#! /usr/bin/perl

#  Copyright (C) 2010, Geoffrey Leach
#
#===============================================================================
#
#         FILE:  03-options_long.t
#
#  DESCRIPTION:  Test combinations of 'long' ('--') run-time options
#
#       AUTHOR:  Geoffrey Leach (), <geoff@hughes.net>
#      VERSION:  1.9.7
#      CREATED:  07/06/2009 03:27:58 PM PDT
#===============================================================================

use strict;
use warnings;

use Test::More tests => 17;
use Test::Output;

use 5.006;
our $VERSION = '1.9.7';

## no critic (RequireLocalizedPunctuationVars)
## no critic (ProhibitPackageVars)

BEGIN {

   # This simulates our being called with various options on the command line.
   # It's here because Getopt::Auto needs to look at it
    @ARGV
        = qw(--foo --bar bararg1 bararg2 notanarg --tar-arr=tararg2 --nosubs --foo-bar -- --foobar);
    use Getopt::Auto{ 'nohelp' => 1 };
}

# Notice that the subroutine-global variables, such as $is_foo_called are
# not initialized. That's because by the time we get here in the normal course
# of execution, the subroutines have already been executed by the processing
# of @ARGV by Getopt::Auto.

our %options;

# Option has no args
my $is_foo_called;
sub foo { $is_foo_called = 1; return; }
ok( $is_foo_called, 'Calling foo()' );

my $is_foo_bar_called;
sub foo_bar { $is_foo_bar_called = 1; return; }
ok( $is_foo_bar_called, 'Calling foo_bar()' );

# Option has two args
my $is_bar_called;

sub bar {
    $is_bar_called = ( shift @ARGV ) . ' and ' . shift @ARGV;
    return;
}
ok( defined $is_bar_called, "Calling bar() with $is_bar_called" );

# Option has one arg, tied with '='
my $is_tar_arr_called;
sub tar_arr { $is_tar_arr_called = shift @ARGV; return; }
ok( defined $is_tar_arr_called, "Calling tar_arr() with $is_tar_arr_called" );

# Option occurs after '--', so is not called
# Subroutine is required as otherwise its always ignored
my $is_foobar_called;
sub foobar { $is_foobar_called = 1; return; }
ok( !defined $is_foobar_called, 'Foobar was not called' );

# --nosubs has no associated sub, so ..
ok( defined $options{'--nosubs'}, 'Option "--nosubs" processed correcly' );

# Check the leftover command line args, and their position
ok( $ARGV[0] eq 'notanarg',
    'Unused command line argument "notanarg" remains' );
ok( $ARGV[1] eq '--foobar',
    'Unused command line argument "--foobar" remains' );

# Verify not a registered option
@ARGV = qw{ --abc };
stderr_is(
    \&Getopt::Auto::_parse_args,
    "Getopt::Auto: --abc is not a registered option\n",
    '--abc correctly not a registered option'
);

my $Eq1_is_called;
sub Eq1 { $Eq1_is_called = shift @ARGV; return; }

@ARGV = qw{ --Eq1=5 --Eq2=99 --Eq3=111 };
stderr_is(
    \&Getopt::Auto::_parse_args,
    "Getopt::Auto: --Eq2 is not a registered option\n"
        . "Getopt::Auto: To use --Eq3 with \"=\", a subroutine must be provided\n",
    '--Eq2 correctly not registered option, --Eq3 has no sub'
);
ok( $Eq1_is_called == 5, 'Eq1() correct' );
ok( $ARGV[0] eq '--Eq2=99',  '--Eq2 restored to ARGV' );
ok( $ARGV[1] eq '--Eq3=111', '--Eq3 restored to ARGV' );

# Test elimination of POD formatting from option definitions
@ARGV = qw{ --bold --italic --i --b };
Getopt::Auto::_parse_args();
ok( defined $options{'--italic'}, 'Option "--italic" processed correcly' );
ok( defined $options{'--bold'},   'Option "--bold" processed correcly' );
ok( defined $options{'--i'},      'Option "--i" processed correcly' );
ok( defined $options{'--b'},      'Option "--b" processed correcly' );

exit 0;

__END__

=pod

=begin stopwords
Nosub
nosubs 
=end stopwords 

=head2 --foo - do a foo

This is the help for --foo

=head3 --bar - do a bar

This is the help for --bar
Note: "=head3"

=head4 --tar-arr - do a tar-arr

This is the help for --tar-arr.
Which also proves the - => _ feature
Note: "=head4"

=head2 --foobar - do a foobar

This is the help for --foobar, which won't be executed
because of the '--' in the command line

=over 4

=item --nosubs -- bump a counter

Note: "=item"

=back

Nosub has -- surprise -- no associated sub

=head2 --foo-bar - This tests embedded dashes

=item --Eq1 - assignment op

=item --Eq3 - assignment op, no sub

=item I<--italic> - 

=item B<--bold> - 

=item I<--i>, B<--b> - 

=cut