VMSify uupacktool.pl and run it during VMS build.

p4raw-id: //depot/perl@31247

diff --git a/uupacktool.pl b/uupacktool.pl
index 20554d7..bf947bb 100644 (file)
--- a/uupacktool.pl
+++ b/uupacktool.pl
@@ -4,6 +4,14 @@ use strict;
 use warnings;
 use Getopt::Long;
 use File::Basename;
+use File::Spec;
+
+BEGIN {
+    if ($^O eq 'VMS') {
+        require VMS::Filespec;
+        import VMS::Filespec;
+    }
+}
 
 Getopt::Long::Configure('no_ignore_case');
 
@@ -13,6 +21,7 @@ sub handle_file {
     my $opts    = shift;
     my $file    = shift or die "Need file\n". usage();
     my $outfile = shift || '';
+    $file = vms_check_name($file) if $^O eq 'VMS';
     my $mode    = (stat($file))[2] & 07777;
 
     open my $fh, "<", $file
@@ -25,7 +34,7 @@ sub handle_file {
     if( $opts->{u} ) {
         if( !$outfile ) {
             $outfile = $file;
-            $outfile =~ s/\.packed//;
+            $outfile =~ s/\.packed\z//;
         }
         my ($head, $body) = split /__UU__\n/, $str;
         die "Can't unpack malformed data in '$file'\n"
@@ -60,6 +69,7 @@ EOFBLURB
     if( $opts->{'s'} ) {
         print STDOUT $outstr;
     } else {
+        $outfile = VMS::Filespec::vmsify($outfile) if $^O eq 'VMS';
         print "Writing $file into $outfile\n" if $opts->{'v'};
         open my $outfh, ">", $outfile
             or do { warn "Could not open $outfile for writing: $!"; exit 0 };
@@ -99,7 +109,8 @@ sub bulk_process {
         $count++;
 
         my $out = $file;
-        $out =~ s/\.packed//;
+        $out =~ s/\.packed\z//;
+        $out = vms_check_name($out) if $^O eq 'VMS';
 
         ### unpack
         if( !$opts->{'c'} ) {
@@ -158,6 +169,33 @@ Options:
 ];
 }
 
+sub vms_check_name {
+
+# Packed files tend to have multiple dots, which the CRTL may or may not handle
+# properly, so convert to native format.  And depending on how the archive was
+# unpacked, foo.bar.baz may be foo_bar.baz or foo.bar_baz.  N.B. This checks for
+# existence, so is not suitable as-is to generate ODS-2-safe names in preparation
+# for file creation.
+
+    my $file = shift;
+
+    $file = VMS::Filespec::vmsify($file);
+    return $file if -e $file;
+
+    my ($vol,$dirs,$base) = File::Spec->splitpath($file);
+    my $tmp = $base;
+    1 while $tmp =~ s/([^\.]+)\.(.+\..+)/$1_$2/;
+    my $try = File::Spec->catpath($vol, $dirs, $tmp);
+    return $try if -e $try;
+
+    $tmp = $base;
+    1 while $tmp =~ s/(.+\..+)\.([^\.]+)/$1_$2/;
+    $try = File::Spec->catpath($vol, $dirs, $tmp);
+    return $try if -e $try;
+
+    return $file;
+}
+
 my $opts = {};
 GetOptions($opts,'u','p','c', 'D', 'm:s','s','d=s','v','h');
 

diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template
index 8894c13..2b66a74 100644 (file)
--- a/vms/descrip_mms.template
+++ b/vms/descrip_mms.template
@@ -1399,10 +1399,16 @@ perly$(O) : perly.c, perly.h, $(h)
 [.t.lib]vms_stdio.t : [.vms.ext.Stdio]test.pl
        Copy/NoConfirm/Log $(MMS$SOURCE) $(MMS$TARGET)
 
+unpack_files :
+       - $(MINIPERL) uupacktool.pl -u -m
+
+cleanup_unpacked_files :
+       - IF F$SEARCH("$(MINIPERL_EXE)") .NES. "" THEN $(MINIPERL) uupacktool.pl -c
+
 check : test
        @ Continue
 
-test : all [.t.lib]vmsfspec.t [.t.lib]vms_dclsym.t [.t.lib]vms_stdio.t
+test : all [.t.lib]vmsfspec.t [.t.lib]vms_dclsym.t [.t.lib]vms_stdio.t unpack_files
        @ PERL_TEST_DRIVER == "TEST."
        - @[.vms]test.com "$(E)" "$(__DEBUG__)"
        @ $(MINIPERL) -e "print ""Ran tests"";" > [.t]rantests.
@@ -1785,7 +1791,7 @@ tidy : cleanlis
        - If F$Search("[.x2p]*.com;-1").nes."" Then Purge/NoConfirm/Log [.x2p]*.com
        - If F$Search("[.lib.pods]*.com;-1").nes."" Then Purge/NoConfirm/Log [.lib.pods]*.com
 
-clean : tidy cleantest
+clean : tidy cleantest cleanup_unpacked_files
        - @make_ext "$(MINIPERL_EXE)" "$(MMS)" clean
        - If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_*.Opt
        - If F$Search("[...]*$(O);*") .nes."" Then Delete/NoConfirm/Log [...]*$(O);*