diff options
| -rw-r--r-- | new-infra/TLDB.pm | 57 | ||||
| -rw-r--r-- | new-infra/TLP.pm | 37 | ||||
| -rw-r--r-- | new-infra/test-tldb.pl | 27 |
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; |