# duck - check for various urls in file

# Copyright (C) 2016 Simon Kainz <skainz@debian.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;