Upgrade to Math-Complex-1.47

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

diff --git a/lib/File/CheckTree.pm b/lib/File/CheckTree.pm
index b90945d..29f05d8 100644 (file)
--- a/lib/File/CheckTree.pm
+++ b/lib/File/CheckTree.pm
@@ -1,18 +1,19 @@
 package File::CheckTree;
 
 use 5.006;
-use Exporter;
 use Cwd;
+use Exporter;
+use File::Spec;
 use warnings;
 use strict;
 
-our $VERSION = '4.2';
+our $VERSION = '4.3';
 our @ISA     = qw(Exporter);
 our @EXPORT  = qw(validate);
 
 =head1 NAME
 
-validate - run many filetest checks on a tree
+File::CheckTree - run many filetest checks on a tree
 
 =head1 SYNOPSIS
 
@@ -49,7 +50,9 @@ The routine returns the number of warnings issued.
 
 =head1 AUTHOR
 
-Unknown.  Revised by Paul Grassie <F<grassie@perl.com>> in 2002.
+File::CheckTree was derived from lib/validate.pl which was
+written by Larry Wall.
+Revised by Paul Grassie <F<grassie@perl.com>> in 2002.
 
 =head1 HISTORY
 
@@ -84,8 +87,17 @@ sub validate {
         # but earlier versions of File::CheckTree did not do this either
 
         # split a line like "/foo -r || die"
-        # so that $file is "/foo", $test is "-rwx || die"
-        ($file, $test) = split(' ', $check, 2);   # special whitespace split
+        # so that $file is "/foo", $test is "-r || die"
+        # (making special allowance for quoted filenames).
+        if ($check =~ m/^\s*"([^"]+)"\s+(.*?)\s*$/ or
+            $check =~ m/^\s*'([^']+)'\s+(.*?)\s*$/ or
+            $check =~ m/^\s*(\S+?)\s+(\S.*?)\s*$/)
+        {
+            ($file, $test) = ($1,$2);
+        }
+        else {
+            die "Malformed line: '$check'";
+        };
 
         # change a $test like "!-ug || die" to "!-Z || die",
         # capturing the bundled tests (e.g. "ug") in $2
@@ -107,10 +119,11 @@ sub validate {
             my $this = $test;
 
             # expand relative $file to full pathname if preceded by cd directive
-            $file = $cwd . '/' . $file if $cwd && $file !~ m|^/|;
+            $file = File::Spec->catfile($cwd, $file) 
+                    if $cwd && !File::Spec->file_name_is_absolute($file);
 
             # put filename in after the test operator
-            $this =~ s/(-\w\b)/$1 "$file"/g;
+            $this =~ s/(-\w\b)/$1 "\$file"/g;
 
             # change the "-Z" representing a bundle with the $one test
             $this =~ s/-Z/-$one/;
@@ -130,7 +143,7 @@ sub validate {
                 # to call valmess instead of die/warn directly
                 # valmess will look up the error message from %Val_Message
                 $this =~ s/ ^ ( (\S+) \s+ \S+ ) \s* \|\| \s* (die|warn) \s* $
-                          /$1 || valmess('$3', '$2', '$file')/x;
+                          /$1 || valmess('$3', '$2', \$file)/x;
             }
 
             {
@@ -151,12 +164,12 @@ sub validate {
                 eval $this;
 
                 # re-raise an exception caused by a "... || die" test 
-                if ($@) {
+                if (my $err = $@) {
                     # in case of any cd directives, return from whence we came
                     if ($starting_dir ne cwd) {
                         chdir($starting_dir) || die "$starting_dir: $!";
                     }
-                    die $@ if $@;
+                    die $err;
                 }
             }
 
@@ -167,7 +180,7 @@ sub validate {
 
     # in case of any cd directives, return from whence we came
     if ($starting_dir ne cwd) {
-        chdir($starting_dir) || die "$starting_dir: $!";
+        chdir($starting_dir) || die "chdir $starting_dir: $!";
     }
 
     return $Warnings;