#!perl use strict; use warnings; use Test::More; use Test::Differences; use Carp qw(confess); use Cwd qw(getcwd chdir); use English qw(-no_match_vars $OS_ERROR $INPUT_RECORD_SEPARATOR); $ENV{AUTHOR_TESTING} or plan( skip_all => 'Set $ENV{AUTHOR_TESTING} to run this test.' ); plan( tests => 2 ); my @data = ( { test => '01_example', path => 'example', filename => '01_example.pl', params => '-I../lib', cmd_result => <<'EOT', 01_example.pl [-?hv] [long options...] -v --verbose Print extra stuff. And here I show, how to work with lots of lines as floating text. -? -h --help Print usage message and exit. EOT result => <<'EOT', #!perl ## no critic (TidyCode) use strict; use warnings; our $VERSION = 0; use Carp qw(confess); use Const::Fast qw(const); use English qw(-no_match_vars $OS_ERROR); use Getopt::Long::Descriptive; use Getopt::Long::DescriptivePod; const my $INDENT => 4; my ($opt, $usage) = describe_options( '01_example.pl %o ', [ 'verbose|v', trim_lines( <<'EOT' ) ], Print extra stuff. And here I show, how to work with lots of lines as floating text. EOT [], # an empty line [ 'help|h|?', 'Print usage message and exit.' ], ); if ( $opt->{help} ) { () = print $usage; replace_pod({ tag => '=head1 USAGE', indent => $INDENT, before_code_block => trim_lines( <<'EOT', $INDENT ), This is floating text in Pod before that code block with the usage inside. EOT code_block => $usage->text, # Here indent counts the groups of spaces of the first line # and removes that at all next lines. # 4 space code ident instead if 1 space works with floating text before. after_code_block => trim_lines( <<'EOT', $INDENT ), This is floating text in Pod after that code block with the usage inside. this_is_code_in_pod( 1, ); EOT }); } # $Id: $ __END__ =head1 NAME for test only =head1 USAGE This is floating text in Pod before that code block with the usage inside. 01_example.pl [-?hv] [long options...] -v --verbose Print extra stuff. And here I show, how to work with lots of lines as floating text. -? -h --help Print usage message and exit. This is floating text in Pod after that code block with the usage inside. this_is_code_in_pod( 1, ); =head1 DESCRIPTION =head1 REQUIRED ARGUMENTS =head1 OPTIONS =head1 DIAGNOSTICS =head1 EXIT STATUS =head1 CONFIGURATION =head1 DEPENDENCIES =head1 INCOMPATIBILITIES =head1 BUGS AND LIMITATIONS =head1 AUTHOR =head1 LICENSE AND COPYRIGHT EOT }, ); for my $data (@data) { my $current_dir = getcwd(); my $example_dir = "$current_dir/$data->{path}"; chdir($example_dir); local $INPUT_RECORD_SEPARATOR = (); open my $file_handle, q{<}, $data->{filename} or confess "$data->{test} read $data->{filename} $OS_ERROR"; my $old_content = <$file_handle>; () = close $file_handle; my $cmd_result = qx{perl $data->{params} $data->{filename} --help 2>&3}; open $file_handle, q{<}, $data->{filename} or confess "$data->{test} read $data->{filename} $OS_ERROR"; my $new_content = <$file_handle>; () = close $file_handle; eq_or_diff( do { $cmd_result =~ s{ \t }{ q{ } x 4 }xmsge; $cmd_result =~ s{ [ ]+ $ }{}xmsg; $cmd_result; }, $data->{cmd_result}, "$data->{test} untabified and right trimmed cmd result", ); eq_or_diff( $new_content, do { $data->{result} =~ s{^ [ ]{4} }{}xmsg; $data->{result}; }, "$data->{test} content", ); open $file_handle, q{>}, $data->{filename} or confess "$data->{test} write $data->{filename} $OS_ERROR"; print {$file_handle} $old_content or confess "$data->{test} write $data->{filename} $OS_ERROR"; close $file_handle or confess "$data->{test} write $data->{filename} $OS_ERROR"; chdir($current_dir); }