App-Basis

 view release on metacpan or  search on metacpan

bin/appbasis  view on Meta::CPAN

            default => 'testing 123',

            # required => 1,
        },
        'item=s' => {

            # required  => 1,
            default => '123',
            desc    => 'another item',

            # validate => sub { my $val = shift ; return $val eq 'item'}
        }    
    },
    #log_file => "your-logfile",
);

# debug will go into "~/$program.log" by default

# lets have the config named after this program
my $cfg = App::Basis::Config->new( filename => "~/.$program" ) ;
# example of using an app specifc config

lib/App/Basis.pm  view on Meta::CPAN

    } else {
        my ($data) = @_ ;
        say STDERR Dump($data) if ($verbose) ;
    }
}

# ----------------------------------------------------------------------------
# check that the option structure does not have repeated things in it
# returns string of any issue

sub _validate_options
{
    my ($options) = @_ ;
    my %seen ;
    my $result = "" ;

    foreach my $opt ( keys %{$options} ) {
        # options are long|short=, or thing=, or flags long|sort, or long
        my ( $long, $short ) ;
        if ( $opt =~ /^(.*?)\|(.*?)=/ ) {
            $long  = $1 ;

lib/App/Basis.pm  view on Meta::CPAN

    my @keys         = sort keys %{ $args{options} } ;
    my %dnames       = _desc_names(@keys) ;
    my $max_desc_len = max( map length, values %dnames ) + 1 ;
    my $help_fmt     = "    %-${max_desc_len}s    %s\n" ;

    # add help text for 'help' first.
    $_app_simple_help_options .= sprintf $help_fmt, $dnames{'help|h|?'},
        'Show help' ;

    #
    my $msg = _validate_options( $args{options} ) ;
    if ($msg) {
        die "$msg" ;
    }

    # get options and their descriptions
    foreach my $o (@keys) {

        # save the option
        push @options, $o ;

lib/App/Basis.pm  view on Meta::CPAN

            $full_options{$name} = $args{options}->{$o} ;
            $has_required++ if ( $full_options{$name}->{required} ) ;
        } else {
            $full_options{$name} = {
                desc => $args{options}->{$o},

                # possible options that can be passed
                # depends => '',
                # default => '',
                # required => 0,
                # validate => sub {}
            } ;
        }

        # save the option string too
        $full_options{$name}->{options} = $o ;

        # build the entry for the help text
        my $desc = $full_options{$name}->{desc} ;
        if ( $name ne 'help' ) {
            my $desc = $full_options{$name}->{desc} ;

lib/App/Basis.pm  view on Meta::CPAN

            }
        }

        # set a default if there is no value
        if ( $full_options{$name}->{default} ) {
            $_cmd_line_options{$name} = $full_options{$name}->{default}
                if ( !$_cmd_line_options{$name} ) ;
        }

        # call the validation routine if we have one
        if ( $_cmd_line_options{$name} && $full_options{$name}->{validate} ) {
            die "need to pass a coderef to validate for option '$name'"
                if ( !ref( $full_options{$name}->{validate} ) eq 'CODE' ) ;
            die
                "Option '$name' has validate and should either also have a default or be required"
                if (
                !(     $full_options{$name}->{required}
                    || $full_options{$name}->{default}
                )
                ) ;
            my $coderef = $full_options{$name}->{validate} ;
            my $result  = $coderef->( $_cmd_line_options{$name} ) ;
            show_usage("Option '$name' does not pass validation")
                if ( !$result ) ;
        }
    }

    # auto set verbose if it has been used
    set_verbose( $_cmd_line_options{verbose} ) ;

    return %_cmd_line_options ;

lib/App/Basis.pm  view on Meta::CPAN

    my %opt = App::Basis::init_app(
    help_text   => 'Sample program description'
    , help_cmdline => 'extra stuff to print about command line use'
    , options   =>  {
        'file|f=s'  => {
            desc => 'local system location of xml data'
            , required => 1
        }
        , 'url|u=s' => {
            desc => 'where to find xml data on the internet'
            , validate => sub { my $url = shift ; return $url =~ m{^(http|file|ftp)://} ; }
        }
        , 'keep|k'  => {
            # no point in having this if there is no file option
            desc => 'keep the local file, do not rename it'
            , depends => 'file'
        }
        , 'counter|c=i' => {
            desc => 'check a counter'
            , default   => 5
        }

lib/App/Basis.pm  view on Meta::CPAN

      simple way
      'fred'     => 'some description of fred'
      'fred|f'   => 'fred again, also allows -f as a variant'
      'fred|f=s' => 'fred needs to be a string'
      'fred|f=i' => 'fred needs to be an integer'

      complex way, more features, validation, dependancies etc
      'fred|f=s' => {
         desc      => 'description of argument',
         # check if fred is one of the allowed things
         validate  => sub { my $fred = shift ; $fred =~ m/bill|mary|jane|sam/i ;},
         # does this option need another option to exist
         depends   => 'otheroption'
       }
      'fred|f=s' => {
         desc     => 'description of argument',
         default  => 'default value for fred'
      }

B<Note will die if not passed a HASH of arguments>

t/01_app.t  view on Meta::CPAN

try {
    @ARGV = ( '--fred=123', '--bill' );
    my %opt = init_app(
        help_text => "Boiler plate code for an App::Basis app",
        options   => {
            'fred=i' => {
                desc     => 'something',
                required => 1,
                depends  => 'bill',
                default  => 123,
                validate => 123
            },
            bill => { desc => 'somedesc' }
        }
    );
}
catch {
    note "  CORRECT: caught $_";
    $status = 1;
};
ok( $status, 'invalid validate function' );
$status = 0;

try {
    @ARGV = ( '--fred=123', '--bill' );
    my %opt = init_app(
        help_text => "Boiler plate code for an App::Basis app",
        options   => {
            'fred=i' => {
                desc     => 'something',
                required => 1,
                depends  => 'bill',
                default  => 123,
                validate => sub { my $val = shift; return $val == 123; }
            },
            bill => { desc => 'somedesc' }
        }
    );
    $status = 1;
}
catch {
    note "  ERROR: caught $_";
};
ok( $status, 'validated parameter' );
$status = 0;

try {
    @ARGV = ( '--fred=123', '--bill' );
    my %opt = init_app(
        help_text => "Boiler plate code for an App::Basis app",
        options   => {
            'fred=i' => {
                desc     => 'something',
                required => 1,
                depends  => 'bill',
                default  => 123,
                validate => sub { my $val = shift; return $val == 124; }
            },
            bill => { desc => 'somedesc' }
        }
    );
}
catch {
    note "  CORRECT: caught $_";
    $status = 1;
};
ok( $status, 'fails validated parameter' );
$status = 0;

try {
    @ARGV = (  );
    my %opt = init_app(
        help_text => "Boiler plate code for an App::Basis app",
        options   => {
            'help|h' => "extra help",
            "bill|h" => "reuse h"
        }