more work

git-svn-id: svn://tug.org/texlive/trunk@4363 c570f23f-e606-0410-a88d-b1316a301751

5 files changed, 137 insertions, 2 deletions

diff --git a/new-infra/Perl-API.txt b/new-infra/Perl-API.txt
index 56c8f2bbda6..85c5afbee9b 100644
--- a/new-infra/Perl-API.txt
+++ b/new-infra/Perl-API.txt
@@ -54,6 +54,11 @@ Input/Output
 		without arg to stdout
 		with arg to filehandle
 
+	$tlp->make_zip($ziploc)
+		creates a zip file of the tlp in $ziploc
+			zip $ziploc files ...
+		NOT IMPLEMENTED
+
 Read/Write functions (with argument set, without arg read)
 
 	$tlp->name
@@ -138,10 +143,21 @@ Input/Output
 		without arg to stdout 
 		with arg to filehandle
 
+	$tldb->generate_packagelist
+		outputs list of "package revision" for web delivery
+		without arg to stdout
+		with arg to filehandle
+
 TLP interface
 
 	$tldb->add_tlp($tlp)
 		adds a TLP to the TLDB
 
-
+	$tlp = $tldb->get_package("packagename");
+		returns undef if not installed
+	
+	$rev = $tldb->package_revision("packagename");
+		returns undef if not installed, otherwise the
+		revision of "packagename"
+	
 	
diff --git a/new-infra/TLDB.pm b/new-infra/TLDB.pm
index 0ae41373352..b87bd516b11 100644
--- a/new-infra/TLDB.pm
+++ b/new-infra/TLDB.pm
@@ -28,9 +28,10 @@ sub from_file {
 		die("Need a filename for initialization!");
 	}
 	open(TMP,"<$_[0]") || die("Cannot open tldb file: $_[0]");
+	my $found = 0;
 	do {
 		my $tlp = TLP->new;
-		my $found = $tlp->from_fh(\*TMP,1);
+		$found = $tlp->from_fh(\*TMP,1);
 		if ($found) {
 			$self->add_tlp($tlp);
 		}
@@ -46,6 +47,32 @@ sub writeout {
 	}
 }
 
+sub get_package {
+	my ($self,$pkg) = @_;
+	if (defined($self->{$pkg})) {
+		return($self->{$pkg});
+	} else {
+		return(undef);
+	}
+}
+
+sub package_revision {
+	my ($self,$pkg) = @_;
+	if (defined($self->{$pkg})) {
+		return($self->{$pkg}->revision);
+	} else {
+		return(undef);
+	}
+}
+
+sub generate_packagelist {
+	my $self = shift;
+	my $fd = (@_ ? $_[0] : STDOUT);
+	foreach (sort keys %$self) {
+		print $fd $self->{$_}->name, " ", $self->{$_}->revision, "\n";
+	}
+}
+
 1;
 
 ### Local Variables:
diff --git a/new-infra/TLP.pm b/new-infra/TLP.pm
index b4c19221164..a36a644cf7c 100644
--- a/new-infra/TLP.pm
+++ b/new-infra/TLP.pm
@@ -184,6 +184,17 @@ sub writeout {
 	}
 }
 
+sub make_zip {
+	my ($self,$ziploc) = @_;
+	print STDERR "NOT IMPLEMENTED\n";
+	print STDERR "Should create a zip file of the tlp in $ziploc\n";
+	return;
+	# we have to get all files listed in the $self->{'runfiles'} etc
+	# and put them in a zip file.
+	# First we have to chdir into $TEXLIVEROOT (this variable has
+	# to be set by the CALLING program!!!!
+}
+
 #
 # member access functions
 #
diff --git a/new-infra/create-package-list.pl b/new-infra/create-package-list.pl
new file mode 100644
index 00000000000..1f2b4906b39
--- /dev/null
+++ b/new-infra/create-package-list.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/env perl -w
+#
+# create-package-list.pl
+# Create thepackage list of the current installation
+# Copyright 2007 Norbert Preining
+#
+# This file is licensed under the GNU General Public Licence version 2
+# or any later version
+
+use strict;
+
+use TLDB;
+use Data::Dumper;
+
+my $TLRoot = ".";
+my $tldblocation = "$TLRoot/local.tldb";
+
+my $tldb = TLDB->new;
+$tldb->from_file($tldblocation);
+
+$tldb->generate_packagelist;
+
+
diff --git a/new-infra/updater.pl b/new-infra/updater.pl
new file mode 100644
index 00000000000..aa5790456d3
--- /dev/null
+++ b/new-infra/updater.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/env perl -w
+#
+# updater.pl
+# test implementation of an update program
+# Copyright 2007 Norbert Preining
+#
+# This file is licensed under the GNU General Public Licence version 2
+# or any later version
+
+use strict;
+
+use TLP;
+use TLDB;
+
+my $TLRoot = ".";
+my $tldblocation = "$TLRoot/local.tldb";
+
+my $tldb = TLDB->new;
+$tldb->from_file($tldblocation);
+
+# read package/revision list from stdin
+# format:
+# package revision
+
+my %netavailable;
+while (<>) {
+	chomp;
+	next if m/^\s*#/;
+	if (m/^(\w+)\s+(\d+)$/) {
+		$netavailable{$1} = $2;
+	} else {
+		die "Wrong format of package list: $_!";
+	}
+}
+
+foreach (keys %netavailable) {
+	my $localrev = $tldb->package_revision($_);
+	if ($localrev) {
+		# the package is installed
+		if ($localrev < $netavailable{$_}) {
+			update_one_package($_,$localrev,$netavailable{$_});
+		}
+	}
+}
+
+
+sub update_one_package {
+	my ($pkgname,$localrev,$netrev) = @_;
+	print "update local/$localrev -> net/$netrev\n";
+}
+
+
+### Local Variables:
+### perl-indent-level: 4
+### tab-width: 4
+### indent-tabs-mode: t
+### End:
+# vim:set tabstop=4: #