# duck - check for debian/copyright files
# Copyright (C) 2016 Simon Kainz <skainz@debian.org>
# Copyright (C) 2022 Baptiste Beauplat <lyknode@cilg.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# he Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# On Debian GNU/Linux systems, the complete text of the GNU General
# Public License can be found in `/usr/share/common-licenses/GPL-2'.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, you can find it on the World Wide
# Web at https://www.gnu.org/copyleft/gpl.html, or write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.

package DUCK::copyright_file;

use strict;
use warnings;
use autodie;
use Data::Dumper;
use Regexp::Common qw /URI Email::Address/;
use Mail::Address;
use DUCK;

my %options = (
    "c:" => "  -c file\tspecify path to copyright file",
    "C"  => "  -C\t\tskip processing of copyright file"
);

sub opts() {
    return keys %options;
}

sub desc() {
    my $r;

    foreach (sort keys %options) {
        $r .= $options{$_} . "\n";
    }

    return $r;
}

sub run() {
    my ($sname, $params, $entries_ref) = @_;
    my %opt = %$params;

    if ($opt{c}) {
        if (!-r $opt{c}) {
            print STDERR "Unable to open user-specified copyright file: "
                . $opt{c} . "\n";
            exit(2);
        }
    }

    if (!$opt{c}) {
        if (!-r "debian/copyright") {
            return;
        }
    }

    if (!$opt{C}) {

        # processing copyright file
        my $copy_fn = ($opt{c} or "debian/copyright");
        my @copy_raw;

        if (open my $fh, "<", $copy_fn) {
            @copy_raw = <$fh>;

            close($fh);
            chomp @copy_raw;
        }
        my $linenum = 0;

        foreach my $copyright_line (@copy_raw) {
            $linenum++;
            $copyright_line =~ s/^[*\s#\-|\/\.]*//;
            $copyright_line =~ s/[\s#\-|\)*]*$//;

            next unless length($copyright_line);

            my $cc = DUCK->extract_url($copyright_line);

            if ($cc) {
                my $copyright_line_mangled = $cc;

                $copyright_line_mangled =~ s/,$//;    # Strip trailing commas.

                my $check_method = "URL";
                my $guess_info   = "";
                my $certainty    = "possible";
                my $verbose      = "";
                my $svn_string   = $copyright_line;
                my $rep          = quotemeta $copyright_line_mangled;

                $svn_string =~ s/$rep/x/g;

                if ($svn_string =~ /\s*svn\s*/) {
                    $check_method = "SVN";
                    $guess_info   = "(SVN method guessed) ";
                    $certainty    = "wild-guess";
                }

                push(
                    @$entries_ref,
                    [
                        $guess_info . $copy_fn . ":" . $linenum,
                        $check_method,
                        $copyright_line_mangled,
                        $copyright_line,
                        {
                            filename    => $copy_fn,
                            linenumber  => $linenum,
                            checkmethod => $check_method,
                            orig_line   => $copyright_line,
                            url         => $copyright_line_mangled,
                            verbose     => $verbose,
                            certainty   => $certainty
                        }
                    ]
                );
            } else {
                if ($copyright_line =~ /[^\s.]@[^\s.]/) {
                    my $copyright_line_mangled = $copyright_line;

                    $copyright_line_mangled =~ s/[\*\#|<>\(\)\/]/ /g;
                    $copyright_line_mangled =~ s/\s\s*/ /g;

                    next unless length($copyright_line_mangled);

                    my @emails = ($copyright_line_mangled =~
                            /$RE{Email}{Address}{-keep}/go);

                    if (@emails && (!($copyright_line =~ /Message-id:/i))) {
                        my @parsed = map $_->address,
                            Mail::Address->parse(@emails);

                        foreach (@parsed) {
                            push(
                                @$entries_ref,
                                [
                                    $copy_fn . ":" . $linenum,
                                    "Email",
                                    $_,
                                    $copyright_line_mangled,
                                    {
                                        filename    => $copy_fn,
                                        linenumber  => $linenum,
                                        checkmethod => "Email",
                                        orig_line   => $copyright_line,
                                        url         => $_,
                                        # verbose =>'$verbose',
                                        certainty => "possible"
                                    }
                                ]
                            );
                        }
                    }
                }
            }
        }
    }

    return;
}

1;
