[Ltp-cvs] ltp/testcases/ballista/ballista/perllib/auto/URI/URL/file dos_path.al,NONE,1.1 unix_path.al,NONE,1.1 autosplit.ix,NONE,1.1 vms_path.al,NONE,1.1 newlocal.al,NONE,1.1 mac_path.al,NONE,1.1

[Martin R. <mr...@us...>]

Update of /cvsroot/ltp/ltp/testcases/ballista/ballista/perllib/auto/URI/URL/file
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18149/auto/URI/URL/file

Added Files:
	dos_path.al unix_path.al autosplit.ix vms_path.al newlocal.al 
	mac_path.al 
Log Message:
Inital drop of ballista testsuite


--- NEW FILE: unix_path.al ---
# NOTE: Derived from ./blib/lib/URI/URL/file.pm.  Changes made here will be lost.
package URI::URL::file;

sub unix_path
{
    my $self = shift;
    my @p;
    for ($self->path_components) {
	Carp::croak("Path component contains '/' or '\0'") if m|[\0/]|;
	if (@p) {
	    next unless length $_;   # skip empty path segments
	    next if $_ eq '.';       # skip these too
	    if ($_ eq '..' && $p[-1] ne '..') {  # go up one level
		pop(@p) if $p[-1] ne '';
		next;
	    }
	}
	push(@p, $_);
    }
    shift(@p) if @p > 1 && $p[0] eq '.';   # './' rendundant if there is more
    return '/' if !@p || (@p == 1 && $p[0] eq '');
    join('/', @p);
}

1;

--- NEW FILE: mac_path.al ---
# NOTE: Derived from ./blib/lib/URI/URL/file.pm.  Changes made here will be lost.
package URI::URL::file;

sub mac_path
{
    my $self = shift;
    my @p;
    for ($self->path_components) {
	Carp::croak("Path component contains ':'") if /:/;
	# XXX: Should probably want to do something about ".." and "."
	# path segments.  I don't know how these are represented in
	# the Machintosh file system.  If these are valid file names
	# then we should split the path ourself, as $u->path_components
	# loose the distinction between '.' and '%2E'.
	push(@p, $_);
    }
    if (@p && $p[0] eq '') {
	shift @p;
    } else {
	unshift(@p, '');
    }
    join(':', @p);
}

1;

--- NEW FILE: newlocal.al ---
# NOTE: Derived from ./blib/lib/URI/URL/file.pm.  Changes made here will be lost.
package URI::URL::file;

sub newlocal {
    my($class, $path) = @_;

    Carp::croak("Only implemented for Unix and OS/2 file systems")
      unless $ostype eq "unix" or $^O =~ /os2|mswin32/i;
    # XXX: Should implement the same thing for other systems

    my $url = new URI::URL "file:";
    unless (defined $path and
    	    ($path =~ m:^/: or 
	     ($^O eq 'os2' and Cwd::sys_is_absolute($path)) or
	     ($^O eq 'MSWin32' and $path =~ m<^[A-Za-z]:[\\/]|^[\\/]{2}>))) {
	require Cwd;
	my $cwd = Cwd::fastcwd();
	$cwd =~ s:/?$:/:; # force trailing slash on dir
	$path = (defined $path) ? $cwd . $path : $cwd;
    }
    $url->path($path);
    $url;
}

1;

--- NEW FILE: dos_path.al ---
# NOTE: Derived from ./blib/lib/URI/URL/file.pm.  Changes made here will be lost.
package URI::URL::file;

sub dos_path
{
    my $self = shift;
    my @p;
    for ($self->path_components) {
	Carp::croak("Path component contains '/' or '\\'") if m|[/\\]|;
	push(@p, uc $_);
    }
    my $p = join("\\", @p);
    $p =~ s/^\\([A-Z]:)/$1/;  # Fix drive letter specification
    $p;
}

1;

--- NEW FILE: autosplit.ix ---
# Index created by AutoSplit for ./blib/lib/URI/URL/file.pm (file acts as timestamp)
package URI::URL::file;
sub newlocal ;
sub unix_path ;
sub dos_path ;
sub mac_path ;
sub vms_path ;
1;

--- NEW FILE: vms_path.al ---
# NOTE: Derived from ./blib/lib/URI/URL/file.pm.  Changes made here will be lost.
package URI::URL::file;

sub vms_path
{
    # ????? Can some VMS people please redo this function ??????

    # This is implemented based on what RFC1738 (sec 3.10) says in the
    # VMS file example:
    #
    #  DISK$USER:[MY.NOTES]NOTE123456.TXT
    #
    #      that might become
    #
    #  file:/disk$user/my/notes/note12345.txt
    #
    # BEWARE: I don't have a VMS machine myself so this is pure guesswork!!!

    my $self = shift;
    my @p = $self->path_components;
    my $abs = 0;
    if (@p && $p[0] eq '') {
	shift @p;
	$abs = 1;
    }
    # First I assume there must be a dollar in a disk spesification
    my $p = '';
    $p = uc(shift(@p)) . ":"  if @p && $p[0] =~ /\$/;
    my $file = pop(@p);
    $p .= "[" . join(".", map{uc($_)} @p) . "]" if @p;
    $p .= uc $file;
    # XXX: How is an absolute path different from a relative one??
    $p =~ s/\[/[./ unless $abs;
    # XXX: How is a directory denoted??
    $p;
}

1;
1;