1*0Sstevel@tonic-gatepackage File::Spec::OS2; 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateuse strict; 4*0Sstevel@tonic-gateuse vars qw(@ISA $VERSION); 5*0Sstevel@tonic-gaterequire File::Spec::Unix; 6*0Sstevel@tonic-gate 7*0Sstevel@tonic-gate$VERSION = '1.2'; 8*0Sstevel@tonic-gate 9*0Sstevel@tonic-gate@ISA = qw(File::Spec::Unix); 10*0Sstevel@tonic-gate 11*0Sstevel@tonic-gatesub devnull { 12*0Sstevel@tonic-gate return "/dev/nul"; 13*0Sstevel@tonic-gate} 14*0Sstevel@tonic-gate 15*0Sstevel@tonic-gatesub case_tolerant { 16*0Sstevel@tonic-gate return 1; 17*0Sstevel@tonic-gate} 18*0Sstevel@tonic-gate 19*0Sstevel@tonic-gatesub file_name_is_absolute { 20*0Sstevel@tonic-gate my ($self,$file) = @_; 21*0Sstevel@tonic-gate return scalar($file =~ m{^([a-z]:)?[\\/]}is); 22*0Sstevel@tonic-gate} 23*0Sstevel@tonic-gate 24*0Sstevel@tonic-gatesub path { 25*0Sstevel@tonic-gate my $path = $ENV{PATH}; 26*0Sstevel@tonic-gate $path =~ s:\\:/:g; 27*0Sstevel@tonic-gate my @path = split(';',$path); 28*0Sstevel@tonic-gate foreach (@path) { $_ = '.' if $_ eq '' } 29*0Sstevel@tonic-gate return @path; 30*0Sstevel@tonic-gate} 31*0Sstevel@tonic-gate 32*0Sstevel@tonic-gatesub _cwd { 33*0Sstevel@tonic-gate # In OS/2 the "require Cwd" is unnecessary bloat. 34*0Sstevel@tonic-gate return Cwd::sys_cwd(); 35*0Sstevel@tonic-gate} 36*0Sstevel@tonic-gate 37*0Sstevel@tonic-gatemy $tmpdir; 38*0Sstevel@tonic-gatesub tmpdir { 39*0Sstevel@tonic-gate return $tmpdir if defined $tmpdir; 40*0Sstevel@tonic-gate my $self = shift; 41*0Sstevel@tonic-gate $tmpdir = $self->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)}, 42*0Sstevel@tonic-gate '/tmp', 43*0Sstevel@tonic-gate '/' ); 44*0Sstevel@tonic-gate} 45*0Sstevel@tonic-gate 46*0Sstevel@tonic-gatesub catdir { 47*0Sstevel@tonic-gate my $self = shift; 48*0Sstevel@tonic-gate my @args = @_; 49*0Sstevel@tonic-gate foreach (@args) { 50*0Sstevel@tonic-gate tr[\\][/]; 51*0Sstevel@tonic-gate # append a backslash to each argument unless it has one there 52*0Sstevel@tonic-gate $_ .= "/" unless m{/$}; 53*0Sstevel@tonic-gate } 54*0Sstevel@tonic-gate return $self->canonpath(join('', @args)); 55*0Sstevel@tonic-gate} 56*0Sstevel@tonic-gate 57*0Sstevel@tonic-gatesub canonpath { 58*0Sstevel@tonic-gate my ($self,$path) = @_; 59*0Sstevel@tonic-gate $path =~ s/^([a-z]:)/\l$1/s; 60*0Sstevel@tonic-gate $path =~ s|\\|/|g; 61*0Sstevel@tonic-gate $path =~ s|([^/])/+|$1/|g; # xx////xx -> xx/xx 62*0Sstevel@tonic-gate $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx 63*0Sstevel@tonic-gate $path =~ s|^(\./)+(?=[^/])||s; # ./xx -> xx 64*0Sstevel@tonic-gate $path =~ s|/\Z(?!\n)|| 65*0Sstevel@tonic-gate unless $path =~ m#^([a-z]:)?/\Z(?!\n)#si;# xx/ -> xx 66*0Sstevel@tonic-gate $path =~ s{^/\.\.$}{/}; # /.. -> / 67*0Sstevel@tonic-gate 1 while $path =~ s{^/\.\.}{}; # /../xx -> /xx 68*0Sstevel@tonic-gate return $path; 69*0Sstevel@tonic-gate} 70*0Sstevel@tonic-gate 71*0Sstevel@tonic-gate 72*0Sstevel@tonic-gatesub splitpath { 73*0Sstevel@tonic-gate my ($self,$path, $nofile) = @_; 74*0Sstevel@tonic-gate my ($volume,$directory,$file) = ('','',''); 75*0Sstevel@tonic-gate if ( $nofile ) { 76*0Sstevel@tonic-gate $path =~ 77*0Sstevel@tonic-gate m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) 78*0Sstevel@tonic-gate (.*) 79*0Sstevel@tonic-gate }xs; 80*0Sstevel@tonic-gate $volume = $1; 81*0Sstevel@tonic-gate $directory = $2; 82*0Sstevel@tonic-gate } 83*0Sstevel@tonic-gate else { 84*0Sstevel@tonic-gate $path =~ 85*0Sstevel@tonic-gate m{^ ( (?: [a-zA-Z]: | 86*0Sstevel@tonic-gate (?:\\\\|//)[^\\/]+[\\/][^\\/]+ 87*0Sstevel@tonic-gate )? 88*0Sstevel@tonic-gate ) 89*0Sstevel@tonic-gate ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? ) 90*0Sstevel@tonic-gate (.*) 91*0Sstevel@tonic-gate }xs; 92*0Sstevel@tonic-gate $volume = $1; 93*0Sstevel@tonic-gate $directory = $2; 94*0Sstevel@tonic-gate $file = $3; 95*0Sstevel@tonic-gate } 96*0Sstevel@tonic-gate 97*0Sstevel@tonic-gate return ($volume,$directory,$file); 98*0Sstevel@tonic-gate} 99*0Sstevel@tonic-gate 100*0Sstevel@tonic-gate 101*0Sstevel@tonic-gatesub splitdir { 102*0Sstevel@tonic-gate my ($self,$directories) = @_ ; 103*0Sstevel@tonic-gate split m|[\\/]|, $directories, -1; 104*0Sstevel@tonic-gate} 105*0Sstevel@tonic-gate 106*0Sstevel@tonic-gate 107*0Sstevel@tonic-gatesub catpath { 108*0Sstevel@tonic-gate my ($self,$volume,$directory,$file) = @_; 109*0Sstevel@tonic-gate 110*0Sstevel@tonic-gate # If it's UNC, make sure the glue separator is there, reusing 111*0Sstevel@tonic-gate # whatever separator is first in the $volume 112*0Sstevel@tonic-gate $volume .= $1 113*0Sstevel@tonic-gate if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s && 114*0Sstevel@tonic-gate $directory =~ m@^[^\\/]@s 115*0Sstevel@tonic-gate ) ; 116*0Sstevel@tonic-gate 117*0Sstevel@tonic-gate $volume .= $directory ; 118*0Sstevel@tonic-gate 119*0Sstevel@tonic-gate # If the volume is not just A:, make sure the glue separator is 120*0Sstevel@tonic-gate # there, reusing whatever separator is first in the $volume if possible. 121*0Sstevel@tonic-gate if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s && 122*0Sstevel@tonic-gate $volume =~ m@[^\\/]\Z(?!\n)@ && 123*0Sstevel@tonic-gate $file =~ m@[^\\/]@ 124*0Sstevel@tonic-gate ) { 125*0Sstevel@tonic-gate $volume =~ m@([\\/])@ ; 126*0Sstevel@tonic-gate my $sep = $1 ? $1 : '/' ; 127*0Sstevel@tonic-gate $volume .= $sep ; 128*0Sstevel@tonic-gate } 129*0Sstevel@tonic-gate 130*0Sstevel@tonic-gate $volume .= $file ; 131*0Sstevel@tonic-gate 132*0Sstevel@tonic-gate return $volume ; 133*0Sstevel@tonic-gate} 134*0Sstevel@tonic-gate 135*0Sstevel@tonic-gate 136*0Sstevel@tonic-gatesub abs2rel { 137*0Sstevel@tonic-gate my($self,$path,$base) = @_; 138*0Sstevel@tonic-gate 139*0Sstevel@tonic-gate # Clean up $path 140*0Sstevel@tonic-gate if ( ! $self->file_name_is_absolute( $path ) ) { 141*0Sstevel@tonic-gate $path = $self->rel2abs( $path ) ; 142*0Sstevel@tonic-gate } else { 143*0Sstevel@tonic-gate $path = $self->canonpath( $path ) ; 144*0Sstevel@tonic-gate } 145*0Sstevel@tonic-gate 146*0Sstevel@tonic-gate # Figure out the effective $base and clean it up. 147*0Sstevel@tonic-gate if ( !defined( $base ) || $base eq '' ) { 148*0Sstevel@tonic-gate $base = $self->_cwd(); 149*0Sstevel@tonic-gate } elsif ( ! $self->file_name_is_absolute( $base ) ) { 150*0Sstevel@tonic-gate $base = $self->rel2abs( $base ) ; 151*0Sstevel@tonic-gate } else { 152*0Sstevel@tonic-gate $base = $self->canonpath( $base ) ; 153*0Sstevel@tonic-gate } 154*0Sstevel@tonic-gate 155*0Sstevel@tonic-gate # Split up paths 156*0Sstevel@tonic-gate my ( $path_volume, $path_directories, $path_file ) = $self->splitpath( $path, 1 ) ; 157*0Sstevel@tonic-gate my ( $base_volume, $base_directories ) = $self->splitpath( $base, 1 ) ; 158*0Sstevel@tonic-gate return $path unless $path_volume eq $base_volume; 159*0Sstevel@tonic-gate 160*0Sstevel@tonic-gate # Now, remove all leading components that are the same 161*0Sstevel@tonic-gate my @pathchunks = $self->splitdir( $path_directories ); 162*0Sstevel@tonic-gate my @basechunks = $self->splitdir( $base_directories ); 163*0Sstevel@tonic-gate 164*0Sstevel@tonic-gate while ( @pathchunks && 165*0Sstevel@tonic-gate @basechunks && 166*0Sstevel@tonic-gate lc( $pathchunks[0] ) eq lc( $basechunks[0] ) 167*0Sstevel@tonic-gate ) { 168*0Sstevel@tonic-gate shift @pathchunks ; 169*0Sstevel@tonic-gate shift @basechunks ; 170*0Sstevel@tonic-gate } 171*0Sstevel@tonic-gate 172*0Sstevel@tonic-gate # No need to catdir, we know these are well formed. 173*0Sstevel@tonic-gate $path_directories = CORE::join( '/', @pathchunks ); 174*0Sstevel@tonic-gate $base_directories = CORE::join( '/', @basechunks ); 175*0Sstevel@tonic-gate 176*0Sstevel@tonic-gate # $base_directories now contains the directories the resulting relative 177*0Sstevel@tonic-gate # path must ascend out of before it can descend to $path_directory. So, 178*0Sstevel@tonic-gate # replace all names with $parentDir 179*0Sstevel@tonic-gate 180*0Sstevel@tonic-gate #FA Need to replace between backslashes... 181*0Sstevel@tonic-gate $base_directories =~ s|[^\\/]+|..|g ; 182*0Sstevel@tonic-gate 183*0Sstevel@tonic-gate # Glue the two together, using a separator if necessary, and preventing an 184*0Sstevel@tonic-gate # empty result. 185*0Sstevel@tonic-gate 186*0Sstevel@tonic-gate #FA Must check that new directories are not empty. 187*0Sstevel@tonic-gate if ( $path_directories ne '' && $base_directories ne '' ) { 188*0Sstevel@tonic-gate $path_directories = "$base_directories/$path_directories" ; 189*0Sstevel@tonic-gate } else { 190*0Sstevel@tonic-gate $path_directories = "$base_directories$path_directories" ; 191*0Sstevel@tonic-gate } 192*0Sstevel@tonic-gate 193*0Sstevel@tonic-gate return $self->canonpath( 194*0Sstevel@tonic-gate $self->catpath( "", $path_directories, $path_file ) 195*0Sstevel@tonic-gate ) ; 196*0Sstevel@tonic-gate} 197*0Sstevel@tonic-gate 198*0Sstevel@tonic-gate 199*0Sstevel@tonic-gatesub rel2abs { 200*0Sstevel@tonic-gate my ($self,$path,$base ) = @_; 201*0Sstevel@tonic-gate 202*0Sstevel@tonic-gate if ( ! $self->file_name_is_absolute( $path ) ) { 203*0Sstevel@tonic-gate 204*0Sstevel@tonic-gate if ( !defined( $base ) || $base eq '' ) { 205*0Sstevel@tonic-gate $base = $self->_cwd(); 206*0Sstevel@tonic-gate } 207*0Sstevel@tonic-gate elsif ( ! $self->file_name_is_absolute( $base ) ) { 208*0Sstevel@tonic-gate $base = $self->rel2abs( $base ) ; 209*0Sstevel@tonic-gate } 210*0Sstevel@tonic-gate else { 211*0Sstevel@tonic-gate $base = $self->canonpath( $base ) ; 212*0Sstevel@tonic-gate } 213*0Sstevel@tonic-gate 214*0Sstevel@tonic-gate my ( $path_directories, $path_file ) = 215*0Sstevel@tonic-gate ($self->splitpath( $path, 1 ))[1,2] ; 216*0Sstevel@tonic-gate 217*0Sstevel@tonic-gate my ( $base_volume, $base_directories ) = 218*0Sstevel@tonic-gate $self->splitpath( $base, 1 ) ; 219*0Sstevel@tonic-gate 220*0Sstevel@tonic-gate $path = $self->catpath( 221*0Sstevel@tonic-gate $base_volume, 222*0Sstevel@tonic-gate $self->catdir( $base_directories, $path_directories ), 223*0Sstevel@tonic-gate $path_file 224*0Sstevel@tonic-gate ) ; 225*0Sstevel@tonic-gate } 226*0Sstevel@tonic-gate 227*0Sstevel@tonic-gate return $self->canonpath( $path ) ; 228*0Sstevel@tonic-gate} 229*0Sstevel@tonic-gate 230*0Sstevel@tonic-gate1; 231*0Sstevel@tonic-gate__END__ 232*0Sstevel@tonic-gate 233*0Sstevel@tonic-gate=head1 NAME 234*0Sstevel@tonic-gate 235*0Sstevel@tonic-gateFile::Spec::OS2 - methods for OS/2 file specs 236*0Sstevel@tonic-gate 237*0Sstevel@tonic-gate=head1 SYNOPSIS 238*0Sstevel@tonic-gate 239*0Sstevel@tonic-gate require File::Spec::OS2; # Done internally by File::Spec if needed 240*0Sstevel@tonic-gate 241*0Sstevel@tonic-gate=head1 DESCRIPTION 242*0Sstevel@tonic-gate 243*0Sstevel@tonic-gateSee L<File::Spec> and L<File::Spec::Unix>. This package overrides the 244*0Sstevel@tonic-gateimplementation of these methods, not the semantics. 245*0Sstevel@tonic-gate 246*0Sstevel@tonic-gateAmongst the changes made for OS/2 are... 247*0Sstevel@tonic-gate 248*0Sstevel@tonic-gate=over 4 249*0Sstevel@tonic-gate 250*0Sstevel@tonic-gate=item tmpdir 251*0Sstevel@tonic-gate 252*0Sstevel@tonic-gateModifies the list of places temp directory information is looked for. 253*0Sstevel@tonic-gate 254*0Sstevel@tonic-gate $ENV{TMPDIR} 255*0Sstevel@tonic-gate $ENV{TEMP} 256*0Sstevel@tonic-gate $ENV{TMP} 257*0Sstevel@tonic-gate /tmp 258*0Sstevel@tonic-gate / 259*0Sstevel@tonic-gate 260*0Sstevel@tonic-gate=item splitpath 261*0Sstevel@tonic-gate 262*0Sstevel@tonic-gateVolumes can be drive letters or UNC sharenames (\\server\share). 263*0Sstevel@tonic-gate 264*0Sstevel@tonic-gate=back 265*0Sstevel@tonic-gate 266*0Sstevel@tonic-gate=cut 267