r65277 - /scripts/perl_team_udd

xoswald at users.alioth.debian.org xoswald at users.alioth.debian.org
Fri Nov 26 00:11:37 UTC 2010


Author: xoswald
Date: Fri Nov 26 00:10:24 2010
New Revision: 65277

URL: http://svn.debian.org/wsvn/?sc=1&rev=65277
Log:
Add perl script to generate statistics from UDD

Added:
    scripts/perl_team_udd   (with props)

Added: scripts/perl_team_udd
URL: http://svn.debian.org/wsvn/scripts/perl_team_udd?rev=65277&op=file
==============================================================================
--- scripts/perl_team_udd (added)
+++ scripts/perl_team_udd Fri Nov 26 00:10:24 2010
@@ -1,0 +1,279 @@
+#!/usr/bin/perl 
+
+# Copyright (C) 2010  Xavier Oswald <xoswald at debian.org>
+#
+# Copying and distribution of this file, with or without modification,
+# are permitted in any medium without royalty provided the copyright
+# notice and this notice are preserved.  This file is offered as-is,
+# without any warranty.
+#
+# Preview can be found at http://alioth.debian.org/~xoswald/
+#
+# This script should be executed on alioth due to local DB connection.
+#
+#TODO:
+# - Add comments about datas
+# - Test failure of DB connection
+# - Improve HTML export
+# - Store an history and create history charts
+
+use DBI;
+use GD::Graph::bars;
+use strict;
+use warnings;
+
+my $target       = "squeeze";
+my $team         = "Perl team";
+my $maintainer   = "pkg-perl-maintainers\@lists.alioth.debian.org";
+my $package_type = "lib%perl";
+
+my $export_file   = "index";
+my $export_format = "html";
+my $export_header = "
+<html>
+<head>
+	<title>$team UDD statistics</title>
+</head>
+<body>";
+
+my $export_footer ="
+<hr />
+<h1>Authors and Contributors</h1> 
+<ul> 
+<li><b>Xavier Oswald \<<a href=\"mailto:xoswald\@debian.org\">xoswald\@debian.org</a>\></b></li> 
+</ul> 
+
+<hr />
+<h1>License</h1>
+<p>Copyright (c) 2009, 2010 by the individual authors and contributors noted
+above.  All rights reserved. This document is free software; you may
+redistribute it and/or modify it under the same terms as Perl itself</p> 
+<p>Perl is distributed under your choice of the GNU General Public License or the
+Artistic License.  On Debian GNU/Linux systems, the complete text of the GNU
+General Public License can be found in `/usr/share/common-licenses/GPL' and the
+Artistic License in `/usr/share/common-licenses/Artistic'.</p> 
+</body>
+</html>";
+
+my @charts = (
+	"Nb_packages",
+	"Popcon",
+	"Lintian_warnings",
+	"Open_bugs",
+	"Archived_bugs",
+	"Rc_bugs"
+);
+
+my %results = ();
+my %requests = ( 
+	"Nb_packages_perl" =>
+		 	"SELECT count(*)" .
+			" FROM sources" .
+			" WHERE source like \'$package_type\'" .
+			" AND maintainer_email=\'$maintainer\'" . 
+			" AND release=\'$target\'",
+	"Nb_packages_other" =>
+		 	"SELECT count(*)" .
+			" FROM sources" .
+			" WHERE source like \'$package_type\'" .
+			" AND maintainer_email!=\'$maintainer\'" . 
+			" AND release=\'$target\'",
+	"Popcon_perl" =>
+			"SELECT sum(insts)" .
+			" FROM popcon_src, sources" .
+			" WHERE popcon_src.source like \'$package_type\'" .
+			" AND sources.source = popcon_src.source" .
+			" AND maintainer_email=\'$maintainer\'" .
+			" AND release=\'$target\'",
+	"Popcon_other" =>
+			"SELECT sum(insts)" .
+			" FROM popcon_src, sources" .
+			" WHERE popcon_src.source like \'$package_type\'" .
+			" AND sources.source = popcon_src.source" .
+			" AND maintainer_email!=\'$maintainer\'" .
+			" AND release=\'$target\'",
+	"Lintian_warnings_perl" =>
+			"SELECT count(*)" .
+			" FROM lintian, packages" .
+			" WHERE lintian.package like \'$package_type\'" .
+			" AND packages.package = lintian.package" .
+			" AND maintainer_email=\'$maintainer\'" .
+			" AND release=\'$target\'".
+			" AND (tag_type=\'error\' OR tag_type=\'warning\')",
+	"Lintian_warnings_other" =>
+			"SELECT count(*)" .
+			" FROM lintian, packages" .
+			" WHERE lintian.package like \'$package_type\'" .
+			" AND packages.package = lintian.package" .
+			" AND maintainer_email!=\'$maintainer\'" .
+			" AND release=\'$target\'".
+			" AND (tag_type=\'error\' OR tag_type=\'warning\')",
+	"Open_bugs_perl" =>
+			"SELECT count(*)" .
+			" FROM bugs, sources" .
+			" WHERE bugs.source like \'$package_type\'" .
+			" AND sources.source = bugs.source" .
+			" AND maintainer_email=\'$maintainer\'" .
+			" AND release=\'$target\'",
+	"Open_bugs_other" =>
+			"SELECT count(*)" .
+			" FROM bugs, sources" .
+			" WHERE bugs.source like \'$package_type\'" .
+			" AND sources.source = bugs.source" .
+			" AND maintainer_email!=\'$maintainer\'" .
+			" AND release=\'$target\'",
+	"Archived_bugs_perl" =>
+			"SELECT count(*)" .
+			" FROM archived_bugs, sources" .
+			" WHERE archived_bugs.source like \'$package_type\'" .
+			" AND sources.source = archived_bugs.source" .
+			" AND maintainer_email=\'$maintainer\'" .
+			" AND release=\'$target\'",
+	"Archived_bugs_other" =>
+			"SELECT count(*)" .
+			" FROM archived_bugs, sources" .
+			" WHERE archived_bugs.source like \'$package_type\'" .
+			" AND sources.source = archived_bugs.source" .
+			" AND maintainer_email!=\'$maintainer\'" .
+			" AND release=\'$target\'",
+	"Rc_bugs_perl" =>
+			"SELECT count(bugs.id)" .
+			" FROM bugs, sources" .
+			" WHERE bugs.source like \'$package_type\'" .
+			" AND sources.source = bugs.source" .
+			" AND maintainer_email=\'$maintainer\'" .
+			" AND release=\'$target\'".
+			" AND (severity=\'critical\' OR severity=\'grave\' OR severity=\'serious\')".
+			" AND affects_testing=TRUE",
+	"Rc_bugs_other" =>
+			"SELECT count(bugs.id)" .
+			" FROM bugs, sources" .
+			" WHERE bugs.source like \'$package_type\'" .
+			" AND sources.source = bugs.source" .
+			" AND maintainer_email!=\'$maintainer\'" .
+			" AND release=\'$target\'".
+			" AND (severity=\'critical\' OR severity=\'grave\' OR severity=\'serious\')".
+			" AND affects_testing=TRUE",
+);
+			
+sub save_chart
+{
+	my ($local_type_stat, $local_perl_stat, $local_other_stat, $local_max_y) = @_;
+	
+	my @data = (
+			[$local_type_stat],
+			[$local_perl_stat],
+			[$local_other_stat],
+		   );
+
+	my $my_graph = GD::Graph::bars->new(180,300);
+
+	$my_graph->set(
+			title           => $local_type_stat,
+			long_ticks      => 1,
+			y_max_value     => $local_max_y,
+			y_tick_number   => 10,
+			y_label_skip    => 2,
+			bar_spacing     => 3,
+			shadow_depth    => 4,
+			accent_treshold => 200,
+			transparent     => 0,
+	);
+
+	$my_graph->set_legend($team, 'Others');
+	$my_graph->plot(\@data);
+
+	#Save to file
+	local(*OUT);
+	my $ext = $my_graph->export_format;
+	open(OUT, ">$local_type_stat.$ext") or  
+		die "Cannot open $local_type_stat.$ext for write: $!";
+	binmode OUT;
+	print OUT $my_graph->gd->$ext();
+	close OUT;
+}
+
+
+sub save_html_page
+{
+	open FILE, ">$export_file.$export_format" or die $!;
+	print FILE $export_header;
+
+	print FILE "<h1> $team statistics </h1>\n";
+	print FILE "<p> This page shows some statistics depending the maintainer of lib<b>FOO</b>perl is the perl team or someone else.<p>\n";
+	print FILE "<hr />\n";
+	print FILE "<h2>Target = $target</h2>\n";	
+	print FILE "<table><tr>\n";
+	foreach my $stat (@charts) {
+		print FILE "  <td><img src=\"$stat.gif\"></img></td>\n" 
+	}
+	print FILE "</table><tr>\n";
+
+	print FILE "<br />\n";
+
+	print FILE "<table border=1>\n";
+	print FILE "<tr><td width=\"200\">--</td><td width=\"100\">$team</td><td width=\"100\">Other</td><td width=\"100\">TOTAL</td></tr>\n";
+	foreach my $stat (@charts) {
+		my $perl_stat   = $results{$stat."_perl"};
+		my $other_stat	= $results{$stat."_other"};
+		my $total = $perl_stat + $other_stat;
+		
+		print FILE "<tr>\n";
+		print FILE "<td>$stat</td>\n";
+		print FILE "<td>$perl_stat</td><td>$other_stat</td><td>$total</td>\n";
+		print FILE "</tr>\n";
+	}
+
+	print FILE "</table>\n";
+	
+	print FILE "<br />\n";
+
+	print FILE $export_footer;
+	close FILE or die $!; 
+}
+
+# Y AXE FOR CHARTS
+sub max_y
+{
+	my ($x,$y) = @_;
+	my $val = $x >= $y ? $x : $y;
+	if($val < 1){
+		return 10;
+	} else {
+		return ($val * 110 / 100);
+	}
+}
+
+my $conn = DBI->connect('dbi:Pg:dbname=udd;host=localhost;port=5441','guest', '');
+
+# EXECUTE ALL REQUESTS
+while( my ($k,$v) = each(%requests) )
+{
+	print("Processing $k... ");
+	my $query = $conn->prepare($v);
+	$query->execute();
+	my $row = $query->fetchrow_array();
+	$results{$k} = $row;
+	print("$row\n");
+	undef($query);
+}
+
+# PARSE RESULTS AND CREATE CHARTS
+foreach my $chart (@charts)
+{
+	my $perl_stat   = $results{$chart."_perl"};
+	my $other_stat	= $results{$chart."_other"};
+
+	# CHARTS ARE UGLY WITH A 0 VALUE
+	if($perl_stat == 0) {$perl_stat = 0.01;}
+	if($other_stat == 0) {$other_stat = 0.01;}
+
+	save_chart($chart, $perl_stat, $other_stat, max_y($perl_stat, $other_stat));
+}
+
+$conn->disconnect();
+$conn = undef;
+
+save_html_page;
+
+1;

Propchange: scripts/perl_team_udd
------------------------------------------------------------------------------
    svn:executable = *




More information about the Pkg-perl-cvs-commits mailing list