You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

licence.pl 3.4KB

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