The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#! /usr/bin/perl

#  Copyright (C) 2010, Geoffrey Leach

#===============================================================================
#
#         FILE:  03-options_text.t
#
#  DESCRIPTION:  Test some variations on the text in POD options
#
#        FILES:  ---
#         BUGS:  ---
#        NOTES:  ---
#       AUTHOR:  Geoffrey Leach (), geoff@hughes.net
#      COMPANY:
#      VERSION:  1.9.7
#      CREATED:  11/05/2009 04:31:11 PM
#     REVISION:  ---
#===============================================================================

use strict;
use warnings;

use Test::More tests => 6;
use Test::Output qw{ stderr_from };
use Getopt::Auto( { test => 1 } );

use 5.006;
our $VERSION = '1.9.7';
my $me = '03-options_text.t';

## no critic (ProhibitImplicitNewlines)
## no critic (ProtectPrivateSubs)
## no critic (RequireLocalizedPunctuationVars)
## no critic (ProtectPrivateVars)
## no critic (ProhibitPackageVars)
## no critic (ProhibitEmptyQuotes)

# Will be assigned by Getopt::Auto
our %options;
if ( %options ) {}; # Avoid complaints from perl-5.6.2

# What we expect to find in the spec list
my @exspec = (
    [ '--bar', 'do a bar', undef, \&bar ],
    [   '--foo', 'do a foo', 'Test long help for foo.

And this is the second paragraph for foo\'s help.
', \&foo
    ],
    [ '--tar', '', undef, \&tar ],
);

# What we expect to find in the options hash
# This is the proof that --far is processed correctly:
# there is no option entry for it
my %ex_options = (
    '--foo' => {
        'longhelp' => 'Test long help for foo.

And this is the second paragraph for foo\'s help.
',
        'code'       => \&foo,
        'shorthelp'  => 'do a foo',
        'options'    => 'main::options',
        'package'    => 'main',
        'registered' => 1,
    },
    '--bar' => {
        'longhelp'   => undef,
        'code'       => \&bar,
        'shorthelp'  => 'do a bar',
        'options'    => 'main::options',
        'package'    => 'main',
        'registered' => 1,
    },
    '--tar' => {
        'longhelp'   => undef,
        'code'       => \&tar,
        'shorthelp'  => '',
        'options'    => 'main::options',
        'package'    => 'main',
        'registered' => 1,
    },
    '--version' => {
        'shorthelp'  => 'Prints the version number',
        'code'       => \&Getopt::Auto::_version,
        'registered' => 1,
    },
    '--help' => {
        'shorthelp'  => 'This text',
        'code'       => \&Getopt::Auto::_help,
        'registered' => 1,
    },
);

my $is_foo_called;
sub foo { ++$is_foo_called; return; }

my $is_bar_called;
sub bar { ++$is_bar_called; return; }

my $is_tar_called;
sub tar { ++$is_tar_called; return; }

my $is_far_called;
sub far { ++$is_far_called; return; }

is_deeply( Getopt::Auto::_get_spec_ref(),
    \@exspec, 'Spec gets built correctly' );
is_deeply( Getopt::Auto::_get_options_ref(),
    \%ex_options, '... and gets converted to options OK' );

@ARGV = qw(--foo --bar --tar --far);
my $help =
    "Getopt::Auto: --far is not a registered option\n" .
    "This is $me version $VERSION\n" .
    "\n" .
    "$me --bar - do a bar\n" .
    "$me --foo - do a foo [*]\n" .
    "$me --help - This text\n" .
    "$me --tar\n" .
    "$me --version - Prints the version number\n" .
    "\n" .
    "More help is available on the topics marked with [*]\n" .
    "Try $me --help --foo\n" .
    "This is the built-in help, exiting\n";

my $stderr = stderr_from( \&Getopt::Auto::_parse_args );
$stderr =~ s{\S+$me}{$me}gxism; 
is( $stderr, $help, '--far is not a registered option' );

ok( $is_foo_called, 'Sub foo() was called' );
ok( $is_bar_called, 'Sub bar() was called' );
ok( $is_tar_called, 'Sub tar() was called' );

exit 0;

__END__

=pod

=begin stopwords
foo
=end stopwords

=head2 --foo - do a foo

Test long help for foo.

And this is the second paragraph for foo's help.

=head2 --bar - do a bar

=head2 --tar - 

=head2 --far -

=cut