[Popcon-commits] cvs commit to popularity-contest by ballombe

popcon-commits@lists.alioth.debian.org popcon-commits@lists.alioth.debian.org
Wed, 16 Feb 2005 16:27:39 -0700


Update of /cvsroot/popcon/popularity-contest
In directory haydn:/tmp/cvs-serv23371

Modified Files:
	popcon.pl 
Log Message:
popcon.pl: compute statistics for source packages.


Index: popcon.pl
===================================================================
RCS file: /cvsroot/popcon/popularity-contest/popcon.pl,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- popcon.pl	19 Nov 2004 14:51:24 -0000	1.13
+++ popcon.pl	16 Feb 2005 23:27:36 -0000	1.14
@@ -83,7 +83,7 @@
 Made by <a href="mailto:ballombe\@debian.org"> Bill Allombert </a>. Last generated on $date UTC. <br>
 <a href="http://popcon.alioth.debian.org" > Popularity-contest project <a> by Avery Pennarun, Bill Allombert and Petter Reinholdtsen.
 <BR>
-Copyright (C) 2004 <A HREF="http://www.spi-inc.org/">SPI</A>;
+Copyright (C) 2004-2005 <A HREF="http://www.spi-inc.org/">SPI</A>;
 See <A HREF="http://www.debian.org/license">license terms</A>.
 </small>
 </body>
@@ -103,32 +103,31 @@
    print HTML ("<a href=\"$dir/by_$f\">$f</a> [<a href=\"$dir/by_$f.gz\">gz</a>] ");
 }
 
+%list_header=(
+"maint" => <<"EOF",
+#<name> is the developer name;
+#
+#The fields below are the sum for all the packages maintained by that
+#developer:
+EOF
+"source" => <<"EOF");
+#<name> is the source package name;
+#
+#The fields below are the sum for all the binary packages generated by
+#that source package:
+EOF
+
 sub make_by
 {
   my ($sec,$order,$pkg,@list) = @_;
-  my %sum;
+  my (%sum, $me);
   @list = sort {$pkg->{$b}->{$order}<=> $pkg->{$a}->{$order} || $a cmp $b } @list;
   $winner{"$sec/$order"}=$list[0];
   open DAT , "| tee $popcon/$sec/by_$order | gzip -c > $popcon/$sec/by_$order.gz";
-  if ($sec eq "maint")
+  if (defined($list_header{$sec}))
   {
-    print DAT <<"EOF";
-#Format
-#   
-#<name> is the developer name;
-#
-#The fields below are the sum for all the packages maintained by that
-#developer:
-#
-#<inst> is the number of people who installed this package;
-#<vote> is the number of people who use this package regularly;
-#<old> is the number of people who installed, but don't use this package
-#      regularly;
-#<recent> is the number of people who upgraded this package recently;
-#<no-files> is the number of people whose entry didn't contain enough
-#           information (atime and ctime were 0).
-#rank name                            inst  vote   old recent no-files
-EOF
+    print DAT $list_header{$sec};
+    $me="";
   }
   else 
   {
@@ -136,22 +135,25 @@
 #Format
 #   
 #<name> is the package name;
+EOF
+    $me="(maintainer)";
+  }
+  print DAT << "EOF";
 #<inst> is the number of people who installed this package;
 #<vote> is the number of people who use this package regularly;
 #<old> is the number of people who installed, but don't use this package
-#        regularly;
+#      regularly;
 #<recent> is the number of people who upgraded this package recently;
 #<no-files> is the number of people whose entry didn't contain enough
-#        information (atime and ctime were 0).
-#rank name                            inst  vote   old recent no-files (maintainer)
+#           information (atime and ctime were 0).
+#rank name                            inst  vote   old recent no-files $me
 EOF
-  }
   $format="%-5d %-30s".(" %5d"x($#fields+1))." %-32s\n";
   my $rank=0;
   for $p (@list)
   {
     $rank++;
-    my $m=($sec eq "maint"?"":"($maint{$p})");
+    my $m=(defined($list_header{$sec})?"":"($maint{$p})");
     printf  DAT $format, $rank, $p, (map {$pkg->{$p}->{$_}} @fields), $m;
     $sum{$_}+=$pkg->{$p}->{$_} for (@fields);
   }
@@ -174,8 +176,10 @@
 %pkg=();
 %section=();
 %maint=();
+%source=();
 %winner=();
 %maintpkg=();
+%sourcepkg=();
 @fields=("inst","vote","old","recent","no-files");
 
 for $file ("slink","slink-nonUS","potato","potato-nonUS","woody","woody-nonUS")
@@ -189,6 +193,7 @@
 	  $sec =~ m{^(non-US|contrib|non-free)/} or $sec="main/$sec";
 	  $section{$p}=$sec;
 	  $maint{$p}="Not in sid";
+	  $source{$p}="Not in sid";
   }
   close AVAIL;
 }
@@ -199,9 +204,10 @@
   open AVAIL, "$file";
   while(<AVAIL>)
   {
-/Package: (.+)/  and do {$p=$1;$maint{$p}="bug";next;};
-/Maintainer: ([^()]+) (\(.+\) )*<.+>/ and do { $maint{$p}=join(' ',map{ucfirst($_)} split(' ',lc $1));next;};
-/Section: (.+)/ or next;
+/^Package: (.+)/  and do {$p=$1;$maint{$p}="bug";$source{$p}=$p;next;};
+/^Maintainer: ([^()]+) (\(.+\) )*<.+>/ and do { $maint{$p}=join(' ',map{ucfirst($_)} split(' ',lc $1));next;};
+/^Source: (\S+)/ and do { $source{$p}=$1;next;};
+/^Section: (.+)/ or next;
           $sec=$1;
           $sec =~ m{^(non-US|contrib|non-free)/} or $sec="main/$sec";
           $section{$p}=$sec;
@@ -220,7 +226,6 @@
 #<recent> is the number of people who upgraded this package recently;
 #<no-files> is the number of people whose entry didn't contain enough
 #        information (atime and ctime were 0).
-
 open PKG, "$results";
 while(<PKG>)
 {
@@ -232,11 +237,13 @@
 	  unshift @votes,$votes[0]+$votes[1]+$votes[2]+$votes[3];
 	  $section{$name}='unknown' unless (defined($section{$name}));
 	  $maint{$name}='Not in sid' unless (defined($maint{$name}));
+	  $source{$name}='Not in sid' unless (defined($source{$name}));
 	  for(my $i=0;$i<=$#fields;$i++)
 	  {
 		  my ($f,$v)=($fields[$i],$votes[$i]);
 		  $pkg{$name}->{$f}=$v;
 		  $maintpkg{$maint{$name}}->{$f}+=$v;
+		  $sourcepkg{$source{$name}}->{$f}+=$v;
 	  }
   }
   elsif ($type eq "Architecture:")
@@ -259,6 +266,7 @@
 %sections = map {$section{$_} => 1} keys %section;
 @sections = sort keys %sections;
 @maints= sort keys %maintpkg;
+@sources= sort keys %sourcepkg;
 
 for $sec (@sections)
 {
@@ -278,6 +286,8 @@
 }
 make_sec "maint";
 make_by ("maint", $_, \%maintpkg, @maints) for (@fields);
+make_sec "source";
+make_by ("source", $_, \%sourcepkg, @sources) for (@fields);
 for $sec (@dists)
 {
   open HTML , "> $popcon/$sec/index.html";
@@ -345,6 +355,9 @@
 	print HTML ("</pre>\n </p> \n");
 	printf HTML ("<p>Statistics by maintainers sorted by fields: <pre>",$sec);
 	print_by ("maint",$_) for (@fields);
+	print HTML ("</pre>\n </p> \n");
+	printf HTML ("<p>Statistics by source packages sorted by fields: <pre>",$sec);
+	print_by ("source",$_) for (@fields);
 	print HTML ("</pre>\n </p> \n");
 	printf HTML ("<p>Statistics for sections sorted by fields\n <pre>\n");
   	for $dir ("main","contrib","non-free","non-US","unknown")