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 19use strict; 20use warnings; 21use Getopt::Long; 22 23# List of licences we can handle 24my $known_licences = { 25 gpl_any => { 26 desc => "GPL (any version)", 27 can_subsume => { 28 public_domain => 1, 29 bsd3 => 1, 30 bsd2 => 1, 31 mit => 1, 32 isc => 1, 33 }, 34 }, 35 gpl2_or_later => { 36 desc => "GPL version 2 (or, at your option, any later version)", 37 can_subsume => { 38 gpl_any => 1, 39 public_domain => 1, 40 bsd3 => 1, 41 bsd2 => 1, 42 mit => 1, 43 isc => 1, 44 }, 45 }, 46 gpl2_only => { 47 desc => "GPL version 2 only", 48 can_subsume => { 49 gpl_any => 1, 50 gpl2_or_later => 1, 51 public_domain => 1, 52 bsd3 => 1, 53 bsd2 => 1, 54 mit => 1, 55 isc => 1, 56 }, 57 }, 58 public_domain => { 59 desc => "Public Domain", 60 can_subsume => {}, 61 }, 62 bsd4 => { 63 desc => "BSD Licence (with advertising clause)", 64 can_subsume => { 65 public_domain => 1, 66 bsd3 => 1, 67 bsd2 => 1, 68 mit => 1, 69 isc => 1, 70 }, 71 }, 72 bsd3 => { 73 desc => "BSD Licence (without advertising clause)", 74 can_subsume => { 75 public_domain => 1, 76 bsd2 => 1, 77 mit => 1, 78 isc => 1, 79 }, 80 }, 81 bsd2 => { 82 desc => "BSD Licence (without advertising or endorsement clauses)", 83 can_subsume => { 84 public_domain => 1, 85 mit => 1, 86 isc => 1, 87 }, 88 }, 89 mit => { 90 desc => "MIT/X11/Xorg Licence", 91 can_subsume => { 92 public_domain => 1, 93 isc => 1, 94 }, 95 }, 96 isc => { 97 desc => "ISC Licence", 98 can_subsume => { 99 public_domain => 1, 100 }, 101 }, 102}; 103 104# Parse command-line options 105my $verbosity = 1; 106Getopt::Long::Configure ( 'bundling', 'auto_abbrev' ); 107GetOptions ( 108 'verbose|v+' => sub { $verbosity++; }, 109 'quiet|q+' => sub { $verbosity--; }, 110) or die "Could not parse command-line options\n"; 111 112# Parse licence list from command line 113my $licences = {}; 114foreach my $licence ( @ARGV ) { 115 die "Unknown licence \"$licence\"\n" 116 unless exists $known_licences->{$licence}; 117 $licences->{$licence} = $known_licences->{$licence}; 118} 119die "No licences specified\n" unless %$licences; 120 121# Dump licence list 122if ( $verbosity >= 1 ) { 123 print "The following licences appear within this file:\n"; 124 foreach my $licence ( keys %$licences ) { 125 print " ".$licences->{$licence}->{desc}."\n" 126 } 127} 128 129# Apply licence compatibilities to reduce to a single resulting licence 130foreach my $licence ( keys %$licences ) { 131 # Skip already-deleted licences 132 next unless exists $licences->{$licence}; 133 # Subsume any subsumable licences 134 foreach my $can_subsume ( keys %{$licences->{$licence}->{can_subsume}} ) { 135 if ( exists $licences->{$can_subsume} ) { 136 print $licences->{$licence}->{desc}." subsumes ". 137 $licences->{$can_subsume}->{desc}."\n" 138 if $verbosity >= 1; 139 delete $licences->{$can_subsume}; 140 } 141 } 142} 143 144# Print resulting licence 145die "Cannot reduce to a single resulting licence!\n" 146 if ( keys %$licences ) != 1; 147( my $licence ) = keys %$licences; 148print "The overall licence for this file is:\n " if $verbosity >= 1; 149print $licences->{$licence}->{desc}."\n"; 150