Mailing-List: contact dev-help@perl.apache.org; run by ezmlm
Precedence: bulk
Message-ID: <3FABDCCC.90905@modperlcookbook.org>
Date: Fri, 07 Nov 2003 12:56:28 -0500
From: Geoffrey Young <geoff@modperlcookbook.org>
User-Agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.2.1) Gecko/20030225
MIME-Version: 1.0
To: dev@perl.apache.org
Subject: Re: cvs commit: modperl-2.0/lib/ModPerl TestRun.pm
References: <20031105095218.28876.qmail@minotaur.apache.org>
In-Reply-To: <20031105095218.28876.qmail@minotaur.apache.org>
Content-Type: multipart/mixed;
 boundary="------------000404080903020403070500"

--------------000404080903020403070500
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit


stas@apache.org wrote:
> stas        2003/11/05 01:52:18
> 
>   Modified:    .        Makefile.PL Changes
>                ModPerl-Registry/t TEST.PL
>                lib/ModPerl TestRun.pm
>   Log:
>   When 'make test' fails we now print the info on what to do next


the attached patch makes it possible to use -bugreport with the 
Apache::TestRun(Perl)->generate_script() form, which is nice for end users 
who are not interested in creating a t/TEST.PL template (which is most at 
this point I'd think).

I realize now that $self->can('bug_report') was a better idea - using the 
no-op method throws warnings that are trapped with fatal => ALL.

--Geoff

--------------000404080903020403070500
Content-Type: text/plain;
 name="generate_script.patch"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="generate_script.patch"

Index: Apache-Test/lib/Apache/TestRun.pm
===================================================================
RCS file: /home/cvspublic/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm,v
retrieving revision 1.121
diff -u -r1.121 TestRun.pm
--- Apache-Test/lib/Apache/TestRun.pm	5 Nov 2003 09:49:27 -0000	1.121
+++ Apache-Test/lib/Apache/TestRun.pm	7 Nov 2003 17:51:42 -0000
@@ -322,14 +322,12 @@
 
 sub try_bug_report {
     my $self = shift;
-    if ($? && $self->{opts}->{bugreport}) {
+    if ($? && $self->{opts}->{bugreport} && 
+              $self->can('bug_report')) {
         $self->bug_report;
     }
 }
 
-# virtual method: does nothing
-sub bug_report {}
-
 #throw away cached config and start fresh
 sub refresh {
     my $self = shift;
@@ -983,9 +981,18 @@
 # generate t/TEST script (or a different filename) which will drive
 # Apache::TestRun
 sub generate_script {
-    my ($class, $file) = @_;
+    my ($class, @opts) = @_;
+
+    my %opts = ();
 
-    $file ||= catfile 't', 'TEST';
+    # back-compat
+    if (@opts == 1) {
+        $opts{file} = $opts[0];
+    }
+    else {
+        %opts = @opts;
+        $opts{file} ||= catfile 't', 'TEST';
+    }
 
     my $body = "BEGIN { eval { require blib; } }\n";
 
@@ -998,9 +1005,18 @@
     my $header = Apache::TestConfig->perlscript_header;
 
     $body .= join "\n",
-        $header, "use $class ();", "$class->new->run(\@ARGV);";
+        $header, "use $class ();";
+
+    if (my $report = $opts{bugreport}) {
+        $report = eval { $report->() } if UNIVERSAL::isa($report, 'CODE');
+
+        $body .= "\n\npackage $class;\n" .
+                 "sub bug_report { print '$report' }\n\n";
+    }
+    
+    $body .= "$class->new->run(\@ARGV);";
 
-    Apache::Test::config()->write_perlscript($file, $body);
+    Apache::Test::config()->write_perlscript($opts{file}, $body);
 }
 
 # in idiomatic perl functions return 1 on success 0 on


--------------000404080903020403070500
Content-Type: text/plain; charset=us-ascii

---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
--------------000404080903020403070500--