The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl -w

use Test::More;
use warnings;

BEGIN {
  if ($^OS_NAME eq 'MSWin32' || $^OS_NAME eq 'VMS') {
      plan skip_all => "Not portable on Win32 or VMS\n";
  }
  else {
      plan tests => 14;
  }
}
use Pod::Usage;

sub getoutput
{
  my @($code) =  @_;
  my $pid = open(my $in, "-|", "-");
  unless(defined $pid) {
    die "Cannot fork: $^OS_ERROR";
  }
  if($pid) {
    # parent
    my @out = @( ~< $in );
    close($in);
    my $exit = $^CHILD_ERROR>>8;
    s/^/#/ for  @out;
    print $^STDOUT, "#EXIT=$exit OUTPUT=+++#$(join '',@out)#+++\n";
    return @($exit, join("", @out));
  }
  # child
  open($^STDERR, ">&", $^STDOUT);
  &$code( < @_ );
  print $^STDOUT, "--NORMAL-RETURN--\n";
  exit 0;
}

sub compare($left,$right)
{
  $left  =~ s/^#\s+/#/gm;
  $right =~ s/^#\s+/#/gm;
  $left  =~ s/\s+/ /gm;
  $right =~ s/\s+/ /gm;
  return $left eq $right;
}

my @($exit, $text) =  getoutput( sub { pod2usage() } );
is ($exit, 2,                 "Exit status pod2usage ()");
ok (compare ($text, <<'EOT'), "Output test pod2usage ()");
#Usage:
#    frobnicate [ -r | --recursive ] [ -f | --force ] file ...
#
EOT

@($exit, $text) =  getoutput( sub { pod2usage(
  message => 'You naughty person, what did you say?',
  verbose => 1 ) });
is ($exit, 1,                 "Exit status pod2usage (message => '...', verbose => 1)");
ok (compare ($text, <<'EOT'), "Output test pod2usage (message => '...', verbose => 1)");
#You naughty person, what did you say?
# Usage:
#     frobnicate [ -r | --recursive ] [ -f | --force ] file ...
# 
# Options:
#     -r | --recursive
#         Run recursively.
# 
#     -f | --force
#         Just do it!
# 
#     -n number
#         Specify number of frobs, default is 42.
# 
EOT

@($exit, $text) =  getoutput( sub { pod2usage(
  "-verbose" => 2, "-exit" => 42 ) } );
is ($exit, 42,                "Exit status pod2usage (verbose => 2, exit => 42)");
ok (compare ($text, <<'EOT'), "Output test pod2usage (verbose => 2, exit => 42)");
#NAME
#     frobnicate - do what I mean
#
# SYNOPSIS
#     frobnicate [ -r | --recursive ] [ -f | --force ] file ...
#
# DESCRIPTION
#     frobnicate does foo and bar and what not.
#
# OPTIONS
#     -r | --recursive
#         Run recursively.
#
#     -f | --force
#         Just do it!
#
#     -n number
#         Specify number of frobs, default is 42.
#
EOT

@($exit, $text) =  getoutput( sub { pod2usage(0) } );
is ($exit, 0,                 "Exit status pod2usage (0)");
ok (compare ($text, <<'EOT'), "Output test pod2usage (0)");
#Usage:
#     frobnicate [ -r | --recursive ] [ -f | --force ] file ...
#
# Options:
#     -r | --recursive
#         Run recursively.
#
#     -f | --force
#         Just do it!
#
#     -n number
#         Specify number of frobs, default is 42.
#
EOT

@($exit, $text) =  getoutput( sub { pod2usage(42) } );
is ($exit, 42,                "Exit status pod2usage (42)");
ok (compare ($text, <<'EOT'), "Output test pod2usage (42)");
#Usage:
#     frobnicate [ -r | --recursive ] [ -f | --force ] file ...
#
EOT

@($exit, $text) =  getoutput( sub { pod2usage(verbose => 0, exit => 'NOEXIT') } );
is ($exit, 0,                 "Exit status pod2usage (verbose => 0, exit => 'NOEXIT')");
ok (compare ($text, <<'EOT'), "Output test pod2usage (verbose => 0, exit => 'NOEXIT')");
#Usage:
#     frobnicate [ -r | --recursive ] [ -f | --force ] file ...
#
# --NORMAL-RETURN--
EOT

@($exit, $text) =  getoutput( sub { pod2usage(verbose => 99, sections => 'DESCRIPTION') } );
is ($exit, 1,                 "Exit status pod2usage (verbose => 99, sections => 'DESCRIPTION')");
ok (compare ($text, <<'EOT'), "Output test pod2usage (verbose => 99, sections => 'DESCRIPTION')");
#Description:
#     frobnicate does foo and bar and what not.
#
EOT



__END__

=head1 NAME

frobnicate - do what I mean

=head1 SYNOPSIS

B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]>
  file ...

=head1 DESCRIPTION

B<frobnicate> does foo and bar and what not.

=head1 OPTIONS

=over 4

=item B<-r> | B<--recursive>

Run recursively.

=item B<-f> | B<--force>

Just do it!

=item B<-n> number

Specify number of frobs, default is 42.

=back

=cut