home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / doc / popularity-contest / examples / popcon.pl < prev    next >
Encoding:
Perl Script  |  2005-07-24  |  13.0 KB  |  450 lines
  1. #! /usr/bin/perl -wT
  2.  
  3. $results="../popcon-mail/results";
  4. $popcon="../www";
  5. my $mirrorbase = "/org/ftp.root/debian";
  6. my $docurlbase = "";
  7.  
  8. sub htmlheader
  9. {
  10.   print HTML <<"EOH";
  11.   <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
  12.   <html>
  13.   <head>
  14.     <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
  15.       <title> Debian Popularity Contest </title>
  16.         <link rev="made" href="mailto:ballombe\@debian.org">
  17.         </head>
  18.         <body text="#000000" bgcolor="#FFFFFF" link="#0000FF" vlink="#800080" alink="#FF0000">
  19.         <div align="center">
  20.         <a href="http://www.debian.org/">
  21.         <img src="http://www.debian.org/logos/openlogo-nd-50.png" border="0" hspace="0" vspace="0" alt="" width="50" height="61">
  22.         </a>
  23.         <a href="http://www.debian.org/">
  24.         <img src="http://www.debian.org/Pics/debian.jpg" border="0" hspace="0" vspace="0" alt="Debian Project" width="179" height="61">
  25.         </a>
  26.         </div>
  27.         <br>
  28.         <table bgcolor="#DF0451" border="0" width="100%" cellpadding="0" cellspacing="0" summary="">
  29.         <tr>
  30.         <td valign="top">
  31.         <img src="http://www.debian.org/Pics/red-upperleft.png" align="left" border="0" hspace="0" vspace="0" alt="" width="15" height="16">
  32.         </td>
  33.         <td rowspan="2" align="center">
  34.         <font color="#FFFF00"><big><big>Debian Popularity Contest</big></big></font>
  35.         </td>
  36.         <td valign="top">
  37.         <img src="http://www.debian.org/Pics/red-upperright.png" align="right" border="0" hspace="0" vspace="0" alt="" width="16" height="16">
  38.         </td>
  39.         </tr>
  40.         <tr>
  41.         <td valign="bottom">
  42.         <img src="http://www.debian.org/Pics/red-lowerleft.png" align="left" border="0" hspace="0" vspace="0" alt="" width="16" height="16">
  43.         </td>
  44.         <td valign="bottom">
  45.         <img src="http://www.debian.org/Pics/red-lowerright.png" align="right" border="0" hspace="0" vspace="0" alt="" width="15" height="16">
  46.         </td>
  47.         </tr>
  48.         </table>
  49. EOH
  50. }
  51.  
  52. sub popconintro
  53. {
  54.   print HTML <<"EOH";
  55.   <p> <em> The popularity contest project is an attempt to map the usage of
  56.   Debian packages.  This site publishes the statistics gathered from report
  57.   sent by users of the <a
  58.   href="http://packages.debian.org/popularity-contest">popularity-contest</a>
  59.   package. This package sends every week the list of packages installed and the
  60.   access time of relevant files to the server via email. Every day the server
  61.   anonymizes the result and publishes this survey.
  62.   For more information, read the <a href="${docurlbase}README">README</a> and the 
  63.   <a href="${docurlbase}FAQ">FAQ</a>.
  64.   </em> <p>
  65. EOH
  66. }
  67.  
  68. sub htmlfooter
  69. {
  70.   my $date=gmtime();
  71.   print HTML <<EOF;
  72. <pre>
  73. inst     : number of people who installed this package;
  74. vote     : number of people who use this package regularly;
  75. old      : number of people who installed, but don't use this package regularly;
  76. recent   : number of people who upgraded this package recently;
  77. no-files : number of people whose entry didn't contain enough information (atime
  78. and ctime were 0).
  79. </pre>
  80. <p>
  81. Number of submissions considered: $numsub
  82. </p><p>
  83. To participate in this survey, install the <a href="http://packages.debian.org/popularity-contest">popularity-contest</a> package.
  84. </p>
  85. EOF
  86.   print HTML <<EOH
  87. <p>
  88. <HR>
  89. <small>
  90. Made by <a href="mailto:ballombe\@debian.org"> Bill Allombert </a>. Last generated on $date UTC. <br>
  91. <a href="http://popcon.alioth.debian.org" > Popularity-contest project </a> by Avery Pennarun, Bill Allombert and Petter Reinholdtsen.
  92. <BR>
  93. Copyright (C) 2004-2005 <A HREF="http://www.spi-inc.org/">SPI</A>;
  94. See <A HREF="http://www.debian.org/license">license terms</A>.
  95. </small>
  96. </body>
  97. </html>
  98. EOH
  99. }
  100.  
  101. sub make_sec
  102. {
  103.   my $sec="$popcon/$_[0]";
  104.   -d $sec || system("mkdir","-p","$sec");
  105. }
  106.  
  107. sub print_by
  108. {
  109.    my ($dir,$f)=@_;
  110.    print HTML ("<a href=\"$dir/by_$f\">$f</a> [<a href=\"$dir/by_$f.gz\">gz</a>] ");
  111. }
  112.  
  113. %list_header=(
  114. "maint" => <<"EOF",
  115. #<name> is the developer name;
  116. #
  117. #The fields below are the sum for all the packages maintained by that
  118. #developer:
  119. EOF
  120. "source" => <<"EOF");
  121. #<name> is the source package name;
  122. #
  123. #The fields below are the sum for all the binary packages generated by
  124. #that source package:
  125. EOF
  126.  
  127. sub make_by
  128. {
  129.   my ($sec,$order,$pkg,@list) = @_;
  130.   my (%sum, $me);
  131.   @list = sort {$pkg->{$b}->{$order}<=> $pkg->{$a}->{$order} || $a cmp $b } @list;
  132.   $winner{"$sec/$order"}=$list[0];
  133.   open DAT , "| tee $popcon/$sec/by_$order | gzip -c > $popcon/$sec/by_$order.gz";
  134.   if (defined($list_header{$sec}))
  135.   {
  136.     print DAT $list_header{$sec};
  137.     $me="";
  138.   }
  139.   else 
  140.   {
  141.     print DAT <<"EOF";
  142. #Format
  143. #   
  144. #<name> is the package name;
  145. EOF
  146.     $me="(maintainer)";
  147.   }
  148.   print DAT << "EOF";
  149. #<inst> is the number of people who installed this package;
  150. #<vote> is the number of people who use this package regularly;
  151. #<old> is the number of people who installed, but don't use this package
  152. #      regularly;
  153. #<recent> is the number of people who upgraded this package recently;
  154. #<no-files> is the number of people whose entry didn't contain enough
  155. #           information (atime and ctime were 0).
  156. #rank name                            inst  vote   old recent no-files $me
  157. EOF
  158.   $format="%-5d %-30s".(" %5d"x($#fields+1))." %-32s\n";
  159.   my $rank=0;
  160.   for $p (@list)
  161.   {
  162.     $rank++;
  163.     my $m=(defined($list_header{$sec})?"":"($maint{$p})");
  164.     printf  DAT $format, $rank, $p, (map {$pkg->{$p}->{$_}} @fields), $m;
  165.     $sum{$_}+=$pkg->{$p}->{$_} for (@fields);
  166.   }
  167.   print  DAT '-'x66,"\n";
  168.   printf DAT $format, $rank, "Total", map {defined($sum{$_})?$sum{$_}:0} @fields;
  169.   close DAT;
  170. }
  171.  
  172. sub print_pkg
  173. {
  174.   my ($pkg)=@_;
  175.   return unless (defined($pkg));
  176.   my $size=length $pkg;
  177.   my $pkgt=substr($pkg,0,20);
  178.   print HTML "<a href=\"http://packages.debian.org/$pkg\">$pkgt</a> ",
  179.   ' 'x(20-$size);
  180. }
  181. sub mark
  182. {
  183.   print join(" ",$_[0],times),"\n";
  184. }
  185.  
  186. %pkg=();
  187. %section=();
  188. %maint=();
  189. %source=();
  190. %winner=();
  191. %maintpkg=();
  192. %sourcepkg=();
  193. @fields=("inst","vote","old","recent","no-files");
  194.  
  195. for $file ("slink","slink-nonUS","potato","potato-nonUS","woody","woody-nonUS")
  196. {
  197.   open AVAIL, "< $file.sections" or die "Cannot open $file.sections";
  198.   while(<AVAIL>)
  199.   {
  200.       my ($p,$sec)=split(' ');
  201.       defined($sec) or last;
  202.       chomp $sec;
  203.       $sec =~ m{^(non-US|contrib|non-free)/} or $sec="main/$sec";
  204.       $section{$p}=$sec;
  205.       $maint{$p}="Not in sid";
  206.       $source{$p}="Not in sid";
  207.   }
  208.   close AVAIL;
  209. }
  210. mark "Reading legacy packages...";
  211.  
  212. for $file (glob("$mirrorbase/dists/stable/*/binary-*/Packages"),
  213.            glob("$mirrorbase/dists/testing/*/binary-*/Packages"),
  214.            glob("$mirrorbase/dists/sid/*/binary-*/Packages"))
  215. {
  216.   open AVAIL, "$file";
  217.   while(<AVAIL>)
  218.   {
  219. /^Package: (.+)/  and do {$p=$1;$maint{$p}="bug";$source{$p}=$p;next;};
  220. /^Maintainer: ([^()]+) (\(.+\) )*<.+>/ and do { $maint{$p}=join(' ',map{ucfirst($_)} split(' ',lc $1));next;};
  221. /^Source: (\S+)/ and do { $source{$p}=$1;next;};
  222. /^Section: (.+)/ or next;
  223.           $sec=$1;
  224.           $sec =~ m{^(non-US|contrib|non-free)/} or $sec="main/$sec";
  225.           $section{$p}=$sec;
  226.   }
  227.   close AVAIL;
  228. }
  229. mark "Reading current packages...";
  230.  
  231. $ENV{PATH}="/bin:/usr/bin";
  232.  
  233. #Format
  234. #<name> <vote> <old> <recent> <no-files>
  235. #   
  236. #<name> is the package name;
  237. #<vote> is the number of people who use this package regularly;
  238. #<old> is the number of people who installed, but don't use this package
  239. #        regularly;
  240. #<recent> is the number of people who upgraded this package recently;
  241. #<no-files> is the number of people whose entry didn't contain enough
  242. #        information (atime and ctime were 0).
  243. open PKG, "$results";
  244. while(<PKG>)
  245. {
  246.   my ($type,@values)=split(" ");
  247.   if ($type eq "Package:")
  248.   {
  249.           my @votes=@values;
  250.       $name = shift @votes;
  251.       unshift @votes,$votes[0]+$votes[1]+$votes[2]+$votes[3];
  252.       $section{$name}='unknown' unless (defined($section{$name}));
  253.       $maint{$name}='Not in sid' unless (defined($maint{$name}));
  254.       $source{$name}='Not in sid' unless (defined($source{$name}));
  255.       for(my $i=0;$i<=$#fields;$i++)
  256.       {
  257.           my ($f,$v)=($fields[$i],$votes[$i]);
  258.           $pkg{$name}->{$f}=$v;
  259.           $maintpkg{$maint{$name}}->{$f}+=$v;
  260.           $sourcepkg{$source{$name}}->{$f}+=$v;
  261.       }
  262.   }
  263.   elsif ($type eq "Architecture:")
  264.   {
  265.     my ($a,$nb)=@values;
  266.     $arch{$a}=$nb;
  267.   }
  268.   elsif ($type eq "Submissions:")
  269.   {
  270.     ($numsub)=@values;
  271.   }
  272.   elsif ($type eq "Release:")
  273.   {
  274.     my ($a,$nb)=@values;
  275.     $release{$a}=$nb;
  276.   }
  277. }
  278. mark "Reading stats...";
  279.  
  280. @pkgs=sort keys %pkg;
  281. %sections = map {$section{$_} => 1} keys %section;
  282. @sections = sort keys %sections;
  283. @maints= sort keys %maintpkg;
  284. @sources= sort keys %sourcepkg;
  285.  
  286. for $sec (@sections)
  287. {
  288.   my @list = grep {$section{$_} eq $sec} @pkgs;
  289.   make_sec $sec;
  290.   make_by ($sec, $_, \%pkg, @list) for (@fields);
  291. }
  292.  
  293. mark "Building by sections pages";
  294.  
  295. @dists=("main","contrib","non-free","non-US");
  296. #There is a hack: '.' is both the current directory and
  297. #the catchall regexp.
  298.  
  299. for $sec (".",@dists)
  300. {
  301.   my @list = grep {$section{$_} =~ /^$sec/ } @pkgs;
  302.   make_sec $sec;
  303.   make_by ($sec, $_, \%pkg, @list) for (@fields);
  304. }
  305. make_sec "maint";
  306. make_by ("maint", $_, \%maintpkg, @maints) for (@fields);
  307. make_sec "source";
  308. make_by ("source", $_, \%sourcepkg, @sources) for (@fields);
  309. for $sec (@dists)
  310. {
  311.   open HTML , "> $popcon/$sec/index.html";
  312.   opendir SEC,"$popcon/$sec";
  313.   &htmlheader;
  314.   printf HTML ("<p>Statistics for the section %-16s sorted by fields: ",$sec);
  315.   print_by (".",$_) for (@fields);
  316.   print HTML ("\n </p> \n");
  317.   printf HTML ("<p> <a href=\"first.html\"> First packages in subsections for each fields </a>\n");
  318.   printf HTML ("<p>Statistics for subsections sorted by fields\n <pre>\n");
  319.   for $dir (sort readdir SEC)
  320.   {
  321.     -d "$popcon/$sec/$dir" or next;
  322.     $dir !~ /^\./ or next;
  323.     printf HTML ("%-16s : ",$dir);
  324.     print_by ($dir,$_) for (@fields);
  325.     print HTML ("\n");
  326.   }
  327.   print HTML ("\n </pre>\n");
  328.   &htmlfooter;
  329.   closedir SEC;
  330.   close HTML;
  331. }
  332. mark "Building by sub-sections pages";
  333. for $sec (@dists)
  334. {
  335.   open HTML , "> $popcon/$sec/first.html";
  336.   opendir SEC,"$popcon/$sec";
  337.   &htmlheader;
  338.   printf HTML ("<p>First package in section %-16s for fields: ",$sec);
  339.   for $f (@fields)
  340.   {
  341.       print_pkg $winner{"$sec/$f"};
  342.   }
  343.   print HTML ("\n </p> \n");
  344.   printf HTML ("<p> <a href=\"index.html\"> Statistics by subsections sorted by fields </a>\n");
  345.   printf HTML ("<p>First package in subsections for fields\n <pre>\n");
  346.   printf HTML ("%-16s : ","subsection");
  347.   for $f (@fields)
  348.   {
  349.       printf HTML ("%-20s ",$f);
  350.   }
  351.   print HTML ("\n","_"x120,"\n");
  352.   for $dir (sort readdir SEC)
  353.   {
  354.       -d "$popcon/$sec/$dir" or next;
  355.       $dir !~ /^\./ or next;
  356.       printf HTML ("%-16s : ",$dir);
  357.       for $f (@fields)
  358.       {
  359.           print_pkg $winner{"$sec/$dir/$f"};
  360.       }
  361.       print HTML ("\n");
  362.   }
  363.   print HTML ("\n </pre>\n");
  364.   &htmlfooter;
  365.   closedir SEC;
  366.   close HTML;
  367. }
  368.  
  369. mark "Building winner pages";
  370.  
  371. {
  372.     open HTML , "> $popcon/index.html";
  373.     &htmlheader;
  374.     &popconintro;
  375.     printf HTML ("<p>Statistics for the whole archive sorted by fields: <pre>",$sec);
  376.     print_by (".",$_) for (@fields);
  377.     print HTML ("</pre>\n </p> \n");
  378.     printf HTML ("<p>Statistics by maintainers sorted by fields: <pre>",$sec);
  379.     print_by ("maint",$_) for (@fields);
  380.     print HTML ("</pre>\n </p> \n");
  381.     printf HTML ("<p>Statistics by source packages sorted by fields: <pre>",$sec);
  382.     print_by ("source",$_) for (@fields);
  383.     print HTML ("</pre>\n </p> \n");
  384.     printf HTML ("<p>Statistics for sections sorted by fields\n <pre>\n");
  385.       for $dir ("main","contrib","non-free","non-US","unknown")
  386.     {
  387.         -d "$popcon/$dir" or next;
  388.         $dir !~ /^\./ or next;
  389.         if ($dir eq "unknown")
  390.         {
  391.             printf HTML ("%-16s : ",$dir);
  392.         }
  393.         else
  394.         {
  395.             printf HTML ("<a href=\"$dir/index.html\">%-16s</a> : ",$dir);
  396.         }
  397.         print_by ($dir,$_) for (@fields);
  398.         print HTML ("\n");
  399.     }
  400.     print HTML  <<'EOF';
  401. </pre>
  402. <table border="0" cellpadding="5" cellspacing="0" width="100%">
  403. <tr>
  404. <td>
  405. Statistics per Debian architectures:
  406. <pre>
  407. EOF
  408.         for $f (grep { $_ ne 'unknown' } sort keys %arch)
  409.         {
  410.         my ($port)=split('-',$f);
  411.         $port="$port/";
  412.         $port="kfreebsd-gnu/" if ($port eq "kfreebsd/");
  413.                 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};
  414.         }
  415.         if (exists $arch{"unknown"}) {
  416.             printf HTML "%-16s : %-10s <a href=\"stat/sub-unknown.png\">graph</a>\n","unknown",$arch{"unknown"}
  417.         }
  418.     print HTML  <<'EOF';
  419. </pre></td>
  420. <td>
  421.  <img alt="Graph of number of submissions per architectures"
  422.  width="600" height="400" src="stat/submission.png">
  423. </td></tr>
  424. <tr><td>
  425. Statistics per popularity-contest releases:
  426. <pre>
  427. EOF
  428.         for $f (grep { $_ ne 'unknown' } sort keys %release)
  429.         {
  430.                 printf HTML "%-16s : %-10s \n",$f,$release{$f};
  431.         }
  432.         if (exists $release{"unknown"}) {
  433.             printf HTML "%-16s : %-10s \n","unknown",$release{"unknown"};
  434.         }
  435.     print HTML  <<'EOF';
  436. </pre></td>
  437. <td>
  438.  <img alt="Graph of popularity-contest versions in use"
  439.   width="600" height="400" src="stat/release.png">
  440. </td></tr>
  441. </table>
  442. <p>
  443. EOF
  444.  
  445.     print HTML "<a href=\"all-popcon-results.txt.gz\">Raw popularity-contest results</a>\n";
  446.     &htmlfooter;
  447.     close HTML;
  448. }
  449. mark "Building index.html";
  450.