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

Contents of /genlop/trunk/genlop

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.20