perl modules: support file:/ in URLs

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

3 files changed, 16 insertions, 4 deletions

diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm
index 6f3b70db578..71be3ea3dee 100644
--- a/Master/tlpkg/TeXLive/TLMedia.pm
+++ b/Master/tlpkg/TeXLive/TLMedia.pm
@@ -25,7 +25,7 @@ sub new
   # no default by itself ...
   # $location = "$TeXLiveURL" unless (defined($location));
   # do media autodetection
-  if ($location =~ m,http://|ftp://,) {
+  if ($location =~ m,http://|ftp://|file://*,) {
     $media = 'NET';
   } else {
     if (-d "$location/texmf/web2c") {
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 7296e9dc33d..55000384f64 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -75,6 +75,8 @@ argument C<root> is given it will be initialized from the respective
 location within $path. If
 C<$path> begins with C<http://> or C<ftp://>, the program C<wget>
 is used to download the file.
+The C<$path> can start with C<file:/> in which case it is treated as
+a file on the filesystem in the usual way.
 
 =cut
 
@@ -175,7 +177,7 @@ sub remove_package {
 The C<from_file> function initializes the C<TLPDB> in case the
 root was not given at generation time.  If C<$filename> begins
 with C<http://> or C<ftp://>, the program C<wget> is used to download
-the file.
+the file. The prefix C<file:/> is treated the expected way.
 
 =cut
 
@@ -194,7 +196,7 @@ sub from_file {
     $self->root($root_from_path);
   }
   my $retfh;
-  if ($path =~ /^(http|ftp):\/\//) {
+  if ($path =~ m;^((http|ftp)://|file:\/\/*);) {
     debug("TLPDB.pm: trying to initialize from $path\n");
     # if we have lzmadec available we try the lzma file
     if (defined($::progs{'lzmadec'})) {
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index aad5328726a..3271e7b9ca6 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -693,6 +693,8 @@ C<copy> invokes C<mkdirhier> if target directories do not exist.
 Files have mode C<0777>-I<umask> if they are executable and
 C<0666>-I<umask> otherwise.
 
+Note that C<copy> will work with file:/ prefixes, too.
+
 =cut
 
 sub copy {
@@ -709,6 +711,7 @@ sub copy {
 
   mkdirhier ("$destdir") unless -d "$destdir";
 
+  $infile =~ s!^file://*!/!i;
   $filename=basename "$infile";
   $outfile="$destdir/$filename";
 
@@ -859,7 +862,8 @@ If C<$what> starts with C<http://> or C<ftp://> then C<$what> is
 downloaded from the net and piped through c<lzmadec> and C<tar>.
 
 If $what ends with C<.tar.lzma> (but does not start with C<http://> or
-C<ftp://>) it is assumed to be a readable file on the system and is
+C<ftp://>, but possibly with C<file:/>) it is assumed to be a readable 
+file on the system and is
 piped through C<lzmadec> and C<tar> in the very same way.
 
 In both of the last cases currently the list C<$@filelistref> currently
@@ -1058,6 +1062,12 @@ sub download_file {
     $wget = "wget";
   }
   my $url;
+  if ($relpath =~ m;^file://*(.*)$;) {
+    # $dest is a file name, we have to get the respective dirname
+    my $par = dirname($dest);
+    copy("/$1", $par);
+    return 1;
+  }
   if ($relpath =~ /^(http|ftp):\/\//) {
     $url = $relpath;
   } else {