Initial commit of OpenSPARC T2 architecture model.

[OpenSPARC-T2-SAM] / sam-t2 / devtools / amd64 / lib / perl5 / 5.8.8 / File / Spec / OS2.pm

package File::Spec::OS2;

use strict;
use vars qw(@ISA $VERSION);
require File::Spec::Unix;

$VERSION = '1.2';

@ISA = qw(File::Spec::Unix);

sub devnull {
   return "/dev/nul";
}

sub case_tolerant {
   return 1;
}

sub file_name_is_absolute {
   my ($self,$file) = @_;
   return scalar($file =~ m{^([a-z]:)?[\\/]}is);
}

sub path {
   my $path = $ENV{PATH};
   $path =~ s:\\:/:g;
   my @path = split(';',$path);
   foreach (@path) { $_ = '.' if $_ eq '' }
   return @path;
}

sub _cwd {
   # In OS/2 the "require Cwd" is unnecessary bloat.
   return Cwd::sys_cwd();
}

my $tmpdir;
sub tmpdir {
   return $tmpdir if defined $tmpdir;
   $tmpdir = $_[0]->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
                             '/tmp',
                             '/'  );
}

sub catdir {
   my $self = shift;
   my @args = @_;
   foreach (@args) {
       tr[\\][/];
       # append a backslash to each argument unless it has one there
       $_ .= "/" unless m{/$};
   }
   return $self->canonpath(join('', @args));
}

sub canonpath {
   my ($self,$path) = @_;
   $path =~ s/^([a-z]:)/\l$1/s;
   $path =~ s|\\|/|g;
   $path =~ s|([^/])/+|$1/|g;                  # xx////xx  -> xx/xx
   $path =~ s|(/\.)+/|/|g;                     # xx/././xx -> xx/xx
   $path =~ s|^(\./)+(?=[^/])||s;              # ./xx      -> xx
   $path =~ s|/\Z(?!\n)||
            unless $path =~ m#^([a-z]:)?/\Z(?!\n)#si;# xx/       -> xx
   $path =~ s{^/\.\.$}{/};                     # /..    -> /
   1 while $path =~ s{^/\.\.}{};               # /../xx -> /xx
   return $path;
}


sub splitpath {
   my ($self,$path, $nofile) = @_;
   my ($volume,$directory,$file) = ('','','');
   if ( $nofile ) {
       $path =~ 
           m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) 
                (.*)
            }xs;
       $volume    = $1;
       $directory = $2;
   }
   else {
       $path =~ 
           m{^ ( (?: [a-zA-Z]: |
                     (?:\\\\|//)[^\\/]+[\\/][^\\/]+
                 )?
               )
               ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
               (.*)
            }xs;
       $volume    = $1;
       $directory = $2;
       $file      = $3;
   }

   return ($volume,$directory,$file);
}


sub splitdir {
   my ($self,$directories) = @_ ;
   split m|[\\/]|, $directories, -1;
}


sub catpath {
   my ($self,$volume,$directory,$file) = @_;

   # If it's UNC, make sure the glue separator is there, reusing
   # whatever separator is first in the $volume
   $volume .= $1
       if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
            $directory =~ m@^[^\\/]@s
          ) ;

   $volume .= $directory ;

   # If the volume is not just A:, make sure the glue separator is 
   # there, reusing whatever separator is first in the $volume if possible.
   if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
        $volume =~ m@[^\\/]\Z(?!\n)@      &&
        $file   =~ m@[^\\/]@
      ) {
       $volume =~ m@([\\/])@ ;
       my $sep = $1 ? $1 : '/' ;
       $volume .= $sep ;
   }

   $volume .= $file ;

   return $volume ;
}


sub abs2rel {
   my($self,$path,$base) = @_;

   # Clean up $path
   if ( ! $self->file_name_is_absolute( $path ) ) {
       $path = $self->rel2abs( $path ) ;
   } else {
       $path = $self->canonpath( $path ) ;
   }

   # Figure out the effective $base and clean it up.
   if ( !defined( $base ) || $base eq '' ) {
       $base = $self->_cwd();
   } elsif ( ! $self->file_name_is_absolute( $base ) ) {
       $base = $self->rel2abs( $base ) ;
   } else {
       $base = $self->canonpath( $base ) ;
   }

   # Split up paths
   my ( $path_volume, $path_directories, $path_file ) = $self->splitpath( $path, 1 ) ;
   my ( $base_volume, $base_directories ) = $self->splitpath( $base, 1 ) ;
   return $path unless $path_volume eq $base_volume;

   # Now, remove all leading components that are the same
   my @pathchunks = $self->splitdir( $path_directories );
   my @basechunks = $self->splitdir( $base_directories );

   while ( @pathchunks && 
           @basechunks && 
           lc( $pathchunks[0] ) eq lc( $basechunks[0] ) 
         ) {
       shift @pathchunks ;
       shift @basechunks ;
   }

   # No need to catdir, we know these are well formed.
   $path_directories = CORE::join( '/', @pathchunks );
   $base_directories = CORE::join( '/', @basechunks );

   # $base_directories now contains the directories the resulting relative
   # path must ascend out of before it can descend to $path_directory.  So, 
   # replace all names with $parentDir

   #FA Need to replace between backslashes...
   $base_directories =~ s|[^\\/]+|..|g ;

   # Glue the two together, using a separator if necessary, and preventing an
   # empty result.

   #FA Must check that new directories are not empty.
   if ( $path_directories ne '' && $base_directories ne '' ) {
       $path_directories = "$base_directories/$path_directories" ;
   } else {
       $path_directories = "$base_directories$path_directories" ;
   }

   return $self->canonpath( 
       $self->catpath( "", $path_directories, $path_file ) 
   ) ;
}


sub rel2abs {
   my ($self,$path,$base ) = @_;

   if ( ! $self->file_name_is_absolute( $path ) ) {

       if ( !defined( $base ) || $base eq '' ) {
           $base = $self->_cwd();
       }
       elsif ( ! $self->file_name_is_absolute( $base ) ) {
           $base = $self->rel2abs( $base ) ;
       }
       else {
           $base = $self->canonpath( $base ) ;
       }

       my ( $path_directories, $path_file ) =
           ($self->splitpath( $path, 1 ))[1,2] ;

       my ( $base_volume, $base_directories ) =
           $self->splitpath( $base, 1 ) ;

       $path = $self->catpath( 
           $base_volume, 
           $self->catdir( $base_directories, $path_directories ), 
           $path_file
       ) ;
   }

   return $self->canonpath( $path ) ;
}

1;
__END__

=head1 NAME

File::Spec::OS2 - methods for OS/2 file specs

=head1 SYNOPSIS

require File::Spec::OS2; # Done internally by File::Spec if needed

=head1 DESCRIPTION

See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
implementation of these methods, not the semantics.

Amongst the changes made for OS/2 are...

=over 4

=item tmpdir

Modifies the list of places temp directory information is looked for.

   $ENV{TMPDIR}
   $ENV{TEMP}
   $ENV{TMP}
   /tmp
   /

=item splitpath

Volumes can be drive letters or UNC sharenames (\\server\share).

=back

=head1 COPYRIGHT

Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut