package Versions;

use vars qw($VERSION);
$VERSION = 0.01;

use strict;
use warnings;

use Carp;
use File::Spec;
use IO::File;


############################################################
#
# Mostly stolen from Module::Build.
#

sub _next_code_line {
    my ($self, $fh, $pat) = @_;
    my $inpod = 0;

    local $_;
    while (<$fh>) {
	$inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
	next if $inpod || /^\s*#/;
	return wantarray ? ($_, /$pat/) : $_
	    if $_ =~ $pat;
    }
    return;
}

sub from_file {
    my ($self, $file) = @_;

    # Some of this code came from the ExtUtils:: hierarchy.
    my $fh = IO::File->new($file)
	or croak "Can't open '$file' for version: $!";

    my $match = qr/([\$*])(([\w\:\']*)\bVERSION)\b.*\=/;
    my ($v_line, $sigil, $var) = $self->_next_code_line($fh, $match)
	or return undef;

    my $eval = qq{ package Versions::_version;
		 no strict;
		    
		 local $sigil$var;
		 \$$var=undef; do {
		   $v_line
		 }; \$$var
		};
    local $^W;
    my $result = eval $eval;

    warn "Error evaling version line '$eval' in $file: $@\n" if $@;
    return $result;
}

sub find_module_by_name {
    my ($self, $mod) = @_;
    my $file = File::Spec->catfile(split '::', $mod);
    foreach (@INC) {
	my $testfile = File::Spec->catfile($_, $file);
	return $testfile
	    if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp
	return "$testfile.pm" if -e "$testfile.pm";
    }
    return;
}

sub from_module {
    my ($self, $mod) = @_;
    my $file = $self->find_module_by_name($mod);
    return $self->from_file($file);
}

1;

__END__

# Undocumented module for dealing with version comparisons.