From 62012ddf76cfb1d21e44055d61bfc80d81c318ac Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Sun, 23 Jul 2017 13:31:00 +0000 Subject: 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) git-svn-id: svn://tug.org/texlive/trunk@44871 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/TeXLive/TLUtils.pm | 63 ++++++++++++++++++++++++++++++----------- 1 file changed, 46 insertions(+), 17 deletions(-) (limited to 'Master/tlpkg/TeXLive/TLUtils.pm') diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 7963546835c..d721baced01 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -803,32 +803,61 @@ sub dir_writable { =item C -The function C does the same as the UNIX command C, -and dies on failure. The optional parameter sets the permission bits. +The function C does the same as the UNIX command C. +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!^//[^/]+/!!) ); - - @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"; + 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) { + 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"; + } + } } -- cgit v1.2.3