tools/licensecheck.pl

   1 #!/usr/bin/perl
   2 # -*- tab-width: 8; indent-tabs-mode: t; cperl-indent-level: 4 -*-
   3 # This script was originally based on the script of the same name from
   4 # the KDE SDK (by dfaure@kde.org)
   5 #
   6 # This version is
   7 #   Copyright (C) 2007, 2008 Adam D. Barratt
   8 #   Copyright (C) 2012 Francesco Poli
   9 #
  10 # This program is free software; you can redistribute it and/or modify
  11 # it under the terms of the GNU General Public License as published by
  12 # the Free Software Foundation; either version 2 of the License, or
  13 # (at your option) any later version.
  14 #
  15 # This program is distributed in the hope that it will be useful,
  16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 # GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License along
  21 # with this program. If not, see <https://www.gnu.org/licenses/>.
  22
  23 # Originally copied from Debian's devscripts. A more modern version of
  24 # this can be found at
  25 # https://anonscm.debian.org/git/pkg-perl/packages/licensecheck.git/
  26
  27 =head1 NAME
  28
  29 licensecheck - simple license checker for source files
  30
  31 =head1 SYNOPSIS
  32
  33 B<licensecheck> B<--help>|B<--version>
  34
  35 B<licensecheck> [B<--no-conf>] [B<--verbose>] [B<--copyright>]
  36 [B<-l>|B<--lines=>I<N>] [B<-i>|B<--ignore=>I<regex>] [B<-c>|B<--check=>I<regex>]
  37 [B<-m>|B<--machine>] [B<-r>|B<--recursive>]  [B<-e>|B<--encoding=>I<...>]
  38 I<list of files and directories to check>
  39
  40 =head1 DESCRIPTION
  41
  42 B<licensecheck> attempts to determine the license that applies to each file
  43 passed to it, by searching the start of the file for text belonging to
  44 various licenses.
  45
  46 If any of the arguments passed are directories, B<licensecheck> will add
  47 the files contained within to the list of files to process.
  48
  49 =head1 OPTIONS
  50
  51 =over 4
  52
  53 =item B<--verbose>, B<--no-verbose>
  54
  55 Specify whether to output the text being processed from each file before
  56 the corresponding license information.
  57
  58 Default is to be quiet.
  59
  60 =item B<-l=>I<N>, B<--lines=>I<N>
  61
  62 Specify the number of lines of each file's header which should be parsed
  63 for license information. (Default is 60).
  64
  65 =item B<--tail=>I<N>
  66
  67 By default, the last 5k bytes of each files are parsed to get license
  68 information. You may use this option to set the size of this parsed chunk.
  69 You may set this value to 0 to avoid parsing the end of the file.
  70
  71 =item B<-i=>I<regex>, B<--ignore=>I<regex>
  72
  73 When processing the list of files and directories, the regular
  74 expression specified by this option will be used to indicate those which
  75 should not be considered (e.g. backup files, VCS metadata).
  76
  77 =item B<-r>, B<--recursive>
  78
  79 Specify that the contents of directories should be added
  80 recursively.
  81
  82 =item B<-c=>I<regex>, B<--check=>I<regex>
  83
  84 Specify a pattern against which filenames will be matched in order to
  85 decide which files to check the license of.
  86
  87 The default includes common source files.
  88
  89 =item B<-s>, B<--skipped>
  90
  91 Specify whether to show skipped files, i.e. files found which do not
  92 match the check regexp (see C<--check> option). Default is to not show
  93 skipped files.
  94
  95 Note that ignored files (like C<.git> or C<.svn>) are not shown even when
  96 this option is used.
  97
  98 =item B<--copyright>
  99
 100 Also display copyright text found within the file
 101
 102 =item B<-e> B<--encoding>
 103
 104 Specifies input encoding of source files. By default, input files are
 105 not decoded. When encoding is specified, license and copyright
 106 information are printed on STDOUT as utf8, or garbage if you got the
 107 encoding wrong.
 108
 109 =item B<-m>, B<--machine>
 110
 111 Display the information in a machine readable way, i.e. in the form
 112 <file><tab><license>[<tab><copyright>] so that it can be easily sorted
 113 and/or filtered, e.g. with the B<awk> and B<sort> commands.
 114 Note that using the B<--verbose> option will kill the readability.
 115
 116 =item B<--no-conf>, B<--noconf>
 117
 118 Do not read any configuration files. This can only be used as the first
 119 option given on the command line.
 120
 121 =back
 122
 123 =head1 CONFIGURATION VARIABLES
 124
 125 The two configuration files F</etc/devscripts.conf> and
 126 F<~/.devscripts> are sourced by a shell in that order to set
 127 configuration variables.  Command line options can be used to override
 128 configuration file settings.  Environment variable settings are
 129 ignored for this purpose.  The currently recognised variables are:
 130
 131 =over 4
 132
 133 =item B<LICENSECHECK_VERBOSE>
 134
 135 If this is set to I<yes>, then it is the same as the B<--verbose> command
 136 line parameter being used. The default is I<no>.
 137
 138 =item B<LICENSECHECK_PARSELINES>
 139
 140 If this is set to a positive number then the specified number of lines
 141 at the start of each file will be read whilst attempting to determine
 142 the license(s) in use.  This is equivalent to the B<--lines> command line
 143 option.
 144
 145 =back
 146
 147 =head1 LICENSE
 148
 149 This code is copyright by Adam D. Barratt <I<adam@adam-barratt.org.uk>>,
 150 all rights reserved; based on a script of the same name from the KDE
 151 SDK, which is copyright by <I<dfaure@kde.org>>.
 152 This program comes with ABSOLUTELY NO WARRANTY.
 153 You are free to redistribute this code under the terms of the GNU
 154 General Public License, version 2 or later.
 155
 156 =head1 AUTHOR
 157
 158 Adam D. Barratt <adam@adam-barratt.org.uk>
 159
 160 =cut
 161
 162 # see https://stackoverflow.com/questions/6162484/why-does-modern-perl-avoid-utf-8-by-default/6163129#6163129
 163 use v5.14;
 164 use utf8;
 165
 166 use strict;
 167 use autodie;
 168 use warnings;
 169 use warnings    qw< FATAL  utf8     >;
 170
 171 use Getopt::Long qw(:config gnu_getopt);
 172 use File::Basename;
 173 use File::stat;
 174 use IO::File;
 175 use Fcntl qw/:seek/;
 176
 177 binmode STDOUT, ':utf8';
 178
 179 my $progname = basename($0);
 180
 181 # From dpkg-source
 182 my $default_ignore_regex = qr!
 183 # Ignore general backup files
 184 ~$|
 185 # Ignore emacs recovery files
 186 (?:^|/)\.#|
 187 # Ignore vi swap files
 188 (?:^|/)\..*\.swp$|
 189 # Ignore baz-style junk files or directories
 190 (?:^|/),,.*(?:$|/.*$)|
 191 # File-names that should be ignored (never directories)
 192 (?:^|/)(?:DEADJOE|\.cvsignore|\.arch-inventory|\.bzrignore|\.gitignore)$|
 193 # File or directory names that should be ignored
 194 (?:^|/)(?:CVS|RCS|\.pc|\.deps|\{arch\}|\.arch-ids|\.svn|\.hg|_darcs|\.git|
 195 \.shelf|_MTN|\.bzr(?:\.backup|tags)?)(?:$|/.*$)
 196 !x;
 197
 198 # The original Debian version checks Markdown (.md and .markdown) files.
 199 # If we add those extensions back, we should add Asciidoctor (.adoc) as
 200 # well, and add SPDX IDs to all of those files.
 201 my $default_check_regex =
 202                 qr!
 203                 \.(                          # search for file suffix
 204                                 c(c|pp|xx)?              # c and c++
 205                          |h(h|pp|xx)?              # header files for c and c++
 206                          |S
 207                          |css|less                 # HTML css and similar
 208                          |f(77|90)?
 209                          |go
 210                          |groovy
 211                          |lisp
 212                          |scala
 213                          |clj
 214                          |p(l|m)?6?|t|xs|pod6?     # perl5 or perl6
 215                          |sh
 216                          |php
 217                          |py(|x)
 218                          |rb
 219                          |java
 220                          |js
 221                          |vala
 222                          |el
 223                          |sc(i|e)
 224                          |cs
 225                          |pas
 226                          |inc
 227                          |dtd|xsl
 228                          |mod
 229                          |m
 230                          |tex
 231                          |mli?
 232                          |(c|l)?hs
 233                  )
 234                 $
 235          !x;
 236
 237 # also used to cleanup
 238 my $copyright_indicator_regex
 239                 = qr!
 240                                  (?:copyright   # The full word
 241                                                 |copr\. # Legally-valid abbreviation
 242                                                 |\xc2\xa9       # Unicode copyright sign encoded in iso8859
 243                         |\x{00a9}       # Unicode character COPYRIGHT SIGN
 244                         #|©            # Unicode character COPYRIGHT SIGN
 245                                                 |\(c\)  # Legally-null representation of sign
 246                                  )
 247                                 !lix;
 248
 249 my $copyright_indicator_regex_with_capture = qr!$copyright_indicator_regex(?::\s*|\s+)(\S.*)$!lix;
 250
 251 # avoid ditching things like <info@foo.com>
 252 my $copyright_disindicator_regex
 253                 = qr{
 254                         \b(?:info(?:rmation)?(?!@)      # Discussing copyright information
 255                                                 |(notice|statement|claim|string)s?      # Discussing the notice
 256                                                 |is|in|to        # Part of a sentence
 257                                                 |(holder|owner)s?       # Part of a sentence
 258                                                 |ownership              # Part of a sentence
 259                                                 )\b
 260                                 }ix;
 261
 262 my $copyright_predisindicator_regex
 263                 = qr!(
 264                                                  ^[#]define\s+.*\(c\)    # #define foo(c) -- not copyright
 265                                  )!ix;
 266
 267 my $modified_conf_msg;
 268
 269 my %OPT=(
 270                 verbose        => '',
 271                 lines          => '',
 272                 noconf         => '',
 273                 ignore         => '',
 274                 check          => '',
 275                 recursive      => 0,
 276                 copyright      => 0,
 277                 machine        => 0,
 278                 text           => 0,
 279                 skipped        => 0,
 280 );
 281
 282 my $def_lines = 60;
 283 my $def_tail = 5000; # roughly 60 lines of 80 chars
 284
 285 # Read configuration files and then command line
 286 # This is boilerplate
 287
 288 if (@ARGV and $ARGV[0] =~ /^--no-?conf$/) {
 289                 $modified_conf_msg = "  (no configuration files read)";
 290                 shift;
 291 } else {
 292                 my @config_files = ('/etc/devscripts.conf', '~/.devscripts');
 293                 my %config_vars = (
 294                                          'LICENSECHECK_VERBOSE' => 'no',
 295                                          'LICENSECHECK_PARSELINES' => $def_lines,
 296                                         );
 297                 my %config_default = %config_vars;
 298
 299                 my $shell_cmd;
 300                 # Set defaults
 301                 foreach my $var (keys %config_vars) {
 302                         $shell_cmd .= qq[$var="$config_vars{$var}";\n];
 303                 }
 304                 $shell_cmd .= 'for file in ' . join(" ", @config_files) . "; do\n";
 305                 $shell_cmd .= '[ -f $file ] && . $file; done;' . "\n";
 306                 # Read back values
 307                 foreach my $var (keys %config_vars) { $shell_cmd .= "echo \$$var;\n" }
 308                 my $shell_out = `/bin/bash -c '$shell_cmd'`;
 309                 @config_vars{keys %config_vars} = split /\n/, $shell_out, -1;
 310
 311                 # Check validity
 312                 $config_vars{'LICENSECHECK_VERBOSE'} =~ /^(yes|no)$/
 313                         or $config_vars{'LICENSECHECK_VERBOSE'} = 'no';
 314                 $config_vars{'LICENSECHECK_PARSELINES'} =~ /^[1-9][0-9]*$/
 315                         or $config_vars{'LICENSECHECK_PARSELINES'} = $def_lines;
 316
 317                 foreach my $var (sort keys %config_vars) {
 318                         if ($config_vars{$var} ne $config_default{$var}) {
 319                                 $modified_conf_msg .= "  $var=$config_vars{$var}\n";
 320                         }
 321                 }
 322                 $modified_conf_msg ||= "  (none)\n";
 323                 chomp $modified_conf_msg;
 324
 325                 $OPT{'verbose'} = $config_vars{'LICENSECHECK_VERBOSE'} eq 'yes' ? 1 : 0;
 326                 $OPT{'lines'} = $config_vars{'LICENSECHECK_PARSELINES'};
 327 }
 328
 329 GetOptions(\%OPT,
 330                 "help|h",
 331                 "check|c=s",
 332                 "copyright",
 333                 "encoding|e=s",
 334                 "ignore|i=s",
 335                 "lines|l=i",
 336                 "machine|m",
 337                 "noconf|no-conf",
 338                 "recursive|r",
 339                 "skipped|s",
 340                 "tail",
 341                 "text|t",
 342                 "verbose!",
 343                 "version|v",
 344 ) or die "Usage: $progname [options] filelist\nRun $progname --help for more details\n";
 345
 346 $OPT{'lines'} = $def_lines if $OPT{'lines'} !~ /^[1-9][0-9]*$/;
 347 my $ignore_regex = length($OPT{ignore}) ? qr/$OPT{ignore}/ : $default_ignore_regex;
 348
 349 my $check_regex = $default_check_regex;
 350 $check_regex = qr/$OPT{check}/ if length $OPT{check};
 351
 352 if ($OPT{'noconf'}) {
 353                 fatal("--no-conf is only acceptable as the first command-line option!");
 354 }
 355 if ($OPT{'help'}) { help(); exit 0; }
 356 if ($OPT{'version'}) { version(); exit 0; }
 357
 358 if ($OPT{text}) {
 359                 warn "$0 warning: option -text is deprecated\n"; # remove -text end 2015
 360 }
 361
 362 die "Usage: $progname [options] filelist\nRun $progname --help for more details\n" unless @ARGV;
 363
 364 $OPT{'lines'} = $def_lines if not defined $OPT{'lines'};
 365
 366 my @files = ();
 367 my @find_args = ();
 368 my $files_count = @ARGV;
 369
 370 push @find_args, qw(-maxdepth 1) unless $OPT{'recursive'};
 371 push @find_args, qw(-follow -type f -print);
 372
 373 while (@ARGV) {
 374                 my $file = shift @ARGV;
 375
 376                 if (-d $file) {
 377                         open my $FIND, '-|', 'find', $file, @find_args
 378                                 or die "$progname: couldn't exec find: $!\n";
 379
 380                         while (my $found = <$FIND>) {
 381                                 chomp ($found);
 382                                 # Silently skip empty files or ignored files
 383                                 next if -z $found or $found =~ $ignore_regex;
 384                                 if ( not $check_regex or $found =~ $check_regex ) {
 385                                         # Silently skip empty files or ignored files
 386                                         push @files, $found ;
 387                                 }
 388                                 else {
 389                                         warn "skipped file $found\n" if $OPT{skipped};
 390                                 }
 391                         }
 392                         close $FIND;
 393                 }
 394                 elsif ($file =~ $ignore_regex) {
 395                         # Silently skip ignored files
 396                         next;
 397                 }
 398                 elsif ( $files_count == 1 or not $check_regex or $file =~ $check_regex ) {
 399                         push @files, $file;
 400                 }
 401                 else {
 402                         warn "skipped file $file\n" if $OPT{skipped};
 403                 }
 404 }
 405
 406 while (@files) {
 407                 my $file = shift @files;
 408                 my $content = '';
 409                 my $copyright_match;
 410                 my $copyright = '';
 411
 412                 my $st = stat $file;
 413
 414                 my $enc = $OPT{encoding} ;
 415                 my $mode = $enc ? "<:encoding($enc)" : '<';
 416                 # need to use "<" when encoding is unknown otherwise we break compatibility
 417                 my $fh = IO::File->new ($file ,$mode) or die "Unable to access $file\n";
 418
 419                 while ( my $line = $fh->getline ) {
 420                         last if ($fh->input_line_number > $OPT{'lines'});
 421                         $content .= $line;
 422                 }
 423
 424                 my %copyrights = extract_copyright($content);
 425
 426                 print qq(----- $file header -----\n$content----- end header -----\n\n)
 427                 if $OPT{'verbose'};
 428
 429                 my $license = parselicense(clean_cruft_and_spaces(clean_comments($content)));
 430                 $copyright = join(" / ", reverse sort values %copyrights);
 431
 432                 if ( not $copyright and $license eq 'UNKNOWN') {
 433                         my $position = $fh->tell; # See IO::Seekable
 434                         my $tail_size = $OPT{tail} // $def_tail;
 435                         my $jump = $st->size - $tail_size;
 436                         $jump = $position if $jump < $position;
 437
 438                         my $tail ;
 439                         if ( $tail_size and $jump < $st->size) {
 440                                 $fh->seek($jump, SEEK_SET) ; # also IO::Seekable
 441                                 $tail .= join('',$fh->getlines);
 442                         }
 443
 444                         print qq(----- $file tail -----\n$tail----- end tail -----\n\n)
 445                         if $OPT{'verbose'};
 446
 447                         %copyrights = extract_copyright($tail);
 448                         $license = parselicense(clean_cruft_and_spaces(clean_comments($tail)));
 449                         $copyright = join(" / ", reverse sort values %copyrights);
 450                 }
 451
 452                 $fh->close;
 453
 454                 if ($OPT{'machine'}) {
 455                         print "$file\t$license";
 456                         print "\t" . ($copyright or "*No copyright*") if $OPT{'copyright'};
 457                         print "\n";
 458                 } else {
 459                         print "$file: ";
 460                         print "*No copyright* " unless $copyright;
 461                         print $license . "\n";
 462                         print "  [Copyright: " . $copyright . "]\n"
 463                         if $copyright and $OPT{'copyright'};
 464                                 print "\n" if $OPT{'copyright'};
 465                 }
 466 }
 467
 468 sub extract_copyright {
 469                 my $content = shift;
 470                 my @c = split /\n/, clean_comments($content);
 471
 472                 my %copyrights;
 473                 my $lines_after_copyright_block = 0;
 474
 475                 my $in_copyright_block = 0;
 476                 while (@c) {
 477                 my $line = shift @c ;
 478                 my $copyright_match = parse_copyright($line, \$in_copyright_block) ;
 479                 if ($copyright_match) {
 480                         while (@c and $copyright_match =~ /\d[,.]?\s*$/) {
 481                                 # looks like copyright end with a year, assume the owner is on next line(s)
 482                                 $copyright_match .= ' '. shift @c;
 483                         }
 484                         $copyright_match =~ s/\s+/ /g;
 485                         $copyright_match =~ s/\s*$//;
 486                         $copyrights{lc("$copyright_match")} = "$copyright_match";
 487                 }
 488                 elsif (scalar keys %copyrights) {
 489                         # skip remaining lines if a copyright blocks was found more than 5 lines ago.
 490                         # so a copyright block may contain up to 5 blank lines, but no more
 491                         last if $lines_after_copyright_block++ > 5;
 492                 }
 493         }
 494         return %copyrights;
 495 }
 496
 497 sub parse_copyright {
 498                 my $data = shift ;
 499                 my $in_copyright_block_ref = shift;
 500                 my $copyright = '';
 501                 my $match;
 502
 503                 if ( $data !~ $copyright_predisindicator_regex) {
 504                 #print "match against ->$data<-\n";
 505                                 if ($data =~ $copyright_indicator_regex_with_capture) {
 506                                                 $match = $1;
 507                                                 $$in_copyright_block_ref = 1;
 508                                                 # Ignore lines matching "see foo for copyright information" etc.
 509                                                 if ($match !~ $copyright_disindicator_regex) {
 510                                                                 # De-cruft
 511                                                                 $match =~ s/$copyright_indicator_regex//igx;
 512                                                                 $match =~ s/^\s+//;
 513                                                                 $match =~ s/\s*\bby\b\s*/ /;
 514                                                                 $match =~ s/([,.])?\s*$//;
 515                                                                 $match =~ s/\s{2,}/ /g;
 516                                                                 $match =~ s/\\//g; # de-cruft nroff files
 517                                                                 $match =~ s/\s*[*#]\s*$//;
 518                                                                 $copyright = $match;
 519                                                 }
 520                                 }
 521                                 elsif ($$in_copyright_block_ref and $data =~ /^\d{2,}[,\s]+/) {
 522                                                 # following lines beginning with a year are supposed to be
 523                                                 # continued copyright blocks
 524                                                 $copyright = $data;
 525                                 }
 526                                 else {
 527                                                 $$in_copyright_block_ref = 0;
 528                                 }
 529                 }
 530
 531                 return $copyright;
 532 }
 533
 534 sub clean_comments {
 535                 local $_ = shift or return q{};
 536
 537                 # Remove generic comments: look for 4 or more lines beginning with
 538                 # regular comment pattern and trim it. Fall back to old algorithm
 539                 # if no such pattern found.
 540                 my @matches = m/^\s*((?:[^a-zA-Z0-9\s]{1,3}|\bREM\b))\s\w/mg;
 541                 if (@matches >= 4) {
 542                                 my $comment_re = qr/\s*[\Q$matches[0]\E]{1,3}\s*/;
 543                                 s/^$comment_re//mg;
 544                 }
 545
 546                 # Remove Fortran comments
 547                 s/^[cC] //gm;
 548
 549                 # Remove C / C++ comments
 550                 s#(\*/|/[/*])##g;
 551
 552                 return $_;
 553 }
 554
 555 sub clean_cruft_and_spaces {
 556                 local $_ = shift or return q{};
 557
 558                 tr/\t\r\n/ /;
 559
 560                 # this also removes quotes
 561                 tr% A-Za-z.+,@:;0-9\(\)/-%%cd;
 562                 tr/ //s;
 563
 564                 return $_;
 565 }
 566
 567 sub help {
 568          print <<"EOF";
 569 Usage: $progname [options] filename [filename ...]
 570 Valid options are:
 571          --help, -h             Display this message
 572          --version, -v          Display version and copyright info
 573          --no-conf, --noconf    Don't read devscripts config files; must be
 574                                                                                                         the first option given
 575          --verbose              Display the header of each file before its
 576                                                                                                                 license information
 577          --skipped, -s          Show skipped files
 578          --lines, -l            Specify how many lines of the file header
 579                                                                                                                 should be parsed for license information
 580                                                                                                                 (Default: $def_lines)
 581          --tail                 Specify how many bytes to parse at end of file
 582                                                                                                                 (Default: $def_tail)
 583          --check, -c            Specify a pattern indicating which files should
 584                                                                                                                  be checked
 585                                                                                                                  (Default: '$default_check_regex')
 586          --machine, -m          Display in a machine readable way (good for awk)
 587          --recursive, -r        Add the contents of directories recursively
 588          --copyright            Also display the file's copyright
 589          --ignore, -i           Specify that files / directories matching the
 590                                                                                                                 regular expression should be ignored when
 591                                                                                                                 checking files
 592                                                                                                                 (Default: '$default_ignore_regex')
 593
 594 Default settings modified by devscripts configuration files:
 595 $modified_conf_msg
 596 EOF
 597 }
 598
 599 sub version {
 600                 print <<"EOF";
 601 This is $progname, from the Debian devscripts package, version 2.16.2
 602 Copyright (C) 2007, 2008 by Adam D. Barratt <adam\@adam-barratt.org.uk>; based
 603 on a script of the same name from the KDE SDK by <dfaure\@kde.org>.
 604
 605 This program comes with ABSOLUTELY NO WARRANTY.
 606 You are free to redistribute this code under the terms of the
 607 GNU General Public License, version 2, or (at your option) any
 608 later version.
 609 EOF
 610 }
 611
 612 sub parselicense {
 613                 my ($licensetext) = @_;
 614
 615                 my $gplver = "";
 616                 my $extrainfo = "";
 617                 my $license = "";
 618
 619                 if ($licensetext =~ /version ([^ ]+)(?: of the License)?,? or(?: \(at your option\))? version (\d(?:[.-]\d+)*)/) {
 620                         $gplver = " (v$1 or v$2)";
 621                 } elsif ($licensetext =~ /version ([^, ]+?)[.,]? (?:\(?only\)?.? )?(?:of the GNU (Affero )?(Lesser |Library )?General Public License )?(as )?published by the Free Software Foundation/i or
 622                         $licensetext =~ /GNU (?:Affero )?(?:Lesser |Library )?General Public License (?:as )?published by the Free Software Foundation[;,] version ([^, ]+?)[.,]? /i) {
 623
 624                         $gplver = " (v$1)";
 625                 } elsif ($licensetext =~ /GNU (?:Affero )?(?:Lesser |Library )?General Public License\s*(?:[(),GPL]+)\s*version (\d+(?:\.\d+)?)[ \.]/i) {
 626                         $gplver = " (v$1)";
 627                 } elsif ($licensetext =~ /either version ([^ ]+)(?: of the License)?, or (?:\(at your option\) )?any later version/) {
 628                         $gplver = " (v$1 or later)";
 629                 } elsif ($licensetext =~ /GPL\sas\spublished\sby\sthe\sFree\sSoftware\sFoundation,\sversion\s([\d.]+)/i ) {
 630                         $gplver = " (v$1)";
 631                 } elsif ($licensetext =~ /SPDX-License-Identifier:\s+GPL-([1-9])\.0-or-later/i ){
 632                         $gplver = " (v$1 or later)";
 633                 } elsif ($licensetext =~ /SPDX-License-Identifier:\s+GPL-([1-9])\.0[^+]/i ) {
 634                         $gplver = " (v$1)";
 635                 } elsif ($licensetext =~ /SPDX-License-Identifier:\s+GPL-([1-9])\.0\+/i ) {
 636                         $gplver = " (v$1 or later)";
 637                 } elsif ($licensetext =~ /SPDX-License-Identifier:\s+LGPL-([1-9])\.[0-1]\-or-later/i ) {
 638                         $gplver = " (v$1 or later)";
 639                 }
 640
 641                 if ($licensetext =~ /(?:675 Mass Ave|59 Temple Place|51 Franklin Steet|02139|02111-1307)/i) {
 642                         $extrainfo = " (with incorrect FSF address)$extrainfo";
 643                 }
 644
 645                 if ($licensetext =~ /permission (?:is (also granted|given))? to link (the code of )?this program with (any edition of )?(Qt|the Qt library)/i) {
 646                         $extrainfo = " (with Qt exception)$extrainfo"
 647                 }
 648
 649                 if ($licensetext =~ /As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work under terms of your choice/) {
 650                         $extrainfo = " (with Bison parser exception)$extrainfo";
 651                 }
 652
 653                 # exclude blurb found in boost license text
 654                 if ($licensetext =~ /(All changes made in this file will be lost|DO NOT (EDIT|delete this file)|Generated (automatically|by|from)|generated.*file)/i
 655                                 and $licensetext !~  /unless such copies or derivative works are solely in the form of machine-executable object code generated by a source language processor/) {
 656                         $license = "GENERATED FILE";
 657                 }
 658
 659                 if ($licensetext =~ /(are made available|(is free software.? )?you can redistribute (it|them) and(?:\/|\s+)or modify (it|them)|is licensed) under the terms of (version [^ ]+ of )?the (GNU (Library |Lesser )General Public License|LGPL)/i) {
 660                         $license = "LGPL$gplver$extrainfo $license";
 661                 }
 662                 # For Perl modules handled by Dist::Zilla
 663                 elsif ($licensetext =~ /this is free software,? licensed under:? (?:the )?(?:GNU (?:Library |Lesser )General Public License|LGPL),? version ([\d\.]+)/i) {
 664                         $license = "LGPL (v$1) $license";
 665                 }
 666
 667                 if ($licensetext =~ /is free software.? you can redistribute (it|them) and(?:\/|\s+)or modify (it|them) under the terms of the (GNU Affero General Public License|AGPL)/i) {
 668                         $license = "AGPL$gplver$extrainfo $license";
 669                 }
 670
 671                 if ($licensetext =~ /(is free software.? )?you (can|may) redistribute (it|them) and(?:\/|\s+)or modify (it|them) under the terms of (?:version [^ ]+ (?:\(?only\)? )?of )?the GNU General Public License/i) {
 672                         $license = "GPL$gplver$extrainfo $license";
 673                 }
 674
 675                 if ($licensetext =~ /is distributed under the terms of the GNU General Public License,/
 676                                 and length $gplver) {
 677                         $license = "GPL$gplver$extrainfo $license";
 678                 }
 679
 680                 if ($licensetext =~ /SPDX-License-Identifier:\s+GPL/i and length $gplver) {
 681                         $license = "GPL$gplver$extrainfo $license";
 682                 }
 683
 684                 if ($licensetext =~ /SPDX-License-Identifier:\s+GPL-2.0-or-later/i and length $gplver) {
 685                         $license = "GPL$gplver$extrainfo";
 686                 }
 687
 688                 if ($licensetext =~ /SPDX-License-Identifier:\s+LGPL/i and length $gplver) {
 689                         $license = "LGPL$gplver$extrainfo $license";
 690                 }
 691
 692                 if ($licensetext =~ /SPDX-License-Identifier:\s+Zlib/i) {
 693                         $license = "zlib/libpng $license";
 694                 }
 695
 696                 if ($licensetext =~ /SPDX-License-Identifier:\s+BSD-3-Clause/i) {
 697                         $license = 'BSD (3 clause)';
 698                 }
 699
 700                 if ($licensetext =~ /SPDX-License-Identifier:\s+BSD-2-Clause/i) {
 701                         $license = 'BSD (2 clause)';
 702                 }
 703
 704                 if ($licensetext =~ /SPDX-License-Identifier:\s+BSD-1-Clause/i) {
 705                         $license = 'BSD (1 clause)';
 706                 }
 707
 708                 if ($licensetext =~ /SPDX-License-Identifier:\s+MIT/i) {
 709                         $license = 'MIT/X11 (BSD like)';
 710                 }
 711
 712                 if ($licensetext =~ /SPDX-License-Identifier:\s+ISC/i) {
 713                         $license = 'ISC';
 714                 }
 715
 716                 if ($licensetext =~ /(?:is|may be)\s(?:(?:distributed|used).*?terms|being\s+released).*?\b(L?GPL)\b/) {
 717                         my $v = $gplver || ' (unversioned/unknown version)';
 718                         $license = "$1$v $license";
 719                 }
 720
 721                 if ($licensetext =~ /the rights to distribute and use this software as governed by the terms of the Lisp Lesser General Public License|\bLLGPL\b/ ) {
 722                         $license = "LLGPL $license";
 723                 }
 724
 725                 if ($licensetext =~ /This file is part of the .*Qt GUI Toolkit. This file may be distributed under the terms of the Q Public License as defined/) {
 726                         $license = "QPL (part of Qt) $license";
 727                 } elsif ($licensetext =~ /may (be distributed|redistribute it) under the terms of the Q Public License/) {
 728                         $license = "QPL $license";
 729                 }
 730
 731                 if ($licensetext =~ /opensource\.org\/licenses\/mit-license\.php/) {
 732                         $license = "MIT/X11 (BSD like) $license";
 733                 } elsif ($licensetext =~ /Permission is hereby granted, free of charge, to any person obtaining a copy of this software and(\/or)? associated documentation files \(the (Software|Materials)\), to deal in the (Software|Materials)/) {
 734                         $license = "MIT/X11 (BSD like) $license";
 735                 } elsif ($licensetext =~ /Permission is hereby granted, without written agreement and without license or royalty fees, to use, copy, modify, and distribute this software and its documentation for any purpose/) {
 736                         $license = "MIT/X11 (BSD like) $license";
 737                 }
 738
 739                 if ($licensetext  =~ /Permission to use, copy, modify, and(\/or)? distribute this software for any purpose with or without fee is hereby granted, provided.*copyright notice.*permission notice.*all copies/) {
 740                         $license = "ISC $license";
 741                 }
 742
 743                 if ($licensetext =~ /THIS SOFTWARE IS PROVIDED .*AS IS AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY/) {
 744                         if ($licensetext =~ /All advertising materials mentioning features or use of this software must display the following acknowledge?ment.*This product includes software developed by/i) {
 745                                         $license = "BSD (4 clause) $license";
 746                         } elsif ($licensetext =~ /(The name(?:\(s\))? .*? may not|Neither the (names? .*?|authors?) nor the names of( (its|their|other|any))? contributors may) be used to endorse or promote products derived from this software/i) {
 747                                         $license = "BSD (3 clause) $license";
 748                         } elsif ($licensetext =~ /Redistributions in binary form must reproduce the above copyright notice/i) {
 749                                         $license = "BSD (2 clause) $license";
 750                         } else {
 751                                         $license = "BSD $license";
 752                         }
 753                 }
 754
 755                 if ($licensetext =~ /Mozilla Public License,? (?:(?:Version|v\.)\s+)?(\d+(?:\.\d+)?)/) {
 756                         $license = "MPL (v$1) $license";
 757                 }
 758                 elsif ($licensetext =~ /Mozilla Public License,? \((?:Version|v\.) (\d+(?:\.\d+)?)\)/) {
 759                         $license = "MPL (v$1) $license";
 760                 }
 761
 762                 # match when either:
 763                 # - the text *begins* with "The Artistic license v2.0" which is (hopefully) the actual artistic license v2.0 text.
 764                 # - a license grant is found. i.e something like "this is free software, licensed under the artistic license v2.0"
 765                 if ($licensetext =~ /(?:^\s*|(?:This is free software, licensed|Released|be used|use and modify this (?:module|software)) under (?:the terms of )?)[Tt]he Artistic License ([v\d.]*\d)/) {
 766                         $license = "Artistic (v$1) $license";
 767                 }
 768
 769                 if ($licensetext =~ /is free software under the Artistic [Ll]icense/) {
 770                         $license = "Artistic $license";
 771                 }
 772
 773                 if ($licensetext =~ /This program is free software; you can redistribute it and\/or modify it under the same terms as Perl itself/) {
 774                         $license = "Perl $license";
 775                 }
 776
 777                 if ($licensetext =~ /under the Apache License, Version ([^ ]+)/) {
 778                         $license = "Apache (v$1) $license";
 779                 }
 780
 781                 if ($licensetext =~ /(THE BEER-WARE LICENSE)/i) {
 782                         $license = "Beerware $license";
 783                 }
 784
 785                 if ($licensetext =~ /distributed under the terms of the FreeType project/i) {
 786                         $license = "FreeType $license"; # aka FTL see https://www.freetype.org/license.html
 787                 }
 788
 789                 if ($licensetext =~ /This source file is subject to version ([^ ]+) of the PHP license/) {
 790                         $license = "PHP (v$1) $license";
 791                 }
 792
 793                 if ($licensetext =~ /under the terms of the CeCILL /) {
 794                         $license = "CeCILL $license";
 795                 }
 796
 797                 if ($licensetext =~ /under the terms of the CeCILL-([^ ]+) /) {
 798                         $license = "CeCILL-$1 $license";
 799                 }
 800
 801                 if ($licensetext =~ /under the SGI Free Software License B/) {
 802                         $license = "SGI Free Software License B $license";
 803                 }
 804
 805                 if ($licensetext =~ /is in the public domain/i) {
 806                         $license = "Public domain $license";
 807                 }
 808
 809                 if ($licensetext =~ /terms of the Common Development and Distribution License(, Version ([^(]+))? \(the License\)/) {
 810                         $license = "CDDL " . ($1 ? "(v$2) " : '') . $license;
 811                 }
 812
 813                 if ($licensetext =~ /Microsoft Permissive License \(Ms-PL\)/) {
 814                         $license = "Ms-PL $license";
 815                 }
 816
 817                 if ($licensetext =~ /Licensed under the Academic Free License version ([\d.]+)/) {
 818                         $license = $1 ? "AFL-$1" : "AFL";
 819                 }
 820
 821                 if ($licensetext =~ /This program and the accompanying materials are made available under the terms of the Eclipse Public License v?([\d.]+)/) {
 822                         $license = $1 ? "EPL-$1" : "EPL";
 823                 }
 824
 825                 # quotes were removed by clean_comments function
 826                 if ($licensetext =~ /Permission is hereby granted, free of charge, to any person or organization obtaining a copy of the software and accompanying documentation covered by this license \(the Software\)/ or
 827                         $licensetext =~ /Boost Software License([ ,-]+Version ([^ ]+)?(\.))/i) {
 828                         $license = "BSL " . ($1 ? "(v$2) " : '') . $license;
 829                 }
 830
 831                 if ($licensetext =~ /PYTHON SOFTWARE FOUNDATION LICENSE (VERSION ([^ ]+))/i) {
 832                         $license = "PSF " . ($1 ? "(v$2) " : '') . $license;
 833                 }
 834
 835                 if ($licensetext =~ /The origin of this software must not be misrepresented.*Altered source versions must be plainly marked as such.*This notice may not be removed or altered from any source distribution/ or
 836                                 $licensetext =~ /see copyright notice in zlib\.h/) {
 837                         $license = "zlib/libpng $license";
 838                 } elsif ($licensetext =~ /This code is released under the libpng license/) {
 839                         $license = "libpng $license";
 840                 }
 841
 842                 if ($licensetext =~ /Do What The Fuck You Want To Public License, Version ([^, ]+)/i) {
 843                         $license = "WTFPL (v$1) $license";
 844                 }
 845
 846                 if ($licensetext =~ /Do what The Fuck You Want To Public License/i) {
 847                         $license = "WTFPL $license";
 848                 }
 849
 850                 if ($licensetext =~ /(License WTFPL|Under (the|a) WTFPL)/i) {
 851                         $license = "WTFPL $license";
 852                 }
 853
 854                 if ($licensetext =~ /SPDX-License-Identifier:\s+\(([a-zA-Z0-9-\.]+)\s+OR\s+([a-zA-Z0-9-\.]+)\)/i) {
 855                         my $license1 = $1;
 856                         my $license2 = $2;
 857                         $license = parselicense("SPDX-License-Identifier: $license1") . ";" . parselicense("SPDX-License-Identifier: $license2");
 858                 }
 859
 860                 $license = "UNKNOWN" if (!length($license));
 861
 862                 # Remove trailing spaces.
 863                 $license =~ s/\s+$//;
 864
 865                 return $license;
 866 }
 867
 868 sub fatal {
 869                 my ($pack,$file,$line);
 870                 ($pack,$file,$line) = caller();
 871                 (my $msg = "$progname: fatal error at line $line:\n@_\n") =~ tr/\0//d;
 872                 $msg =~ s/\n\n$/\n/;
 873                 die $msg;
 874 }