File Coverage

blib/lib/Software/LicenseMoreUtils.pm

Criterion	Covered	Total	%
statement	54	56	96.4
branch	6	10	60.0
condition	4	5	80.0
subroutine	14	15	93.3
pod	1	2	50.0
total	79	88	89.7

#
# This file is part of Software-LicenseMoreUtils
#
# This software is copyright (c) 2018, 2022 by Dominique Dumont.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
package Software::LicenseMoreUtils;
$Software::LicenseMoreUtils::VERSION = '1.008';
use strict;
use warnings;
use 5.10.1;

use Try::Tiny;
use Carp;
use Software::LicenseMoreUtils::LicenseWithSummary;
use Software::License 0.103014;

# ABSTRACT: More utilities and a summary for Software::License

use base qw/Software::LicenseUtils/;

# a short name with '+' at the end of the short name implies an
# "or later" clause.  i.e. GPL-1+ is "GPL-1 or any later version"
my %more_short_names = (
    'Apache-2'     => 'Software::License::Apache_2_0',
    'Artistic'     => 'Software::License::Artistic_1_0',
    'Artistic-1'   => 'Software::License::Artistic_1_0',
    'Artistic-2'   => 'Software::License::Artistic_2_0',
    'BSD-3-clause' => 'Software::License::BSD',
    'Expat'        => 'Software::License::MIT',
    'LGPL-2'       => 'Software::LicenseMoreUtils::LGPL_2',
    'LGPL_2'       => 'Software::LicenseMoreUtils::LGPL_2',
    'LGPL-3'       => 'Software::License::LGPL_3_0',
    'MPL-1.0'      => 'Software::License::Mozilla_1_0',
    'MPL-1.1'      => 'Software::License::Mozilla_1_1',
    'MPL-2.0'      => 'Software::License::Mozilla_2_0',

    # GPL SPDX identifiers have another convention for GPL version number
    'LGPL-2.0' => 'Software::LicenseMoreUtils::LGPL_2',

    'GPL-1.0'  => 'Software::License::GPL_1',
    'GPL-2.0'  => 'Software::License::GPL_2',
    'GPL-3.0'  => 'Software::License::GPL_3',
);

sub _create_license {
    my ( $class, $arg ) = @_;
    croak "no license short name specified"
          unless defined $arg->{short_name};

    my $lic_obj;
    try {
        $lic_obj = SUPER::new_from_short_name($arg);
    };

    return $lic_obj if $lic_obj;

    try {
        $lic_obj = SUPER::new_from_spdx_expression($arg);
    };

    return $lic_obj if $lic_obj;

    my $short = $arg->{short_name};
    $short =~ s/-(only|or-later)$//;
    $short =~ s/\+$//;

    my $subclass = $short;
    $subclass =~ s/[\-.]/_/g;

    my $info = $more_short_names{$short} || "Software::License::$subclass";
    my $lic_file = my $lic_class = $info;
    $lic_file =~ s!::!/!g;
    try {
        ## no critic (Modules::RequireBarewordIncludes)
        require "$lic_file.pm";
    } catch {
        Carp::croak "Unknow license with short name $short ($_)";
    } ;
    delete $arg->{short_name};
    $lic_obj = $lic_class->new( { %$arg } );

    return $lic_obj;
}

sub new_license_with_summary {
    carp "new_license_with_summary is deprecated. Please use new_from_short_name";
    goto & new_from_short_name;
}

sub new_from_short_name {
    my ( $class, $arg ) = @_;
    croak "no license short name specified"
        unless defined $arg->{short_name};

    my $short = $arg->{short_name};

    my $info = $more_short_names{$short} || '';
    my $or_later = $short =~ /(\+|-or-later)$/ ? 1 : 0;
    my $lic = $class->_create_license($arg);

    my $xlic = Software::LicenseMoreUtils::LicenseWithSummary->new({
        license => $lic,
        or_later => $or_later
    });
    return $xlic;
}

1;

__END__