# duck - check for debian/copyright files

# 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::copyright_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=(
    "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;
