/usr/share/perl5/Software/LicenseUtils.pm is in libsoftware-license-perl 0.103008-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 | use strict;
use warnings;
use Carp;
package Software::LicenseUtils;
{
$Software::LicenseUtils::VERSION = '0.103008';
}
# ABSTRACT: little useful bits of code for licensey things
use File::Spec;
use IO::Dir;
use Module::Load;
my $_v = qr/(?:v(?:er(?:sion|\.))(?: |\.)?)/i;
my @phrases = (
"under the same (?:terms|license) as perl $_v?6" => [],
'under the same (?:terms|license) as (?:the )?perl' => 'Perl_5',
'affero g' => 'AGPL_3',
"GNU (?:general )?public license,? $_v?([123])" => sub { "GPL_$_[0]" },
'GNU (?:general )?public license' => [ map {"GPL_$_"} (1..3) ],
"GNU (?:lesser|library) (?:general )?public license,? $_v?([23])\\D" => sub {
$_[0] == 2 ? 'LGPL_2_1' : $_[0] == 3 ? 'LGPL_3_0' : ()
},
'GNU (?:lesser|library) (?:general )?public license' => [ qw(LGPL_2_1 LGPL_3_0) ],
'BSD license' => 'BSD',
"Artistic license $_v?(\\d)" => sub { "Artistic_$_[0]_0" },
'Artistic license' => [ map { "Artistic_$_\_0" } (1..2) ],
"LGPL,? $_v?(\\d)" => sub {
$_[0] == 2 ? 'LGPL_2_1' : $_[0] == 3 ? 'LGPL_3_0' : ()
},
'LGPL' => [ qw(LGPL_2_1 LGPL_3_0) ],
"GPL,? $_v?(\\d)" => sub { "GPL_$_[0]_0" },
'GPL' => [ map { "GPL_$_\_0" } (1..3) ],
'BSD' => 'BSD',
'Artistic' => [ map { "Artistic_$_\_0" } (1..2) ],
'MIT' => 'MIT',
);
my %meta_keys = ();
# find all known Software::License::* modules and get identification data
#
# XXX: Grepping over @INC is dangerous, as it means that someone can change the
# behavior of your code by installing a new library that you don't load. rjbs
# is not a fan. On the other hand, it will solve a real problem. One better
# solution is to check "core" licenses first, then fall back, and to skip (but
# warn about) bogus libraries. Another is, at least when testing S-L itself,
# to only scan lib/ blib. -- rjbs, 2013-10-20
for my $lib (map { "$_/Software/License" } @INC) {
next unless -d $lib;
for my $file (IO::Dir->new($lib)->read) {
next unless $file =~ m{\.pm$};
# if it fails, ignore it
eval {
(my $mod = $file) =~ s{\.pm$}{};
my $class = "Software::License::$mod";
load $class;
$meta_keys{ $class->meta_name }{$mod} = undef;
$meta_keys{ $class->meta2_name }{$mod} = undef;
my $name = $class->name;
unshift @phrases, qr/\Q$name\E/, [$mod];
};
}
}
sub guess_license_from_pod {
my ($class, $pm_text) = @_;
die "can't call guess_license_* in scalar context" unless wantarray;
return unless $pm_text =~ /
(
=head \d \s+
(?:licen[cs]e|licensing|copyright|legal)\b
)
/ixmsg;
my $header = $1;
if (
$pm_text =~ m/
\G
(
.*?
)
(=head\\d.*|=cut.*|)
\z
/ixms
) {
my $license_text = "$header$1";
for (my $i = 0; $i < @phrases; $i += 2) {
my ($pattern, $license) = @phrases[ $i .. $i+1 ];
$pattern =~ s{\s+}{\\s+}g
unless ref $pattern eq 'Regexp';
if ( $license_text =~ /$pattern/i ) {
my $match = $1;
# if ( $osi and $license_text =~ /All rights reserved/i ) {
# warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it.";
# }
my @result = (ref $license||'') eq 'CODE' ? $license->($match)
: (ref $license||'') eq 'ARRAY' ? @$license
: $license;
return unless @result;
return map { "Software::License::$_" } @result;
}
}
}
return;
}
sub guess_license_from_meta {
my ($class, $meta_text) = @_;
die "can't call guess_license_* in scalar context" unless wantarray;
my ($license_text) = $meta_text =~ m{\b["']?license["']?\s*:\s*["']?([a-z_0-9]+)["']?}gm;
return unless $license_text and my $license = $meta_keys{ $license_text };
return map { "Software::License::$_" } sort keys %$license;
}
*guess_license_from_meta_yml = \&guess_license_from_meta;
my %short_name = (
'GPL-1' => 'Software::License::GPL_1',
'GPL-2' => 'Software::License::GPL_2',
'GPL-3' => 'Software::License::GPL_3',
'LGPL-2' => 'Software::License::LGPL_2',
'LGPL-2.1' => 'Software::License::LGPL_2_1',
'LGPL-3' => 'Software::License::LGPL_3_0',
'LGPL-3.0' => 'Software::License::LGPL_3_0',
'Artistic' => 'Software::License::Artistic_1_0',
'Artistic-1' => 'Software::License::Artistic_1_0',
'Artistic-2' => 'Software::License::Artistic_2_0',
'GPL-1+' => [ 'Software::License::GPL_1', or_later => 1 ],
'GPL-2+' => [ 'Software::License::GPL_2', or_later => 1 ],
'GPL-3+' => [ 'Software::License::GPL_3', or_later => 1 ],
'LGPL-2+' => [ 'Software::License::LGPL_2', or_later => 1 ],
'LGPL-2.1+' => [ 'Software::License::LGPL_2_1', or_later => 1 ],
'LGPL-3+' => [ 'Software::License::LGPL_3_0', or_later => 1 ],
'LGPL-3.0+' => [ 'Software::License::LGPL_3_0', or_later => 1 ],
);
sub new_from_short_name {
my ( $class, $arg ) = @_;
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 $info = $short_name{$short} ;
my @infos = ref $info ? @$info : ($info);
my $lic_file = my $lic_class = shift @infos;
$lic_file =~ s!::!/!g;
require "$lic_file.pm";
return $lic_class->new( { %$arg, @infos } );
}
1;
__END__
=pod
=head1 NAME
Software::LicenseUtils - little useful bits of code for licensey things
=head1 VERSION
version 0.103008
=head1 METHODS
=head2 guess_license_from_pod
my @guesses = Software::LicenseUtils->guess_license_from_pod($pm_text);
Given text containing POD, like a .pm file, this method will attempt to guess
at the license under which the code is available. This method will either
a list of Software::License classes (or instances) or false.
Calling this method in scalar context is a fatal error.
=head2 guess_license_from_meta
my @guesses = Software::LicenseUtils->guess_license_from_meta($meta_str);
Given the content of the META.(yml|json) file found in a CPAN distribution, this
method makes a guess as to which licenses may apply to the distribution. It
will return a list of zero or more Software::License instances or classes.
=head2 new_from_short_name
my $license_object = Software::LicenseUtils->new_from_short_name( {
short_name => 'GPL-1',
holder => 'X. Ample'
}) ;
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-*>
=head1 AUTHOR
Ricardo Signes <rjbs@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Ricardo Signes.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|