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