look in hierarchy if package name is not readable

as is.


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

1 files changed, 17 insertions, 7 deletions

diff --git a/Master/tlpkg/TeXLive/TLPSRC.pm b/Master/tlpkg/TeXLive/TLPSRC.pm
index 969463118c6..6ccc0a8e100 100644
--- a/Master/tlpkg/TeXLive/TLPSRC.pm
+++ b/Master/tlpkg/TeXLive/TLPSRC.pm
@@ -38,6 +38,16 @@ sub from_file {
   die("Need exactly one filename for initialization!") if @_ != 1;
   my $srcfile = $_[0];
   
+  if (! -r "$srcfile") {
+    # if the argument is not readable as is, try looking for it in the
+    # hierarchy where we are.  The %INC hash records where packages were
+    # found, so we use that to locate ourselves.
+    (my $trydir = $INC{"TeXLive/TLPSRC.pm"}) =~ s,/[^/]*$,,;
+    my $tryfile = "$trydir/../tlpsrc/$srcfile.tlpsrc";
+    #warn "$trydir\n$tryfile\n";
+    $srcfile = $tryfile if -r $tryfile;
+  }
+  
   open(TMP, "<$srcfile") || die("failed to open tlpsrc '$srcfile': $!");
   my @lines = <TMP>;
   close(TMP);
@@ -616,7 +626,6 @@ The following functions can be called for an C<TLPSRC> object:
 =over 
 
 =item C<new>
-
 (constructor) returns a new C<TLPSRC> object. The arguments to the C<new>
 constructor can be in the usual hash representation for the different keys
 above:
@@ -624,14 +633,16 @@ above:
 	$tlpsrc = TLPSRC->new ( name => "foobar", shortdesc => "The foobar package" );
 
 =item C<from_file("filename")>
+reads a C<tlpsrc> file from disk.  C<filename> can either be a full path
+(if it's readable, it's used), or just a package identifier such as
+C<plain>.  In the latter case, the directory searched is the C<tlpsrc>
+sibling of the C<TeXLive> package directory where C<TLPSRC.pm> was found.
 
-reads a C<tlpsrc> file.
-
-	$tlpsrc = new TLPSRC;
-	$tlpsrc->from_file("path/to/the/tlpsrc/file");
+	$tlpsrc = new TeXLive::TLPSRC;
+	$tlpsrc->from_file("/path/to/the/tlpsrc/somepkg.tlpsrc");
+	$tlpsrc->from_file("somepkg");
 
 =item C<writeout>
-
 writes the textual representation of a C<TLPSRC> object to stdout, or the
 filehandle if given:
 
@@ -639,7 +650,6 @@ filehandle if given:
 	$tlpsrc->writeout(\*FILEHANDLE);
 
 =item C<make_tlpobj($tltree)>
-
 creates a C<TLPOBJ> object from a C<TLPSRC> object and a C<TLTREE> object.
 This function does the necessary work to expand the manual data and
 enrich it which the actual content from <$tltree> to a C<TLPOBJ> object.