File Coverage

blib/lib/Software/LicenseMoreUtils/LicenseWithSummary.pm

Criterion	Covered	Total	%
statement	45	48	93.7
branch	6	6	100.0
condition	4	5	80.0
subroutine	14	15	93.3
pod	4	6	66.6
total	73	80	91.2

#
# 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::LicenseWithSummary;
$Software::LicenseMoreUtils::LicenseWithSummary::VERSION = '1.007';
# ABSTRACT: Software::License with a summary

use strict;
use warnings;
use 5.10.1;

use Path::Tiny;
use YAML::Tiny;
use List::Util qw/first/;
use Carp;
use Text::Template;

our $AUTOLOAD;

# map location of distro file (like /etc/redhat_release) to distro.
# must match a _summaries.yml file in the directory containing
# this Perl module file
my %path_to_distro = (
    '/etc/debian_version' => 'debian',
);

my $distro_file = first { -e $_ } keys %path_to_distro;
my $distro = $path_to_distro{$distro_file // ''} || 'unknown';

(my $module_file = __PACKAGE__.'.pm' ) =~ s!::!/!g;
my $yml_file = path($INC{$module_file})->parent->child("$distro-summaries.yml") ;

my $summaries = {} ;
if ($yml_file->is_file) {
    $summaries = YAML::Tiny->read($yml_file)->[0];
}

sub new {
    my ($class, $args) = @_;
    my $self = {
        license => $args->{license},
        or_later => $args->{or_later},
    };

    return bless $self, $class;
}

sub distribution { return $distro }

sub summary {
    my $self = shift;

    my $later_text = $self->{or_later} ? ", or (at\nyour option) any later version" : '';

    (my $section_name = ref( $self->{license} )) =~ s/.*:://;
    my $summary = $summaries->{$section_name} // '';

    my $template = Text::Template->new(
        TYPE => 'STRING',
        DELIMITERS => [ qw({{ }}) ],
        SOURCE => $summary
    );

    return $template->fill_in(
        HASH => { or_later_clause => $later_text },
    );
}

sub license_class {
    my $self = shift;
    return ref($self->{license});
}

sub debian_text {
    my $self = shift;
    carp "debian_text is deprecated, please use summary_or_text";
    return $self->summary_or_text;
}

sub summary_or_text {
    my $self = shift;
    return join("\n",  grep { $_ } ($self->notice, $self->summary))
        if length $self->summary;
    return $self->fulltext;
}

sub AUTOLOAD {
    my ($self, @args) = @_;
    my $lic = $self->{license};
    my ($sub) = ($AUTOLOAD =~ /(\w+)$/);
    if ($lic and $sub ne 'DESTROY') {
        return $lic->$sub(@args);
    }
    else {
        return;
    }
}

1;

__END__