summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2007-06-06 11:43:38 +0000
committerNorbert Preining <preining@logic.at>2007-06-06 11:43:38 +0000
commit4c473ca7fcaf7f3246a51d322877ec768d408556 (patch)
tree636d7557236392d054c012447a196157f553aaa3
parentbbe72e45ac159608384e015d20b2e3b59b5b630f (diff)
clean up
git-svn-id: svn://tug.org/texlive/trunk@4419 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r--new-infra/first-try/Makefile12
-rw-r--r--new-infra/first-try/tlp2tldb.sh7
-rw-r--r--new-infra/first-try/tlsrc2tlp.pl562
-rw-r--r--new-infra/first-try/use_tldb.pl247
4 files changed, 0 insertions, 828 deletions
diff --git a/new-infra/first-try/Makefile b/new-infra/first-try/Makefile
deleted file mode 100644
index 0ad364dca02..00000000000
--- a/new-infra/first-try/Makefile
+++ /dev/null
@@ -1,12 +0,0 @@
-
-all:
- mkdir tlp
- perl tlsrc2tlp.pl tlsrc/*.tlsrc
- bash tlp2tldb.sh tlp/*.tlp > full.tldb
- mv tlp tlp.old
- mkdir tlp
- perl use_tldb.pl full.tldb
- diff -urN tlp.old tlp
-
-clean:
- rm -rf tlp tlp.old full.tldb
diff --git a/new-infra/first-try/tlp2tldb.sh b/new-infra/first-try/tlp2tldb.sh
deleted file mode 100644
index d7bb6138138..00000000000
--- a/new-infra/first-try/tlp2tldb.sh
+++ /dev/null
@@ -1,7 +0,0 @@
-#!/bin/bash
-
-for i in "$@" ; do
- cat $i
- echo ""
-done
-
diff --git a/new-infra/first-try/tlsrc2tlp.pl b/new-infra/first-try/tlsrc2tlp.pl
deleted file mode 100644
index 68872334a07..00000000000
--- a/new-infra/first-try/tlsrc2tlp.pl
+++ /dev/null
@@ -1,562 +0,0 @@
-#!/usr/bin/env perl -w
-#
-# tlsrc2tlp.pl
-# generate tlp files from tlsrc files
-# Copyright 2007 Norbert Preining
-#
-# This file is licensed under the GNU General Public Licence version 2
-# or any later version
-
-use strict;
-
-my %tls;
-my %tldb;
-my $opt_debug = 0;
-my %AllFiles;
-my %DirNames;
-my %FilesOfDir;
-my %SubdirsOfDir;
-
-my $statusfile = "";
-my $tlpline;
-my $DirTree = { };
-
-use Getopt::Long;
-GetOptions("debug!" => \$opt_debug, "statusfile=s" => \$statusfile);
-
-
-&main(@ARGV);
-
-1;
-
-sub dirname {
- my ($f) = @_;
- if ($f =~ m@(^.*)[\\/][^\\/]*$@) {
- return $1;
- } else {
- return ".";
- }
-}
-
-sub basename {
- my ($f) = @_;
- $f =~ m@([^\\/]*)$@;
- return $1;
-}
-
-
-sub main {
- my (@tlsrc) = @_;
- foreach my $f (@tlsrc) {
- read_tlsrc_file($f);
- }
- initialize_all_files();
- my $ts = $#tlsrc + 1;
- my $fs = 0;
- $| = 1;
- foreach my $f (keys %tls) {
- print ".";
- $fs++;
- if ($fs/100 == int($fs/100)) { print "$fs from $ts\n"; }
- generate_tlp_data($f);
- write_tlp_file($f);
- }
- #foreach my $f (keys %tldb) {
- # write_tlp_file($f);
- #}
- my @notused = ();
- my @multiused = ();
- my @tmp;
- foreach my $f (keys %AllFiles) {
- @tmp = @{$AllFiles{$f}{'used'}};
- if ($#tmp < 0) { push @notused, $f; }
- if ($#tmp >= 1) { push @multiused, $f; }
- }
- if ($#notused >= 0) { print "NOT COVERED FILES:\n"; }
- foreach my $f (sort @notused) {
- print STDERR "$f\n";
- }
- if ($#multiused >= 0) { print "MULTIPLE INCLUDED FILES:\n"; }
- foreach my $f (sort @multiused) {
- print STDERR "$f\n";
- foreach (@{$AllFiles{$f}{'used'}}) {
- print " $_\n";
- }
- }
-}
-
-sub read_tlsrc_file {
- my ($tlsrc) = @_;
- open(TMP,"<$tlsrc") || die("Cannot open $tlsrc: $!");
- my @lines = <TMP>;
- close(TMP);
- my $name = "";
- my $shortdesc = "";
- my $longdesc= "";
- my $catalogue = "";
- my (@executes, @depends);
- my (@runpatterns, @docpatterns, @binpatterns, @srcpatterns);
- my $started = 0;
- my $finished = 0;
- my $lastcmd = "";
-
- logit("Working on $tlsrc\n");
- foreach my $line (@lines) {
- $line =~ /^\s*#/ && next; # skip comment lines
- if ($line =~ /^\s*$/) {
- if (!$started) { next; }
- if ($finished) { next; }
- die("No empty line allowed in tlsrc files!");
- }
- if ($line =~ /^ /) {
- if ( ($lastcmd eq "longdesc") ||
- ($lastcmd eq "runpattern") ||
- ($lastcmd eq "binpattern") ||
- ($lastcmd eq "docpattern") ||
- ($lastcmd eq "srcpattern") ||
- ($lastcmd eq "execute") ||
- ($lastcmd eq "depend") ) {
- $line =~ s/^ /$lastcmd /;
- } else {
- die("Continuation of $lastcmd not allowed, please fix tlsrc!\n");
- }
- }
- if ($line =~ /^name\s*([\w-]+)$/) {
- logit("found name: $1\n");
- $name = "$1";
- $lastcmd = "name";
- $started && die("Cannot have two name directives!");
- $started = 1;
- } else {
- $started || die("First directive needs to be 'name'");
- if ($line =~ /^shortdesc\s+(.*)$/) {
- logit("found shortdesc: $1\n");
- $shortdesc .= "$1 ";
- $lastcmd = "shortdesc";
- next;
- } elsif ($line =~ /^longdesc\s*(.*)$/) {
- logit("found longdesc: $1\n");
- $longdesc .= "$1 ";
- $lastcmd = "longdesc";
- next;
- } elsif ($line =~ /^catalogue\s*(.*)$/) {
- logit("found catalogue: $1\n");
- $catalogue .= "$1 ";
- $lastcmd = "catalogue";
- next;
- } elsif ($line =~ /^runpatterns\s+(.*)$/) {
- logit("found runpattern: $1\n");
- push @runpatterns, "$1";
- $lastcmd = "runpattern";
- next;
- } elsif ($line =~ /^srcpatterns\s+(.*)$/) {
- logit("found srcpattern: $1\n");
- push @srcpatterns, "$1";
- $lastcmd = "srcpattern";
- next;
- } elsif ($line =~ /^docpatterns\s+(.*)$/) {
- logit("found docpattern: $1\n");
- push @docpatterns, "$1";
- $lastcmd = "docpattern";
- next;
- } elsif ($line =~ /^binpatterns\s+(.*)$/) {
- logit("found binpattern: $1\n");
- push @binpatterns, "$1";
- $lastcmd = "binpattern";
- next;
- } elsif ($line =~ /^execute\s+(.*)$/) {
- logit("found execute: $1\n");
- push @executes, "$1";
- $lastcmd = "execute";
- next;
- } elsif ($line =~ /^depend\s+(.*)$/) {
- logit("found depend: $1\n");
- push @depends, "$1";
- $lastcmd = "depend";
- next;
- } else {
- die("Unknown directive ...$line... in $tlsrc, please fix it!");
- }
- }
- }
- logit("Done reading the source file, filling the data structure!\n");
- if ($catalogue ne "") {
- $tls{$name}{'catalogue'} = "$catalogue";
- } else {
- $tls{$name}{'catalogue'} = "$name";
- }
- if ($shortdesc ne "") {
- $tls{$name}{'shortdesc'} = "$shortdesc";
- }
- if ($longdesc ne "") {
- $tls{$name}{'longdesc'} = "$longdesc";
- }
- if ($#srcpatterns >= 0) {
- $tls{$name}{'srcpatterns'} = [ @srcpatterns ];
- }
- if ($#runpatterns >= 0) {
- $tls{$name}{'runpatterns'} = [ @runpatterns ];
- }
- if ($#binpatterns >= 0) {
- $tls{$name}{'binpatterns'} = [ @binpatterns ];
- }
- if ($#docpatterns >= 0) {
- $tls{$name}{'docpatterns'} = [ @docpatterns ];
- }
- if ($#executes >= 0) {
- $tls{$name}{'executes'} = [ @executes ];
- }
- if ($#depends>= 0) {
- $tls{$name}{'depends'} = [ @depends ];
- }
-}
-
-sub initialize_all_files {
- my @lines;
- if (-r "$statusfile") {
- logit("Reading svn status from $statusfile\n");
- open(FOO,"$statusfile") || die("Cannot open statusfile $statusfile");
- @lines = <FOO>;
- close(FOO);
- } else {
- logit("Reading svn status from svn status -v\n");
- @lines = `svn status -v`;
- }
- foreach my $l (@lines) {
- chomp($l);
- next if ($l =~ /^\?/); # ignore files not under version control
- if ($l =~ /^(.)(.)(.)(.)(.)(.)..\s*(\d+)\s+(\d+)\s+\w+\s+(.+)$/) {
- my $lastchanged = $8;
- my $entry = "$9";
- next if -d $entry; # TODO: what to do with links???
- @{$AllFiles{$entry}{'used'}} = ();
- $AllFiles{$entry}{'lastchangedrev'} = $lastchanged;
- my $fn = basename($entry);
- my $dn = dirname($entry);
- add_path_to_tree($DirTree, split("[/\\\\]", $dn));
- push @{$FilesOfDir{$dn}}, $fn;
- } else {
- die("Cannot read svn status output line: $l");
- }
- }
- # now do some magic
- # - create list of top level dirs with a list of full path names of
- # the respective dir attached
- # MISSING
- #print_tree($DirTree);
- walk_tree($DirTree, \&find_alldirs);
-}
-
-sub print_tree {
- my ($node) = @_;
- &walk_tree($node, \&print_node);
-}
-
-sub find_alldirs {
- my ($node, @stackdir) = @_;
- my $tl = $stackdir[-1];
- push @{$DirNames{$tl}}, join("/", @stackdir);
- if (keys(%{$node})) {
- my $pa = join("/", @stackdir);
- push @{$SubdirsOfDir{$pa}}, keys(%{$node});
- }
-}
-
-sub print_node {
- my ($node, @stackdir) = @_;
- my $dp = join("/", @stackdir);
- if ($FilesOfDir{$dp}) {
- foreach my $f (@{$FilesOfDir{$dp}}) {
- print "dp=$dp file=$f\n";
- }
- }
- if (! keys(%{$node})) {
- print join("/", @stackdir) . "\n";
- }
-}
-
-sub walk_tree {
- my (@stack_dir);
- walk_tree1(@_, @stack_dir);
-}
-
-sub walk_tree1 {
- my ($node, $pre_proc, $post_proc, @stack_dir) = @_;
- my $v;
- for my $k (keys(%{$node})) {
- push @stack_dir, $k;
- $v = $node->{$k};
- if ($pre_proc) { &{$pre_proc}($v, @stack_dir) }
- walk_tree1 (\%{$v}, $pre_proc, $post_proc, @stack_dir);
- $v = $node->{$k};
- if ($post_proc) { &{$post_proc}($v, @stack_dir) }
- pop @stack_dir;
- }
-}
-
-sub generate_tlp_data {
- my ($tlp) = @_;
- # predefined patterns if all are missing
- if (! ( (defined($tls{$tlp}{'runpatterns'})) ||
- (defined($tls{$tlp}{'srcpatterns'})) ||
- (defined($tls{$tlp}{'docpatterns'})) ||
- (defined($tls{$tlp}{'binpatterns'})) )) {
- foreach my $md (qw/bibtex context dvips fonts makeindex metafont
- metapost mft omega scripts tex vtex/) {
- push @{$tls{$tlp}{'runpatterns'}}, "t texmf-dist $md $tlp";
- }
- push @{$tls{$tlp}{'docpatterns'}}, "t texmf-dist doc $tlp";
- push @{$tls{$tlp}{'srcpatterns'}}, "t texmf-dist source $tlp";
- }
- $tldb{$tlp}{'name'} = $tls{$tlp};
- if (defined($tls{$tlp}{'shortdesc'})) {
- $tldb{$tlp}{'shortdesc'} = $tls{$tlp}{'shortdesc'};
- }
- if (defined($tls{$tlp}{'longdesc'})) {
- $tldb{$tlp}{'longdesc'} = $tls{$tlp}{'longdesc'};
- }
- if (defined($tls{$tlp}{'catalogue'})) {
- $tldb{$tlp}{'catalogue'} = $tls{$tlp}{'catalogue'};
- }
- if (defined($tls{$tlp}{'executes'})) {
- $tldb{$tlp}{'executes'} = $tls{$tlp}{'executes'};
- }
- if (defined($tls{$tlp}{'depends'})) {
- $tldb{$tlp}{'depends'} = $tls{$tlp}{'depends'};
- }
- $tldb{$tlp}{'runfiles'} = [ ];
- $tldb{$tlp}{'docfiles'} = [ ];
- $tldb{$tlp}{'binfiles'} = [ ];
- $tldb{$tlp}{'srcfiles'} = [ ];
- $tldb{$tlp}{'packageversion'} = 0;
- my $filemax;
- foreach my $p (@{$tls{$tlp}{'runpatterns'}}) {
- my ($pattype,@patwords) = split ' ',$p;
- if ($pattype eq "t") {
- do_leaf_pattern($tlp,'runfiles',@patwords);
- } else {
- do_regexp_pattern($tlp,'runfiles',$p);
- }
- }
- foreach my $p (@{$tls{$tlp}{'srcpatterns'}}) {
- my ($pattype,@patwords) = split ' ',$p;
- if ($pattype eq "t") {
- do_leaf_pattern($tlp,'srcfiles',@patwords);
- } else {
- do_regexp_pattern($tlp,'srcfiles',$p);
- }
- }
- foreach my $p (@{$tls{$tlp}{'docpatterns'}}) {
- my ($pattype,@patwords) = split ' ',$p;
- if ($pattype eq "t") {
- do_leaf_pattern($tlp,'docfiles',@patwords);
- } else {
- do_regexp_pattern($tlp,'docfiles',$p);
- }
- }
- foreach my $p (@{$tls{$tlp}{'binpatterns'}}) {
- my ($pattype,@patwords) = split ' ',$p;
- if ($pattype eq "t") {
- do_leaf_pattern($tlp,'binfiles',@patwords);
- } else {
- do_regexp_pattern($tlp,'binfiles',$p);
- }
- }
-}
-
-sub do_leaf_pattern {
- my ($tlp,$type,@patwords) = @_;
- # the pattern type looks like: dir1 dir2 ... dirn dirtl
- # where a file matches if it looks like
- # dir1/dir2/.../dirn/.*/dirtl/file
- # all but the first define the first dirs, the last the leaf dir
- my $tl = pop @patwords;
- my $filemax;
- if (defined($DirNames{$tl})) {
- foreach my $tld (@{$DirNames{$tl}}) {
- if (index($tld,join("/",@patwords)."/") == 0) {
- my @files = files_under_path($tld);
- foreach my $f (@files) {
- $filemax = $AllFiles{$f}{'lastchangedrev'};
- push_uniq( \@{$AllFiles{$f}{'used'}}, $tlp );
- $tldb{$tlp}{'packageversion'} = $filemax > $tldb{$tlp}{'packageversion'} ? $filemax : $tldb{$tlp}{'packageversion'};
- }
- push_uniq (\@{$tldb{$tlp}{$type}}, @files);
- #$tldb{$tlp}{$type} = [ @{$tldb{$tlp}{$type}}, @files ];
- }
- }
- }
-}
-
-sub files_under_path {
- my ($p) = @_;
- my @files = ();
- foreach my $aa (@{$FilesOfDir{$p}}) {
- push_uniq( \@files, $p . "/" . $aa);
- }
- if (defined($SubdirsOfDir{$p})) {
- foreach my $sd (@{$SubdirsOfDir{$p}}) {
- my @sdf = files_under_path($p . "/" . $sd);
- push_uniq (\@files, @sdf);
- }
- }
- return @files;
-}
-
-sub do_regexp_pattern {
- my ($tlp,$filetype,$p) = @_;
- my $filemax;
- FILELABEL: foreach my $f (keys %AllFiles) {
- $filemax = $AllFiles{$f}{'lastchangedrev'};
- if (pattern_hit($f,$p)) {
- push_uniq( \@{$AllFiles{$f}{'used'}}, $tlp );
- logit("Hit\n");
- $tldb{$tlp}{'packageversion'} = $filemax > $tldb{$tlp}{'packageversion'} ? $filemax : $tldb{$tlp}{'packageversion'};
- $tldb{$tlp}{$filetype} = [ @{$tldb{$tlp}{$filetype}}, $f ];
- next FILELABEL;
- }
- }
-}
-
-sub pattern_hit {
- my ($file, $pattern) = @_;
- my (@dirs) = split /\//, $file;
- $pattern =~ /^(d|f|t)\s+(.*)$/;
- my $pattype = $1;
- my $patdata = $2;
- logit("pattype=...$pattype...patdata=...$patdata...\n");
- if ($pattype eq "d") {
- pop @dirs ;
- my $foo = join "/",@dirs;
- logit("matching [d] >>>$patdata<<< against >>>$foo<<<\n");
- if ($foo =~ /^$patdata$/) {
- return 1;
- }
- } elsif ($pattype eq "f") {
- logit("matching [f] >>>$patdata<<< against >>>$file<<<\n");
- if ($file =~ /^$patdata$/) {
- return 1;
- }
- } else {
- die("Unknown pattern specification: $pattern!");
- }
- return 0;
-}
-
-
-sub write_tlp_file {
- my ($tlp) = @_;
- open(TLP,">tlp/$tlp.tlp") || die("Cannot open tlp/$tlp.tlp for writing: $!");
- print TLP "name $tlp\n";
- #### these two things are disabled for comparison reasons
- #####print TLP "packageversion $tldb{$tlp}{'packageversion'}\n";
- if (defined($tldb{$tlp}{'shortdesc'})) {
- $tlpline = "shortdesc $tldb{$tlp}{'shortdesc'}";
- write TLP;
- }
- if (defined($tldb{$tlp}{'longdesc'})) {
- $tlpline = "longdesc $tldb{$tlp}{'longdesc'}";
- write TLP;
- }
- if (defined($tldb{$tlp}{'catalogue'})) {
- #######print TLP "catalogue $tldb{$tlp}{'catalogue'}\n";
- }
- if (defined($tldb{$tlp}{'depends'})) {
- foreach (@{$tldb{$tlp}{'depends'}}) {
- print TLP "depend $_\n";
- }
- }
- if (defined($tldb{$tlp}{'executes'})) {
- foreach (@{$tldb{$tlp}{'executes'}}) {
- print TLP "execute $_\n";
- }
- }
- my @tmp;
- @tmp = @{$tldb{$tlp}{'docfiles'}};
- if ($#tmp >= 0) {
- print TLP "docfiles\n";
- foreach (sort @tmp) {
- print TLP " $_\n";
- }
- }
- @tmp = @{$tldb{$tlp}{'srcfiles'}};
- if ($#tmp >= 0) {
- print TLP "srcfiles\n";
- foreach (sort @tmp) {
- print TLP " $_\n";
- }
- }
- @tmp = @{$tldb{$tlp}{'binfiles'}};
- if ($#tmp >= 0) {
- print TLP "binfiles\n";
- foreach (sort @tmp) {
- print TLP " $_\n";
- }
- }
- @tmp = @{$tldb{$tlp}{'runfiles'}};
- if ($#tmp >= 0) {
- print TLP "runfiles\n";
- foreach (sort @tmp) {
- print TLP " $_\n";
- }
- }
- close(TLP);
-}
-
-sub logit {
- $opt_debug && print STDERR @_;
-}
-
-
-sub add_path_to_tree {
- my ($node, @path) = @_;
- my ($current);
-
- while (@path) {
- $current = shift @path;
- if ($$node{$current}) {
- $node = $$node{$current};
- } else {
- $$node{$current} = { };
- $node = $$node{$current};
- }
- }
- return $node;
-}
-
-sub member {
- my ($e, @l) = @_;
- my ($f);
- foreach $f (@l) {
- if ($e eq $f) {
- return 1;
- }
- }
- return 0;
-}
-
-sub push_uniq {
- my ($l,@le) = @_;
- my ($e);
- foreach $e (@le) {
- if (! &member($e, @$l)) {
- push @$l, $e;
- }
- }
-}
-
-###### Formats
-format TLP =
-^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$tlpline
- ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
-$tlpline
-.
-
-
-### Local Variables:
-### perl-indent-level: 4
-### tab-width: 4
-### indent-tabs-mode: t
-### End:
-# vim:set tabstop=4: #
diff --git a/new-infra/first-try/use_tldb.pl b/new-infra/first-try/use_tldb.pl
deleted file mode 100644
index 3e6a684d076..00000000000
--- a/new-infra/first-try/use_tldb.pl
+++ /dev/null
@@ -1,247 +0,0 @@
-#!/usr/bin/env perl -w
-#
-# use_tldb.pl
-# use the tldb file which is nothing else then a concatenation of
-# single tlp files
-# Copyright 2007 Norbert Preining
-#
-# This file is licensed under the GNU General Public Licence version 2
-# or any later version
-
-use strict;
-
-my %tldb;
-my $opt_debug = 0;
-
-my $tlpline;
-
-&main(@ARGV);
-
-1;
-
-
-
-
-sub main {
- my ($tldb) = @_;
- read_tldb_file($tldb);
- foreach my $f (keys %tldb) {
- write_tlp_file($f);
- }
-}
-
-sub read_tldb_file {
- my ($tldb) = @_;
- open(TMP,"<$tldb") || die("Cannot open $tldb: $!");
- my @lines = <TMP>;
- close(TMP);
- my $name = "";
- my $shortdesc = "";
- my $longdesc= "";
- my $catalogue = "";
- my (@executes, @depends);
- my (@runfiles, @docfiles, @binfiles, @srcfiles);
- my $started = 0;
- my $lastcmd =
-
- logit("Working on $tldb\n");
- foreach my $line (@lines) {
- logit("line=>>>$line<<<\n");
- $line =~ /^\s*#/ && next; # skip comment lines
- if ($line =~ /^\s*$/) {
- if ($started) {
- # one entry is finished, we have to fill the hash and
- # clean the tmp variables
- # clear the tmp variables
- @runfiles = @docfiles = @srcfiles = @binfiles = ();
- @executes = @depends = ();
- $shortdesc = $longdesc = $catalogue = "";
- $started = 0;
- next;
- } else {
- # ignore empty lines between tlps
- next;
- }
- }
- if ($line =~ /^ /) {
- if ( ($lastcmd eq "longdesc") ||
- ($lastcmd eq "runfiles") ||
- ($lastcmd eq "binfiles") ||
- ($lastcmd eq "docfiles") ||
- ($lastcmd eq "srcfiles") ||
- ($lastcmd eq "execute") ||
- ($lastcmd eq "depend") ) {
- $line =~ s/^ /$lastcmd /;
- } else {
- die("Continuation of $lastcmd not allowed, please fix tlsrc!\n");
- }
- }
- if ($line =~ /^name\s*(\w+)$/) {
- logit("found name: $1\n");
- $name = "$1";
- $lastcmd = "name";
- $started && die("Cannot have two name directives!");
- $started = 1;
- } else {
- $started || die("First directive needs to be 'name'");
- if ($line =~ /^packageversion\s*(.*)$/) {
- logit("found packageversion: $1\n");
- $tldb{$name}{'packageversion'} = "$1";
- $lastcmd = "packageversion";
- next;
- } elsif ($line =~ /^shortdesc\s*(.*)$/) {
- logit("found shortdesc: $1\n");
- $tldb{$name}{'shortdesc'} .= "$1 ";
- $lastcmd = "shortdesc";
- next;
- } elsif ($line =~ /^longdesc\s*(.*)$/) {
- logit("found longdesc: $1\n");
- $tldb{$name}{'longdesc'} .= "$1 ";
- $lastcmd = "longdesc";
- next;
- } elsif ($line =~ /^catalogue\s*(.*)$/) {
- logit("found catalogue: $1\n");
- $tldb{$name}{'catalogue'} = "$1";
- $lastcmd = "catalogue";
- next;
- } elsif ($line =~ /^runfiles\s*(.*)$/) {
- logit("found runfiles: $1\n");
- push @{$tldb{$name}{'runfiles'}}, "$1" unless "$1" eq "";
- $lastcmd = "runfiles";
- next;
- } elsif ($line =~ /^srcfiles\s*(.*)$/) {
- logit("found srcfiles: $1\n");
- push @{$tldb{$name}{'srcfiles'}}, "$1" unless "$1" eq "";
- $lastcmd = "srcfiles";
- next;
- } elsif ($line =~ /^docfiles\s*(.*)$/) {
- logit("found docfiles: $1\n");
- push @{$tldb{$name}{'docfiles'}}, "$1" unless "$1" eq "";
- $lastcmd = "docfiles";
- next;
- } elsif ($line =~ /^binfiles\s*(.*)$/) {
- logit("found binfiles: $1\n");
- push @{$tldb{$name}{'binfiles'}}, "$1" unless "$1" eq "";
- $lastcmd = "binfiles";
- next;
- } elsif ($line =~ /^execute\s*(.*)$/) {
- logit("found execute: $1\n");
- push @{$tldb{$name}{'executes'}}, "$1" unless "$1" eq "";
- $lastcmd = "execute";
- next;
- } elsif ($line =~ /^depend\s*(.*)$/) {
- logit("found depend: $1\n");
- push @{$tldb{$name}{'depends'}}, "$1" unless "$1" eq "";
- $lastcmd = "depend";
- next;
- } else {
- die("Unknown directive ...$line... in $tldb, please fix it!");
- }
- }
- }
- logit("Done reading the tldb file, filling the data structure!\n");
- if ($catalogue ne "") {
- $tldb{$name}{'catalogue'} = "$catalogue";
- } else {
- $tldb{$name}{'catalogue'} = "$name";
- }
- if ($shortdesc ne "") {
- $tldb{$name}{'shortdesc'} = "$shortdesc";
- }
- if ($longdesc ne "") {
- $tldb{$name}{'longdesc'} = "$longdesc";
- }
- if ($#srcfiles >= 0) {
- $tldb{$name}{'srcfiles'} = [ @srcfiles ];
- }
- if ($#runfiles >= 0) {
- $tldb{$name}{'runfiles'} = [ @runfiles ];
- }
- if ($#binfiles >= 0) {
- $tldb{$name}{'binfiles'} = [ @binfiles ];
- }
- if ($#docfiles >= 0) {
- $tldb{$name}{'docfiles'} = [ @docfiles ];
- }
- if ($#executes >= 0) {
- $tldb{$name}{'executes'} = [ @executes ];
- }
- if ($#depends>= 0) {
- $tldb{$name}{'depends'} = [ @depends ];
- }
-}
-
-sub write_tlp_file {
- my ($tlp) = @_;
- open(TLP,">tlp/$tlp.tlp") || die("Cannot open tlp/$tlp.tlp for writing: $!");
- print TLP "name $tlp\n";
- print TLP "packageversion $tldb{$tlp}{'packageversion'}\n";
- if (defined($tldb{$tlp}{'shortdesc'})) {
- $tlpline = "shortdesc $tldb{$tlp}{'shortdesc'}";
- write TLP;
- }
- if (defined($tldb{$tlp}{'longdesc'})) {
- $tlpline = "longdesc $tldb{$tlp}{'longdesc'}";
- write TLP;
- }
- if (defined($tldb{$tlp}{'catalogue'})) {
- print TLP "catalogue $tldb{$tlp}{'catalogue'}\n";
- }
- my @tmp;
- if (defined($tldb{$tlp}{'executes'})) {
- foreach (@{$tldb{$tlp}{'executes'}}) {
- print TLP "execute $_\n";
- }
- }
- if (defined($tldb{$tlp}{'depends'})) {
- foreach (@{$tldb{$tlp}{'depends'}}) {
- print TLP "depend $_\n";
- }
- }
- if (defined($tldb{$tlp}{'docfiles'})) {
- print TLP "docfiles\n";
- foreach (@{$tldb{$tlp}{'docfiles'}}) {
- print TLP " $_\n";
- }
- }
- if (defined($tldb{$tlp}{'srcfiles'})) {
- print TLP "srcfiles\n";
- foreach (@{$tldb{$tlp}{'srcfiles'}}) {
- print TLP " $_\n";
- }
- }
- if (defined($tldb{$tlp}{'binfiles'})) {
- print TLP "binfiles\n";
- foreach (@{$tldb{$tlp}{'binfiles'}}) {
- print TLP " $_\n";
- }
- }
- if (defined($tldb{$tlp}{'runfiles'})) {
- print TLP "runfiles\n";
- foreach (@{$tldb{$tlp}{'runfiles'}}) {
- print TLP " $_\n";
- }
- }
- close(TLP);
-}
-
-sub logit {
- $opt_debug && print STDERR @_;
-}
-
-
-###### Formats
-format TLP =
-^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$tlpline
- ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
-$tlpline
-.
-
-
-### Local Variables:
-### perl-indent-level: 4
-### tab-width: 4
-### indent-tabs-mode: t
-### End:
-# vim:set tabstop=4: #