File: short-name-fallback

package info (click to toggle)
libsoftware-license-perl 0.103012-1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 1,012 kB
  • ctags: 289
  • sloc: perl: 6,682; makefile: 2
file content (67 lines) | stat: -rw-r--r-- 2,222 bytes parent folder | download
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");