AIX-Perfstat

 view release on metacpan or  search on metacpan

inc/Devel/CheckLib.pm  view on Meta::CPAN

when you might want to prompt the user for various paths and
things before checking that what they've told you is sane.

If any library or header is missing, it exits with an exit value of 0 to avoid
causing a CPAN Testers 'FAIL' report.  CPAN Testers should ignore this
result -- which is what you want if an external library dependency is not
available.

=cut

sub check_lib_or_exit {
    eval 'assert_lib(@_)';
    if($@) {
        warn $@;
        exit;
    }
}

sub assert_lib {
    my %args = @_;
    my (@libs, @libpaths, @headers, @incpaths);

    # FIXME: these four just SCREAM "refactor" at me
    @libs = (ref($args{lib}) ? @{$args{lib}} : $args{lib}) 
        if $args{lib};
    @libpaths = (ref($args{libpath}) ? @{$args{libpath}} : $args{libpath}) 
        if $args{libpath};
    @headers = (ref($args{header}) ? @{$args{header}} : $args{header}) 
        if $args{header};

inc/Devel/CheckLib.pm  view on Meta::CPAN

        my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd);
        push @missing, $lib if $rv != 0 || ! -x $exefile; 
        _cleanup_exe($exefile);
    } 
    unlink $cfile;

    my $miss_string = join( q{, }, map { qq{'$_'} } @missing );
    die("Can't link/include $miss_string\n") if @missing;
}

sub _cleanup_exe {
    my ($exefile) = @_;
    my $ofile = $exefile;
    $ofile =~ s/$Config{_exe}$/$Config{_o}/;
    unlink $exefile if -f $exefile;
    unlink $ofile if -f $ofile;
    unlink "$exefile\.manifest" if -f "$exefile\.manifest";
    return
}
    
sub _findcc {
    my @paths = split(/$Config{path_sep}/, $ENV{PATH});
    my @cc = split(/\s+/, $Config{cc});
    return @cc if -x $cc[0];
    foreach my $path (@paths) {
        my $compiler = File::Spec->catfile($path, $cc[0]) . $Config{_exe};
        return ($compiler, @cc[1 .. $#cc]) if -x $compiler;
    }
    die("Couldn't find your C compiler\n");
}

# code substantially borrowed from IPC::Run3
sub _quiet_system {
    my (@cmd) = @_;

    # save handles
    local *STDOUT_SAVE;
    local *STDERR_SAVE;
    open STDOUT_SAVE, ">&STDOUT" or die "CheckLib: $! saving STDOUT";
    open STDERR_SAVE, ">&STDERR" or die "CheckLib: $! saving STDERR";
    
    # redirect to nowhere
    local *DEV_NULL;

ppport.h  view on Meta::CPAN

my @srcext = qw( xs c h cc cpp );
my $srcext = join '|', @srcext;

if (@ARGV) {
  my %seen;
  @files = grep { -f && !exists $seen{$_} } map { glob $_ } @ARGV;
}
else {
  eval {
    require File::Find;
    File::Find::find(sub {
      $File::Find::name =~ /\.($srcext)$/i
          and push @files, $File::Find::name;
    }, '.');
  };
  if ($@) {
    @files = map { glob "*.$_" } @srcext;
  }
}

if (!@ARGV || $opt{filter}) {

ppport.h  view on Meta::CPAN

  else {
    info("Looks good");
  }
}

close PATCH if $patch_opened;

exit 0;


sub mydiff
{
  local *F = shift;
  my($file, $str) = @_;
  my $diff;

  if (exists $opt{diff}) {
    $diff = run_diff($opt{diff}, $file, $str);
  }

  if (!defined $diff and can_use('Text::Diff')) {

ppport.h  view on Meta::CPAN

  if (!defined $diff) {
    error("Cannot generate a diff. Please install Text::Diff or use --copy.");
    return;
  }

  print F $diff;

}

sub run_diff
{
  my($prog, $file, $str) = @_;
  my $tmp = 'dppptemp';
  my $suf = 'aaa';
  my $diff = '';
  local *F;

  while (-e "$tmp.$suf") { $suf++ }
  $tmp = "$tmp.$suf";

ppport.h  view on Meta::CPAN

    unlink $tmp;
  }
  else {
    error("Cannot open '$tmp' for writing: $!");
  }

  return undef;
}

sub can_use
{
  eval "use @_;";
  return $@ eq '';
}

sub rec_depend
{
  my $func = shift;
  my %seen;
  return () unless exists $depends{$func};
  grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}};
}

sub parse_version
{
  my $ver = shift;

  if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
    return ($1, $2, $3);
  }
  elsif ($ver !~ /^\d+\.[\d_]+$/) {
    die "cannot parse version '$ver'\n";
  }

ppport.h  view on Meta::CPAN

  if ($r < 5 || ($r == 5 && $v < 6)) {
    if ($s % 10) {
      die "cannot parse version '$ver'\n";
    }
  }

  return ($r, $v, $s);
}

sub format_version
{
  my $ver = shift;

  $ver =~ s/$/000000/;
  my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;

  $v = int $v;
  $s = int $s;

  if ($r < 5 || ($r == 5 && $v < 6)) {

ppport.h  view on Meta::CPAN

    $ver = sprintf "%d.%03d", $r, $v;
    $s > 0 and $ver .= sprintf "_%02d", $s;

    return $ver;
  }

  return sprintf "%d.%d.%d", $r, $v, $s;
}

sub info
{
  $opt{quiet} and return;
  print @_, "\n";
}

sub diag
{
  $opt{quiet} and return;
  $opt{diag} and print @_, "\n";
}

sub warning
{
  $opt{quiet} and return;
  print "*** ", @_, "\n";
}

sub error
{
  print "*** ERROR: ", @_, "\n";
}

my %given_hints;
sub hint
{
  $opt{quiet} and return;
  $opt{hints} or return;
  my $func = shift;
  exists $hints{$func} or return;
  $given_hints{$func}++ and return;
  my $hint = $hints{$func};
  $hint =~ s/^/   /mg;
  print "   --- hint for $func ---\n", $hint;
}

sub usage
{
  my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
  my %M = ( 'I' => '*' );
  $usage =~ s/^\s*perl\s+\S+/$^X $0/;
  $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;

  print <<ENDUSAGE;

Usage: $usage

ppport.h  view on Meta::CPAN

#  define PUSHu(u)                       STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG;  } STMT_END
#endif

#ifndef XPUSHu
#  define XPUSHu(u)                      STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
#endif

#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
/* Replace: 1 */
#  define PL_DBsingle               DBsingle
#  define PL_DBsub                  DBsub
#  define PL_Sv                     Sv
#  define PL_compiling              compiling
#  define PL_copline                copline
#  define PL_curcop                 curcop
#  define PL_curstash               curstash
#  define PL_debstash               debstash
#  define PL_defgv                  defgv
#  define PL_diehook                diehook
#  define PL_dirty                  dirty
#  define PL_dowarn                 dowarn