#!/usr/bin/perl

# this is release 1.13 of genini, downloaded from http://cygwin.com/cgi-bin/cvsweb.cgi/genini/genini?cvsroot=cygwin-apps
# its use is documented on http://sourceware.org/cygwin-apps/package-server.html

# 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 strict;

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

my @okmissing = qw'message ldesc';
my ($outfile, $help, $recursive);
my @cmp_fmts = qw(gz bz2 lzma xz);

GetOptions('okmissing=s'=>\@okmissing, 'output=s'=>\$outfile, 'help'=>\$help, 'recursive'=>\$recursive) or usage;
$help and usage;

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

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 "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') {
	    my $val = $pkg{$p}{$what}{$key} or next;
	    print "$key: ", $val, "\n";
	}
    }
}

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)/) {
		$val = get(\*F, $key, $val);
		$pkg{$pname}{$what}{$key} = $val;
	    } else {
		if ($key eq 'curr') {
		    $key = '';
		} else {
		    $key = "[$key]\n";
		}
		$pkg{$pname}{$key}{'version'} = $val;
	    }
	    next if defined $val;
	};
	/^\[[^\]]+\]/ and do {
	    $what = $_ . "\n";
	    next;
	};
	die "$0: unrecognized input at line file $f, line $.\n";
    }
}

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 $cmp_fmts_grep = join('|', @cmp_fmts);
    my $cmp_fmts_glob = join(',', @cmp_fmts);
    my @files = sort grep{!/-src\.tar\.($cmp_fmts_grep)/} glob("$d/*.tar.{$cmp_fmts_glob}");
    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);

    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;
    open(*F, '<', $f) or do {
	myerror "can't open $f - $!" unless $main::okmissing{$what};
	return undef;
    };
    my $md5 = Digest::MD5->new;
    $md5->addfile(\*F);
    $x->{$what} = join(' ', $f, -s $f, $md5->hexdigest);
}

sub tarball {
    my $d = shift;
    my $b = join('-', @_) . '.tar.';
    for my $e (@cmp_fmts) {
      my $f = "$d/" . "$b" . "$e";
      if (-e "$f") {
        return "$f";
      }
    }
    # default to .bz2 (even though we know it is missing)
    return "$d/" . "$b" . "bz2";
}

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] [setup.ini] [dir ...]
Create cygwin 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
    --output=file      output setup.ini info to file
    --help             display this message

[*] You wouldn't want to violate the GPL, now would you?

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

BEGIN {
    my @cats = qw'
     Admin Archive Audio Base Comm Database Devel Doc Editors Games
     Gnome Graphics Interpreters KDE Libs Mail Math Mingw Net Perl
     Publishing Python Science Shells Sound System Text Utils Web X11
     _obsolete _PostInstallLast
     ';
    @main::categories{map {lc $_} @cats} = @cats;
}
