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

Contents of /genlop/trunk/genlop

Parent Directory Parent Directory | Revision Log Revision Log


Revision 177 - (show annotations) (download)
Mon Apr 9 14:55:16 2007 UTC (7 years, 4 months ago) by mcummings
File size: 36699 byte(s)
Bug noted by steev on the -dev mailing list - too many commas in display


1 #!/usr/bin/perl
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
20 use strict;
21 use warnings;
22 use POSIX;
23 use Term::ANSIColor;
24 use Date::Manip;
25 use LWP::Simple;
26 use File::Basename;
27
28 my $version = "0.30.7";
29 my @logfiles = ("/var/log/emerge.log");
30 my %COLORS = (
31 'blue' => 'bold blue',
32 'green' => 'bold green',
33 'red' => 'bold red',
34 );
35 my ($e_count, $w_count, $tm_secondi, $m_secondi) = (0, 0, 0, 0);
36
37 # variabili per la funzione parse
38 my (
39 $date_found,
40 $search_found,
41 $unmerge_found,
42 $list_found,
43 $file_found,
44 $time_found,
45 $help_found,
46 $current_found,
47 $pretend_found,
48 $version_found,
49 $info_found,
50 $gmt_found,
51 $rsync_found,
52 $info_ok,
53 $info_target,
54 $ssearch_found,
55 $online_query,
56 $secs,
57 $mins,
58 $hours,
59 $days,
60 $lhtomsg,
61 $last_skipped
62 );
63
64 # variabili globali del programma
65 my ($e_start, $e_end, $search_string, $m_count, $ebuild_found);
66
67 # variabili di datecompare
68 my ($fh, $elog);
69 my @targets;
70 my $progname = basename($0);
71
72 my ($userdate1, $userdate2, $searchdate1, $searchdate2);
73
74 sub datecompare ($)
75 {
76
77 # datecompare( epoch )
78 # returns -1 if epoch is outside searchdates 1 and 2
79 # returns 1 if inside
80 # returns undefined for errors
81 # expects searchdate1 to be before searchdate2 and neither should be in
82 # the future (but it's probably ok if searchdate2 is)
83 die if (!$searchdate1);
84 die if (!$searchdate2);
85 my $epochdate = $_[0];
86 if (($epochdate <=> $searchdate1) < 0)
87 {
88
89 # epoch is outside period
90 return -1;
91 }
92 elsif (($epochdate <=> $searchdate2) > 0)
93 {
94
95 # epoch is outside period
96 return -1;
97 }
98 else
99 {
100 return 1;
101 }
102
103 #TODO check that it's actually the case
104 }
105
106 # test a file, before opening it for reading
107 # second argument is a reference to a variable thet gets populated with
108 # a filehandle to the first argument
109 sub open_file
110 {
111 my ($file, $fh) = @_;
112 if ($file eq "/var/log/emerge.log" && !-r $file)
113 {
114 print "$progname: cannot open " . $file . " for reading\n" . "maybe you are not a member of the portage group ?\n" . "try genlop -h for help\n";
115 exit 1;
116 }
117 if (-T $file)
118 {
119 open $$fh, '<', "$file"
120 or die "could not open $file";
121 return 0;
122 }
123
124 # if we got here file is unreadable, might simply be compressed...
125 # let's try this
126 my $nature = qx{file $file}
127 or die "could not determine nature of (nonASCII) $file";
128 if ($nature =~ /gzip/)
129 {
130 open $$fh, "gzip -d -c $file |"
131 or die "could not open (gzipped) $file";
132 return 0;
133 }
134 elsif ($nature =~ /bzip/)
135 {
136 open $$fh, "bzip2 -d -c $file |"
137 or die "could not open (bzipped) $file";
138 return 0;
139 }
140 else
141 {
142
143 # giving up...
144 print "could not determine file type of $file\n";
145 exit 1;
146 }
147 }
148
149 # orderes logfiles by date
150 sub order_logs (@)
151 {
152 my @files = @_;
153 my %ordered;
154 foreach my $logfile (@files)
155 {
156 my $handle;
157 open_file("$logfile", \$handle);
158 my $fline = <$handle>; # first line
159 $ordered{$logfile} = (split /:/, $fline)[0];
160 }
161 return sort { $ordered{$a} <=> $ordered{$b} } keys %ordered;
162 }
163
164 # parse(arg), a hacked-up version of getopts
165 # sets (global) variables for options and returns.
166 # non option arguments are pushed into a (global) array
167 #
168 # FIXME Getopt::Long would be much better
169 sub parse ($)
170 {
171 my $arg = $_[0];
172 my $nexist = 0;
173 chomp $arg;
174
175 # long (--foo) options
176 if ($arg =~ /^--/)
177 {
178 LSWITCH:
179 {
180 $current_found = 1, last LSWITCH if ($arg eq "--current");
181 $pretend_found = 1, last LSWITCH if ($arg eq "--pretend");
182 $help_found = 1, last LSWITCH if ($arg eq "--help");
183 $time_found = 1, last LSWITCH if ($arg eq "--time");
184 $unmerge_found = 1, last LSWITCH if ($arg eq "--unmerge");
185 $ENV{'ANSI_COLORS_DISABLED'} = 1, last LSWITCH
186 if ($arg eq "--nocolor");
187 $list_found = 1, last LSWITCH if ($arg eq "--list");
188 $version_found = 1, last LSWITCH if ($arg eq "--version");
189 $search_found = 1, last LSWITCH if ($arg eq "--search");
190 $info_found = 1, last LSWITCH if ($arg eq "--info");
191 $gmt_found = 1, last LSWITCH if ($arg eq "--gmt");
192 $rsync_found = 1, last LSWITCH if ($arg eq "--rsync");
193
194 if ($arg eq "--date")
195 {
196 $date_found = 1;
197 if (!$userdate1)
198 {
199 help() if !$ARGV[0];
200 $userdate1 = ParseDate(\@ARGV);
201 unless (UnixDate($userdate1, "%s"))
202 {
203 print color 'bold red';
204 print "!!! Error:", " invalid date format (try mm/dd/yyyy)";
205 print color 'reset';
206 print "\n";
207 exit -1;
208 }
209 if ((UnixDate($userdate1, "%s") <=> time) <= 0)
210 {
211 $searchdate1 = UnixDate($userdate1, "%s");
212 $searchdate2 = time;
213 }
214 else
215 {
216 die "Date $userdate1 is in the future, not good\n";
217 }
218 }
219 elsif (!$userdate2)
220 {
221 $userdate2 = ParseDate(\@ARGV);
222 unless (UnixDate($userdate2, "%s"))
223 {
224 print color 'bold red';
225 print "!!! Error:", " invalid date format (try mm/dd/yyyy)";
226 print color 'reset';
227 print "\n";
228 exit -1;
229 }
230 if ((UnixDate($userdate1, "%s") <=> UnixDate($userdate2, "%s")) <= 0)
231 {
232 $searchdate2 = UnixDate($userdate2, "%s");
233 }
234 else
235 {
236 $searchdate2 = $searchdate1;
237 $searchdate1 = UnixDate($userdate2, "%s");
238 }
239 }
240 else
241 {
242 print "too many --date arguments ?\n";
243 die;
244 }
245 last LSWITCH;
246 }
247 $nexist = $arg;
248 } # END LSWITCH
249 if ($nexist)
250 {
251
252 # This is the standard error message
253 print color 'bold red';
254 print "!!! Error: $nexist, invalid option.";
255 print color 'reset';
256 print "\n";
257 exit -1;
258 }
259 return 0;
260 }
261
262 # short bsd-style options
263 if ($arg =~ /^-.*/)
264 {
265 until ($arg eq "-")
266 {
267 my $opt = chop($arg);
268 SSWITCH:
269 {
270 $help_found = 1, last SSWITCH if ($opt eq "h");
271 $help_found = 1, last SSWITCH if ($opt eq "?");
272 $time_found = 1, last SSWITCH if ($opt eq "t");
273 $unmerge_found = 1, last SSWITCH if ($opt eq "u");
274 $ENV{'ANSI_COLORS_DISABLED'} = 1, last SSWITCH if ($opt eq "n");
275 $list_found = 1, last SSWITCH if ($opt eq "l");
276 $search_found = 1, last SSWITCH if ($opt eq "s");
277 $version_found = 1, last SSWITCH if ($opt eq "v");
278 $info_found = 1, last SSWITCH if ($opt eq "i");
279 $online_query = 1, last SSWITCH if ($opt eq "q");
280 $ssearch_found = 1, last SSWITCH if ($opt eq "S");
281 $current_found = 1, last SSWITCH if ($opt eq "c");
282 $pretend_found = 1, last SSWITCH if ($opt eq "p");
283 $rsync_found = 1, last SSWITCH if ($opt eq "r");
284 $gmt_found = 1, last SSWITCH if ($opt eq "g");
285 $ebuild_found = 1, last SSWITCH if ($opt eq "e");
286
287 if ($opt eq "f")
288 {
289 if (!$ARGV[0])
290 {
291 print color 'bold red';
292 print "!!! Error: no logfile specified.";
293 print color 'reset';
294 print "\n";
295 exit -1;
296 }
297 if (!-r $ARGV[0])
298 {
299 print color 'bold red';
300 print "!!! Error: logfile " . $ARGV[0] . " not readable ", "or not found.";
301 print color 'reset';
302 print "\n";
303 exit -1;
304 }
305 print "using logfile " . $ARGV[0] . "\n";
306 if (!$file_found)
307 {
308 $logfiles[0] = shift @ARGV;
309 $file_found = 1;
310 }
311 else
312 {
313 push @logfiles, shift(@ARGV);
314 }
315 last SSWITCH;
316 }
317 $nexist = $opt;
318 } # END SSWITCH
319 }
320 if ($nexist)
321 {
322 print color 'bold red';
323 print "!!! Error: \-$nexist, invalid option.";
324 print color 'reset';
325 print "\n";
326 exit -1;
327 }
328 return 0;
329 }
330 push @targets, $arg;
331 return 0;
332 }
333
334 # provides help information
335 sub help ()
336 {
337 print "Usage: ", colored("genlop ", $COLORS{'blue'}), "[", colored("options", $COLORS{'green'}), "] [", colored("-f ", $COLORS{'green'}), "logfile] [",
338 colored("category/package", $COLORS{'green'}), "]\n\n", colored("Options:\n", $COLORS{'green'}), colored(" -c ", $COLORS{'green'}),
339 "display the currently compiling packages (if any)\n", colored(" -e ", $COLORS{'green'}) . "display package history; default if any option is used.\n",
340 colored(" -f ", $COLORS{'green'}), "read emerge log information from \"logfile\" instead of ", $logfiles[0], "\n",
341 colored(" -h ", $COLORS{'green'}), "print this help\n", colored(" -i ", $COLORS{'green'}),
342 "extra infos for the selected package (build specific USE ", "and CFLAGS\n variables, average build time, etc)\n",
343 colored(" -g ", $COLORS{'green'}), "display GMT/UTC, not localized time.\n", colored(" -l ", $COLORS{'green'}), "show full merge history.\n",
344 colored(" -n ", $COLORS{'green'}), "no color in output\n", colored(" -p ", $COLORS{'green'}),
345 "estimate build time from a piped \"emerge -p\" output\n", colored(" -q ", $COLORS{'green'}),
346 "query gentoo.linuxhowtos.org database if no local emerge was found\n", colored(" -r ", $COLORS{'green'}),
347 "search for portage tree sync/rsync history.\n", colored(" -s ", $COLORS{'green'}),
348 "use (case insensitive) regular expressions to match package names\n", colored(" -S ", $COLORS{'green'}),
349 "use case sensitive regular expressions to match package names\n", colored(" -t ", $COLORS{'green'}),
350 "calculate merge time for the specific package(s).\n", colored(" -u ", $COLORS{'green'}), "show when packages have been unmerged.\n",
351 colored(" -v ", $COLORS{'green'}), "display genlop version and exit.\n\n", colored(" --date datestring1", $COLORS{'green'}), " [",
352 colored(" --date datestring2", $COLORS{'green'}), "] only shows results between datestring1\n",
353 " and datestring2. datestring2 dafaults to \"now\" if not", " explicitly set.\n", " (e.g. genlop --list --date 3 days ago)\n",
354 "\nThis program is licensed under the GPL v2. See COPYING.\n", "For further info about genlop please read the man page.\n";
355 exit 0;
356 }
357
358 sub gtime($)
359 {
360 my $gtime = $_[0];
361 chomp($gtime);
362 $secs = $gtime % 60;
363 $gtime = ($gtime - $secs) / 60;
364 $mins = $gtime % 60;
365 $gtime = ($gtime - $mins) / 60;
366 $hours = $gtime % 24;
367 $gtime = ($gtime - $hours) / 24;
368 $days = $gtime % 7;
369 if ($gtime < 0)
370 {
371 $gtime = 0;
372 }
373 }
374
375 sub print_gtime()
376 {
377 if ($days > 0)
378 {
379 print colored("$days", $COLORS{'green'}), " day";
380 print "s" if ($days > 1);
381 }
382 if ($hours > 0)
383 {
384 print ", " if ($days > 0);
385 print colored("$hours", $COLORS{'green'}), " hour";
386 print "s" if ($hours > 1);
387 }
388 if ($mins > 0)
389 {
390 print ", " if ($days > 0 or $hours > 0);
391 print colored("$mins", $COLORS{'green'}), " minute";
392 print "s" if ($mins > 1);
393 }
394 if ($mins < 1 && $hours < 1 && $days < 1 && $secs > 0 && $current_found)
395 {
396 print colored("less than a minute", $COLORS{'green'});
397 }
398 elsif ($mins < 1 && $hours < 1 && $days < 1 && $secs > 0 && $pretend_found)
399 {
400 print colored("less than a minute", $COLORS{'green'});
401 }
402 elsif ($secs > 0 && !$pretend_found)
403 {
404 print " and " if ($days > 0 or $hours > 0 or $mins > 0);
405 print colored("$secs", $COLORS{'green'}), " second";
406 print "s" if ($secs > 1);
407 }
408 print ".";
409 }
410
411 sub gen_regexp ($)
412 {
413
414 # generates the correct regexp depending on what the user asked us.
415 # default is to search only the correct package name (eg. mozilla)
416 # a different regexp is needed in the following cases:
417 # argument is in the form category/
418 # argument is in the form category/ebuild
419 # argument is in the form category/ebuild-version
420 # the user can provide his own regular expression(s) via the -s option
421 my $arg = $_[0];
422 my ($category, $ebuild, $version);
423 my $regexp;
424 my @list;
425
426 if ($list_found)
427 {
428 if ($arg =~ m{^=})
429 {
430 $arg =~ s{^=}{};
431 $regexp = qr/(.*$arg).*?/;
432 }
433 else
434 {
435 $regexp = qr/(.*)(-[0-9]{1,7}.*?)/i;
436 }
437 return "$regexp";
438 }
439 if ($search_found)
440 {
441
442 # return user supplied regexp as-is
443 if ($arg =~ m{^=})
444 {
445 $arg =~ s{^=}{};
446 $regexp =
447 $ssearch_found
448 ? qr/(.*$arg)(.*?)/
449 : qr/(.*$arg)(.*?)/i;
450 }
451 else
452 {
453 $regexp =
454 $ssearch_found
455 ? qr/(.*$arg.*?)(-[0-9]{1,7}.*?)/
456 : qr/(.*$arg.*?)(-[0-9]{1,7}.*?)/i;
457 }
458 return "$regexp";
459 }
460
461 # check if we were asked only the category
462 if ($arg =~ /.*?\/$/)
463 {
464 $category = $arg;
465 $regexp =
466 $ssearch_found
467 ? qr/($category.*?)(-[0-9]{1,7}.*?)/
468 : qr/($category.*?)(-[0-9]{1,7}.*?)/i;
469 return "$regexp";
470 }
471 @list = split(/\//, $arg);
472 $ebuild = $list[0];
473 if ($list[1])
474 {
475 $category = $list[0];
476 $ebuild = $list[1];
477 @list = ();
478 @list = split(/(-[0-9]{1,7})/, $ebuild);
479 if ($list[1])
480 {
481 $ebuild = $list[0];
482 $version = $list[2] ? join('', $list[1], $list[2]) : $list[1];
483 $category =~ s{^=}{};
484 $regexp =
485 $ssearch_found
486 ? qr!($category\/$ebuild)($version)!
487 : qr!($category\/$ebuild)($version)!i;
488 return "$regexp";
489 }
490 $regexp =
491 $ssearch_found
492 ? qr!($category\/$ebuild)(-[0-9]{1,7}.*?)!
493 : qr!($category\/$ebuild)(-[0-9]{1,7}.*?)!i;
494 return "$regexp";
495 }
496 $regexp =
497 $ssearch_found
498 ? qr!(.*?/$ebuild)(-[0-9]{1,7}.*?)!
499 : qr!(.*?/$ebuild)(-[0-9]{1,7}.*?)!i;
500 return "$regexp";
501 }
502
503 # Submitted in bug 157103 by sascha to enable searching against linuxhowtos for compile
504 # times when genlop has no data to work with
505 sub lhtoquery($$)
506 {
507 my ( $vcpu, $pcpu, $opcpu ) = (0,0,-1);
508 my $modelname = "";
509 my $cachesize;
510 my $packet = shift(@_);
511 my $countref = shift(@_);
512 open(my $cmdline, "/proc/cpuinfo");
513 while (<$cmdline>)
514 {
515 if (m/processor\s*:\s*(\d*)/)
516 {
517 $vcpu = $1 if ($1 > $vcpu);
518 }
519 if (m/model name\s*:\s*(.*)$/)
520 {
521 $modelname = $1;
522 }
523 if (m/cache size\s*:\s*(.*)$/)
524 {
525 $cachesize = $1;
526 }
527 if (m/physical id\s*:\s*(\d*)$/)
528 {
529 $pcpu++ if ($1 != $opcpu);
530 $opcpu = $1;
531 }
532 }
533 $vcpu++;
534 $pcpu = 1 if ($pcpu == 0);
535 my $cpuname = $pcpu . "x $modelname $cachesize";
536 $cpuname =~ s/ /%20/g;
537 my $retval = LWP::Simple::get("http://gentoo.linuxhowtos.org/query.php?cpuname=$cpuname&vcpu=$vcpu&packetname=$packet");
538 if ($retval =~ m/estimate: (\d*) seconds/)
539 {
540 $$countref = 1;
541 return $1;
542 }
543 if ($retval =~ /unknown cpu/)
544 {
545 $lhtomsg = "Your CPU is not yet known, please add it by following the instructions on http://gentoo.linuxhowtos.org/compiletimeestimator/";
546 }
547 return 0;
548 }
549
550 # --pretend or -p takes an emerge -p `-e -D world, system`, anything you want
551 # and elaborates its output. for each package is calculated the average build
552 # time and summed together. this is the estimated merge time
553 sub pretend()
554 {
555 if ($pretend_found)
556 {
557 @targets = ();
558 print "These are the pretended packages:";
559 print " (this may take a while; wait...)\n\n";
560
561 # open STDIN; that's why emerge -p foo is piped to a genlop -p
562 while (<STDIN>)
563 {
564 if ($_ =~ m/^\[e.*\] (.*?)\/(.*?)(\-[0-9])/)
565 {
566 push @targets, $2;
567 print;
568 }
569 }
570 my $last_ebuild;
571 foreach my $ebuild_arg (@targets)
572 {
573
574 # we track the last ebuild processed with $last_ebuild variable
575 $last_ebuild = $ebuild_arg;
576 $ebuild_arg =~ s/(\+)/\\$1/g;
577 foreach my $logfile (@logfiles)
578 {
579 my $handle;
580 open_file($logfile, \$handle);
581 foreach (<$handle>)
582 {
583 if (m/^(.*?)\: \>\>\> emerge.*?\/$ebuild_arg-[0-9].*/)
584 {
585 $e_start = $1;
586 }
587 if (m/^(.*?)\: ::: completed .*?\) .*\/$ebuild_arg-[0-9].* to \//)
588 {
589 $e_end = $1;
590 $tm_secondi += ($e_end - $e_start);
591 $e_count++;
592 }
593 }
594 }
595 if ($e_count == 0)
596 {
597 if ($online_query)
598 {
599
600 #query gentoo.linuxhowtos.org
601 $tm_secondi += lhtoquery($last_ebuild, \$e_count);
602 }
603 }
604 if ($e_count == 0)
605 {
606 $ebuild_arg =~ s/\\//g;
607 print "\n!!! Error: couldn't get previous ", "merge of $ebuild_arg; skipping...";
608
609 # if a pretended package haven't any successfull merge
610 # stored in logfile (ie a new package required by
611 # another, or a logfile corruption), prints a warning
612 # and keep track with $last_skipped
613 $last_skipped = $ebuild_arg;
614 }
615 else
616 {
617 $m_secondi += $tm_secondi / ($e_count);
618 $e_count = 0;
619 $tm_secondi = 0;
620 $last_skipped = "none-skipped";
621 }
622 }
623 if (@targets)
624 {
625 if ($last_ebuild =~ m/$last_skipped/)
626 {
627 print color 'bold red';
628 print "\n!!! Error: $last_skipped never merged; ", "estimated time unknown.";
629 print color 'reset';
630 print "\n";
631 if ($lhtomsg)
632 {
633 print color 'bold yellow';
634 print "$lhtomsg\n";
635 print color 'reset';
636 }
637 exit;
638 }
639 print "\n\nEstimated update time: ";
640 &gtime($m_secondi);
641 &print_gtime;
642 print "\n";
643 }
644 else
645 {
646 print color 'bold red';
647 print "\n!!! Error: no pretended packages found.";
648 print color 'reset';
649 print "\n";
650 }
651 exit;
652 }
653 }
654
655 sub current()
656 {
657
658 # support for 'current' merge.
659 #
660 # this whole 'current' thing is based on having sandboxind enabled
661 # we need to check for it, basically sandboxing is on if
662 # FEATURES contains 'sandbox' and does not contain 'userpriv'
663 # FEATURES contains 'sandbox' and contains both 'userpriv' and 'usersandbox'
664 # 20050815 - JeR: On slow systems, running portageq takes a lot of time,
665 # sometimes enough to miss all the sandbox action completely. Better to
666 # not check for sanity and have users check their FEATURES instead.
667 my @targets = ();
668 my @sandbox_pids = qx{ps --no-header -o pid -C sandbox};
669 my ($e_curmerge, $e_lastmerge);
670 if (scalar @sandbox_pids == 0)
671 {
672 print colored("!!!", $COLORS{'red'});
673 print " Error: no working merge found.\n";
674 print "(the -c option only works if there is" . " an ongoing compilation, see manpage)\n";
675 exit;
676 }
677 foreach my $pid (@sandbox_pids)
678 {
679 my $current;
680 chomp $pid;
681 $pid =~ s/\s//g;
682 open(my $cmdline, "/proc/$pid/cmdline");
683 while (<$cmdline>)
684 {
685 if ($_ =~ m/^\[(.*?)\-[0-9].*?\]/g)
686 {
687 $current = $1;
688 }
689 }
690 push @targets, $current;
691 }
692 if (scalar @targets == 0)
693 {
694 print colored("!!!", $COLORS{'red'});
695 print "oops! should not happen, pease file bug\n";
696 print "empty \@targets\n";
697 exit 1;
698 }
699 foreach my $ebuild_arg (@targets)
700 {
701 my $e_current;
702 $ebuild_arg =~ s/(\+)/\\$1/g;
703 foreach my $logfile (@logfiles)
704 {
705 my $handle;
706 open_file($logfile, \$handle);
707 foreach (<$handle>)
708 {
709 if (m/^(.*?)\: \>\>\> emerge \((.*?) of (.*?)\)(.*?\/$ebuild_arg-[0-9].*?)to \//)
710 {
711 $e_start = $1;
712 $e_curmerge = $2;
713 $e_lastmerge = $3;
714 $e_current = $4;
715 }
716 if (m/^(.*?)\: ::: completed .*?\) .*\/$ebuild_arg-[0-9].* to \//)
717 {
718 $e_end = $1;
719 $e_count++;
720 &gtime($e_end - $e_start);
721 $tm_secondi += ($e_end - $e_start);
722 }
723 }
724 }
725 $e_end = CORE::time();
726 &gtime($e_end - $e_start);
727 print "\n Currently merging $e_curmerge out of $e_lastmerge\n";
728 print colored("\n \*$e_current\n\n", $COLORS{'blue'});
729 print " current merge time: ";
730 $current_found = undef;
731 &print_gtime();
732 $current_found = 1;
733 print "\n";
734 print " ETA: ";
735
736 if (!$e_count && $online_query)
737 {
738
739 #query gentoo.linuxhowtos.org
740 $tm_secondi = lhtoquery($ebuild_arg, \$e_count);
741 $e_count = 1;
742 }
743
744 if ($e_count && $e_start)
745 {
746 &gtime(($tm_secondi / $e_count) - ($e_end - $e_start));
747 if (($e_end - $e_start) >= ($tm_secondi / $e_count))
748 {
749 print colored("any time now.\n", $COLORS{'green'});
750 }
751 else
752 {
753 &print_gtime();
754 print "\n";
755 }
756 }
757 else
758 {
759 print color 'bold red';
760 print "unknown.";
761 print color 'reset';
762 print "\n";
763 }
764 }
765 exit;
766 }
767
768 sub info($)
769 {
770 my $package = $_[0];
771 if ($list_found) { &help(); }
772 if ($e_count) { $m_count = $e_count - $w_count; }
773 if ($m_count == 0)
774 {
775 print colored("Total merge time unknown.\n\n", $COLORS{'red'});
776 }
777 else
778 {
779 print "\n Total builds: ", colored("$e_count", $COLORS{'green'});
780 print "\n Global build time: ";
781 &gtime($tm_secondi);
782 &print_gtime();
783 if ($w_count)
784 {
785 print " Global build time of $m_count merges.\n";
786 }
787 else
788 {
789 print "\n";
790 }
791 if ($e_count > 1)
792 {
793 print " Average merge time: ";
794 &gtime($tm_secondi / $m_count);
795 &print_gtime();
796 print "\n";
797 }
798 $e_count = 0;
799 $tm_secondi = 0;
800
801 #$gtime = 0;
802 }
803 $e_count = 0;
804 print "\n Info about currently installed ebuild:\n";
805 opendir(DIR, "/var/db/pkg/") || die "can't open /var/db/pkg/ $!\n";
806 while (defined(my $categoria = readdir(DIR)))
807 {
808 if ($package =~ m/^$categoria.*/g)
809 {
810 opendir(DIR2, "/var/db/pkg/$categoria");
811 while (defined(my $package_dir = readdir(DIR2)))
812 {
813
814 #$package =~ s/(\+)/\\$1/g;
815 my $tmp_package = $package;
816 $tmp_package =~ s/\+/\\+/g;
817 if ("$categoria/$package_dir" =~ m/$tmp_package\-[0-9].*/)
818 {
819 $info_ok = 1;
820 print colored("\n * $categoria/$package_dir\n", $COLORS{'blue'});
821 $package_dir =~ s/(\+)/\\$1/g;
822
823 my $e_date;
824 foreach my $logfile (@logfiles)
825 {
826 my $handle;
827 open_file($logfile, \$handle);
828 foreach (<$handle>)
829 {
830 my $pattern = gen_regexp("$categoria/$package_dir");
831 if (m/^([0-9]{10})\: ::: completed .*?\) $pattern to \//)
832 {
833 if ($gmt_found)
834 {
835 $e_date = scalar gmtime "$1";
836 }
837 else
838 {
839 $e_date = scalar localtime "$1";
840 }
841 }
842 }
843 }
844 print " Install date: ";
845 print colored("$e_date\n", $COLORS{'green'});
846
847 # we use 3 array to collect data: before processing they are
848 # @unused_use: contain packages' USEs
849 # @pkg_use: USE declared before compiling that package
850 # @used_use: empty
851 my (@potential_use, @pkg_use, @used_use, @unused_use);
852
853 # each installed package store its information here
854 my $db_pkg_dir = "/var/db/pkg/$categoria/$package_dir/";
855 if ("$categoria/$package_dir" =~ m/.*\/(.*)/g)
856 {
857
858 # we search into the installed ebuild for USE flags available
859 # and store them in @potential_use.
860 open(pkg_ebuild, "$db_pkg_dir/$1.ebuild") || return;
861 while (<pkg_ebuild>)
862 {
863 if ($_ =~ m/^IUSE=\"(\$\{IUSE\} )?(.*)"/g)
864 {
865 @potential_use = split(/\ /, $2);
866 }
867 }
868 }
869
870 # this file lists every USE flag defined, even ones in make.conf
871 # we push'em in @pkg_use
872 open(pkg_use, "$db_pkg_dir/USE") || return;
873 while (<pkg_use>)
874 {
875 @pkg_use = split(/\ /, $_);
876 }
877
878 # for every possible package USE we search into USEs stored in @pkg_use
879 # if a match is found we move it from @potential_use in @used_use.
880 # in this way, when every possible package USE are processed, @used_use
881 # contain only used ones and @potential_use the not used ones.
882 USE: foreach my $use (@potential_use)
883 {
884 chomp($use);
885 foreach my $pkg (@pkg_use)
886 {
887 chomp($pkg);
888 if ($use eq $pkg)
889 {
890 push(@used_use, $use);
891 next USE;
892 }
893 }
894 push(@unused_use, $use);
895 }
896
897 # finally we print'em out
898 print " USE=\"", colored("@used_use", $COLORS{'red'});
899 foreach my $unused (@unused_use)
900 {
901 print colored(" -$unused", $COLORS{'blue'});
902 }
903 print "\"\n";
904
905 # easy work here: we simply print the CFLAGS file
906 print " CFLAGS=\"";
907 open(pkg_cflag, "$db_pkg_dir/CFLAGS");
908 while (<pkg_cflag>)
909 {
910 chomp();
911 print();
912 }
913 print "\"\n";
914 }
915 }
916 }
917 }
918 if (!$info_ok) { print " none installed.\n"; }
919 }
920 ###
921 # supporto iniziale per rsync/sync
922 sub rsync()
923 {
924 my $date;
925 if ($_ =~ m/^(.*?)\: \=\=\= r?sync/g)
926 {
927 if ($gmt_found)
928 {
929 $date = scalar gmtime "$1";
930 }
931 else
932 {
933 $date = scalar localtime "$1";
934 }
935 print " rsync'ed at >>> ";
936 print colored("$date\n", $COLORS{'green'});
937 }
938 print color 'reset';
939 }
940
941 #######
942 # *Start*
943 #######
944
945 help() if (!$ARGV[0]);
946
947 # parse arguments
948 parse(shift @ARGV) while ($ARGV[0]);
949
950 help() if ($help_found);
951 if ($version_found)
952 {
953 print "genlop $version, maintained by Michael Cummings <mcummings\@gentoo.org>\n"
954 . "original code by Giorgio Mandolfo and Antonio Dolcetta\n"
955 . "Please file any bugs found online at:\n"
956 . "https://bugs.gentoo.org\n"
957 . "Distribuited under the GPL v2. See COPYING for details\n";
958 exit;
959 }
960
961 if ( !$targets[0]
962 and !$list_found
963 and !$current_found
964 and !$pretend_found
965 and !$rsync_found)
966 {
967 help();
968 }
969
970 # FIXME questi a cosa servono ?
971 if ($rsync_found) { @targets = (); push @targets, "-r"; }
972 if ($list_found) { @targets = (); push @targets, "-l"; }
973 if ($pretend_found) { @targets = (); push @targets, "-p"; }
974 if ($current_found) { @targets = (); push @targets, "-c"; }
975
976 # main code...
977 #cache_files(\@logfiles, \@logfile_cache);
978 if (scalar @logfiles > 1)
979 {
980 @logfiles = order_logs(@logfiles);
981 }
982 foreach my $ebuild_arg (@targets)
983 {
984
985 # this is for packages like gtk+
986 $ebuild_arg =~ s/(\+)/\\$1/g;
987
988 foreach my $logfile (@logfiles)
989 {
990 my $handle;
991 open_file($logfile, \$handle);
992 foreach (<$handle>)
993 {
994 my $pattern = gen_regexp($ebuild_arg);
995 if ($date_found)
996 {
997 if ($_ =~ m/^([0-9]{10})\:/)
998 {
999 if (datecompare($1) <= 0)
1000 {
1001 next;
1002 }
1003 }
1004 }
1005 if ($pretend_found) { &pretend; }
1006 if ($current_found) { &current; }
1007 if ($rsync_found) { &rsync; }
1008 if ($time_found or $info_found)
1009 {
1010 if ($_ =~ m/^([0-9]{10})\: \>\>\> emerge .*?\) $pattern/)
1011 {
1012 $e_start = $1;
1013 $info_target = $2;
1014 }
1015 }
1016 if ($_ =~ m/^([0-9]{10})\: ::: completed .*?\) $pattern to \//)
1017 {
1018 my $e_date;
1019 if ($gmt_found)
1020 {
1021 $e_date = scalar gmtime "$1";
1022 }
1023 else
1024 {
1025 $e_date = scalar localtime "$1";
1026 }
1027 $e_end = $1;
1028 if ($time_found or $info_found)
1029 {
1030 &gtime($e_end - $e_start);
1031 if ($e_end - $e_start > 0)
1032 {
1033 $tm_secondi += ($e_end - $e_start);
1034 }
1035 else
1036 {
1037 $tm_secondi += 0;
1038 }
1039 }
1040 if (!$e_count)
1041 {
1042 my $p_ebuild = " \* $2\n\n";
1043 $p_ebuild =~ s/\\//g;
1044 if (!$search_found)
1045 {
1046 if ($ebuild_arg =~ m/\/$/)
1047 {
1048 print colored("\* $ebuild_arg\n\n", $COLORS{'blue'});
1049 }
1050 else
1051 {
1052 print colored("$p_ebuild", $COLORS{'blue'});
1053 }
1054 }
1055 else
1056 {
1057 print colored(" \* matches found:\n\n", $COLORS{'blue'});
1058 }
1059 }
1060 if ($ebuild_found or !$info_found or $time_found)
1061 {
1062 my $eb = $2;
1063 my $extra = $3 || "";
1064 print " $e_date >>>", colored(" $eb$extra\n", $COLORS{'green'});
1065 }
1066 if ($time_found)
1067 {
1068 print " merge time: ";
1069 if (($e_end - $e_start) > 0)
1070 {
1071 &print_gtime();
1072 print "\n\n";
1073 }
1074 else
1075 {
1076 print color 'bold red';
1077 print "log error; merge time unknown.";
1078 print color 'reset';
1079 print "\n\n";
1080 $w_count++;
1081 }
1082 }
1083 $e_count++;
1084 }
1085 if ($unmerge_found or $info_found)
1086 {
1087 $pattern = gen_regexp($ebuild_arg);
1088 if (m/^([0-9]{10})\: \>\>\> unmerge success: ($pattern.*)/g)
1089 {
1090 my $u_date = scalar localtime "$1";
1091 if ($unmerge_found)
1092 {
1093 print " $u_date <<<", colored(" $2\n", $COLORS{'red'});
1094 }
1095 }
1096 }
1097 }
1098 }
1099 if (!$e_count and !$list_found and !$rsync_found)
1100 {
1101 if ($e_count == 0)
1102 {
1103 if ($online_query)
1104 {
1105
1106 #query gentoo.linuxhowtos.org
1107 $tm_secondi += lhtoquery($ebuild_arg, \$e_count);
1108 }
1109 }
1110 if ($e_count > 0)
1111 {
1112 print "Estimated merge time: ";
1113 &gtime($tm_secondi);
1114 &print_gtime();
1115 }
1116 else
1117 {
1118 print color 'bold red';
1119 print "!!! Error: no merge found for \'$ebuild_arg\'";
1120 print color 'reset';
1121 }
1122 print "\n";
1123 }
1124 elsif ($info_found)
1125 {
1126 &info($info_target);
1127 }
1128 else
1129 {
1130 $e_count = 0;
1131 }
1132 }
1133
1134 if ($lhtomsg)
1135 {
1136 print color 'bold yellow';
1137 print "$lhtomsg\n";
1138 print color 'reset';
1139 }

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.20