src/util/licence.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # Copyright (C) 2008 Michael Brown <mbrown@fensystems.co.uk>.
   4 #
   5 # This program is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public License as
   7 # published by the Free Software Foundation; either version 2 of the
   8 # License, or any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18
  19 use strict;
  20 use warnings;
  21 use Getopt::Long;
  22
  23 # List of licences we can handle
  24 my $known_licences = {
  25   gpl_any => {
  26     desc => "GPL (any version)",
  27     can_subsume => {
  28       public_domain => 1,
  29       bsd3 => 1,
  30       bsd2 => 1,
  31     },
  32   },
  33   gpl2_or_later => {
  34     desc => "GPL version 2 (or, at your option, any later version)",
  35     can_subsume => {
  36       gpl_any => 1,
  37       public_domain => 1,
  38       bsd3 => 1,
  39       bsd2 => 1,
  40     },
  41   },
  42   gpl2_only => {
  43     desc => "GPL version 2 only",
  44     can_subsume => {
  45       gpl_any => 1,
  46       gpl2_or_later => 1,
  47       public_domain => 1,
  48       bsd3 => 1,
  49       bsd2 => 1,
  50     },
  51   },
  52   public_domain => {
  53     desc => "Public Domain",
  54     can_subsume => {},
  55   },
  56   bsd4 => {
  57     desc => "BSD Licence (with advertising clause)",
  58     can_subsume => {
  59       public_domain => 1,
  60       bsd3 => 1,
  61       bsd2 => 1,
  62     },
  63   },
  64   bsd3 => {
  65     desc => "BSD Licence (without advertising clause)",
  66     can_subsume => {
  67       public_domain => 1,
  68       bsd2 => 1,
  69     },
  70   },
  71   bsd2 => {
  72     desc => "BSD Licence (without advertising or endorsement clauses)",
  73     can_subsume => {
  74       public_domain => 1,
  75     },
  76   },
  77 };
  78
  79 # Parse command-line options
  80 my $verbosity = 1;
  81 Getopt::Long::Configure ( 'bundling', 'auto_abbrev' );
  82 GetOptions (
  83   'verbose|v+' => sub { $verbosity++; },
  84   'quiet|q+' => sub { $verbosity--; },
  85 ) or die "Could not parse command-line options\n";
  86
  87 # Parse licence list from command line
  88 my $licences = {};
  89 foreach my $licence ( @ARGV ) {
  90   die "Unknown licence \"$licence\"\n"
  91       unless exists $known_licences->{$licence};
  92   $licences->{$licence} = $known_licences->{$licence};
  93 }
  94 die "No licences specified\n" unless %$licences;
  95
  96 # Dump licence list
  97 if ( $verbosity >= 1 ) {
  98   print "The following licences appear within this file:\n";
  99   foreach my $licence ( keys %$licences ) {
 100     print "  ".$licences->{$licence}->{desc}."\n"
 101   }
 102 }
 103
 104 # Apply licence compatibilities to reduce to a single resulting licence
 105 foreach my $licence ( keys %$licences ) {
 106   # Skip already-deleted licences
 107   next unless exists $licences->{$licence};
 108   # Subsume any subsumable licences
 109   foreach my $can_subsume ( keys %{$licences->{$licence}->{can_subsume}} ) {
 110     if ( exists $licences->{$can_subsume} ) {
 111       print $licences->{$licence}->{desc}." subsumes ".
 112           $licences->{$can_subsume}->{desc}."\n"
 113           if $verbosity >= 1;
 114       delete $licences->{$can_subsume};
 115     }
 116   }
 117 }
 118
 119 # Print resulting licence
 120 die "Cannot reduce to a single resulting licence!\n"
 121     if ( keys %$licences ) != 1;
 122 ( my $licence ) = keys %$licences;
 123 print "The overall licence for this file is:\n  " if $verbosity >= 1;
 124 print $licences->{$licence}->{desc}."\n";