view release on metacpan or  search on metacpan

lib/CPANPLUS/Dist/Debora/License.pm  view on Meta::CPAN

package CPANPLUS::Dist::Debora::License;

# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later

use 5.016;
use warnings;
use utf8;

our $VERSION = '0.018';

use parent qw(Software::License);

use File::Spec::Functions qw(catfile);
use Scalar::Util qw(weaken);
use Text::Wrap qw();

use CPANPLUS::Dist::Debora::Util qw(slurp_utf8);

# Common modules whose license might not be guessed.
my %LICENSE_NAME_FOR = (
    'Coro' => '(Artistic-1.0-Perl OR GPL-1.0-or-later) '
        . 'AND (BSD-2-Clause OR GPL-2.0-or-later)',
    'Crypt-Blowfish' => 'BSD-4-Clause',
    'Data-Hexdumper' => 'Artistic-1.0-Perl OR GPL-2.0-or-later',
    'EV'             => '(Artistic-1.0-Perl OR GPL-1.0-or-later) '
        . 'AND (BSD-2-Clause OR GPL-2.0-or-later)',
    'Exporter-Tidy' => 'SUSE-Permissive '
        . 'OR GPL-2.0-or-later OR LGPL-2.1-or-later OR MPL-2.0',
    'FCGI'           => 'BSD-2-Clause',
    'Net-Patricia'   => 'GPL-2.0-or-later AND BSD-2-Clause',
    'Time-ParseDate' => 'SUSE-Permissive',
);

sub new {
    my ($class, $attrs) = @_;

    my $package = $attrs->{package};
    delete $attrs->{package};

    my $self = $class->SUPER::new($attrs);

    $self->{package} = $package;
    weaken $self->{package};

    return $self;
}

sub name {
    my $self = shift;

    return 'Unknown license';
}

sub url {
    my $self = shift;

    return;
}

sub meta_name {
    my $self = shift;

    return 'restrictive';
}

sub meta2_name {
    my $self = shift;

    return 'restricted';
}

sub spdx_expression {
    my $self = shift;

    my $package   = $self->{package};
    my $dist_name = $package->dist_name;

    return $LICENSE_NAME_FOR{$dist_name} // 'Unknown';
}

sub license {
    my $self = shift;

    my $package  = $self->{package};
    my $builddir = $package->builddir;

    my $text = q{};

    # Read the license files.
    my @license_files = @{$package->files_by_type('license')};
    for my $filename (@license_files) {
        my $buf = eval { slurp_utf8(catfile($builddir, $filename)) };
        if ($buf) {
            $buf =~ s{\A \v+}{}xms;    # Remove leading newlines.
            $buf =~ s{\v+ \z}{}xms;    # Remove trailing newlines.

            if ($text) {
                $text .= "\n\n";
            }

            if (@license_files > 1) {
                $text .= "-- $filename file --\n\n";
            }