[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / 5.8.0 / File / Spec / OS2.pm

package File::Spec::OS2;

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

$VERSION = '1.1';

@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;
}

my $tmpdir;
sub tmpdir {
    return $tmpdir if defined $tmpdir;
    my $self = shift;
    my @dirlist = ( @ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /) );
    {
	no strict 'refs';
	if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
	    require Scalar::Util;
	    @dirlist = grep { ! Scalar::Util::tainted $_ } @dirlist;
	}
    }
    foreach (@dirlist) {
	next unless defined && -d;
	$tmpdir = $_;
	last;
    }
    $tmpdir = '' unless defined $tmpdir;
    $tmpdir =~ s:\\:/:g;
    $tmpdir = $self->canonpath($tmpdir);
    return $tmpdir;
}

=item canonpath

No physical check on the filesystem, but a logical cleanup of a
path. On UNIX eliminated successive slashes and successive "/.".

=cut

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
    return $path;
}

=item splitpath

    ($volume,$directories,$file) = File::Spec->splitpath( $path );
    ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );

Splits a path in to volume, directory, and filename portions. Assumes that 
the last file is a path unless the path ends in '/', '/.', '/..'
or $no_file is true.  On Win32 this means that $no_file true makes this return 
( $volume, $path, undef ).

Separators accepted are \ and /.

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

The results can be passed to L</catpath> to get back a path equivalent to
(usually identical to) the original path.

=cut

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);
}


=item splitdir

The opposite of L<catdir()|File::Spec/catdir()>.

    @dirs = File::Spec->splitdir( $directories );

$directories must be only the directory portion of the path on systems 
that have the concept of a volume or that have path syntax that differentiates
files from directories.

Unlike just splitting the directories on the separator, leading empty and 
trailing directory entries can be returned, because these are significant
on some OSs. So,

    File::Spec->splitdir( "/a/b//c/" );

Yields:

    ( '', 'a', 'b', '', 'c', '' )

=cut

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


=item catpath

Takes volume, directory and file portions and returns an entire path. Under
Unix, $volume is ignored, and this is just like catfile(). On other OSs,
the $volume become significant.

=cut

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 = Cwd::sys_cwd() ;
    } elsif ( ! $self->file_name_is_absolute( $base ) ) {
        $base = $self->rel2abs( $base ) ;
    } else {
        $base = $self->canonpath( $base ) ;
    }

    # Split up paths
    my ( undef, $path_directories, $path_file ) =
        $self->splitpath( $path, 1 ) ;

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

    # 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 = Cwd::sys_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 File::Spec::Unix for a documentation of the methods provided
there. This package overrides the implementation of these methods, not
the semantics.
Commit	Line	Data
86530b38 AT	1	package File::Spec::OS2;
	2
	3	use strict;
	4	use vars qw(@ISA $VERSION);
	5	require File::Spec::Unix;
	6
	7	$VERSION = '1.1';
	8
	9	@ISA = qw(File::Spec::Unix);
	10
	11	sub devnull {
	12	return "/dev/nul";
	13	}
	14
	15	sub case_tolerant {
	16	return 1;
	17	}
	18
	19	sub file_name_is_absolute {
	20	my ($self,$file) = @_;
	21	return scalar($file =~ m{^([a-z]:)?[\\/]}is);
	22	}
	23
	24	sub path {
	25	my $path = $ENV{PATH};
	26	$path =~ s:\\:/:g;
	27	my @path = split(';',$path);
	28	foreach (@path) { $_ = '.' if $_ eq '' }
	29	return @path;
	30	}
	31
	32	my $tmpdir;
	33	sub tmpdir {
	34	return $tmpdir if defined $tmpdir;
	35	my $self = shift;
	36	my @dirlist = ( @ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /) );
	37	{
	38	no strict 'refs';
	39	if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
	40	require Scalar::Util;
	41	@dirlist = grep { ! Scalar::Util::tainted $_ } @dirlist;
	42	}
	43	}
	44	foreach (@dirlist) {
	45	next unless defined && -d;
	46	$tmpdir = $_;
	47	last;
	48	}
	49	$tmpdir = '' unless defined $tmpdir;
	50	$tmpdir =~ s:\\:/:g;
	51	$tmpdir = $self->canonpath($tmpdir);
	52	return $tmpdir;
	53	}
	54
	55	=item canonpath
	56
	57	No physical check on the filesystem, but a logical cleanup of a
	58	path. On UNIX eliminated successive slashes and successive "/.".
	59
	60	=cut
	61
	62	sub canonpath {
	63	my ($self,$path) = @_;
	64	$path =~ s/^([a-z]:)/\l$1/s;
65	$path =~ s\|\\\|/\|g;
66	$path =~ s\|([^/])/+\|$1/\|g; # xx////xx -> xx/xx
67	$path =~ s\|(/\.)+/\|/\|g; # xx/././xx -> xx/xx
68	$path =~ s\|^(\./)+(?=[^/])\|\|s; # ./xx -> xx
69	$path =~ s\|/\Z(?!\n)\|\|
70	unless $path =~ m#^([a-z]:)?/\Z(?!\n)#si;# xx/ -> xx
71	return $path;
72	}
73
74	=item splitpath
75
76	($volume,$directories,$file) = File::Spec->splitpath( $path );
77	($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
78
79	Splits a path in to volume, directory, and filename portions. Assumes that
80	the last file is a path unless the path ends in '/', '/.', '/..'
81	or $no_file is true. On Win32 this means that $no_file true makes this return
82	( $volume, $path, undef ).
83
84	Separators accepted are \ and /.
85
86	Volumes can be drive letters or UNC sharenames (\\server\share).
87
88	The results can be passed to L</catpath> to get back a path equivalent to
89	(usually identical to) the original path.
90
91	=cut
92
93	sub splitpath {
94	my ($self,$path, $nofile) = @_;
95	my ($volume,$directory,$file) = ('','','');
96	if ( $nofile ) {
97	$path =~
98	m{^( (?:[a-zA-Z]:\|(?:\\\\\|//)[^\\/]+[\\/][^\\/]+)? )
99	(.*)
100	}xs;
101	$volume = $1;
102	$directory = $2;
103	}
104	else {
105	$path =~
106	m{^ ( (?: [a-zA-Z]: \|
107	(?:\\\\\|//)[^\\/]+[\\/][^\\/]+
108	)?
109	)
110	( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
111	(.*)
112	}xs;
113	$volume = $1;
114	$directory = $2;
115	$file = $3;
116	}
117
118	return ($volume,$directory,$file);
119	}
120
121
122	=item splitdir
123
124	The opposite of L<catdir()\|File::Spec/catdir()>.
125
126	@dirs = File::Spec->splitdir( $directories );
127
128	$directories must be only the directory portion of the path on systems
129	that have the concept of a volume or that have path syntax that differentiates
130	files from directories.
131
132	Unlike just splitting the directories on the separator, leading empty and
133	trailing directory entries can be returned, because these are significant
134	on some OSs. So,
135
136	File::Spec->splitdir( "/a/b//c/" );
137
138	Yields:
139
140	( '', 'a', 'b', '', 'c', '' )
141
142	=cut
143
144	sub splitdir {
145	my ($self,$directories) = @_ ;
146	split m\|[\\/]\|, $directories, -1;
147	}
148
149
150	=item catpath
151
152	Takes volume, directory and file portions and returns an entire path. Under
153	Unix, $volume is ignored, and this is just like catfile(). On other OSs,
154	the $volume become significant.
155
156	=cut
157
158	sub catpath {
159	my ($self,$volume,$directory,$file) = @_;
160
161	# If it's UNC, make sure the glue separator is there, reusing
162	# whatever separator is first in the $volume
163	$volume .= $1
164	if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
165	$directory =~ m@^[^\\/]@s
166	) ;
167
168	$volume .= $directory ;
169
170	# If the volume is not just A:, make sure the glue separator is
171	# there, reusing whatever separator is first in the $volume if possible.
172	if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
173	$volume =~ m@[^\\/]\Z(?!\n)@ &&
174	$file =~ m@[^\\/]@
175	) {
176	$volume =~ m@([\\/])@ ;
177	my $sep = $1 ? $1 : '/' ;
178	$volume .= $sep ;
179	}
180
181	$volume .= $file ;
182
183	return $volume ;
184	}
185
186
187	sub abs2rel {
188	my($self,$path,$base) = @_;
189
190	# Clean up $path
191	if ( ! $self->file_name_is_absolute( $path ) ) {
192	$path = $self->rel2abs( $path ) ;
193	} else {
194	$path = $self->canonpath( $path ) ;
195	}
196
197	# Figure out the effective $base and clean it up.
198	if ( !defined( $base ) \|\| $base eq '' ) {
199	$base = Cwd::sys_cwd() ;
200	} elsif ( ! $self->file_name_is_absolute( $base ) ) {
201	$base = $self->rel2abs( $base ) ;
202	} else {
203	$base = $self->canonpath( $base ) ;
204	}
205
206	# Split up paths
207	my ( undef, $path_directories, $path_file ) =
208	$self->splitpath( $path, 1 ) ;
209
210	my $base_directories = ($self->splitpath( $base, 1 ))[1] ;
211
212	# Now, remove all leading components that are the same
213	my @pathchunks = $self->splitdir( $path_directories );
214	my @basechunks = $self->splitdir( $base_directories );
215
216	while ( @pathchunks &&
217	@basechunks &&
218	lc( $pathchunks[0] ) eq lc( $basechunks[0] )
219	) {
220	shift @pathchunks ;
221	shift @basechunks ;
222	}
223
224	# No need to catdir, we know these are well formed.
225	$path_directories = CORE::join( '/', @pathchunks );
226	$base_directories = CORE::join( '/', @basechunks );
227
228	# $base_directories now contains the directories the resulting relative
229	# path must ascend out of before it can descend to $path_directory. So,
230	# replace all names with $parentDir
231
232	#FA Need to replace between backslashes...
233	$base_directories =~ s\|[^\\/]+\|..\|g ;
234
235	# Glue the two together, using a separator if necessary, and preventing an
236	# empty result.
237
238	#FA Must check that new directories are not empty.
239	if ( $path_directories ne '' && $base_directories ne '' ) {
240	$path_directories = "$base_directories/$path_directories" ;
241	} else {
242	$path_directories = "$base_directories$path_directories" ;
243	}
244
245	return $self->canonpath(
246	$self->catpath( "", $path_directories, $path_file )
247	) ;
248	}
249
250
251	sub rel2abs {
252	my ($self,$path,$base ) = @_;
253
254	if ( ! $self->file_name_is_absolute( $path ) ) {
255
256	if ( !defined( $base ) \|\| $base eq '' ) {
257	$base = Cwd::sys_cwd() ;
258	}
259	elsif ( ! $self->file_name_is_absolute( $base ) ) {
260	$base = $self->rel2abs( $base ) ;
261	}
262	else {
263	$base = $self->canonpath( $base ) ;
264	}
265
266	my ( $path_directories, $path_file ) =
267	($self->splitpath( $path, 1 ))[1,2] ;
268
269	my ( $base_volume, $base_directories ) =
270	$self->splitpath( $base, 1 ) ;
271
272	$path = $self->catpath(
273	$base_volume,
274	$self->catdir( $base_directories, $path_directories ),
275	$path_file
276	) ;
277	}
278
279	return $self->canonpath( $path ) ;
280	}
281
282	1;
283	__END__
284
285	=head1 NAME
286
287	File::Spec::OS2 - methods for OS/2 file specs
288
289	=head1 SYNOPSIS
290
291	require File::Spec::OS2; # Done internally by File::Spec if needed
292
293	=head1 DESCRIPTION
294
295	See File::Spec::Unix for a documentation of the methods provided
296	there. This package overrides the implementation of these methods, not
297	the semantics.