#! /usr/bin/perl -wT $popcon="."; sub htmlheader { print HTML <<"EOH"; Debian Popularity Contest
Debian Project

Debian Popularity Contest
EOH } sub htmlfooter { my $date=`LANG=C date -u`; print HTML ("\n \n

\n"); print HTML < inst : number of people who installed this package; vote : number of people who use this package regularly; old : number of people who installed, but don't use this package regularly; recent : number of people who upgraded this package recently; no-files : number of people whose entry didn't contain enough information (atime and ctime were 0).

Number of submissions considered: $numsub

To participate in this survey: apt-get install popularity-contest

EOF print HTML <


Made by Bill Allombert . Last generated on $date.
Popularity-contest project by Avery Pennarun, Bill Allombert and Petter Reinholdtsen.
Copyright (C) 2003
SPI; See license terms. EOH } sub make_sec { my $sec="$popcon/$_[0]"; print "$sec\n"; -d $sec || system("mkdir","-p","$sec"); } sub make_by { my ($sec,$order,$pkg,@list) = @_; my %sum; @list = sort {$pkg->{$b}->{$order}<=> $pkg->{$a}->{$order} || $a cmp $b } @list; $winner{"$sec/$order"}=$list[0]; my $m=($sec eq "maint"?"":"(maintainer)"); open DAT , "> $popcon/$sec/by_$order"; print DAT <<"EOF"; #Format # # is the package name; # is the number of people who installed this package; # is the number of people who use this package regularly; # is the number of people who installed, but don't use this package # regularly; # is the number of people who upgraded this package recently; # 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 $m EOF $format="%-5d %-30s".(" %5d"x($#fields+1))." %-32s\n"; my $rank=0; for $p (@list) { $rank++; my $m=($sec eq "maint"?"":"($maint{$p})"); printf DAT $format, $rank, $p, (map {$pkg->{$p}->{$_}} @fields), $m; $sum{$_}+=$pkg->{$p}->{$_} for (@fields); } print DAT '-'x66,"\n"; printf DAT $format, $rank, "Total", map {defined($sum{$_})?$sum{$_}:0} @fields; close DAT; } sub print_pkg { my ($pkg)=@_; return unless (defined($pkg)); my $size=length $pkg; my $pkgt=substr($pkg,0,20); print HTML "$pkgt ", ' 'x(20-$size); } %pkg=(); %section=(); %maint=(); %winner=(); %maintpkg=(); @fields=("inst","vote","old","recent","no-files"); for $file ("slink","slink-nonUS","potato","potato-nonUS","woody","woody-nonUS") { open AVAIL, "< $file.sections" or die "Cannot open $file.sections"; while() { my ($p,$sec)=split(' '); defined($sec) or last; chomp $sec; $sec =~ m{^(non-US|contrib|non-free)/} or $sec="main/$sec"; $section{$p}=$sec; $maint{$p}="Not in sid"; } close AVAIL; } for $file (glob("/org/ftp.root/debian/dists/testing/*/binary-*/Packages"),glob("/org/ftp.root/debian/dists/sid/*/binary-*/Packages")) { open AVAIL, "$file"; while() { /Package: (.+)/ and do {$p=$1;$maint{$p}="bug";next;}; /Maintainer: ([^()]+) (\(.+\) )*<.+>/ and do { $maint{$p}=join(' ',map{ucfirst($_)} split(' ',lc $1));next;}; /Section: (.+)/ or next; $sec=$1; $sec =~ m{^(non-US|contrib|non-free)/} or $sec="main/$sec"; $section{$p}=$sec; } close AVAIL; } $ENV{PATH}="/bin:/usr/bin"; $numsub=`/bin/cat ~apenwarr/public_html/popcon/num-submissions`; #Format # # # is the package name; # is the number of people who use this package regularly; # is the number of people who installed, but don't use this package # regularly; # is the number of people who upgraded this package recently; # is the number of people whose entry didn't contain enough # information (atime and ctime were 0). open PKG, "zcat ~apenwarr/public_html/popcon/all-popcon-results.txt.gz|"; while() { my ($name,@votes)=split(" "); 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})); for(my $i=0;$i<=$#fields;$i++) { my ($f,$v)=($fields[$i],$votes[$i]); $pkg{$name}->{$f}=$v; $maintpkg{$maint{$name}}->{$f}+=$v; } } @pkgs=sort keys %pkg; %sections = map {$section{$_} => 1} keys %section; @sections = sort keys %sections; @maints= sort keys %maintpkg; for $sec (@sections) { my @list = grep {$section{$_} eq $sec} @pkgs; make_sec $sec; for $order (@fields) { make_by $sec, $order, \%pkg, @list; } } @dists=("main","contrib","non-free","non-US"); #There is a hack: '.' is both the current directory and #the catchall regexp. for $sec (".",@dists) { print "/$sec\n"; my @list = grep {$section{$_} =~ /^$sec/ } @pkgs; for $order (@fields) { make_by $sec, $order, \%pkg, @list; } } { print "/maint\n"; make_sec "maint"; for $order (@fields) { make_by "maint", $order, \%maintpkg, @maints; } } for $sec (@dists) { print "html/$sec\n"; open HTML , "> $popcon/$sec/index.html"; opendir SEC,"$popcon/$sec"; &htmlheader; printf HTML ("

Statistics for the section %-16s sorted by fields: ",$sec); for $f (@fields) { print HTML (" $f " ); } print HTML ("\n

\n"); printf HTML ("

First packages in subsections for each fields \n"); printf HTML ("

Statistics for subsections sorted by fields\n

\n");
  for $dir (sort readdir SEC)
  {
    -d "$popcon/$sec/$dir" or next;
    $dir !~ /^\./ or next;
    printf HTML ("%-16s : ",$dir);
    for $f (@fields)
    {
      print HTML (" $f  " );
    }
    print HTML ("\n");
  }
  &htmlfooter;
  closedir SEC;
  close HTML;
}
for $sec (@dists)
{
  print "html/$sec\n";
  open HTML , "> $popcon/$sec/first.html";
  opendir SEC,"$popcon/$sec";
  &htmlheader;
  printf HTML ("

First package in section %-16s for fields: ",$sec); for $f (@fields) { print_pkg $winner{"$sec/$f"}; } print HTML ("\n

\n"); printf HTML ("

Statistics by subsections sorted by fields \n"); printf HTML ("

First package in subsections for fields\n

\n");
  printf HTML ("%-16s : ","subsection");
  for $f (@fields)
  {
	  printf HTML ("%-20s ",$f);
  }
  print HTML ("\n","_"x120,"\n");
  for $dir (sort readdir SEC)
  {
	  -d "$popcon/$sec/$dir" or next;
	  $dir !~ /^\./ or next;
	  printf HTML ("%-16s : ",$dir);
	  for $f (@fields)
	  {
		  print_pkg $winner{"$sec/$dir/$f"};
	  }
	  print HTML ("\n");
  }
  &htmlfooter;
  closedir SEC;
  close HTML;
}
{
	print "html/\n";
	open HTML , "> $popcon/index.html";
	&htmlheader;
	printf HTML ("

Statistics for the whole archive sorted by fields:

",$sec);
	for $f (@fields)
	{
		print HTML (" $f  " );
	}
	print HTML ("
\n

\n"); printf HTML ("

Statistics by maintainers sorted by fields:

",$sec);
	for $f (@fields)
	{
		print HTML (" $f  " );
	}
	print HTML ("
\n

\n"); printf HTML ("

Statistics for sections sorted by fields\n

\n");
  	for $dir ("main","contrib","non-free","non-US","unknown")
	{
		-d "$popcon/$dir" or next;
		$dir !~ /^\./ or next;
		if ($dir eq "unknown")
		{
			printf HTML ("%-16s : ",$dir);
		}
		else
		{
			printf HTML ("%-16s : ",$dir);
		}
		for $f (@fields)
		{
			print HTML (" $f  " );
		}
		print HTML ("\n");
	}
	&htmlfooter;
	close HTML;
}