rt/sbin/extract_pod_tests

   1 #!/usr/bin/perl
   2 # BEGIN LICENSE BLOCK
   3 #
   4 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
   5 #
   6 # (Except where explictly superceded by other copyright notices)
   7 #
   8 # This work is made available to you under the terms of Version 2 of
   9 # the GNU General Public License. A copy of that license should have
  10 # been provided with this software, but in any event can be snarfed
  11 # from www.gnu.org.
  12 #
  13 # This work is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 # General Public License for more details.
  17 #
  18 # Unless otherwise specified, all modifications, corrections or
  19 # extensions to this work which alter its source code become the
  20 # property of Best Practical Solutions, LLC when submitted for
  21 # inclusion in the work.
  22 #
  23 #
  24 # END LICENSE BLOCK
  25
  26 use strict;
  27 use vars qw($VERSION);
  28 $VERSION = '0.06';
  29
  30 use Pod::Tests;
  31 use Symbol;
  32
  33 =pod
  34
  35 =head1 NAME
  36
  37 extract_pod_tests -  RT-specific variant of pod2tests
  38
  39 =head1 SYNOPSIS
  40
  41   pod2test [-Mmodule] [input [output]]
  42
  43 =head1 DESCRIPTION
  44
  45 B<pod2test> is a front-end for Test::Inline.  It generates the
  46 "Bodies" of MakeMaker style .t testing files from embedded tests and
  47 code examples.
  48
  49 If output is not specified, the resulting .t file will go to STDOUT.
  50 Otherwise, it will go to the given output file.  If input is not
  51 given, it will draw from STDIN.
  52
  53 If the given file contains no tests or code examples, no output will
  54 be given and no output file will be created.
  55
  56 =cut
  57
  58 my($infile, $outfile) = @ARGV;
  59 my($infh,$outfh);
  60
  61
  62 if( defined $infile ) {
  63     $infh = gensym;
  64     open($infh, $infile) or
  65       die "Can't open the POD file $infile: $!";
  66 }
  67 else {
  68     $infh = \*STDIN;
  69 }
  70
  71 unless ($outfile) {
  72      ( my $test = $infile ) =~ s/\.(pm|pod)$//;
  73             $test =~ s/^lib\W//;
  74             $test =~ s/\W/-/;
  75             $test =~ s/\//__/g;
  76
  77         $outfile = "lib/t/autogen/autogen-$test.t";
  78 }
  79
  80
  81 my $p = Pod::Tests->new;
  82 $p->parse_fh($infh);
  83
  84 # XXX Hack to put the filename into the #line directive
  85 $p->{file} = $infile || '';
  86
  87 my @tests    = $p->build_tests($p->tests);
  88 my @examples = $p->build_examples($p->examples);
  89
  90 exit unless @tests or @examples;
  91
  92
  93 if( defined $outfile) {
  94     $outfh = gensym;
  95     open($outfh, ">$outfile") or
  96       die "Can't open the test file $outfile: $!";
  97 }
  98 else {
  99     $outfh = \*STDOUT;
 100 }
 101
 102
 103
 104 foreach my $test (@tests, @examples) {
 105     print $outfh "$test\n";
 106 }
 107
 108 print $outfh "1;\n";
 109
 110 =pod
 111
 112 =head1 BUGS and CAVEATS
 113
 114 This is a very simple rough cut.  It only does very rudimentary tests
 115 on the examples.
 116
 117 =head1 AUTHOR
 118
 119
 120
 121 Based on pod2tests by Michael G Schwern <schwern@pobox.com>
 122
 123 =head1 SEE ALSO
 124
 125 L<Test::Inline>
 126
 127 =cut
 128
 129 1;