package App::Licensecheck;

use utf8;
use strictures 2;
use autodie;

use version;
use Path::Iterator::Rule;
use Path::Tiny;
use Fcntl qw/:seek/;
use Encode;
use String::Copyright 0.003 {
	format => sub { join ' ', $_->[0] || (), $_->[1] || () }
};
use String::Copyright 0.003 {
	threshold_after => 5,
	format          => sub { join ' ', $_->[0] || (), $_->[1] || () },
	},
	'copyright' => { -as => 'copyright_optimistic' };

use Moo;

use experimental "switch";
use namespace::clean;

=head1 NAME

App::Licensecheck - functions for a simple license checker for source files

=head1 VERSION

Version v3.0.25

=cut

our $VERSION = version->declare("v3.0.25");

=head1 SYNOPSIS

    use App::Licensecheck;

    my $app = App::Licensecheck->new;

    $app->lines(0); # Speedup parsing - our file is not huge

    printf "License: %s\nCopyright: %s\n", $app->parse( 'some-file' );

=head1 DESCRIPTION

L<App::Licensecheck> is the core of L<licensecheck> script
to check for licenses of source files.
See the script for casual usage.

=cut

# legacy descriptive names different from SPDX shortnames
my %SPDX = (
	'Artistic or GPL' => 'Perl',
	'BSD-2-clause'    => 'BSD (2 clause)',
	'BSD-3-clause'    => 'BSD (3 clause)',
	'BSD-4-clause'    => 'BSD (4 clause)',
	'CC-BY-SA'        => 'CC by-sa',
	FTL               => 'Freetype',
	Expat             => 'MIT/X11 (BSD like)',
	Libpng            => 'libpng',
	'MS-PL'           => 'Ms-PL',
	'public-domain'   => 'Public domain',
	'Python'          => 'PSF',
	'SGI-B'           => 'SGI Free Software License B',
	Zlib              => 'zlib/libpng',
);

my $ver_prefix_re = qr/(?:version |v\.? ?)?/i;
my $ver_re        = qr/\d(?:\.\d+)*/;

my $default_check_regex = q!
	/[\w-]+$ # executable scripts or README like file
	|\.( # search for file suffix
		c(c|pp|xx)? # c and c++
		|h(h|pp|xx)? # header files for c and c++
		|S
		|css|less # HTML css and similar
		|f(77|90)?
		|go
		|groovy
		|lisp
		|scala
		|clj
		|p(l|m)?6?|t|xs|pod6? # perl5 or perl6
		|sh
		|php
		|py(|x)
		|rb
		|java
		|js
		|vala
		|el
		|sc(i|e)
		|cs
		|pas
		|inc
		|dtd|xsl
		|mod
		|m
		|md|markdown
		|tex
		|mli?
		|(c|l)?hs
	)$
!;

# From dpkg-source
my $default_ignore_regex = q!
	# Ignore general backup files
	~$|
	# Ignore emacs recovery files
	(?:^|/)\.#|
	# Ignore vi swap files
	(?:^|/)\..*\.swp$|
	# Ignore baz-style junk files or directories
	(?:^|/),,.*(?:$|/.*$)|
	# File-names that should be ignored (never directories)
	(?:^|/)(?:DEADJOE|\.cvsignore|\.arch-inventory|\.bzrignore|\.gitignore)$|
	# File or directory names that should be ignored
	(?:^|/)(?:CVS|RCS|\.pc|\.deps|\{arch\}|\.arch-ids|\.svn|\.hg|_darcs|\.git|
	\.shelf|_MTN|\.bzr(?:\.backup|tags)?)(?:$|/.*$)
!;

has check_regex => (
	is     => 'rw',
	lazy   => 1,
	coerce => sub {
		my $value = shift;
		return qr/$default_check_regex/x
			if $value eq 'common source files';
		return $value if ref $value eq 'Regexp';
		return qr/$value/;
	},
	default => sub {qr/$default_check_regex/x},
);

has ignore_regex => (
	is     => 'rw',
	lazy   => 1,
	coerce => sub {
		my $value = shift;
		return qr/$default_ignore_regex/x
			if $value eq 'some backup and VCS files';
		return $value if ref $value eq 'Regexp';
		return qr/$value/;
	},
	default => sub {qr/$default_ignore_regex/x},
);

has recursive => (
	is => 'rw',
);

has lines => (
	is      => 'rw',
	default => sub {60},
);

has tail => (
	is      => 'rw',
	default => sub {5000},    # roughly 60 lines of 80 chars
);

has encoding => (
	is     => 'rw',
	coerce => sub {
		find_encoding( $_[0] ) unless ref( $_[0] ) eq 'OBJECT';
	},
);

has verbose => (
	is => 'rw',
);

has skipped => (
	is => 'rw',
);

has deb_fmt => (
	is      => 'rw',
	lazy    => 1,
	default => sub { $_[0]->deb_machine },
);

has deb_machine => (
	is => 'rw',
);

sub find
{
	my ( $self, @paths ) = @_;

	my $check_re  = $self->check_regex;
	my $ignore_re = $self->ignore_regex;
	my $rule      = Path::Iterator::Rule->new;
	my %options   = (
		follow_symlinks => 0,
	);

	$rule->max_depth(1)
		unless $self->recursive;
	$rule->not( sub {/$ignore_re/} );
	$rule->file->nonempty;

	if ( @paths >> 1 ) {
		if ( $self->skipped ) {
			my $skipped = $rule->clone->not( sub {/$check_re/} );
			for ( $skipped->all( @paths, \%options ) ) {
				warn "skipped file $_\n";
			}
		}
		$rule->and( sub {/$check_re/} );
	}

	return $rule->all( @paths, \%options );
}

sub parse
{
	my $self = shift;
	my $file = path(shift);

	if ( $self->lines == 0 ) {
		return ( $self->parse_file($file) );
	}
	else {
		return ( $self->parse_lines($file) );
	}
}

sub parse_file
{
	my $self = shift;
	my $file = path(shift);

	my $content;

	given ( $self->encoding ) {
		when (undef)  { $content = $file->slurp_raw }
		when ('utf8') { $content = $file->slurp_utf8 }
		default {
			$content
				= $file->slurp(
				{ binmode => sprintf ':encoding(%s)', $self->encoding->name }
				)
		}
	}
	print qq(----- $file content -----\n$content----- end content -----\n\n)
		if $self->verbose;

	my $cleaned_content = clean_comments($content);

	return (
		$self->parse_license( clean_cruft_and_spaces($cleaned_content) )
			|| "UNKNOWN",
		copyright( clean_cruft($cleaned_content) ),
	);
}

sub parse_lines
{
	my $self    = shift;
	my $file    = path(shift);
	my $content = '';

	my $fh;
	my $st = $file->stat;

	given ( $self->encoding ) {
		when (undef)  { $fh = $file->openr_raw }
		when ('utf8') { $fh = $file->openr_utf8 }
		default {
			$fh = $file->openr(
				sprintf ':encoding(%s)',
				$self->encoding->name
				)
		}
	}

	while ( my $line = $fh->getline ) {
		last if ( $fh->input_line_number > $self->lines );
		$content .= $line;
	}
	print qq(----- $file header -----\n$content----- end header -----\n\n)
		if $self->verbose;

	my $cleaned_content = clean_comments($content);

	my $license
		= $self->parse_license( clean_cruft_and_spaces($cleaned_content) );
	my $copyrights = copyright_optimistic( clean_cruft($cleaned_content) );

	if ( not $copyrights and $license eq 'UNKNOWN' ) {
		my $position = $fh->tell;                 # See IO::Seekable
		my $jump     = $st->size - $self->tail;
		$jump = $position if $jump < $position;

		my $tail = '';
		if ( $self->tail and $jump < $st->size ) {
			$fh->seek( $jump, SEEK_SET );         # also IO::Seekable
			$tail .= join( '', $fh->getlines );
		}
		print qq(----- $file tail -----\n$tail----- end tail -----\n\n)
			if $self->verbose;

		my $cleaned_tail = clean_comments($tail);

		$copyrights = copyright_optimistic( clean_cruft($cleaned_tail) );
		$license
			= $self->parse_license( clean_cruft_and_spaces($cleaned_tail) );
	}

	$fh->close;
	return ( $license || "UNKNOWN", $copyrights );
}

sub clean_comments
{
	local $_ = shift or return q{};

	# Remove generic comments: look for 4 or more lines beginning with
	# regular comment pattern and trim it. Fall back to old algorithm
	# if no such pattern found.
	my @matches = m/^\s*((?:[^a-zA-Z0-9\s]{1,3}|\bREM\b))\s\w/mg;
	if ( @matches >= 4 ) {
		my $comment_re = qr/\s*[\Q$matches[0]\E]{1,3}\s*/;
		s/^$comment_re//mg;
	}

	# Remove other side of "boxed" comments
	s/\s*[*#]\s*$//gm;

	# Remove Fortran comments
	s/^[cC] //gm;

	# Remove C / C++ comments
	s#(\*/|/[/*])##g;

	return $_;
}

sub clean_cruft
{
	local $_ = shift or return q{};

	# TODO: decode latin1/UTF-8/HTML data instead
	s/\xcb\x97|\xe2\x80[\x90-\x95|\xe2\x81\x83|\xe2\x88\x92|\xef\x89\xa3|\xef\xbc\x8d]|[&](?:ndash|mdash|horbar|minus|[#](?:727|820[8-9]|821[0-3]|8259|8722|65123|65293|x727|z201[0-5]|x2043|x2212|xFE63|xFF0D))[;]/-/gm;
	s/\x58\xa9|\xc2\xa9|\xe2\x92\x9e|\xe2\x92\xb8|\xe2\x93\x92|\xf0\x9f\x84\x92|\xf0\x9f\x84\xab|\xf0\x9f\x85\x92|[&](?:copy|[#](?:169|9374|9400|9426|127250|127275|127314|x0A9|x249E|x24b8|x24D2|x0F112|x0F12B|x0F152))[;]/©/gm;

	# TODO: decode nroff files specifically instead
	s/\\//gm;    # de-cruft nroff files

	return $_;
}

sub clean_cruft_and_spaces
{
	local $_ = shift or return q{};

	tr/\t\r\n/ /;

	# this also removes quotes
	tr% A-Za-z.,@;0-9\(\)/-%%cd;
	tr/ //s;

	return $_;
}

sub parse_license
{
	my $self = shift;
	my ($licensetext) = @_;

	my $gplver    = "";
	my $extrainfo = "";
	my $license   = "";
	my @spdx_gplver;

  # @spdx_license contains identifiers from https://spdx.org/licenses/
  # it would be more efficient to store license info only in this
  # array and then convert it to legacy formulation, but there are
  # corner case (like extrainfo) that would not fit. So the old storage scheme
  # is kept with the new (spdx/dep-5) scheme to keep backward compat.
	my @spdx_license;
	my $spdx_extra;
	my $gen_spdx = sub {
		my @ret
			= @spdx_gplver ? ( map { "$_[0]-$_"; } @spdx_gplver ) : ( $_[0] );
		push @ret, $spdx_extra if $spdx_extra;
		return @ret;
	};
	my $gen_license = sub {
		my ( $id, $v, $later, $id2, $v2, $later2 ) = @_;
		my @spdx;
		my $desc = $SPDX{$id} || $id;
		$v .= '+' if ($later);
		push @spdx, $v ? "$id-$v" : $id if ($id);
		my $desc2;
		$desc2 = $SPDX{$id2} || $id2 if ($id2);
		$v2 .= '+' if ($later2);
		push @spdx, $v2 ? "$id2-$v2" : "$id2" if ($id2);
		my $legacy = join(
			' ',
			$desc,
			( $v     ? "(v$v)"     : () ),
			( $desc2 ? "or $desc2" : () ),
			( $v2    ? "(v$v2)"    : () ),
		);
		push @spdx_license, join( ' or ', @spdx );
		$license = join( ' ', ( $SPDX{$legacy} || $legacy ), $license );
	};

	#<<<  do not let perltidy touch this (keep long regex on one line)

	my $cc_by_sa = qr/Creative Commons Attribution[ -]Share[ -]?Alike|CC[ -]BY[ -]SA/i;

	# version of AGPL/GPL/LGPL
	given ($licensetext) {
		when ( /version ($ver_re)(?: of the License)?,? or(?: \(at your option\))? version ($ver_re)/ ) {
			$gplver = " (v$1 or v$2)";
			@spdx_gplver = ( $1, $2 );
		}
		when ( /version ($ver_re)[.,]? (?:\(?only\)?.? )?(?:of the GNU (Affero |Lesser |Library )?General Public License )?(as )?published by the Free Software Foundation/i ) {
			$gplver      = " (v$1)";
			@spdx_gplver = ($1)
		}
		when ( /GNU (?:Affero |Lesser |Library )?General Public License (?:as )?published by the Free Software Foundation[;,] $ver_prefix_re($ver_re)[.,]? /i ) {
			$gplver      = " (v$1)";
			@spdx_gplver = ($1);
		}
		when ( /GNU (?:Affero |Lesser |Library )?General Public License ?(?:[(),AGPL]+) ?$ver_prefix_re($ver_re)[ \.]/i ) {
			$gplver      = " (v$1)";
			@spdx_gplver = ($1);
		}
		when ( /either $ver_prefix_re($ver_re)(?: of the License)?, or (?:\(at your option\) )?any later version/ ) {
			$gplver      = " (v$1 or later)";
			@spdx_gplver = ( $1 . '+' );
		}
		when ( /GPL as published by the Free Software Foundation, version ($ver_re)/i ) {
			$gplver      = " (v$1)";
			@spdx_gplver = ($1)
		}
	}

	# address in AGPL/GPL/LGPL
	given ($licensetext) {
		when ( /(?:675 Mass Ave|59 Temple Place|51 Franklin Steet|02139|02111-1307)/i ) {
			$extrainfo = " (with incorrect FSF address)$extrainfo";
		}
	}

	# exception for AGPL/GPL/LGPL
	given ($licensetext) {
		when ( /permission (?:is (also granted|given))? to link (the code of )?this program with (any edition of )?(Qt|the Qt library)/i ) {
			$extrainfo  = " (with Qt exception)$extrainfo";
			$spdx_extra = 'with Qt exception';
		}
	}

	# generated file
	given ($licensetext) {
		# exclude blurb found in boost license text
		when ( /unless such copies or derivative works are solely in the form of machine-executable object code generated by a source language processor/ ) {
			break;
		}
		when ( /(All changes made in this file will be lost|DO NOT ((?:HAND )?EDIT|delete this file|modify)|edit the original|Generated (automatically|by|from|data|with)|generated.*file|auto[- ]generated)/i ) {
			$license = "GENERATED FILE";
		}
	}

	given ($licensetext) {
		when ( /under(?: the)?(?:GNU)? (AGPL|GPL|LGPL)-?($ver_re)( or later| (?:and|or)(?: \(at your option\))?(?: any)? later(?: version)?)?,? (?:and|or)(?: the| a)? $cc_by_sa(?: version)? ($ver_re)(?: License)?( (?:and|or)(?: \(at your option\))? any later|[,.] Later versions are permitted)?/i ) {
			$gen_license->( 'CC-BY-SA', $3, $4, $1, $2 );
		}
	}

	# LGPL
	given ($licensetext) {
		when ( /(are made available|(is free software.? )?you can redistribute (it|them) and[ \/]or modify (it|them)|is licensed) under the terms of (version \S+ of )?the (GNU (Library |Lesser )General Public License|LGPL)/i ) {
			$license = "LGPL$gplver$extrainfo $license";
			push @spdx_license, $gen_spdx->('LGPL');
		}
		# For Perl modules handled by Dist::Zilla
		when ( /this is free software,? licensed under:? (?:the )?(?:GNU (?:Library |Lesser )General Public License|LGPL),? $ver_prefix_re($ver_re)/i ) {
			$gen_license->( 'LGPL', $1 );
		}
	}

	# AGPL
	given ($licensetext) {
		when ( /is free software.? you can redistribute (it|them) and[ \/]or modify (it|them) under the terms of the (GNU Affero General Public License|AGPL)/i ) {
			$license = "AGPL$gplver$extrainfo $license";
			push @spdx_license, $gen_spdx->('AGPL');
		}
		# exclude GPL-3 license
		when ( /GNU Affero General Public License into/i ) {
			$license = "AGPL (v$1) $license";
			break;
		}
		# exclude MPL-2.0 license
		when ( /means either [^.]+, the GNU Affero General Public License/i ) {
			$license = "AGPL (v$1) $license";
			break;
		}
		when ( /AFFERO GENERAL PUBLIC LICENSE(?:,? $ver_prefix_re($ver_re)(,? or(?: any)? (?:later|newer))?)?/i ) {
			$gen_license->( 'AGPL', $1, $2 );
		}
	}

	# GPL
	given ($licensetext) {
		when ( /(is free software.? )?you (can|may) redistribute (it|them) and[ \/]or modify (it|them) under the terms of (?:version \S+ (?:\(?only\)? )?of )?the GNU General Public License/i ) {
			$license = "GPL$gplver$extrainfo $license";
			push @spdx_license, $gen_spdx->('GPL');
		}
	}
	if ( $licensetext =~ /is distributed under the terms of the GNU General Public License,/ and length $gplver ) {
		$license = "GPL$gplver$extrainfo $license";
		push @spdx_license, $gen_spdx->('GPL');
	}

	# LGPL/GPL unversioned
	given ($licensetext) {
		when ( /(?:is|may be) (?:(?:distributed|used).*?terms|being released).*?\b(L?GPL)\b/ ) {
			my $v = $gplver || ' (unversioned/unknown version)';
			$license = "$1$v $license";
			push @spdx_license, $gen_spdx->($1);
		}
	}

	# CC
	given ($licensetext) {
		when ( /$cc_by_sa(?i: version)? ($ver_re) or ($ver_re)/ ) {
			$license = "CC BY-SA (v$1 or v$2) $license";
			push @spdx_license, "CC-BY-SA-$1 or CC-BY-SA-$1";
		}
		when ( /$cc_by_sa(?: $ver_prefix_re($ver_re)?)(?: License)?( (?:and|or)(?: \(at your option\))? any later(?: version)|[,.] Later versions are permitted)?(?:,? (?:and|or)(?: the)?(?:GNU)? (AGPL|GPL|LGPL)(?:-?($ver_re)( or later)?)?)?/i ) {
			$gen_license->( 'CC-BY-SA', $1, $2, $3, $4 );
		}
		when ( m<https?creativecommons.org/licenses/by-sa/($ver_re)/( \(or any later version\))?> ) {
			$gen_license->( 'CC-BY-SA', $1, $2 );
		}
	}
	# CC or GPL
	given ($licensetext) {
	}

	# LLGPL
	given ($licensetext) {
		when ( /the rights to distribute and use this software as governed by the terms of the Lisp Lesser General Public License|\bLLGPL\b/ ) {
			$gen_license->('LLGPL');
		}
	}

	# QPL
	given ($licensetext) {
		when ( /This file is part of the .*Qt GUI Toolkit. This file may be distributed under the terms of the Q Public License as defined/ ) {
			$gen_license->('QPL');
		}
		when ( /may (be distributed|redistribute it) under the terms of the Q Public License/ ) {
			$gen_license->('QPL');
		}
	}

	# MIT
	given ($licensetext) {
		when ( /opensource\.org\/licenses\/mit-license\.php/ ) {
			$gen_license->('Expat');
		}
		when ( /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)/ ) {
			$gen_license->('Expat');
		}
		when ( /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/ ) {
			$gen_license->('Expat');
		}
	}

	# ISC
	given ($licensetext) {
		when ( /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/ ) {
			$gen_license->('ISC');
		}
	}

	# BSD
	if ( $licensetext =~ /THIS SOFTWARE IS PROVIDED .*AS IS AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY/ ) {
		given ($licensetext) {
			when ( /All advertising materials mentioning features or use of this software must display the following acknowledge?ment.*This product includes software developed by/i ) {
				$gen_license->('BSD-4-clause');
			}
			when ( /(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 ) {
				$gen_license->('BSD-3-clause');
			}
			when ( /Redistributions in binary form must reproduce the above copyright notice/i ) {
				$gen_license->('BSD-2-clause');
			}
			default {
				$gen_license->('BSD');
			}
		}
	}
	elsif ( $licensetext =~ /licen[sc]ebsd(?:-(\d)-clause)?/i ) {
		if ($1) {
			$gen_license->("BSD-$1-clause");
		}
		else {
			$gen_license->('BSD');
		}
	}

	# MPL
	given ($licensetext) {
		when ( /Mozilla Public License,? $ver_prefix_re($ver_re)/ ) {
			$gen_license->( 'MPL', $1 );
		}
		when ( /Mozilla Public License,? \($ver_prefix_re($ver_re)\)/ ) {
			$gen_license->( 'MPL', $1 );
		}
	}

	# APAFML
	given ($licensetext) {
		when ( /AFM files it accompanies may be used|that the AFM files are not distributed/ ) {
			$license = "Adobe Postscript AFM License $license";
			push @spdx_license, "APAFML";
		}
	}

	# Adobe-Glyph
	given ($licensetext) {
		when ( /and to permit others to do the same, provided that the derived work is not represented as being a copy/ ) {
			$license = "Adobe Glyph List License $license";
			push @spdx_license, "Adobe-Glyph";
		}
	}

	# Adobe-2006
	given ($licensetext) {
		when ( /You agree to indemnify, hold harmless and defend/ ) {
			$license = "Adobe $license";
			push @spdx_license, "Adobe-2006";
		}
	}

	# Aladdin
	given ($licensetext) {
		when ( /This License is not the same as any of the GNU Licenses/ ) {
			$license = "Aladdin Free Public License $license";
			push @spdx_license, "Aladdin";
		}
		when ( /under the terms of the Aladdin Free Public License/ ) {
			$license = "Aladdin $license";
			push @spdx_license, "Aladdin";
		}
	}

	# GPL or Aladdin
	given ($licensetext) {
		when ( /under the GNU License and Aladdin Free Public License/ ) {
			$license = "GPL or Aladdin $license";
			push @spdx_license, "GPL or Aladdin";
		}
	}

	# Artistic
	given ($licensetext) {
		# either *begins* with "The Artistic license v2.0" (hopefully the actual license)
		# or some license grant,
		when ( /(?:^ ?|(?:This is free software, licensed|Released|be used|use and modify this (?:module|software)) under (?:the terms of )?)[Tt]he Artistic License v?($ver_re)/ ) {
			$gen_license->( 'Artistic', $1 );
		}
	}
	given ($licensetext) {
		when ( /is free software under the Artistic [Ll]icense/ ) {
			$gen_license->('Artistic');
		}
	}

	# Artistic or GPL
	given ($licensetext) {
		when ( /This (program )?is free software; you can redistribute it and\/or modify it under the same terms as (the )?Perl( ?5)? (programming |language |system )*itself/ ) {
			$gen_license->('Artistic', 0, 0, 'GPL');
		}
	}

	# Apache
	given ($licensetext) {
		when ( /Apache(?: Software)? License(?:,? $ver_prefix_re($ver_re)( or(?: any)? (?:later|newer))?)?(?:(?: or)? [^ ,]*?apache[^ ,]*| \([^(),]+\))*,? or(?: the)?(?:(?: GNU)? General Public License(?: \(GPL\))?|GPL)(?: $ver_prefix_re($ver_re)( or(?: any)? (?:later|newer))?)?/i ) {
			$gen_license->( 'Apache', $1, $2, 'GPL', $3, $4 );
		}
		when ( /Apache(?: Software)? License(?:,? $ver_prefix_re($ver_re)( or(?: any)? (?:later|newer))?)?(?:(?: or)? [^ ,]*?apache[^ ,]*| \([^(),]\))*,? or(?: the)? bsd(?:[ -](\d)-clause)?\b/i ) {
			$gen_license->( 'Apache', $1, $2, "BSD-$3-clause" );
		}
		when ( /Apache(?: Software)? License(?:,? $ver_prefix_re($ver_re)( or(?: any)? (?:later|newer))?)?(?:(?: or)? [^ ,]*?apache[^ ,]*| \([^(),]\))*,? or(?: the)? (?:Expat|MIT)\b/i ) {
			$gen_license->( 'Apache', $1, $2, 'Expat', $3, $4 );
		}
		when ( /Apache(?: Software)? License(?:,? $ver_prefix_re($ver_re)(,? or(?: any)? (?:later|newer))?)?/i ) {
			$gen_license->( 'Apache', $1, $2 );
		}
		when ( m<https?www.apache.org/licenses(?:/LICENSE-($ver_re))?>i ) {
			$gen_license->( 'Apache', $1 );
		}
	}

	# Beerware
	given ($licensetext) {
		when ( /(THE BEER-WARE LICENSE)/i ) {
			$gen_license->('Beerware');
		}
	}

	# FTL
	given ($licensetext) {
		when ( /distributed under the terms of the FreeType project/i )	{
			$gen_license->('FTL');
		}
	}

	# FSFAP
	given ($licensetext) {
		when ( /Copying and distribution of this file, with or without modification, are permitted in any medium without royalty provided the copyright notice and this notice are preserved/i ) {
			$license = "FSF All Permissive License $license";
			push @spdx_license, 'FSFAP';
		}
	}

	# FSFUL
	given ($licensetext) {
		when ( /This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it\./i ) {
			$license = "FSF Unlimited License $license";
			push @spdx_license, 'FSFUL';
		}
		when ( /This (\w+)(?: (?:file|script))? is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it\./i ) {
			$license = "FSF Unlimited License ($1 derivation) $license";
			push @spdx_license, "FSFUL~$1";
		}
	}

	# FSFULLR
	given ($licensetext) {
		when ( /This file is free software; the Free Software Foundation gives unlimited permission to copy and\/or distribute it, with or without modifications, as long as this notice is preserved/i ) {
			$license = "FSF Unlimited License (with License Retention, $1 derivation) $license";
			push @spdx_license, 'FSFULLR';
		}
		when ( /This (\w+)(?: (?:file|script))?  is free software; the Free Software Foundation gives unlimited permission to copy and\/or distribute it, with or without modifications, as long as this notice is preserved/i ) {
			$license = "FSF Unlimited License (with License Retention, $1 derivation) $license";
			push @spdx_license, "FSFULLR~$1";
		}
	}

	# JSON
	given ($licensetext) {
		when ( /The Software shall be used for Good, not Evil/ ) {
			$license = "JSON License $license";
			push @spdx_license, "JSON";
		}
	}

	# PHP
	given ($licensetext) {
		when ( /This source file is subject to version ($ver_re) of the PHP license/ ) {
			$gen_license->( 'PHP', $1 );
		}
	}

	# CECILL
	given ($licensetext) {
		when ( /under the terms of the CeCILL-(\S+) / ) {
			$gen_license->( 'CeCILL', $1 );
		}
		when ( /under the terms of the CeCILL / ) {
			$gen_license->('CeCILL');
		}
	}

	# SGI-B
	given ($licensetext) {
		when ( /under the SGI Free Software License B/ ) {
			$gen_license->('SGI-B');
		}
	}

	# public-domain
	given ($licensetext) {
		when ( /is in the public domain/i ) {
			$gen_license->('public-domain');
		}
	}

	# CDDL
	given ($licensetext) {
		when ( /terms of the Common Development and Distribution License(?:,? $ver_prefix_re($ver_re))?/ ) {
			$license = "CDDL " . ( $1 ? "(v$1) " : '' ) . $license;
			push @spdx_license, 'CDDL' . ( $1 ? "-$1" : '' );
		}
	}

	# MS-PL
	given ($licensetext) {
		when ( /Microsoft Permissive License \(Ms-PL\)/ ) {
			$gen_license->('MS-PL');
		}
	}

	# AFL
	given ($licensetext) {
		when ( /Licensed under the Academic Free License(?: $ver_prefix_re($ver_re))?/ ) {
			$gen_license->( 'AFL', $1 );
		}
	}

	# EPL
	given ($licensetext) {
		when ( /This program and the accompanying materials are made available under the terms of the Eclipse Public License(?:[ ,-]+$ver_prefix_re($ver_re))?/ ) {
			$gen_license->( 'EPL', $1 );
		}
	}

	# BSL
	given ($licensetext) {
		when ( /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\)/ ) {
			$gen_license->('BSL');
		}
		when ( /Boost Software License(?:[ ,-]+ $ver_prefix_re($ver_re))?/i ) {
			$gen_license->( 'BSL', $1, $2 );
		}
	}

	# PostgreSQL
	given ($licensetext) {
		when ( /Permission to use, copy, modify, and distribute this software and its documentation for any purpose, without fee, and without a written agreement is hereby granted, provided that the above copyright notice and this paragraph and the following two paragraphs appear in all copies/i ) {
			$license = "PostgreSQL $license";
			push @spdx_license, 'PostgreSQL';
		}
	}

	# Python
	given ($licensetext) {
		when ( /PYTHON SOFTWARE FOUNDATION LICENSE(?:,? $ver_prefix_re($ver_re))?/i ) {
			$gen_license->( 'Python', $1, $2 );
		}
	}

	# SIL
	given ($licensetext) {
		when ( /must be distributed using this license/i ) {
			$license = "SIL (v1.0) $license";
			push @spdx_license, 'SIL-1.0';
		}
		when ( /must be distributed entirely under this license/i ) {
			$license = "SIL (v1.1) $license";
			push @spdx_license, 'SIL-1.1';
		}
	}

	# Unicode-strict
	given ($licensetext) {
		when ( /Unicode, Inc\. hereby grants the right to freely use the information supplied in this file in the creation of products supporting the Unicode Standard, and to make copies of this file in any form for internal or external distribution as long as this notice remains attached/i ) {
			$license = "Unicode strict $license";
			push @spdx_license, 'Unicode-strict';
		}
	}

	# Unicode-TOU
	given ($licensetext) {
		when ( /Any person is hereby authorized, without fee, to view, use, reproduce, and distribute all documents and files solely for informational purposes in the creation of products supporting the Unicode Standard, subject to the Terms and Conditions herein/i ) {
			$license = "Unicode Terms of Use $license";
			push @spdx_license, 'Unicode-TOU';
		}
	}

	# Zlib/Libpng
	given ($licensetext) {
		when ( /acknowledgment .* in the product documentation is required/ ) {
			$license = "zlib/libpng License with Acknowledgement $license";
			push @spdx_license, 'zlib-acknowledgement';
		}
		when ( /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/ ) {
			$gen_license->('Zlib');
		}
		when ( /see copyright notice in zlib\.h/ ) {
			$gen_license->('Zlib');
		}
		when ( /This code is released under the libpng license/ ) {
			$gen_license->('Libpng');
		}
	}

	# WTFPL
	given ($licensetext) {
		when ( /Do What The Fuck You Want To Public License,? $ver_prefix_re($ver_re)/i ) {
			$gen_license->( 'WTFPL', $1 );
		}
	}
	given ($licensetext) {
		when ( /Do what The Fuck You Want To Public License/i ) {
			$gen_license->('WTFPL');
		}
	}
	given ($licensetext) {
		when ( /(License WTFPL|Under (the|a) WTFPL)/i ) {
			$gen_license->('WTFPL');
		}
	}
	#>>>

	# Remove trailing spaces.
	$license =~ s/\s+$//;
	return $self->deb_fmt ? join( ' and/or ', @spdx_license ) : $license;
}

=encoding UTF-8

=head1 AUTHOR

Jonas Smedegaard C<< <dr@jones.dk> >>

=head1 COPYRIGHT AND LICENSE

This program is based on the script "licensecheck" from the KDE SDK,
originally introduced by Stefan Westerfeld C<< <stefan@space.twc.de> >>.

  Copyright © 2007, 2008 Adam D. Barratt

  Copyright © 2012 Francesco Poli

  Copyright © 2016 Jonas Smedegaard

This program is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 3, or (at your option) any
later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License along
with this program. If not, see <https://www.gnu.org/licenses/>.

=cut

1;
