view release on metacpan or  search on metacpan

lib/App/Glacier/Core.pm  view on Meta::CPAN

package App::Glacier::Core;
use strict;
use warnings;
use Getopt::Long qw(GetOptionsFromArray :config gnu_getopt no_ignore_case require_order);
use Pod::Man;
use Pod::Usage;
use Pod::Find qw(pod_where);
use File::Basename;
use Storable;
use Carp;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(usage_error
                 pod_usage_msg
                 EX_OK
                 EX_FAILURE
                 EX_USAGE       
                 EX_DATAERR     
                 EX_NOINPUT     
                 EX_NOUSER      
                 EX_NOHOST      
                 EX_UNAVAILABLE 
                 EX_SOFTWARE    
                 EX_OSERR       
                 EX_OSFILE      
                 EX_CANTCREAT   
                 EX_IOERR       
                 EX_TEMPFAIL    
                 EX_PROTOCOL    
                 EX_NOPERM      
                 EX_CONFIG);

use constant {
    EX_OK => 0,
    EX_FAILURE => 1,
    EX_USAGE        => 64, 
    EX_DATAERR      => 65, 
    EX_NOINPUT      => 66, 
    EX_NOUSER       => 67, 
    EX_NOHOST       => 68, 
    EX_UNAVAILABLE  => 69, 
    EX_SOFTWARE     => 70, 
    EX_OSERR        => 71, 
    EX_OSFILE       => 72, 
    EX_CANTCREAT    => 73, 
    EX_IOERR        => 74, 
    EX_TEMPFAIL     => 75, 
    EX_PROTOCOL     => 76, 
    EX_NOPERM       => 77, 
    EX_CONFIG       => 78 
};


sub new {
    my ($class, $argref) = (shift, shift);
    my $self = bless {
	_debug => 0,
	_dry_run => 0,
	_progname => basename($0)
    }, $class;

    $self->{_argref} = $argref // \@ARGV;
    my %opts;
    local %_ = @_;
    
    if (my $optmap = delete $_{optmap}) {
	foreach my $k (keys %{$optmap}) {
	    if (ref($optmap->{$k}) eq 'CODE') {
		$opts{$k} = sub { &{$optmap->{$k}}($self, @_ ) }
	    } elsif (ref($optmap->{$k})) {
		$opts{$k} = $optmap->{$k};
	    } else {
		$opts{$k} = \$self->{_options}{$optmap->{$k}}
	    }
	}
    }
    croak "unrecognized parameters" if keys(%_);

    $opts{'shorthelp|?'} = sub {
	pod2usage(-message => $self->pod_usage_msg,
		  -input => pod_where({-inc => 1}, ref($self)),
		  -exitstatus => EX_OK)
    };
    $opts{help} = sub {
	pod2usage(-exitstatus => EX_OK,
		  -verbose => 2,
		  -input => pod_where({-inc => 1}, ref($self)))
    };
    $opts{usage} = sub {
	pod2usage(-exitstatus => EX_OK,
		  -verbose => 0,
		  -input => pod_where({-inc => 1}, ref($self)))
    };
    $opts{'debug|D'} = sub { $self->{_debug}++ };
    $opts{'dry-run|n'} = sub { $self->{_debug}++; $self->{_dry_run} = 1 };
    $opts{'program-name=s'} = sub { $self->{_progname} = $_[1] };
    
    GetOptionsFromArray($self->{_argref}, %opts);