File Coverage

lib/Module/Data.pm

Criterion	Covered	Total	%
statement	37	60	61.6
branch	7	12	58.3
condition			n/a
subroutine	12	17	70.5
pod	3	3	100.0
total	59	92	64.1

use strict;
use warnings;

package Module::Data;
BEGIN {
  $Module::Data::AUTHORITY = 'cpan:KENTNL';
}
{
  $Module::Data::VERSION = '0.012'; # TRIAL
}

# ABSTRACT: Introspect context information about modules in @INC
use Moo;
use Sub::Quote;

around BUILDARGS => sub {
  my ( $orig, $class, @args ) = @_;

  unshift @args, 'package' if @args % 2 == 1;

  return $class->$orig(@args);
};



has package => (
  required => 1,
  is       => 'ro',
  isa      => quote_sub q{}
    . q{die "given undef for 'package' , expects a Str/module name" if not defined $_[0];}
    . q{die " ( 'package' => $_[0] ) is not a Str/module name, got a ref : " . ref $_[0] if ref $_[0];}
    . q{require Module::Runtime;}
    . q{Module::Runtime::check_module_name( $_[0] );},
);

has _notional_name => (
  is      => 'ro',
  lazy    => 1,
  default => quote_sub q{} . q{require Module::Runtime;} . q{return Module::Runtime::module_notional_filename( $_[0]->package );},
);


sub loaded {
  my ($self) = @_;
  return exists $INC{ $self->_notional_name };
}


## no critic ( ProhibitBuiltinHomonyms )
sub require {
  my ($self) = @_;
  return $self->package if $self->loaded;

  require Module::Runtime;
  Module::Runtime::require_module( $self->package );
  return $self->package;
}

sub _find_module_perl {
  my ($self) = @_;
  $self->require;
  return $INC{ $self->_notional_name };
}

sub _find_module_emulate {
  my ($self) = @_;
  require Path::ScanINC;
  Path::ScanINC->VERSION('0.011');
  return Path::ScanINC->new()->first_file( $self->_notional_name );
}

sub _find_module_optimistic {
  my ($self) = @_;
  return $INC{ $self->_notional_name } if $self->loaded;
  return $self->_find_module_emulate;
}

## use critic


has path => (
  is       => 'ro',
  lazy     => 1,
  init_arg => undef,
  builder  => '_build_path',
);

sub _build_path {
  my ( $self, ) = @_;
  my $value = $self->_find_module_optimistic;
  return if not defined $value;
  require Path::Tiny;
  return Path::Tiny::path( $value )->absolute;
}


has root => (
  is       => 'ro',
  lazy     => 1,
  init_arg => undef,
  builder  => '_build_root',
);

sub _build_root {
  my ($path) = $_[0]->path;

  # Parent ne Self is the only cross-platform way
  # I can think of that will stop at the top of a tree
  # as / is not applicable on windows.
  while ( $path->parent->absolute ne $path->absolute ) {
    if ( not $path->is_dir ) {
      $path = $path->parent;
      next;
    }
    if ( $path->child( $_[0]->_notional_name )->absolute eq $_[0]->path->absolute ) {
      return $path->absolute;
    }
    $path = $path->parent;
  }
  return;

}


sub _version_perl {
  my ($self) = @_;
  $self->require;

  # has to load the code into memory to work
  return $self->package->VERSION;
}

sub _version_emulate {
  my ($self) = @_;
  my $path = $self->path;
  require Module::Metadata;
  my $i = Module::Metadata->new_from_file( $path, collect_pod => 0 );
  return $i->version( $self->package );
}

sub _version_optimistic {
  my ($self) = @_;
  return $self->package->VERSION if $self->loaded;
  return $self->_version_emulate;
}

sub version {
  my ( $self, @junk ) = @_;
  return $self->_version_optimistic;
}


no Moo;

1;

__END__