view release on metacpan or  search on metacpan

t/a2.t  view on Meta::CPAN

  croak "Error in tempdir() using $template: $errstr"
    unless ((undef, $tempdir) = File::Temp::_gettemp($template,
                                         "open" => 0,
                                         "mkdir"=> 1 ,
                                         "suffixlen" => $suffixlen,
                                         "ErrStr" => \$errstr,
                                        ) );

  # Install exit handler; must be dynamic to get lexical
  if ( $options{'CLEANUP'} && -d $tempdir) {
    _deferred_unlink(undef, $tempdir, 1);
  }

  # Return the dir name
  return $tempdir;

}

### MonkeyPatch the Unix implementation of File::Spec->catdir
sub _patched_pp_canonpath {
    my ($self,$path) = @_;
    return unless defined $path;

    carp "Entered patched File::Spec->canonpath";
    carp "canonpath path 0 $path is tainted" if tainted($path);
    my $node = '';
    my $double_slashes_special = $^O eq 'qnx' || $^O eq 'nto';

    if ( $double_slashes_special
         && ( $path =~ s{^(//[^/]+)/?\z}{}s || $path =~ s{^(//[^/]+)/}{/}s ) ) {
      $node = $1;
    }
    carp "canonpath node 1 $node is tainted" if tainted($node);
    $path =~ s|/{2,}|/|g;                            # xx////xx  -> xx/xx
    carp "canonpath path 1 $path is tainted" if tainted($path);
    $path =~ s{(?:/\.)+(?:/|\z)}{/}g;                # xx/././xx -> xx/xx
    carp "canonpath path 2 $path is tainted" if tainted($path);
    $path =~ s|^(?:\./)+||s unless $path eq "./";    # ./xx      -> xx
    carp "canonpath path 3 $path is tainted" if tainted($path);
    $path =~ s|^/(?:\.\./)+|/|;                      # /../../xx -> xx
    carp "canonpath path 4 $path is tainted" if tainted($path);
    $path =~ s|^/\.\.$|/|;                         # /..       -> /
    carp "canonpath path 5 $path is tainted" if tainted($path);
    $path =~ s|/\z|| unless $path eq "/";          # xx/       -> xx
    carp "canonpath path 6 $path is tainted" if tainted($path);
    carp "canonpath node 2 $node is tainted" if tainted($node);
    return "$node$path";
}

my $mock = Mock::MonkeyPatch->patch('File::Temp::tempdir' => \&_patched_tempdir);
die "MonkeyPatch tempdir failed" unless $mock;

my $mock2 = Mock::MonkeyPatch->patch('File::Spec::Unix::canonpath' => \&_patched_pp_canonpath);
die "MonkeyPatch canonpath failed" unless $mock2;

use Test::More tests => 1;

my $pathdir = $ENV{HOME};  # make variable tainted and set to an existing absolute directory 
(-d $pathdir) and File::Spec->file_name_is_absolute($pathdir);

my $workdir = File::Temp::tempdir("temp.XXXXXX", DIR => "log");

ok((-d $workdir), 'tempdir test');