File Coverage

blib/lib/Module/Version/App.pm

Criterion	Covered	Total	%
statement	20	44	45.4
branch	2	24	8.3
condition			n/a
subroutine	9	10	90.0
pod	3	3	100.0
total	34	81	41.9

package Module::Version::App;
our $AUTHORITY = 'cpan:XSAWYERX';
# ABSTRACT: Application implementation for Module::Version

use strict;
use warnings;
use Carp qw< croak >;

use Getopt::Long    qw( :config no_ignore_case );
use Module::Version 'get_version';

our $VERSION = '0.13';

sub new { return bless {}, $_[0] }

sub run {
    my $self    = shift;
    my @modules;

    $self->parse_opts;

    $self->{'modules'}
        and push @modules, @{ $self->{'modules'} };

    if ( my $file = $self->{'input'} ) {
        open my $fh, '<', $file
            or croak("Cannot open '$file': $!");

        chomp( my @extra_modules = <$fh> );
        push @modules, @extra_modules;

        close $fh
            or croak("Cannot close '$file': $!");
    }

    if ( $self->{'include'} ) {
        my $include = $self->{'include'};

        ref $include eq 'ARRAY'
            or die "Error: include must be an ARRAY ref\n";

        unshift @INC, @{$include};
    }

    @modules
        or die "Error: no modules to check\n";

    foreach my $module (@modules) {
        my $version = get_version($module);
        if ( !$version ) {
            $self->{'quiet'}
                or warn "Warning: module '$module' does not seem to be installed.\n";

            next;
        }

        $self->{'dev'} or $version =~ s/_(.+)$/$1/xms;

        my $output = $self->{'full'} ? "$module $version\n" : "$version\n";
        print $output;
    }
}

sub parse_opts {
    my $self = shift;

    GetOptions(
        'h|help'       => sub { $self->help },
        'f|full!'      => \$self->{'full'},
        'i|input=s'    => \$self->{'input'},
        'I|include=s@' => \$self->{'include'},
        'd|dev!'       => \$self->{'dev'},
        'q|quiet!'     => \$self->{'quiet'},
        '<>'           => sub { $self->process(@_) },
    ) or $self->error('could not parse options');
}

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

    # force stringify Getopt::Long input
    push @{ $self->{'modules'} }, "$_" for @args;
}

sub help {
    my $self = shift;

    print << "_END_HEREDOC";
$0 [ OPTIONS ] Module Module Module...

Provide a module's version, comfortably.

OPTIONS
    -f | --full     Output name and version (a la Module::Version 0.05)
    -I | --include  Include any number of directories to include as well
    -i | --input    Input file to read module names from
    -d | --dev      Show developer versions as 0.01_01 instead of 0.0101
    -q | --quiet    Do not error out if module doesn't exist

_END_HEREDOC
}

1;

__END__