import of rt 3.0.4

[freeside.git] / rt / sbin / extract_pod_tests

diff --git a/rt/sbin/extract_pod_tests b/rt/sbin/extract_pod_tests
new file mode 100644 (file)
index 0000000..ed01c7d
--- /dev/null
+++ b/rt/sbin/extract_pod_tests
@@ -0,0 +1,129 @@
+#!/usr/bin/perl
+# BEGIN LICENSE BLOCK
+# 
+# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+# 
+# (Except where explictly superceded by other copyright notices)
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# Unless otherwise specified, all modifications, corrections or
+# extensions to this work which alter its source code become the
+# property of Best Practical Solutions, LLC when submitted for
+# inclusion in the work.
+# 
+# 
+# END LICENSE BLOCK
+
+use strict;
+use vars qw($VERSION);
+$VERSION = '0.06';
+
+use Pod::Tests;
+use Symbol;
+
+=pod
+
+=head1 NAME
+
+extract_pod_tests -  RT-specific variant of pod2tests
+
+=head1 SYNOPSIS
+
+  pod2test [-Mmodule] [input [output]]
+
+=head1 DESCRIPTION
+
+B<pod2test> is a front-end for Test::Inline.  It generates the 
+"Bodies" of MakeMaker style .t testing files from embedded tests and 
+code examples.
+
+If output is not specified, the resulting .t file will go to STDOUT.
+Otherwise, it will go to the given output file.  If input is not
+given, it will draw from STDIN.
+
+If the given file contains no tests or code examples, no output will
+be given and no output file will be created.
+
+=cut
+
+my($infile, $outfile) = @ARGV;
+my($infh,$outfh);
+
+
+if( defined $infile ) {
+    $infh = gensym;
+    open($infh, $infile) or 
+      die "Can't open the POD file $infile: $!";
+}
+else {
+    $infh = \*STDIN;
+}
+
+unless ($outfile) {
+     ( my $test = $infile ) =~ s/\.(pm|pod)$//;
+            $test =~ s/^lib\W//;
+            $test =~ s/\W/-/;
+            $test =~ s/\//__/g;
+
+        $outfile = "lib/t/autogen/autogen-$test.t";
+}
+
+
+my $p = Pod::Tests->new;
+$p->parse_fh($infh);
+
+# XXX Hack to put the filename into the #line directive
+$p->{file} = $infile || '';
+
+my @tests    = $p->build_tests($p->tests);
+my @examples = $p->build_examples($p->examples);
+
+exit unless @tests or @examples;
+
+
+if( defined $outfile) {
+    $outfh = gensym;
+    open($outfh, ">$outfile") or
+      die "Can't open the test file $outfile: $!";
+}
+else {
+    $outfh = \*STDOUT;
+}
+
+
+
+foreach my $test (@tests, @examples) {
+    print $outfh "$test\n";
+}
+
+print $outfh "1;\n";
+
+=pod
+
+=head1 BUGS and CAVEATS
+
+This is a very simple rough cut.  It only does very rudimentary tests
+on the examples.
+
+=head1 AUTHOR
+
+
+
+Based on pod2tests by Michael G Schwern <schwern@pobox.com>
+
+=head1 SEE ALSO
+
+L<Test::Inline>
+
+=cut
+
+1;