Group
Extension

App-Mver/lib/App/Mver.pm

package App::Mver;

use strict;
use version;
use warnings;

use ExtUtils::MakeMaker;

our $VERSION = '0.09';

my $module_corelist   = eval 'require Module::CoreList; 1';
my $lwp_useragent     = eval 'require LWP::Simple; 1';
my $json_any          = eval 'use JSON::Any; 1';
my $changes_parser    = eval 'require CPAN::Changes; 1';
my $can_do_requests   = $lwp_useragent && $json_any;
my $can_parse_changes = $can_do_requests && $changes_parser;

my $api_host         = 'http://api.metacpan.org';
my $module_search    = "$api_host/module/%s";
my $changelog_search = "$api_host/v0/file/_search?q=release:%s-%s AND (name:Changes OR name:ChangeLog OR name:CHANGES OR name:CHANGELOG OR name:Changelog)&fields=path";
my $source_search    = "$api_host/source/%s/%s/%s";

sub run {
    my($modules, $opts) = @_;

    $can_do_requests = 0 if $opts->{'no-internet'};
    $can_parse_changes = 0 unless $opts->{changes};

    mver($_) for @$modules;
}

sub mver {
    my $arg = shift;
    $arg =~ s{-}{::}g;

    print "$arg: ";
    if(lc $arg eq 'perl') {
        require Config;
        print $Config::Config{version};
    }
    else {
        my $file = MM->_installed_file_for_module($arg);
        if(defined $file) {
            my $version = eval { version->parse(MM->parse_version($file)) };
            if($version) {
                print $version;

                if($module_corelist and is_core($arg)) {
                    print ' (core module)';
                }
            }
            else {
                print 'installed, but $VERSION is not defined';
            }

            if($can_do_requests and $version) {
                my($latest, $author) = get_latest_version_and_author($arg);
                if($latest and $latest <= $version) {
                    print ' (latest)';
                }
                else {
                    print " (latest: $latest)";

                    if($can_parse_changes and $latest and $author) {
                        my $changes = get_changes_between($arg, $author, $version, $latest);
                        if($changes) {
                            print "$/Changes:$/$changes";
                        }
                    }
                }
            }
        }
        else {
            print 'not installed';
        }
    }
    print $/;
}

sub is_core {
    my $arg = shift;

    my($found_in_core) = Module::CoreList->find_modules(qr/^\Q$arg\E$/, $]);

    !!$found_in_core;
}

sub get_latest_version_and_author {
    my $arg = shift;

    my $json     = LWP::Simple::get(sprintf $module_search, $arg) or return;
    my $response = eval { JSON::Any->from_json($json) } or return;

    if($response->{status} eq 'latest') {
        my $version = version->parse($response->{version}) or return ();
        return ($version, $response->{author});
    }

    return ();
}

sub get_changes_between {
    my($arg, $author, $ver_start, $ver_stop) = @_;

    $arg =~ s/::/-/g;

    my $json      = LWP::Simple::get(sprintf $changelog_search, $arg, $ver_stop) or return;
    my $response  = eval { JSON::Any->from_json($json) } or return;
    my $first_hit = $response->{hits}{hits}[0]{fields} or return;

    my $raw = LWP::Simple::get(
        sprintf $source_search, $author,
                                "$arg-$ver_stop",
                                $first_hit->{path},
    ) or return;

    my $changes;
    if($raw) {
        my $parser = CPAN::Changes->load_string($raw);
        for my $release ($parser->releases) {
            my $curr = eval { version->parse($release->version) } or next;
            if($curr > $ver_start and $curr <= $ver_stop) {
                $changes .= $release->serialize;
            }
        }
    }

    $changes;
}

1;

__END__

=head1 NAME

App::Mver - just print modules' C<$VERSION> (and some other stuff)

=head1 DESCRIPTION

For those, who are sick of

    perl -MLong::Module::Name -le'print Long::Module::Name->VERSION'

The main purpose of this simple stupid tool is to save you some typing.

It will report you the following things (some of them require command line arguments):

=over 4

=item your installed version of the given module(s)

=item whether or not your current version is the last one available on CPAN

=item whether or not the module is included in Perl distribution

=item changes between installed and latest version

=back

=head1 SEE ALSO

L<mver>

=head1 AUTHOR

Alexey Surikov E<lt>ksuri@cpan.orgE<gt>

=head1 LICENSE

This program is free software, you can redistribute it under the same terms as Perl itself.


Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.