File Coverage

blib/lib/Module/Data.pm

Criterion	Covered	Total	%
statement	57	61	93.4
branch	10	12	83.3
condition			n/a
subroutine	16	17	94.1
pod	3	3	100.0
total	86	93	92.4

use 5.006;    # our
use strict;
use warnings;

package Module::Data;

our $VERSION = '0.013';

# ABSTRACT: Introspect context information about modules in @INC

our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY

use Moo qw( around has );
use Sub::Quote qw( quote_sub );

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

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

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






































has package => (
  required => 1,
  is       => 'ro',
  ## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars, ValuesAndExpressions::RestrictLongStrings)
  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,
  ## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
  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, ) = @_;
  return $self->_version_optimistic;
}









no Moo;

1;

__END__