t: replace variable root directory in tests

[perl/plp/.git] / lib / Test / PLP.pm

diff --git a/lib/Test/PLP.pm b/lib/Test/PLP.pm
index edadc874a5ebf3ff3f8992d6a5f47df865e66b07..c030742a137b43b5e5261de76090f11b43c9cb03 100644 (file)
--- a/lib/Test/PLP.pm
+++ b/lib/Test/PLP.pm
@@ -3,24 +3,28 @@ package Test::PLP;
 use strict;
 use warnings;
 
-use Cwd;
-use Test::More;
 use PLP::Functions qw( DecodeURI );
 require PLP::Backend::CGI;
 require PerlIO::scalar;
 
 our $VERSION = '1.00';
 
-use base 'Exporter';
+use Test::Builder::Module;
+use base 'Test::Builder::Module';
 our @EXPORT = qw( plp_is plp_ok );
 
 $PLP::use_cache = 0 if $PLP::use_cache;
 #TODO: caching on (change file names)
 
-my $ORGDIR = '.'; # Cwd::getcwd();
 open ORGOUT, '>&', *STDOUT;
 
+sub is_string ($$;$) {
+       my $tb = __PACKAGE__->builder;
+       $tb->is_eq(@_);
+}
+
 eval {
+       # optionally replace unformatted is_string by LongString prettification
        require Test::LongString;
        Test::LongString->import(max => 128);
 
@@ -34,7 +38,7 @@ eval {
                # align lines to: "____expected: "
                return $s;
        };
-} or *is_string = \&is;  # fallback to ugly unformatted is()
+} or 1;
 
 sub _plp_run {
        my ($src, $env, $in) = @_;
@@ -46,10 +50,10 @@ sub _plp_run {
                GATEWAY_INTERFACE => 'CGI/1.1',
                
                SCRIPT_NAME => '/plp.cgi',
-               SCRIPT_FILENAME => "$ORGDIR/plp.cgi",
+               SCRIPT_FILENAME => "./plp.cgi",
                PATH_INFO => "/$src/test/123",
-               PATH_TRANSLATED => "$ORGDIR/$src/test/123",
-               DOCUMENT_ROOT => $ORGDIR,
+               PATH_TRANSLATED => "./$src/test/123",
+               DOCUMENT_ROOT => ".",
                
                $env ? %{$env} : (),
        ); # Apache/2.2.4 CGI environment
@@ -81,12 +85,13 @@ sub _plp_run {
 
 sub plp_is {
        my ($name, $src, $expect, $env, $in) = @_;
+       my $tb = __PACKAGE__->builder;
        local $Test::Builder::Level = $Test::Builder::Level + 1;
 
        my ($output, $failure) = _plp_run($src, $env, $in);
        if ($failure) {
-               fail($name);
-               diag("    Error: $failure");
+               $tb->ok(0, $name);
+               $tb->diag("    Error: $failure");
                return;
        }
        $output =~ s{((?:.+\n)*)}{ join "", sort split /(?<=\n)/, $1 }e; # order headers
@@ -107,6 +112,7 @@ sub _getwarning {
 
 sub plp_ok {
        my ($file, %replace) = @_;
+       my $tb = __PACKAGE__->builder;
        local $Test::Builder::Level = $Test::Builder::Level + 1;
 
        (my $name = $file) =~ s/[.][^.]+$//;
@@ -122,8 +128,8 @@ sub plp_ok {
                return readline $fh;
        };
        if (not defined $out) {
-               fail($name);
-               diag("error reading output from $file: $@");
+               $tb->ok(0, $name);
+               $tb->diag("error reading output from $file: $@");
                return;
        }
 
@@ -131,7 +137,7 @@ sub plp_ok {
        $replace{HEAD} //= "Content-Type: text/html\nX-PLP-Version: $PLP::VERSION\n";
        $replace{VERSION        } //= $PLP::VERSION;
        $replace{SCRIPT_NAME    } //= $infile;
-       $replace{SCRIPT_FILENAME} //= "$ORGDIR/$infile";
+       $replace{SCRIPT_FILENAME} //= "./$infile";
 
        chomp $out;
        $out =~ s/\$$_/$replace{$_}/g for keys %replace;