#!/usr/bin/perl -w

use strict;
use vars qw($VERSION);
$VERSION = '0.01';

use Pod::Tests;

=pod

=head1 NAME

pod2test - Convert embedded tests and code examples to .t files

=head1 SYNOPSIS

  pod2test [-Mmodule] [input [output]]

=head1 DESCRIPTION

B<pod2test> is a front-end for Pod::Tests.  It generates 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.

The Test module is made available to the testing blocks.  Any further
modules which should be used are specified with -M. B<UNIMPLEMENTED>

=cut

my($infile, $outfile) = @ARGV;
my($infh,$outfh);

if( defined $infile ) {
    open($infh, $infile) or 
      die "Can't open the POD file $infile: $!";
}
else {
    $infh = \*STDIN;
}

if( defined $outfile) {
    open($outfh, ">$outfile") or
      die "Can't open the test file $outfile: $!";
}
else {
    $outfh = \*STDOUT;
}

my $p = Pod::Tests->new;
$p->parse_fh($infh);

my @tests    = build_tests($p->tests);
my @examples = build_examples($p->examples);

sub build_tests {
    my(@tests) = @_;

    my @code = ();
    foreach my $test (@tests) {
        push @code, <<CODE;
# From line $test->{line}
{
    $test->{code}
}
CODE

    }

    return @code;
}


sub build_examples {
    my(@examples) = @_;

    my @code = ();
    foreach my $example (@examples) {
        push @code, <<CODE;
# From line $example->{line}
eval {
    local $^W = 0;
    $example->{code};
};
ok(!\$@);
CODE

    }

    return @code;
}


# XXX This logic will have to be *much* smarter.  We can't assume
# XXX one block == one ok.
my $num_tests = @tests + @examples;

my $perl = '/usr/bin/perl';  # XXX eventually this will be smarter.
print $outfh <<"TEST";
#!$perl -w

use Test;

BEGIN { plan tests => $num_tests; }
TEST

foreach my $test (@tests, @examples) {
    print $outfh "$test\n";
}


=pod

=head1 BUGS and CAVEATS

This is a very simple rough cut.  It currently assumes only one ok per
test block and only does very rudimentary tests on the examples.

=head1 AUTHOR

Michael G Schwern <schwern@pobox.com>

=head1 SEE ALSO

L<Pod::Tests>

=cut

1;
