view release on metacpan or  search on metacpan

lib/Qgoda/Command.pm  view on Meta::CPAN

    $args ||= [];
    my %options = $self->parseOptions($args);

    return $self->_run($args, $global_options, %options);
}

sub parseOptions {
    my ($self, $args) = @_;

    my %options = $self->_getDefaults;
    my %specs = $self->_getOptionSpecs;
    $specs{help} = 'h|help';

    my %optspec;
    foreach my $key (keys %specs) {
        $optspec{$specs{$key}} = 
                ref $options{$key} ? $options{$key} : \$options{$key};
    }

    Getopt::Long::Configure('bundling');
    {
        local $SIG{__WARN__} = sub {
            $SIG{__WARN__} = 'DEFAULT';
            $self->__usageError(shift);
        };

        GetOptionsFromArray($args, %optspec);
    }

    # Exits.
    $self->_displayHelp if $options{help};

    return %options;
}

sub _getDefaults {}
sub _getOptionSpecs {};

sub __usageError {
    my ($self, @msg) = @_;

    my $class = ref $self;
    $class =~ s/^Qgoda::Command:://;
    my $cmd = join '-', map { lcfirst $_ } split /::/, $class;

    return Qgoda::CLI->commandUsageError($cmd, @msg);
}

sub _displayHelp {
    my ($self) = @_;

    my $module = class2module ref $self;

    my $path = $INC{$module};
    $path = './' . $path if !File::Spec->file_name_is_absolute($path);

    $^W = 1 if $ENV{'PERLDOCDEBUG'};
    pop @INC if $INC[-1] eq '.';
    require Pod::Perldoc;
    local @ARGV = ($path);
    exit(Pod::Perldoc->run());
}

1;