# duck - check for various urls in file
# 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::list_file;

use strict;
use warnings;
use autodie;
use Data::Dumper;
use Parse::DebControl qw(parse_file);
use Regexp::Common qw /URI Email::Address/;
use Mail::Address;
use DUCK;

my %options = (
    "l:" => "  -l file\tspecify path to list 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{l}) {
        if (!-r $opt{l}) {
            print STDERR "Unable to open user-specified list file: "
                . $opt{l} . "\n";
            exit(2);
        }

        # processing list file
        my $list_fn = ($opt{l});
        my @list_raw;

        if (open my $fh, "<", $list_fn) {
            @list_raw = <$fh>;

            close($fh);
            chomp @list_raw;
        }

        my $linenum = 0;

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

            next unless length($list_line);

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

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

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

                my $check_method = "URL";
                my $guess_info   = "";
                my $certainty    = "possible";
                my $verbose      = "";

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

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

                    my $check_method = "Vcs-Svn";
                    my $guess_info   = "";
                    my $certainty    = "possible";
                    my $verbose      = "";

                    push(
                        @$entries_ref,
                        [
                            $guess_info . $list_fn . ":" . $linenum,
                            $check_method,
                            $list_line_mangled,
                            $list_line,
                            {
                                filename    => $list_fn,
                                linenumber  => $linenum,
                                checkmethod => $check_method,
                                orig_line   => $list_line,
                                url         => $list_line_mangled,
                                verbose     => $verbose,
                                certainty   => $certainty
                            }
                        ]
                    );
                }

                if ($list_line =~ /^\s*git/) {
                    my $list_line_mangled = $list_line;

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

                    my $check_method = "Vcs-Git";
                    my $guess_info   = "";
                    my $certainty    = "possible";
                    my $verbose      = "";

                    push(
                        @$entries_ref,
                        [
                            $guess_info . $list_fn . ":" . $linenum,
                            $check_method,
                            $list_line_mangled,
                            $list_line,
                            {
                                filename    => $list_fn,
                                linenumber  => $linenum,
                                checkmethod => $check_method,
                                orig_line   => $list_line,
                                url         => $list_line_mangled,
                                verbose     => $verbose,
                                certainty   => $certainty
                            }
                        ]
                    );
                }

                if ($list_line =~ /[^\s.]@[^\s.]/) {
                    my $list_line_mangled = $list_line;

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

                    next unless length($list_line_mangled);

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

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

                        foreach (@parsed) {
                            push(
                                @$entries_ref,
                                [
                                    $list_fn . ":" . $linenum,
                                    "Email",
                                    $_,
                                    $list_line_mangled,
                                    {
                                        filename    => $list_fn,
                                        linenumber  => $linenum,
                                        checkmethod => "Email",
                                        orig_line   => $list_line,
                                        url         => $_,
                                        certainty   => "possible"
                                    }
                                ]
                            );
                        }
                    }
                }
            }
        }
    }

    return;
}

1;
