You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
505 lines
15 KiB
505 lines
15 KiB
#! /usr/bin/perl -wT
|
|
|
|
$results="../popcon-mail/results";
|
|
$popcon="../www";
|
|
my $mirrorbase = "/org/ftp.debian.org/ftp";
|
|
my $docurlbase = "";
|
|
%popconver=("1.28" => "sarge", "1.41" => "etch", "1.46" => "lenny", "1.49" => "squeeze");
|
|
%popver=();
|
|
|
|
sub htmlheader
|
|
{
|
|
print HTML <<"EOH";
|
|
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
|
|
<html>
|
|
<head>
|
|
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
|
|
<title> Debian Popularity Contest </title>
|
|
<link rev="made" href="mailto:ballombe\@debian.org">
|
|
<link rel="shortcut icon" href="/favicon.ico">
|
|
</head>
|
|
<body text="#000000" bgcolor="#FFFFFF" link="#0000FF" vlink="#800080" alink="#FF0000">
|
|
<div align="center">
|
|
<a href="http://www.debian.org/">
|
|
<img src="http://www.debian.org/logos/openlogo-nd-50.png" border="0" hspace="0" vspace="0" alt="" width="50" height="61">
|
|
</a>
|
|
<a href="http://www.debian.org/">
|
|
<img src="http://www.debian.org/Pics/debian.jpg" border="0" hspace="0" vspace="0" alt="Debian Project" width="179" height="61">
|
|
</a>
|
|
</div>
|
|
<br>
|
|
<table bgcolor="#DF0451" border="0" width="100%" cellpadding="0" cellspacing="0" summary="">
|
|
<tr>
|
|
<td valign="top">
|
|
<img src="http://www.debian.org/Pics/red-upperleft.png" align="left" border="0" hspace="0" vspace="0" alt="" width="15" height="16">
|
|
</td>
|
|
<td rowspan="2" align="center">
|
|
<font color="#FFFF00"><big><big>Debian Popularity Contest</big></big></font>
|
|
</td>
|
|
<td valign="top">
|
|
<img src="http://www.debian.org/Pics/red-upperright.png" align="right" border="0" hspace="0" vspace="0" alt="" width="16" height="16">
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td valign="bottom">
|
|
<img src="http://www.debian.org/Pics/red-lowerleft.png" align="left" border="0" hspace="0" vspace="0" alt="" width="16" height="16">
|
|
</td>
|
|
<td valign="bottom">
|
|
<img src="http://www.debian.org/Pics/red-lowerright.png" align="right" border="0" hspace="0" vspace="0" alt="" width="15" height="16">
|
|
</td>
|
|
</tr>
|
|
</table>
|
|
EOH
|
|
}
|
|
|
|
sub popconintro
|
|
{
|
|
print HTML <<"EOH";
|
|
<p> <em> The popularity contest project is an attempt to map the usage of
|
|
Debian packages. This site publishes the statistics gathered from report
|
|
sent by users of the <a
|
|
href="http://packages.debian.org/popularity-contest">popularity-contest</a>
|
|
package. This package sends every week the list of packages installed and the
|
|
access time of relevant files to the server via email. Every day the server
|
|
anonymizes the result and publishes this survey.
|
|
For more information, read the <a href="${docurlbase}README">README</a> and the
|
|
<a href="${docurlbase}FAQ">FAQ</a>.
|
|
</em> <p>
|
|
<form method="GET" action="http://qa.debian.org/popcon.php">Popcon statistics
|
|
for source package <input type="text" size="30" maxlength="80" name="package">
|
|
<input type="submit" value="Go">
|
|
</form> <p>
|
|
EOH
|
|
}
|
|
|
|
sub htmlfooter
|
|
{
|
|
my $date=gmtime();
|
|
print HTML <<EOF;
|
|
<pre>
|
|
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).
|
|
</pre>
|
|
<p>
|
|
Number of submissions considered: $numsub
|
|
</p><p>
|
|
To participate in this survey, install the <a href="http://packages.debian.org/popularity-contest">popularity-contest</a> package.
|
|
</p>
|
|
EOF
|
|
print HTML <<EOH
|
|
<p>
|
|
<HR>
|
|
<small>
|
|
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-2005 <A HREF="http://www.spi-inc.org/">SPI</A>;
|
|
See <A HREF="http://www.debian.org/license">license terms</A>.
|
|
</small>
|
|
</body>
|
|
</html>
|
|
EOH
|
|
}
|
|
|
|
sub make_sec
|
|
{
|
|
my $sec="$popcon/$_[0]";
|
|
-d $sec || system("mkdir","-p","$sec");
|
|
}
|
|
|
|
sub print_by
|
|
{
|
|
my ($dir,$f)=@_;
|
|
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
|
|
"sourcemax" => <<"EOF");
|
|
#<name> is the source package name;
|
|
#
|
|
#The fields below are the maximum for all the binary packages generated by
|
|
#that source package:
|
|
EOF
|
|
|
|
sub make_by
|
|
{
|
|
my ($sec,$order,$pkg,@list) = @_;
|
|
my (%sum, $me);
|
|
@list = sort {$pkg->{$b}->{$order}<=> $pkg->{$a}->{$order} || $a cmp $b } @list;
|
|
$winner{"$sec/$order"}=$list[0];
|
|
open DAT , "|-:utf8", "tee $popcon/$sec/by_$order | gzip -c > $popcon/$sec/by_$order.gz";
|
|
if (defined($list_header{$sec}))
|
|
{
|
|
print DAT $list_header{$sec};
|
|
$me="";
|
|
}
|
|
else
|
|
{
|
|
print DAT <<"EOF";
|
|
#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;
|
|
#<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 $me
|
|
EOF
|
|
$format="%-5d %-30s".(" %5d"x($#fields+1))." %-32s\n";
|
|
my $rank=0;
|
|
for $p (@list)
|
|
{
|
|
$rank++;
|
|
my $m=(defined($list_header{$sec})?"":"($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 make
|
|
{
|
|
my ($sec,$pkg,@list)=@_;
|
|
make_sec $sec;
|
|
make_by ($sec, $_, $pkg, @list) for (@fields);
|
|
}
|
|
sub print_pkg
|
|
{
|
|
my ($pkg)=@_;
|
|
return unless (defined($pkg));
|
|
my $size=length $pkg;
|
|
my $pkgt=substr($pkg,0,20);
|
|
print HTML "<a href=\"http://packages.debian.org/$pkg\">$pkgt</a> ",
|
|
' 'x(20-$size);
|
|
}
|
|
sub mark
|
|
{
|
|
print join(" ",$_[0],times),"\n";
|
|
}
|
|
|
|
%pkg=();
|
|
%section=();
|
|
%maint=();
|
|
%source=();
|
|
%winner=();
|
|
%maintpkg=();
|
|
%sourcepkg=();
|
|
%sourcemax=();
|
|
@fields=("inst","vote","old","recent","no-files");
|
|
|
|
for $file ("slink","slink-nonUS","potato","potato-nonUS",
|
|
"woody","woody-nonUS","sarge","etch")
|
|
{
|
|
open AVAIL, "<:utf8", "$file.sections" or die "Cannot open $file.sections";
|
|
while(<AVAIL>)
|
|
{
|
|
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";
|
|
$source{$p}="Not in sid";
|
|
}
|
|
close AVAIL;
|
|
}
|
|
mark "Reading legacy packages...";
|
|
$ENV{PATH}="/bin:/usr/bin";
|
|
|
|
for $dist ("stable", "testing", "unstable")
|
|
{
|
|
for (glob("$mirrorbase/dists/$dist/*/binary-*/Packages.gz"))
|
|
{
|
|
/([^[:space:]]+)/ or die("incorrect package name");
|
|
$file = $1;#Untaint
|
|
open AVAIL, "-|:encoding(UTF-8)","zcat $file";
|
|
while(<AVAIL>)
|
|
{
|
|
/^Package: (.+)/ and do {$p=$1;$maint{$p}="bug";$source{$p}=$p;next;};
|
|
/^Version: (.+)/ && $p eq "popularity-contest"
|
|
and do { $popver{$dist}=$1; 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;
|
|
}
|
|
close AVAIL;
|
|
}
|
|
}
|
|
for $dist ("stable", "testing", "unstable")
|
|
{
|
|
my($v)=$popver{$dist};
|
|
$popconver{$v}=defined($popconver{$v})?"$popconver{$v}/$dist":$dist;
|
|
}
|
|
|
|
mark "Reading current packages...";
|
|
|
|
|
|
#Format
|
|
#<name> <vote> <old> <recent> <no-files>
|
|
#
|
|
#<name> is the package name;
|
|
#<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).
|
|
open PKG, "<:utf8","$results";
|
|
while(<PKG>)
|
|
{
|
|
my ($type,@values)=split(" ");
|
|
if ($type eq "Package:")
|
|
{
|
|
my @votes=@values;
|
|
$name = shift @votes;
|
|
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;
|
|
my($sm)=$sourcemax{$source{$name}}->{$f};
|
|
$sourcemax{$source{$name}}->{$f}=$v
|
|
if (!defined($sm) || $sm < $v);
|
|
}
|
|
}
|
|
elsif ($type eq "Architecture:")
|
|
{
|
|
my ($a,$nb)=@values;
|
|
$arch{$a}=$nb;
|
|
}
|
|
elsif ($type eq "Submissions:")
|
|
{
|
|
($numsub)=@values;
|
|
}
|
|
elsif ($type eq "Release:")
|
|
{
|
|
my ($a,$nb)=@values;
|
|
$release{$a}=$nb;
|
|
}
|
|
}
|
|
mark "Reading stats...";
|
|
|
|
@pkgs=sort keys %pkg;
|
|
%sections = map {$section{$_} => 1} keys %section;
|
|
@sections = sort keys %sections;
|
|
@maints= sort keys %maintpkg;
|
|
@sources= sort keys %sourcepkg;
|
|
|
|
for $sec (@sections)
|
|
{
|
|
my @list = grep {$section{$_} eq $sec} @pkgs;
|
|
make ($sec, \%pkg, @list);
|
|
}
|
|
|
|
mark "Building by sections pages";
|
|
|
|
@dists=("main","contrib","non-free","non-US");
|
|
#There is a hack: '.' is both the current directory and
|
|
#the catchall regexp.
|
|
|
|
for $sec (".",@dists)
|
|
{
|
|
my @list = grep {$section{$_} =~ /^$sec/ } @pkgs;
|
|
make ($sec, \%pkg, @list);
|
|
}
|
|
make ("maint", \%maintpkg, @maints);
|
|
make ("source", \%sourcepkg, @sources);
|
|
make ("sourcemax", \%sourcemax, @sources);
|
|
|
|
for $sec (@dists)
|
|
{
|
|
open HTML , ">:utf8", "$popcon/$sec/index.html";
|
|
opendir SEC,"$popcon/$sec";
|
|
&htmlheader;
|
|
printf HTML ("<p>Statistics for the section %-16s sorted by fields: ",$sec);
|
|
print_by (".",$_) for (@fields);
|
|
print HTML ("\n </p> \n");
|
|
printf HTML ("<p> <a href=\"first.html\"> First packages in subsections for each fields </a>\n");
|
|
printf HTML ("<p>Statistics for subsections sorted by fields\n <pre>\n");
|
|
for $dir (sort readdir SEC)
|
|
{
|
|
-d "$popcon/$sec/$dir" or next;
|
|
$dir !~ /^\./ or next;
|
|
printf HTML ("%-16s : ",$dir);
|
|
print_by ($dir,$_) for (@fields);
|
|
print HTML ("\n");
|
|
}
|
|
print HTML ("\n </pre>\n");
|
|
&htmlfooter;
|
|
closedir SEC;
|
|
close HTML;
|
|
}
|
|
mark "Building by sub-sections pages";
|
|
for $sec (@dists)
|
|
{
|
|
open HTML , ">:utf8", "$popcon/$sec/first.html";
|
|
opendir SEC,"$popcon/$sec";
|
|
&htmlheader;
|
|
printf HTML ("<p>First package in section %-16s for fields: ",$sec);
|
|
for $f (@fields)
|
|
{
|
|
print_pkg $winner{"$sec/$f"};
|
|
}
|
|
print HTML ("\n </p> \n");
|
|
printf HTML ("<p> <a href=\"index.html\"> Statistics by subsections sorted by fields </a>\n");
|
|
printf HTML ("<p>First package in subsections for fields\n <pre>\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");
|
|
}
|
|
print HTML ("\n </pre>\n");
|
|
&htmlfooter;
|
|
closedir SEC;
|
|
close HTML;
|
|
}
|
|
|
|
mark "Building winner pages";
|
|
|
|
{
|
|
open HTML , ">:utf8", "$popcon/index.html";
|
|
&htmlheader;
|
|
&popconintro;
|
|
printf HTML ("<p>Statistics for the whole archive sorted by fields: <pre>",$sec);
|
|
print_by (".",$_) for (@fields);
|
|
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 (sum) sorted by fields: <pre>",$sec);
|
|
print_by ("source",$_) for (@fields);
|
|
print HTML ("</pre>\n </p> \n");
|
|
printf HTML ("<p>Statistics by source packages (max) sorted by fields: <pre>",$sec);
|
|
print_by ("sourcemax",$_) 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")
|
|
{
|
|
-d "$popcon/$dir" or next;
|
|
$dir !~ /^\./ or next;
|
|
if ($dir eq "unknown")
|
|
{
|
|
printf HTML ("%-16s : ",$dir);
|
|
}
|
|
else
|
|
{
|
|
printf HTML ("<a href=\"$dir/index.html\">%-16s</a> : ",$dir);
|
|
}
|
|
print_by ($dir,$_) for (@fields);
|
|
print HTML ("\n");
|
|
}
|
|
print HTML <<'EOF';
|
|
</pre>
|
|
<table border="0" cellpadding="5" cellspacing="0" width="100%">
|
|
<tr>
|
|
<td>
|
|
Statistics per Debian architectures:
|
|
<pre>
|
|
EOF
|
|
for $f (grep { $_ ne 'unknown' } sort keys %arch)
|
|
{
|
|
my ($port)=split('-',$f);
|
|
$port="$port/";
|
|
$port="kfreebsd-gnu/" if ($port eq "kfreebsd/");
|
|
printf HTML "<a href=\"http://www.debian.org/ports/$port\">%-16s</a> : %-10s <a href=\"stat/sub-$f.png\">graph</a>\n",$f,$arch{$f};
|
|
}
|
|
if (defined $arch{"unknown"}) {
|
|
printf HTML "%-16s : %-10s <a href=\"stat/sub-unknown.png\">graph</a>\n","unknown",$arch{"unknown"}
|
|
}
|
|
print HTML <<'EOF';
|
|
</pre></td>
|
|
<td>
|
|
<table>
|
|
<tr><td>
|
|
<img alt="Graph of number of submissions per architectures"
|
|
width="600" height="400" src="stat/submission.png">
|
|
</td></tr>
|
|
<tr><td>
|
|
<img alt="Graph of number of submissions per architectures (last 12 months)"
|
|
width="600" height="400" src="stat/submission-1year.png">
|
|
</td></tr>
|
|
</table>
|
|
</td></tr>
|
|
<tr><td>
|
|
Statistics per popularity-contest releases:
|
|
<pre>
|
|
EOF
|
|
for $f (grep { $_ ne 'unknown' } sort keys %release)
|
|
{
|
|
my($name) = $f;
|
|
$name = "$f ($popconver{$f})" if (defined($popconver{$f}));
|
|
printf HTML "%-25s : %-10s \n",$name,$release{$f};
|
|
}
|
|
if (defined $release{"unknown"}) {
|
|
printf HTML "%-25s : %-10s \n","unknown",$release{"unknown"};
|
|
}
|
|
print HTML <<'EOF';
|
|
</pre></td>
|
|
<td>
|
|
<table>
|
|
<tr><td>
|
|
<img alt="Graph of popularity-contest versions in use"
|
|
width="600" height="400" src="stat/release.png">
|
|
</td></tr>
|
|
<tr><td>
|
|
<img alt="Graph of popularity-contest versions in use (12 last months)"
|
|
width="600" height="400" src="stat/release-1year.png">
|
|
</td></tr>
|
|
</table>
|
|
</td>
|
|
</tr>
|
|
</table>
|
|
<p>
|
|
EOF
|
|
|
|
print HTML "<a href=\"all-popcon-results.gz\">Raw popularity-contest results</a>\n";
|
|
&htmlfooter;
|
|
close HTML;
|
|
}
|
|
mark "Building index.html";
|
|
|