File-FindLib-0.001004/0000755000373400001440000000000012365362053013673 5ustar tmcqueenusersFile-FindLib-0.001004/META.json0000644000373400001440000000175112365362053015320 0ustar tmcqueenusers{ "abstract" : "Find and use a file/dir from a directory above your script file", "author" : [ "Tye McQueen" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.141170", "license" : [ "unrestricted" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "File-FindLib", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "File::Basename" : "0", "File::Spec::Functions" : "0", "strict" : "0", "vars" : "0" } } }, "release_status" : "stable", "version" : "0.001004" } File-FindLib-0.001004/FindLib.pm0000644000373400001440000002263412365032302015536 0ustar tmcqueenuserspackage File::FindLib; use strict; use File::Basename qw< dirname >; use File::Spec::Functions qw< rel2abs catdir splitdir >; use vars qw< $VERSION >; my $Pkg= __PACKAGE__; # Our class name (convenient to use in messages) BEGIN { $VERSION= 0.001_004; } return 1; # No run-time code below; just 'sub's and maybe BEGIN blocks sub import { my( $class, @args )= @_; if( 1 == @args ) { my( $find )= @args; return LookUp( -from => ( caller )[1], -upto => $find, -add => $find, ); } else { die "Too many arguments to 'use $Pkg'. Not yet supported.\n"; } } sub LookUp { my %args= @_; my $from= rel2abs( $args{-from} ); my $upto= $args{-upto}; my $add= $args{-add}; warn "$Pkg finds no $from; perhaps chdir()ed before 'use $Pkg'?\n" if ! -e $from && $^W; if( -l $from ) { $from= rel2abs( readlink($from), dirname($from) ); } my $dir= $from; $dir= dirname( $dir ) if ! -d _; while( 1 ) { my $find= catdir( $dir, $upto ); if( -e $find ) { my $path= catdir( $dir, $add ); if( -d $path ) { require lib; lib->import( $path ); return $path; } my $ret= require $path; UpdateInc( $path ); return $ret; } my $up= dirname( $dir ); die "$Pkg can't find $find in ancestor directory of $from.\n" if $up eq $dir; $dir= $up; } } # Set $INC{'My/Mod.pm'} after loading 'lib/My/Mod.pm'; # so "use File::FindLib 'lib/Mod.pm'; use Mod;" doesn't load it twice. sub UpdateInc { my( $path )= @_; # Path to module file. my $base= $path; # Path minus ".pm"; parts that go into package name. return 0 # If no .pm on end, "use Bareword" wouldn't find it. if $base !~ s/[.]pm$//; my @parts= grep length $_, splitdir( $base ); # Potential pkg name parts. my @names; # Above minus leading parts that aren't barewords. unshift @names, pop @parts # Include last part until find... while @parts && $parts[-1] =~ /^\w+$/; # ...a non-bareword. EDGE: for my $o ( 0 .. $#names ) { # Strip shortest prefix that leaves a pkg. next # "use Foo::123" works but "use 123::Foo" wouldn't. if $names[$o] =~ /^[0-9]/; my $stab= \%main::; my @pkg= @names[ $o..$#names ]; for my $name ( @pkg ) { # Defined package? No autovivification. $stab= $stab->{$name.'::'}; next EDGE if ! $stab || 'GLOB' ne ref \$stab; } my $mod= join '/', @pkg; # @INC always uses '/'; no catdir() $INC{"$mod.pm"} ||= $INC{$path}; return 1; } return 0; } __END__ =head1 NAME File::FindLib - Find and use a file/dir from a directory above your script file =head1 SYNOPSIS use File::FindLib 'lib'; Or use File::FindLib 'lib/MyCorp/Setup.pm'; =head1 DESCRIPTION File::FindLib starts in the directory where your script (or library) is located and looks for the file or directory whose name you pass in. If it isn't found, then FindLib looks in the parent directory and continues moving up parent directories until it finds it or until there is not another parent directory. If it finds the named path and it is a directory, then it prepends it to C<@INC>. That is, use File::FindLib 'lib'; is roughly equivalent to: use File::Basename qw< dirname >; use lib dirname(__FILE__) . '/../../../lib'; except you don't have to know how many '../'s to include and it adjusts if __FILE__ is a symbolic link. If it finds the named path and it is a file, then it loads the Perl code stored in that file. That is, use File::FindLib 'lib/MyCorp/Setup.pm'; is roughly equivalent to: use File::Basename qw< dirname >; BEGIN { require dirname(__FILE__) . '/../../../lib/MyCorp/Setup.pm'; } except you don't have to know how many '../'s to include (and it adjusts if __FILE__ is a symbolic link). =head2 MOTIVATION It is common to have a software product that gets deployed as a tree of directories containing commands (scripts) and/or test scripts in the deployment that need to find Perl libraries that are part of the deployment. By including File::FindLib in your standard Perl deployment, you can include one or more custom initialization or boot-strap modules in each of your software deployments and easily load one by pasting one short line into each script. The custom module would likely add some directories to @INC so that the script can then just load any modules that were included in the deployment. For example, you might have a deployment structure that looks like: bin/init ... db/bin/dump ... lib/MyCorp/Setup.pm lib/MyCorp/Widget.pm lib/MyCorp/Widget/Connect.pm ... t/TestEnv.pm t/itPing.t t/itTimeOut.t t/MyCorp/Widget/basic.t ... t/MyCorp/Widget/Connect/retry.t ... t/testlib/MyTest.pm ... And your various Perl scripts like bin/init and db/bin/dump might start with: use File::FindLib 'lib/MyCorp/Setup.pm'; use MyCorp::Widget; And Setup.pm might start with: package MyCorp::Setup; use File::FindLib 'lib'; While your various test scripts might start with: use File::FindLib 't/TestEnv.pm'; use MyTest qw< plan ok >; where TestEnv.pm might start with: package TestEnv; use File::FindLib 'testlib'; # Find modules in $repo/t/testlib/ use File::FindLib 'lib'; # Find modules in $repo/lib/ And you don't have to worry about having to update a script if it gets moved to a different point in the deployment directory tree. =head2 SYMBOLIC LINKS If the calling script/library was loaded via a symbolic link (if C<-l __FILE__> is true inside the calling code), then File::FindLib will start looking from where that symbolic link points. If it points at another symbolic link or if any of the parent directories are symbolic links, then File::FindLib will ignore this fact. So, if we have the following symbolic links: /etc/init.d/widget -> /site/mycorp/widget/bin/init-main /site/mycorp/widget/bin/init-main -> ../util/admin/init /site/mycorp/widget/ -> ../dist/widget/current/ /site/mycorp/dist/widget/current/ -> 2011-12-01/ /site/mycorp/dist/widget/2011-12-01 -> v1.042_037/ /site/mycorp/ -> /export/site/mycorp/ /site -> /export/var/site And the following command produces the following output: $ head -2 /etc/init.d/widget #!/usr/bin/perl use File::FindLib 'lib/Setup.pm'; $ Then File::FindLib will do: See that it was called from /etc/init.d/widget. See that this is a symbolic link. Act like it was called from /site/mycorp/widget/bin/init-main. (Ignore that this is another symbolic link.) Search for: /site/mycorp/widget/bin/lib/Setup.pm /site/mycorp/widget/lib/Setup.pm /site/mycorp/lib/Setup.pm /site/lib/Setup.pm /lib/Setup.pm Only the first symbolic link that we mentioned is noticed. This would be unfortunate if you also have the symbolic link: /etc/rc2.d/S99widget -> ../init.d/widget Since running that command would cause the following searches: /etc/init.d/lib/Setup.pm /etc/lib/Setup.pm /lib/Setup.pm If you instead made a hard link: # ln /etc/init.d/widget /etc/rc2.d/S99widget then /etc/init.d/widget would also be a symbolic link to /site/mycorp/widget/bin/init-main which would surely work better. So future versions of File::FindLib may notice more cases of symbolic links or provide options for controlling which symbolic links to notice. =head2 %INC The code: use File::FindLib 'lib/MyCorp/Setup.pm'; is more accurately approximated as: use File::Basename qw< dirname >; BEGIN { my $path= dirname(__FILE__) . '/../../../lib/MyCorp/Setup.pm'; require $path; $INC{'MyCorp/Setup.pm'} ||= $INC{$path}; } The setting of C<$INC{'MyCorp/Setup.pm'}> is so that: use File::FindLib 'lib/MyCorp/Setup.pm'; ... use MyCorp::Setup; doesn't try to load the MyCorp::Setup module twice. Though, this is only done if lib/MyCorp/Setup.pm defines a MyCorp::Setup package... and C<$INC{'MyCorp/Setup.pm'}> isn't already set and there is no lib::MyCorp::Setup package defined. See the source code if you have to know every detail of the heuristics used, though misfires are unlikely (especially since module names are usually capitalized while library subdirectory names usually are not). Even this problem case is unlikely and the consequences of loading the same module twice are often just harmless warnings, if that. So this detail will not matter most of the time. =head1 PLANS I'd like to support a more powerful interface. For example: use File::FindLib( -from => __FILE__, -upto => 'ReleaseVersion.txt', -inc => 'custom/lib', # Like: use lib ... +inc => 'lib', # Like: push @INC, ... -load => 'initEnv.pl', # Like: require ... \my $DataDir => 'custom/data', # Sets $DataDir to full path ); But adding such an interface should not interfere with the one-argument interface already implemented. =head1 CONTRIBUTORS Author: Tye McQueen, http://perlmonks.org/?node=tye =head1 ALSO SEE Lake Missoula =cut File-FindLib-0.001004/Changes0000644000373400001440000000057112365361431015170 0ustar tmcqueenusersRevision history for Perl extension File::FindLib 0.001_004 2014-07-27 - Fix bug in UpdateInc() [s/0/-1/]. - More unit tests for UpdateInc(). - Prevent smoke test failures due to extraneous output. 0.001_003 2014-07-26 - Add (un)license 0.001_002 2014-06-28 - Prevent double-loading of modules. 0.001_001 2011-12-07 - Initial developer release to CPAN. File-FindLib-0.001004/LICENSE0000644000373400001440000000227112364764270014710 0ustar tmcqueenusersThis is free and unencumbered software released into the public domain. Anyone is free to copy, modify, publish, use, compile, sell, or distribute this software, either in source code form or as a compiled binary, for any purpose, commercial or non-commercial, and by any means. In jurisdictions that recognize copyright laws, the author or authors of this software dedicate any and all copyright interest in the software to the public domain. We make this dedication for the benefit of the public at large and to the detriment of our heirs and successors. We intend this dedication to be an overt act of relinquishment in perpetuity of all present and future rights to this software under copyright law. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. For more information, please refer to File-FindLib-0.001004/MANIFEST0000644000373400001440000000055712365362053015033 0ustar tmcqueenusersChanges FindLib.pm LICENSE MANIFEST Makefile.PL inc/MyTest.pm t/FindMe.pm t/basic.t t/init/.exists t/simple.t t/sub/Sub/Find.pm t/sub/dir/module.pm t/sub/dir/script t/sub/dir/subScript t/updateinc.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) File-FindLib-0.001004/inc/0000755000373400001440000000000012365362053014444 5ustar tmcqueenusersFile-FindLib-0.001004/inc/MyTest.pm0000644000373400001440000000307012365356715016237 0ustar tmcqueenuserspackage MyTest; use strict; use Test qw< plan ok skip >; use vars qw< @EXPORT_OK >; BEGIN { @EXPORT_OK= qw< plan ok skip Okay SkipIf Lives Dies >; require Exporter; *import= \&Exporter::import; } $|= 1; return 1; sub Okay($;$$) { @_= @_ < 3 ? reverse @_ : @_[1,0,2]; goto &ok; } sub SkipIf($;$$$) { my $skip= shift @_; die "Can't not skip a non-test" if ! $skip && ! @_; $skip= 'Prior test failed' if $skip && 1 eq $skip; @_= @_ < 3 ? reverse @_ : @_[1,0,2]; @_= ( $skip, @_ ); goto &skip; } sub Lives { my( $code, $desc )= @_; my( $pkg, $file, $line )= caller(); if( ref $code ) { $desc ||= "$file line $line"; @_= ( 1, eval { $code->(); 1 }, "Should not die:\n$desc\n$@" ); goto &Okay; } else { $desc ||= $code; ++$line; my $eval= qq(\n#line $line "$file"\n) . $code . "\n1;\n"; @_= ( 1, eval $eval, "Should not die:\n$desc\n$@" ); goto &Okay; } } sub Dies { my( $code, $omen, $desc )= @_; my( $pkg, $file, $line )= caller(); ++$line; if( ref $code ) { $desc ||= "$file line $line"; @_= ( ! Okay( undef, eval { $code->(); 1 }, "Should die:\n$desc" ), $omen, $@, "Error from:\n$desc", ); } else { $desc ||= $code; my $eval= qq(\n#line $line "$file"\n) . $code . "\n1;\n"; @_= ( ! Okay( undef, eval $eval, "Should die:\n$desc" ), $omen, $@, "Error from:\n$desc", ); } goto &SkipIf; } File-FindLib-0.001004/META.yml0000644000373400001440000000110712365362053015143 0ustar tmcqueenusers--- abstract: 'Find and use a file/dir from a directory above your script file' author: - 'Tye McQueen' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.141170' license: unrestricted meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: File-FindLib no_index: directory: - t - inc requires: File::Basename: '0' File::Spec::Functions: '0' strict: '0' vars: '0' version: '0.001004' File-FindLib-0.001004/t/0000755000373400001440000000000012365362053014136 5ustar tmcqueenusersFile-FindLib-0.001004/t/FindMe.pm0000644000373400001440000000012612365032202015623 0ustar tmcqueenuserspackage FindMe; use vars qw< $VERSION >; $VERSION= 0.001_004; our $loaded; ++$loaded; File-FindLib-0.001004/t/init/0000755000373400001440000000000012365362053015101 5ustar tmcqueenusersFile-FindLib-0.001004/t/init/.exists0000644000373400001440000000000011667565351016421 0ustar tmcqueenusersFile-FindLib-0.001004/t/updateinc.t0000755000373400001440000000255512365361436016315 0ustar tmcqueenusers#!/usr/bin/perl -w use strict; use File::Basename qw< dirname >; use lib dirname(__FILE__) . '/../inc'; use MyTest qw< plan Okay SkipIf Lives Dies >; use File::FindLib(); plan( tests => 7 ); my $path = 'word/not-word/one1/2two/tre_3/4for/5.pm'; $INC{$path} = "/root/$path"; { no strict 'refs'; ${'word::not-word::one1::2two::tre_3::4for::5::VERSION'} = 1.01; ${'not-word::one1::2two::tre_3::4for::5::VERSION'} = 1.01; ${'one1::2two::tre_3::4for::'}{'5::'} = 1.01; # Not package ${'2two::tre_3::4for::5::VERSION'} = 1.01; ${'tre_3::4for::5::VERSION'} = 1.01; ${'4for::5::VERSION'} = 1.01; ${'5::VERSION'} = 1.01; } my $r = 'tre_3/4for/5.pm'; *UpdateInc = \&File::FindLib::UpdateInc; # Success case: my %bef = %INC; my $start = 0 + keys %INC; Okay( 1, UpdateInc( $path ), 'claims to update inc' ); Okay( 1, keys(%INC) - $start, 'one more item in %INC' ); Okay( "/root/$path", $INC{$r}, 'worked' ); my @suffs; my $suff = $path; push @suffs, $suff while $suff =~ s|^[^/]+/||; my @set = grep exists $INC{$_}, @suffs; Okay( $r, "@set", 'which prefix' ); @set = grep ! exists $bef{$_}, keys %INC; Okay( $r, "@set", 'what is new' ); # Skip module not ending in ".pm": Okay( 0, UpdateInc('foo/bar.pl'), 'claims no update for .pl' ); # Return 0 if no match found: Okay( 0, UpdateInc('Foo/Bar.pm'), 'claims no update for no match' ); File-FindLib-0.001004/t/simple.t0000755000373400001440000000330012365361436015617 0ustar tmcqueenusers#!/usr/bin/perl -w use strict; use File::FindLib 'inc/MyTest.pm'; use File::Basename qw< dirname >; use File::Spec::Functions qw< rel2abs >; BEGIN { MyTest->import( qw< plan skip Okay SkipIf Lives Dies > ); plan( tests => 6, # todo => [ 2, 3 ], ); } # TODO: Change failure to "skip", for the smartarses :) Dies( sub { File::FindLib->import('nobody/has/this/path/on/their/system') }, qr{nobody\W+has\W+this\W+path\W+on\W+their\W+system}, 'Fails when path not found', ); sub maybe_david { our $David; $David = 1 if @_ && $_[0] =~ s/^Using \S+\n//; return $David; } my $VER= $File::FindLib::VERSION; my $t= rel2abs( dirname(__FILE__) ); my $v; chomp( $v= qx( $^X -Mblib $t/sub/dir/script 2>&1 ) ); maybe_david( $v ); Okay( $VER, $v, "Found right version from t/sub/dir/script" ); chomp( $v= qx( $^X -Mblib -e "require '$t/sub/dir/module.pm'" 2>&1 ) ); maybe_david( $v ); Okay( $VER, $v, "Found right version from t/sub/dir/module.pm" ); unlink( "$t/init/link" ); if( maybe_david() ) { skip( 'smoke tester inserting extra output' ) for 1,2; } elsif( eval { if( ! symlink( "../sub/dir/subScript", "$t/init/link" ) ) { warn "# symlink: $!\n"; 0 } else { 1 } } ) { my( $v, $l )= qx( $^X -Mblib $t/init/link 2>&1 ); chomp for $v, $l; Okay( $VER, $v, "Found right version from t/init/link" ); Okay( '1 1', $l, "Sub::Find loaded once" ); } else { skip( 'No symlinks' ) for 1,2; } # TODO: #chdir("$t/sub/dir"); # But will fail is actually from from there #Warns( # sub { # File::FindLib->import( # }, # ... #); File-FindLib-0.001004/t/basic.t0000755000373400001440000000143212353652120015401 0ustar tmcqueenusers#!/usr/bin/perl -w use strict; use File::Basename qw< dirname >; use File::Spec::Functions qw< rel2abs >; use lib dirname(__FILE__) . '/../inc'; use MyTest qw< plan Okay SkipIf Lives Dies >; BEGIN { plan( tests => 7, # todo => [ 2, 3 ], ); require File::FindLib; Okay( 1, 1, 'Load module' ); } Okay( !1, ! File::FindLib->import('t'), 'Import t should return true value' ); Okay( rel2abs(dirname(__FILE__)), $INC[0], 'Unshifted t dir onto @INC' ); Okay( !1, ! File::FindLib->import('t/FindMe.pm'), 'Import FindMe should return true value' ); Okay( $FindMe::VERSION, $File::FindLib::VERSION, 'Found right FindMe' ); Okay( 1, require FindMe, 'require FindMe gives 1' ); { no warnings 'once'; Okay( 1, $FindMe::loaded, 'FindMe loaded once' ); } File-FindLib-0.001004/t/sub/0000755000373400001440000000000012365362053014727 5ustar tmcqueenusersFile-FindLib-0.001004/t/sub/Sub/0000755000373400001440000000000012365362053015460 5ustar tmcqueenusersFile-FindLib-0.001004/t/sub/Sub/Find.pm0000644000373400001440000000013112365032205016662 0ustar tmcqueenuserspackage Sub::Find; use vars qw< $VERSION >; $VERSION= 0.001_004; our $loaded; ++$loaded; File-FindLib-0.001004/t/sub/dir/0000755000373400001440000000000012365362053015505 5ustar tmcqueenusersFile-FindLib-0.001004/t/sub/dir/module.pm0000644000373400001440000000010011666024177017324 0ustar tmcqueenusersuse File::FindLib 't/FindMe.pm'; print $FindMe::VERSION, $/; 1; File-FindLib-0.001004/t/sub/dir/script0000755000373400001440000000007511666024206016737 0ustar tmcqueenusersuse File::FindLib 't/FindMe.pm'; print $FindMe::VERSION, $/; File-FindLib-0.001004/t/sub/dir/subScript0000755000373400001440000000017712353606140017411 0ustar tmcqueenusersuse File::FindLib 'Sub/Find.pm'; print $Sub::Find::VERSION, $/; my $ret= require Sub::Find; print "$ret $Sub::Find::loaded\n"; File-FindLib-0.001004/Makefile.PL0000755000373400001440000000125312365005252015644 0ustar tmcqueenusers#!/usr/bin/perl -w use strict; use ExtUtils::MakeMaker; # Run "perldoc ExtUtils::MakeMaker" for more information. my $v = $ExtUtils::MakeMaker::VERSION; WriteMakefile( 'NAME' => 'File::FindLib', 'VERSION_FROM' => 'FindLib.pm', 'PREREQ_PM' => { 'strict' => 0, # in 'core' 'File::Basename' => 0, # in 'core' 'File::Spec::Functions' => 0, # in 'core' 'vars' => 0, # in 'core' }, $] < 5.005 ? () : ( 'AUTHOR' => 'Tye McQueen', 'ABSTRACT_FROM' => 'FindLib.pm', ), $v < 6.31 ? () : ( LICENSE => 'unrestricted' ), );