texlive[44871] Master/tlpkg/TeXLive/TLUtils.pm: rework mkdirhier to

commits+preining at tug.org commits+preining at tug.org
Sun Jul 23 15:31:00 CEST 2017


Revision: 44871
          http://tug.org/svn/texlive?view=revision&revision=44871
Author:   preining
Date:     2017-07-23 15:31:00 +0200 (Sun, 23 Jul 2017)
Log Message:
-----------
rework mkdirhier to distinguish on context what to return

in void context: die on error, otherwise return
	(old behaviour)
in scalar context: return 1/0 on success/error
in list context: return (1) or (0, errormessage)

Modified Paths:
--------------
    trunk/Master/tlpkg/TeXLive/TLUtils.pm

Modified: trunk/Master/tlpkg/TeXLive/TLUtils.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLUtils.pm	2017-07-23 00:21:08 UTC (rev 44870)
+++ trunk/Master/tlpkg/TeXLive/TLUtils.pm	2017-07-23 13:31:00 UTC (rev 44871)
@@ -803,32 +803,61 @@
 
 =item C<mkdirhier($path, [$mode])>
 
-The function C<mkdirhier> does the same as the UNIX command C<mkdir -p>,
-and dies on failure.  The optional parameter sets the permission bits.
+The function C<mkdirhier> does the same as the UNIX command C<mkdir -p>.
+It behaves differently depending on the context in which it is called:
+If called in void context it will die on failure. If called in
+scalar context, it will return 1/0 on sucess/failure. If called in
+list context, it returns 1/0 as first element and an error message
+as second, if an error occurred (and no second element in case of
+success). The optional parameter sets the permission bits.
 
 =cut
 
 sub mkdirhier {
   my ($tree,$mode) = @_;
+  my $ret = 1;
+  my $reterror;
 
-  return if (-d "$tree");
-  my $subdir = "";
-  # win32 is special as usual: we need to separate //servername/ part
-  # from the UNC path, since (! -d //servername/) tests true
-  $subdir = $& if ( win32() && ($tree =~ s!^//[^/]+/!!) );
+  if (-d "$tree") {
+    $ret = 1;
+  } else {
+    my $subdir = "";
+    # win32 is special as usual: we need to separate //servername/ part
+    # from the UNC path, since (! -d //servername/) tests true
+    $subdir = $& if ( win32() && ($tree =~ s!^//[^/]+/!!) );
 
-  @dirs = split (/\//, $tree);
-  for my $dir (@dirs) {
-    $subdir .= "$dir/";
-    if (! -d $subdir) {
-      if (defined $mode) {
-        mkdir ($subdir, $mode)
-        || die "$0: mkdir($subdir,$mode) failed, goodbye: $!\n";
-      } else {
-        mkdir ($subdir) || die "$0: mkdir($subdir) failed, goodbye: $!\n";
+    @dirs = split (/\//, $tree);
+    for my $dir (@dirs) {
+      $subdir .= "$dir/";
+      if (! -d $subdir) {
+        if (defined $mode) {
+          if (! mkdir ($subdir, $mode)) {
+            $ret = 0;
+            $reterror = "mkdir($subdir,$mode) failed, goodbye: $!";
+            last;
+          }
+        } else {
+          if (! mkdir ($subdir)) {
+            $ret = 0;
+            $reterror = "mkdir($subdir) failed, goodbye: $!";
+            last;
+          }
+        }
       }
     }
   }
+  if ($ret) {
+    return(1);  # nothing bad here returning 1 in any case, will
+                # be ignored in void context, and give 1 in list context
+  } else {
+    if (wantarray) {
+      return(0, $reterror);
+    } elsif (defined wantarray) {
+      return(0);
+    } else {
+      die "$0: $reterror\n";
+    }
+  }
 }
 
 



More information about the tex-live-commits mailing list