lib/local/lib.pm

   1 use strict;
   2 use warnings;
   3
   4 package local::lib;
   5
   6 use 5.008001; # probably works with earlier versions but I'm not supporting them
   7               # (patches would, of course, be welcome)
   8
   9 use File::Spec ();
  10 use File::Path ();
  11 use Carp ();
  12 use Config;
  13
  14 our $VERSION = '1.002000'; # 1.2.0
  15
  16 sub import {
  17   my ($class, @args) = @_;
  18
  19   # The path is required, but last in the list, so we pop, not shift here.
  20   my $path = pop @args;
  21   $path = $class->resolve_path($path);
  22   $class->setup_local_lib_for($path);
  23
  24   # Handle the '--self-contained' option
  25   my $flag = shift @args;
  26   no warnings 'uninitialized'; # the flag is optional
  27   if ($flag eq '--self-contained') {
  28     # The only directories that remain are those that we just defined and those where core modules are stored.
  29     @INC = ($Config::Config{privlibexp}, $Config::Config{archlibexp}, split ':', $ENV{PERL5LIB});
  30   }
  31   elsif (defined $flag) {
  32       die "unrecognized import argument: $flag";
  33   }
  34
  35 }
  36
  37 sub pipeline;
  38
  39 sub pipeline {
  40   my @methods = @_;
  41   my $last = pop(@methods);
  42   if (@methods) {
  43     \sub {
  44       my ($obj, @args) = @_;
  45       $obj->${pipeline @methods}(
  46         $obj->$last(@args)
  47       );
  48     };
  49   } else {
  50     \sub {
  51       shift->$last(@_);
  52     };
  53   }
  54 }
  55
  56 =begin testing
  57
  58 #:: test pipeline
  59
  60 package local::lib;
  61
  62 { package Foo; sub foo { -$_[1] } sub bar { $_[1]+2 } sub baz { $_[1]+3 } }
  63 my $foo = bless({}, 'Foo');
  64 Test::More::ok($foo->${pipeline qw(foo bar baz)}(10) == -15);
  65
  66 =end testing
  67
  68 =cut
  69
  70 sub resolve_path {
  71   my ($class, $path) = @_;
  72   $class->${pipeline qw(
  73     resolve_relative_path
  74     resolve_home_path
  75     resolve_empty_path
  76   )}($path);
  77 }
  78
  79 sub resolve_empty_path {
  80   my ($class, $path) = @_;
  81   if (defined $path) {
  82     $path;
  83   } else {
  84     '~/perl5';
  85   }
  86 }
  87
  88 =begin testing
  89
  90 #:: test classmethod setup
  91
  92 my $c = 'local::lib';
  93
  94 =end testing
  95
  96 =begin testing
  97
  98 #:: test classmethod
  99
 100 is($c->resolve_empty_path, '~/perl5');
 101 is($c->resolve_empty_path('foo'), 'foo');
 102
 103 =end testing
 104
 105 =cut
 106
 107 sub resolve_home_path {
 108   my ($class, $path) = @_;
 109   return $path unless ($path =~ /^~/);
 110   my ($user) = ($path =~ /^~([^\/]+)/); # can assume ^~ so undef for 'us'
 111   my $tried_file_homedir;
 112   my $homedir = do {
 113     if (eval { require File::HomeDir } && $File::HomeDir::VERSION >= 0.65) {
 114       $tried_file_homedir = 1;
 115       if (defined $user) {
 116         File::HomeDir->users_home($user);
 117       } else {
 118         File::HomeDir->my_home;
 119       }
 120     } else {
 121       if (defined $user) {
 122         (getpwnam $user)[7];
 123       } else {
 124         if (defined $ENV{HOME}) {
 125           $ENV{HOME};
 126         } else {
 127           (getpwuid $<)[7];
 128         }
 129       }
 130     }
 131   };
 132   unless (defined $homedir) {
 133     Carp::croak(
 134       "Couldn't resolve homedir for "
 135       .(defined $user ? $user : 'current user')
 136       .($tried_file_homedir ? '' : ' - consider installing File::HomeDir')
 137     );
 138   }
 139   $path =~ s/^~[^\/]*/$homedir/;
 140   $path;
 141 }
 142
 143 sub resolve_relative_path {
 144   my ($class, $path) = @_;
 145   File::Spec->rel2abs($path);
 146 }
 147
 148 =begin testing
 149
 150 #:: test classmethod
 151
 152 local *File::Spec::rel2abs = sub { shift; 'FOO'.shift; };
 153 is($c->resolve_relative_path('bar'),'FOObar');
 154
 155 =end testing
 156
 157 =cut
 158
 159 sub setup_local_lib_for {
 160   my ($class, $path) = @_;
 161   $class->ensure_dir_structure_for($path);
 162   if ($0 eq '-') {
 163     $class->print_environment_vars_for($path);
 164     exit 0;
 165   } else {
 166     $class->setup_env_hash_for($path);
 167     unshift(@INC, split(':', $ENV{PERL5LIB}));
 168   }
 169 }
 170
 171 sub modulebuildrc_path {
 172   my ($class, $path) = @_;
 173   File::Spec->catfile($path, '.modulebuildrc');
 174 }
 175
 176 sub install_base_bin_path {
 177   my ($class, $path) = @_;
 178   File::Spec->catdir($path, 'bin');
 179 }
 180
 181 sub install_base_perl_path {
 182   my ($class, $path) = @_;
 183   File::Spec->catdir($path, 'lib', 'perl5');
 184 }
 185
 186 sub install_base_arch_path {
 187   my ($class, $path) = @_;
 188   File::Spec->catdir($class->install_base_perl_path($path), $Config{archname});
 189 }
 190
 191 sub ensure_dir_structure_for {
 192   my ($class, $path) = @_;
 193   unless (-d $path) {
 194     warn "Attempting to create directory ${path}\n";
 195   }
 196   File::Path::mkpath($path);
 197   my $modulebuildrc_path = $class->modulebuildrc_path($path);
 198   if (-e $modulebuildrc_path) {
 199     unless (-f _) {
 200       Carp::croak("${modulebuildrc_path} exists but is not a plain file");
 201     }
 202   } else {
 203     warn "Attempting to create file ${modulebuildrc_path}\n";
 204     open MODULEBUILDRC, '>', $modulebuildrc_path
 205       || Carp::croak("Couldn't open ${modulebuildrc_path} for writing: $!");
 206     print MODULEBUILDRC qq{install  --install_base  ${path}\n}
 207       || Carp::croak("Couldn't write line to ${modulebuildrc_path}: $!");
 208     close MODULEBUILDRC
 209       || Carp::croak("Couldn't close file ${modulebuildrc_path}: $@");
 210   }
 211 }
 212
 213 sub INTERPOLATE_ENV () { 1 }
 214 sub LITERAL_ENV     () { 0 }
 215
 216 sub print_environment_vars_for {
 217   my ($class, $path) = @_;
 218   my @envs = $class->build_environment_vars_for($path, LITERAL_ENV);
 219   my $out = '';
 220
 221   # rather basic csh detection, goes on the assumption that something won't
 222   # call itself csh unless it really is. also, default to bourne in the
 223   # pathological situation where a user doesn't have $ENV{SHELL} defined.
 224   # note also that shells with funny names, like zoid, are assumed to be
 225   # bourne.
 226   my $shellbin = 'sh';
 227   if(defined $ENV{'SHELL'}) {
 228       my @shell_bin_path_parts = File::Spec->splitpath($ENV{'SHELL'});
 229       $shellbin = $shell_bin_path_parts[-1];
 230   }
 231   my $shelltype = do {
 232       local $_ = $shellbin;
 233       if(/csh/) {
 234           'csh'
 235       } else {
 236           'bourne'
 237       }
 238   };
 239
 240   while (@envs) {
 241     my ($name, $value) = (shift(@envs), shift(@envs));
 242     $value =~ s/(\\")/\\$1/g;
 243     $out .= $class->${\"build_${shelltype}_env_declaration"}($name, $value);
 244   }
 245   print $out;
 246 }
 247
 248 # simple routines that take two arguments: an %ENV key and a value. return
 249 # strings that are suitable for passing directly to the relevant shell to set
 250 # said key to said value.
 251 sub build_bourne_env_declaration {
 252   my $class = shift;
 253   my($name, $value) = @_;
 254   return qq{export ${name}="${value}"\n};
 255 }
 256
 257 sub build_csh_env_declaration {
 258   my $class = shift;
 259   my($name, $value) = @_;
 260   return qq{setenv ${name} "${value}"\n};
 261 }
 262
 263 sub setup_env_hash_for {
 264   my ($class, $path) = @_;
 265   my %envs = $class->build_environment_vars_for($path, INTERPOLATE_ENV);
 266   @ENV{keys %envs} = values %envs;
 267 }
 268
 269 sub build_environment_vars_for {
 270   my ($class, $path, $interpolate) = @_;
 271   return (
 272     MODULEBUILDRC => $class->modulebuildrc_path($path),
 273     PERL_MM_OPT => "INSTALL_BASE=${path}",
 274     PERL5LIB => join(':',
 275                   $class->install_base_perl_path($path),
 276                   $class->install_base_arch_path($path),
 277                   ($ENV{PERL5LIB} ?
 278                     ($interpolate == INTERPOLATE_ENV
 279                       ? ($ENV{PERL5LIB})
 280                       : ('$PERL5LIB'))
 281                     : ())
 282                 ),
 283     PATH => join(':',
 284               $class->install_base_bin_path($path),
 285               ($interpolate == INTERPOLATE_ENV
 286                 ? $ENV{PATH}
 287                 : '$PATH')
 288              ),
 289   )
 290 }
 291
 292 =begin testing
 293
 294 #:: test classmethod
 295
 296 File::Path::rmtree('t/var/splat');
 297
 298 $c->ensure_dir_structure_for('t/var/splat');
 299
 300 ok(-d 't/var/splat');
 301
 302 ok(-f 't/var/splat/.modulebuildrc');
 303
 304 =end testing
 305
 306 =head1 NAME
 307
 308 local::lib - create and use a local lib/ for perl modules with PERL5LIB
 309
 310 =head1 SYNOPSIS
 311
 312 In code -
 313
 314   use local::lib; # sets up a local lib at ~/perl5
 315
 316   use local::lib '~/foo'; # same, but ~/foo
 317
 318   # Or...
 319   use FindBin;
 320   use local::lib "$FindBin::Bin/../support";  # app-local support library
 321
 322 From the shell -
 323
 324   # Install LWP and it's missing dependencies to the 'my_lwp' directory
 325   perl -MCPAN -Mlocal::lib=my_lwp -e 'CPAN::install(LWP)'
 326
 327   # Install LWP and *all non-core* dependencies to the 'my_lwp' directory
 328   perl -MCPAN -Mlocal::lib=--self-contained,my_lwp -e 'CPAN::install(LWP)'
 329
 330   # Just print out useful shell commands
 331   $ perl -Mlocal::lib
 332   export MODULEBUILDRC=/home/username/perl/.modulebuildrc
 333   export PERL_MM_OPT='INSTALL_BASE=/home/username/perl'
 334   export PERL5LIB='/home/username/perl/lib/perl5:/home/username/perl/lib/perl5/i386-linux'
 335   export PATH="/home/username/perl/bin:$PATH"
 336
 337 To bootstrap if you don't have local::lib itself installed -
 338
 339   <download local::lib tarball from CPAN, unpack and cd into dir>
 340
 341   $ perl Makefile.PL --bootstrap
 342   $ make test && make install
 343
 344   $ echo 'eval $(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)' >>~/.bashrc
 345
 346   # Or for C shells...
 347
 348   $ /bin/csh
 349   % echo $SHELL
 350   /bin/csh
 351   % perl -I$HOME/perl5/lib/perl5 -Mlocal::lib >> ~/.cshrc
 352
 353 You can also pass --boostrap=~/foo to get a different location (adjust the
 354 bashrc / cshrc line appropriately)
 355
 356 =head1 DESCRIPTION
 357
 358 This module provides a quick, convenient way of bootstrapping a user-local Perl
 359 module library located within the user's home directory. It also constructs and
 360 prints out for the user the list of environment variables using the syntax
 361 appropriate for the user's current shell (as specified by the C<SHELL>
 362 environment variable), suitable for directly adding to one's shell configuration
 363 file.
 364
 365 More generally, local::lib allows for the bootstrapping and usage of a directory
 366 containing Perl modules outside of Perl's C<@INC>. This makes it easier to ship
 367 an application with an app-specific copy of a Perl module, or collection of
 368 modules. Useful in cases like when an upstream maintainer hasn't applied a patch
 369 to a module of theirs that you need for your application.
 370
 371 On import, local::lib sets the following environment variables to appropriate
 372 values:
 373
 374 =over 4
 375
 376 =item MODULEBUILDRC
 377
 378 =item PERL_MM_OPT
 379
 380 =item PERL5LIB
 381
 382 =item PATH
 383
 384 PATH is appended to, rather than clobbered.
 385
 386 =back
 387
 388 These values are then available for reference by any code after import.
 389
 390 =head1 A WARNING ABOUT UNINST=1
 391
 392 Be careful about using local::lib in combination with "make install UNINST=1".
 393 The idea of this feature is that will uninstall an old version of a module
 394 before installing a new one. However it lacks a safety check that the old
 395 version and the new version will go in the same directory. Used in combination
 396 with local::lib, you can potentially delete a globally accessible version of a
 397 module while installing the new version in a local place. Only combine if "make
 398 install UNINST=1" and local::lib if you understand these possible consequences.
 399
 400 =head1 LIMITATIONS
 401
 402 Rather basic shell detection. Right now anything with csh in its name is
 403 assumed to be a C shell or something compatible, and everything else is assumed
 404 to be Bourne. If the C<SHELL> environment variable is not set, a
 405 Bourne-compatible shell is assumed.
 406
 407 Bootstrap is a hack and will use CPAN.pm for ExtUtils::MakeMaker even if you
 408 have CPANPLUS installed.
 409
 410 Kills any existing PERL5LIB, PERL_MM_OPT or MODULEBUILDRC.
 411
 412 Should probably auto-fixup CPAN config if not already done.
 413
 414 Patches very much welcome for any of the above.
 415
 416 =head1 ENVIRONMENT
 417
 418 =over 4
 419
 420 =item SHELL
 421
 422 local::lib looks at the user's C<SHELL> environment variable when printing out
 423 commands to add to the shell configuration file.
 424
 425 =back
 426
 427 =head1 AUTHOR
 428
 429 Matt S Trout <mst@shadowcat.co.uk> http://www.shadowcat.co.uk/
 430
 431 auto_install fixes kindly sponsored by http://www.takkle.com/
 432
 433 =head1 CONTRIBUTORS
 434
 435 Patches to correctly output commands for csh style shells, as well as some
 436 documentation additions, contributed by Christopher Nehren <apeiron@cpan.org>.
 437
 438 '--self-contained' feature contributed by Mark Stosberg <mark@summersault.com>.
 439
 440 =head1 LICENSE
 441
 442 This library is free software under the same license as perl itself
 443
 444 =cut
 445
 446 1;