first cut at remove, add form feeds,

function-starting { in column 1.


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

1 files changed, 55 insertions, 22 deletions

diff --git a/Master/tlpkg/TeXLive/TLPSRC.pm b/Master/tlpkg/TeXLive/TLPSRC.pm
index 6ccc0a8e100..c943b02dd88 100644
--- a/Master/tlpkg/TeXLive/TLPSRC.pm
+++ b/Master/tlpkg/TeXLive/TLPSRC.pm
@@ -13,7 +13,8 @@ use TeXLive::TLTREE;
 
 my $_tmp;
 
-sub new { 
+sub new
+{
   my $class = shift;
   my %params = @_;
   my $self = {
@@ -33,7 +34,9 @@ sub new {
   return $self;
 }
 
-sub from_file {
+
+sub from_file
+{
   my $self = shift;
   die("Need exactly one filename for initialization!") if @_ != 1;
   my $srcfile = $_[0];
@@ -114,20 +117,36 @@ sub from_file {
       }
     }
   }
-  $self->name("$name");
-  $self->category("$category");
-  $self->catalogue($catalogue) if ("$catalogue" ne "");
-  $self->shortdesc("$shortdesc") if ($shortdesc ne "");
-  $self->longdesc("$longdesc") if ($longdesc ne "");
-  $self->srcpatterns(@srcpatterns) if ($#srcpatterns >= 0);
-  $self->runpatterns(@runpatterns) if ($#runpatterns >= 0);
-  $self->binpatterns(@binpatterns) if ($#binpatterns >= 0);
-  $self->docpatterns(@docpatterns) if ($#docpatterns >= 0);
-  $self->executes(@executes) if ($#executes >= 0);
-  $self->depends(@depends) if ($#depends >= 0);
+  $self->_srcfile($srcfile);
+  $self->name($name);
+  $self->category($category);
+  $self->catalogue($catalogue) if $catalogue;
+  $self->shortdesc($shortdesc) if $shortdesc;
+  $self->longdesc($longdesc) if $longdesc;
+  $self->srcpatterns(@srcpatterns) if @srcpatterns;
+  $self->runpatterns(@runpatterns) if @runpatterns;
+  $self->binpatterns(@binpatterns) if @binpatterns;
+  $self->docpatterns(@docpatterns) if @docpatterns;
+  $self->executes(@executes) if @executes;
+  $self->depends(@depends) if @depends;
 }
 
-sub writeout {
+
+sub remove
+{
+  my $self = shift;
+  my $srcfile = $self->{"_srcfile"};
+  die "no _srcfile for tlpsrc object" unless $srcfile;
+  if (unlink ($srcfile) == 0) {
+    print "unlink($srcfile) ok.\n";
+  } else {
+    warn "unlink($srcfile) failed: $!";
+  }
+}
+
+
+sub writeout
+{
   my $self = shift;
   my $fd = (@_ ? $_[0] : STDOUT);
   format_name $fd "multilineformat";
@@ -171,11 +190,11 @@ sub writeout {
   }
 }
 
-#
+
 # the hard work, generate a TLP file
 #
-
-sub make_tlpobj {
+sub make_tlpobj
+{
   my ($self,$tltree) = @_;
   my $tlp = TeXLive::TLPOBJ->new;
   $tlp->name($self->name);
@@ -325,9 +344,14 @@ sub _do_normal_pattern {
   }
 }
 
-#
+
 # member access functions
 #
+sub _srcfile {
+  my $self = shift;
+  if (@_) { $self->{'_srcfile'} = shift }
+  return $self->{'-srcfile'};
+}
 sub name {
   my $self = shift;
   if (@_) { $self->{'name'} = shift }
@@ -393,6 +417,7 @@ $_tmp
 .
 
 __END__
+
 
 =head1 NAME
 
@@ -403,11 +428,12 @@ TeXLive::TLPSRC - TeX Live Package Source access module
 	use TeXLive::TLPSRC;
 
 	my $tlpsrc = TeXLive::TLPSRC->new( name => "foobar" );
-	$tlpsrc->from_file("package.tlpsrc");
+	$tlpsrc->from_file("/some/tlpsrc/package.tlpsrc");
+	$tlpsrc->from_file("package");
+	$tlpsrc->remove;
 	$tlpsrc->writeout;
 	$tlpsrc->writeout(\*FILEHANDLE);
 
-
 =head1 DESCRIPTION
 
 The L<TeXLive::TLPSRC> module provide access to TeX Live Package Source
@@ -416,8 +442,8 @@ derived from the files in the TeX Live subversion repository.
 
 =head1 FILE SPECIFICATION
 
-A L<tlpsrc> file has to consist of non-empty lines (initial and final
-empty lines are ignored) of the form
+A L<tlpsrc> file has to consist of non-empty lines (except that initial
+and final empty lines are ignored) of the form
 
 I<key value>
 
@@ -619,6 +645,9 @@ Arguments and return values for C<name>, C<category>, C<shortdesc>,
 C<longdesc>, C<catalogue> are single scalars. Arguments and return values
 for C<depends>, C<executes>, and the various C<patterns> are lists.
 
+In addition, the C<_srcfile> member refers to the filename for this
+C<TLPSRC> object, if set (normally by C<from_file>).
+
 =head1 OTHER FUNCTIONS
 
 The following functions can be called for an C<TLPSRC> object:
@@ -642,6 +671,10 @@ sibling of the C<TeXLive> package directory where C<TLPSRC.pm> was found.
 	$tlpsrc->from_file("/path/to/the/tlpsrc/somepkg.tlpsrc");
 	$tlpsrc->from_file("somepkg");
 
+=item C<remove>
+removes the file for this C<TLPSRC> object from disk.  It does not
+update any database (or anything else).
+
 =item C<writeout>
 writes the textual representation of a C<TLPSRC> object to stdout, or the
 filehandle if given: