1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
|
Description: Short name fallback
Patch short_name to fallback on a Software::License class if short name is unknown
Forwarded: https://github.com/rjbs/Software-License/pull/31
Author: dod
--- a/lib/Software/LicenseUtils.pm
+++ b/lib/Software/LicenseUtils.pm
@@ -212,15 +212,15 @@
Carp::croak "no license short name specified"
unless defined $arg->{short_name};
- my $short = delete $arg->{short_name};
- Carp::croak "Unknow license with short name $short"
- unless $short_name{$short};
+ my $subclass = my $short = delete $arg->{short_name};
+ $subclass =~ s/[\-.]/_/g;
- my $info = $short_name{$short} ;
+ my $info = $short_name{$short} || "Software::License::$subclass";
my @infos = ref $info ? @$info : ($info);
my $lic_file = my $lic_class = shift @infos;
$lic_file =~ s!::!/!g;
- require "$lic_file.pm";
+ eval { require "$lic_file.pm"; } ;
+ Carp::croak "Unknow license with short name $short ($@)" if $@;
return $lic_class->new( { %$arg, @infos } );
}
@@ -277,7 +277,10 @@
Create a new L<Software::License> object from the license specified
with C<short_name>. Known short license names are C<GPL-*>, C<LGPL-*> ,
-C<Artistic> and C<Artistic-*>
+C<Artistic> and C<Artistic-*>. If the short name is not know, this
+method will try to create a license object with C<Software::License::> and
+the specified short name (e.g. C<Software::License::MIT> with
+C<< short_name => 'MIT' >>.
=head1 AUTHOR
--- a/t/short_name.t
+++ b/t/short_name.t
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 6;
+use Test::More tests => 8;
my $class = 'Software::LicenseUtils';
require_ok($class);
@@ -17,3 +17,16 @@
isa_ok($license,'Software::License::GPL_1',"license class");
like($license->name, qr/version 1/i, "license name");
like($license->fulltext, qr/general public/i, 'license text');
+
+# test fall back
+my $mit_lic = $class->new_from_short_name({
+ short_name => 'MIT',
+ holder => 'X. Ample'
+});
+isa_ok($mit_lic,'Software::License::MIT',"license class");
+
+my $apache_lic = $class->new_from_short_name({
+ short_name => 'Apache-2.0',
+ holder => 'X. Ample'
+});
+isa_ok($apache_lic,'Software::License::Apache_2_0',"license class");
|