package Dpkg::Copyright::Grant::Plain;

use 5.20.0;
use strict;
use warnings;
use utf8;
use Carp;

use Mouse;

use Software::Copyright;
use Digest::SHA qw/sha1_hex/;

use feature qw/postderef signatures/;
no warnings qw/experimental::postderef experimental::signatures/;

use overload '%{}' => \&_to_copyright_structure;
use overload 'eq' => \&_equal;
use overload '==' => \&_equal;
use overload '""' => \&_stringify;

has copyright => (
    is => 'rw',
    isa => 'Software::Copyright',
    required => 1,
    handles => {
        map { $_ => $_ } qw/name email record owners/
    },
    trigger => sub ($self, $c, $=0) {
        my $new_c = _cleanup_copyright("$c");
        # the test avoids infinite recursion
        if ($c->stringify ne $new_c) {
            $self->copyright(Software::Copyright->new($new_c));
        }
    }
);

# a short-name
has license => (
    is => 'rw',
    isa => 'Str',
    required => 1,
    trigger => sub ($self, $l, $=0) {
        my $new_l = _cleanup_license($l);
        # the test avoids infinite recursion
        $self->license($new_l) if $l ne $new_l;
    }
);

# compatibility with Debian copyright information
has license_text => (
    is => 'rw',
    isa => 'Str',
    default => ''
);

# compatibility with Debian copyright information
has comment => (
    is => 'rw',
    isa => 'Str',
    default => ''
);

around BUILDARGS => sub ($orig, $class, %args) {
    if (ref $args{copyright}) {
        croak "constructor error: need strings, not objects";
    }

    # triggers are not applied when creating an object, so cleanup
    # must aldo be done here.
    my $c = _cleanup_copyright(delete $args{copyright});
    my $l = _cleanup_license(delete $args{license});

    return $class->$orig({
        copyright => Software::Copyright->new($c),
        license => $l,
        %args,
    }) ;
};

sub empty_grant {
    return Dpkg::Copyright::Grant::Plain->new();
}

sub hash ($self) {
    return 0 unless $self->has_info;
    my $str = $self->license.$self->copyright.$self->comment.$self->license_text;
    utf8::encode($str);
    return sha1_hex($str);
}

sub _stringify ($self, $other, $swap) {
    return join(' / ', grep { $_ } ($self->license, $self->copyright));
}

sub lic_owner_hash ($self) {
    return 0 unless $self->has_info;
    my $str = join('|',$self->license, sort $self->owners);
    utf8::encode($str);
    return sha1_hex($str);
}

sub lic_comment_owner_hash ($self) {
    return 0 unless $self->has_info;
    my $str = join('|',$self->comment, $self->license_text, $self->license, sort $self->owners);
    utf8::encode($str);
    return sha1_hex($str);
}

sub year_ranges ($self) {
    return map { $_->range } $self->copyright->statement_list;
}

sub has_info ($self) {
    return 1 if $self->copyright ;
    return 1 if $self->license;
    return 0; # only if both info are missing
}

sub _cleanup_license ($l) {
    return '' unless defined $l;

    $l =~ s/\bMIT\b/Expat/g;

    # cleanup license text output. Assume that 'or' is inclusive
    $l =~ s!and/or!or!;

    # Found in LICENSE files generated by Dist::Zilla
    $l =~ s/(l?gpl)_(\d)/uc($1)."-$2"/ie;
    $l =~ s/_/./;
    $l =~ s!GPL-1\+ or GPL-1!GPL-1+!;

    # convert spdx license in Debian style
    $l =~ s!(L?GPL-\d)\.0!$1!g;
    $l =~ s!(L?GPL-[\d.]+)-only!$1!g;
    $l =~ s!(L?GPL-[\d.]+)-or-later!$1+!g;

    # convert perl style license to spdx license
    $l =~ s!perl\.?5?!Artistic-1.0 or GPL-1+!i;

    # convert plain license to spdx keyword
    $l =~ s/artistic(?!-)/Artistic-1.0/i;

    # blank license is unknown license
    $l = '' if $l =~ /unknown/i;

    # remove identical or'ed license, unless there's an 'and' in the mix
    my %lics = map {
        # remove trailing + from the key, so GPL-2+ value clobbers GPL-2
        # this remove duplicates like GPL2+ or GPL-2
        # detecting overlap of GPL2+ or GPL-3 is too complicated
        s/\+$//r => $_
    } sort split /\sor\s/, $l;
    $l = join (' or ', sort values %lics) unless $l =~ /\band\b/;

    return $l;
}

# for now I prefer doing cleanup specific to licensecheck here
# instead of inside Software::Copyright which is more generic
sub _cleanup_copyright ($c) {
    return '' unless defined $c;

    # blank if unknown
    $c = '' if $c =~ /unknown|no-info-found|no copyright/i;

    # Some copyright statements contain copyright word.
    # the counter is a safety measure.
    my $n = 0;
    while ($c =~ s/(?i:copyright|©|\(c\))\s+(?=[A-Z\d][a-z\d])//) { last if $n++ > 10};

    $c =~ s/®//g;
    $c =~ s/^[\n\s]*//;
    chomp($c);

    return $c;
}

sub _to_copyright_structure ($self, $other=0, $swap=0) {
    return {
        Copyright => $self->copyright->stringify,
        License => {
            short_name => $self->license,
            $self->license_text ? (license_text => $self->license_text) : ()
        },
        $self->comment ? (comment => $self->comment) : ()
    };
}

sub _equal ($self, $other, $swap) {
    no warnings "uninitialized"; ## no critic (ProhibitNoWarnings)
    return ($self->copyright->stringify eq $other->{Copyright} and $self->license eq $other->{License}{short_name});
}

sub merge ($self, $other) {
    $self->copyright->merge($other->copyright) if $other->copyright;
    # license value is cleaned up by trigger
    $self->license(join(' or ', sort grep {$_} ($self->license, $other->license)))
        unless $self->license eq $other->license;

    foreach my $what (qw/license_text comment/) {
        my $new_str = $self->$what() // '';
        my $other_str = $other->$what() // '';
        if ($new_str and $other_str and $new_str ne $other_str) {
            croak "cannot clobber $what when merging";
        } elsif ($other_str and not $new_str) {
            $self->$what($other_str);
        }
    }
    return $self;
}

sub clone ($self) {
    return $self->new(
        copyright => $self->copyright.'',
        license => $self->license,
        comment => $self->comment,
        license_text => $self->license_text,
    );
}

sub contains($self, $other) {
    return 0 unless defined $other;
    if (($self->license eq $other->license or not $other->license) and
        $self->comment eq $other->comment and
        $self->license_text eq $other->license_text
    ) {
        return (not $other->copyright.'' or $self->copyright->contains($other->copyright));
    }
    return 0;
}

sub merge_old_grant ($self, $other) {
    # update info if they are missing in self. Otherwise we consider
    # that data from old grant is obsolete
    $self->license($other->license) unless $self->license;
    $self->copyright($other->copyright) unless $self->copyright;

    # do not clobber existing data
    $self->comment($other->comment) unless $self->comment;
    $self->license_text($other->license_text) unless $self->license_text;
    return;
}

1;
