#!/usr/bin/perl
# Copyright (C) 2005, 2006, 2007 Christopher Faylor
#
# This software is a copyrighted work licensed under the terms of the
# GNU General Public License.  See http://www.gnu.org/copyleft/gpl.html
# for details.
#
use File::Basename;
use Digest::MD5;
use Getopt::Long;
use POSIX;

use strict;

sub mywarn(@);
sub myerror(@);
sub usage();
sub arch_handler(@);

my %md5s;

if( open F, "md5sums" ) {
	while(<F>) {
		chomp;
		my($md5,$s,$t,$f) = split / /;
		next unless -f $f;
		$md5s{$f}{md5} = $md5;
		$md5s{$f}{s} = $s;
		$md5s{$f}{t} = $t;
	}
	close F;
}

my %licfile;
my %licmap;
if( open F, "license.map" ) {
	while(<F>) {
		chomp;
		my($first,$second,$comment) = split / /;
		$licmap{$second} = $first;
	}
}

my %acceptable;
if( open F, "acceptable.lst" ) {
	while(<F>) {
		chomp;
		my($id,$comment) = split / /;
		$acceptable{$id} = 1;
	}
}

# For OSGeo4W we don't mind lacking a source file.
my @okmissing = qw'message ldesc source license';
my ($outfile, $help, $recursive);
my $arch = 'x86';
my $release;
my $date;
my $startts;
GetOptions('okmissing=s'=>\@okmissing, 'output=s'=>\$outfile, 'help'=>\$help, 'release=s'=>\$release, 'arch=s'=>\&arch_handler, 'recursive'=>\$recursive, 'date=s'=>\$date) or usage;
if($date) {
	usage unless $date =~ /^(\d{4})-(\d{2})-(\d{2})$/;
	$startts = POSIX::mktime( 0, 0, 0, $3, $2-1, $1-1900);
	usage unless defined $startts;
}
$help and usage;

@main::okmissing{@okmissing} = @okmissing;

sub arch_handler (@) {
   my ($opt_name, $opt_value) = @_;
   die "invalid arch specified: '$opt_value'"
      unless $main::valid_arch{lc $opt_value};
   $arch = $opt_value;
}

if (defined($outfile)) {
    open(STDOUT, '>', $outfile) or die "$0: can't open $outfile - $!\n";
}

my %pkg;

for my $f (@ARGV) {
    if (-d "$f/.") {
        parsedir($f);
    } else {
        parse($f);
    }
}

print <<'EOF';
# This file is automatically generated.  If you edit it, your
# edits will be discarded next time the file is generated.
# See http://cygwin.com/setup.html for details.
#
EOF

my $ts = time();
print "release: $release\n" if $release;
print "arch: $arch\n";
print "setup-timestamp: $ts\n";
print "$main::setup_version\n" if $main::setup_version;

undef $main::curfile;
for my $p (sort keys %pkg) {
    print "\n@ $p\n";
    for my $key ('sdesc', 'ldesc', 'category', 'requires', 'message') {
        my $val = $pkg{$p}{''}{$key};
        if (!defined($val) && $pkg{$p}{''}{'install'} !~ /_obsolete/o) {
            mywarn "package $p is missing a $key field"
              unless defined $main::okmissing{$key};
        } else {
            if ($key eq 'requires') {
                for my $p1 (split(' ', $val)) {
                    mywarn "package $p requires an unknown package '$p1'"
                      unless $pkg{$p};
                }
            } elsif ($key eq 'category') {
                for my $c (split(' ', $val)) {
                    mywarn "package $p uses an invalid category '$c'"
                      unless $main::categories{lc $c};
                }
            }
            print "$key: ", $val, "\n" if defined($val) and $val ne "";
        }
    }
    for my $what ('', "[prev]\n", "[test]\n") {
        $pkg{$p}{$what} or next;
        print "$what";
        for my $key ('version', 'install', 'source', 'license') {
            my $val = $pkg{$p}{$what}{$key} or next;
            print "$key: ", $val, "\n";
        }
    }
}

open F, ">md5sums";
for my $f (keys %md5s) {
	print F
		$md5s{$f}{md5} . " " .
		$md5s{$f}{s} . " " .
		$md5s{$f}{t} . " " .
		$f . "\n";
}
close F;

sub get {
    my $FH = shift;
    my $keyhint = shift;
    my $val = shift;

    if ($keyhint eq 'message') {
	my ($kw, $rest) = $val =~ /^([^"'\s]+)\s+(.*)$/;
	return undef unless defined($kw) && defined($rest);
	return $kw . ' ' . get($FH, 'ldesc', $rest);
    } elsif (substr($val, 0, 1) ne '"') {
        $val = '"'. $val . '"' if $keyhint eq 'ldesc' || $keyhint eq 'sdesc';
    } else {
        while (length($val) == 1 || $val !~ /"$/os) {
            $_ = <$FH>;
            length or last;
            chomp;
            s/(\S)\s+$/$1/;
            $val .= "\n" . $_;
        }
    } 
    $val =~ s/(.)"(.)/$1'$2/mog;
    return $val;
}

sub parse {
    my $f = shift;
    my $pname = shift;
    my $what;
    $main::curfile = $f;
    $. = 0;
    open(\*F, '<', $f) or die "$0: couldn't open $f - $!\n";
    while (<F>) {
        chomp;
        s/#.*$//o;
        s/^\s+//o;
        s/(\S)\s+$/$1/o;
        length or next;
        /^setup-timestamp:/ and do {
            $main::setup_timestamp = $_;
            next;
        };
        /^setup-version:/ and do {
            $main::setup_version = $_;
            next;
        };
        /^\@\s+(\S+)/ and do {
            $pname = $1;
            $what = '';
            next;
        };
        /^([^:]+):\s*(.*)$/ and do {
            my $key = $1;
            my $val = $2;
            if ($key !~ /^(?:prev|curr|test)/) {
                $pkg{$pname}{$what}{$key} = get(\*F, $key, $val);
            } else {
                if ($key eq 'curr') {
                    $key = '';
                } else {
                    $key = "[$key]\n";
                }
                $pkg{$pname}{$key}{'version'} = $val;
            }
            next;
        };
        /^\[[^\]]+\]/ and do {
            $what = $_ . "\n";
            next;
        };
        die "$0: unrecognized input at line file $f, line $.\n";
    }
}

sub compare_versions {
	my($a, $b) = @_;

	my @a = split /\./, $a;
	my @b = split /\./, $b;

	my $n = @a < @b ? @a : @b;

	while( @a && @b ) {
		my $a = shift @a;
		my $b = shift @b;

		next if $a eq $b;

		my ($an) = $a =~ /^(\d+)/;
		my ($bn) = $b =~ /^(\d+)/;
		
		return defined $an && defined $bn ?  $an <=> $bn : $an cmp $bn;
	}

	return @a ? 1 : @b ? -1 : 0;
}

sub parsedir {
    my $d = shift;
    my $pname = basename($d);
    delete $pkg{$pname};
    if ($recursive) {
        for my $drecur (glob("$d/*/.")) {
            last if $drecur =~ /\*/;
            parsedir(dirname($drecur));
        }
    }
    my $setup_hint = "$d/setup.hint";
    return unless -e $setup_hint;
    parse("$setup_hint", $pname);
    my $explicit = 0;
    for my $what ('', "[prev]\n", "[test]\n") {
        my $x = $pkg{$pname}{$what};
        next unless $x->{'version'};
        $explicit = 1;
        addfiles($pname, $x, $d);
    }

    return if $explicit;
    my @files = sort {
                        my($an,$av,$ap) = ($a =~ /(.*)-([^-]+)-(\d+).tar.bz2$/);
                        my($bn,$bv,$bp) = ($b =~ /(.*)-([^-]+)-(\d+).tar.bz2$/);

			my $r;
                        if( defined $ap && defined $bp ) {
                                $r = ($an ne $bn) ?
                                        $an cmp $bn :
                                        $av ne $bv ?
                                                compare_versions($av, $bv) :
                                                compare_versions($ap, $bp);
                        } else {
                                $r = $a cmp $b;
                        }
			return $r;
                } grep { !/-src\.tar.bz2/ } glob("$d/*.tar.bz2");
    @files = grep { (stat($_))[9]<=$startts; } @files if $startts;

    if (!@files) {
        myerror "not enough package files in $d";
        return;
    }
    for my $what ('', "[prev]\n") {
        my $f = pop @files or last;
        $pkg{$pname}{$what}{-unused} = 1;
        my $x = $pkg{$pname}{$what};
        my $p;
        ($p, $x->{'version'}) = getver($f);
        addfiles($p, $x, $d);
    }
}

sub addfiles {
    my $pname = shift;
    my $x = shift;
    my $d = shift;

    my $install = tarball($d, $pname, $x->{'version'});
 
    filer($x, 'install', $install);

    my $t = license($d, ".txt", $pname, $x->{'version'});
    my $p = license($d, ".pdf", $pname, $x->{'version'});
    my $r = license($d, ".rtf", $pname, $x->{'version'});

    if( -e $p && (! -e $t || (stat($p))[9] > (stat($t))[9] ) ) {
	system "pdftotext -layout -enc ASCII7 '$p' - >'$t'";
    } elsif( -e $r && (! -e $t || (stat($r))[9] > (stat($r))[9] ) ) {
	system "catdoc -dus-ascii '$r' >'$t'";
    }

    filer($x, 'license', $t) if -e $t;

    if ($pkg{$pname}{''}{'external-source'}) {
        $pname = $pkg{$pname}{''}{'external-source'};
        $d = finddir($d, $pname) or return;
    }

    my $source  = tarball($d, $pname, $x->{'version'}, 'src');
    filer($x, 'source', $source);
}

sub getver {
    my $f = basename($_[0]);
    my @a = ($f =~ /^(.*?)-(\d.*)\.tar/);
    return wantarray ? @a : $a[1];
}

sub filer {
    my $x = shift;
    my $what = shift;
    my $f = shift;

    unless( -r $f ) {
	myerror "can't open $f - $!" unless $main::okmissing{$what};
        return undef;
    }

    my $digest = $md5s{$f}{md5};
    my ($s,$t) = (stat $f)[7,9];	# size and mtime

    unless( defined $digest && $md5s{$f}{s}==$s && $md5s{$f}{t}==$t ) {
      open(*F, '<', $f);
      my $md5 = Digest::MD5->new;
      $md5->addfile(\*F);
      $digest = $md5->hexdigest;

      $md5s{$f}{md5} = $digest;
      $md5s{$f}{s} = $s;
      $md5s{$f}{t} = $t;
    }

    if( $what eq 'license' ) {
    	$digest = $licmap{$digest} if exists $licmap{$digest};

    	unless( exists $licfile{$digest} ) {
    		$licfile{$digest} = $f;
    	} else {
        	$f = $licfile{$digest};
    	}

	return if exists $acceptable{$digest};
    }

    $x->{$what} = join(' ', $f, -s $f, $digest);
}

sub tarball {
    my $d = shift;
    return "$d/" . join('-', @_) . '.tar.bz2';
}

sub license {
    my $d = shift;
    my $ext = shift;
    return "$d/" . join('-', @_) . $ext;
}

sub fnln {
    return $main::curfile ? "$main::curfile:$.: " : '';
}

sub mywarn(@) {
    warn "warning: " . fnln . "@_\n";
}

sub myerror(@) {
    warn "error: " . fnln . "@_\n";
}

sub finddir {
    my $d = $_[0];
    my $pname = $_[1];
    while (($d = dirname($d)) ne '.' && length($d)) {
        return "$d/$pname" if -d "$d/$pname/.";
    }
    myerror "couldn't find package directory for external-source '$pname'";
    return undef;
}

sub usage() {
    print STDERR <<'EOF';
Usage: genini [--okmissing=key ...] [--recursive] [--output=file] [--help] [--date=yyyy-mm-dd] [setup.ini] [dir ...]
Create OSGeo4W setup.ini from setup.ini, setup.hint and tar ball information.

    --okmissing=key    don't warn if key is missing from setup.ini or setup.hint
                       or if some expected `source' or `install' tarballs are
                       missing. Option may be repeated. --okmissing=install is
                       useful if hint files contain `prev' or `test' entries for
                       missing tarballs. --okmissing=source is useful for
                       LOCAL-ONLY srcless install media.
    --recursive        recurse all subdirectories of specified dirs
    --arch=x86|x86_64  Must be either x86 or x86_64. Defaults to x86.
    --date=yyyy-mm-dd  Generate ini for an older state (all newer files will be ignored)
    --release=string   Optional repository id: cygwin, cygwinports, etc.
    --output=file      output setup.ini info to file
    --help             display this message

Report bugs to cygwin mailing list.
EOF
    exit 0;
}

BEGIN {
    my @cats = qw'
     Commandline_Utilities Desktop Libs Web Web_Applications
     _obsolete _PostInstallLast
     ';
    @main::categories{map {lc $_} @cats} = @cats;

    my @archs = qw'x86 x86_64';
    @main::valid_arch{map {lc $_} @archs} = @archs;
}