File Coverage

lib/Module/Info/File.pm

Criterion	Covered	Total	%
statement	43	48	89.5
branch	12	18	66.6
condition	6	14	42.8
subroutine	9	9	100.0
pod	3	3	100.0
total	73	92	79.3

package Module::Info::File;

use strict;
use warnings;
use base 'Module::Info';
use Carp;
use File::Spec;
use vars qw($VERSION);

$VERSION = '0.14';

sub new_from_file {
    my ( $proto, $filename ) = @_;

    open my $file, '<', $filename
        or croak "Unable to open file: $filename - $!";

    my ( @packages, $version, $name, $dir );
    while (<$file>) {
        if ( $_ =~ m/\bpackage\s?([A-Za-z0-9_:]+);/xm ) {
            if ($1) {
                $name = $1;
            } else {
                ($name) = $file =~ m/(\w+\.pm)$/xm;
            }
        }
        $dir = File::Spec->rel2abs($file);
        $dir =~ s[/(\w+\.p(m|l))$][]xm;

        if ( $_ =~ m/\bVERSION\b\s*=\s*'([0-9_.]+)'*;/xm ) {
            $version = $1;
        }

        if ( $name and $dir and $filename and $version ) {
            last;
        }

    }
    close $file;

    return __PACKAGE__->new_from_data(
        name    => $name,
        dir     => $dir,
        file    => $filename,
        version => $version ? $version : undef,
    );
}

sub new_from_data {
    my ( $class, %params ) = @_;

    my $self = bless {}, $class || ref $class;

    foreach ( keys %params ) {
        $self->{$_} = $params{$_} || undef;
    }

    if ( !$self->{'version'} ) {
        $self->{'version'} = $self->version();
    }

    return $self;
}

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

    if ($version) {
        $self->{version} = $version;
        return 1;
    }

    if ( $self->{version} ) {
        return $self->{version};
    } else {
        return $self->SUPER::version();
    }
}

1;

__END__