errep.perl

   1 #!perl -w
   2 use strict;
   3
   4 use Config;
   5
   6 my @precommands=('uname -a','perl -V');
   7 my @manpages=('dlopen','shl_load','dlsym','dlclose');
   8 my @postcommands=map { "man $_ | col -bf | cat -s" } @manpages;
   9
  10 print <<EOF;
  11
  12   This script will gather information about your system in order to
  13   help debugging the problem compiling or testing Imager on your
  14   system.
  15
  16   Make sure that you are in the same directory as errep.perl is when
  17   running the script.  Also make sure that the environment variables
  18   are the same as when running perl Makefile.PL
  19
  20   It issues: uname -a, perl -V and gets the %Config hash from the
  21   build of the perl binary.  Then it tries to build and test the
  22   module (but not install it).  It dumps out the test logs if there
  23   are any.  It ends by dumping out some manpages.
  24
  25   All the results are saved to the file 'report.txt'
  26
  27   Continue [Y/n]?
  28
  29 EOF
  30
  31 my $a=<STDIN>;
  32 chomp($a);
  33 die "Aborted!\n" if $a =~ /^n/i;
  34
  35 print "Generating info about system\n";
  36
  37 open OSTD, '>&STDOUT' or die $!;
  38 open STDOUT, '>report.txt' or die $!;
  39 open STDERR, '>&STDOUT' or die $!;
  40
  41 rcomm('rm testout/*');
  42 rcomm(@precommands);
  43 my $make = $Config{make};
  44 rcomm("$^X Makefile.PL --verbose") || rcomm("$make") || rcomm("$make test TEST_VERBOSE=1");
  45 head("Logfiles from run");
  46 dumplogs();
  47
  48 pconf();
  49 rcomm(@postcommands);
  50
  51 sub pconf {
  52     head("perl Config parameters");
  53     for(sort keys %Config) {  print $_,"=>",(defined $Config{$_} ? $Config{$_} : '(undef)'),"\n"; }
  54     print "\n";
  55 }
  56
  57
  58 sub rcomm {
  59     my @commands=@_;
  60     my ($comm,$R);
  61     for $comm(@commands) {
  62         print "Executing '$comm'\n";
  63         print OSTD "Executing '$comm'\n";
  64         $R=system($comm);
  65         print "warning - rc=$R\n" if $R;
  66         print "=====================\n\n";
  67     }
  68     return $R;
  69 }
  70
  71 sub head {
  72     my $h=shift;
  73     print "=========================\n";
  74     print $h;
  75     print "\n=========================\n";
  76 }
  77
  78 sub dumplogs {
  79     opendir(DH,"testout") || die "Cannot open dir testout: $!\n";
  80     my @fl=sort grep(/\.log$/,readdir(DH));
  81
  82     for my $f (@fl) {
  83         print "::::::::::::::\ntestout/$f\n::::::::::::::\n";
  84         open(FH,"testout/$f") || warn "Cannot open testout/$f: $!\n";
  85         print while(<FH>);
  86         close(FH);
  87     }
  88 }
  89
  90
  91
  92
  93
  94
  95
  96
  97
  98