Author: sparky Date: Thu Oct 29 22:27:42 2009 New Revision: 10879 Added: toys/stbr/queue_parser.pl Log: - new, queue.gz parser
Added: toys/stbr/queue_parser.pl ============================================================================== --- (empty file) +++ toys/stbr/queue_parser.pl Thu Oct 29 22:27:42 2009 @@ -0,0 +1,143 @@ +#!/usr/bin/perl +# +# 2009 (c) Przemysław Iskra <[email protected]> +# It's GPL v2+ ! +# +use strict; +use warnings; +use WWW::Curl::Easy; +use Compress::Zlib (); +use Data::Dumper; + +my $data_dir = $ENV{PWD}; + +my $line = shift @ARGV; +$line ||= "th"; +$line = ucfirst lc $line; + +my %queue_uri = ( + Th => 'http://ep09.pld-linux.org/~builderth/queue.gz', + Ti => 'http://ep09.pld-linux.org/~builderti/queue.gz', +); + +my $uri = $queue_uri{ $line } || die "Line $line not supported\n"; + +my $data_file = "$data_dir/saved-vars-$line.pl"; +my $data = do $data_file; +$data ||= { last_time => time - 60, printed => {} }; +my %printed; + + +my %status_to_color = ( + '?' => "bold", + OK => "green", + FAIL => "red", + SKIP => "blue", + UNSUPP => "magenta", +); + +my %color_to_code = ( + red => 5, + green => 3, + yellow => 7, + blue => 2, + magenta => 6, + "" => 0, +); +sub color +{ + my $color = shift || ""; + return "\002" if $color eq "bold"; + return "\003" . $color_to_code{$color}; +} + +sub get +{ + my $uri = shift; + + my $curl = new WWW::Curl::Easy; + $curl->setopt( CURLOPT_URL, $uri ); + + my $body; + open my $body_f, ">", \$body; + + $curl->setopt( CURLOPT_WRITEDATA, $body_f ); + + my $retcode = $curl->perform; + + if ( $retcode ) { + die "$line queue download error: " . $curl->strerror( $retcode ) . " ($retcode)\n"; + } + return Compress::Zlib::memGunzip( $body ); +} + + +my $xml = get( $uri ); +$xml =~ s{</queue>.*}{}s; + +my $now = time; + +my $printed_something = 0; +my $done_so_far = 1; +my @group = $xml =~ m{(<group.*?</group>)}gs; +foreach my $grp ( @group ) { + my ($time) = $grp =~ m{<time>(\d+)</time>}; + next if $time <= $data->{last_time}; + + my @pkg = $grp =~ m{(<batch.*?</batch>)}gs; + foreach my $p ( @pkg ) { + my ($id) = $p =~ m{<batch id='(.*?)'}; + + if ( $data->{printed}->{$id} ) { + $printed{$id} = 1; + next; + } + + my ($rpm) = $p =~ m{<src-rpm>(.*?)</src-rpm>}; + if ( $rpm ) { + $rpm =~ s/\.src\.rpm$//; + } else { + ($rpm) = $p =~ m{<command flags="">(.*?)</command>}; + } + + my $all_done = 1; + my $some_done = 0; + my @status; + my @builders = $p =~ m{(<builder.*?</builder>)}g; + foreach my $b ( @builders ) { + my ( $status, $builder ) = $b =~ m{status='(.*?)'.*?>(.*?)</builder>}; + my $color = $status_to_color{ $status } || "red"; + push @status, "$builder: " . color($color) . "$status\017"; + if ( $status eq "?" ) { + $all_done = 0; + } else { + $some_done = 1; + } + } + + my $print = undef; + if ( $all_done ) { + $print = 1; + } elsif ( $some_done ) { + $print = 0 if $time + 120 < $now; + } + if ( not $all_done ) { + $done_so_far = 0; + $printed{$id} = 0 if $some_done; + next if exists $data->{printed}->{$id}; + } + + if ( defined $print ) { + $printed{$id} = $print; + $printed_something++; + print color( "yellow" ) ."$line\017: $rpm\002:\017 " . ( join ", ", @status ) . "\n"; + } + } + $data->{last_time} = $time if $done_so_far; + last if $printed_something > 4; +} + +$data->{printed} = \%printed; +open F_OUT, ">", $data_file; +print F_OUT Dumper( $data ); +close F_OUT; _______________________________________________ pld-cvs-commit mailing list [email protected] http://lists.pld-linux.org/mailman/listinfo/pld-cvs-commit
