#!/usr/bin/perl -Wl

# md5.scr - script to generate descript.ion out of .tardists in a directory
# Replaces dexter1's previous md5.scr, hopefully fixing all of inconsistencies
# and being faster/lighter for the system.
#
# The script was developed and tested on Linux, but worked on IRIX 6.5.27f
# out of the box. (Provided that you have Digest::MD5 Perl module:
# perl -MCPAN -e 'install "Digest::MD5"')
#
# Thu Oct  6 18:56:48 CEST 2005
#
# Davor Ocelic, docelic@spinlocksolutions.com
# Spinlock Solutions, http://www.spinlocksolutions.com/
# Nekochan community, http://www.nekochan.net/
# SGI, http://www.sgi.com/
 
use warnings;
use strict;
use Digest::MD5 qw/md5_hex/;

## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## 
## User-configurable part
my @globs = qw/neko_*.tardist/;
use constant DEBUG => 0;
use constant WARNINGS => 1;

# List of file/package names that have "-" in their package name part.
# All such files should have '-' replaced with '_',
# and then deleted from this list if you like.
my @dashnames = qw/
	gnome-mime-info
	php5-mysql4
	php5-mysqli4
	rss-glx
/;

# List of file/package names whose .tardists contain archive
# files that are not named exactly after package names. Very unfortunately,
# this need to be regexes matching the filename...
my %archivenames = (
	'^neko_gtk\+-1' => 'gtk1',
	'^neko_gtk\+-2' => 'gtk',
	'^neko_glib-1' => 'glib1',
);



## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## 
## No configurables below
use constant NOP => '';
my @files = <@globs>;
my %packagedata;

for my $file (@files) {
	## Filename
	print $file unless DEBUG;

	## Package name (including version)
	my $package = $file;
	$package =~ s/^neko_//;
	$package =~ s/\.tardist$//;

	## Package version (extract out of package name)
	local $" = '|';
	my $version = $package;	
	if   ( $version =~ s/^@dashnames// ) { warn "$package: dashes in pkg name\n" }
	else { $version =~ s/^([\w\+]+)// and $package = $1  }
	local $" = ' ';

	if   ( $version ) { $version =~ s/^-// }
	else { warn "$package: missing version info ('-.*' regexp)\n" }

	## File digest (generate by reading in the tardist)
	open PKG, "< $file" or die "Can't rdopen $file ($!)\n";
	my $digest = md5_hex( <PKG> );
	close PKG or die "Can't rdclose $file ($!)\n";

	## File/package dependencies (basically dexter1's code). Apart from
	# optimizations I've done, I think it can still be optimized way further.
	my @dependencies = `tar Oxf '$file'       |
		strings                                 |
		tr -cs '[A-Z][a-z][0-9][_]' '[\\012*]'  |
		grep neko_                              |
		sort -u                                 |
		sed 's/^neko_//'                        |
		grep -vE '^$package(_|\$)'
	`;
	chomp for @dependencies;
	my $dependencies = join(',', @dependencies);
	$dependencies ||= 'no dependencies';

	## File size (obtained by stat()ting file)
	my $size = (stat $file)[7] or die "Can't stat $file ($!)\n";

	## Package "epoch" (version from neko_<pkgname> file inside tardist)
	# (Just first determine if the description filename within .tardist is 
	# the same as package name or not, and adjust it if needed).
	my $archivename = $package;
	for my $pat ( keys %archivenames ) {
		if ( $file =~ /$pat/ ) {
			$archivename = $archivenames{$pat}
		}
	}
	$archivename = 'neko_' . $archivename;

	# dexter1's code used octal dump from the end of file, but
	# here's voidfoo's hopefully equivalent but simpler approach:
	my @epoch = `tar Oxf '$file' '$archivename' |
		strings                                   |
		egrep '^P[0-9]+_[0-9]+\$'`;
	chomp for @epoch;
	@epoch == 1 or die "Failed internal version check for $file/$archivename\n";
	( my $epoch = $epoch[0] ) =~ s/.*_//;
	

	## At this point we have $file $package $version $epoch $digest $dependencies
	$packagedata{$file} = [ $package, $epoch, $digest, $dependencies ];
}

# Finally, just dump out descript.ion
open OUT, "> descript.ion" or die "Can't wropen descript.ion ($!)\n";
while ( my($file,$data) = each %packagedata ) {
	print OUT $file, "\t", join(' ', @$data);
}
close OUT or die "Can't wrclose descript.ion ($!)\n";

exit 0;