/[gentoo-perl]/genlop/trunk/genlop
Gentoo

Contents of /genlop/trunk/genlop

Parent Directory Parent Directory | Revision Log Revision Log


Revision 167 - (show annotations) (download)
Mon Apr 2 11:53:31 2007 UTC (11 years, 6 months ago) by mcummings
File size: 31768 byte(s)
Bug 120405, patch for appropriate display of seconds timestamp

1 #!/usr/bin/perl -w
2 #
3 # $Id: genlop,v 1.21 2005/08/16 23:50:32 antonio Exp $
4 #
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 2 of the License, or
8 # (at your option) any later version.
9 #
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18 #
19 # genlop-0.30.5 Copyright 2004 Giorgio Mandolfo <giorgio@pollycoke.org>
20 #
21
22 #use strict;
23 use POSIX;
24 use Term::ANSIColor;
25 use Date::Manip;
26
27 my $version = "0.30.4";
28 my @logfiles = ("/var/log/emerge.log");
29 my %COLORS = (
30 'blue' => 'bold blue',
31 'green' => 'bold green',
32 'red' => 'bold red',
33 );
34 my ($e_count, $w_count, $tm_secondi) = (0, 0, 0);
35 # variabili per la funzione parse
36 my (
37 $search_found, $unmerge_found, $list_found, $file_found,
38 $time_found, $help_found, $current_found, $pretend_found,
39 $version_found, $info_found, $gmt_found, $rsync_found,
40 $info_ok, $info_target, $ssearch_found
41 );
42 # variabili globali del programma
43 my ($e_start, $e_end, $search_string, $m_count, $ebuild_found);
44 # variabili di datecompare
45 my ($fh, $elog);
46 my @targets;
47 my $progname = $0;
48 $progname =~ s!.*/!!;
49
50 my ($userdate1, $userdate2, $searchdate1, $searchdate2);
51
52 sub datecompare ($) {
53 # datecompare( epoch )
54 # returns -1 if epoch is outside searchdates 1 and 2
55 # returns 1 if inside
56 # returns undefined for errors
57 # expects searchdate1 to be before searchdate2 and neither should be in
58 # the future (but it's probably ok if searchdate2 is)
59 die if (!$searchdate1);
60 die if (!$searchdate2);
61 my $epochdate = $_[0];
62 if (($epochdate <=> $searchdate1) < 0) {
63 # epoch is outside period
64 return -1;
65 } elsif (($epochdate <=> $searchdate2) > 0) {
66 # epoch is outside period
67 return -1;
68 } else {
69 return 1;
70 }
71 #TODO check that it's actually the case
72 }
73
74 # test a file, before opening it for reading
75 # second argument is a reference to a variable thet gets populated with
76 # a filehandle to the first argument
77 sub open_file {
78 my ($file, $fh) = @_;
79 if ($file eq "/var/log/emerge.log" && !-r $file) {
80 print "$progname: cannot open ".$file
81 ." for reading\n"
82 ."maybe you are not a member of the portage group ?\n"
83 ."try genlop -h for help\n";
84 exit 1;
85 }
86 if (-T $file) {
87 open $$fh, "< $file"
88 or die "could not open $file";
89 return 0;
90 }
91 # if we got here file is unreadable, might simply be compressed...
92 # let's try this
93 my $nature = qx{file $file}
94 or die "could not determine nature of (nonASCII) $file";
95 if ($nature =~ /gzip/) {
96 open $$fh, "gzip -d -c $file |"
97 or die "could not open (gzipped) $file";
98 return 0;
99 } elsif ($nature =~ /bzip/) {
100 open $$fh, "bzip2 -d -c $file |"
101 or die "could not open (bzipped) $file";
102 return 0;
103 } else {
104 # giving up...
105 print "could not determine file type of $file\n";
106 exit 1;
107 }
108 }
109
110 # orderes logfiles by date
111 sub order_logs (@) {
112 my @files = @_;
113 my %ordered;
114 foreach my $logfile (@files) {
115 my $handle;
116 open_file("$logfile", \$handle);
117 my $fline = <$handle>; # first line
118 $ordered{$logfile} = (split /:/, $fline)[0];
119 }
120 return sort { $ordered{$a} <=> $ordered{$b} } keys %ordered;
121 }
122
123 # parse(arg), a hacked-up version of getopts
124 # sets (global) variables for options and returns.
125 # non option arguments are pushed into a (global) array
126 #
127 # FIXME Getopt::Long would be much better
128 sub parse ($) {
129 my $arg = $_[0];
130 my $nexist = 0;
131 chomp $arg;
132 # long (--foo) options
133 if ($arg =~ /^--/) {
134 LSWITCH: {
135 $current_found = 1, last LSWITCH if ($arg eq "--current");
136 $pretend_found = 1, last LSWITCH if ($arg eq "--pretend");
137 $help_found = 1, last LSWITCH if ($arg eq "--help");
138 $time_found = 1, last LSWITCH if ($arg eq "--time");
139 $unmerge_found = 1, last LSWITCH if ($arg eq "--unmerge");
140 $ENV{'ANSI_COLORS_DISABLED'} = 1, last LSWITCH
141 if ($arg eq "--nocolor");
142 $list_found = 1, last LSWITCH if ($arg eq "--list");
143 $version_found = 1, last LSWITCH if ($arg eq "--version");
144 $search_found = 1, last LSWITCH if ($arg eq "--search");
145 $info_found = 1, last LSWITCH if ($arg eq "--info");
146 $gmt_found = 1, last LSWITCH if ($arg eq "--gmt");
147 $rsync_found = 1, last LSWITCH if ($arg eq "--rsync");
148
149 if ($arg eq "--date") {
150 $date_found = 1;
151 if (!$userdate1) {
152 help() if !$ARGV[0];
153 $userdate1 = ParseDate(\@ARGV);
154 unless (UnixDate($userdate1, "%s")) {
155 print color 'bold red';
156 print "!!! Error:",
157 " invalid date format (try mm/dd/yyyy)";
158 print color 'reset';
159 print "\n";
160 exit -1;
161 }
162 if ((UnixDate($userdate1, "%s") <=> time) <= 0) {
163 $searchdate1 = UnixDate($userdate1, "%s");
164 $searchdate2 = time;
165 } else {
166 die "Date $userdate1 is in the future, not good\n";
167 }
168 } elsif (!$userdate2) {
169 $userdate2 = ParseDate(\@ARGV);
170 unless (UnixDate($userdate2, "%s")) {
171 print color 'bold red';
172 print "!!! Error:",
173 " invalid date format (try mm/dd/yyyy)";
174 print color 'reset';
175 print "\n";
176 exit -1;
177 }
178 if (
179 (
180 UnixDate($userdate1, "%s")
181 <=> UnixDate($userdate2, "%s")
182 ) <= 0
183 )
184 {
185 $searchdate2 = UnixDate($userdate2, "%s");
186 } else {
187 $searchdate2 = $searchdate1;
188 $searchdate1 = UnixDate($userdate2, "%s");
189 }
190 } else {
191 print "too many --date arguments ?\n";
192 die;
193 }
194 last LSWITCH;
195 }
196 $nexist = $arg;
197 } # END LSWITCH
198 if ($nexist) {
199 # This is the standard error message
200 print color 'bold red';
201 print "!!! Error: $nexist, invalid option.";
202 print color 'reset';
203 print "\n";
204 exit -1;
205 }
206 return 0;
207 }
208 # short bsd-style options
209 if ($arg =~ /^-.*/) {
210 until ($arg eq "-") {
211 my $opt = chop($arg);
212 SSWITCH: {
213 $help_found = 1, last SSWITCH if ($opt eq "h");
214 $help_found = 1, last SSWITCH if ($opt eq "?");
215 $time_found = 1, last SSWITCH if ($opt eq "t");
216 $unmerge_found = 1, last SSWITCH if ($opt eq "u");
217 $ENV{'ANSI_COLORS_DISABLED'} = 1, last SSWITCH if ($opt eq "n");
218 $list_found = 1, last SSWITCH if ($opt eq "l");
219 $search_found = 1, last SSWITCH if ($opt eq "s");
220 $version_found = 1, last SSWITCH if ($opt eq "v");
221 $info_found = 1, last SSWITCH if ($opt eq "i");
222 $ssearch_found = 1, last SSWITCH
223 if ($opt eq "S");
224 $current_found = 1, last SSWITCH if ($opt eq "c");
225 $pretend_found = 1, last SSWITCH if ($opt eq "p");
226 $rsync_found = 1, last SSWITCH if ($opt eq "r");
227 $gmt_found = 1, last SSWITCH if ($opt eq "g");
228 $ebuild_found = 1, last SSWITCH if ($opt eq "e");
229
230 if ($opt eq "f") {
231 if (!$ARGV[0]) {
232 print color 'bold red';
233 print "!!! Error: no logfile specified.";
234 print color 'reset';
235 print "\n";
236 exit -1;
237 }
238 if (!-r $ARGV[0]) {
239 print color 'bold red';
240 print "!!! Error: logfile ".$ARGV[0]." not readable ",
241 "or not found.";
242 print color 'reset';
243 print "\n";
244 exit -1;
245 }
246 print "using logfile ".$ARGV[0]."\n";
247 if (!$file_found) {
248 $logfiles[0] = shift @ARGV;
249 $file_found = 1;
250 } else {
251 push @logfiles, shift(@ARGV);
252 }
253 last SSWITCH;
254 }
255 $nexist = $opt;
256 } # END SSWITCH
257 }
258 if ($nexist) {
259 print color 'bold red';
260 print "!!! Error: \-$nexist, invalid option.";
261 print color 'reset';
262 print "\n";
263 exit -1;
264 }
265 return 0;
266 }
267 push @targets, $arg;
268 return 0;
269 }
270
271 # provides help information
272 sub help () {
273 print "Usage: ", colored("genlop ", $COLORS{'blue'}), "[",
274 colored("options", $COLORS{'green'}), "] [",
275 colored("-f ", $COLORS{'green'}), "logfile] [",
276 colored("category/package", $COLORS{'green'}), "]\n\n",
277 colored("Options:\n", $COLORS{'green'}),
278 colored(" -c ", $COLORS{'green'}),
279 "display the currently compiling packages (if any)\n",
280 colored(" -e ", $COLORS{'green'})
281 ."display package history; default if any option is used.\n",
282 colored(" -f ", $COLORS{'green'}),
283 "read emerge log information from \"logfile\" instead of ", $logfiles[0],
284 "\n", colored(" -h ", $COLORS{'green'}), "print this help\n",
285 colored(" -i ", $COLORS{'green'}),
286 "extra infos for the selected package (build specific USE ",
287 "and CFLAGS\n variables, average build time, etc)\n",
288 colored(" -g ", $COLORS{'green'}),
289 "display GMT/UTC, not localized time.\n",
290 colored(" -l ", $COLORS{'green'}), "show full merge history.\n",
291 colored(" -n ", $COLORS{'green'}), "no color in output\n",
292 colored(" -p ", $COLORS{'green'}),
293 "estimate build time from a piped \"emerge -p\" output\n",
294 colored(" -r ", $COLORS{'green'}),
295 "search for portage tree sync/rsync history.\n",
296 colored(" -s ", $COLORS{'green'}),
297 "use (case insensitive) regular expressions to match package names\n",
298 colored(" -S ", $COLORS{'green'}),
299 "use case sensitive regular expressions to match package names\n",
300 colored(" -t ", $COLORS{'green'}),
301 "calculate merge time for the specific package(s).\n",
302 colored(" -u ", $COLORS{'green'}),
303 "show when packages have been unmerged.\n",
304 colored(" -v ", $COLORS{'green'}),
305 "display genlop version and exit.\n\n",
306 colored(" --date datestring1", $COLORS{'green'}), " [",
307 colored("datestring2", $COLORS{'green'}),
308 "] only shows results between datestring1\n",
309 " and datestring2. datestring2 dafaults to \"now\" if not",
310 " explicitly set.\n", " (e.g. genlop --list --date 3 days ago)\n",
311 "\nThis program is licensed under the GPL v2. See COPYING.\n",
312 "For further info about genlop please read the man page.\n";
313 exit 0;
314 }
315
316 sub gtime($) {
317 my $gtime = $_[0];
318 chomp($gtime);
319 $secs = $gtime % 60;
320 $gtime = ($gtime - $secs) / 60;
321 $mins = $gtime % 60;
322 $gtime = ($gtime - $mins) / 60;
323 $hours = $gtime % 24;
324 $gtime = ($gtime - $hours) / 24;
325 $days = $gtime % 7;
326 if ($gtime < 0) {
327 $gtime = 0;
328 }
329 }
330
331 sub print_gtime() {
332 if ($days > 0) {
333 print colored("$days", $COLORS{'green'}), " day";
334 print "s" if ($days > 1);
335 }
336 if ($hours > 0) {
337 print ", " if ($days > 0);
338 print colored("$hours", $COLORS{'green'}), " hour";
339 print "s" if ($hours > 1);
340 print ", ";
341 }
342 if ($mins > 0) {
343 print ", " if ($days > 0 or $hours > 0);
344 print colored("$mins", $COLORS{'green'}), " minute";
345 print "s" if ($mins > 1);
346 }
347 if ($mins < 1 && $hours < 1 && $days < 1 && $secs > 0 && $current_found) {
348 print colored("less than a minute", $COLORS{'green'});
349 } elsif ($mins < 1 && $hours < 1 && $days < 1 && $secs > 0 && $pretend_found) {
350 print colored("less than a minute", $COLORS{'green'});
351 } elsif ($secs > 0 && !$pretend_found) {
352 print " and " if ($days > 0 or $hours > 0 or $mins > 0);
353 print colored("$secs", $COLORS{'green'}), " second";
354 print "s" if ($secs > 1);
355 }
356 print ".";
357 }
358
359 sub gen_regexp ($) {
360 # generates the correct regexp depending on what the user asked us.
361 # default is to search only the correct package name (eg. mozilla)
362 # a different regexp is needed in the following cases:
363 # argument is in the form category/
364 # argument is in the form category/ebuild
365 # argument is in the form category/ebuild-version
366 # the user can provide his own regular expression(s) via the -s option
367 my $arg = $_[0];
368 my ($category, $ebuild, $version);
369 my $regexp;
370 my @list;
371
372 if ($list_found) {
373 $regexp = qr/(.*)(-[0-9]{1,7}.*?)/i;
374 return "$regexp";
375 }
376 if ($search_found) {
377 # return user supplied regexp as-is
378 $regexp =
379 $ssearch_found
380 ? qr/(.*$arg.*?)(-[0-9]{1,7}.*?)/
381 : qr/(.*$arg.*?)(-[0-9]{1,7}.*?)/i;
382 return "$regexp";
383 }
384 # check if we were asked only the category
385 if ($arg =~ /.*?\/$/) {
386 $category = $arg;
387 $regexp =
388 $ssearch_found
389 ? qr/($category.*?)(-[0-9]{1,7}.*?)/
390 : qr/($category.*?)(-[0-9]{1,7}.*?)/i;
391 return "$regexp";
392 }
393 @list = split(/\//, $arg);
394 $ebuild = $list[0];
395 if ($list[1]) {
396 $category = $list[0];
397 $ebuild = $list[1];
398 @list = ();
399 @list = split(/(-[0-9]{1,7})/, $ebuild);
400 if ($list[1]) {
401 $ebuild = $list[0];
402 $version = $list[2] ? join('', $list[1], $list[2]) : $list[1];
403 $regexp =
404 $ssearch_found
405 ? qr!($category\/$ebuild)($version)!
406 : qr!($category\/$ebuild)($version)!i;
407 return "$regexp";
408 }
409 $regexp =
410 $ssearch_found
411 ? qr!($category\/$ebuild)(-[0-9]{1,7}.*?)!
412 : qr!($category\/$ebuild)(-[0-9]{1,7}.*?)!i;
413 return "$regexp";
414 }
415 $regexp =
416 $ssearch_found
417 ? qr!(.*?/$ebuild)(-[0-9]{1,7}.*?)!
418 : qr!(.*?/$ebuild)(-[0-9]{1,7}.*?)!i;
419 return "$regexp";
420 }
421
422 # --pretend or -p takes an emerge -p `-e -D world, system`, anything you want
423 # and elaborates its output. for each package is calculated the average build
424 # time and summed together. this is the estimated merge time
425 sub pretend() {
426 if ($pretend_found) {
427 @targets = ();
428 print "These are the pretended packages:";
429 print " (this may take a while; wait...)\n\n";
430 # open STDIN; that's why emerge -p foo is piped to a genlop -p
431 while (<STDIN>) {
432 if ($_ =~ m/^\[e.*\] (.*?)\/(.*?)(\-[0-9])/) {
433 push @targets, $2;
434 print;
435 }
436 }
437 foreach $ebuild_arg (@targets) {
438 # we track the last ebuild processed with $last_ebuild variable
439 $last_ebuild = $ebuild_arg;
440 $ebuild_arg =~ s/(\+)/\\$1/g;
441 foreach my $logfile (@logfiles) {
442 my $handle;
443 open_file($logfile, \$handle);
444 foreach (<$handle>) {
445 if (m/^(.*?)\: \>\>\> emerge.*?\/$ebuild_arg-[0-9].*/) {
446 $e_start = $1;
447 }
448 if (m/^(.*?)\: ::: completed .*?\) .*\/$ebuild_arg-[0-9].* to \//)
449 {
450 $e_end = $1;
451 $tm_secondi += ($e_end - $e_start);
452 $e_count++;
453 }
454 }
455 }
456 if ($e_count == 0) {
457 $ebuild_arg =~ s/\\//g;
458 print "\n!!! Error: couldn't get previous ",
459 "merge of $ebuild_arg; skipping...";
460 # if a pretended package haven't any successfull merge
461 # stored in logfile (ie a new package required by
462 # another, or a logfile corruption), prints a warning
463 # and keep track with $last_skipped
464 $last_skipped = $ebuild_arg;
465 } else {
466 $m_secondi += $tm_secondi / ($e_count);
467 $e_count = 0;
468 $tm_secondi = 0;
469 $last_skipped = "none-skipped";
470 }
471 }
472 if (@targets) {
473 if ($last_ebuild =~ m/$last_skipped/) {
474 print color 'bold red';
475 print "\n!!! Error: $last_skipped never merged; ",
476 "estimated time unknown.";
477 print color 'reset';
478 print "\n";
479 exit;
480 }
481 print "\n\nEstimated update time: ";
482 &gtime($m_secondi);
483 &print_gtime;
484 print "\n";
485 } else {
486 print color 'bold red';
487 print "\n!!! Error: no pretended packages found.";
488 print color 'reset';
489 print "\n";
490 }
491 exit;
492 }
493 }
494
495 sub current() {
496 # support for 'current' merge.
497 #
498 # this whole 'current' thing is based on having sandboxind enabled
499 # we need to check for it, basically sandboxing is on if
500 # FEATURES contains 'sandbox' and does not contain 'userpriv'
501 # FEATURES contains 'sandbox' and contains both 'userpriv' and 'usersandbox'
502 # 20050815 - JeR: On slow systems, running portageq takes a lot of time,
503 # sometimes enough to miss all the sandbox action completely. Better to
504 # not check for sanity and have users check their FEATURES instead.
505 my @targets = ();
506 my @sandbox_pids = qx{ps --no-header -o pid -C sandbox};
507 if (scalar @sandbox_pids == 0) {
508 print colored("!!!", $COLORS{'red'});
509 print " Error: no working merge found.\n";
510 print "(the -c option only works if there is"
511 ." an ongoing compilation, see manpage)\n";
512 exit;
513 }
514 foreach my $pid (@sandbox_pids) {
515 chomp $pid;
516 $pid =~ s/\s//g;
517 open(my $cmdline, "/proc/$pid/cmdline");
518 while (<$cmdline>) {
519 if ($_ =~ m/^\[(.*?)\-[0-9].*?\]/g) {
520 $current = $1;
521 }
522 }
523 push @targets, $current;
524 }
525 if (scalar @targets == 0) {
526 print colored("!!!", $COLORS{'red'});
527 print "oops! should not happen, pease file bug\n";
528 print "empty \@targets\n";
529 exit 1;
530 }
531 foreach $ebuild_arg (@targets) {
532 $ebuild_arg =~ s/(\+)/\\$1/g;
533 foreach my $logfile (@logfiles) {
534 my $handle;
535 open_file($logfile, \$handle);
536 foreach (<$handle>) {
537 if (m/^(.*?)\: \>\>\> emerge .*?\)(.*?\/$ebuild_arg-[0-9].*?)to \//)
538 {
539 $e_start = $1;
540 $e_current = $2;
541 }
542 if (m/^(.*?)\: ::: completed .*?\) .*\/$ebuild_arg-[0-9].* to \//) {
543 $e_end = $1;
544 $e_count++;
545 &gtime($e_end - $e_start);
546 $tm_secondi += ($e_end - $e_start);
547 }
548 }
549 }
550 $e_end = CORE::time();
551 &gtime($e_end - $e_start);
552 print colored("\n \*$e_current\n\n", $COLORS{'blue'});
553 print " current merge time: ";
554 $current_found = undef;
555 &print_gtime();
556 $current_found = 1;
557 print "\n";
558 print " ETA: ";
559
560 if ($e_count && $e_start) {
561 &gtime(($tm_secondi / $e_count) - ($e_end - $e_start));
562 if (($e_end - $e_start) >= ($tm_secondi / $e_count)) {
563 print colored("any time now.\n", $COLORS{'green'});
564 } else {
565 &print_gtime();
566 print "\n";
567 }
568 } else {
569 print color 'bold red';
570 print "unknown.";
571 print color 'reset';
572 print "\n";
573 }
574 }
575 exit;
576 }
577
578 sub info($) {
579 my $package = $_[0];
580 if ($list_found) { &help(); }
581 if ($e_count) { $m_count = $e_count - $w_count; }
582 if ($m_count == 0) {
583 print colored("Total merge time unknown.\n\n", $COLORS{'red'});
584 } else {
585 print "\n Total builds: ", colored("$e_count", $COLORS{'green'});
586 print "\n Global build time: ";
587 &gtime($tm_secondi);
588 &print_gtime();
589 if ($w_count) {
590 print " Global build time of $m_count merges.\n";
591 } else {
592 print "\n";
593 }
594 if ($e_count > 1) {
595 print " Average merge time: ";
596 &gtime($tm_secondi / $m_count);
597 &print_gtime();
598 print "\n";
599 }
600 $e_count = 0;
601 $tm_secondi = 0;
602 #$gtime = 0;
603 }
604 $e_count = 0;
605 print "\n Info about currently installed ebuild:\n";
606 opendir(DIR, "/var/db/pkg/") || die "can't open /var/db/pkg/ $!\n";
607 while (defined($categoria = readdir(DIR))) {
608 if ($package =~ m/^$categoria.*/g) {
609 opendir(DIR2, "/var/db/pkg/$categoria");
610 while (defined($package_dir = readdir(DIR2))) {
611 #$package =~ s/(\+)/\\$1/g;
612 $tmp_package = $package;
613 $tmp_package =~ s/\+/\\+/g;
614 if ("$categoria/$package_dir" =~ m/$tmp_package\-[0-9].*/) {
615 $info_ok = 1;
616 print colored("\n * $categoria/$package_dir\n",
617 $COLORS{'blue'});
618 $package_dir =~ s/(\+)/\\$1/g;
619 #foreach $_ (@logfile_cache) {
620 foreach my $logfile (@logfiles) {
621 my $handle;
622 open_file($logfile, \$handle);
623 foreach (<$handle>) {
624 my $pattern = gen_regexp("$categoria/$package_dir");
625 if ( m/^([0-9]{10})\: ::: completed .*?\) $pattern to \//) {
626 if ($gmt_found) {
627 $e_date = scalar gmtime "$1";
628 } else {
629 $e_date = scalar localtime "$1";
630 }
631 }
632 }
633 }
634 print " Install date: ";
635 print colored("$e_date\n", $COLORS{'green'});
636 # we use 3 array to collect data: before processing they are
637 # @unused_use: contain packages' USEs
638 # @pkg_use: USE declared before compiling that package
639 # @used_use: empty
640 my (@potential_use, @pkg_use, @used_use, @unused_use);
641 # each installed package store its information here
642 my $db_pkg_dir = "/var/db/pkg/$categoria/$package_dir/";
643 if ("$categoria/$package_dir" =~ m/.*\/(.*)/g) {
644 # we search into the installed ebuild for USE flags available
645 # and store them in @potential_use.
646 open(pkg_ebuild, "$db_pkg_dir/$1.ebuild") || return;
647 while (<pkg_ebuild>) {
648 if ($_ =~ m/^IUSE=\"(\$\{IUSE\} )?(.*)"/g) {
649 @potential_use = split(/\ /, $2);
650 }
651 }
652 }
653 # this file lists every USE flag defined, even ones in make.conf
654 # we push'em in @pkg_use
655 open(pkg_use, "$db_pkg_dir/USE") || return;
656 while (<pkg_use>) {
657 @pkg_use = split(/\ /, $_);
658 }
659 # for every possible package USE we search into USEs stored in @pkg_use
660 # if a match is found we move it from @potential_use in @used_use.
661 # in this way, when every possible package USE are processed, @used_use
662 # contain only used ones and @potential_use the not used ones.
663 USE: foreach my $use (@potential_use) {
664 chomp($use);
665 foreach my $pkg (@pkg_use) {
666 chomp($pkg);
667 if ($use eq $pkg) {
668 push(@used_use, $use);
669 next USE;
670 }
671 }
672 push(@unused_use, $use);
673 }
674 # finally we print'em out
675 print " USE=\"", colored("@used_use", $COLORS{'red'});
676 foreach $unused (@unused_use) {
677 print colored(" -$unused", $COLORS{'blue'});
678 }
679 print "\"\n";
680 # easy work here: we simply print the CFLAGS file
681 print " CFLAGS=\"";
682 open(pkg_cflag, "$db_pkg_dir/CFLAGS");
683 while (<pkg_cflag>) {
684 chomp();
685 print();
686 }
687 print "\"\n";
688 }
689 }
690 }
691 }
692 if (!$info_ok) { print " none installed.\n"; }
693 }
694 ###
695 # supporto iniziale per rsync/sync
696 sub rsync() {
697 if ($_ =~ m/^(.*?)\: \=\=\= r?sync/g) {
698 if ($gmt_found) {
699 $date = scalar gmtime "$1";
700 } else {
701 $date = scalar localtime "$1";
702 }
703 print " rsync'ed at >>> ";
704 print colored("$date\n", $COLORS{'green'});
705 }
706 print color 'reset';
707 }
708
709 #######
710 # *Start*
711 #######
712
713 help() if (!$ARGV[0]);
714
715 # parse arguments
716 parse(shift @ARGV) while ($ARGV[0]);
717
718 help() if ($help_found);
719 if ($version_found) {
720 print "genlop $version by Giorgio Mandolfo and Antonio Dolcetta\n"
721 ."please send praise to Giorgio <giorgio\@pollycoke.org>\n"
722 ."and bugs/flames to Antonio <adolcetta\@infracom.it>\n"
723 ."Copyright 2004 Giorgio Mandolfo.\n"
724 ."Distribuited under the GPL v2. See COPYING for details\n";
725 exit;
726 }
727
728 if ( !$targets[0]
729 and !$list_found
730 and !$current_found
731 and !$pretend_found
732 and !$rsync_found)
733 {
734 help();
735 }
736
737 # FIXME questi a cosa servono ?
738 if ($rsync_found) { @targets = (); push @targets, "-r"; }
739 if ($list_found) { @targets = (); push @targets, "-l"; }
740 if ($pretend_found) { @targets = (); push @targets, "-p"; }
741 if ($current_found) { @targets = (); push @targets, "-c"; }
742
743 # main code...
744 #cache_files(\@logfiles, \@logfile_cache);
745 if (scalar @logfiles > 1) {
746 @logfiles = order_logs(@logfiles);
747 }
748 my $ebuild_arg;
749 foreach $ebuild_arg (@targets) {
750 # this is for packages like gtk+
751 $ebuild_arg =~ s/(\+)/\\$1/g;
752 #foreach $_ (@logfile_cache) {
753 foreach my $logfile (@logfiles) {
754 my $handle;
755 open_file($logfile, \$handle);
756 foreach (<$handle>) {
757 my $pattern = gen_regexp($ebuild_arg);
758 if ($date_found) {
759 if ($_ =~ m/^([0-9]{10})\:/) {
760 if (datecompare($1) <= 0) {
761 next;
762 }
763 }
764 }
765 if ($pretend_found) { &pretend; }
766 if ($current_found) { &current; }
767 if ($rsync_found) { &rsync; }
768 if ($time_found or $info_found) {
769 if ($_ =~ m/^([0-9]{10})\: \>\>\> emerge .*?\) $pattern/) {
770 $e_start = $1;
771 $info_target = $2;
772 }
773 }
774 if ($_ =~ m/^([0-9]{10})\: ::: completed .*?\) $pattern to \//) {
775 if ($gmt_found) {
776 $e_date = scalar gmtime "$1";
777 } else {
778 $e_date = scalar localtime "$1";
779 }
780 $e_end = $1;
781 if ($time_found or $info_found) {
782 &gtime($e_end - $e_start);
783 if ($e_end - $e_start > 0) {
784 $tm_secondi += ($e_end - $e_start);
785 } else {
786 $tm_secondi += 0;
787 }
788 }
789 if (!$e_count) {
790 my $p_ebuild = " \* $2\n\n";
791 $p_ebuild =~ s/\\//g;
792 if (!$search_found) {
793 if ($ebuild_arg =~ m/\/$/) {
794 print colored("\* $ebuild_arg\n\n",
795 $COLORS{'blue'});
796 } else {
797 print colored("$p_ebuild", $COLORS{'blue'});
798 }
799 } else {
800 print colored(" \* matches found:\n\n",
801 $COLORS{'blue'});
802 }
803 }
804 if ($ebuild_found or !$info_found or $time_found) {
805 print " $e_date >>>",
806 colored(" $2$3\n", $COLORS{'green'});
807 }
808 if ($time_found) {
809 print " merge time: ";
810 if (($e_end - $e_start) > 0) {
811 &print_gtime();
812 print "\n\n";
813 } else {
814 print color 'bold red';
815 print "log error; merge time unknown.";
816 print color 'reset';
817 print "\n\n";
818 $w_count++;
819 }
820 }
821 $e_count++;
822 }
823 if ($unmerge_found or $info_found) {
824 $pattern = gen_regexp($ebuild_arg);
825 if (m/^([0-9]{10})\: \>\>\> unmerge success: ($pattern.*)/g) {
826 $u_date = scalar localtime "$1";
827 if ($unmerge_found) {
828 print " $u_date <<<",
829 colored(" $2\n", $COLORS{'red'});
830 }
831 }
832 }
833 }
834 }
835 if (!$e_count and !$list_found and !$rsync_found) {
836 print color 'bold red';
837 print "!!! Error: no merge found for \'$ebuild_arg\'";
838 print color 'reset';
839 print "\n";
840 } elsif ($info_found) {
841 &info($info_target);
842 } else {
843 $e_count = 0;
844 }
845 }

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.20