1=head1 NAME
2
3File::VirtualPath - Portable abstraction of a file/dir/url path
4
5=cut
6
7######################################################################
8
9package File::VirtualPath;
10require 5.004;
11
12# Copyright (c) 1999-2003, Darren R. Duncan.  All rights reserved.  This module
13# is free software; you can redistribute it and/or modify it under the same terms
14# as Perl itself.  However, I do request that this copyright information and
15# credits remain attached to the file.  If you modify this module and
16# redistribute a changed version then please attach a note listing the
17# modifications.  This module is available "as-is" and the author can not be held
18# accountable for any problems resulting from its use.
19
20use strict;
21use warnings;
22use vars qw($VERSION);
23$VERSION = '1.011';
24
25######################################################################
26
27=head1 DEPENDENCIES
28
29=head2 Perl Version
30
31	5.004
32
33=head2 Standard Modules
34
35	I<none>
36
37=head2 Nonstandard Modules
38
39	I<none>
40
41=head1 SYNOPSIS
42
43=head2 Content of thin shell "startup.pl":
44
45	#!/usr/bin/perl
46	use strict;
47	use warnings;
48
49	my $root = "/home/johndoe/projects/aardvark";
50	my $separator = "/";
51	if( $^O =~ /Win/i ) {
52		$root = "c:\\projects\\aardvark";
53		$separator = "\\";
54	}
55	if( $^O =~ /Mac/i ) {
56		$root = "Documents:projects:aardvark";
57		$separator = ":";
58	}
59
60	use Aardvark;
61	Aardvark->main( File::VirtualPath->new( $root, $separator ) );
62
63	1;
64
65=head2 Content of fat main program "Aardvark.pm"
66
67	package Aardvark;
68	use strict;
69	use warnings;
70	use File::VirtualPath;
71
72	sub main {
73		my (undef, $project_dir) = @_;
74		my $prefs = &get_prefs( $project_dir->child_path_obj( 'config.pl' ) );
75		&do_work( $prefs, $project_dir );
76	}
77
78	sub get_prefs {
79		my ($project_dir) = @_;
80		my $real_filename = $project_dir->physical_path_string();
81		my $prefs = do $real_filename;
82		defined( $prefs ) or do {
83			my $virtual_fn = $project_dir->path_string();
84			die "Can't get Aardvark prefs from file '$virtual_fn': $!";
85		};
86		return( $prefs );
87	}
88
89	sub do_work {
90		my ($prefs, $project_dir) = @_;
91		my ($lbl_a, $lbl_b, $lbl_c) = ($prefs->{a}, $prefs->{b}, $prefs->{c});
92		my $data_source = $prefs->{'sourcefile'};
93		open( SOURCE, $project_dir->physical_child_path_string( $data_source ) );
94		while( my $line = <SOURCE> ) {
95			my ($a, $b, $c) = split( "\t", $line );
96			print "File contains: $lbl_a='$a', $lbl_b='$b', $lbl_c='$c'\n";
97		}
98		close( SOURCE );
99	}
100
101	1;
102
103=head2 Content of settings file "config.pl"
104
105	$rh_prefs = {
106		sourcefile => 'mydata.txt',
107		a => 'name',
108		b => 'phone',
109		c => 'date',
110	};
111
112=head1 DESCRIPTION
113
114This Perl 5 object class implements a portable abstraction of a resource path,
115examples of which include file-system paths like "/usr/bin/perl" and URLs like
116"http://www.cpan.org/modules/".  It is designed to support applications that are
117easily portable across systems because common platform-specific details are
118abstracted away.  Abstracted details include the location of your project within
119the file-system and the path separator for your OS; you can write your
120application as if it is in the root directory of a UNIX system, and it will
121function correctly when moved to any subdirectory or to a Mac or Windows system.
122
123=head1 OVERVIEW
124
125This class is implemented as a simple data structure which stores an array of
126path segments such as ['', 'usr', 'bin', 'perl'] in a virtual file-system. The
127majority part of your application works with these objects and passes them around
128during its routines of locating config or data or other files.
129
130As your application navigates the virtual file-system, it uses object methods
131like chdir() to tell the object where the app thinks it is now.  When your
132program actually needs to use files, it asks a method like physical_path_string()
133to give it a string representing the current path in the real world, which it
134then passes to your standard I/O functions like open().
135
136For example, the program may think it is sitting in "/config/access", but it
137actually makes an open call to "/home/johndoe/projects/aardvark/config/access".
138If you move the "aardvark" project to a Windows system, the real path may have
139changed to "c:\projects\aardvark\config\access", but your program would never
140need to know the difference (aside from any internal file format issues).
141
142In order for this to work, a small part of your program needs to know the truth
143of where the project it is working on is located.  But that part can be a very
144lightweight shim which initializes a single File::VirtualPath object and then
145passes it to the fat portable part of the program.  There are two bits of data
146that your shim needs to provide: 1. A string having the full real-world path of
147your project root directory; 2. A string having the real-world path separator.
148See the SYNOPSIS for an example.
149
150Then, your main program just needs to assume that the argument it was passed is
151currently in the virtual root directory and go from there.
152
153	THIN CONFIG SHELL <----> File::VirtualPath <----> FAT PROGRAM CORE
154	(may be portable)        (portable)               (portable)
155
156Taking this idea further, it is easy for program code to be reused for multiple
157projects, simultaneously, because each would only need a different thin shim
158program which points to a different physical directory as the virtual root.
159
160Taking this idea further, File::VirtualPath makes it easier for you to separate
161your application into components that have their own files to keep track of.
162When your main program calls a component, it can pass a modified FVP object which
163that component uses as its own virtual root.  And so you can have multiple
164instances of program components each working in different directories, and no
165logic for working this out needs to be in the components themselves.
166
167On a final note, the paths returned by this class are all absolute.  Therefore
168you never need to do a real "chdir" or "cd" operation in your program, and your
169executable doesn't have to be located in the same place as its data.  This is
170particularly useful if you are calling your program using a link/alias/shortcut.
171
172=cut
173
174######################################################################
175
176# Names of properties for objects of this class are declared here:
177my $KEY_PHYSICAL_ROOT = 'physical_root';  # str - physical path of virtual root
178my $KEY_PHYSICAL_DELI = 'physical_deli';  # str - physical delim for path elems
179my $KEY_VIR_PATH_DELI = 'vir_path_deli';  # str - delim for vir path elements
180my $KEY_VIR_PATH_ELEM = 'vir_path_elem';  # array - virtual path we represent
181my $KEY_VIR_PATH_LEVE = 'vir_path_leve';  # num - path elem ind we are examining
182
183######################################################################
184
185=head1 SYNTAX
186
187This class does not export any functions or methods, so you need to call them
188using object notation.  This means using B<Class-E<gt>function()> for functions
189and B<$object-E<gt>method()> for methods.  If you are inheriting this class for
190your own modules, then that often means something like B<$self-E<gt>method()>.
191
192Paths can be represented as either strings or array refs, and any methods which
193take absolute or relative paths as arguments can take either format.  A literal
194list will not work.  Methods which return paths usually come in pairs, and their
195names differ only in that one has a "_string" suffix; each will return either an
196array ref or a string.  Literal lists are never returned, even in list context.
197
198A path is "absolute" when its array representation has an empty string as its
199first element, or its string representation begins with a "/".  Note that a
200simple split or join operation on "/" will cleanly convert one into the other.
201Conversely, a path is "relative" when its array representation has anything but
202an empty string (or undef) in its first element, or its string representation
203does not start with a "/".
204
205In the virtual file-system that objects of this class represent, the root
206directory is called "/" and path separators are also "/"; this is just like UNIX.
207String representations of the virtual path are split or joined on the same "/".
208For your convenience, the path_delimiter() method lets you change the string
209that has these dual purposes.
210
211Whenever you see any CHANGE_VECTOR arguments mentioned below, realize that they
212can be either absolute or relative paths.  The effects of using either is the
213same as with your normal "chdir" or "cd" functions.  If CHANGE_VECTOR is an
214absolute path then the entire path becomes it; whereas, if that argument is a
215relative path then it is applied to the current absolute path and a new absolute
216path results.  Usual conventions have alphanumeric path segments going down one
217directory level, ".." segments going up one level, and "." not going anywhere.
218
219If an absolute path is taken as an argument or derived from a relative path, it
220is always reduced to its simplest form before being stored or returned.  Mainly
221this ensures that there are no ".." or "." remaining in the path.  Any ".."
222path segments are paired up with previous alphanumeric list elements; these
223negate each other and both are removed.  If any ".." can not be paired up then
224they are simply removed since you can not navigate higher than the root; note
225that this would only happen if we are passed a malformed argument.  This
226precaution can also act as a pseudo-security measure by never returning a
227physical path that is outside the virtual root.
228
229=head1 FUNCTIONS AND METHODS
230
231=head2 new([ PHY_ROOT[, PHY_DELIM[, VIR_DELIM[, VIR_PATH]]] ])
232
233This function creates a new File::VirtualPath (or subclass) object and
234returns it.  All of the method arguments are passed to initialize() as is; please
235see the POD for that method for an explanation of them.
236
237=cut
238
239######################################################################
240
241sub new {
242	my $class = shift( @_ );
243	my $self = bless( {}, ref($class) || $class );
244	$self->initialize( @_ );
245	return( $self );
246}
247
248######################################################################
249
250=head2 initialize([ PHY_ROOT[, PHY_DELIM[, VIR_DELIM[, VIR_PATH]]] ])
251
252This method is used by B<new()> to set the initial properties of objects that it
253creates.  The 4 optional arguments allow you to set the default values for the
254four object properties that the following methods also handle: physical_root(),
255physical_delimiter(), path_delimiter, path().  Semantecs are the same as calling
256those 4 methods yourself in the same order.
257
258=cut
259
260######################################################################
261
262sub initialize {
263	my ($self, $root, $phy_delim, $vir_delim, $elem) = @_;
264	$self->{$KEY_PHYSICAL_ROOT} = '';  # default is virt root = phys root
265	$self->{$KEY_PHYSICAL_DELI} = '/';  # default is UNIX
266	$self->{$KEY_VIR_PATH_DELI} = '/';  # default is UNIX
267	$self->{$KEY_VIR_PATH_ELEM} = [''];  # default vir path is virtual root
268	$self->{$KEY_VIR_PATH_LEVE} = 0;  # default is virtual root
269	$self->physical_root( $root );
270	$self->physical_delimiter( $phy_delim );
271	$self->path_delimiter( $vir_delim );
272	$self->path( $elem );
273}
274
275######################################################################
276
277=head2 clone([ CLONE ])
278
279This method initializes a new object to have all of the same properties of the
280current object and returns it.  This new object can be provided in the optional
281argument CLONE (if CLONE is an object of the same class as the current object);
282otherwise, a brand new object of the current class is used.  Only object
283properties recognized by File::VirtualPath are set in the clone; other
284properties are not changed.
285
286=cut
287
288######################################################################
289
290sub clone {
291	my ($self, $clone) = @_;
292	ref($clone) eq ref($self) or $clone = bless( {}, ref($self) );
293	$clone->{$KEY_PHYSICAL_ROOT} = $self->{$KEY_PHYSICAL_ROOT};
294	$clone->{$KEY_PHYSICAL_DELI} = $self->{$KEY_PHYSICAL_DELI};
295	$clone->{$KEY_VIR_PATH_DELI} = $self->{$KEY_VIR_PATH_DELI};
296	$clone->{$KEY_VIR_PATH_ELEM} = [@{$self->{$KEY_VIR_PATH_ELEM}}];
297	$clone->{$KEY_VIR_PATH_LEVE} = $self->{$KEY_VIR_PATH_LEVE};
298	return( $clone );
299}
300
301######################################################################
302
303=head2 physical_root([ NEW_VALUE ])
304
305This method is an accessor for the scalar "physical root" property of this
306object, which it returns.  If NEW_VALUE is defined, this property is set to it.
307This property defines what path on the real file-system the virtual root
308corresponds to.  This property defaults to an empty string.  This property must
309not have any trailing delimiter like "/".
310
311=cut
312
313######################################################################
314
315sub physical_root {
316	my ($self, $new_value) = @_;
317	if( defined( $new_value ) ) {
318		$self->{$KEY_PHYSICAL_ROOT} = $new_value;
319	}
320	return( $self->{$KEY_PHYSICAL_ROOT} );
321}
322
323######################################################################
324
325=head2 physical_delimiter([ NEW_VALUE ])
326
327This method is an accessor for the scalar "physical delimiter" property of this
328object, which it returns.  If NEW_VALUE is defined, this property is set to it.
329This property defines what the path delimiter in the real file-system is.
330This property defaults to "/", which is the UNIX standard.
331
332=cut
333
334######################################################################
335
336sub physical_delimiter {
337	my ($self, $new_value) = @_;
338	if( defined( $new_value ) ) {
339		$self->{$KEY_PHYSICAL_DELI} = $new_value;
340	}
341	return( $self->{$KEY_PHYSICAL_DELI} );
342}
343
344######################################################################
345
346=head2 path_delimiter([ NEW_VALUE ])
347
348This method is an accessor for the scalar "path delimiter" property of this
349object, which it returns.  If NEW_VALUE is defined, this property is set to it.
350This property defines what the path delimiter in the virtual file-system is.
351This property defaults to "/", which is the UNIX standard.
352
353=cut
354
355######################################################################
356
357sub path_delimiter {
358	my ($self, $new_value) = @_;
359	if( defined( $new_value ) ) {
360		$self->{$KEY_VIR_PATH_DELI} = $new_value;
361	}
362	return( $self->{$KEY_VIR_PATH_DELI} );
363}
364
365######################################################################
366
367=head2 path([ NEW_VALUE ])
368
369This method is an accessor for the array-ref "path" property of this
370object, which it returns.  If NEW_VALUE is defined, this property is set to it.
371This property defines what absolute path in the virtual file-system this object
372represents.  This property defaults to the virtual root.
373
374=cut
375
376######################################################################
377
378sub path {
379	my ($self, $new_value) = @_;
380	if( defined( $new_value ) ) {
381		my @elements = ('', ref( $new_value ) eq 'ARRAY' ?
382			@{$new_value} : @{$self->_path_str_to_ra( $new_value )});
383		$self->{$KEY_VIR_PATH_ELEM} = $self->_simplify_path_ra( \@elements );
384	}
385	return( [@{$self->{$KEY_VIR_PATH_ELEM}}] );
386}
387
388######################################################################
389
390=head2 child_path( CHANGE_VECTOR )
391
392This method uses CHANGE_VECTOR to derive a new path relative to what this object
393represents and returns it as an array-ref.
394
395=cut
396
397######################################################################
398
399sub child_path {
400	my ($self, $chg_vec) = @_;
401	my $ra_elements = $self->_join_two_path_ra( $self->{$KEY_VIR_PATH_ELEM},
402		ref( $chg_vec ) eq 'ARRAY' ? $chg_vec :
403		$self->_path_str_to_ra( $chg_vec ) );
404	return( $self->_simplify_path_ra( $ra_elements ) );
405}
406
407######################################################################
408
409=head2 child_path_obj( CHANGE_VECTOR )
410
411This method uses CHANGE_VECTOR to derive a new path relative to what this object
412represents and uses it as the "path" attribute of a new object of this class,
413which it returns.  All other attributes of the new object are cloned.
414
415=cut
416
417######################################################################
418
419sub child_path_obj {
420	my ($self, $chg_vec) = @_;
421	my $obj = bless( {}, ref($self) );
422	$obj->{$KEY_PHYSICAL_ROOT} = $self->{$KEY_PHYSICAL_ROOT};
423	$obj->{$KEY_PHYSICAL_DELI} = $self->{$KEY_PHYSICAL_DELI};
424	$obj->{$KEY_VIR_PATH_DELI} = $self->{$KEY_VIR_PATH_DELI};
425	$obj->{$KEY_VIR_PATH_ELEM} = $self->child_path( $chg_vec );
426	$obj->{$KEY_VIR_PATH_LEVE} = $self->{$KEY_VIR_PATH_LEVE};
427	return( $obj );
428}
429
430######################################################################
431
432=head2 chdir( CHANGE_VECTOR )
433
434This method uses CHANGE_VECTOR to derive a new path relative to what this object
435represents and then changes this object to represent the new path.  The effect
436is conceptually the same as using "chdir" to change your current working
437directory where this object represents such.
438
439=cut
440
441######################################################################
442
443sub chdir {
444	my ($self, $chg_vec) = @_;
445	return( $self->{$KEY_VIR_PATH_ELEM} = $self->child_path( $chg_vec ) );
446}
447
448######################################################################
449
450=head2 path_string([ WANT_TRAILER ])
451
452This method returns the absolute path on the virtual file-system that this object
453represents as a string.  If WANT_TRAILER is true then the string has a path
454delimiter appended; otherwise, there is none.
455
456=cut
457
458######################################################################
459
460sub path_string {
461	my ($self, $tra) = @_;
462	$tra and $tra = $self->{$KEY_VIR_PATH_DELI} or $tra = '';
463	return( $self->_path_ra_to_str( $self->{$KEY_VIR_PATH_ELEM} ).$tra );
464}
465
466######################################################################
467
468=head2 physical_path_string([ WANT_TRAILER ])
469
470This method returns the absolute path on the real file-system that this object
471represents as a string.  If WANT_TRAILER is true then the string has a path
472delimiter appended; otherwise, there is none.
473
474=cut
475
476######################################################################
477
478sub physical_path_string {
479	my ($self, $tra) = @_;
480	$tra and $tra = $self->{$KEY_PHYSICAL_DELI} or $tra = '';
481	return( $self->_path_ra_to_phy_str( $self->{$KEY_VIR_PATH_ELEM} ).$tra );
482}
483
484######################################################################
485
486=head2 child_path_string( CHANGE_VECTOR[, WANT_TRAILER] )
487
488This method uses CHANGE_VECTOR to derive a new path in the virtual file-system
489relative to what this object represents and returns it as a string.  If
490WANT_TRAILER is true then the string has a path delimiter appended; otherwise,
491there is none.
492
493=cut
494
495######################################################################
496
497sub child_path_string {
498	my ($self, $chg_vec, $tra) = @_;
499	$tra and $tra = $self->{$KEY_VIR_PATH_DELI} or $tra = '';
500	return( $self->_path_ra_to_str( $self->child_path( $chg_vec ) ).$tra );
501}
502
503######################################################################
504
505=head2 physical_child_path_string( CHANGE_VECTOR[, WANT_TRAILER] )
506
507This method uses CHANGE_VECTOR to derive a new path in the real file-system
508relative to what this object represents and returns it as a string.  If
509WANT_TRAILER is true then the string has a path delimiter appended; otherwise,
510there is none.
511
512=cut
513
514######################################################################
515
516sub physical_child_path_string {
517	my ($self, $chg_vec, $tra) = @_;
518	$tra and $tra = $self->{$KEY_PHYSICAL_DELI} or $tra = '';
519	return( $self->_path_ra_to_phy_str( $self->child_path( $chg_vec ) ).$tra );
520}
521
522######################################################################
523
524=head2 path_element( INDEX[, NEW_VALUE] )
525
526This method is an accessor for individual segments of the "path" property of
527this object, and it returns the one at INDEX.  If NEW_VALUE is defined then
528the segment at INDEX is set to it.  This method is useful if you want to examine
529virtual path segments one at a time.  INDEX defaults to 0, meaning you are
530looking at the first segment, which happens to always be empty.  That said, this
531method will let you change this condition if you want to.
532
533=cut
534
535######################################################################
536
537sub path_element {
538	my ($self, $index, $new_value) = @_;
539	$index ||= 0;
540	if( defined( $new_value ) ) {
541		$self->{$KEY_VIR_PATH_ELEM}->[$index] = $new_value;
542	}
543	return( $self->{$KEY_VIR_PATH_ELEM}->[$index] );
544}
545
546######################################################################
547
548=head2 current_path_level([ NEW_VALUE ])
549
550This method is an accessor for the number "current path level" property of this
551object, which it returns.  If NEW_VALUE is defined, this property is set to it.
552If you want to examine the virtual path segments sequentially then this property
553tracks the index of the segment you are currently viewing.  This property
554defaults to 0, the first segment, which always happens to be an empty string.
555
556=cut
557
558######################################################################
559
560sub current_path_level {
561	my ($self, $new_value) = @_;
562	if( defined( $new_value ) ) {
563		$self->{$KEY_VIR_PATH_LEVE} = 0 + $new_value;
564	}
565	return( $self->{$KEY_VIR_PATH_LEVE} );
566}
567
568######################################################################
569
570=head2 inc_path_level([ NEW_VALUE ])
571
572This method will increment this object's "current path level" property by 1 so
573you can view the next path segment.  The new current value is returned.
574
575=cut
576
577######################################################################
578
579sub inc_path_level {
580	my $self = shift( @_ );
581	return( ++$self->{$KEY_VIR_PATH_LEVE} );
582}
583
584######################################################################
585
586=head2 dec_path_level([ NEW_VALUE ])
587
588This method will decrement this object's "current path level" property by 1 so
589you can view the previous path segment.  The new current value is returned.
590
591=cut
592
593######################################################################
594
595sub dec_path_level {
596	my $self = shift( @_ );
597	return( --$self->{$KEY_VIR_PATH_LEVE} );
598}
599
600######################################################################
601
602=head2 current_path_element([ NEW_VALUE ])
603
604This method is an accessor for individual segments of the "path" property of
605this object, the current one of which it returns.  If NEW_VALUE is defined then
606the current segment is set to it.  This method is useful if you want to examine
607virtual path segments one at a time in sequence.  The segment you are looking at
608now is determined by the current_path_level() method; by default you are looking
609at the first segment, which is always an empty string.  That said, this method
610will let you change this condition if you want to.
611
612=cut
613
614######################################################################
615
616sub current_path_element {
617	my ($self, $new_value) = @_;
618	my $curr_elem_num = $self->{$KEY_VIR_PATH_LEVE};
619	if( defined( $new_value ) ) {
620		$self->{$KEY_VIR_PATH_ELEM}->[$curr_elem_num] = $new_value;
621	}
622	return( $self->{$KEY_VIR_PATH_ELEM}->[$curr_elem_num] );
623}
624
625######################################################################
626# _path_str_to_ra( PATH_STR )
627# This private method takes a string representing an absolute or relative
628# virtual path and splits it on any "/" into an array ref list of path levels.
629
630sub _path_str_to_ra {
631	my ($self, $in) = @_;
632	$in ||= '';  # avoid uninitialized value warning
633	return( [split( $self->{$KEY_VIR_PATH_DELI}, $in )] );
634}
635
636######################################################################
637# _path_ra_to_str( PATH_RA )
638# This private method takes an array ref list of path levels and joins it
639# with "/" into a string representing an absolute or relative virtual path.
640
641sub _path_ra_to_str {
642	my ($self, $in) = @_;
643	return( join( $self->{$KEY_VIR_PATH_DELI}, @{$in} ) );
644}
645
646######################################################################
647# _path_ra_to_phy_str( PATH_RA )
648# This private method takes an array ref containing a complete virtual path
649# and joins it into a string that is the equivalent absolute physical path.
650
651sub _path_ra_to_phy_str {
652	my ($self, $in) = @_;
653	my $root = $self->{$KEY_PHYSICAL_ROOT};
654	return( $root.join( $self->{$KEY_PHYSICAL_DELI}, @{$in} ) );
655}
656
657######################################################################
658# _join_two_path_ra( CURRENT_PATH_RA, CHANGE_VECTOR_RA )
659# This private method takes two array refs, each having virtual path levels,
660# and combines them into one array ref.  An analogy for what this method does
661# is that it operates like the "cd" or "chdir" command but in the virtual space.
662# CURRENT_PATH_RA is an absolute path saying what the current directory is
663# before the change, and this method returns an absolute path for the current
664# directory after the change.  CHANGE_VECTOR_RA is either an absolute or
665# relative path.  If it is absolute, then it becomes the whole path that is
666# returned.  If it is relative, then this method appends it to the end of
667# CURRENT_PATH_RA and returns the longer list.  Well, actually, this method
668# will return a relative path if CURRENT_PATH_RA is relative and
669# CHANGE_VECTOR_RA is not absolute, since two relatives are then being combined
670# to produce a new relative.  Regardless, you should pass this method's return
671# value to _simplify_path_ra() to get rid of anomalies like ".." or "." in the
672# middle or end of the path.
673
674sub _join_two_path_ra {
675	my ($self, $curr, $chg) = @_;
676	return( @{$chg} && $chg->[0] eq '' ? [@{$chg}] : [@{$curr}, @{$chg}] );
677}
678
679######################################################################
680# _simplify_path_ra( SOURCE )
681# This private method takes an array ref having virtual path levels and
682# reduces it to its simplest form.  Mainly this ensures that there are no ".."
683# or "." in the middle or end of the array.  Any ".." list elements are paired
684# up with previous alphanumeric list elements; these negate each other and both
685# are removed.  If any ".." can't be paired with previous elements then they
686# are kept at the start of the path if the path is relative; if the path is
687# absolute then the ".." is simply dropped since you can not navigate higher
688# than the virtual root.  Any "." are simply removed since they are redundant.
689# We determine whether SOURCE is absolute by whether the first element is an
690# empty string or not; an empty string means absolute and otherwise means not.
691
692sub _simplify_path_ra {
693	my ($self, $source) = @_;
694	my @in = @{$source};  # store source elements here
695	my @mid = ();  # store alphanumeric outputs here
696	my @out = $in[0] eq '' ? shift( @in ) : ();  # make note if absolute or not
697
698	foreach my $part (@in) {
699		$part =~ /[a-zA-Z0-9]/ and push( @mid, $part ) and next;  # keep alpnums
700		$part ne '..' and next;  # skip over "." and the like
701		@mid ? pop( @mid ) : push( @out, '..' );  # neg ".." if we can or hold
702	}
703
704	$out[0] eq '' and @out = '';  # If absolute then toss any leading ".."
705	push( @out, @mid );  # add remaining non-neg alphanumerics to output
706	return( \@out );
707}
708
709######################################################################
710
7111;
712__END__
713
714=head1 AUTHOR
715
716Copyright (c) 1999-2003, Darren R. Duncan.  All rights reserved.  This module
717is free software; you can redistribute it and/or modify it under the same terms
718as Perl itself.  However, I do request that this copyright information and
719credits remain attached to the file.  If you modify this module and
720redistribute a changed version then please attach a note listing the
721modifications.  This module is available "as-is" and the author can not be held
722accountable for any problems resulting from its use.
723
724I am always interested in knowing how my work helps others, so if you put this
725module to use in any of your own products or services then I would appreciate
726(but not require) it if you send me the website url for said product or
727service, so I know who you are.  Also, if you make non-proprietary changes to
728the module because it doesn't work the way you need, and you are willing to
729make these freely available, then please send me a copy so that I can roll
730desirable changes into the main release.
731
732Address comments, suggestions, and bug reports to B<perl@DarrenDuncan.net>.
733
734=head1 CREDITS
735
736Thanks to Baldvin Kovacs <baldvin@fazekas.hu> for alerting me to the
737"uninitialized value" warnings (and offering a patch to fix it) that appear
738when running the test suite with the -w option (fixed in 1.01), and also thanks
739for a patch to the README file documentation, which was applied.
740
741=head1 SEE ALSO
742
743perl(1), CGI::Portable.
744
745=cut
746