|
@@ -0,0 +1,124 @@
|
|
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";
|