lib/blib.pm

   1 package blib;
   2
   3 =head1 NAME
   4
   5 blib - Use MakeMaker's uninstalled version of a package
   6
   7 =head1 SYNOPSIS
   8
   9  perl -Mblib script [args...]
  10
  11  perl -Mblib=dir script [args...]
  12
  13 =head1 DESCRIPTION
  14
  15 Looks for MakeMaker-like I<'blib'> directory structure starting in
  16 I<dir> (or current directory) and working back up to five levels of '..'.
  17
  18 Intended for use on command line with B<-M> option as a way of testing
  19 arbitrary scripts against an uninstalled version of a package.
  20
  21 However it is possible to :
  22
  23  use blib;
  24  or
  25  use blib '..';
  26
  27 etc. if you really must.
  28
  29 =head1 BUGS
  30
  31 Pollutes global name space for development only task.
  32
  33 =head1 AUTHOR
  34
  35 Nick Ing-Simmons nik@tiuk.ti.com
  36
  37 =cut
  38
  39 use Cwd;
  40 use File::Spec;
  41
  42 use vars qw($VERSION $Verbose);
  43 $VERSION = '1.03';
  44 $Verbose = 0;
  45
  46 sub import
  47 {
  48  my $package = shift;
  49  my $dir;
  50  if ($^O eq "MSWin32" && -f "Win32.xs") {
  51      # We don't use getcwd() on Windows because it will internally
  52      # call Win32::GetCwd(), which will get the Win32 module loaded.
  53      # That means that it would not be possible to run `make test`
  54      # for the Win32 module because blib.pm would always load the
  55      # installed version before @INC gets updated with the blib path.
  56      chomp($dir = `cd`);
  57  }
  58  else {
  59      $dir = getcwd;
  60  }
  61  if ($^O eq 'VMS') { ($dir = VMS::Filespec::unixify($dir)) =~ s-/\z--; }
  62  if (@_)
  63   {
  64    $dir = shift;
  65    $dir =~ s/blib\z//;
  66    $dir =~ s,/+\z,,;
  67    $dir = File::Spec->curdir unless ($dir);
  68    die "$dir is not a directory\n" unless (-d $dir);
  69   }
  70  my $i = 5;
  71  my($blib, $blib_lib, $blib_arch);
  72  while ($i--)
  73   {
  74    $blib = File::Spec->catdir($dir, "blib");
  75    $blib_lib = File::Spec->catdir($blib, "lib");
  76
  77    if ($^O eq 'MacOS')
  78     {
  79      $blib_arch = File::Spec->catdir($blib_lib, $MacPerl::Architecture);
  80     }
  81    else
  82     {
  83      $blib_arch = File::Spec->catdir($blib, "arch");
  84     }
  85
  86    if (-d $blib && -d $blib_arch && -d $blib_lib)
  87     {
  88      unshift(@INC,$blib_arch,$blib_lib);
  89      warn "Using $blib\n" if $Verbose;
  90      return;
  91     }
  92    $dir = File::Spec->catdir($dir, File::Spec->updir);
  93   }
  94  die "Cannot find blib even in $dir\n";
  95 }
  96
  97 1;