view release on metacpan or  search on metacpan

t/Getopt-Tree.t  view on Meta::CPAN

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl Getopt-Tree.t'
use Test::More qw/ no_plan /;

use strict;
use lib '../lib';
use Getopt::Tree;

sub call_with_slurped_pipe {
    my ( $callme ) = @_;
    my ( $usage_reader, $usage_writer );

    pipe( $usage_reader, $usage_writer );
    ok( $usage_writer );

    select $usage_writer;
    $|++;
    select STDOUT;
    local $/ = undef;

    $callme->($usage_writer);
    close( $usage_writer );
    my $r = <$usage_reader>;
    close( $usage_reader );
    return $r;
}

sub test_parse_command_line {
    my ( $params, $cli ) = @_;

    local @ARGV = split( m/ +/, $cli );
    local $SIG{__WARN__} = sub {};
    my ( $op, $config ) = parse_command_line( $params );
    ok( $op && $config, $cli );
    return ( $op, $config );
}

#########################

use constant STATUS_REGEX => qr/(OPEN|CLOSED|HOLD)/;
use constant TICKET_REGEX => qr/(\d+)/;

my $p;
{
    my $param_status_sub = sub {
        my ( $v ) = @_;
        if   ( $v =~ /hold/i ) { return 'On Hold' }
        else                   { return ucfirst( lc( $v ) ) }
    };

    $p = [
        { name => 'debug', abbr => 'd', exists => 1, optional => 1, descr => 'Enable debugging output.' },
        {
            name     => 'user',
            abbr     => 'u',
            optional => 1,
            descr    => 'Ticketing username, defaults to scalar(getpwuid($<)).'
        },
        {
            name     => 'no-cache',
            abbr     => 'nc',
            exists   => 1,
            optional => 1,
            descr    => 'Don\'t cache your credentials in /tmp/.'
        },
        {
            name     => 'qa',
            exists   => 1,
            optional => 1,
            descr    => 'Connect to the test system instead of the prod system.'
        },
        {
            name     => 'help',
            abbr     => 'h',
            exists   => 1,
            descr    => 'Print usage information.',
        },
        {
            name   => 'search',
            abbr   => 's',
            descr  => 'Search for ticket, list tickets in queue, or print contents of a ticket.',
            exists => 1,
            params => [{
                    name   => 'ticket',
                    abbr   => 't',
                    re     => TICKET_REGEX,
                    descr  => 'The ticket number to search for.',
                    params => [{
                            name     => 'show-all-fields',
                            exists   => 1,
                            optional => 1,
                            descr    => 'Show all ticket fields.'
                        },
                        {
                            name     => 'show-worklog',
                            abbr     => 'w',
                            exists   => 1,
                            optional => 1,
                            descr    => 'Display the ticket\'s worklog.',
                            params   => [{
                                    name     => 'show-all-worklog-fields',
                                    exists   => 1,
                                    optional => 1,
                                    descr    => 'Show all worklog fields.'
                                }
                            ],
                        },
                        {
                            name     => 'shrink-whitespace',
                            abbr     => 'sw',
                            exists   => 1,
                            optional => 1,
                            descr    => 'Compress multiple newlines to a single newline for display.',
                        },
                    ]
                },
                {