V - Print version of the specified module(s).

V documentation Contained in the V distribution.

Index

Code Index:

NAME

Top

V - Print version of the specified module(s).

SYNOPSIS

Top

    $ perl -MV=V

or if you want more than one

    $ perl -MV=CPAN,V

Can now also be used as a light-weight module for getting versions of modules without loading them:

    BEGIN { $V::NO_EXIT = 1 }
    require V;

    printf "%s has version '%s'\n", "V", V::get_version( "V" );

DESCRIPTION

Top

This module uses stolen code from Module::Info to find the location and version of the specified module(s). It prints them and exit()s.

It defines import() and is based on an idea from Michael Schwern on the perl5-porters list. See the discussion:

  http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2002-01/msg00760.html

AUTHOR

Top

Abe Timmerman <abeltje@cpan.org>.

COPYRIGHT & LICENSE

Top

Copyright 2002-2006 Abe Timmerman, All Rights Reserved.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

V documentation Contained in the V distribution. 
package V;
use strict;

# $Id: V.pm 1126 2007-11-07 00:10:02Z abeltje $

use vars qw( $VERSION $NO_EXIT );
$VERSION  = '0.13';

$NO_EXIT ||= 0; # prevent import() from exit()ing and fall of the edge


sub report_pkg($@) {
    my $pkg = shift;

    print "$pkg\n";
    @_ or print "\tNot found\n";
    for my $module ( @_ ) {
        printf "\t%s: %s\n", $module->file, $module->version || '?';
    }
}

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

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

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;

    return unless -r $file;

    my $self = {};
    $self->{file} = File::Spec->rel2abs($file);
    $self->{dir}  = '';
    $self->{name} = '';

    return bless $self, $class;
}

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

    @inc = @INC unless @inc;
    my $file = File::Spec->catfile(split m/::/, $name) . '.pm';
    
    my @modules = ();
    foreach my $dir (@inc) {
        # Skip the new code ref in @INC feature.
        next if ref $dir;

        my $filename = File::Spec->catfile($dir, $file);
        if( -r $filename ) {
            my $module = $class->new_from_file($filename);
            $module->{dir} = File::Spec->rel2abs($dir);
            $module->{name} = $name;
            push @modules, $module;
        }
    }
              
    return @modules;
}

# Thieved from ExtUtils::MM_Unix 1.12603
sub version {
    my($self) = shift;

    my $parsefile = $self->file;

    local *MOD;
    open(MOD, $parsefile) or die $!;

    my $inpod = 0;
    my $result;
    local $_;
    while (<MOD>) {
        $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
        next if $inpod || /^\s*#/;

        chomp;
        next unless m/([\$*])(([\w\:\']*)\bVERSION)\b.*\=/;
        { local($1, $2); ($_ = $_) = m/(.*)/; } # untaint
        my $eval = qq{
                        package V::Module::Info::_version;
                        no strict;

                        local $1$2;
                        \$$2=undef; do {
                                $_
                        }; \$$2
                };
        local $^W = 0;
        $result = eval($eval);
        warn "Could not eval '$eval' in $parsefile: $@" if $@;
        $result = "undef" unless defined $result;
        last;
    }
    close MOD;
    return $result;
}

sub accessor {
    my $self = shift;
    my $field = shift;

    $self->{ $field } = $_[0] if @_;
    return $self->{ $field };
}

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

    use vars qw( $AUTOLOAD );
    my( $method ) = $AUTOLOAD =~ m|.+::(.+)$|;

    if ( exists $self->{ $method } ) {
        splice @_, 1, 0, $method;
        goto &accessor;
    }
}