File Coverage

blib/lib/Path/FindDev/Object.pm

Criterion	Covered	Total	%
statement	46	77	59.7
branch	12	26	46.1
condition	1	3	33.3
subroutine	10	12	83.3
pod	4	4	100.0
total	73	122	59.8

use 5.006;    # our
use strict;
use warnings;

package Path::FindDev::Object;

our $VERSION = 'v0.5.3';

# ABSTRACT: Object oriented guts to FindDev

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

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













use Class::Tiny 0.010 'set', 'uplevel_max', {
  nest_retry => sub {
    return 0;
  },
  isdev => sub {
    require Path::IsDev::Object;
    return Path::IsDev::Object->new( ( $_[0]->has_set ? ( set => $_[0]->set ) : () ) );
  },
};









## no critic (RequireArgUnpacking)







sub has_set { return exists $_[0]->{set} }















sub has_uplevel_max { return exists $_[0]->{uplevel_max} }


















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














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 BUILD {
  my ($self) = @_;
  return $self unless $DEBUG;
  $self->_debug('{');
  $self->_debug( '  set         => ' . $self->set )         if $self->has_set;
  $self->_debug( '  uplevel_max => ' . $self->uplevel_max ) if $self->uplevel_max;
  $self->_debug( '  nest_retry  => ' . $self->nest_retry );
  $self->_debug( '  isdev       => ' . $self->isdev );
  $self->_debug('}');
  return $self;
}













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









sub _error {
  my ( $self, $message ) = @_;
  my $id = $self->_instance_id;
  my $f_message = sprintf qq{[Path::FindDev=%s] %s\n}, $id, $message;
  require Carp;
  Carp::croak($f_message);
}
















sub _step {
  my ( $self, $search_root, $dev_levels, $uplevels ) = @_;

  if ( $self->isdev->matches($search_root) ) {
    $self->_debug( 'Found dev dir' . $search_root );
    ${$dev_levels}++;
    return { type => 'found', path => $search_root } if ${$dev_levels} >= $self->nest_retry;
    $self->_debug( sprintf 'Ignoring found dev dir due to dev_levels(%s) < nest_retry(%s)', ${$dev_levels}, $self->nest_retry );
  }
  if ( $search_root->is_rootdir ) {
    $self->_debug('OS Root hit ( ->is_rootdir )');
    return { type => 'stop' };
  }
  if ( $self->has_uplevel_max and ${$uplevels} > $self->uplevel_max ) {
    $self->_debug( 'Stopping search due to uplevels(%s) >= uplevel_max(%s)', ${$uplevels}, $self->uplevel_max );
    return { type => 'stop' };
  }

  return { type => 'next' };
}









sub find_dev {
  my ( $self, $path ) = @_;
  require Path::Tiny;
  my $search_root = Path::Tiny::path($path)->absolute->realpath;
  $self->_debug( 'Finding dev for ' . $path );
  my $dev_levels = 0;
  my $uplevels   = 0 - 1;
FLOW: {
    $uplevels++;
    my $result = $self->_step( $search_root, \$dev_levels, \$uplevels );
    if ( 'next' eq $result->{type} ) {
      $self->_debug( 'Trying ../ : ' . $search_root->parent );
      $search_root = $search_root->parent;
      redo FLOW;
    }
    if ( 'stop' eq $result->{type} ) {
      return;
    }
    if ( 'found' eq $result->{type} ) {
      return $result->{path};
    }
    $self->_error( 'Unexpected end of flow control with _step response type' . $result->{type} );
  }
  return;
}
1;

__END__