File Coverage

blib/lib/Test/Smoke/Database/Parsing.pm
Criterion Covered Total %
statement 261 327 79.8
branch 219 316 69.3
condition 109 182 59.8
subroutine 9 10 90.0
pod 4 4 100.0
total 602 839 71.7


line stmt bran cond sub pod time code
1             package Test::Smoke::Database::Parsing;
2              
3             # Copyright 200x A.Barbet alian@cpan.org All rights reserved.
4             # $Date: 2004/04/19 15:15:38 $
5             # $Log: Parsing.pm,v $
6             # Revision 1.14 2004/04/19 15:15:38 alian
7             # fix on warnings
8             #
9             # Revision 1.13 2004/04/14 22:30:49 alian
10             # parse 1.19 style reports
11             #
12             # Revision 1.12 2003/11/07 17:42:22 alian
13             # Avoid warnings when create graph
14             #
15             # Revision 1.11 2003/11/07 17:33:41 alian
16             # - link to web archive when delete a report
17             # - skip report with only '? ? ? ?'
18             #
19             # Revision 1.10 2003/09/16 15:41:50 alian
20             # - Update parsing to parse 5.6.1 report
21             # - Change display for lynx
22             # - Add top smokers
23             #
24             # Revision 1.9 2003/08/19 10:37:24 alian
25             # Release 1.14:
26             # - FORMAT OF DATABASE UPDATED ! (two cols added, one moved).
27             # - Add a 'version' field to filter/parser (Eg: All perl-5.8.1 report)
28             # - Use the field 'date' into filter/parser (Eg: All report after 07/2003)
29             # - Add an author field to parser, and a smoker HTML page about recent
30             # smokers and their available config.
31             # - Change how nbte (number of failed tests) is calculate
32             # - Graph are done by month, no longuer with patchlevel
33             # - Only rewrite cc if gcc. Else we lost solaris info
34             # - Remove ccache info for have less distinct compiler
35             # - Add another report to tests
36             # - Update FAQ.pod for last Test::Smoke version
37             # - Save only wanted headers for each nntp articles (and save From: field).
38             # - Move away last varchar field from builds to data
39             #
40             # Revision 1.8 2003/08/15 15:48:40 alian
41             # Speedup for update_ref & some pod doc
42             #
43             # Revision 1.7 2003/08/15 15:12:28 alian
44             # Update update_ref with SQL request from admin_smokedb
45             #
46              
47 5     5   137820 use strict;
  5         11  
  5         228  
48 5     5   26 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  5         9  
  5         360  
49 5     5   10877 use DBI;
  5         106219  
  5         351  
50 5     5   2876 use Data::Dumper;
  5         57193  
  5         383  
51 5     5   48 use Carp qw(cluck);
  5         11  
  5         247  
52 5     5   65 use File::Basename;
  5         11  
  5         50881  
53             require Exporter;
54              
55             @ISA = qw(Exporter);
56             @EXPORT = qw();
57             $VERSION = ('$Revision: 1.14 $ ' =~ /(\d+\.\d+)/)[0];
58              
59             my $moii = qr/Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec/;
60             my $date = qr/^Date: \w{0,3},? {0,2}(\d{1,2}) ($moii) (\d\d\d\d) (\d\d:\d\d:?\d?\d?)/;
61             my %month = ( Jan => 1, Feb => 2, Mar =>3, Apr =>4, May => 5, Jun =>6,
62             Jul => 7, Aug => 8, Sep =>9, Oct =>10, Nov =>11, Dec=> 12);
63              
64             #------------------------------------------------------------------------------
65             # parse_import
66             #------------------------------------------------------------------------------
67             sub parse_import {
68 0     0 1 0 my $self = shift;
69 0         0 my ($nb,$nbo,%k) = (0,0);
70 0 0       0 print scalar(localtime),": Parse reports\n"
71             if ($self->{opts}->{verbose});
72             # Select list of knows id
73 0         0 my $st = $self->{DBH}->prepare('select distinct id from builds');
74 0         0 $st->execute;
75 0         0 while (my ($id)= $st->fetchrow_array) { $k{$id}=1; }
  0         0  
76 0         0 $st->finish;
77              
78             # Read a .rpt file
79 0         0 foreach (glob($self->{opts}->{dir}."/*.rpt*")) {
80 0         0 $nb++;
81             # skip backup file or already defined report
82 0 0 0     0 next if (/~$/ or ( /(\d+)\.rpt/ && $k{$1}));
      0        
83 0         0 my $id = $1;
84 0         0 my $ref = parse_rpt($_);
85 0 0       0 if (!defined($ref)) {
    0          
86 0 0       0 warn "Can't read/parse $_\n" if ($self->{opts}->{debug});
87             }
88             elsif (!ref($ref)) {
89 0 0       0 if ($ref == -1) {
    0          
    0          
90 0         0 my @l = parse_hm_brand_rpt($_);
91 0         0 foreach (@l) {
92 0 0 0     0 next if (!$_->{id} or $k{$_->{id}});
93 0 0       0 print STDERR "Add a H.M. Brand report\n"
94             if ($self->{opts}->{debug});
95 0 0       0 $self->db->add_to_db($_) && $nbo++;
96 0         0 $k{$_->{id}}=1;
97             }
98             } elsif ($ref == -2) {
99 0 0       0 warn "\thttp://nntp.x.perl.org/group/perl.daily-build.reports/$id seems to be a DEAD report, will be unlink\n"
100             if ($self->{opts}->{verbose});
101 0         0 unlink $_;
102             } elsif ($ref == -3) {
103 0 0       0 warn "\tSeems to be a Alian report with too more rows, will be unlink"
104             if ($self->{opts}->{verbose});
105 0         0 unlink $_;
106             } else {
107 0         0 warn "\tWhat's this ? $_";
108             }
109            
110             }
111             else {
112             # Add it to database
113 0 0       0 print STDERR "Add report $_\n" if ($self->{opts}->{debug});
114 0 0       0 $self->db->add_to_db($ref) && $nbo++;
115             }
116             }
117 0 0       0 print scalar(localtime),": $nbo reports imported from $nb files\n"
118             if ($self->{opts}->{verbose});
119 0         0 return $nbo;
120             }
121              
122             #------------------------------------------------------------------------------
123             # parse_hm_brand_rpt
124             #------------------------------------------------------------------------------
125             sub parse_hm_brand_rpt($) {
126 6     6 1 156060 my $file = shift;
127 6 100       45 return if (!$file);
128 5 100       190 if (!-r $file) { warn "Can't found $file"; return; }
  1         112  
  1         9  
129 4         15 my (@lr,%last,$header,$datee);
130 4 50       414 open(FILE,$file) or die "Can't read $file:$!\n";
131 4         1389 my @content = ;
132 4         425 close(FILE);
133 4         10 my $ok=0;
134             # Rebuild report wrapped by mail to 72c
135 4         9 my $cont; my $re = 0;
  4         13  
136 4         16 foreach my $l (@content) {
137 1155         1432 chomp($l);
138 1155         11175 $l=~s/=3D/=/g;
139 1155         6983 $l=~s/=20$/ /g;
140 1155 100       35863 if ($l=~$date) { $datee=$l; } # common date
  16         28  
141 1155 50       4094 if ($l=~/\=$/) { chop($l); $re=1; }
  0         0  
  0         0  
142 1155 50       1763 if ($re) { $cont.=$l; $re=0; }
  0         0  
  0         0  
143 1155         3018 else { $cont.=$l."\n"; }
144             }
145 4         11 my $origI = 0;
146 4         8 my $nbI = 0;
147 4         680 foreach my $l (split(/\n/, $cont)) {
148 1147         3818 $l.="\n";
149 1147         1916 my $i = $origI;
150 1147         2335 foreach my $a (@lr) {
151 11882 50 33     95582 if (!$a or !ref($a)) { delete $lr[$i]; next;}
  0         0  
  0         0  
152 11882         29657 $i++;
153             }
154 1147         7316 $i = $origI;
155 1147 100       4449 if ($l=~/MULTIPART_MIXED_/) { $origI = $#lr+1; $ok=0; }
  22         38  
  22         32  
156 1147 100 66     5391 $ok = 1 if ($l=~/^ HP-UX/ && !$ok);
157 1147 100       3852 if (!$ok) { $header.= $l; next;} # skip header
  442         2962  
  442         863  
158 705 100       1288 if ($ok<5) {$l=~s/\s+/ /g; }
  56         413  
159 705 100 100     19272 if ($ok ==1) { # os
    100 33        
    100 100        
    100 33        
    100 100        
    100          
    100          
    100          
160 14 100       421 foreach (split(/ /,$l)) { push(@lr, +{ os => $_ }) if ($_); } $ok++;}
  104         379  
  14         40  
161             elsif ($ok == 2) { # osver
162 14 100       75 foreach (split(/ /,$l)) { $lr[$i++]->{osver} = $_ if ($_); } $ok++;}
  104         350  
  14         37  
163             elsif ($ok == 3) { # cc
164 14 100       68 foreach (split(/ /,$l)) { $lr[$i++]->{cc} = $_ if ($_); } $ok++;}
  104         3338  
  14         162  
165             elsif ($ok == 4) { # no smoke
166 14 100 100     83 foreach (split(/ /,$l)) { $lr[$i++]->{smoke} = $_ if ($_ && /^\d*$/); }
  118         2958  
167 14         36 $ok++; $nbI = $i-$origI;
  14         189  
168 14         18 } elsif ($ok == 5) { $ok++; next; } # line of -
  14         30  
169             # line of speed result
170             elsif ($ok >5 && (($l=~/^\d/) or ($l=~/^ \d/))) {
171 30         60 for my $i (0..$nbI) { delete $lr[$origI+$i]; }
  216         566  
172             }
173             # line of result
174             elsif ($ok >5 && ($l=~/^O/ || $l=~/^F/ || $l=~/^m/) && $l ne "Failures:\n") {
175 97         278 chomp($l);
176 97         106 my @l;
177 97         134 $i=0;
178 97         185 while ($i < $nbI) {
179 644 50       3536 ((length($l)>=9*$i) ? push(@l,substr($l,9*$i,9)) : push(@l,' '));
180 644         1091 $i++;
181             }
182 97         111 $i=$origI;
183 97 50       294 my $conf = (length($l)>9*$nbI ? substr($l,9*$nbI) : " ");
184 97 50 66     550 next if ($conf!~/^-/ and $conf!~/^\s*$/);
185 97         165 foreach (@l) {
186 644 100       2401 if (!(/^[ \?\-\.]+$/)) { # really a result
187 386 50       2827 $lr[$i]->{build}{$conf} = $_ if ($_!~m!^\s*$!);
188             }
189 644         1380 $i++;
190             }
191 97         272 $ok++;
192             }
193             # errors
194             elsif ($ok > 6) {
195 448         803 my ($r,%ln)=(0);
196 448         675 foreach my $a (@lr) {
197             # print "Dump:",Data::Dumper->Dump([ $a ]),"\n";
198             # print $a,"\n";
199 3708 0 33     29147 next if (!$a->{os} && !$a->{osver});
200 3708 100       21834 if ($a->{os} =~ /cygwin/i) {
    100          
201 433         1931 $ln{$i++} = $a->{os}." ".substr($a->{osver},0,3);
202             } elsif ($a->{os} =~ /aix/i) {
203 1363         6892 $ln{$i++} = $a->{os}." ".substr($a->{osver},0,3).' '.$a->{cc};
204 1912         23861 } else { $ln{$i++} = $a->{os}." ".$a->{osver}; }
205             }
206 448         19814 foreach my $n (keys %ln) {# print $ln{$n},"\n";
207 3708 100       68248 if ($l=~/^$ln{$n}/i) {
208 114 50       1626 $lr[$n]->{failure}.=$l if ($lr[$n]);
209 114         210 $last{$n}=1;
210 114         252 $r=1; #last;
211             }
212             }
213 448 100       1457 if (!$r) {
214 368 100 100     6857 if ($l=~/^[ \t]+/ && %last) {
215 181         524 foreach (keys %last) {
216 221 50       652 if ($lr[$_]) {
217 221         9958 $lr[$_]->{failure}.=$l;
218 221 50       2803 $lr[$_]->{nbte}++ if $l=~m!^\s!;
219             }
220             }
221 187         1170 } else { undef %last; }
222             }
223             }
224             }
225              
226 4         244 $ok=-1;
227 4         11 foreach my $r (@lr) {
228 53         66 $ok++;
229 53 50 33     195 if (!ref($r) or !$r->{smoke}) { delete $lr[$ok]; next; }
  0         0  
  0         0  
230 53         106 $r->{file}=$file;
231 53         273 $r->{date}=$datee;
232 53         99 $r->{author}='merijn@l1.procura.nl';
233 53         79 $r->{archi}= ' ';
234 53         156 $r->{matrix} = [
235             'PERLIO = stdio',
236             'PERLIO = perlio',
237             'PERLIO = stdio -DDEBUGGING',
238             'PERLIO = perlio -DDEBUGGING'
239             ];
240             # Try to guess cc version
241 53         419 my $name = $r->{os}.' '.$r->{osver};
242 53 100 100     1956 if (!$r->{ccver} && $header=~m/$name[^ ]* \s*([^\n]*)\n/i) {
243 26         67 my $v = $1;
244 26 50       136 if ($v=~/^([^\n]*?\d)\s+(.*)/) {
245 26         66 $r->{ccver} = $1;
246 26 100 66     201 $lr[$ok+1]->{ccver}=$2
247             if ($lr[$ok+1]->{os} && $lr[$ok+1]->{os} eq $r->{os});
248 0         0 } else { $r->{ccver} = $v; }
249             }
250 53 100 100     417 if ($r->{ccver} && $r->{ccver}=~/^(.*?)\s+32-bit$/) {
251 8         18 $r->{ccver} = $1;
252             }
253 53         199 $r->{id} = $r->{smoke}.$ok;
254             }
255 4         13 foreach (@lr) { update_ref($_, 1); }
  53         134  
256 4         246 return @lr;
257             }
258            
259             #------------------------------------------------------------------------------
260             # parse_rpt
261             #------------------------------------------------------------------------------
262             sub parse_rpt($) {
263 14     14 1 51149 my $file = shift;
264 14         41 my ($nbr,$fail,$col,$content)=(0);
265 14 100       143 return if (!$file);
266 13 100       475 if (!-r $file) { warn "Can't found $file"; return; }
  1         31  
  1         7  
267 12 50       555 open(FILE,$file) or die "Can't read $file:$!\n";
268 12         68 my %h = ( file => $file );
269 12         1113 my @content = ;
270 12         235 close(FILE);
271 12         22 my $r = 0;
272             # Rebuild report wrapped by mail to 72c
273 12         19 my $cont;
274 12         21 my $have_result = 0;
275 12         134 foreach my $l (@content) {
276 828         1473 chomp($l);
277 828         13889 $l=~s/=3D/=/g;
278 828         1021 $l=~s/=20$/ /g;
279 828 100       3288 if ($l=~/=$/) { chop($l); $r=1; }
  12         29  
  12         22  
280 828 100       2379 if ($r) { $cont.=$l; $r=0; }
  12         17  
  12         20  
281 816         3542 else { $cont.=$l."\n"; }
282             }
283 12 50       41 return undef if (!$cont);
284 12         27 my $irix = 0;
285 12         95 my $re = qr/(?:O|F|m|M|c|-|t|X|\?)/;
286 12         668 my $reEs = qr/$re /;
287 12         119 my $re4Smoke = qr/$reEs{3,5}$re/;
288 12         277 my $re2Smoke = qr/$re $re/;
289              
290 12         3857 foreach my $l (split(/\n/, $cont)) {
291 764         11855 $content.=$l;
292 764         899 chomp($l);
293 764 50       1698 $nbr++ if ($l=~/^>/);
294             # Author
295 764 100 33     128768 if ($l=~/^From:/) {
    100 100        
    100 100        
    100 100        
    100 100        
    50 66        
    100          
    100          
    50          
    100          
    100          
    100          
    100          
    100          
    50          
    100          
    100          
    100          
    100          
    100          
    100          
296 6 100       38 if ($l=~/Brand/) { $col=-1; }
  2 50       5  
297 0         0 elsif ($l=~/Alian/) { $col=-3; }
298 6 50       71 $h{author} = $1 if $l=~/^From: ([^ ]+\@[^ ]+)/;
299 6 50       41 $h{author} = $1 if $l=~/^From: .* <([^ ]+\@[^ ]+)>/;
300             }
301 3         62 elsif ($l=~/^Return-Path: /) { $col=-1; }
302             # perl version tested
303 7         34 elsif ($l=~/^Subject: Smoke \[([^\]]{5,5})\]/) { $h{version}=$1; }
  10         39  
304             # Date: Sun, 29 Dec 2002 11:13:01
305             elsif ($l=~$date) {$h{date}= $l; }
306             # A reply
307 1         29 elsif ($l=~/^Subject: Re:/) { return -2; }
308             # A report without info about os
309             elsif (($l=~/Automated smoke report for patch (\d+) on - $/) or
310             ($l=~/Automated smoke report for patch (\d*) on - \(\)$/)) {
311 0         0 return -2;
312             }
313             # A normal report with os and osver
314             elsif (($l=~/Automated smoke report for patch (\d+) on (.*) - (.*)$/) or
315             ($l=~/Automated smoke report for .* patch (\d+) on (.*) - (.*)$/)) {
316 7         84 ($h{smoke},$h{os}, $h{osver}) = ($1,$2,$3);
317 7 0 33     35 if (!$h{os} and !$h{osver}) {
318             # print "\tNo os and osver defined in report\n"
319             # if ($self->{opts}->{verbose});
320 0         0 return undef;
321             }
322             }
323             # patchlevel os osver
324             elsif ($l=~/Automated smoke report for patch (\d*) on (.*)$/) {
325 2         16 ($h{smoke},$h{os}, $h{osver}) = ($1,$2,"??");
326 2 50       17 if ($l=~/(irix\d*)$/) { $irix = 1; $h{os}=$1;}
  2         9  
  2         15  
327             }
328             # patchlevel
329             elsif ($l=~/Automated smoke report for patch (\d*)$/) {
330 0         0 ($h{smoke}) = ($1);
331             }
332             elsif ($irix==1) {
333 2         4 $irix=0;
334 2 50       14 $h{osver} = $1 if ($l=~/^ - (.*)$/);
335             }
336              
337             # @20040125: 1.19 style reports
338             elsif ($l=~/Automated smoke report for .* patch (\d+)$/) {
339 2         8 $h{smoke} = $1;
340             }
341             elsif ($l=~m!^.+:\s+.*\((.+)(?:/\d+ cpus?)?\)$!) {
342 29         141 $h{archi} = $1;
343             }
344             elsif ($l=~/^\s+on\s+(.*) - (.*)$/) {
345 2         17 ($h{os}, $h{osver}) = ($1, $2);
346             }
347             elsif ($l=~/^\s+using\s+(.*) version (.*)$/) {
348 2         12 ($h{cc}, $h{ccver}) = ($1, $2);
349             }
350             # End 1.19 style for now
351              
352             # os osver cc ccver
353             elsif ($l=~/on (.*) using (.*) version (.*)$/) {
354 0         0 ($h{os}, $h{cc},$h{ccver},$h{osver}) = ($1,$2,$3,"??");
355             }
356             # ccver
357             elsif ($l=~/using (.*) version (.*)$/) {
358 9         69 ($h{cc}, $h{ccver}) = ($1,$2);
359             }
360             # A line of result (not 5.6.1)
361             elsif (($l=~/^($re4Smoke) +(-.+)$/) || ($l=~/^($re4Smoke)$/)) {
362 70 100 66     1001 next if $1 eq '- - - -' or $1 eq '? ? ? ?';
363 69         91 $have_result = 1;
364 69 100       196 my $c = ( $2 ? $2 : ' ');
365 69         276 $h{"build"}{$c} = $1;
366             }
367              
368             # A line of result (5.6.1)
369             elsif (($l=~/^($re2Smoke) +(-.+)$/) || ($l=~/^($re2Smoke)$/)) {
370 5         8 $have_result = 1;
371 5 100       17 my $c = ( $2 ? $2 : ' ');
372 5         22 $h{"build"}{$c} = $1;
373             }
374              
375             # Matrix
376             elsif (!$fail && $l=~/^[\| ]*\+-+ (.*)$/ && $1!~/^-*$/) {
377 46 50       126 push(@{$h{matrix}}, $1) if ($1 ne 'Configuration');
  46         229  
378             }
379             # Failures
380             elsif ($fail) {
381 226 100       761 $h{"failure"}.=$l."\n" if ($l);
382 226 100       1969 $h{nbte}++ if $l=~m!^\s!;
383             }
384 5         15 elsif ($l=~/Failures(.*):/) { $fail=1; }
385             }
386              
387             # Valid report have os and build and build lines
388 11 50 33     205 if ($h{build} && $h{os}) {
389 11 50       37 @{$h{matrix}}=reverse @{$h{matrix}} if ($h{matrix});
  11         65  
  11         32  
390 11 50 33     191 $h{id}=$1 if (($file=~/(\d+)\.rpt/ or
391             $file=~/(\d+)\.normal\.rpt/));
392 11         65 return update_ref(\%h);
393             }
394             # More than 8 lines beginning with '>', seems to be a reply
395 0 0 0     0 if ($nbr>8) {
    0 0        
396 0         0 warn "$file seems to be a reply\n";
397 0         0 return -2;
398             } elsif (!$have_result && (!$col || $col != -1)) {
399 0         0 return -2;
400             }
401             # elsif ($col && (!$h{os} || !$h{) { warn "$file have no build or os\n"; }
402 0 0       0 return ($col ? $col : undef);
403             }
404              
405             #------------------------------------------------------------------------------
406             # update_ref
407             #------------------------------------------------------------------------------
408             sub update_ref(\%) {
409 64     64 1 112 my $ref = shift;
410 64   100     166 my $mj = shift || 0;
411              
412             # Number of failed test
413 64 100       222 $ref->{nbte} = 0 if (!$ref->{nbte});
414              
415             # Os
416 64         161 $ref->{os} = lc($ref->{os});
417 64 50       619 if ($ref->{os} eq 'WIN32') {
    50          
    100          
    50          
    50          
    50          
    50          
    100          
418 0         0 $ref->{os}='MSWin32';
419             } elsif ($ref->{os}=~m!windows!) {
420 0         0 $ref->{os}='MSWin32';
421             } elsif ($ref->{os}=~/^cygwin/) {
422 3         10 $ref->{os}='cygwin';
423             } elsif ($ref->{os} eq 'red hat linux 8.0') {
424 0         0 $ref->{os}='linux';
425             } elsif ($ref->{os} eq 'osf1') {
426 0         0 $ref->{os}='dec_osf';
427             } elsif ($ref->{os}=~/^sunos/ ) {
428 0         0 $ref->{os}='solaris';
429             } elsif ($ref->{os} eq 'bsd/os') {
430 0         0 $ref->{os}='bsdos';
431             } elsif ($ref->{os} eq 'hpux') {
432 1         4 $ref->{os}='hp-ux';
433             }
434              
435             # Guess if we use gcc
436 64 100 66     1817 my $isgcc = (defined($ref->{cc}) && $ref->{cc}=~/gcc/ ? 1 : 0);
437 64 100 100     1423 $isgcc = 1 if (!$isgcc && $ref->{cc}=~/cc/ && ( $ref->{ccver}=~/^2\.9/ ||
      66        
      66        
438             $ref->{ccver}=~/^3\./));
439 64 50 100     309 $isgcc = 1 if !$isgcc and $ref->{ccver} and $ref->{ccver}=~/^egcs-/;
      66        
440              
441             # cc
442 64 100 100     734 if (!$ref->{cc}) { $ref->{cc}="??"; }
  1 100 100     3  
    100          
    50          
443 1         4 elsif ($isgcc && $ref->{cc}=~m!/([^/]+ .+)$!) { $ref->{cc}=$1; }
444 1         4 elsif ($isgcc && $ref->{cc}=~m!/([^/]+)$!) { $ref->{cc}=$1; }
445 61         189 elsif ($ref->{cc}=~m/^\s?(.*)\s?$/) { $ref->{cc}=$1; }
446              
447             # ccver
448 64 100 66     25742 if (!$ref->{ccver} || $ref->{ccver}=~m!cc: Error:!) {
    100          
449 4 100       13 $ref->{ccver}="??" if !$mj;
450             } elsif ($ref->{ccver} eq 'gcc') {
451 1 50 33     21 $ref->{ccver}='2.95.3' if ($ref->{os} eq 'solaris' &&
      33        
452             ($ref->{osver}=~m'2.7' ||
453             $ref->{osver}=~m'2.8'));
454 1 50       6 $ref->{ccver} = '??' if ( $ref->{ccver} eq 'gcc');
455             } else { # cut of long info about gcc
456 59         135 $ref->{ccver}=~s/3\.2-/3.2./g;
457 59         95 $ref->{ccver}=~s/^egcs-//g;
458 59 100 100     276 $ref->{ccver} = $1 if ($isgcc && $ref->{ccver}=~/^([\d\.]+) /);
459 59         95 $ref->{ccver}=~s/\(prerelease\)//g;
460 59         98 $ref->{ccver}=~s/\(release\)//g;
461             }
462              
463             # print Data::Dumper->Dump([$ref]) if ($ref->{ccver}=~/^gcc/);
464              
465             # cc (2) => Extract ccache info from cc and append it to ccver
466             #if ($isgcc && $ref->{cc}=~/^ccache (.*)/) {
467             # $ref->{cc}="gcc (ccache)";
468             #} else {
469 64 100       261 $ref->{cc} = 'gcc' if $isgcc;
470             #}
471              
472             # Number of configure run
473 64         83 $ref->{nbc} = scalar keys %{$ref->{build}};
  64         263  
474 64         145 $ref->{nbco} = 0;
475              
476             # Try to set the archi
477 64 100 100     364 if ($ref->{osver}=~m!^(.*)\(([^/]{3,10})/.*\)! or $ref->{osver}=~m!^(.*)\(([^\)]{3,10})\)!) {
478 6         16 $ref->{osver} = $1;
479 6         19 $ref->{archi} = $2;
480             # if ($ref->{archi}=~m!^([^-]*)-!) { $ref->{archi} = $1; }
481 6 50 66     69 $ref->{archi} = "i386" if ($ref->{archi}=~/^i.86/ or
      66        
      33        
482             $ref->{archi} eq 'x86' or
483             $ref->{os} eq 'cygwin' or
484             $ref->{os} eq 'mswin32');
485             } else { # set architecture for report before 1.16 of Test-Smoke
486 58 50 33     2608 if ( ($ref->{os} eq 'solaris') or
    50 33        
    50 33        
    100 33        
    100 0        
    100 33        
      66        
      66        
487             ($ref->{os} eq 'NetBSD' and $ref->{osver} eq '1.5.3') or
488             ($ref->{os} eq 'linux' and $ref->{osver} eq '2.2.19')) {
489 0         0 $ref->{archi} ='sparc';
490             } elsif ($ref->{os} eq 'linux' and ( $ref->{osver} eq '2.2.16' or $ref->{osver} eq '2.4.18')) {
491 0         0 $ref->{archi} ='ppc';
492             } elsif ($ref->{os} eq 'dec_osf') {
493 0         0 $ref->{archi} = 'alpha';
494             } elsif ($ref->{os}=~/^irix/ && $ref->{osver}=~/^(.*) (IP\d*)/) {
495 2         5 $ref->{osver}=$1; $ref->{archi}=$2;
  2         6  
496             } elsif ($ref->{os} eq 'aix') {
497 20         47 $ref->{archi} = 'aix';
498             } elsif ($ref->{os}=~/HP-UX/i or $ref->{os}=~/^irix/i) {
499 32         76 $ref->{archi} = ' ';
500 4         13 } else { $ref->{archi}= 'i386'; }
501             }
502              
503             # Os version
504 64 0       197 if (!$ref->{osver}) { $ref->{osver} = ( $ref->{os} eq 'freebsd' ? '4.6-STABLE' : ' ' ); }
  0 50       0  
505 64 50       631 $ref->{osver} = ' ' if ();
506 64 50       1457 $ref->{osver} = $1 if $ref->{osver}=~m!^([^\(]*)!;
507 64 50       394 $ref->{osver} = $1 if $ref->{osver}=~m!^(.*?)\s*$!;
508 64 100       189 $ref->{osver} = $1 if $ref->{osver}=~/^(.*)-\d/;
509 64 50       141 $ref->{osver} = $1.'SP'.$2 if $ref->{osver}=~/^(.*)Service Pack (.*)$/;
510              
511             # perl tested (version) - For report before Test::Smoke 1.17
512 64 100 66     204 if (!$ref->{version} || $ref->{version} eq '5.?.?') {
513 57 100 66     2781 if ($ref->{smoke}>17675 && $ref->{smoke}<22318) {
    50 33        
    50          
514 49         205 $ref->{version} = '5.9.0';
515             } elsif ($ref->{smoke}>17675 && $ref->{smoke}<22523) {
516 0         0 $ref->{version} = '5.9.1';
517             } elsif ($ref->{smoke}>17675) {
518 0         0 $ref->{version} = '5.9.2';
519 8         25 } else { $ref->{version} = '5.8.0'; }
520             }
521              
522             # date: rewrite it for mysql
523 64 100 66     2097 if ($ref->{date} && $ref->{date}=~$date) { # 1997-10-04 22:23:00
524 54         1585 $ref->{date}= sprintf("%4d-%02d-%02d %s",$3, $month{$2}, $1, $4);
525             } else {
526             # print STDERR "bad date for ",Data::Dumper->Dump( [$ref] )
527             # if ($self->{opts}->{debug});
528             }
529              
530             # os
531 64 100       168 if ($ref->{author}) {
532 59 50 66     2003 if ($ref->{author}=~/^jhi/) {
    100          
    100          
    50          
    50          
    50          
    100          
533 0         0 $ref->{author} = 'jhi@cc.hut.fi';
534             } elsif ($ref->{author}=~/^alian/ || $ref->{author}=~/^alb\@/) {
535 1         4 $ref->{author} = 'alian@cpan.org';
536             } elsif ($ref->{author}=~/^abeltje/i) {
537 1         5 $ref->{author} = 'abe@ztreet.demon.nl';
538             } elsif ($ref->{author}=~/^nwc10\@/) {
539 0         0 $ref->{author} = 'nick@ccl4.org';
540             } elsif ($ref->{author}=~/^kane\@/) {
541 0         0 $ref->{author} = 'kane@cpan.org';
542             } elsif ($ref->{author}=~/\@marimba.nl$/) {
543 0         0 $ref->{author} = 'obsd33-smoke58x@marimba.nl';
544             } elsif ($ref->{author}=~/^h\.m\.brand/) {
545 2         6 $ref->{author} = 'merijn@l1.procura.nl';
546             }
547             }
548              
549             # remove -Uuseperlio for blead
550 64 100 66     463 if ($ref->{version} =~/^5\.9/ && $ref->{build}) {
551 53 100       141 delete $ref->{build}{'-Uuseperlio'} if ($ref->{build}{'-Uuseperlio'});
552             }
553              
554 64         1126 return $ref;
555             }
556              
557             __END__