|
|
1.1 root 1: #!/usr/bin/perl -w
2: #
3: # Copyright (C) 2008 Michael Brown <[email protected]>.
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: 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
105: my $verbosity = 1;
106: Getopt::Long::Configure ( 'bundling', 'auto_abbrev' );
107: GetOptions (
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
113: my $licences = {};
114: foreach my $licence ( @ARGV ) {
115: die "Unknown licence \"$licence\"\n"
116: unless exists $known_licences->{$licence};
117: $licences->{$licence} = $known_licences->{$licence};
118: }
119: die "No licences specified\n" unless %$licences;
120:
121: # Dump licence list
122: if ( $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
130: foreach 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
145: die "Cannot reduce to a single resulting licence!\n"
146: if ( keys %$licences ) != 1;
147: ( my $licence ) = keys %$licences;
148: print "The overall licence for this file is:\n " if $verbosity >= 1;
149: print $licences->{$licence}->{desc}."\n";
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.