licensecheck2dep5 4.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153
  1. #!/usr/bin/perl -w
  2. use Getopt::Long;
  3. use Pod::Usage;
  4. =head1 NAME
  5. licensecheck2dep5 - reformat licencecheck output to copyright file format
  6. =head1 SYNOPSIS
  7. licensecheck2dep5 [B<options>]
  8. =head1 OPTIONS
  9. =over 12
  10. =item B<--help>
  11. Print a brief help message and exits.
  12. =item B<--man>
  13. Prints the manual page and exits.
  14. =item B<--list-delimiter>
  15. String added between each item in whitelist-based lists.
  16. Default value (without quotes): S<"\n ">
  17. =item B<--rfc822-delimiter>
  18. String added between each item in rfc822-based lists.
  19. Default value (without quotes): S<"\n ">
  20. =item B<--merge-licenses>
  21. Boolean flag to merge Files sections with same license.
  22. Default value: unset
  23. =item B<--strip-suffix>
  24. Suffix stripped from each input filename.
  25. Default value: F<.metadata>
  26. =back
  27. =head1 DESCRIPTION
  28. B<This program> will readfrom B<STDIN>
  29. the output of the B<licensecheck> command
  30. shipped with Debian B<devscript> package,
  31. reformat to Debian copyright format,
  32. and emit to B<STDOUT>.
  33. =cut
  34. my $list_delimiter = $ENV{'whitespace_list_delimiter'} || "\n ";
  35. my $rfc822_delimiter = $ENV{'rfc822_list_delimiter'} || "\n ";
  36. my $merge_licenses = $ENV{'merge_same_license'} || "";
  37. my $strip_suffix = $ENV{'metadata_suffix'} || ".metadata";
  38. GetOptions( help => \my $help,
  39. man => \my $man,
  40. 'list-delimiter' => \$list_delimiter,
  41. 'rfc822-delimiter' => \$rfc822_delimiter,
  42. 'merge-licenses' => \$merge_licenses,
  43. 'strip-suffix' => \$strip_suffix,
  44. ) or pod2usage(2);
  45. pod2usage( -verbose => 1 ) if $help;
  46. pod2usage( -verbose => 2, -exitstatus => 0 ) if $man;
  47. print "Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/\n";
  48. print "Upstream-Name: FIXME\n";
  49. print "Upstream-Contact: FIXME\n";
  50. print "Source: FIXME\n";
  51. print "Disclaimer: Autogenerated by CDBS\n\n";
  52. $n=0; while (<>) {
  53. if (/^([^:\s][^:]+):[\s]+(\S.*?)\s*$/) {
  54. $files[$n]{name}=$1;
  55. $files[$n]{license}=$2;
  56. };
  57. if (/^\s*\[Copyright:\s*(\S.*?)\s*\]/) {
  58. $files[$n]{copyright}=$1;
  59. };
  60. /^$/ and $n++;
  61. };
  62. foreach $file (@files) {
  63. $file->{name} =~ s/([*?\\])/\\$1/g;
  64. $file->{name} =~ s/$strip_suffix$//g;
  65. unless ($file->{copyright}) {
  66. $file->{copyright} = 'NONE';
  67. $file->{license} =~ s/^\*No copyright\*\s*//;
  68. }
  69. $file->{license} =~ s/^generated-file$/UNKNOWN/;
  70. $file->{license} =~ s/^generated-file or //;
  71. $file->{license} =~ s/ or generated-file//;
  72. $file->{copyright} =~ s/(?:(?<=\A)|(?<=\/ ))\d{4}(?:(?:-|, )\d{4})*\K(?= [\S^\d])/,/g;
  73. my @ownerlines = grep {/\w\w/} split /\s\/\s/, $file->{copyright};
  74. my @ownerlines_clean = ();
  75. my %owneryears = ();
  76. my $owneryears_seem_correct = 1;
  77. for $ownerline ( @ownerlines ) {
  78. my ($owneryear, $owner) = $ownerline =~ /^((?:\d{4}(?:(?:-|, )\d{4})*)?) ?((?:\S.*)?)$/;
  79. $owneryears_seem_correct = 0 unless ($owneryear);
  80. push @ownerlines_clean, "$owneryear$owner";
  81. push @{ $owneryears{"$owner"} }, $owneryear;
  82. };
  83. my @owners = sort keys %owneryears;
  84. @owners = () if ($merge_licenses and $owneryears_seem_correct);
  85. my $pattern = join ("\n", $file->{license}, @owners);
  86. push @{ $patternfiles{"$pattern"} }, $file->{name};
  87. push @{ $patternownerlines{"$pattern"} }, @ownerlines_clean;
  88. $patternlicense{"$pattern"} = $file->{license};
  89. };
  90. foreach $pattern ( sort {
  91. @{$patternfiles{$b}} <=> @{$patternfiles{$a}}
  92. ||
  93. $a cmp $b
  94. } keys %patternfiles ) {
  95. my $prev;
  96. @ownerlines_unique = grep((!defined $prev || $_ ne $prev) && (($prev) = $_), sort @{ $patternownerlines{$pattern} });
  97. print "Files: ", join($list_delimiter, sort @{ $patternfiles{$pattern} }), "\n";
  98. print "Copyright: ", join($rfc822_delimiter, @ownerlines_unique), "\n";
  99. print "License: $patternlicense{$pattern}\n FIXME\n\n";
  100. };
  101. =head1 AUTHOR
  102. Jonas Smedegaard, C<< <dr@jones.dk> >>
  103. =head1 LICENSE AND COPYRIGHT
  104. Copyright 2005-2012, 2016-2017 Jonas Smedegaard
  105. This program is free software; you can redistribute it and/or modify it
  106. under the terms of the GNU General Public License as published by the
  107. Free Software Foundation; either version 3, or (at your option) any
  108. later version.
  109. This program is distributed in the hope that it will be useful, but
  110. WITHOUT ANY WARRANTY; without even the implied warranty of
  111. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  112. General Public License for more details.
  113. You should have received a copy of the GNU General Public License along
  114. with this program. If not, see <http://www.gnu.org/licenses/>.
  115. =cut