view release on metacpan or  search on metacpan

t/a2.t  view on Meta::CPAN

#!/usr/bin/perl -T

# MonkeyPatched version of test to get some diagnostics from tempdir

use File::Spec;
use File::Temp qw(tempdir);

use Carp;
use Scalar::Util qw(tainted);
use Mock::MonkeyPatch;

####### Monkeypatch File::Temp::tempdir

sub _patched_tempdir  {
  if ( @_ && $_[0] eq 'File::Temp' ) {
      croak "'tempdir' can't be called as a method";
  }
  carp "verifying in the monkeypatched function";
  return Mock::MonkeyPatch::ORIGINAL(@_) if (($^O eq 'VMS') || ($^O eq 'MacOS') || scalar(@_) != 3);

  # Can not check for argument count since we can have any
  # number of args

  # Default options
  my %options = (
                 "CLEANUP"    => 0, # Remove directory on exit
                 "DIR"        => '', # Root directory
                 "TMPDIR"     => 0,  # Use tempdir with template
                );

  # Check to see whether we have an odd or even number of arguments
  my ($maybe_template, $args) = File::Temp::_parse_args(@_);
  carp "options args->{DIR} $args->{DIR}" if tainted($args->{DIR});
  my $template = @$maybe_template ? $maybe_template->[0] : undef;

  # Read the options and merge with defaults
  %options = (%options, %$args);
  carp "options dir 1 $options{DIR}" if tainted($options{'DIR'});

  # Modify or generate the template

  # Deal with the DIR and TMPDIR options
  if (defined $template) {
    carp "tempdir called with tainted template $template" if tainted($template);
    # Need to strip directory path if using DIR or TMPDIR
    if ($options{'TMPDIR'} || $options{'DIR'}) {

      carp "options dir 2 $options{DIR}" if tainted($options{'DIR'});
      # Strip parent directory from the filename
      #
      # There is no filename at the end
      my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);

      # Last directory is then our template
      $template = (File::Spec->splitdir($directories))[-1];
      carp "tempdir after spltdir tainted template $template" if tainted($template);

      # Prepend the supplied directory or temp dir
      if ($options{"DIR"}) {

	carp "options dir 3 $options{DIR}" if tainted($options{"DIR"});
	carp "tempdir before cattdir 1 tainted template $template" if tainted($template);
        $template = File::Spec->catdir($options{"DIR"}, $template);
	carp "tempdir after cattdir 1 tainted template $template" if tainted($template);

      } elsif ($options{TMPDIR}) {

        # Prepend tmpdir
        $template = File::Spec->catdir(File::Spec->tmpdir, $template);
	carp "tempdir after cattdir 2 tainted template $template" if tainted($template);

      }
    }

  } else {

    if ($options{"DIR"}) {