[licensecheck] 29/112: Use Regexp::Pattern::License for shortname resolving (with internal list as fallback until phased out).

[Jonas Smedegaard]

This is an automated email from the git hooks/post-receive script.

js pushed a commit to branch master
in repository licensecheck.

commit cb13f08ab9cf6bb6cfa77d4e308a84cafe23545e
Author: Jonas Smedegaard <dr at jones.dk>
Date:   Tue Oct 11 14:46:56 2016 +0200

    Use Regexp::Pattern::License for shortname resolving (with internal list as fallback until phased out).
---
 lib/App/Licensecheck.pm | 46 +++++++++++++++++++++++++++++++++++++---------
 1 file changed, 37 insertions(+), 9 deletions(-)

diff --git a/lib/App/Licensecheck.pm b/lib/App/Licensecheck.pm
index c12d86e..24874b9 100755
--- a/lib/App/Licensecheck.pm
+++ b/lib/App/Licensecheck.pm
@@ -9,6 +9,7 @@ use Path::Iterator::Rule;
 use Path::Tiny;
 use Fcntl qw/:seek/;
 use Encode;
+use Regexp::Pattern::License;
 use String::Copyright 0.003 {
 	format => sub { join ' ', $_->[0] || (), $_->[1] || () }
 };
@@ -380,6 +381,28 @@ sub clean_cruft_and_spaces
 	return $_;
 }
 
+sub licensepatterns
+{
+	my $org = shift;
+
+	my %list;
+
+	while ( my ( $key, $val ) = each %SPDX ) {
+		$list{caption}{$key} = $val;
+	}
+	while ( my ( $key, $val ) = each %Regexp::Pattern::License::RE ) {
+		if ($org) {
+			$list{name}{$key}    = $val->{ 'name.alt.org.' . $org };
+			$list{caption}{$key} = $val->{ 'caption.alt.org.' . $org };
+		}
+		$list{name}{$key} ||= $val->{name} || $key;
+		$list{caption}{$key} ||= $val->{caption} || $val->{name} || $key;
+		$list{re}{$key} = $val->{pat};
+	}
+
+	return %list;
+}
+
 sub parse_license
 {
 	my $self = shift;
@@ -390,6 +413,9 @@ sub parse_license
 	my $license   = "";
 	my @spdx_gplver;
 
+	# TODO: make naming scheme configurable
+	my %L = licensepatterns('debian');
+
   # @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
@@ -406,22 +432,24 @@ sub parse_license
 	my $gen_license = sub {
 		my ( $id, $v, $later, $id2, $v2, $later2 ) = @_;
 		my @spdx;
-		my $desc = $SPDX{$id} || $id;
+		my $name = $L{name}{$id}    || $id;
+		my $desc = $L{caption}{$id} || $id;
 		$v .= '+' if ($later);
-		push @spdx, $v ? "$id-$v" : $id if ($id);
-		my $desc2;
-		$desc2 = $SPDX{$id2} || $id2 if ($id2);
+		push @spdx, $v ? "$name-$v" : $name if ($id);
+		my ( $name2, $desc2 );
+		$name2 = $L{name}{$id2}    || $id2 if ($id2);
+		$desc2 = $L{caption}{$id2} || $id2 if ($id2);
 		$v2 .= '+' if ($later2);
-		push @spdx, $v2 ? "$id2-$v2" : "$id2" if ($id2);
+		push @spdx, $v2 ? "$name2-$v2" : "$name2" if ($id2);
 		my $legacy = join(
 			' ',
 			$desc,
-			( $v     ? "(v$v)"     : () ),
-			( $desc2 ? "or $desc2" : () ),
-			( $v2    ? "(v$v2)"    : () ),
+			$v     ? "(v$v)"     : (),
+			$desc2 ? "or $desc2" : (),
+			$v2    ? "(v$v2)"    : (),
 		);
 		push @spdx_license, join( ' or ', @spdx );
-		$license = join( ' ', ( $SPDX{$legacy} || $legacy ), $license );
+		$license = join( ' ', $L{caption}{$legacy} || $legacy, $license );
 	};
 
 	#<<<  do not let perltidy touch this (keep long regex on one line)

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/licensecheck.git