|
1 #! /usr/perl5/bin/perl -w |
|
2 |
|
3 # |
|
4 # Copyright 2008 Sun Microsystems, Inc. All rights reserved. |
|
5 # Use is subject to license terms. |
|
6 # |
|
7 # Permission is hereby granted, free of charge, to any person obtaining a |
|
8 # copy of this software and associated documentation files (the |
|
9 # "Software"), to deal in the Software without restriction, including |
|
10 # without limitation the rights to use, copy, modify, merge, publish, |
|
11 # distribute, and/or sell copies of the Software, and to permit persons |
|
12 # to whom the Software is furnished to do so, provided that the above |
|
13 # copyright notice(s) and this permission notice appear in all copies of |
|
14 # the Software and that both the above copyright notice(s) and this |
|
15 # permission notice appear in supporting documentation. |
|
16 # |
|
17 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS |
|
18 # OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF |
|
19 # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT |
|
20 # OF THIRD PARTY RIGHTS. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR |
|
21 # HOLDERS INCLUDED IN THIS NOTICE BE LIABLE FOR ANY CLAIM, OR ANY SPECIAL |
|
22 # INDIRECT OR CONSEQUENTIAL DAMAGES, OR ANY DAMAGES WHATSOEVER RESULTING |
|
23 # FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, |
|
24 # NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION |
|
25 # WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. |
|
26 # |
|
27 # Except as contained in this notice, the name of a copyright holder |
|
28 # shall not be used in advertising or otherwise to promote the sale, use |
|
29 # or other dealings in this Software without prior written authorization |
|
30 # of the copyright holder. |
|
31 # |
|
32 # ident "@(#)find-build-errors 1.1 08/08/07 SMI" |
|
33 # |
|
34 |
|
35 require 5.005; # minimal Perl version required |
|
36 use strict; # |
|
37 use diagnostics; # |
|
38 use File::Spec; # pathname manipulation routines |
|
39 use File::stat; # Named results from stat() function |
|
40 use English qw( -nomatchvars ); |
|
41 |
|
42 my $default_logfile = 'buildit-XW'; |
|
43 my $default_logpath = 'log/' . $default_logfile; |
|
44 my $default_pkglogpath = 'proto-packages/logs/package_build'; |
|
45 my $logfile; |
|
46 my $pkglog; |
|
47 my $pkgfailed; |
|
48 |
|
49 if (defined $ARGV[0]) { |
|
50 if (-d $ARGV[0]) { |
|
51 $logfile = $ARGV[0] . '/' . $default_logpath; |
|
52 } elsif ($ARGV[0] =~ m{/package_build$}ms) { |
|
53 $pkglog = $ARGV[0]; |
|
54 } else { |
|
55 $logfile = $ARGV[0]; |
|
56 } |
|
57 } elsif ( -f $default_logfile ) { |
|
58 $logfile = $default_logfile; |
|
59 } elsif ( -f $default_logpath ) { |
|
60 $logfile = $default_logpath; |
|
61 } else { |
|
62 my @dirtree = File::Spec->splitdir( |
|
63 File::Spec->rel2abs(File::Spec->curdir())); |
|
64 |
|
65 # climb the tree, removing one parent at a time to find the logfile |
|
66 while (scalar(@dirtree) > 0) { |
|
67 $logfile = File::Spec->catfile( @dirtree, $default_logpath); |
|
68 last if ( -f $logfile); |
|
69 # print "$logfile not found\n"; |
|
70 pop @dirtree; |
|
71 } |
|
72 |
|
73 if (scalar(@dirtree) == 0) { |
|
74 die "$default_logfile not found, please specify path to log\n"; |
|
75 } |
|
76 } |
|
77 |
|
78 if (defined $logfile) { |
|
79 open my $LOGFILE, '<', $logfile |
|
80 or die "Can't open '$logfile': $OS_ERROR"; |
|
81 |
|
82 print "Scanning $logfile for error messages...\n\n"; |
|
83 |
|
84 my @steplines; |
|
85 my $found_error = 0; |
|
86 |
|
87 while (my $l = <$LOGFILE>) { |
|
88 # Finished if we see the end line |
|
89 last if $l =~ m{Finished building the X Window System Consolidation}ms; |
|
90 |
|
91 # Clear saved lines for each new module/subdir |
|
92 if (($l =~ m{^\#\# making \S+ in \S+\.\.\.$}ms) || # open-src pattern |
|
93 ($l =~ m{^\S+ing( \S+)* in \S+\.\.\.$}ms)) { # xc pattern |
|
94 @steplines = (); |
|
95 $found_error = 0; |
|
96 } |
|
97 |
|
98 # If we already hit an error, skip the rest of this module |
|
99 next if ($found_error != 0); |
|
100 |
|
101 # Add this line to the saved output, combine with previous if previous |
|
102 # ended with an \ |
|
103 if (($#steplines >= 0) && ($steplines[$#steplines] =~ m{\\\Z}ms)) { |
|
104 $steplines[$#steplines] .= $l; |
|
105 } else { |
|
106 push @steplines, $l; |
|
107 } |
|
108 |
|
109 # Skip ahead to next line if this line ends with \ |
|
110 next if ($l =~ m{\\\Z}ms); |
|
111 |
|
112 # Found a new error? |
|
113 if ($l =~ m{\*\*\* }ms) { |
|
114 $found_error = 1; |
|
115 |
|
116 # Print section header |
|
117 print $steplines[0], "\n"; |
|
118 |
|
119 my $lastmake; |
|
120 my $lastcommand = 1; |
|
121 my $lastplus = 0; |
|
122 |
|
123 # scan back to figure out how far back to print |
|
124 for my $ln (1..($#steplines - 1)) { |
|
125 my $sl = $steplines[$ln]; |
|
126 |
|
127 # print "lastmake: $lastmake, lastcom: $lastcommand, lastplus: $lastplus, line #$ln: $sl\n"; |
|
128 if ($sl =~ m{\b(make|gmake)\b}ms) { |
|
129 $lastmake = $ln; |
|
130 } |
|
131 |
|
132 if ($sl =~ m{\breturned\b}ms) { |
|
133 # don't treat this as a command |
|
134 } elsif ($sl =~ m{\b(cc|gcc|CC|g\+\+|ld|gpatch|libtool)\s+}ms) { |
|
135 if ($sl !~ m{usage:}) { |
|
136 $lastcommand = $ln; |
|
137 } |
|
138 } elsif ($sl =~ m{^\+ }ms) { |
|
139 # print from start of shell's set -x output, not end |
|
140 if ($lastplus != ($ln - 1)) { |
|
141 $lastcommand = $ln; |
|
142 } |
|
143 $lastplus = $ln; |
|
144 } elsif ($lastplus == ($ln - 1)) { |
|
145 $lastcommand = $ln; |
|
146 } |
|
147 } |
|
148 |
|
149 # print "lastmake: $lastmake, lastcommand: $lastcommand\n"; |
|
150 if ($lastmake && ($lastmake < $lastcommand)) { |
|
151 print $steplines[$lastmake]; |
|
152 } |
|
153 |
|
154 for my $ln ($lastcommand..$#steplines) { |
|
155 print $steplines[$ln]; |
|
156 } |
|
157 print "\n", '-'x78, "\n"; |
|
158 } |
|
159 } |
|
160 |
|
161 my $printme = 0; |
|
162 |
|
163 # end of file stuff |
|
164 while (my $l = <$LOGFILE>) { |
|
165 if ($l =~ m{^Runtime: }) { |
|
166 print $l; |
|
167 next; |
|
168 } |
|
169 |
|
170 # Look for package build results |
|
171 if ($l =~ m{^result log is in (.*/package_build)$}ms) { |
|
172 $pkglog = $1; |
|
173 } elsif ($l =~ m{^Packages built:}ms) { |
|
174 print $l; |
|
175 } elsif ($l =~ m{^Packages failed:\s+(\d+)}ms) { |
|
176 $pkgfailed = $1; |
|
177 print $l; |
|
178 } |
|
179 # print lines where messages about COPYING file errors appear |
|
180 # between "Copying package descriptions" & "Building packages" |
|
181 elsif ($l =~ m{Copying package descriptions}) { |
|
182 $printme = 1; |
|
183 } elsif ($l =~ m{Building packages}) { |
|
184 $printme = 0; |
|
185 } |
|
186 elsif ($printme == 1) { |
|
187 print $l; |
|
188 } |
|
189 } |
|
190 |
|
191 close($LOGFILE); |
|
192 } |
|
193 |
|
194 sub check_pkglog { |
|
195 my ($pl) = @_; |
|
196 |
|
197 if ( -f $pl ) { |
|
198 my $logfile_sb = stat($logfile); |
|
199 my $pkglog_sb = stat($pl); |
|
200 |
|
201 if ($logfile_sb > $pkglog_sb) { |
|
202 # Haven't rebuilt packages since last build, so no point reporting errors |
|
203 undef $pl; |
|
204 } |
|
205 } else { |
|
206 undef $pl; |
|
207 } |
|
208 |
|
209 return $pl; |
|
210 } |
|
211 |
|
212 # No packaging log found in build log, try to guess where it is |
|
213 if (!defined($pkglog)) { |
|
214 my $path_to_check = $logfile; |
|
215 $path_to_check =~ s{$default_logpath}{$default_pkglogpath}ms; |
|
216 |
|
217 $pkglog = check_pkglog($path_to_check); |
|
218 |
|
219 if (!defined($pkglog)) { |
|
220 $path_to_check = $logfile; |
|
221 $path_to_check =~ s{($default_logpath).*$}{$default_pkglogpath}ms; |
|
222 |
|
223 $pkglog = check_pkglog($path_to_check); |
|
224 } |
|
225 } |
|
226 |
|
227 if ((!defined($pkgfailed) || ($pkgfailed > 0)) && defined($pkglog)) { |
|
228 open my $PKGLOG, '<', $pkglog |
|
229 or die "Can't open '$pkglog': $OS_ERROR"; |
|
230 |
|
231 my @pkglines; |
|
232 |
|
233 while (my $l = <$PKGLOG>) { |
|
234 # Clear saved lines for each new package |
|
235 if ($l =~ m{^[*]+ Making the \S+ package [*]+$}ms) { |
|
236 @pkglines = (); |
|
237 } |
|
238 |
|
239 if ($l =~ m{Packaging was not successful.}ms) { |
|
240 print join('', @pkglines); |
|
241 } else { |
|
242 push @pkglines, $l; |
|
243 } |
|
244 } |
|
245 |
|
246 close($PKGLOG); |
|
247 } |