[catagits/Gitalist.git] / local-lib5 / lib / perl5 / i486-linux-gnu-thread-multi / File / Spec / Win32.pm

package File::Spec::Win32;

use strict;

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

$VERSION = '3.30';
$VERSION = eval $VERSION;

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

# Some regexes we use for path splitting
my $DRIVE_RX = '[a-zA-Z]:';
my $UNC_RX = '(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+';
my $VOL_RX = "(?:$DRIVE_RX|$UNC_RX)";


=head1 NAME

File::Spec::Win32 - methods for Win32 file specs

=head1 SYNOPSIS

 require File::Spec::Win32; # 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.

=over 4

=item devnull

Returns a string representation of the null device.

=cut

sub devnull {
    return "nul";
}

sub rootdir { '\\' }


=item tmpdir

Returns a string representation of the first existing directory
from the following list:

    $ENV{TMPDIR}
    $ENV{TEMP}
    $ENV{TMP}
    SYS:/temp
    C:\system\temp
    C:/temp
    /tmp
    /

The SYS:/temp is preferred in Novell NetWare and the C:\system\temp
for Symbian (the File::Spec::Win32 is used also for those platforms).

Since Perl 5.8.0, if running under taint mode, and if the environment
variables are tainted, they are not used.

=cut

my $tmpdir;
sub tmpdir {
    return $tmpdir if defined $tmpdir;
    $tmpdir = $_[0]->_tmpdir( map( $ENV{$_}, qw(TMPDIR TEMP TMP) ),
			      'SYS:/temp',
			      'C:\system\temp',
			      'C:/temp',
			      '/tmp',
			      '/'  );
}

=item case_tolerant

MSWin32 case-tolerance depends on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE,
indicating the case significance when comparing file specifications.
Since XP FS_CASE_SENSITIVE is effectively disabled for the NT subsubsystem.
See http://cygwin.com/ml/cygwin/2007-07/msg00891.html
Default: 1

=cut

sub case_tolerant {
  eval { require Win32API::File; } or return 1;
  my $drive = shift || "C:";
  my $osFsType = "\0"x256;
  my $osVolName = "\0"x256;
  my $ouFsFlags = 0;
  Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 );
  if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; }
  else { return 1; }
}

=item file_name_is_absolute

As of right now, this returns 2 if the path is absolute with a
volume, 1 if it's absolute with no volume, 0 otherwise.

=cut

sub file_name_is_absolute {

    my ($self,$file) = @_;

    if ($file =~ m{^($VOL_RX)}o) {
      my $vol = $1;
      return ($vol =~ m{^$UNC_RX}o ? 2
	      : $file =~ m{^$DRIVE_RX[\\/]}o ? 2
	      : 0);
    }
    return $file =~  m{^[\\/]} ? 1 : 0;
}

=item catfile

Concatenate one or more directory names and a filename to form a
complete path ending with a filename

=cut

sub catfile {
    shift;

    # Legacy / compatibility support
    #
    shift, return _canon_cat( "/", @_ )
	if $_[0] eq "";

    # Compatibility with File::Spec <= 3.26:
    #     catfile('A:', 'foo') should return 'A:\foo'.
    return _canon_cat( ($_[0].'\\'), @_[1..$#_] )
        if $_[0] =~ m{^$DRIVE_RX\z}o;

    return _canon_cat( @_ );
}

sub catdir {
    shift;

    # Legacy / compatibility support
    #
    return ""
    	unless @_;
    shift, return _canon_cat( "/", @_ )
	if $_[0] eq "";

    # Compatibility with File::Spec <= 3.26:
    #     catdir('A:', 'foo') should return 'A:\foo'.
    return _canon_cat( ($_[0].'\\'), @_[1..$#_] )
        if $_[0] =~ m{^$DRIVE_RX\z}o;

    return _canon_cat( @_ );
}

sub path {
    my @path = split(';', $ENV{PATH});
    s/"//g for @path;
    @path = grep length, @path;
    unshift(@path, ".");
    return @path;
}

=item canonpath

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

	dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even
	dir1\dir2\dir3\...\dir4   -> \dir\dir4

=cut

sub canonpath {
    # Legacy / compatibility support
    #
    return $_[1] if !defined($_[1]) or $_[1] eq '';
    return _canon_cat( $_[1] );
}

=item splitpath

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

Splits a path into 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, '' ).

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{^ ( $VOL_RX ? ) (.*) }sox;
        $volume    = $1;
        $directory = $2;
    }
    else {
        $path =~ 
            m{^ ( $VOL_RX ? )
                ( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? )
                (.*)
             }sox;
        $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() likes to forget about trailing null fields, so here we
    # check to be sure that there will not be any before handling the
    # simple case.
    #
    if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
        return split( m|[\\/]|, $directories );
    }
    else {
        #
        # since there was a trailing separator, add a file name to the end, 
        # then do the split, then replace it with ''.
        #
        my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
        $directories[ $#directories ]= '' ;
        return @directories ;
    }
}


=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
    my $v;
    $volume .= $v
        if ( (($v) = $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 _same {
  lc($_[1]) eq lc($_[2]);
}

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

    my $is_abs = $self->file_name_is_absolute($path);

    # Check for volume (should probably document the '2' thing...)
    return $self->canonpath( $path ) if $is_abs == 2;

    if ($is_abs) {
      # It's missing a volume, add one
      my $vol = ($self->splitpath( $self->_cwd() ))[0];
      return $self->canonpath( $vol . $path );
    }

    if ( !defined( $base ) || $base eq '' ) {
      require Cwd ;
      $base = Cwd::getdcwd( ($self->splitpath( $path ))[0] ) if defined &Cwd::getdcwd ;
      $base = $self->_cwd() unless defined $base ;
    }
    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 ) ;
}

=back

=head2 Note For File::Spec::Win32 Maintainers

Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32.

=head1 COPYRIGHT

Copyright (c) 2004,2007 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.

=head1 SEE ALSO

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

=cut


sub _canon_cat				# @path -> path
{
    my ($first, @rest) = @_;

    my $volume = $first =~ s{ \A ([A-Za-z]:) ([\\/]?) }{}x	# drive letter
    	       ? ucfirst( $1 ).( $2 ? "\\" : "" )
	       : $first =~ s{ \A (?:\\\\|//) ([^\\/]+)
				 (?: [\\/] ([^\\/]+) )?
	       			 [\\/]? }{}xs			# UNC volume
	       ? "\\\\$1".( defined $2 ? "\\$2" : "" )."\\"
	       : $first =~ s{ \A [\\/] }{}x			# root dir
	       ? "\\"
	       : "";
    my $path   = join "\\", $first, @rest;

    $path =~ tr#\\/#\\\\#s;		# xx/yy --> xx\yy & xx\\yy --> xx\yy

    					# xx/././yy --> xx/yy
    $path =~ s{(?:
		(?:\A|\\)		# at begin or after a slash
		\.
		(?:\\\.)*		# and more
		(?:\\|\z) 		# at end or followed by slash
	       )+			# performance boost -- I do not know why
	     }{\\}gx;

    # XXX I do not know whether more dots are supported by the OS supporting
    #     this ... annotation (NetWare or symbian but not MSWin32).
    #     Then .... could easily become ../../.. etc:
    # Replace \.\.\. by (\.\.\.+)  and substitute with
    # { $1 . ".." . "\\.." x (length($2)-2) }gex
	     				# ... --> ../..
    $path =~ s{ (\A|\\)			# at begin or after a slash
    		\.\.\.
		(?=\\|\z) 		# at end or followed by slash
	     }{$1..\\..}gx;
    					# xx\yy\..\zz --> xx\zz
    while ( $path =~ s{(?:
		(?:\A|\\)		# at begin or after a slash
		[^\\]+			# rip this 'yy' off
		\\\.\.
		(?<!\A\.\.\\\.\.)	# do *not* replace ^..\..
		(?<!\\\.\.\\\.\.)	# do *not* replace \..\..
		(?:\\|\z) 		# at end or followed by slash
	       )+			# performance boost -- I do not know why
	     }{\\}sx ) {}

    $path =~ s#\A\\##;			# \xx --> xx  NOTE: this is *not* root
    $path =~ s#\\\z##;			# xx\ --> xx

    if ( $volume =~ m#\\\z# )
    {					# <vol>\.. --> <vol>\
	$path =~ s{ \A			# at begin
		    \.\.
		    (?:\\\.\.)*		# and more
		    (?:\\|\z) 		# at end or followed by slash
		 }{}x;

	return $1			# \\HOST\SHARE\ --> \\HOST\SHARE
	    if    $path eq ""
	      and $volume =~ m#\A(\\\\.*)\\\z#s;
    }
    return $path ne "" || $volume ? $volume.$path : ".";
}

1;
Commit	Line	Data
3fea05b9	1	package File::Spec::Win32;
	2
	3	use strict;
	4
	5	use vars qw(@ISA $VERSION);
	6	require File::Spec::Unix;
	7
	8	$VERSION = '3.30';
	9	$VERSION = eval $VERSION;
	10
	11	@ISA = qw(File::Spec::Unix);
	12
	13	# Some regexes we use for path splitting
	14	my $DRIVE_RX = '[a-zA-Z]:';
	15	my $UNC_RX = '(?:\\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+';
	16	my $VOL_RX = "(?:$DRIVE_RX\|$UNC_RX)";
	17
	18
	19	=head1 NAME
	20
	21	File::Spec::Win32 - methods for Win32 file specs
	22
	23	=head1 SYNOPSIS
	24
	25	require File::Spec::Win32; # Done internally by File::Spec if needed
	26
	27	=head1 DESCRIPTION
	28
	29	See File::Spec::Unix for a documentation of the methods provided
	30	there. This package overrides the implementation of these methods, not
	31	the semantics.
	32
	33	=over 4
	34
	35	=item devnull
	36
	37	Returns a string representation of the null device.
	38
	39	=cut
	40
	41	sub devnull {
	42	return "nul";
	43	}
	44
	45	sub rootdir { '\\' }
	46
	47
	48	=item tmpdir
	49
	50	Returns a string representation of the first existing directory
	51	from the following list:
	52
	53	$ENV{TMPDIR}
	54	$ENV{TEMP}
	55	$ENV{TMP}
	56	SYS:/temp
	57	C:\system\temp
	58	C:/temp
	59	/tmp
	60	/
	61
	62	The SYS:/temp is preferred in Novell NetWare and the C:\system\temp
	63	for Symbian (the File::Spec::Win32 is used also for those platforms).
	64
65	Since Perl 5.8.0, if running under taint mode, and if the environment
66	variables are tainted, they are not used.
67
68	=cut
69
70	my $tmpdir;
71	sub tmpdir {
72	return $tmpdir if defined $tmpdir;
73	$tmpdir = $_[0]->_tmpdir( map( $ENV{$_}, qw(TMPDIR TEMP TMP) ),
74	'SYS:/temp',
75	'C:\system\temp',
76	'C:/temp',
77	'/tmp',
78	'/' );
79	}
80
81	=item case_tolerant
82
83	MSWin32 case-tolerance depends on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE,
84	indicating the case significance when comparing file specifications.
85	Since XP FS_CASE_SENSITIVE is effectively disabled for the NT subsubsystem.
86	See http://cygwin.com/ml/cygwin/2007-07/msg00891.html
87	Default: 1
88
89	=cut
90
91	sub case_tolerant {
92	eval { require Win32API::File; } or return 1;
93	my $drive = shift \|\| "C:";
94	my $osFsType = "\0"x256;
95	my $osVolName = "\0"x256;
96	my $ouFsFlags = 0;
97	Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 );
98	if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; }
99	else { return 1; }
100	}
101
102	=item file_name_is_absolute
103
104	As of right now, this returns 2 if the path is absolute with a
105	volume, 1 if it's absolute with no volume, 0 otherwise.
106
107	=cut
108
109	sub file_name_is_absolute {
110
111	my ($self,$file) = @_;
112
113	if ($file =~ m{^($VOL_RX)}o) {
114	my $vol = $1;
115	return ($vol =~ m{^$UNC_RX}o ? 2
116	: $file =~ m{^$DRIVE_RX[\\/]}o ? 2
117	: 0);
118	}
119	return $file =~ m{^[\\/]} ? 1 : 0;
120	}
121
122	=item catfile
123
124	Concatenate one or more directory names and a filename to form a
125	complete path ending with a filename
126
127	=cut
128
129	sub catfile {
130	shift;
131
132	# Legacy / compatibility support
133	#
134	shift, return _canon_cat( "/", @_ )
135	if $_[0] eq "";
136
137	# Compatibility with File::Spec <= 3.26:
138	# catfile('A:', 'foo') should return 'A:\foo'.
139	return _canon_cat( ($_[0].'\\'), @_[1..$#_] )
140	if $_[0] =~ m{^$DRIVE_RX\z}o;
141
142	return _canon_cat( @_ );
143	}
144
145	sub catdir {
146	shift;
147
148	# Legacy / compatibility support
149	#
150	return ""
151	unless @_;
152	shift, return _canon_cat( "/", @_ )
153	if $_[0] eq "";
154
155	# Compatibility with File::Spec <= 3.26:
156	# catdir('A:', 'foo') should return 'A:\foo'.
157	return _canon_cat( ($_[0].'\\'), @_[1..$#_] )
158	if $_[0] =~ m{^$DRIVE_RX\z}o;
159
160	return _canon_cat( @_ );
161	}
162
163	sub path {
164	my @path = split(';', $ENV{PATH});
165	s/"//g for @path;
166	@path = grep length, @path;
167	unshift(@path, ".");
168	return @path;
169	}
170
171	=item canonpath
172
173	No physical check on the filesystem, but a logical cleanup of a
174	path. On UNIX eliminated successive slashes and successive "/.".
175	On Win32 makes
176
177	dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even
178	dir1\dir2\dir3\...\dir4 -> \dir\dir4
179
180	=cut
181
182	sub canonpath {
183	# Legacy / compatibility support
184	#
185	return $_[1] if !defined($_[1]) or $_[1] eq '';
186	return _canon_cat( $_[1] );
187	}
188
189	=item splitpath
190
191	($volume,$directories,$file) = File::Spec->splitpath( $path );
192	($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
193
194	Splits a path into volume, directory, and filename portions. Assumes that
195	the last file is a path unless the path ends in '\\', '\\.', '\\..'
196	or $no_file is true. On Win32 this means that $no_file true makes this return
197	( $volume, $path, '' ).
198
199	Separators accepted are \ and /.
200
201	Volumes can be drive letters or UNC sharenames (\\server\share).
202
203	The results can be passed to L</catpath> to get back a path equivalent to
204	(usually identical to) the original path.
205
206	=cut
207
208	sub splitpath {
209	my ($self,$path, $nofile) = @_;
210	my ($volume,$directory,$file) = ('','','');
211	if ( $nofile ) {
212	$path =~
213	m{^ ( $VOL_RX ? ) (.*) }sox;
214	$volume = $1;
215	$directory = $2;
216	}
217	else {
218	$path =~
219	m{^ ( $VOL_RX ? )
220	( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? )
221	(.*)
222	}sox;
223	$volume = $1;
224	$directory = $2;
225	$file = $3;
226	}
227
228	return ($volume,$directory,$file);
229	}
230
231
232	=item splitdir
233
234	The opposite of L<catdir()\|File::Spec/catdir()>.
235
236	@dirs = File::Spec->splitdir( $directories );
237
238	$directories must be only the directory portion of the path on systems
239	that have the concept of a volume or that have path syntax that differentiates
240	files from directories.
241
242	Unlike just splitting the directories on the separator, leading empty and
243	trailing directory entries can be returned, because these are significant
244	on some OSs. So,
245
246	File::Spec->splitdir( "/a/b/c" );
247
248	Yields:
249
250	( '', 'a', 'b', '', 'c', '' )
251
252	=cut
253
254	sub splitdir {
255	my ($self,$directories) = @_ ;
256	#
257	# split() likes to forget about trailing null fields, so here we
258	# check to be sure that there will not be any before handling the
259	# simple case.
260	#
261	if ( $directories !~ m\|[\\/]\Z(?!\n)\| ) {
262	return split( m\|[\\/]\|, $directories );
263	}
264	else {
265	#
266	# since there was a trailing separator, add a file name to the end,
267	# then do the split, then replace it with ''.
268	#
269	my( @directories )= split( m\|[\\/]\|, "${directories}dummy" ) ;
270	$directories[ $#directories ]= '' ;
271	return @directories ;
272	}
273	}
274
275
276	=item catpath
277
278	Takes volume, directory and file portions and returns an entire path. Under
279	Unix, $volume is ignored, and this is just like catfile(). On other OSs,
280	the $volume become significant.
281
282	=cut
283
284	sub catpath {
285	my ($self,$volume,$directory,$file) = @_;
286
287	# If it's UNC, make sure the glue separator is there, reusing
288	# whatever separator is first in the $volume
289	my $v;
290	$volume .= $v
291	if ( (($v) = $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s) &&
292	$directory =~ m@^[^\\/]@s
293	) ;
294
295	$volume .= $directory ;
296
297	# If the volume is not just A:, make sure the glue separator is
298	# there, reusing whatever separator is first in the $volume if possible.
299	if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
300	$volume =~ m@[^\\/]\Z(?!\n)@ &&
301	$file =~ m@[^\\/]@
302	) {
303	$volume =~ m@([\\/])@ ;
304	my $sep = $1 ? $1 : '\\' ;
305	$volume .= $sep ;
306	}
307
308	$volume .= $file ;
309
310	return $volume ;
311	}
312
313	sub _same {
314	lc($_[1]) eq lc($_[2]);
315	}
316
317	sub rel2abs {
318	my ($self,$path,$base ) = @_;
319
320	my $is_abs = $self->file_name_is_absolute($path);
321
322	# Check for volume (should probably document the '2' thing...)
323	return $self->canonpath( $path ) if $is_abs == 2;
324
325	if ($is_abs) {
326	# It's missing a volume, add one
327	my $vol = ($self->splitpath( $self->_cwd() ))[0];
328	return $self->canonpath( $vol . $path );
329	}
330
331	if ( !defined( $base ) \|\| $base eq '' ) {
332	require Cwd ;
333	$base = Cwd::getdcwd( ($self->splitpath( $path ))[0] ) if defined &Cwd::getdcwd ;
334	$base = $self->_cwd() unless defined $base ;
335	}
336	elsif ( ! $self->file_name_is_absolute( $base ) ) {
337	$base = $self->rel2abs( $base ) ;
338	}
339	else {
340	$base = $self->canonpath( $base ) ;
341	}
342
343	my ( $path_directories, $path_file ) =
344	($self->splitpath( $path, 1 ))[1,2] ;
345
346	my ( $base_volume, $base_directories ) =
347	$self->splitpath( $base, 1 ) ;
348
349	$path = $self->catpath(
350	$base_volume,
351	$self->catdir( $base_directories, $path_directories ),
352	$path_file
353	) ;
354
355	return $self->canonpath( $path ) ;
356	}
357
358	=back
359
360	=head2 Note For File::Spec::Win32 Maintainers
361
362	Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32.
363
364	=head1 COPYRIGHT
365
366	Copyright (c) 2004,2007 by the Perl 5 Porters. All rights reserved.
367
368	This program is free software; you can redistribute it and/or modify
369	it under the same terms as Perl itself.
370
371	=head1 SEE ALSO
372
373	See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
374	implementation of these methods, not the semantics.
375
376	=cut
377
378
379	sub _canon_cat # @path -> path
380	{
381	my ($first, @rest) = @_;
382
383	my $volume = $first =~ s{ \A ([A-Za-z]:) ([\\/]?) }{}x # drive letter
384	? ucfirst( $1 ).( $2 ? "\\" : "" )
385	: $first =~ s{ \A (?:\\\\\|//) ([^\\/]+)
386	(?: [\\/] ([^\\/]+) )?
387	[\\/]? }{}xs # UNC volume
388	? "\\\\$1".( defined $2 ? "\\$2" : "" )."\\"
389	: $first =~ s{ \A [\\/] }{}x # root dir
390	? "\\"
391	: "";
392	my $path = join "\\", $first, @rest;
393
394	$path =~ tr#\\/#\\\\#s; # xx/yy --> xx\yy & xx\\yy --> xx\yy
395
396	# xx/././yy --> xx/yy
397	$path =~ s{(?:
398	(?:\A\|\\) # at begin or after a slash
399	\.
400	(?:\\\.)* # and more
401	(?:\\\|\z) # at end or followed by slash
402	)+ # performance boost -- I do not know why
403	}{\\}gx;
404
405	# XXX I do not know whether more dots are supported by the OS supporting
406	# this ... annotation (NetWare or symbian but not MSWin32).
407	# Then .... could easily become ../../.. etc:
408	# Replace \.\.\. by (\.\.\.+) and substitute with
409	# { $1 . ".." . "\\.." x (length($2)-2) }gex
410	# ... --> ../..
411	$path =~ s{ (\A\|\\) # at begin or after a slash
412	\.\.\.
413	(?=\\\|\z) # at end or followed by slash
414	}{$1..\\..}gx;
415	# xx\yy\..\zz --> xx\zz
416	while ( $path =~ s{(?:
417	(?:\A\|\\) # at begin or after a slash
418	[^\\]+ # rip this 'yy' off
419	\\\.\.
420	(?<!\A\.\.\\\.\.) # do not replace ^..\..
421	(?<!\\\.\.\\\.\.) # do not replace \..\..
422	(?:\\\|\z) # at end or followed by slash
423	)+ # performance boost -- I do not know why
424	}{\\}sx ) {}
425
426	$path =~ s#\A\\##; # \xx --> xx NOTE: this is not root
427	$path =~ s#\\\z##; # xx\ --> xx
428
429	if ( $volume =~ m#\\\z# )
430	{ # <vol>\.. --> <vol>\
431	$path =~ s{ \A # at begin
432	\.\.
433	(?:\\\.\.)* # and more
434	(?:\\\|\z) # at end or followed by slash
435	}{}x;
436
437	return $1 # \\HOST\SHARE\ --> \\HOST\SHARE
438	if $path eq ""
439	and $volume =~ m#\A(\\\\.*)\\\z#s;
440	}
441	return $path ne "" \|\| $volume ? $volume.$path : ".";
442	}
443
444	1;