extend some variable types to avoid overflows for mediancut
[imager.git] / errep.perl
CommitLineData
d75a4e19
TC
1#!perl -w
2use strict;
02d1d628
AMH
3
4use Config;
5
d75a4e19
TC
6my @precommands=('uname -a','perl -V');
7my @manpages=('dlopen','shl_load','dlsym','dlclose');
8my @postcommands=map { "man $_ | col -bf | cat -s" } @manpages;
02d1d628
AMH
9
10print <<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
29EOF
30
d75a4e19 31my $a=<STDIN>;
02d1d628
AMH
32chomp($a);
33die "Aborted!\n" if $a =~ /^n/i;
34
35print "Generating info about system\n";
36
37open OSTD, '>&STDOUT' or die $!;
38open STDOUT, '>report.txt' or die $!;
39open STDERR, '>&STDOUT' or die $!;
40
41rcomm('rm testout/*');
42rcomm(@precommands);
d75a4e19 43my $make = $Config{make};
edbce063 44rcomm("$^X Makefile.PL --verbose") || rcomm("$make") || rcomm("$make test TEST_VERBOSE=1");
02d1d628
AMH
45head("Logfiles from run");
46dumplogs();
47
48pconf();
49rcomm(@postcommands);
50
51sub pconf {
52 head("perl Config parameters");
53 for(sort keys %Config) { print $_,"=>",(defined $Config{$_} ? $Config{$_} : '(undef)'),"\n"; }
54 print "\n";
55}
56
57
58sub 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
71sub head {
72 my $h=shift;
73 print "=========================\n";
74 print $h;
75 print "\n=========================\n";
76}
77
78sub 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