File Coverage

blib/lib/Path/IsDev/Object.pm

Criterion	Covered	Total	%
statement	53	65	81.5
branch	6	10	60.0
condition			n/a
subroutine	14	15	93.3
pod	2	2	100.0
total	75	92	81.5

use 5.008;    # utf8
use strict;
use warnings;
use utf8;

package Path::IsDev::Object;

our $VERSION = '1.001003';

# ABSTRACT: Object Oriented guts for IsDev export

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













our $ENV_KEY_DEBUG = 'PATH_ISDEV_DEBUG';
our $DEBUG = ( exists $ENV{$ENV_KEY_DEBUG} ? $ENV{$ENV_KEY_DEBUG} : undef );

our $ENV_KEY_DEFAULT = 'PATH_ISDEV_DEFAULT_SET';
our $DEFAULT =
  ( exists $ENV{$ENV_KEY_DEFAULT} ? $ENV{$ENV_KEY_DEFAULT} : 'Basic' );









use Class::Tiny 0.010 {
  set        => sub { $DEFAULT },
  set_prefix => sub { 'Path::IsDev::HeuristicSet' },
  set_module => sub {
    require Module::Runtime;
    return Module::Runtime::compose_module_name( $_[0]->set_prefix => $_[0]->set );
  },
  loaded_set_module => sub {
    require Module::Runtime;
    return Module::Runtime::use_module( $_[0]->set_module );
  },
};



















my $instances   = {};
my $instance_id = 0;

sub _carp { require Carp; goto &Carp::carp; }












sub _instance_id {
  my ($self) = @_;
  require Scalar::Util;
  my $addr = Scalar::Util::refaddr($self);
  return $instances->{$addr} if exists $instances->{$addr};
  $instances->{$addr} = sprintf '%x', $instance_id++;
  return $instances->{$addr};
}











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

  return unless $DEBUG;
  my $id = $self->_instance_id;
  return *STDERR->printf( qq{[Path::IsDev=%s] %s\n}, $id, $message );
}












sub _with_debug {
  my ( $self, $code ) = @_;
  require Path::IsDev;
  ## no critic (ProhibitNoWarnings)
  no warnings 'redefine';
  local *Path::IsDev::debug = sub {
    $self->_debug(@_);
  };
  return $code->();
}










sub BUILD {
  my ($self) = @_;
  return $self unless $DEBUG;
  $self->_debug('{');
  $self->_debug( ' set               => ' . $self->set );
  $self->_debug( ' set_prefix        => ' . $self->set_prefix );
  $self->_debug( ' set_module        => ' . $self->set_module );
  $self->_debug( ' loaded_set_module => ' . $self->loaded_set_module );
  $self->_debug('}');
  return $self;
}











sub _matches {
  my ( $self, $path ) = @_;
  require Path::IsDev::Result;
  my $result_object = Path::IsDev::Result->new( path => $path );
  my $result;
  $self->_with_debug(
    sub {

      $self->_debug( 'Matching ' . $result_object->path );
      $result = $self->loaded_set_module->matches($result_object);
    },
  );
  if ( !!$result != !!$result_object->result ) {
    _carp(q[Result and Result Object missmatch]);
  }
  return $result_object;
}











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

  my $result_object = $self->_matches($path);

  if ( not $result_object->result ) {
    $self->_debug('no match found');
    return;
  }

  return $result_object->result;
}

1;

__END__