summaryrefslogtreecommitdiff
path: root/new-infra
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2007-05-24 09:44:56 +0000
committerNorbert Preining <preining@logic.at>2007-05-24 09:44:56 +0000
commitf35c2d99a542a12c8b06562395e90f5afbdbcd51 (patch)
tree3c2735f5e0e06f54da5a941e2d47f6226b23888d /new-infra
parentde9763530c6841fc8d050a7858c7fd28211793a1 (diff)
TLDB module
git-svn-id: svn://tug.org/texlive/trunk@4360 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'new-infra')
-rw-r--r--new-infra/TLDB.pm57
-rw-r--r--new-infra/TLP.pm37
-rw-r--r--new-infra/test-tldb.pl27
3 files changed, 113 insertions, 8 deletions
diff --git a/new-infra/TLDB.pm b/new-infra/TLDB.pm
new file mode 100644
index 00000000000..3c23e94989c
--- /dev/null
+++ b/new-infra/TLDB.pm
@@ -0,0 +1,57 @@
+#
+# TLDB.pm
+# module for using tldb files
+# Copyright 2007 Norbert Preining
+#
+# This file is licensed under the GNU General Public Licence version 2
+# or any later version
+
+package TLDB;
+
+use TLP;
+
+sub new {
+ my $class = shift;
+ my %params = @_;
+ my $self = {};
+ bless $self, $class;
+ return $self;
+}
+
+sub add_tlp {
+ my ($self,$tlp) = @_;
+ $self->{$tlp->name} = $tlp;
+}
+
+sub from_file {
+ my $self = shift;
+ if (@_ != 1) {
+ die("Need a filename for initialization!");
+ }
+ open(TMP,"<$_[0]") || die("Cannot open tldb file: $_[0]");
+ do {
+ my $tlp = TLP->new;
+ my $found = $tlp->from_fh(\*TMP,1);
+ if ($found) {
+ $self->add_tlp($tlp);
+ }
+ } until (!$found);
+}
+
+sub writeout {
+ my $self = shift;
+ my $fd = (@_ ? $_[0] : STDOUT);
+ foreach (sort keys %$self) {
+ $self->{$_}->writeout($fd);
+ print $fd "\n";
+ }
+}
+
+1;
+
+### Local Variables:
+### perl-indent-level: 4
+### tab-width: 4
+### indent-tabs-mode: t
+### End:
+# vim:set tabstop=4: #
diff --git a/new-infra/TLP.pm b/new-infra/TLP.pm
index 5b10dd952b3..b4c19221164 100644
--- a/new-infra/TLP.pm
+++ b/new-infra/TLP.pm
@@ -32,24 +32,40 @@ sub new {
return $self;
}
+# sub from_file {
+# my $self = shift;
+# if (@_ != 1) {
+# die("Need a filename for initialization!");
+# }
+# open(TMP,"<$_[0]") || die("Cannot open tlp file: $_[0]");
+# my @lines = <TMP>;
+# close(TMP);
+
sub from_file {
my $self = shift;
if (@_ != 1) {
die("Need a filename for initialization!");
}
open(TMP,"<$_[0]") || die("Cannot open tlp file: $_[0]");
- my @lines = <TMP>;
- close(TMP);
+ $self->from_fh(\*TMP);
+}
+
+sub from_fh {
+ my ($self,$fh,$multi) = @_;
my $started = 0;
- my $finished = 0;
my $lastcmd = "";
- foreach my $line (@lines) {
+ while (my $line = $fh->getline) {
$line =~ /^\s*#/ && next; # skip comment lines
if ($line =~ /^\s*$/) {
if (!$started) { next; }
- if ($finished) { next; }
- die("No empty line allowed within tlp files!");
+ if (defined($multi)) {
+ # we may read from a tldb file
+ return 1;
+ } else {
+ # we are reading one tldb file, nothing else allowed
+ die("No empty line allowed within tlp files!");
+ }
}
if ($line =~ /^ /) {
if ( ($lastcmd eq "longdesc") ||
@@ -68,7 +84,7 @@ sub from_file {
$name = "$1";
$lastcmd = "name";
$self->name("$name");
- $started && die("Cannot have two name directives!");
+ $started && die("Cannot have two name directives: $line!");
$started = 1;
} else {
$started || die("First directive needs to be 'name'");
@@ -80,6 +96,10 @@ sub from_file {
$self->{'longdesc'} .= "$1 ";
$lastcmd = "longdesc";
next;
+ } elsif ($line =~ /^revision\s+(.*)$/) {
+ $self->{'revision'} .= "$1 ";
+ $lastcmd = "revision";
+ next;
} elsif ($line =~ /^catalogue\s+(.*)$/) {
$self->catalogue("$1");
$lastcmd = "catalogue";
@@ -109,10 +129,11 @@ sub from_file {
$lastcmd = "depend";
next;
} else {
- die("Unknown directive ...$line... in $tldb, please fix it!");
+ die("Unknown directive ...$line... , please fix it!");
}
}
}
+ return $started;
}
sub writeout {
diff --git a/new-infra/test-tldb.pl b/new-infra/test-tldb.pl
new file mode 100644
index 00000000000..373058a6459
--- /dev/null
+++ b/new-infra/test-tldb.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use TLP;
+use TLDB;
+
+my $tldb = new TLDB;
+
+my $tlp = new TLP;
+$tlp->from_file("tlp/baz.tlp");
+$tldb->add_tlp($tlp);
+
+$tlp = new TLP;
+$tlp->from_file("tlp/foo.tlp");
+$tldb->add_tlp($tlp);
+
+open(TMP,">test.tldb");
+$tldb->writeout(\*TMP);
+close(TMP);
+$tldb->writeout;
+
+print "=========================\n";
+
+my $tldbnew = new TLDB;
+$tldb->from_file("test.tldb");
+$tldb->writeout;