view release on metacpan or  search on metacpan

lib/App/module/version.pm  view on Meta::CPAN

package App::module::version;

use 5.008009;
use strict;
use warnings;

use Getopt::Long 2.13     qw(GetOptionsFromArray);
use Pod::Usage            qw(pod2usage);
use English               qw( -no_match_vars );
use Config;
use File::Spec::Functions qw(splitpath catfile);
use Carp                  qw(carp);

# following recommendation from http://www.dagolden.com/index.php/369/version-numbers-should-be-boring/
our $VERSION = "1.004";
$VERSION = eval $VERSION;

sub new {
	my $class = shift;
	return bless {
		prompt => 0,
		prompted => [],
		list => [],
	}, $class;
}

sub parse_options {
	my $self = shift;
	my @a = @_;

	GetOptionsFromArray(\@a,
		   'help|?'  => sub { pod2usage(-exitstatus => 0, -verbose => 0); }, 
		   'man'     => sub { pod2usage(-exitstatus => 0, -verbose => 2); },
		   'usage'   => sub { _usage(); },
		   'version' => sub { _version(); exit(1); },
		   'prompt'  => \$self->{prompt},
		  ) or pod2usage(-verbose => 2);

	if (0 == scalar @a) {
		$self->{prompt} = 1;
	}
	else {
		@{$self->{list}} = @a;
	}
}


sub do_job {
	my $self = shift;

	if ($self->{prompt}) {
		_version();
		print "\nPlease type in a space-separated list of modules you want to find\nthe installed versions for below.\n> ";
		my $cmd = <STDIN>;
		@{$self->{prompted}} = split m{\s+}, $cmd; 
	}

	print "\n";
	my $version_info;
	MODULE:
	for my $module (@{$self->{list}}, @{$self->{prompted}}) {
		if ('perl' eq lc($module)) {
			print "The version of perl is $PERL_VERSION on $OSNAME ($Config{archname})\n";
			next MODULE;
		}

		if ($module =~ m/\Astrawberry (?:perl)?\z/imsx) {
			if (('MSWin32' ne $OSNAME) or ($Config{libperl} !~ m{\.a\z}msx)) {
				print "This is not Strawberry Perl.\n";
			}
		
			if (($Config{libperl} =~ m{\.a\z}msx) and ($Config{myuname} !~ m/\AWin32 [ ] strawberryperl/msx )) {
				print "This is not a new enough version of Strawberry Perl to easily tell what version it is.\n";
				next MODULE;
			}
			
			my ($strawberryversion, $bits) = (q{}, q{});
			if ($Config{myuname} =~ 
				m{\AWin32 [ ] strawberryperl [ ] # Starting code.
				 (\S+)			   # Version
				 .* [ ]			  # The date Strawberry Perl was built.
				 (\S+)\z			 # The version
				 }msx) {
				($strawberryversion, $bits) = ($1, $2);
				$bits = ('i386' eq $bits) ? 32 : 64;
			}
			print "The version of Strawberry Perl is $strawberryversion ($bits-bit), using gcc $Config{gccversion}\n";
			next MODULE;
		}

		if ('activeperl' eq lc($module)) {
			my $buildnumber = eval { return Win32::BuildNumber() };
			if ($EVAL_ERROR) {
				print "This is not ActivePerl (at least, not on Windows.)\n";
				next MODULE;
			}
			print "The version of ActivePerl is $PERL_VERSION build number $buildnumber\n";
			next MODULE;
		}

	    my $version_info = {};
	    my $module_file = catfile(split(/::/, $module));

	    DIRECTORY: foreach my $dir (@INC) {
		my $filename = catfile($dir, "$module_file.pm");
		if (-e $filename ) {
		    $version_info->{dir} = $dir;
		    if (open IN, "$filename") {
			while (<IN>) {
			    # the following regexp comes from the Extutils::MakeMaker
			    # documentation.
			    if (/([\$*])(([\w\:\']*)\bVERSION)\b.*\=/) {
				local $VERSION;
				my $res = eval $_;
				$version_info->{version} = $VERSION || $res;