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