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

Contents of /genlop/trunk/genlop

Parent Directory Parent Directory | Revision Log Revision Log


Revision 200 - (show annotations) (download)
Tue Sep 25 21:27:15 2007 UTC (7 years, 7 months ago) by fuzzyray
File size: 36767 byte(s)
Apply FreeBSD patch from lavajoe (Bug #172839)
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 = ();
669 my @sandbox_procs = qx{ps ax -o pid,args | tail -n +2 | sed -e's/^ *//' | grep ' sandbox ' | grep -v ' grep '};
670 my ($e_curmerge, $e_lastmerge);
671 foreach (@sandbox_procs)
672 {
673 if (m/^(.*?) \[(.*?)\-[0-9].*?\]/)
674 {
675 push @sandbox_pids, $1;
676 push @targets, $2;
677 }
678 }
679 if (scalar @sandbox_pids == 0)
680 {
681 print colored("!!!", $COLORS{'red'});
682 print " Error: no working merge found.\n";
683 print "(the -c option only works if there is" . " an ongoing compilation, see manpage)\n";
684 exit;
685 }
686 if (scalar @targets == 0)
687 {
688 print colored("!!!", $COLORS{'red'});
689 print "oops! should not happen, pease file bug\n";
690 print "empty \@targets\n";
691 exit 1;
692 }
693 foreach my $ebuild_arg (@targets)
694 {
695 my $e_current;
696 $ebuild_arg =~ s/(\+)/\\$1/g;
697 foreach my $logfile (@logfiles)
698 {
699 my $handle;
700 open_file($logfile, \$handle);
701 foreach (<$handle>)
702 {
703 if (m/^(.*?)\: \>\>\> emerge \((.*?) of (.*?)\)(.*?\/$ebuild_arg-[0-9].*?)to \//)
704 {
705 $e_start = $1;
706 $e_curmerge = $2;
707 $e_lastmerge = $3;
708 $e_current = $4;
709 }
710 if (m/^(.*?)\: ::: completed .*?\) .*\/$ebuild_arg-[0-9].* to \//)
711 {
712 $e_end = $1;
713 $e_count++;
714 &gtime($e_end - $e_start);
715 $tm_secondi += ($e_end - $e_start);
716 }
717 }
718 }
719 $e_end = CORE::time();
720 &gtime($e_end - $e_start);
721 print "\n Currently merging $e_curmerge out of $e_lastmerge\n";
722 print colored("\n \*$e_current\n\n", $COLORS{'blue'});
723 print " current merge time: ";
724 $current_found = undef;
725 &print_gtime();
726 $current_found = 1;
727 print "\n";
728 print " ETA: ";
729
730 if (!$e_count && $online_query)
731 {
732
733 #query gentoo.linuxhowtos.org
734 $tm_secondi = lhtoquery($ebuild_arg, \$e_count);
735 $e_count = 1;
736 }
737
738 if ($e_count && $e_start)
739 {
740 &gtime(($tm_secondi / $e_count) - ($e_end - $e_start));
741 if (($e_end - $e_start) >= ($tm_secondi / $e_count))
742 {
743 print colored("any time now.\n", $COLORS{'green'});
744 }
745 else
746 {
747 &print_gtime();
748 print "\n";
749 }
750 }
751 else
752 {
753 print color 'bold red';
754 print "unknown.";
755 print color 'reset';
756 print "\n";
757 }
758 }
759 exit;
760 }
761
762 sub info($)
763 {
764 my $package = $_[0];
765 if ($list_found) { &help(); }
766 if ($e_count) { $m_count = $e_count - $w_count; }
767 if ($m_count == 0)
768 {
769 print colored("Total merge time unknown.\n\n", $COLORS{'red'});
770 }
771 else
772 {
773 print "\n Total builds: ", colored("$e_count", $COLORS{'green'});
774 print "\n Global build time: ";
775 &gtime($tm_secondi);
776 &print_gtime();
777 if ($w_count)
778 {
779 print " Global build time of $m_count merges.\n";
780 }
781 else
782 {
783 print "\n";
784 }
785 if ($e_count > 1)
786 {
787 print " Average merge time: ";
788 &gtime($tm_secondi / $m_count);
789 &print_gtime();
790 print "\n";
791 }
792 $e_count = 0;
793 $tm_secondi = 0;
794
795 #$gtime = 0;
796 }
797 $e_count = 0;
798 print "\n Info about currently installed ebuild:\n";
799 opendir(DIR, "/var/db/pkg/") || die "can't open /var/db/pkg/ $!\n";
800 while (defined(my $categoria = readdir(DIR)))
801 {
802 if ($package =~ m/^$categoria.*/g)
803 {
804 opendir(DIR2, "/var/db/pkg/$categoria");
805 while (defined(my $package_dir = readdir(DIR2)))
806 {
807
808 #$package =~ s/(\+)/\\$1/g;
809 my $tmp_package = $package;
810 $tmp_package =~ s/\+/\\+/g;
811 if ("$categoria/$package_dir" =~ m/$tmp_package\-[0-9].*/)
812 {
813 $info_ok = 1;
814 print colored("\n * $categoria/$package_dir\n", $COLORS{'blue'});
815 $package_dir =~ s/(\+)/\\$1/g;
816
817 my $e_date;
818 foreach my $logfile (@logfiles)
819 {
820 my $handle;
821 open_file($logfile, \$handle);
822 foreach (<$handle>)
823 {
824 my $pattern = gen_regexp("$categoria/$package_dir");
825 if (m/^([0-9]{10})\: ::: completed .*?\) $pattern to \//)
826 {
827 if ($gmt_found)
828 {
829 $e_date = scalar gmtime "$1";
830 }
831 else
832 {
833 $e_date = scalar localtime "$1";
834 }
835 }
836 }
837 }
838 print " Install date: ";
839 print colored("$e_date\n", $COLORS{'green'});
840
841 # we use 3 array to collect data: before processing they are
842 # @unused_use: contain packages' USEs
843 # @pkg_use: USE declared before compiling that package
844 # @used_use: empty
845 my (@potential_use, @pkg_use, @used_use, @unused_use);
846
847 # each installed package store its information here
848 my $db_pkg_dir = "/var/db/pkg/$categoria/$package_dir/";
849 if ("$categoria/$package_dir" =~ m/.*\/(.*)/g)
850 {
851
852 # we search into the installed ebuild for USE flags available
853 # and store them in @potential_use.
854 open(pkg_ebuild, "$db_pkg_dir/$1.ebuild") || return;
855 while (<pkg_ebuild>)
856 {
857 if ($_ =~ m/^IUSE=\"(\$\{IUSE\} )?(.*)"/g)
858 {
859 @potential_use = split(/\ /, $2);
860 }
861 }
862 }
863
864 # this file lists every USE flag defined, even ones in make.conf
865 # we push'em in @pkg_use
866 open(pkg_use, "$db_pkg_dir/USE") || return;
867 while (<pkg_use>)
868 {
869 @pkg_use = split(/\ /, $_);
870 }
871
872 # for every possible package USE we search into USEs stored in @pkg_use
873 # if a match is found we move it from @potential_use in @used_use.
874 # in this way, when every possible package USE are processed, @used_use
875 # contain only used ones and @potential_use the not used ones.
876 USE: foreach my $use (@potential_use)
877 {
878 chomp($use);
879 foreach my $pkg (@pkg_use)
880 {
881 chomp($pkg);
882 if ($use eq $pkg)
883 {
884 push(@used_use, $use);
885 next USE;
886 }
887 }
888 push(@unused_use, $use);
889 }
890
891 # finally we print'em out
892 print " USE=\"", colored("@used_use", $COLORS{'red'});
893 foreach my $unused (@unused_use)
894 {
895 print colored(" -$unused", $COLORS{'blue'});
896 }
897 print "\"\n";
898
899 # easy work here: we simply print the CFLAGS file
900 print " CFLAGS=\"";
901 open(pkg_cflag, "$db_pkg_dir/CFLAGS");
902 while (<pkg_cflag>)
903 {
904 chomp();
905 print();
906 }
907 print "\"\n";
908 }
909 }
910 }
911 }
912 if (!$info_ok) { print " none installed.\n"; }
913 }
914
915 sub rsync() {
916 foreach (@logfiles) {
917 my $handle;
918 open_file($_, \$handle);
919 while(<$handle>) {
920 if ($_ =~ m/^(.*?)\: \=\=\= Sync completed with/) {
921 if ($date_found) {
922 if (datecompare($1) <= 0) {
923 next;
924 }
925 }
926
927 if ($gmt_found) {
928 print " rsync'ed at >>> ", colored((scalar gmtime "$1"), $COLORS{'green'}),"\n";
929 }
930 else {
931 print " rsync'ed at >>> ", colored((scalar localtime "$1"), $COLORS{'green'}),"\n";
932 }
933 }
934 }
935 close($handle);
936 }
937
938 print color 'reset';
939
940 return 0;
941 }
942
943 #######
944 # *Start*
945 #######
946
947 help() if (!$ARGV[0]);
948
949 # parse arguments
950 parse(shift @ARGV) while ($ARGV[0]);
951
952 help() if ($help_found);
953 if ($version_found)
954 {
955 print "genlop $version, maintained by Michael Cummings <mcummings\@gentoo.org>\n"
956 . "original code by Giorgio Mandolfo and Antonio Dolcetta\n"
957 . "Please file any bugs found online at:\n"
958 . "https://bugs.gentoo.org\n"
959 . "Distribuited under the GPL v2. See COPYING for details\n";
960 exit;
961 }
962
963 if ( !$targets[0]
964 and !$list_found
965 and !$current_found
966 and !$pretend_found
967 and !$rsync_found)
968 {
969 help();
970 }
971
972 # FIXME questi a cosa servono ?
973 if ($rsync_found) { @targets = (); push @targets, "-r"; }
974 if ($list_found) { @targets = (); push @targets, "-l"; }
975 if ($pretend_found) { @targets = (); push @targets, "-p"; }
976 if ($current_found) { @targets = (); push @targets, "-c"; }
977
978 # main code...
979 #cache_files(\@logfiles, \@logfile_cache);
980 if (scalar @logfiles > 1)
981 {
982 @logfiles = order_logs(@logfiles);
983 }
984
985 # - Option -r given? >
986 if ($rsync_found) {
987 rsync();
988 exit(0);
989 }
990
991 foreach my $ebuild_arg (@targets)
992 {
993
994 # this is for packages like gtk+
995 $ebuild_arg =~ s/(\+)/\\$1/g;
996
997 foreach my $logfile (@logfiles)
998 {
999 my $handle;
1000 open_file($logfile, \$handle);
1001 foreach (<$handle>)
1002 {
1003 my $pattern = gen_regexp($ebuild_arg);
1004 if ($date_found)
1005 {
1006 if ($_ =~ m/^([0-9]{10})\:/)
1007 {
1008 if (datecompare($1) <= 0)
1009 {
1010 next;
1011 }
1012 }
1013 }
1014 if ($pretend_found) { &pretend; }
1015 if ($current_found) { &current; }
1016 if ($time_found or $info_found)
1017 {
1018 if ($_ =~ m/^([0-9]{10})\: \>\>\> emerge .*?\) $pattern/)
1019 {
1020 $e_start = $1;
1021 $info_target = $2;
1022 }
1023 }
1024 if ($_ =~ m/^([0-9]{10})\: ::: completed .*?\) $pattern to \//)
1025 {
1026 my $e_date;
1027 if ($gmt_found)
1028 {
1029 $e_date = scalar gmtime "$1";
1030 }
1031 else
1032 {
1033 $e_date = scalar localtime "$1";
1034 }
1035 $e_end = $1;
1036 if ($time_found or $info_found)
1037 {
1038 &gtime($e_end - $e_start);
1039 if ($e_end - $e_start > 0)
1040 {
1041 $tm_secondi += ($e_end - $e_start);
1042 }
1043 else
1044 {
1045 $tm_secondi += 0;
1046 }
1047 }
1048 if (!$e_count)
1049 {
1050 my $p_ebuild = " \* $2\n\n";
1051 $p_ebuild =~ s/\\//g;
1052 if (!$search_found)
1053 {
1054 if ($ebuild_arg =~ m/\/$/)
1055 {
1056 print colored("\* $ebuild_arg\n\n", $COLORS{'blue'});
1057 }
1058 else
1059 {
1060 print colored("$p_ebuild", $COLORS{'blue'});
1061 }
1062 }
1063 else
1064 {
1065 print colored(" \* matches found:\n\n", $COLORS{'blue'});
1066 }
1067 }
1068 if ($ebuild_found or !$info_found or $time_found)
1069 {
1070 my $eb = $2;
1071 my $extra = $3 || "";
1072 print " $e_date >>>", colored(" $eb$extra\n", $COLORS{'green'});
1073 }
1074 if ($time_found)
1075 {
1076 print " merge time: ";
1077 if (($e_end - $e_start) > 0)
1078 {
1079 &print_gtime();
1080 print "\n\n";
1081 }
1082 else
1083 {
1084 print color 'bold red';
1085 print "log error; merge time unknown.";
1086 print color 'reset';
1087 print "\n\n";
1088 $w_count++;
1089 }
1090 }
1091 $e_count++;
1092 }
1093 if ($unmerge_found or $info_found)
1094 {
1095 $pattern = gen_regexp($ebuild_arg);
1096 if (m/^([0-9]{10})\: \>\>\> unmerge success: ($pattern.*)/g)
1097 {
1098 my $u_date = scalar localtime "$1";
1099 if ($unmerge_found)
1100 {
1101 print " $u_date <<<", colored(" $2\n", $COLORS{'red'});
1102 }
1103 }
1104 }
1105 }
1106 }
1107 if (!$e_count and !$list_found and !$rsync_found)
1108 {
1109 if ($e_count == 0)
1110 {
1111 if ($online_query)
1112 {
1113
1114 #query gentoo.linuxhowtos.org
1115 $tm_secondi += lhtoquery($ebuild_arg, \$e_count);
1116 }
1117 }
1118 if ($e_count > 0)
1119 {
1120 print "Estimated merge time: ";
1121 &gtime($tm_secondi);
1122 &print_gtime();
1123 }
1124 else
1125 {
1126 print color 'bold red';
1127 print "!!! Error: no merge found for \'$ebuild_arg\'";
1128 print color 'reset';
1129 }
1130 print "\n";
1131 }
1132 elsif ($info_found)
1133 {
1134 &info($info_target);
1135 }
1136 else
1137 {
1138 $e_count = 0;
1139 }
1140 }
1141
1142 if ($lhtomsg)
1143 {
1144 print color 'bold yellow';
1145 print "$lhtomsg\n";
1146 print color 'reset';
1147 }

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.20