SVN: toys/fun/queue_notify.pl

[sparky]

Author: sparky
Date: Fri Apr 23 22:08:16 2010
New Revision: 11341

Added:
   toys/fun/queue_notify.pl   (contents, props changed)
Log:
- builder queue notifier, sends info via notify-send command


Added: toys/fun/queue_notify.pl
==============================================================================
--- (empty file)
+++ toys/fun/queue_notify.pl	Fri Apr 23 22:08:16 2010
@@ -0,0 +1,170 @@
+#!/usr/bin/perl
+#
+# 2010 (c) Przemysław Iskra <sparky at pld-linux.org>
+# It's GPL v2+!
+#
+use strict;
+use warnings;
+use WWW::Curl::Easy;
+use WWW::Curl::Share;
+use Compress::Zlib ();
+use Data::Dumper;
+
+my $line = shift @ARGV;
+$line ||= "th";
+$line = ucfirst lc $line;
+$line = "AidaTh" if lc $line eq "aidath";
+
+my %queue_uri = (
+	AidaTh => 'http://ep09.pld-linux.org/~builderaidath/queue.gz',
+	Ac => 'http://ep09.pld-linux.org/~buildsrc/queue.gz',
+	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 $curlsh = new WWW::Curl::Share;
+$curlsh->setopt( CURLSHOPT_SHARE, CURL_LOCK_DATA_DNS );
+
+my %status_to_color = (
+	'?' => "white",
+	OK => "green",
+	FAIL => "red",
+	SKIP => "blue",
+	UNSUPP => "magenta",
+);
+
+my $last_modified = "";
+sub check
+{
+	my $curl = new WWW::Curl::Easy;
+	$curl->setopt( CURLOPT_SHARE, $curlsh );
+	$curl->setopt( CURLOPT_URL, $uri );
+	$curl->setopt( CURLOPT_NOBODY, 1 );
+
+	my $body;
+	open my $body_f, ">", \$body;
+	$curl->setopt( CURLOPT_WRITEHEADER, $body_f );
+
+	if ( my $retcode = $curl->perform() ) {
+		die "$line queue download error: " . $curl->strerror( $retcode )
+			. " ($retcode)\n";
+	}
+
+	my $lm = $last_modified;
+	$body =~ /Last-Modified: (.*)/i;
+	$last_modified = $1;
+
+	return $lm ne $last_modified;
+}
+
+sub get
+{
+	my $curl = new WWW::Curl::Easy;
+	$curl->setopt( CURLOPT_SHARE, $curlsh );
+	$curl->setopt( CURLOPT_URL, $uri );
+
+	my $body;
+	open my $body_f, ">", \$body;
+	$curl->setopt( CURLOPT_WRITEDATA, $body_f );
+
+	if ( my $retcode = $curl->perform() ) {
+		die "$line queue download error: " . $curl->strerror( $retcode )
+			. " ($retcode)\n";
+	}
+	return Compress::Zlib::memGunzip( $body );
+}
+
+my $printed = {};
+my $last_time = time() - 1600;
+sub update
+{
+	my $xml = shift;
+	my $now = time;
+	my %printed;
+
+	my $done_so_far = 1;
+	my @group = $xml =~ m{(<group.*?</group>)}gs;
+	GROUP: foreach my $grp ( @group ) {
+		my ($time) = $grp =~ m{<time>(\d+)</time>};
+		next if $time <= $last_time;
+	
+		my $pre = "$line";
+		if ( $grp =~ m{<group.*?flags="test-build">} ) {
+			$pre .= " (test)";
+		}
+	
+		my ($requester) = $grp =~ m{<requester email='.*?'>(.*?)</requester>};
+	
+		my @pkg = $grp =~ m{(<batch.*?</batch>)}gs;
+		foreach my $p ( @pkg ) {
+			my ($id) = $p =~ m{<batch id='(.*?)'};
+	
+			if ( ( $printed->{$id} or "" ) eq "all" ) {
+				$printed{$id} = "all";
+				next;
+			}
+	
+			my ($rpm) = $p =~ m{<src-rpm>(.*?)</src-rpm>};
+			if ( $rpm ) {
+				$rpm =~ s/\.src\.rpm$//;
+				$rpm = "<span color='cyan'>$1</span>$2" if $rpm =~ /^(.*)(-.*?-.*?)$/;
+			} else {
+				$p =~ m{<command flags="(.*?)">(.*?)</command>};
+				$rpm = $1 ? "<span color='cyan'>$2</span> ($1)" : $2;
+			}
+			if ( $p =~ m{<branch>(.+?)</branch>} ) {
+				my $branch = $1;
+				$rpm .= " (<span color='yellow'>$branch</span>)"
+					if $branch ne "HEAD";
+			}
+	
+			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: <span color='$color'>$status</span>";
+				if ( $status eq "?" ) {
+					$all_done = 0;
+				} else {
+					$some_done++;
+				}
+			}
+	
+			if ( $all_done ) {
+				# all done
+				$printed{$id} = "all";
+			} else {
+				$done_so_far = 0;
+				next unless $some_done;
+	
+				# some done ?
+				my $ftime = $printed->{$id};
+				$printed{$id} = $some_done;
+				next if $ftime and $ftime == $some_done;
+			}
+	
+			system "notify-send", $pre, 
+				"<span color='green'>" . $requester . "</span> *\n" .
+				"$rpm<b>:</b>\n - " . ( join "\n - ", @status );
+		}
+		$last_time = $time if $done_so_far;
+	}
+}
+
+for (;;) {
+	sleep 10;
+
+	next unless check();
+
+	my $xml = get( $uri );
+	$xml =~ s{</queue>.*}{}s;
+
+	update( $xml );
+}
+
+# vim: ts=4 sw=4