#!/usr/bin/perl -w

# duck - the Debian Url Checker
# Copyright (C) 2014 Simon Kainz <simon@familiekainz.at>
#
# 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 http://www.gnu.org/copyleft/gpl.html, or write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.

use strict;

use lib '/usr/share/duck/lib';

use DUCK;
use Getopt::Std;
use YAML::XS qw(Load);
use Parse::Debian::Packages;

sub proc($;$;$;$;$);

our $VERSION="0.3";
$Getopt::Std::STANDARD_HELP_VERSION=1;

my $debug=0;
my $exitcode=0;

my @yaml_urls;

my @extract=("Homepage","Repository","Repository-Browse","Screenshots","Bug-Submit","Bug-Database","Changelog","Donation","FAQ","Gallery","Other-References","Webservice","Reference","URL","Eprint");

my @upstream_filenames=("debian/upstream","debian/upstream-metadata.yaml","debian/upstream/metadata");

my $extract_hash;
my $upstream_filename;


my %opt;
getopts('qvf:', \%opt);

if ( $opt{v} && $opt{q} ) 
{
    print STDERR " Please specify either -q or -v\n";
    exit(1);
}

foreach my $a (@extract)
{
    $extract_hash->{$a}=1;
}


my $fh= IO::File->new($opt{f} or "debian/control") or die ("no debian/control file found!");
my $parser =Parse::Debian::Packages->new( $fh );

my $DUCK= DUCK->new();
my $funcref= $DUCK->cb();


my @entries;

# create list of urls from debian/control
while (my %package=$parser->next)
{
foreach my $k (keys %package)
{
	push (@entries, ["debian/control",$k,$package{$k} ]);
}

}
close($fh);


# extend list of urls by urls from upstream metadata
foreach (@upstream_filenames)
{
    @yaml_urls=();

    if ( -f $_)
    {
	$upstream_filename=$_;
	open my $fh,"<",$_;

	my @raw=<$fh>;
	my $raw_string=join("",@raw);
	
	close($fh);
	my $hashref;

	eval { Load($raw_string);}; if (!$@)
	{
	    $hashref=Load($raw_string);

	    foreach my $k (keys $hashref)
	    {
		if ($extract_hash->{$k})
		{ 
		    proc("",\@yaml_urls,$k,$hashref->{$k});
		}
	    }

	}

    }


# iterate over all urls, run checks.

foreach my $yaml_url(@yaml_urls)
{
push (@entries, [$upstream_filename.": ".@$yaml_url[2],"URL",@$yaml_url[1] ]);
}

}
foreach my $entry (@entries)
{
    my $type=@$entry[0];
    my $k=@$entry[1];
    my $url=@$entry[2];
    if ($funcref->{$k})
    {
	my $res=&{$funcref->{$k}}($url);
	
	if (!defined $res)
	{
	    if (!$opt{q})
	    {
		print STDERR " Skipping field ".$k." (Reason: Missing helper!)\n";
	    }
	}
	else
	{
	if ($res->{retval}>0)
	{
	    if (!$opt{q})
	    {
		print STDERR  $type.": ".$k.": ".$url.": ERROR\n";
		print STDERR $res->{response};
		print STDERR "\n\n";
	    }
	   $exitcode=1;
	}
	else
	{
	 if ($opt{v})
	 {
	     print STDOUT $type.": ".$k.": ".$url.": OK\n";
	 }
	 
	}
	}
    }



}

exit($exitcode);



sub HELP_MESSAGE()
{
print STDOUT <<EOF;

Usage: duck [options] 
  -h\t--help\tdisplay this usage information and exit
  -f file\tspecify path to control file
  -q\t\tquiet mode, suppress all output
  -v\t\tverbose mode

EOF
    exit(0);
}

sub VERSION_MESSAGE()
{
    print "duck $VERSION\n";

print <<EOF;
This code is copyright 2014 by Simon Kainz <simon\@familiekainz.at>
all rights reserved.
This program comes with ABSOLUTELY NO WARRANTY.
You are free to redistribute this code under the terms of the
GNU General Public License, version 2 or later.

EOF
}


sub proc($;$;$;$;$)
{
    my ($sp,$ref,$key,$r,$p)=@_;
    my $t=ref($r);
    
    if ($t eq "HASH")
    {
	my %a=%{$r};
	foreach my $e (keys %a)
	{
	    return proc($sp,$ref,$e,$a{$e},$key);
	}
	
    }
    
    
    if ($t eq "ARRAY")
    {
	
	my @a=@{$r};
	foreach my $e (@a)
	{
	    return proc($sp,$ref,$key,$e,$key);
	}
    }
    
    if ($t eq "")
    {
	if ($extract_hash->{$key})
	{
	    my @data=($sp,$r,$key);
	    push(@{$ref},\@data);
	}
    }
}
