view release on metacpan or  search on metacpan

lib/V.pm  view on Meta::CPAN

    my $pkg = shift;

    print "$pkg\n";
    @_ or print "\tNot found\n";
    foreach my $module (@_) {
	my ($versions) = $module->version;
	if (@$versions > 1) {
	    printf "\t%s:\n", $module->file;
	    printf "\t    %s: %s\n", $_->{pkg}, $_->{version} || '' for @$versions;
	    }
	else {
	    printf "\t%s: %s\n", $module->file, $versions->[0]{version} || '?';
	    }
	}
    } # report_pkg

sub import {
    shift;
    @_ or push @_ => 'V';

    for my $pkg (@_) {
	my @modules = V::Module::Info->all_installed ($pkg);
	report_pkg $pkg, @modules;
	}
    $NO_EXIT or exit ();
    } # import

sub get_version {
    my ($pkg)   = @_;
    my ($first) = V::Module::Info->all_installed ($pkg);
    return $first ? $first->version : undef;
    } # get_version

caller or V->import (@ARGV);

1;

# Okay I did the AUTOLOAD bit, but this is a Copy 'n Paste job.
# Thank you Michael Schwern for Module::Info! This one is mostly that!

package V::Module::Info;

require File::Spec;

sub new_from_file {
    my ($proto, $file) = @_;
    my $class = ref $proto || $proto;

    -r $file and return bless {
	file => File::Spec->rel2abs ($file),
	dir  => "",
	name => "",
	} => $class;
    } # new_from_file

sub all_installed {
    my ($proto, $name, @inc) = @_;
    my $class = ref $proto || $proto;

    @inc or @inc = @INC;
    my $file = File::Spec->catfile (split m/::/ => $name) . ".pm";

    my @modules;
    foreach my $dir (@inc) {
	# Skip the new code ref in @INC feature.
	ref $dir and next;

	my $filename = File::Spec->catfile ($dir, $file);
	-r $filename or next;

	my $module = $class->new_from_file ($filename);
	$module->{dir}  = File::Spec->rel2abs ($dir);
	$module->{name} = $name;
	push @modules => $module;
	}

    $V::DEBUG and do { print {*STDERR} "# $file: @{[scalar $_->version]}\n" for @modules };
    return @modules;
    } # all_installed

# Once thieved from ExtUtils::MM_Unix 1.12603
# Stealing from Module::Extract::VERSION is an option for the future
sub version {
    my $self = shift;

    my $parsefile = $self->file;

    open my $mod, "<", $parsefile or die "open $parsefile: $!";

    my $inpod = 0;
    local $_;
    my %eval;
    my ($cur_pkg, $cur_ord) = ("main", 0);
    $eval{$cur_pkg} = { ord => $cur_ord };
    while (<$mod>) {
	$inpod = m/^=(?!cut)/ ? 1 : m/^=cut/ ? 0 : $inpod;
	$inpod || m/^\s*#/ and next;

	chomp;
	if (m/^\s* (?:package|class) \s+ (\w+(?:::\w+)*) /x) {
	    $cur_pkg = $1;
	    exists $eval{$cur_pkg} or
		$eval{$cur_pkg} = { ord => ++$cur_ord };
	    }

	$cur_pkg =~ m{^V::Module::Info} and next;

	if (m/(?:our)?\s*([\$*])(([\w\:\']*)\bVERSION)\s*\=(?![=~])/) {
	    { local ($1, $2); ($_ = $_) = m/(.*)/; }    # untaint
	    my ($sigil, $name) = ($1, $2);
	    m/\$$name\s*=\s*eval.+\$$name/	and next;
	    m/my\s*\$VERSION\s*=/		and next;
	    m/^[^']*'[^']*\$$name[^']*'/	and next;
	    $eval{$cur_pkg}{prg} = qq{
                package V::Module::Info::_version_var;
                # $cur_pkg
                no strict;
                local $sigil$name;
                \$$name = undef;
                do { $_
		    # Closing brace needs to be on next line