split /^/

[p5sagit/p5-mst-13.2.git] / lib / Cwd.pm

diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index e3c4590..d86428c 100644 (file)
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -70,7 +70,7 @@ kept up to date if all packages which use chdir import it from Cwd.
 
 use Carp;
 
-$VERSION = '2.02';
+$VERSION = '2.03';
 
 require Exporter;
 @ISA = qw(Exporter);
@@ -108,9 +108,6 @@ sub getcwd
 # This is a faster version of getcwd.  It's also more dangerous because
 # you might chdir out of a directory that you can't chdir back into.
     
-# List of metachars taken from do_exec() in doio.c
-my $quoted_shell_meta = quotemeta('$&*(){}[]";\\|?<>~`'."'\n");
-
 sub fastcwd {
     my($odev, $oino, $cdev, $cino, $tdev, $tino);
     my(@path, $path);
@@ -142,7 +139,7 @@ sub fastcwd {
     if ($^O eq 'apollo') { $path = "/".$path; }
     # At this point $path may be tainted (if tainting) and chdir would fail.
     # To be more useful we untaint it then check that we landed where we started.
-    $path = $1 if $path =~ /^(.*)$/;   # untaint
+    $path = $1 if $path =~ /^(.*)\z/s; # untaint
     CORE::chdir($path) || return undef;
     ($cdev, $cino) = stat('.');
     die "Unstable directory path, current directory changed unexpectedly"
@@ -170,7 +167,7 @@ sub chdir_init {
        $ENV{'PWD'} = cwd();
     }
     # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
-    if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
+    if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
        my($pd,$pi) = stat($2);
        my($dd,$di) = stat($1);
        if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
@@ -187,7 +184,7 @@ sub chdir {
     return 0 unless CORE::chdir $newdir;
     if ($^O eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} }
 
-    if ($newdir =~ m#^/#) {
+    if ($newdir =~ m#^/#s) {
        $ENV{'PWD'} = $newdir;
     } else {
        my @curdir = split(m#/#,$ENV{'PWD'});
@@ -203,63 +200,39 @@ sub chdir {
     1;
 }
 
-# Taken from Cwd.pm It is really getcwd with an optional
-# parameter instead of '.'
-#
 
-sub abs_path
-{
-    my $start = @_ ? shift : '.';
-    my($dotdots, $cwd, @pst, @cst, $dir, @tst);
+# By Jeff "japhy" Pinyan (07/23/2000)
+#   usage:  abs_path(PATHNAME)
+# see the docs
+
+sub abs_path {
+  my $base = @_ ? $_[0] : ".";
+  my $path = "";
+  my $file;
 
-    unless (@cst = stat( $start ))
-    {
-       carp "stat($start): $!";
-       return '';
+  do {
+    my @devino = (stat($base))[0,1] or
+      carp("stat($base): $!"), return;
+
+    $base .= "/..";
+
+    opendir PREV, $base or carp("opendir($base): $!"), return;
+    while (defined($file = readdir PREV)) {
+      next if $file eq "." or $file eq "..";
+      my @entry = (lstat("$base/$file"))[0,1] or
+        carp("lstat($base/$file): $!"), return;
+      last if $devino[0] == $entry[0] and $devino[1] == $entry[1];
     }
-    $cwd = '';
-    $dotdots = $start;
-    do
-    {
-       $dotdots .= '/..';
-       @pst = @cst;
-       unless (opendir(PARENT, $dotdots))
-       {
-           carp "opendir($dotdots): $!";
-           return '';
-       }
-       unless (@cst = stat($dotdots))
-       {
-           carp "stat($dotdots): $!";
-           closedir(PARENT);
-           return '';
-       }
-       if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
-       {
-           $dir = undef;
-       }
-       else
-       {
-           do
-           {
-               unless (defined ($dir = readdir(PARENT)))
-               {
-                   carp "readdir($dotdots): $!";
-                   closedir(PARENT);
-                   return '';
-               }
-               $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
-           }
-           while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
-                  $tst[1] != $pst[1]);
-       }
-       $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
-       closedir(PARENT);
-    } while (defined $dir);
-    chop($cwd) unless $cwd eq '/'; # drop the trailing /
-    $cwd;
+    closedir PREV;
+
+    $path = (defined $file and $file) . "/$path";
+  } while defined $file;
+
+  length($path) > 1 and chop $path;
+  return $path;
 }
 
+
 # added function alias for those of us more
 # used to the libc function.  --tchrist 27-Jan-00
 *realpath = \&abs_path;