lib/local/lib.pm

   1 use strict;
   2 use warnings;
   3
   4 package local::lib;
   5
   6 use 5.8.1; # 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.000000'; # 1.0.0
  15
  16 sub import {
  17   my ($class, $path) = @_;
  18   $path = $class->resolve_path($path);
  19   $class->setup_local_lib_for($path);
  20 }
  21
  22 sub pipeline;
  23
  24 sub pipeline {
  25   my @methods = @_;
  26   my $last = pop(@methods);
  27   if (@methods) {
  28     \sub {
  29       my ($obj, @args) = @_;
  30       $obj->${pipeline @methods}(
  31         $obj->$last(@args)
  32       );
  33     };
  34   } else {
  35     \sub {
  36       shift->$last(@_);
  37     };
  38   }
  39 }
  40
  41 =for test pipeline
  42
  43 package local::lib;
  44
  45 { package Foo; sub foo { -$_[1] } sub bar { $_[1]+2 } sub baz { $_[1]+3 } }
  46 my $foo = bless({}, 'Foo');
  47 Test::More::ok($foo->${pipeline qw(foo bar baz)}(10) == -15);
  48
  49 =cut
  50
  51 sub resolve_path {
  52   my ($class, $path) = @_;
  53   $class->${pipeline qw(
  54     resolve_relative_path
  55     resolve_home_path
  56     resolve_empty_path
  57   )}($path);
  58 }
  59
  60 sub resolve_empty_path {
  61   my ($class, $path) = @_;
  62   if (defined $path) {
  63     $path;
  64   } else {
  65     '~/perl5';
  66   }
  67 }
  68
  69 =for test classmethod setup
  70
  71 my $c = 'local::lib';
  72
  73 =cut
  74
  75 =for test classmethod
  76
  77 is($c->resolve_empty_path, '~/perl5');
  78 is($c->resolve_empty_path('foo'), 'foo');
  79
  80 =cut
  81
  82 sub resolve_home_path {
  83   my ($class, $path) = @_;
  84   return $path unless ($path =~ /^~/);
  85   my ($user) = ($path =~ /^~([^\/]+)/); # can assume ^~ so undef for 'us'
  86   my $tried_file_homedir;
  87   my $homedir = do {
  88     if (eval { require File::HomeDir } && $File::HomeDir::VERSION >= 0.65) {
  89       $tried_file_homedir = 1;
  90       if (defined $user) {
  91         File::HomeDir->users_home($user);
  92       } else {
  93         File::HomeDir->my_homedir;
  94       }
  95     } else {
  96       if (defined $user) {
  97         (getpwnam $user)[7];
  98       } else {
  99         if (defined $ENV{HOME}) {
 100           $ENV{HOME};
 101         } else {
 102           (getpwuid $<)[7];
 103         }
 104       }
 105     }
 106   };
 107   unless (defined $homedir) {
 108     Carp::croak(
 109       "Couldn't resolve homedir for "
 110       .(defined $user ? $user : 'current user')
 111       .($tried_file_homedir ? '' : ' - consider installing File::HomeDir')
 112     );
 113   }
 114   $path =~ s/^~[^\/]*/$homedir/;
 115   $path;
 116 }
 117
 118 sub resolve_relative_path {
 119   my ($class, $path) = @_;
 120   File::Spec->rel2abs($path);
 121 }
 122
 123 =for test classmethod
 124
 125 local *File::Spec::rel2abs = sub { shift; 'FOO'.shift; };
 126 is($c->resolve_relative_path('bar'),'FOObar');
 127
 128 =cut
 129
 130 sub setup_local_lib_for {
 131   my ($class, $path) = @_;
 132   $class->ensure_dir_structure_for($path);
 133   if ($0 eq '-') {
 134     $class->print_environment_vars_for($path);
 135     exit 0;
 136   } else {
 137     $class->setup_env_hash_for($path);
 138     unshift(@INC, split(':', $ENV{PERL5LIB}));
 139   }
 140 }
 141
 142 sub modulebuildrc_path {
 143   my ($class, $path) = @_;
 144   File::Spec->catfile($path, '.modulebuildrc');
 145 }
 146
 147 sub install_base_bin_path {
 148   my ($class, $path) = @_;
 149   File::Spec->catdir($path, 'bin');
 150 }
 151
 152 sub install_base_perl_path {
 153   my ($class, $path) = @_;
 154   File::Spec->catdir($path, 'lib', 'perl5');
 155 }
 156
 157 sub install_base_arch_path {
 158   my ($class, $path) = @_;
 159   File::Spec->catdir($class->install_base_perl_path($path), $Config{archname});
 160 }
 161
 162 sub ensure_dir_structure_for {
 163   my ($class, $path) = @_;
 164   unless (-d $path) {
 165     warn "Attempting to create directory ${path}\n";
 166   }
 167   File::Path::mkpath($path);
 168   my $modulebuildrc_path = $class->modulebuildrc_path($path);
 169   if (-e $modulebuildrc_path) {
 170     unless (-f _) {
 171       Carp::croak("${modulebuildrc_path} exists but is not a plain file");
 172     }
 173   } else {
 174     warn "Attempting to create file ${modulebuildrc_path}\n";
 175     open MODULEBUILDRC, '>', $modulebuildrc_path
 176       || Carp::croak("Couldn't open ${modulebuildrc_path} for writing: $!");
 177     print MODULEBUILDRC qq{install  --install_base  ${path}\n}
 178       || Carp::croak("Couldn't write line to ${modulebuildrc_path}: $!");
 179     close MODULEBUILDRC
 180       || Carp::croak("Couldn't close file ${modulebuildrc_path}: $@");
 181   }
 182 }
 183
 184 sub INTERPOLATE_PATH () { 1 }
 185 sub LITERAL_PATH     () { 0 }
 186
 187 sub print_environment_vars_for {
 188   my ($class, $path) = @_;
 189   my @envs = $class->build_environment_vars_for($path, LITERAL_PATH);
 190   my $out = '';
 191   while (@envs) {
 192     my ($name, $value) = (shift(@envs), shift(@envs));
 193     $value =~ s/(\\")/\\$1/g;
 194     $out .= qq{export ${name}="${value}"\n};
 195   }
 196   print $out;
 197 }
 198
 199 sub setup_env_hash_for {
 200   my ($class, $path) = @_;
 201   my %envs = $class->build_environment_vars_for($path, INTERPOLATE_PATH);
 202   @ENV{keys %envs} = values %envs;
 203 }
 204
 205 sub build_environment_vars_for {
 206   my ($class, $path, $interpolate) = @_;
 207   return (
 208     MODULEBUILDRC => $class->modulebuildrc_path($path),
 209     PERL_MM_OPT => "INSTALL_BASE=${path}",
 210     PERL5LIB => join(':',
 211                   $class->install_base_perl_path($path),
 212                   $class->install_base_arch_path($path),
 213                 ),
 214     PATH => join(':',
 215               $class->install_base_bin_path($path),
 216               ($interpolate == INTERPOLATE_PATH
 217                 ? $ENV{PATH}
 218                 : '$PATH')
 219              ),
 220   )
 221 }
 222
 223 =for test classmethod
 224
 225 File::Path::rmtree('t/var/splat');
 226
 227 $c->ensure_dir_structure_for('t/var/splat');
 228
 229 ok(-d 't/var/splat');
 230
 231 ok(-f 't/var/splat/.modulebuildrc');
 232
 233 =head1 NAME
 234
 235 local::lib - create and use a local lib/ for perl modules with PERL5LIB
 236
 237 =head1 SYNOPSIS
 238
 239 In code -
 240
 241   use local::lib; # sets up a local lib at ~/perl5
 242
 243   use local::lib '~/foo'; # same, but ~/foo
 244
 245 From the shell -
 246
 247   $ perl -Mlocal::lib
 248   export MODULEBUILDRC=/home/username/perl/.modulebuildrc
 249   export PERL_MM_OPT='INSTALL_BASE=/home/username/perl'
 250   export PERL5LIB='/home/username/perl/lib/perl5:/home/username/perl/lib/perl5/i386-linux'
 251   export PATH="/home/username/perl/bin:$PATH"
 252
 253 To bootstrap if you don't have local::lib itself installed -
 254
 255   perl -MCPAN -eshell
 256   cpan> look local::lib
 257   $ perl Makefile.PL --bootstrap
 258   $ make test && make install
 259
 260 =head1 AUTHOR
 261
 262 Matt S Trout <mst@shadowcat.co.uk> http://www.shadowcat.co.uk/
 263
 264 =head1 LICENSE
 265
 266 This library is free software under the same license as perl itself
 267
 268 =cut
 269
 270 1;