Hello,
I've started to play with portable scripts, and am making heavy use of
File::Spec to help me. I just did a small test on VMS with the
following script, and found the result to be a bit disturbing:
------------------------------- FOO.PL -------------------------------
use File::Spec;
foreach my $f ("FOO:[BAR.COOKIE.BANANA]HAHA.TXT",
"[BAR.COOKIE.BANANA]HAHA.TXT",
"FOO:[-.BAR.COOKIE.BANANA]HAHA.TXT",
"[-.BAR.COOKIE.BANANA]HAHA.TXT",
"FOO:[--.BAR.COOKIE.BANANA]HAHA.TXT",
"[--.BAR.COOKIE.BANANA]HAHA.TXT",
"FOO:[BAR.-.COOKIE.BANANA]HAHA.TXT",
"[BAR.-.COOKIE.BANANA]HAHA.TXT",
"FOO:[BAR.--.COOKIE.BANANA]HAHA.TXT",
"[BAR.--.COOKIE.BANANA]HAHA.TXT",
"FOO:[BAR.COOKIE.-.BANANA]HAHA.TXT",
"[BAR.COOKIE.-.BANANA]HAHA.TXT",
"FOO:[BAR.COOKIE.--.BANANA]HAHA.TXT",
"[BAR.COOKIE.--.BANANA]HAHA.TXT",
"FOO:[BAR.COOKIE.BANANA.-]HAHA.TXT",
"[BAR.COOKIE.BANANA.-]HAHA.TXT",
"FOO:[BAR.COOKIE.BANANA.--]HAHA.TXT",
"[BAR.COOKIE.BANANA.--]HAHA.TXT",
"FOO:[BAR.000000.][000000.][BANANA.--]HAHA.TXT",
"[BAR.000000.][000000.][BANANA.--]HAHA.TXT",
"FOO:[BAR.000000.][000000.][BANANA.--.000000]HAHA.TXT",
"[BAR.000000.][000000.][BANANA.--.000000]HAHA.TXT",
"FOO:[BAR.000000.][000000.][-.-.000000]HAHA.TXT",
"[BAR.000000.][000000.][--.-.000000]HAHA.TXT",
) {
print "-" x 70,"\n";
print "(",join(", ",File::Spec->splitpath($f)),")\n";
print File::Spec->canonpath($f),"\n";
}
print "-" x 70,"\n";
----------------------------------------------------------------------
$ perl foo.pl
----------------------------------------------------------------------
FOO:[BAR.COOKIE.BANANA]HAHA.TXT
==>FOO:[BAR.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
[BAR.COOKIE.BANANA]HAHA.TXT
==>[BAR.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
FOO:[-.BAR.COOKIE.BANANA]HAHA.TXT
==>FOO:[-.BAR.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
[-.BAR.COOKIE.BANANA]HAHA.TXT
==>[-.BAR.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
FOO:[--.BAR.COOKIE.BANANA]HAHA.TXT
==>FOO:[--.BAR.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
[--.BAR.COOKIE.BANANA]HAHA.TXT
==>[--.BAR.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.-.COOKIE.BANANA]HAHA.TXT
==>FOO:[COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
[BAR.-.COOKIE.BANANA]HAHA.TXT
==>[COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.--.COOKIE.BANANA]HAHA.TXT
==>FOO:[-.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
[BAR.--.COOKIE.BANANA]HAHA.TXT
==>[-.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.COOKIE.-.BANANA]HAHA.TXT
==>FOO:[BAR.BANANA]HAHA.TXT
----------------------------------------------------------------------
[BAR.COOKIE.-.BANANA]HAHA.TXT
==>[BAR.BANANA]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.COOKIE.--.BANANA]HAHA.TXT
==>FOO:[BAR.-.BANANA]HAHA.TXT
----------------------------------------------------------------------
[BAR.COOKIE.--.BANANA]HAHA.TXT
==>[BAR.-.BANANA]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.COOKIE.BANANA.-]HAHA.TXT
==>FOO:[BAR.COOKIE]HAHA.TXT
----------------------------------------------------------------------
[BAR.COOKIE.BANANA.-]HAHA.TXT
==>[BAR.COOKIE]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.COOKIE.BANANA.--]HAHA.TXT
==>FOO:[BAR.COOKIE.-]HAHA.TXT
----------------------------------------------------------------------
[BAR.COOKIE.BANANA.--]HAHA.TXT
==>[BAR.COOKIE.-]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.000000.][000000.][BANANA.--]HAHA.TXT
==>FOO:[BAR.000000.-]HAHA.TXT
----------------------------------------------------------------------
[BAR.000000.][000000.][BANANA.--]HAHA.TXT
==>[BAR.000000.-]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.000000.][000000.][BANANA.000000]HAHA.TXT
==>FOO:[BAR.000000.BANANA]HAHA.TXT
----------------------------------------------------------------------
[BAR.000000.][000000.][BANANA.000000]HAHA.TXT
==>[BAR.000000.BANANA]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.000000.][000000.][BANANA.--.000000]HAHA.TXT
==>FOO:[BAR.000000.-.000000]HAHA.TXT
----------------------------------------------------------------------
[BAR.000000.][000000.][BANANA.--.000000]HAHA.TXT
==>[BAR.000000.-.000000]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.000000.][000000.][-.-.000000]HAHA.TXT
==>FOO:[BAR.-.000000]HAHA.TXT
----------------------------------------------------------------------
[BAR.000000.][000000.][--.-.000000]HAHA.TXT
==>[BAR.--.000000]HAHA.TXT
----------------------------------------------------------------------
----------------------------------------------------------------------
As can be seen, there are things that don't really happen, like
[BAR.COOKIE.BANANA.--] only got changed to [BAR.COOKIE.-], not [BAR]
(basically, the current VMS.pm doesn't handle multiple dashes very
well). Also, I noticed that things like FOO.000000] would be
converted to FOO], which I think is an absolute no-no (you CAN have a
000000.DIR), only [000000.][, .][000000] and [000000. should be
reduced. While I'm at it, < and > should be changed to [ and ].
My patch (attached as VMD.pm.diff, produced with diff -u) makes the
above errors go away. I've based the things I do on a decade of
experience with VMS, having hacked similar things a long time ago in
GNU emacs and so on.
The same script with my version of VMS.pm results in the following:
----------------------------------------------------------------------
$ perl "-IUSER:[LEVITTE.WRK.PERL-HACKS]" foo.pl
----------------------------------------------------------------------
FOO:[BAR.COOKIE.BANANA]HAHA.TXT
==>FOO:[BAR.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
[BAR.COOKIE.BANANA]HAHA.TXT
==>[BAR.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
FOO:[-.BAR.COOKIE.BANANA]HAHA.TXT
==>FOO:[-.BAR.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
[-.BAR.COOKIE.BANANA]HAHA.TXT
==>[-.BAR.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
FOO:[--.BAR.COOKIE.BANANA]HAHA.TXT
==>FOO:[--.BAR.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
[--.BAR.COOKIE.BANANA]HAHA.TXT
==>[--.BAR.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.-.COOKIE.BANANA]HAHA.TXT
==>FOO:[COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
[BAR.-.COOKIE.BANANA]HAHA.TXT
==>[COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.--.COOKIE.BANANA]HAHA.TXT
==>FOO:[-.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
[BAR.--.COOKIE.BANANA]HAHA.TXT
==>[-.COOKIE.BANANA]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.COOKIE.-.BANANA]HAHA.TXT
==>FOO:[BAR.BANANA]HAHA.TXT
----------------------------------------------------------------------
[BAR.COOKIE.-.BANANA]HAHA.TXT
==>[BAR.BANANA]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.COOKIE.--.BANANA]HAHA.TXT
==>FOO:[BANANA]HAHA.TXT
----------------------------------------------------------------------
[BAR.COOKIE.--.BANANA]HAHA.TXT
==>[BANANA]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.COOKIE.BANANA.-]HAHA.TXT
==>FOO:[BAR.COOKIE]HAHA.TXT
----------------------------------------------------------------------
[BAR.COOKIE.BANANA.-]HAHA.TXT
==>[BAR.COOKIE]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.COOKIE.BANANA.--]HAHA.TXT
==>FOO:[BAR]HAHA.TXT
----------------------------------------------------------------------
[BAR.COOKIE.BANANA.--]HAHA.TXT
==>[BAR]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.000000.][000000.][BANANA.--]HAHA.TXT
==>FOO:[BAR]HAHA.TXT
----------------------------------------------------------------------
[BAR.000000.][000000.][BANANA.--]HAHA.TXT
==>[BAR]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.000000.][000000.][BANANA.000000]HAHA.TXT
==>FOO:[BAR.000000.BANANA.000000]HAHA.TXT
----------------------------------------------------------------------
[BAR.000000.][000000.][BANANA.000000]HAHA.TXT
==>[BAR.000000.BANANA.000000]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.000000.][000000.][BANANA.--.000000]HAHA.TXT
==>FOO:[BAR.000000]HAHA.TXT
----------------------------------------------------------------------
[BAR.000000.][000000.][BANANA.--.000000]HAHA.TXT
==>[BAR.000000]HAHA.TXT
----------------------------------------------------------------------
FOO:[BAR.000000.][000000.][-.-.000000]HAHA.TXT
==>FOO:[000000]HAHA.TXT
----------------------------------------------------------------------
[BAR.000000.][000000.][--.-.000000]HAHA.TXT
==>[-.000000]HAHA.TXT
----------------------------------------------------------------------
----------------------------------------------------------------------
Cheers,
Richard
-----
Please consider sponsoring my work on free software.
See http://www.free.lp.se/sponsoring.html for details.
--
Richard Levitte | http://richard.levitte.org/ | Tunnlandsv. 52
Levitte Programming | http://www.lp.se/ | S-168 36 Bromma
T: +46-708-26 53 44 | | SWEDEN
"Price, performance, quality... choose the two you like"
--- File/Spec/VMS.pm 2004-07-22 22:52:58.000000000 +0200
+++ VMS.pm 2004-07-23 00:13:39.000000000 +0200
@@ -155,16 +155,34 @@
else { return vmsify($path); }
}
else {
- $path =~ s/([\[<])000000\./$1/g; # [000000.foo ==> [foo
- $path =~ s/([^-]+)\.(\]\[|><)?000000([\]\>])/$1$3/g; # foo.000000] ==> foo]
- $path =~ s-\]\[--g; $path =~ s/><//g; # foo.][bar ==> foo.bar
- 1 while $path =~ s{([\[<-])\.-}{$1-}; # [.-.- ==> [--
- $path =~ s/\.[^\[<\.]+\.-([\]\>])/$1/; # bar.foo.-] ==> bar]
- $path =~ s/([\[<])(-+)/$1 . "\cx" x length($2)/e; # encode leading '-'s
- $path =~ s/([\[<\.])([^\[<\.\cx]+)\.-\.?/$1/g; # bar.-.foo ==> foo
- $path =~ s/([\[<])(\cx+)/$1 . '-' x length($2)/e; # then decode
- $path =~ s/^[\[<\]>]{2}//; # []foo ==> foo
- return $path;
+ $path =~ tr/<>/[]/; # < and > ==> [ and ]
+ $path =~ s/\]\[\./\.\]\[/g; # ][. ==> .][
+ $path =~ s/\[000000\.\]\[/\[/g; # [000000.][ ==> [
+ $path =~ s/\[000000\./\[/g; # [000000. ==> [
+ $path =~ s/\.\]\[000000\]/\]/g; # .][000000] ==> ]
+ $path =~ s/\.\]\[/\./g; # foo.][bar ==> foo.bar
+ while ($path =~ s/([\[\.])(-+)\.(-+)([\.\]])/$1$2$3$4/) {}
+ # That loop does the following
+ # with any amount of dashes:
+ # .-.-. ==> .--.
+ # [-.-. ==> [--.
+ # .-.-] ==> .--]
+ # [-.-] ==> [--]
+ while ($path =~ s/([\[\.])[^\]\.]+\.-(-+)([\]\.])/$1$2$3/) {}
+ # That loop does the following
+ # with any amount (minimum 2)
+ # of dashes:
+ # .foo.--. ==> .-.
+ # .foo.--] ==> .-]
+ # [foo.--. ==> [-.
+ # [foo.--] ==> [-]
+ #
+ # And then, the remaining cases
+ $path =~ s/\.[^\]\.]+\.-\./\./g; # .foo.-. ==> .
+ $path =~ s/\[[^\]\.]+\.-\./\[/g; # [foo.-. ==> [
+ $path =~ s/\.[^\]\.]+\.-\]/\]/g; # .foo.-] ==> ]
+ $path =~ s/\[[^\]\.]+\.-\]/\[\]/g; # [foo.-] ==> []
+ return $path;
}
}
