dslinux/user/perl/vms/ext Filespec.pm XSSymSet.pm filespec.t

cayenne dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:02:17 CET 2006


Update of /cvsroot/dslinux/dslinux/user/perl/vms/ext
In directory antilope:/tmp/cvs-serv17422/vms/ext

Added Files:
	Filespec.pm XSSymSet.pm filespec.t 
Log Message:
Adding fresh perl source to HEAD to branch from

--- NEW FILE: XSSymSet.pm ---
package ExtUtils::XSSymSet;

use Carp qw( &carp );
use strict;
use vars qw( $VERSION );
$VERSION = '1.0';


sub new { 
  my($pkg,$maxlen,$silent) = @_;
  $maxlen ||= 31;
  $silent ||= 0;
  my($obj) = { '__M at xLen' => $maxlen, '__S!lent' => $silent };
  bless $obj, $pkg;
}


sub trimsym {
  my($self,$name,$maxlen,$silent) = @_;

  unless (defined $maxlen) {
    if (ref $self) { $maxlen ||= $self->{'__M at xLen'}; }
    $maxlen ||= 31;
  }
  unless (defined $silent) {
    if (ref $self) { $silent ||= $self->{'__S!lent'}; }
    $silent ||= 0;
  }
  return $name if (length $name <= $maxlen);

  my $trimmed = $name;
  # First, just try to remove duplicated delimiters
  $trimmed =~ s/__/_/g;
  if (length $trimmed > $maxlen) {
    # Next, all duplicated chars
    $trimmed =~ s/(.)\1+/$1/g;
    if (length $trimmed > $maxlen) {
      my $squeezed = $trimmed;
      my($xs,$prefix,$func) = $trimmed =~ /^(XS_)?(.*)_([^_]*)$/;
      if (length $func <= 12) {  # Try to preserve short function names
        my $frac = int(length $prefix / (length $trimmed - $maxlen) + 0.5);
        my $pat = '([^_])';
        if ($frac > 1) { $pat .= '[^A-Z_]{' . ($frac - 1) . '}'; }
        $prefix =~ s/$pat/$1/g;
        $squeezed = "$xs$prefix" . "_$func";
        if (length $squeezed > $maxlen) {
          $pat =~ s/A-Z//;
          $prefix =~ s/$pat/$1/g;
          $squeezed = "$xs$prefix" . "_$func";
        }
      }
      else { 
        my $frac = int(length $trimmed / (length $trimmed - $maxlen) + 0.5);
        my $pat = '([^_])';
        if ($frac > 1) { $pat .= '[^A-Z_]{' . ($frac - 1) . '}'; }
        $squeezed = "$prefix$func";
        $squeezed =~ s/$pat/$1/g;
        if (length "$xs$squeezed" > $maxlen) {
          $pat =~ s/A-Z//;
          $squeezed =~ s/$pat/$1/g;
        }
        $squeezed = "$xs$squeezed";
      }
      if (length $squeezed <= $maxlen) { $trimmed = $squeezed; }
      else {
        my $frac = int((length $trimmed - $maxlen) / length $trimmed + 0.5);
        my $pat = '(.).{$frac}';
        $trimmed =~ s/$pat/$1/g;
      }
    }
  }
  carp "Warning: long symbol $name\n\ttrimmed to $trimmed\n\t" unless $silent;
  return $trimmed;
}


sub addsym {
  my($self,$sym,$maxlen,$silent) = @_;
  my $trimmed = $self->get_trimmed($sym);

  return $trimmed if defined $trimmed;

  $maxlen ||= $self->{'__M at xLen'} || 31;
  $silent ||= $self->{'__S!lent'} || 0;    
  $trimmed = $self->trimsym($sym,$maxlen,1);
  if (exists $self->{$trimmed}) {
    my($i) = "00";
    $trimmed = $self->trimsym($sym,$maxlen-3,$silent);
    while (exists $self->{"${trimmed}_$i"}) { $i++; }
    carp "Warning: duplicate symbol $trimmed\n\tchanged to ${trimmed}_$i\n\t(original was $sym)\n\t"
      unless $silent;
    $trimmed .= "_$i";
  }
  elsif (not $silent and $trimmed ne $sym) {
    carp "Warning: long symbol $sym\n\ttrimmed to $trimmed\n\t";
  }
  $self->{$trimmed} = $sym;
  $self->{'__N+Map'}->{$sym} = $trimmed;
  $trimmed;
}


sub delsym {
  my($self,$sym) = @_;
  my $trimmed = $self->{'__N+Map'}->{$sym};
  if (defined $trimmed) {
    delete $self->{'__N+Map'}->{$sym};
    delete $self->{$trimmed};
  }
  $trimmed;
}


sub get_trimmed {
  my($self,$sym) = @_;
  $self->{'__N+Map'}->{$sym};
}


sub get_orig {
  my($self,$trimmed) = @_;
  $self->{$trimmed};
}


sub all_orig { (keys %{$_[0]->{'__N+Map'}}); }
sub all_trimmed { (grep { /^\w+$/ } keys %{$_[0]}); }

__END__

=head1 NAME

VMS::XSSymSet - keep sets of symbol names palatable to the VMS linker

=head1 SYNOPSIS

  use VMS::XSSymSet;

  $set = new VMS::XSSymSet;
  while ($sym = make_symbol()) { $set->addsym($sym); }
  foreach $safesym ($set->all_trimmed) {
    print "Processing $safesym (derived from ",$self->get_orig($safesym),")\n";
    do_stuff($safesym);
  }

  $safesym = VMS::XSSymSet->trimsym($onesym);

=head1 DESCRIPTION

Since the VMS linker distinguishes symbols based only on the first 31
characters of their names, it is occasionally necessary to shorten
symbol names in order to avoid collisions.  (This is especially true of
names generated by xsubpp, since prefixes generated by nested package
names can become quite long.)  C<VMS::XSSymSet> provides functions to
shorten names in a consistent fashion, and to track a set of names to
insure that each is unique.  While designed with F<xsubpp> in mind, it
may be used with any set of strings.  

This package supplies the following functions, all of which should be
called as methods.

=over 4

=item new([$maxlen[,$silent]])

Creates an empty C<VMS::XSSymset> set of symbols.  This function may be
called as a static method or via an existing object.  If C<$maxlen> or
C<$silent> are specified, they are used as the defaults for maximum
name length and warning behavior in future calls to addsym() or
trimsym() via this object.

=item addsym($name[,$maxlen[,$silent]])

Creates a symbol name from C<$name>, using the methods described
under trimsym(), which is unique in this set of symbols, and returns
the new name.  C<$name> and its resultant are added to the set, and
any future calls to addsym() specifying the same C<$name> will return
the same result, regardless of the value of C<$maxlen> specified.
Unless C<$silent> is true, warnings are output if C<$name> had to be
trimmed or changed in order to avoid collision with an existing symbol
name.  C<$maxlen> and C<$silent> default to the values specified when
this set of symbols was created.  This method must be called via an
existing object.

=item trimsym($name[,$maxlen[,$silent]])

Creates a symbol name C<$maxlen> or fewer characters long from
C<$name> and returns it. If C<$name> is too long, it first tries to
shorten it by removing duplicate characters, then by periodically
removing non-underscore characters, and finally, if necessary, by
periodically removing characters of any type.  C<$maxlen> defaults
to 31.  Unless C<$silent> is true, a warning is output if C<$name>
is altered in any way.  This function may be called either as a
static method or via an existing object, but in the latter case no
check is made to insure that the resulting name is unique in the
set of symbols.

=item delsym($name)

Removes C<$name> from the set of symbols, where C<$name> is the
original symbol name passed previously to addsym().  If C<$name>
existed in the set of symbols, returns its "trimmed" equivalent,
otherwise returns C<undef>.  This method must be called via an
existing object.

=item get_orig($trimmed)

Returns the original name which was trimmed to C<$trimmed> by a
previous call to addsym(), or C<undef> if C<$trimmed> does not
correspond to a member of this set of symbols.  This method must be
called via an existing object.

=item get_trimmed($name)

Returns the trimmed name which was generated from C<$name> by a
previous call to addsym(), or C<undef> if C<$name> is not a member
of this set of symbols.  This method must be called via an
existing object.

=item all_orig()

Returns a list containing all of the original symbol names
from this set.

=item all_trimmed()

Returns a list containing all of the trimmed symbol names
from this set.

=back

=head1 AUTHOR

Charles Bailey  E<lt>I<bailey at newman.upenn.edu>E<gt>

=head1 REVISION

Last revised 14-Feb-1997, for Perl 5.004.


--- NEW FILE: Filespec.pm ---
#   Perl hooks into the routines in vms.c for interconversion
#   of VMS and Unix file specification syntax.
#
#   Version:  see $VERSION below
#   Author:   Charles Bailey  bailey at newman.upenn.edu
#   Revised:  08-Mar-1995

=head1 NAME

VMS::Filespec - convert between VMS and Unix file specification syntax

=head1 SYNOPSIS

use VMS::Filespec;
$fullspec = rmsexpand('[.VMS]file.specification'[, 'default:[file.spec]']);
$vmsspec = vmsify('/my/Unix/file/specification');
$unixspec = unixify('my:[VMS]file.specification');
$path = pathify('my:[VMS.or.Unix.directory]specification.dir');
$dirfile = fileify('my:[VMS.or.Unix.directory.specification]');
$vmsdir = vmspath('my/VMS/or/Unix/directory/specification.dir');
$unixdir = unixpath('my:[VMS.or.Unix.directory]specification.dir');
candelete('my:[VMS.or.Unix]file.specification');

=head1 DESCRIPTION

This package provides routines to simplify conversion between VMS and
Unix syntax when processing file specifications.  This is useful when
porting scripts designed to run under either OS, and also allows you
to take advantage of conveniences provided by either syntax (I<e.g.>
ability to easily concatenate Unix-style specifications).  In
addition, it provides an additional file test routine, C<candelete>,
which determines whether you have delete access to a file.

If you're running under VMS, the routines in this package are special,
in that they're automatically made available to any Perl script,
whether you're running F<miniperl> or the full F<perl>.  The C<use
VMS::Filespec> or C<require VMS::Filespec; import VMS::Filespec ...>
statement can be used to import the function names into the current
package, but they're always available if you use the fully qualified
name, whether or not you've mentioned the F<.pm> file in your script. 
If you're running under another OS and have installed this package, it
behaves like a normal Perl extension (in fact, you're using Perl
substitutes to emulate the necessary VMS system calls).

Each of these routines accepts a file specification in either VMS or
Unix syntax, and returns the converted file specification, or C<undef>
if an error occurs.  The conversions are, for the most part, simply
string manipulations; the routines do not check the details of syntax
(e.g. that only legal characters are used).  There is one exception:
when running under VMS, conversions from VMS syntax use the $PARSE
service to expand specifications, so illegal syntax, or a relative
directory specification which extends above the tope of the current
directory path (e.g [---.foo] when in dev:[dir.sub]) will cause
errors.  In general, any legal file specification will be converted
properly, but garbage input tends to produce garbage output.  

Each of these routines is prototyped as taking a single scalar
argument, so you can use them as unary operators in complex
expressions (as long as you don't use the C<&> form of
subroutine call, which bypasses prototype checking).


The routines provided are:

=head2 rmsexpand

Uses the RMS $PARSE and $SEARCH services to expand the input
specification to its fully qualified form, except that a null type
or version is not added unless it was present in either the original
file specification or the default specification passed to C<rmsexpand>.
(If the file does not exist, the input specification is expanded as much
as possible.)  If an error occurs, returns C<undef> and sets C<$!>
and C<$^E>.

=head2 vmsify

Converts a file specification to VMS syntax.

=head2 unixify

Converts a file specification to Unix syntax.

=head2 pathify

Converts a directory specification to a path - that is, a string you
can prepend to a file name to form a valid file specification.  If the
input file specification uses VMS syntax, the returned path does, too;
likewise for Unix syntax (Unix paths are guaranteed to end with '/').
Note that this routine will insist that the input be a legal directory
file specification; the file type and version, if specified, must be
F<.DIR;1>.  For compatibility with Unix usage, the type and version
may also be omitted.

=head2 fileify

Converts a directory specification to the file specification of the
directory file - that is, a string you can pass to functions like
C<stat> or C<rmdir> to manipulate the directory file.  If the
input directory specification uses VMS syntax, the returned file
specification does, too; likewise for Unix syntax.  As with
C<pathify>, the input file specification must have a type and
version of F<.DIR;1>, or the type and version must be omitted.

=head2 vmspath

Acts like C<pathify>, but insures the returned path uses VMS syntax.

=head2 unixpath

Acts like C<pathify>, but insures the returned path uses Unix syntax.

=head2 candelete

Determines whether you have delete access to a file.  If you do, C<candelete>
returns true.  If you don't, or its argument isn't a legal file specification,
C<candelete> returns FALSE.  Unlike other file tests, the argument to
C<candelete> must be a file name (not a FileHandle), and, since it's an XSUB,
it's a list operator, so you need to be careful about parentheses.  Both of
these restrictions may be removed in the future if the functionality of
C<candelete> becomes part of the Perl core.

=head1 REVISION

This document was last revised 22-Feb-1996, for Perl 5.002.

=cut

package VMS::Filespec;
require 5.002;

our $VERSION = '1.11';

# If you want to use this package on a non-VMS system,
# uncomment the following line.
# use AutoLoader;
require Exporter;

@ISA = qw( Exporter );
@EXPORT = qw( &vmsify &unixify &pathify &fileify
              &vmspath &unixpath &candelete &rmsexpand );

1;


__END__


# The autosplit routines here are provided for use by non-VMS systems
# They are not guaranteed to function identically to the XSUBs of the
# same name, since they do not have access to the RMS system routine
# sys$parse() (in particular, no real provision is made for handling
# of complex DECnet node specifications).  However, these routines
# should be adequate for most purposes.

# A sort-of sys$parse() replacement
sub rmsexpand ($;$) {
  my($fspec,$defaults) = @_;
  if (!$fspec) { return undef }
  my($node,$dev,$dir,$name,$type,$ver,$dnode,$ddev,$ddir,$dname,$dtype,$dver);

  $fspec =~ s/:$//;
  $defaults = [] unless $defaults;
  $defaults = [ $defaults ] unless ref($defaults) && ref($defaults) eq 'ARRAY';

  while ($fspec !~ m#[:>\]]# && $ENV{$fspec}) { $fspec = $ENV{$fspec} }

  if ($fspec =~ /:/) {
    my($dev,$devtrn,$base);
    ($dev,$base) = split(/:/,$fspec);
    $devtrn = $dev;
    while ($devtrn = $ENV{$devtrn}) {
      if ($devtrn =~ /(.)([:>\]])$/) {
        $dev .= ':', last if $1 eq '.';
        $dev = $devtrn, last;
      }
    }
    $fspec = $dev . $base;
  }

  ($node,$dev,$dir,$name,$type,$ver) = $fspec =~
     /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
  foreach ((@$defaults,$ENV{'DEFAULT'})) {
    next unless defined;
    last if $node && $ver && $type && $dev && $dir && $name;
    ($dnode,$ddev,$ddir,$dname,$dtype,$dver) =
       /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
    $node = $dnode if $dnode && !$node;
    $dev = $ddev if $ddev && !$dev;
    $dir = $ddir if $ddir && !$dir;
    $name = $dname if $dname && !$name;
    $type = $dtype if $dtype && !$type;
    $ver = $dver if $dver && !$ver;
  }
  # do this the long way to keep -w happy
  $fspec = '';
  $fspec .= $node if $node;
  $fspec .= $dev if $dev;
  $fspec .= $dir if $dir;
  $fspec .= $name if $name;
  $fspec .= $type if $type;
  $fspec .= $ver if $ver;
  $fspec;
}  

sub vmsify ($) {
  my($fspec) = @_;
  my($hasdev,$dev,$defdirs,$dir,$base, at dirs, at realdirs);

  if ($fspec =~ m#^\.(\.?)/?$#) { return $1 ? '[-]' : '[]'; }
  return $fspec if $fspec !~ m#/#;
  ($hasdev,$dir,$base) = $fspec =~ m#(/?)(.*)/(.*)#;
  @dirs = split(m#/#,$dir);
  if ($base eq '.') { $base = ''; }
  elsif ($base eq '..') {
    push @dirs,$base;
    $base = '';
  }
  foreach (@dirs) {
    next unless $_;  # protect against // in input
    next if $_ eq '.';
    if ($_ eq '..') {
      if (@realdirs && $realdirs[$#realdirs] ne '-') { pop @realdirs }
      else                                           { push @realdirs, '-' }
    }
    else { push @realdirs, $_; }
  }
  if ($hasdev) {
    $dev = shift @realdirs;
    @realdirs = ('000000') unless @realdirs;
    $base = '' unless $base;  # keep -w happy
    $dev . ':[' . join('.', at realdirs) . "]$base";
  }
  else {
    '[' . join('',map($_ eq '-' ? $_ : ".$_", at realdirs)) . "]$base";
  }
}

sub unixify ($) {
  my($fspec) = @_;

  return $fspec if $fspec !~ m#[:>\]]#;
  return '.' if ($fspec eq '[]' || $fspec eq '<>');
  if ($fspec =~ m#^[<\[](\.|-+)(.*)# ) {
    $fspec = ($1 eq '.' ? '' : "$1.") . $2;
    my($dir,$base) = split(/[\]>]/,$fspec);
    my(@dirs) = grep($_,split(m#\.#,$dir));
    if ($dirs[0] =~ /^-/) {
      my($steps) = shift @dirs;
      for (1..length($steps)) { unshift @dirs, '..'; }
    }
    join('/', at dirs) . "/$base";
  }
  else {
    $fspec = rmsexpand($fspec,'_N_O_T_:[_R_E_A_L_]');
    $fspec =~ s/.*_N_O_T_:(?:\[_R_E_A_L_\])?//;
    my($dev,$dir,$base) = $fspec =~ m#([^:<\[]*):?[<\[](.*)[>\]](.*)#;
    my(@dirs) = split(m#\.#,$dir);
    if ($dirs[0] && $dirs[0] =~ /^-/) {
      my($steps) = shift @dirs;
      for (1..length($steps)) { unshift @dirs, '..'; }
    }
    "/$dev/" . join('/', at dirs) . "/$base";
  }
}


sub fileify ($) {
  my($path) = @_;

  if (!$path) { return undef }
  if ($path eq '/') { return 'sys$disk:[000000]'; }
  if ($path =~ /(.+)\.([^:>\]]*)$/) {
    $path = $1;
    if ($2 !~ /^dir(?:;1)?$/i) { return undef }
  }

  if ($path !~ m#[/>\]]#) {
    $path =~ s/:$//;
    while ($ENV{$path}) {
      ($path = $ENV{$path}) =~ s/:$//;
      last if $path =~ m#[/>\]]#;
    }
  }
  if ($path =~ m#[>\]]#) {
    my($dir,$sep,$base) = $path =~ /(.*)([>\]])(.*)/;
    $sep =~ tr/<[/>]/;
    if ($base) {
      "$dir$sep$base.dir;1";
    }
    else {
      if ($dir !~ /\./) { $dir =~ s/([<\[])/${1}000000./; }
      $dir =~ s#\.(\w+)$#$sep$1#;
      $dir =~ s/^.$sep//;
      "$dir.dir;1";
    }
  }
  else {
    $path =~ s#/$##;
    "$path.dir;1";
  }
}

sub pathify ($) {
  my($fspec) = @_;

  if (!$fspec) { return undef }
  if ($fspec =~ m#[/>\]]$#) { return $fspec; }
  if ($fspec =~ m#(.+)\.([^/>\]]*)$# && $2 && $2 ne '.') {
    $fspec = $1;
    if ($2 !~ /^dir(?:;1)?$/i) { return undef }
  }

  if ($fspec !~ m#[/>\]]#) {
    $fspec =~ s/:$//;
    while ($ENV{$fspec}) {
      if ($ENV{$fspec} =~ m#[>\]]$#) { return $ENV{$fspec} }
      else { $fspec = $ENV{$fspec} =~ s/:$// }
    }
  }
  
  if ($fspec !~ m#[>\]]#) { "$fspec/"; }
  else {
    if ($fspec =~ /([^>\]]+)([>\]])(.+)/) { "$1.$3$2"; }
    else { $fspec; }
  }
}

sub vmspath ($) {
  pathify(vmsify($_[0]));
}

sub unixpath ($) {
  pathify(unixify($_[0]));
}

sub candelete ($) {
  my($fspec) = @_;
  my($parent);

  return '' unless -w $fspec;
  $fspec =~ s#/$##;
  if ($fspec =~ m#/#) {
    ($parent = $fspec) =~ s#/[^/]+$##;
    return (-w $parent);
  }
  elsif ($parent = fileify($fspec)) { # fileify() here to expand lnms
    $parent =~ s/[>\]][^>\]]+//;
    return (-w fileify($parent));
  }
  else { return (-w '[-]'); }
}

--- NEW FILE: filespec.t ---
#!./perl

BEGIN { unshift(@INC,'../lib') if -d '../lib'; }

use VMS::Filespec;
use File::Spec;

foreach (<DATA>) {
  chomp;
  s/\s*#.*//;
  next if /^\s*$/;
  push(@tests,$_);
}

require './test.pl';
plan(tests => scalar(2*@tests)+6);

foreach $test (@tests) {
  ($arg,$func,$expect) = split(/\s+/,$test);

  $expect = undef if $expect eq 'undef';
  $rslt = eval "$func('$arg')";
  is($@, '', "eval ${func}('$arg')");
  is($rslt, $expect, "${func}('$arg'): '$rslt'");
}

$defwarn = <<'EOW';
# Note: This failure may have occurred because your default device
# was set using a non-concealed logical name.  If this is the case,
# you will need to determine by inspection that the two resultant
# file specifications shown above are in fact equivalent.
EOW

is(uc(rmsexpand('[]')),   "\U$ENV{DEFAULT}", 'rmsexpand()') || print $defwarn;
is(rmsexpand('from.here'),"\L$ENV{DEFAULT}from.here") || print $defwarn;
is(rmsexpand('from'),     "\L$ENV{DEFAULT}from")      || print $defwarn;

is(rmsexpand('from.here','cant:[get.there];2'),
   'cant:[get.there]from.here;2')                     || print $defwarn;


# Make sure we're using redirected mkdir, which strips trailing '/', since
# the CRTL's mkdir can't handle this.
ok(mkdir('testdir/',0777),      'using redirected mkdir()');
ok(rmdir('testdir/'),           '    rmdir()');

__DATA__

# lots of underscores used to minimize collision with existing logical names

# Basic VMS to Unix filespecs
__some_:[__where_.__over_]__the_.__rainbow_    unixify /__some_/__where_/__over_/__the_.__rainbow_
[.__some_.__where_.__over_]__the_.__rainbow_   unixify __some_/__where_/__over_/__the_.__rainbow_
[-.__some_.__where_.__over_]__the_.__rainbow_  unixify ../__some_/__where_/__over_/__the_.__rainbow_
[.__some_.--.__where_.__over_]__the_.__rainbow_        unixify __some_/../../__where_/__over_/__the_.__rainbow_
[.__some_...__where_.__over_]__the_.__rainbow_ unixify __some_/.../__where_/__over_/__the_.__rainbow_
[...__some_.__where_.__over_]__the_.__rainbow_ unixify .../__some_/__where_/__over_/__the_.__rainbow_
[.__some_.__where_.__over_...]__the_.__rainbow_        unixify __some_/__where_/__over_/.../__the_.__rainbow_
[.__some_.__where_.__over_...] unixify __some_/__where_/__over_/.../
[.__some_.__where_.__over_.-]  unixify __some_/__where_/__over_/../
[]	unixify		./
[-]	unixify		../
[--]	unixify		../../
[...]	unixify		.../

# and back again
/__some_/__where_/__over_/__the_.__rainbow_    vmsify  __some_:[__where_.__over_]__the_.__rainbow_
__some_/__where_/__over_/__the_.__rainbow_     vmsify  [.__some_.__where_.__over_]__the_.__rainbow_
../__some_/__where_/__over_/__the_.__rainbow_  vmsify  [-.__some_.__where_.__over_]__the_.__rainbow_
__some_/../../__where_/__over_/__the_.__rainbow_       vmsify  [-.__where_.__over_]__the_.__rainbow_
.../__some_/__where_/__over_/__the_.__rainbow_ vmsify  [...__some_.__where_.__over_]__the_.__rainbow_
__some_/.../__where_/__over_/__the_.__rainbow_ vmsify  [.__some_...__where_.__over_]__the_.__rainbow_
/__some_/.../__where_/__over_/__the_.__rainbow_        vmsify  __some_:[...__where_.__over_]__the_.__rainbow_
__some_/__where_/...   vmsify  [.__some_.__where_...]
/__where_/...  vmsify  __where_:[...]
.	vmsify	[]
..	vmsify	[-]
../..	vmsify	[--]
.../	vmsify	[...]
/	vmsify	sys$disk:[000000]

# Fileifying directory specs
__down_:[__the_.__garden_.__path_]     fileify __down_:[__the_.__garden_]__path_.dir;1
[.__down_.__the_.__garden_.__path_]    fileify [.__down_.__the_.__garden_]__path_.dir;1
/__down_/__the_/__garden_/__path_      fileify /__down_/__the_/__garden_/__path_.dir;1
/__down_/__the_/__garden_/__path_/     fileify /__down_/__the_/__garden_/__path_.dir;1
__down_/__the_/__garden_/__path_       fileify __down_/__the_/__garden_/__path_.dir;1
__down_:[__the_.__garden_]__path_      fileify __down_:[__the_.__garden_]__path_.dir;1
__down_:[__the_.__garden_]__path_.     fileify # N.B. trailing . ==> null type
__down_:[__the_]__garden_.__path_      fileify undef
/__down_/__the_/__garden_/__path_.     fileify # N.B. trailing . ==> null type
/__down_/__the_/__garden_.__path_      fileify undef

# and pathifying them
__down_:[__the_.__garden_]__path_.dir;1        pathify __down_:[__the_.__garden_.__path_]
[.__down_.__the_.__garden_]__path_.dir pathify [.__down_.__the_.__garden_.__path_]
/__down_/__the_/__garden_/__path_.dir  pathify /__down_/__the_/__garden_/__path_/
__down_/__the_/__garden_/__path_.dir   pathify __down_/__the_/__garden_/__path_/
__down_:[__the_.__garden_]__path_      pathify __down_:[__the_.__garden_.__path_]
__down_:[__the_.__garden_]__path_.     pathify # N.B. trailing . ==> null type
__down_:[__the_]__garden_.__path_      pathify undef
/__down_/__the_/__garden_/__path_.     pathify # N.B. trailing . ==> null type
/__down_/__the_/__garden_.__path_      pathify undef
__down_:[__the_.__garden_]__path_.dir;2        pathify #N.B. ;2
__path_        pathify __path_/
/__down_/__the_/__garden_/.    pathify /__down_/__the_/__garden_/./
/__down_/__the_/__garden_/..   pathify /__down_/__the_/__garden_/../
/__down_/__the_/__garden_/...  pathify /__down_/__the_/__garden_/.../
__path_.notdir pathify undef

# Both VMS/Unix and file/path conversions
__down_:[__the_.__garden_]__path_.dir;1        unixpath        /__down_/__the_/__garden_/__path_/
/__down_/__the_/__garden_/__path_      vmspath __down_:[__the_.__garden_.__path_]
__down_:[__the_.__garden_.__path_]     unixpath        /__down_/__the_/__garden_/__path_/
__down_:[__the_.__garden_.__path_...]  unixpath        /__down_/__the_/__garden_/__path_/.../
/__down_/__the_/__garden_/__path_.dir  vmspath __down_:[__the_.__garden_.__path_]
[.__down_.__the_.__garden_]__path_.dir unixpath        __down_/__the_/__garden_/__path_/
__down_/__the_/__garden_/__path_       vmspath [.__down_.__the_.__garden_.__path_]
__path_        vmspath [.__path_]
/	vmspath	sys$disk:[000000]

# Redundant characters in Unix paths
//__some_/__where_//__over_/../__the_.__rainbow_       vmsify  __some_:[__where_]__the_.__rainbow_
/__some_/__where_//__over_/./__the_.__rainbow_ vmsify  __some_:[__where_.__over_]__the_.__rainbow_
..//../	vmspath	[--]
./././	vmspath	[]
./../.	vmsify	[-]

# Our override of File::Spec->canonpath can do some strange things
__dev:[__dir.000000]__foo     File::Spec->canonpath   __dev:[__dir.000000]__foo
__dev:[__dir.][000000]__foo   File::Spec->canonpath   __dev:[__dir]__foo




More information about the dslinux-commit mailing list