App-Dex

 view release on metacpan or  search on metacpan

scripts/dex  view on Meta::CPAN

          }
          $profiler->app_call( [ $0, @ARGV ], scalar gettimeofday() );
      }
  }
  
  
  END {
      $profiler->app_exit( scalar gettimeofday() ) if profiling;
  }
  
  sub _binmode {
      my ( $fh, $mode, $what ) = @_;
      # if $mode is not given, then default to ":raw", except on Windows,
      # where we default to ":crlf";
      # otherwise if a proper layer string was given, use that,
      # else use ":raw"
      my $layer = !$mode
         ? (is_win32 ? ":crlf" : ":raw")
         : ($mode =~ /^:/ ? $mode : ":raw");
      warn "binmode $what, $layer\n" if debugging >= 2;
  
      binmode $fh, ":raw" unless $layer eq ":raw";      # remove all layers first
      binmode $fh, $layer or croak "binmode $layer failed: $!";
  }
  
  sub _spool_data_to_child {
      my ( $type, $source, $binmode_it ) = @_;
  
      # If undef (not \undef) passed, they want the child to inherit
      # the parent's STDIN.
      return undef unless defined $source;
  
      my $fh;
      if ( ! $type ) {
          open $fh, "<", $source or croak "$!: $source";
         _binmode($fh, $binmode_it, "STDIN");
          warn "run3(): feeding file '$source' to child STDIN\n"
              if debugging >= 2;
      } elsif ( $type eq "FH" ) {
          $fh = $source;
          warn "run3(): feeding filehandle '$source' to child STDIN\n"
              if debugging >= 2;
      } else {
          $fh = $fh_cache{in} ||= tempfile;
          truncate $fh, 0;
          seek $fh, 0, 0;
         _binmode($fh, $binmode_it, "STDIN");
          my $seekit;
          if ( $type eq "SCALAR" ) {
  
              # When the run3()'s caller asks to feed an empty file
              # to the child's stdin, we want to pass a live file
              # descriptor to an empty file (like /dev/null) so that
              # they don't get surprised by invalid fd errors and get
              # normal EOF behaviors.
              return $fh unless defined $$source;  # \undef passed
  

scripts/dex  view on Meta::CPAN

             or croak "$!: $dest";
      } else {
          warn "run3(): capturing child $what\n"
              if debugging >= 2;
  
          $fh = $fh_cache{$what} ||= tempfile;
          seek $fh, 0, 0;
          truncate $fh, 0;
      }
  
      my $binmode_it = $options->{"binmode_$what"};
      _binmode($fh, $binmode_it, uc $what);
  
      return $fh;
  }
  
  sub _read_child_output_fh {
      my ( $what, $type, $dest, $fh, $options ) = @_;
  
      return if $type eq "SCALAR" && $dest == \undef;
  
      seek $fh, 0, 0 or croak "$! seeking on temp file for child $what";

scripts/dex  view on Meta::CPAN

      if ( ref $cmd ) {
          croak "run3(): empty command"     unless @$cmd;
          croak "run3(): undefined command" unless defined $cmd->[0];
          croak "run3(): command name ('')" unless length  $cmd->[0];
      } else {
          croak "run3(): missing command" unless @_;
          croak "run3(): undefined command" unless defined $cmd;
          croak "run3(): command ('')" unless length  $cmd;
      }
  
      foreach (qw/binmode_stdin binmode_stdout binmode_stderr/) {
         if (my $mode = $options->{$_}) {
             croak qq[option $_ must be a number or a proper layer string: "$mode"]
                unless $mode =~ /^(:|\d+$)/;
         }
      }
  
      my $in_type  = _type $stdin;
      my $out_type = _type $stdout;
      my $err_type = _type $stderr;
  

scripts/dex  view on Meta::CPAN

         close $_ foreach values %fh_cache;
         %fh_cache = ();
         $fh_cache_pid = $$;
      }
  
      # This routine proceeds in stages so that a failure in an early
      # stage prevents later stages from running, and thus from needing
      # cleanup.
  
      my $in_fh  = _spool_data_to_child $in_type, $stdin,
          $options->{binmode_stdin} if defined $stdin;
  
      my $out_fh = _fh_for_child_output "stdout", $out_type, $stdout,
          $options if defined $stdout;
  
      my $tie_err_to_out =
          defined $stderr && defined $stdout && $stderr eq $stdout;
  
      my $err_fh = $tie_err_to_out
          ? $out_fh
          : _fh_for_child_output "stderr", $err_type, $stderr,

scripts/dex  view on Meta::CPAN

  C<STDERR>, collecting all into file "foo.txt" or C<$both>.
  
  =head3 C<\%options>
  
  The last parameter, C<\%options>, must be a hash reference if present.
  
  Currently the following keys are supported:
  
  =over 4
  
  =item C<binmode_stdin>, C<binmode_stdout>, C<binmode_stderr>
  
  The value must a "layer" as described in L<perlfunc/binmode>.  If specified the
  corresponding parameter C<$stdin>, C<$stdout> or C<$stderr>, resp., operates
  with the given layer.
  
  For backward compatibility, a true value that doesn't start with ":"
  (e.g. a number) is interpreted as ":raw". If the value is false
  or not specified, the default is ":crlf" on Windows and ":raw" otherwise.
  
  Don't expect that values other than the built-in layers ":raw", ":crlf",
  and (on newer Perls) ":bytes", ":utf8", ":encoding(...)" will work.
  

scripts/dex  view on Meta::CPAN

  
  sub new {
      my $class = ref $_[0] ? ref shift : shift;
      my $self = bless { @_ }, $class;
      
      $self->{Destination} = "run3.out"
          unless defined $self->{Destination} && length $self->{Destination};
  
      open PROFILE, ">$self->{Destination}"
          or die "$!: $self->{Destination}\n";
      binmode PROFILE;
      $self->{FH} = *PROFILE{IO};
  
      $self->{times} = [];
      return $self;
  }
  
  =head2 C<< $logger->run_exit( ... ) >>
  
  =cut
  

xt/author/00-compile.t  view on Meta::CPAN

for my $lib (@module_files)
{
    # see L<perlfaq8/How can I capture STDERR from an external command?>
    my $stderr = IO::Handle->new;

    diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
            $^X, @switches, '-e', "require q[$lib]"))
        if $ENV{PERL_COMPILE_TEST_DEBUG};

    my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
    binmode $stderr, ':crlf' if $^O eq 'MSWin32';
    my @_warnings = <$stderr>;
    waitpid($pid, 0);
    is($?, 0, "$lib loaded ok");

    shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
        and not eval { +require blib; blib->VERSION('1.01') };

    if (@_warnings)
    {
        warn @_warnings;

xt/author/00-compile.t  view on Meta::CPAN

    close $fh and skip("$file uses -T; not testable with PERL5LIB", 1)
        if grep { $_ eq '-T' } @switches and $ENV{PERL5LIB};

    my $stderr = IO::Handle->new;

    diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
            $^X, @switches, '-c', $file))
        if $ENV{PERL_COMPILE_TEST_DEBUG};

    my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-c', $file);
    binmode $stderr, ':crlf' if $^O eq 'MSWin32';
    my @_warnings = <$stderr>;
    waitpid($pid, 0);
    is($?, 0, "$file compiled ok");

    shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
        and not eval { +require blib; blib->VERSION('1.01') };

    # in older perls, -c output is simply the file portion of the path being tested
    if (@_warnings = grep { !/\bsyntax OK$/ }
        grep { chomp; $_ ne (File::Spec->splitpath($file))[2] } @_warnings)