X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFile%2FCheckTree.pm;h=ae1877741bc995fcce631a4e962f3597d13dd615;hb=bdb84599aeb6d8fcc1319c109c1240cbc6c835db;hp=a440bda71ec5c1fdde8030432a5888b321042484;hpb=748a93069b3d16374a9859d1456065dd3ae11394;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/File/CheckTree.pm b/lib/File/CheckTree.pm
index a440bda..ae18777 100644
--- a/lib/File/CheckTree.pm
+++ b/lib/File/CheckTree.pm
@@ -2,6 +2,45 @@ package File::CheckTree;
 require 5.000;
 require Exporter;
 
+=head1 NAME
+
+validate - run many filetest checks on a tree
+
+=head1 SYNOPSIS
+
+    use File::CheckTree;
+
+    $warnings += validate( q{
+	/vmunix                 -e || die
+	/boot                   -e || die
+	/bin                    cd
+	    csh                 -ex
+	    csh                 !-ug
+	    sh                  -ex
+	    sh                  !-ug
+	/usr                    -d || warn "What happened to $file?\n"
+    });
+
+=head1 DESCRIPTION
+
+The validate() routine takes a single multiline string consisting of
+lines containing a filename plus a file test to try on it.  (The
+file test may also be a "cd", causing subsequent relative filenames
+to be interpreted relative to that directory.)  After the file test
+you may put C<|| die> to make it a fatal error if the file test fails.
+The default is C<|| warn>.  The file test may optionally have a "!' prepended
+to test for the opposite condition.  If you do a cd and then list some
+relative filenames, you may want to indent them slightly for readability.
+If you supply your own die() or warn() message, you can use $file to
+interpolate the filename.
+
+Filetests may be bunched:  "-rwx" tests for all of C<-r>, C<-w>, and C<-x>.
+Only the first failed test of the bunch will produce a warning.
+
+The routine returns the number of warnings issued.
+
+=cut
+
 @ISA = qw(Exporter);
 @EXPORT = qw(validate);
 
@@ -66,7 +105,7 @@ sub validate {
 
 sub valmess {
     local($disposition,$this) = @_;
-    $file = $cwd . '/' . $file unless $file =~ m|^/|;
+    $file = $cwd . '/' . $file unless $file =~ m|^/|s;
     if ($this =~ /^(!?)-(\w)\s+\$file\s*$/) {
 	$neg = $1;
 	$tmp = $2;
@@ -98,13 +137,13 @@ sub valmess {
 	    $mess =~ s/ does not / should not / ||
 	    $mess =~ s/ not / /;
 	}
-	print STDERR $mess,"\n";
     }
     else {
 	$this =~ s/\$file/'$file'/g;
-	print STDERR "Can't do $this.\n";
+	$mess = "Can't do $this.\n";
     }
-    if ($disposition eq 'die') { exit 1; }
+    die "$mess\n" if $disposition eq 'die';
+    warn "$mess\n";
     ++$warnings;
 }