1 files changed, 157 insertions, 0 deletions
diff --git a/rt/sbin/extract_pod_tests b/rt/sbin/extract_pod_tests
new file mode 100644
index 000000000..4d9d7bd6c
--- /dev/null
+++ b/rt/sbin/extract_pod_tests
@@ -0,0 +1,157 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+#  
+# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC 
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# 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.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED 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;
+}
+
+
+print $outfh <<EOF;
+
+use Test::More qw/no_plan/;
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+EOF
+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;