tools/license-count

   1 #!/usr/bin/perl -w
   2 #
   3 # This script walks through a Lintian laboratory and counts license usage
   4 # based on matching regexes against the contents of the copyright files.  It's
   5 # intended to provide a rough estimate of the number of packages using a
   6 # particular license when discussing whether to add a license to base-files.
   7 #
   8 # It expects one argument, which should be the root of the Lintian laboratory.
   9
  10 our @RULES = (
  11     [qr,/usr/share/common-licenses/Apache-2.0,     => 'Apache 2.0'],
  12     [qr,/usr/share/common-licenses/Artistic,       => 'Artistic'],
  13     [qr,/usr/share/common-licenses/BSD,            => 'BSD (common-licenses)'],
  14     [qr,/usr/share/common-licenses/GFDL-1.2,       => 'GFDL 1.2'],
  15     [qr,/usr/share/common-licenses/GFDL-1.3,       => 'GFDL 1.3'],
  16     [qr,/usr/share/common-licenses/GPL-2,          => 'GPL 2'],
  17     [qr,/usr/share/common-licenses/GPL-3,          => 'GPL 3'],
  18     [qr,/usr/share/common-licenses/LGPL-2,         => 'LGPL 2'],
  19     [qr,/usr/share/common-licenses/LGPL-2.1,       => 'LGPL 2.1'],
  20     [qr,/usr/share/common-licenses/LGPL-3,         => 'LGPL 3'],
  21
  22     [qr,/usr/share/common-licenses/GFDL(?!-),      => 'GFDL (symlink)'],
  23     [qr,/usr/share/common-licenses/GPL(?!-),       => 'GPL (symlink)'],
  24     [qr,/usr/share/common-licenses/LGPL(?!-),      => 'LGPL (symlink)'],
  25
  26     [qr,(?m)^License:.*Artistic(?!-),              => 'Artistic'],
  27     [qr,(?m)^License:.*Artistic-2,                 => 'Artistic 2.0'],
  28     [qr,(?m)^License:.*CC-BY-3.0,                  => 'CC-BY 3.0'],
  29     [qr,(?m)^License:.*CC-BY-SA-3.0,               => 'CC-BY-SA 3.0'],
  30     [qr,(?m)^License:.*CDDL,                       => 'CDDL'],
  31     [qr,(?m)^License:.*GPL-1,                      => 'GPL 1'],
  32     [qr,(?m)^License:.*LPPL,                       => 'LaTeX PPL'],
  33     [qr,(?m)^License:.*MPL-1\.1,                   => 'MPL 1.1'],
  34     [qr,(?m)^License:.*Perl,                       => 'Artistic'],
  35     [qr,(?m)^License:.*Perl,                       => 'GPL 1'],
  36
  37     [qr,The Artistic License 2\.0,                 => 'Artistic 2.0'],
  38     [qr,COMMON DEVELOPMENT AND DISTRIBUTION LICENSE \(CDDL\), => 'CDDL'],
  39     [qr,CONTRAT DE LICENCE DE LOGICIEL LIBRE CeCILL(?!-), => 'CeCILL'],
  40     [qr,CeCILL FREE SOFTWARE LICENSE AGREEMENT,    => 'CeCILL'],
  41     [qr,CONTRAT DE LICENCE DE LOGICIEL LIBRE CeCILL-B, => 'CeCILL-B'],
  42     [qr,CeCILL-B FREE SOFTWARE LICENSE AGREEMENT,  => 'CeCILL-B'],
  43     [qr,CONTRAT DE LICENCE DE LOGICIEL LIBRE CeCILL-C, => 'CeCILL-C'],
  44     [qr,CeCILL-C FREE SOFTWARE LICENSE AGREEMENT,  => 'CeCILL-C'],
  45     [qr,(?i)creative\s+commons\s+attribution\s+3\.0, => 'CC-BY 3.0'],
  46     [qr,(?i)creative\s+commons\s+attribution[-\s]+share\s*alike\s+3\.0, => 'CC-BY-SA 3.0'],
  47     [qr,GNU GENERAL PUBLIC LICENSE\s+Version 1,    => 'GPL 1'],
  48     [qr,LPPL Version 1.3c,                         => 'LaTeX PPL'],
  49     [qr,MOZILLA PUBLIC LICENSE\s+Version 1\.1,     => 'MPL 1.1'],
  50     [qr,SIL OPEN FONT LICENSE Version 1\.1,        => 'SIL OFL 1.1'],
  51     [qr,SIL OPEN FONT LICENSE Version 1\.0,        => 'SIL OFL 1.0'],
  52 );
  53
  54 unless (@ARGV == 1) {
  55     die "Usage: license-count <path-to-lintian-lab>\n";
  56 }
  57 my $lab = $ARGV[0];
  58 opendir (LAB, "$lab/binary") or die "$0: cannot open $lab/binary: $!\n";
  59 my ($package, %counts);
  60 my $n = 0;
  61 while (defined ($package = readdir LAB)) {
  62     next if ($package =~ /^\./);
  63     $n++;
  64     print "Checked $n packages\n" if (($n % 100) == 0);
  65     local $/;
  66     open (COPYRIGHT, '<', "$lab/binary/$package/copyright") or next;
  67     my $copyright = <COPYRIGHT>;
  68     close COPYRIGHT;
  69     my %seen;
  70     study $copyright;
  71     for my $rule (@RULES) {
  72         if ($copyright =~ /$rule->[0]/ && !$seen{$rule->[1]}) {
  73             $counts{$rule->[1]}++;
  74             $seen{$rule->[1]} = 1;
  75         }
  76     }
  77 }
  78 closedir LAB;
  79 my $length = 0;
  80 for my $name (keys %counts) {
  81     if (length ($name) > $length) {
  82         $length = length ($name);
  83     }
  84 }
  85 for my $name (sort keys %counts) {
  86     printf "%-${length}s %5d\n", $name, $counts{$name};
  87 }