whoami7 - Manager
:
/
usr
/
share
/
perl5
/
vendor_perl
/
Software
/
Upload File:
files >> //usr/share/perl5/vendor_perl/Software/LicenseUtils.pm
use strict; use warnings; use Carp; package Software::LicenseUtils; # ABSTRACT: little useful bits of code for licensey things $Software::LicenseUtils::VERSION = '0.103013'; use File::Spec; use IO::Dir; use Module::Load; #pod =method guess_license_from_pod #pod #pod my @guesses = Software::LicenseUtils->guess_license_from_pod($pm_text); #pod #pod Given text containing POD, like a .pm file, this method will attempt to guess #pod at the license under which the code is available. This method will either #pod a list of Software::License classes (or instances) or false. #pod #pod Calling this method in scalar context is a fatal error. #pod #pod =cut 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) ], '(?:the )?2[-\s]clause (?:Free)?BSD' => 'FreeBSD', 'BSD license' => 'BSD', 'FreeBSD license' => 'FreeBSD', "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]" }, 'GPL' => [ map { "GPL_$_" } (1..3) ], 'FreeBSD' => 'FreeBSD', 'BSD' => 'BSD', 'Artistic' => [ map { "Artistic_$_\_0" } (1..2) ], 'MIT' => 'MIT', 'has dedicated the work to the Commons' => 'CC0_1_0', 'waiving all of his or her rights to the work worldwide under copyright law' => 'CC0_1_0', ); my %meta_keys = (); my %meta1_keys = (); my %meta2_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; $meta1_keys{ $class->meta_name }{$mod} = undef; $meta_keys{ $class->meta2_name }{$mod} = undef; $meta2_keys{ $class->meta2_name }{$mod} = undef; my $name = $class->name; unshift @phrases, qr/\Q$name\E/, [$mod]; if ((my $name_without_space = $name) =~ s/\s+\(.+?\)//) { unshift @phrases, qr/\Q$name_without_space\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 =~ /\b$pattern\b/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::$_" } sort @result; } } } return; } #pod =method guess_license_from_meta #pod #pod my @guesses = Software::LicenseUtils->guess_license_from_meta($meta_str); #pod #pod Given the content of the META.(yml|json) file found in a CPAN distribution, this #pod method makes a guess as to which licenses may apply to the distribution. It #pod will return a list of zero or more Software::License instances or classes. #pod #pod =cut 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; } { no warnings 'once'; *guess_license_from_meta_yml = \&guess_license_from_meta; } #pod =method guess_license_from_meta_key #pod #pod my @guesses = Software::LicenseUtils->guess_license_from_meta_key($key, $v); #pod #pod This method returns zero or more Software::License classes known to use C<$key> #pod as their META key. If C<$v> is supplied, it specifies whether to treat C<$key> #pod as a v1 or v2 meta entry. Any value other than 1 or 2 will raise an exception. #pod #pod =cut sub guess_license_from_meta_key { my ($self, $key, $v) = @_; my $src = (! defined $v) ? \%meta_keys : $v eq '1' ? \%meta1_keys : $v eq '2' ? \%meta2_keys : Carp::croak("illegal META version: $v"); return unless $src->{$key}; return map { "Software::License::$_" } sort keys %{ $src->{$key} }; } 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', ); #pod =method new_from_short_name #pod #pod my $license_object = Software::LicenseUtils->new_from_short_name( { #pod short_name => 'GPL-1', #pod holder => 'X. Ample' #pod }) ; #pod #pod Create a new L<Software::License> object from the license specified #pod with C<short_name>. Known short license names are C<GPL-*>, C<LGPL-*> , #pod C<Artistic> and C<Artistic-*> #pod #pod =cut 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 $lic_file = my $lic_class = $short_name{$short} ; $lic_file =~ s!::!/!g; require "$lic_file.pm"; return $lic_class->new( $arg ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Software::LicenseUtils - little useful bits of code for licensey things =head1 VERSION version 0.103013 =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 guess_license_from_meta_key my @guesses = Software::LicenseUtils->guess_license_from_meta_key($key, $v); This method returns zero or more Software::License classes known to use C<$key> as their META key. If C<$v> is supplied, it specifies whether to treat C<$key> as a v1 or v2 meta entry. Any value other than 1 or 2 will raise an exception. =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) 2017 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
Copyright ©2021 || Defacer Indonesia