| Subject: | add vmstar_clean() to File::Spec::VMS |
Hi,
I feel it would help autors of cross-platform modules if they had a way to transform Unix-style paths into a valid VMS path. I used the vmstar source to do it.
Modules like EU::MM and Archive::Tar (+CPANPLUS) should benefit from this.
hth+
good luck.
-- Abe.
diff -ruN --exclude=Filespec.pm PathTools-3.07.orig/MANIFEST PathTools-3.07/MANIFEST
--- PathTools-3.07.orig/MANIFEST Fri May 6 14:47:34 2005
+++ PathTools-3.07/MANIFEST Mon May 16 16:51:30 2005
@@ -26,5 +26,6 @@
t/rel2abs2rel.t
t/Spec.t
t/taint.t
+t/vmstar_cleanup.t
t/win32.t
SIGNATURE Added here by Module::Build
Binary files PathTools-3.07.orig/PathTools-3.07.tar.gz and PathTools-3.07/PathTools-3.07.tar.gz differ
diff -ruN --exclude=Filespec.pm PathTools-3.07.orig/lib/File/Spec/VMS.pm PathTools-3.07/lib/File/Spec/VMS.pm
--- PathTools-3.07.orig/lib/File/Spec/VMS.pm Fri May 6 14:47:34 2005
+++ PathTools-3.07/lib/File/Spec/VMS.pm Mon May 16 16:42:58 2005
@@ -4,7 +4,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '1.4';
+$VERSION = '1.5';
@ISA = qw(File::Spec::Unix);
@@ -516,6 +516,39 @@
}
return $self->canonpath( $path ) ;
+}
+
+=item vmstar_cleanup( $path )
+
+This is a port of the vms_cleanup() routine in the vmstar distribution
+(in F<tar2vms.c>).
+
+It transforms illegal characters (for VMS) in a unix style path C<$path> into
+undescores and returns a VMS style path.
+
+=cut
+
+my $BADCHARS = q-!@#%^&*()+=|~`[]{}':;<>,?\\\"-;
+my $TRANSLATE = q-__$______X_________________-;
+
+sub vmstar_cleanup {
+ shift; my( $path ) = @_;
+
+ $path =~ s|^\./||;
+
+ eval qq{ \$path =~ tr/$BADCHARS/$TRANSLATE/ };
+
+ my $fname = ( $path =~ m|/| ? "" : $path );
+ $fname or ( $path, $fname ) = $path =~ m|(.+)/(.*)|;
+
+ $path =~ s|^/|[|; # create an absolute path
+ $path =~ tr|.|_|; # change dots into underscore
+ $path =~ tr|/|.|; # change directory separator into dot
+ $path =~ s|^(?!\[)|[.|; # not an absolute path
+
+ defined $fname or $fname = "";
+ $fname =~ s/\.(?=.+\..*)/_/g; # change all but the last dot in fname
+ return "$path]$fname";
}
diff -ruN --exclude=Filespec.pm PathTools-3.07.orig/t/vmstar_cleanup.t PathTools-3.07/t/vmstar_cleanup.t
--- PathTools-3.07.orig/t/vmstar_cleanup.t Thu Jan 1 01:00:00 1970
+++ PathTools-3.07/t/vmstar_cleanup.t Mon May 16 16:41:35 2005
@@ -0,0 +1,48 @@
+#! perl -w
+use strict;
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ @INC = '../lib';
+ }
+}
+
+use Test::More;
+plan $^O eq 'VMS' ? (tests => 6) : (skip_all => 'this is not VMS');
+
+use_ok 'File::Spec::VMS';
+
+{
+ my $upath = 'sub/dir@2/file.with.dots';
+ my $vpath = File::Spec::VMS->vmstar_cleanup( $upath );
+ is $vpath, '[.sub.dir_2]file_with.dots', "$upath -> $vpath";
+
+}
+
+{
+ my $upath = './sub/dir@2/file.with.dots';
+ my $vpath = File::Spec::VMS->vmstar_cleanup( $upath );
+ is $vpath, '[.sub.dir_2]file_with.dots', "$upath -> $vpath";
+
+}
+
+{
+ my $upath = '/sub/dir@2/file.with.dots';
+ my $vpath = File::Spec::VMS->vmstar_cleanup( $upath );
+ is $vpath, '[sub.dir_2]file_with.dots', "$upath -> $vpath";
+
+}
+
+{
+ my $upath = 'PathTools-3.07/lib/File/Spec/VMS.pm';
+ my $vpath = File::Spec::VMS->vmstar_cleanup( $upath );
+ is $vpath, '[.PathTools-3_07.lib.File.Spec]VMS.pm', "$upath -> $vpath";
+
+}
+
+{
+ my $upath = 'PathTools-3.07/lib/File/Spec/';
+ my $vpath = File::Spec::VMS->vmstar_cleanup( $upath );
+ is $vpath, '[.PathTools-3_07.lib.File.Spec]', "$upath -> $vpath";
+
+}