[Summary view] [Print] [Text view]

   1  package File::Spec::Epoc;
   2  
   3  use strict;
   4  use vars qw($VERSION @ISA);
   5  
   6  $VERSION = '3.2501';
   7  
   8  require File::Spec::Unix;
   9  @ISA = qw(File::Spec::Unix);
  10  
  11  =head1 NAME
  12  
  13  File::Spec::Epoc - methods for Epoc file specs
  14  
  15  =head1 SYNOPSIS
  16  
  17   require File::Spec::Epoc; # Done internally by File::Spec if needed
  18  
  19  =head1 DESCRIPTION
  20  
  21  See File::Spec::Unix for a documentation of the methods provided
  22  there. This package overrides the implementation of these methods, not
  23  the semantics.
  24  
  25  This package is still work in progress ;-)
  26  
  27  =cut
  28  
  29  sub case_tolerant {
  30      return 1;
  31  }
  32  
  33  =pod
  34  
  35  =over 4
  36  
  37  =item canonpath()
  38  
  39  No physical check on the filesystem, but a logical cleanup of a
  40  path. On UNIX eliminated successive slashes and successive "/.".
  41  
  42  =back
  43  
  44  =cut
  45  
  46  sub canonpath {
  47      my ($self,$path) = @_;
  48  
  49      $path =~ s|/+|/|g;                             # xx////xx  -> xx/xx
  50      $path =~ s|(/\.)+/|/|g;                        # xx/././xx -> xx/xx
  51      $path =~ s|^(\./)+||s unless $path eq "./";    # ./xx      -> xx
  52      $path =~ s|^/(\.\./)+|/|s;                     # /../../xx -> xx
  53      $path =~  s|/\Z(?!\n)|| unless $path eq "/";          # xx/       -> xx
  54      return $path;
  55  }
  56  
  57  =pod
  58  
  59  =head1 AUTHOR
  60  
  61  o.flebbe@gmx.de
  62  
  63  =head1 COPYRIGHT
  64  
  65  Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  66  
  67  This program is free software; you can redistribute it and/or modify
  68  it under the same terms as Perl itself.
  69  
  70  =head1 SEE ALSO
  71  
  72  See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
  73  implementation of these methods, not the semantics.
  74  
  75  =cut
  76  
  77  1;