App-cpanminus
view release on metacpan or search on metacpan
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
sub _push_tags {
my($pkg, $var, $syms) = @_;
my @nontag = ();
my $export_tags = \%{"${pkg}::EXPORT_TAGS"};
push(@{"${pkg}::$var"},
map { $export_tags->{$_} ? @{$export_tags->{$_}}
: scalar(push(@nontag,$_),$_) }
(@$syms) ? @$syms : keys %$export_tags);
if (@nontag and $^W) {
# This may change to a die one day
require Carp;
Carp::carp(join(", ", @nontag)." are not tags of $pkg");
}
}
sub heavy_require_version {
my($self, $wanted) = @_;
my $pkg = ref $self || $self;
return ${pkg}->VERSION($wanted);
}
sub heavy_export_tags {
_push_tags((caller)[0], "EXPORT", \@_);
}
sub heavy_export_ok_tags {
_push_tags((caller)[0], "EXPORT_OK", \@_);
}
1;
EXPORTER_HEAVY
$fatpacked{"File/pushd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PUSHD';
use strict;
use warnings;
package File::pushd;
# ABSTRACT: change directory temporarily for a limited scope
our $VERSION = '1.009'; # VERSION
our @EXPORT = qw( pushd tempd );
our @ISA = qw( Exporter );
use Exporter;
use Carp;
use Cwd qw( getcwd abs_path );
use File::Path qw( rmtree );
use File::Temp qw();
use File::Spec;
use overload
q{""} => sub { File::Spec->canonpath( $_[0]->{_pushd} ) },
fallback => 1;
#--------------------------------------------------------------------------#
# pushd()
#--------------------------------------------------------------------------#
sub pushd {
my ( $target_dir, $options ) = @_;
$options->{untaint_pattern} ||= qr{^([-+@\w./]+)$};
$target_dir = "." unless defined $target_dir;
croak "Can't locate directory $target_dir" unless -d $target_dir;
my $tainted_orig = getcwd;
my $orig;
if ( $tainted_orig =~ $options->{untaint_pattern} ) {
$orig = $1;
}
else {
$orig = $tainted_orig;
}
my $tainted_dest;
eval { $tainted_dest = $target_dir ? abs_path($target_dir) : $orig };
croak "Can't locate absolute path for $target_dir: $@" if $@;
my $dest;
if ( $tainted_dest =~ $options->{untaint_pattern} ) {
$dest = $1;
}
else {
$dest = $tainted_dest;
}
if ( $dest ne $orig ) {
chdir $dest or croak "Can't chdir to $dest\: $!";
}
my $self = bless {
_pushd => $dest,
_original => $orig
},
__PACKAGE__;
return $self;
}
#--------------------------------------------------------------------------#
# tempd()
#--------------------------------------------------------------------------#
sub tempd {
my ($options) = @_;
my $dir;
eval { $dir = pushd( File::Temp::tempdir( CLEANUP => 0 ), $options ) };
croak $@ if $@;
$dir->{_tempd} = 1;
return $dir;
}
#--------------------------------------------------------------------------#
# preserve()
#--------------------------------------------------------------------------#
sub preserve {
my $self = shift;
return 1 if !$self->{"_tempd"};
if ( @_ == 0 ) {
return $self->{_preserve} = 1;
}
else {
return $self->{_preserve} = $_[0] ? 1 : 0;
}
}
#--------------------------------------------------------------------------#
# DESTROY()
# Revert to original directory as object is destroyed and cleanup
# if necessary
#--------------------------------------------------------------------------#
sub DESTROY {
my ($self) = @_;
my $orig = $self->{_original};
chdir $orig if $orig; # should always be so, but just in case...
if ( $self->{_tempd}
&& !$self->{_preserve} )
{
# don't destroy existing $@ if there is no error.
my $err = do {
local $@;
eval { rmtree( $self->{_pushd} ) };
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
# working directory changed to /tmp
}
# working directory has reverted to $ENV{HOME}
# tempd() is equivalent to pushd( File::Temp::tempdir )
{
my $dir = tempd();
}
# object stringifies naturally as an absolute path
{
my $dir = pushd( '/tmp' );
my $filename = File::Spec->catfile( $dir, "somefile.txt" );
# gives /tmp/somefile.txt
}
=head1 DESCRIPTION
File::pushd does a temporary C<chdir> that is easily and automatically
reverted, similar to C<pushd> in some Unix command shells. It works by
creating an object that caches the original working directory. When the object
is destroyed, the destructor calls C<chdir> to revert to the original working
directory. By storing the object in a lexical variable with a limited scope,
this happens automatically at the end of the scope.
This is very handy when working with temporary directories for tasks like
testing; a function is provided to streamline getting a temporary
directory from L<File::Temp>.
For convenience, the object stringifies as the canonical form of the absolute
pathname of the directory entered.
B<Warning>: if you create multiple C<pushd> objects in the same lexical scope,
their destruction order is not guaranteed and you might not wind up in the
directory you expect.
=head1 USAGE
use File::pushd;
Using File::pushd automatically imports the C<pushd> and C<tempd> functions.
=head2 pushd
{
my $dir = pushd( $target_directory );
}
Caches the current working directory, calls C<chdir> to change to the target
directory, and returns a File::pushd object. When the object is
destroyed, the working directory reverts to the original directory.
The provided target directory can be a relative or absolute path. If
called with no arguments, it uses the current directory as its target and
returns to the current directory when the object is destroyed.
If the target directory does not exist or if the directory change fails
for some reason, C<pushd> will die with an error message.
Can be given a hashref as an optional second argument. The only supported
option is C<untaint_pattern>, which is used to untaint file paths involved.
It defaults to {qr{^(L<-+@\w./>+)$}}, which is reasonably restrictive (e.g.
it does not even allow spaces in the path). Change this to suit your
circumstances and security needs if running under taint mode. *Note*: you
must include the parentheses in the pattern to capture the untainted
portion of the path.
=head2 tempd
{
my $dir = tempd();
}
This function is like C<pushd> but automatically creates and calls C<chdir> to
a temporary directory created by L<File::Temp>. Unlike normal L<File::Temp>
cleanup which happens at the end of the program, this temporary directory is
removed when the object is destroyed. (But also see C<preserve>.) A warning
will be issued if the directory cannot be removed.
As with C<pushd>, C<tempd> will die if C<chdir> fails.
It may be given a single options hash that will be passed internally
to C<pushd>.
=head2 preserve
{
my $dir = tempd();
$dir->preserve; # mark to preserve at end of scope
$dir->preserve(0); # mark to delete at end of scope
}
Controls whether a temporary directory will be cleaned up when the object is
destroyed. With no arguments, C<preserve> sets the directory to be preserved.
With an argument, the directory will be preserved if the argument is true, or
marked for cleanup if the argument is false. Only C<tempd> objects may be
marked for cleanup. (Target directories to C<pushd> are always preserved.)
C<preserve> returns true if the directory will be preserved, and false
otherwise.
=head1 SEE ALSO
=over 4
=item *
L<File::chdir>
=back
=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
=head1 SUPPORT
=head2 Bugs / Feature Requests
Please report any bugs or feature requests through the issue tracker
at L<https://github.com/dagolden/File-pushd/issues>.
You will be notified automatically of any progress on your issue.
=head2 Source Code
This is open source software. The code repository is available for
public review and contribution under the terms of the license.
lib/App/cpanminus/fatscript.pm view on Meta::CPAN
STRING_SHELLQUOTE
$fatpacked{"lib/core/only.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LIB_CORE_ONLY';
package lib::core::only;
use strict;
use warnings FATAL => 'all';
use Config;
sub import {
@INC = @Config{qw(privlibexp archlibexp)};
return
}
=head1 NAME
lib::core::only - Remove all non-core paths from @INC to avoid site/vendor dirs
=head1 SYNOPSIS
use lib::core::only; # now @INC contains only the two core directories
To get only the core directories plus the ones for the local::lib in scope:
$ perl -mlocal::lib -Mlib::core::only -Mlocal::lib=~/perl5 myscript.pl
To attempt to do a self-contained build (but note this will not reliably
propagate into subprocesses, see the CAVEATS below):
$ PERL5OPT='-mlocal::lib -Mlib::core::only -Mlocal::lib=~/perl5' cpan
Please note that it is necessary to use C<local::lib> twice for this to work.
First so that C<lib::core::only> doesn't prevent C<local::lib> from loading
(it's not currently in core) and then again after C<lib::core::only> so that
the local paths are not removed.
=head1 DESCRIPTION
lib::core::only is simply a shortcut to say "please reduce my @INC to only
the core lib and archlib (architecture-specific lib) directories of this perl".
You might want to do this to ensure a local::lib contains only the code you
need, or to test an L<App::FatPacker|App::FatPacker> tree, or to avoid known
bad vendor packages.
You might want to use this to try and install a self-contained tree of perl
modules. Be warned that that probably won't work (see L</CAVEATS>).
This module was extracted from L<local::lib|local::lib>'s --self-contained
feature, and contains the only part that ever worked. I apologise to anybody
who thought anything else did.
=head1 CAVEATS
This does B<not> propagate properly across perl invocations like local::lib's
stuff does. It can't. It's only a module import, so it B<only affects the
specific perl VM instance in which you load and import() it>.
If you want to cascade it across invocations, you can set the PERL5OPT
environment variable to '-Mlib::core::only' and it'll sort of work. But be
aware that taint mode ignores this, so some modules' build and test code
probably will as well.
You also need to be aware that perl's command line options are not processed
in order - -I options take effect before -M options, so
perl -Mlib::core::only -Ilib
is unlike to do what you want - it's exactly equivalent to:
perl -Mlib::core::only
If you want to combine a core-only @INC with additional paths, you need to
add the additional paths using -M options and the L<lib|lib> module:
perl -Mlib::core::only -Mlib=lib
# or if you're trying to test compiled code:
perl -Mlib::core::only -Mblib
For more information on the impossibility of sanely propagating this across
module builds without help from the build program, see
L<http://www.shadowcat.co.uk/blog/matt-s-trout/tainted-love> - and for ways
to achieve the old --self-contained feature's results, look at
L<App::FatPacker|App::FatPacker>'s tree function, and at
L<App::cpanminus|cpanm>'s --local-lib-contained feature.
=head1 AUTHOR
Matt S. Trout <mst@shadowcat.co.uk>
=head1 LICENSE
This library is free software under the same terms as perl itself.
=head1 COPYRIGHT
(c) 2010 the lib::core::only L</AUTHOR> as specified above.
=cut
1;
LIB_CORE_ONLY
$fatpacked{"local/lib.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOCAL_LIB';
package local::lib;
use 5.006;
use strict;
use warnings;
use Config;
our $VERSION = '2.000015';
$VERSION = eval $VERSION;
BEGIN {
*_WIN32 = ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'symbian')
? sub(){1} : sub(){0};
# punt on these systems
*_USE_FSPEC = ($^O eq 'MacOS' || $^O eq 'VMS' || $INC{'File/Spec.pm'})
? sub(){1} : sub(){0};
}
our $_DIR_JOIN = _WIN32 ? '\\' : '/';
our $_DIR_SPLIT = (_WIN32 || $^O eq 'cygwin') ? qr{[\\/]}
: qr{/};
our $_ROOT = _WIN32 ? do {
my $UNC = qr{[\\/]{2}[^\\/]+[\\/][^\\/]+};
qr{^(?:$UNC|[A-Za-z]:|)$_DIR_SPLIT};
} : qr{^/};
our $_PERL;
sub _cwd {
my $drive = shift;
if (!$_PERL) {
($_PERL) = $^X =~ /(.+)/; # $^X is internal how could it be tainted?!
if (_is_abs($_PERL)) {
}
elsif (-x $Config{perlpath}) {
$_PERL = $Config{perlpath};
}
else {
($_PERL) =
map { /(.*)/ }
grep { -x $_ }
map { join($_DIR_JOIN, $_, $_PERL) }
split /\Q$Config{path_sep}\E/, $ENV{PATH};
}
}
local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};
my $cmd = $drive ? "eval { Cwd::getdcwd(q($drive)) }"
: 'getcwd';
my $cwd = `"$_PERL" -MCwd -le "print $cmd"`;
chomp $cwd;
if (!length $cwd && $drive) {
$cwd = $drive;
}
$cwd =~ s/$_DIR_SPLIT?$/$_DIR_JOIN/;
$cwd;
}
sub _catdir {
if (_USE_FSPEC) {
require File::Spec;
File::Spec->catdir(@_);
}
else {
my $dir = join($_DIR_JOIN, @_);
$dir =~ s{($_DIR_SPLIT)(?:\.?$_DIR_SPLIT)+}{$1}g;
$dir;
}
}
sub _is_abs {
if (_USE_FSPEC) {
require File::Spec;
File::Spec->file_name_is_absolute($_[0]);
}
else {
$_[0] =~ $_ROOT;
}
}
sub _rel2abs {
my ($dir, $base) = @_;
return $dir
if _is_abs($dir);
$base = _WIN32 && $dir =~ s/^([A-Za-z]:)// ? _cwd("$1")
: $base ? $base
: _cwd;
return _catdir($base, $dir);
}
sub import {
my ($class, @args) = @_;
( run in 1.286 second using v1.01-cache-2.11-cpan-7fcb06a456a )