modern_perl_book_test.pl

#!/usr/bin/env perl
# tests sections of pod script with perl -c syntax check.
use warnings;
use strict;
my ( @files ) = @ARGV;

require IO::Null or do { print "IO::Null cpan module is missing..\n"; exit };
require Pod::Parser or do { print "Pod::Parser cpan module is missing..\n"; exit };

@files == 0 and do { print '$ perl ./script.pl *.pod', "\n" };

my $parser= Test::Pod::Executable->new;

for my $file ( @files ) {

	open my $fh, '<', $file or die;
	print "testing for '$file'\n";
	$parser->parse_from_filehandle( $fh, IO::Null->new );

}


package Test::Pod::Executable;
use warnings;
use strict;
use Data::Dumper;
use base qw( Pod::Parser );

sub command {
	my( $self, $cmd, $text, $line_num, $pod_para ) = @_;
	if( $cmd =~ 'begin' && $text =~ '^programlisting\s*$' ) { __set_sect( 'code' ) } 
	else { __set_sect( "else" ) }
}


sub verbatim {
	my( $self, $text, $line_num, $pod_para ) = @_;
	if( __get_sect() eq 'code' ) {
		my $c;
		do {
		$c = 0;
		$c += $text =~ s{[A-Z]<<<<<\s*([^>]+)\s*>>>>>}{$1}g;
		$c += $text =~ s{[A-Z]<<<<\s*([^>]+)\s*>>>>}{$1}g;
		$c += $text =~ s{[A-Z]<<<\s*([^>]+)\s*>>>}{$1}g;
		$c += $text =~ s{[A-Z]<<\s*([^>]+)\s*>>}{$1}g;
		$c += $text =~ s{[A-Z]<([^>]+)>}{$1}g;
		} while ( $c );
		print "$line_num\t";
		open my $perl, "|-", "perl -M5.010 -c" or die;
		print { $perl } $text;
	}
}


{
	my $current_section = "";
	sub __get_sect { $current_section }
	sub __set_sect { $current_section = shift } 
}