Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Add a Result object and refactor internals to reflect that

  • Loading branch information...
commit 50c73f6b996f6caf83339a35e9dffb1fd8cc43c9 1 parent b83a1f1
@kentfredric kentfredric authored
View
41 lib/Path/IsDev/Heuristic.pm
@@ -16,7 +16,6 @@ package Path::IsDev::Heuristic;
=cut
-sub _path { require Path::Tiny; goto &Path::Tiny::path }
sub _croak { require Carp; goto &Carp::croak }
sub _blessed { require Scalar::Util; goto &Scalar::Util::blessed }
sub _debug { require Path::IsDev; goto &Path::IsDev::debug }
@@ -49,15 +48,19 @@ Glue layer between C<< ->matches >> and C<< ->files >>
=cut
sub _file_matches {
- my ( $self, $path ) = @_;
- my $root = _path($path);
+ my ( $self, $result_object ) = @_;
+ my $root = $result_object->path;
for my $file ( $self->files ) {
my $stat = $root->child($file);
- next unless -e $stat;
- next unless -f $stat;
- _debug("$stat exists for $self");
- return 1;
+ if ( -e $stat and -f $stat ) {
+ _debug("$stat exists for $self");
+ $result_object->add_reason( $self, 1, { 'file_exists?' => $stat } );
+ $result_object->result(1);
+ return 1;
+ }
+ $result_object->add_reason( $self, 0, { 'file_exists?' => $stat } );
}
+ $result_object->result(undef);
return;
}
@@ -72,15 +75,19 @@ Glue layer between C<< ->matches >> and C<< ->dirs >>
=cut
sub _dir_matches {
- my ( $self, $path ) = @_;
- my $root = _path($path);
+ my ( $self, $result_object ) = @_;
+ my $root = $result_object->path;
for my $file ( $self->dirs ) {
my $stat = $root->child($file);
- next unless -e $stat;
- next unless -d $stat;
- _debug( "$stat exists for" . $self->name );
- return 1;
+ if ( -e $stat and -d $stat ) {
+ _debug( "$stat exists for" . $self->name );
+ $result_object->add_reason( $self, 1, { 'dir_exists?' => $stat } );
+ $result_object->result(1);
+ return 1;
+ }
+ $result_object->add_reason( $self, 0, { 'dir_exists?' => $stat } );
}
+ $result_object->result(undef);
return;
}
@@ -88,7 +95,7 @@ sub _dir_matches {
Determines if the current heuristic matches a given path
- my $result = $heuristic->matches( $path );
+ my $matched = $heuristic->matches( $result_object );
The default implementation takes values from C<< ->files >> and C<< ->dirs >>
and returns true as soon as any match satisfies.
@@ -96,15 +103,15 @@ and returns true as soon as any match satisfies.
=cut
sub matches {
- my ( $self, $path ) = @_;
+ my ( $self, $result_object ) = @_;
if ( not $self->can('files') and not $self->can('dirs') ) {
return _croak("Heuristic $self did not implement one of : matches, files, dirs");
}
if ( $self->can('files') ) {
- return 1 if $self->_file_matches($path);
+ return 1 if $self->_file_matches($result_object);
}
if ( $self->can('dirs') ) {
- return 1 if $self->_dir_matches($path);
+ return 1 if $self->_dir_matches($result_object);
}
return;
}
View
12 lib/Path/IsDev/Heuristic/Changelog.pm
@@ -33,7 +33,6 @@ etc.
=cut
use parent 'Path::IsDev::Heuristic';
-sub _path { require Path::Tiny; goto &Path::Tiny::path }
=method C<matches>
@@ -47,11 +46,16 @@ Indicators for this heuristic is the existence of a file such as:
=cut
sub matches {
- my ( $self, $path ) = @_;
- for my $child ( _path($path)->children ) {
+ my ( $self, $result_object ) = @_;
+ for my $child ( $result_object->path->children ) {
next unless -f $child;
- return 1 if $child->basename =~ /\AChange(s|log)(|[.][^.\s]+)\z/isxm;
+ if ( $child->basename =~ /\AChange(s|log)(|[.][^.\s]+)\z/isxm ) {
+ $result_object->add_reason( $self, 1, { child_matches_expression => $child } );
+ $result_object->result(1);
+ return 1;
+ }
}
+ $result_object->add_reason( $self, 0, { no_children_matched_expression => 1 } );
return;
}
View
10 lib/Path/IsDev/HeuristicSet.pm
@@ -99,19 +99,19 @@ Determine if the C<HeuristicSet> contains a match.
=cut
sub matches {
- my ( $self, $path ) = @_;
+ my ( $self, $result_object ) = @_;
TESTS: for my $module ( $self->modules ) {
$self->_load_module($module);
if ( $module->can('excludes') ) {
- if ( $module->excludes($path) ) {
- _debug( $module->name . q[ excludes path ] . $path );
+ if ( $module->excludes($result_object) ) {
+ _debug( $module->name . q[ excludes path ] . $result_object->path );
return;
}
next TESTS;
}
- next unless $module->matches($path);
+ next unless $module->matches($result_object);
my $name = $module->name;
- _debug( $name . q[ matched path ] . $path );
+ _debug( $name . q[ matched path ] . $result_object->path );
return 1;
}
return;
View
37 lib/Path/IsDev/NegativeHeuristic.pm
@@ -16,7 +16,6 @@ package Path::IsDev::NegativeHeuristic;
=cut
-sub _path { require Path::Tiny; goto &Path::Tiny::path }
sub _croak { require Carp; goto &Carp::croak }
sub _blessed { require Scalar::Util; goto &Scalar::Util::blessed }
sub _debug { require Path::IsDev; goto &Path::IsDev::debug }
@@ -49,14 +48,17 @@ Glue layer between C<< ->excludes >> and C<< ->files >>
=cut
sub _file_excludes {
- my ( $self, $path ) = @_;
- my $root = _path($path);
+ my ( $self, $result_object ) = @_;
+ my $root = $result_object->path;
for my $file ( $self->files ) {
my $stat = $root->child($file);
- next unless -e $stat;
- next unless -f $stat;
- _debug("$stat exists for $self");
- return 1;
+ if ( -e $stat and -f $stat ) {
+ _debug("$stat exists for $self");
+ $result_object->add_reason( $self, 1, { 'exclude_file_exists?' => $stat } );
+ $result_object->result(undef);
+ return 1;
+ }
+ $result_object->add_reason( $self, 0, { 'exclude_file_exists?' => $stat } );
}
return;
}
@@ -72,14 +74,17 @@ Glue layer between C<< ->excludes >> and C<< ->dirs >>
=cut
sub _dir_excludes {
- my ( $self, $path ) = @_;
- my $root = _path($path);
+ my ( $self, $result_object ) = @_;
+ my $root = $result_object->path;
for my $file ( $self->dirs ) {
my $stat = $root->child($file);
- next unless -e $stat;
- next unless -d $stat;
- _debug( "$stat exists for" . $self->name );
- return 1;
+ if ( -e $stat and -d $stat ) {
+ _debug( "$stat exists for" . $self->name );
+ $result_object->add_reason( $self, 1, { 'exclude_dir_exists?' => $stat } );
+ $result_object->result(undef);
+ return 1;
+ }
+ $result_object->add_reason( $self, 0, { 'exclude_dir_exists?' => $stat } );
}
return;
}
@@ -96,15 +101,15 @@ and returns true as soon as any match satisfies.
=cut
sub excludes {
- my ( $self, $path ) = @_;
+ my ( $self, $result_object ) = @_;
if ( not $self->can('files') and not $self->can('dirs') ) {
return _croak("Heuristic $self did not implement one of : matches, files, dirs");
}
if ( $self->can('files') ) {
- return 1 if $self->_file_excludes($path);
+ return 1 if $self->_file_excludes($result_object);
}
if ( $self->can('dirs') ) {
- return 1 if $self->_dir_excludes($path);
+ return 1 if $self->_dir_excludes($result_object);
}
return;
}
View
29 lib/Path/IsDev/Object.pm
@@ -142,7 +142,7 @@ sub _with_debug {
=p_method C<BUILD>
-C<BUILD> is an implementation detail of C<Moo>/C<Moose>.
+C<BUILD> is an implementation detail of C<Class::Tiny>.
This module hooks C<BUILD> to give a self report of the object
to C<*STDERR> after C<< ->new >> when under C<$DEBUG>
@@ -171,18 +171,33 @@ Determine if a given path satisfies the C<set>
=cut
-sub matches {
+sub _matches {
my ( $self, $path ) = @_;
- $self->_debug( 'Matching ' . $path );
- my $result = $self->_with_debug(
+ require Path::IsDev::Result;
+ my $object = Path::IsDev::Result->new( path => $path );
+ my $result;
+ $self->_with_debug(
sub {
- $self->loaded_set_module->matches($path);
+ $result = $self->loaded_set_module->matches($object);
}
);
- if ( not $result ) {
+ if ( !!$result != !!$object->result ) {
+ warn "Result and Result Object missmatch";
+ }
+ return $object;
+}
+
+sub matches {
+ my ( $self, $path ) = @_;
+ $self->_debug( 'Matching ' . $path );
+
+ my $object = $self->_matches($path);
+
+ if ( not $object->result ) {
$self->_debug('no match found');
}
- return $result;
+
+ return $object->result;
}
1;
View
44 lib/Path/IsDev/Result.pm
@@ -0,0 +1,44 @@
+use strict;
+use warnings;
+
+package Path::IsDev::Result;
+
+# ABSTRACT: Result container
+
+use Class::Tiny 'path', 'result', {
+ reasons => sub { [] }
+};
+sub _path { require Path::Tiny; goto &Path::Tiny::path }
+
+sub BUILD {
+ my ( $self, $args ) = @_;
+ if ( not $self->path ) {
+ die "<path> is a mandatory parameter";
+ }
+ if ( not ref $self->path ) {
+ $self->path( _path( $self->path ) );
+ }
+ if ( not -e $self->path ) {
+ die "<path> parameter must exist for heuristics to be performed";
+ }
+}
+my %type_map = (
+ 'Path::IsDev::Heuristic' => 'positive heuristic',
+ 'Path::IsDev::NegativeHeuristic' => 'negative heuristic',
+);
+
+sub add_reason {
+ my ( $self, $heuristic_name, $heuristic_result, $context ) = @_;
+ $context ||= {};
+ $context->{heuristic} = $heuristic_name;
+ $context->{result} = $heuristic_result;
+
+ for my $type ( sort keys %type_map ) {
+ if ( $heuristic_name->isa($type) ) {
+ $context->{type} = $type_map{$type};
+ }
+ }
+ push @{ $self->reasons }, $context;
+}
+
+1;
View
82 t/Path-IsDev-Object/_matches.t
@@ -0,0 +1,82 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Path::Tiny qw(path);
+use Test::Fatal qw( exception );
+use FindBin;
+
+sub nofatal {
+ my ( $message, $sub ) = @_;
+ my $e = exception { $sub->() };
+ return is( $e, undef, "no exceptions: $message" );
+}
+
+my $corpus_dir =
+ path($FindBin::Bin)->parent->parent->child('corpus')->child('Changelog');
+
+subtest 'corpus/Changelog' => sub {
+ return unless nofatal 'require Path::IsDev::Object' => sub {
+ require Path::IsDev::Object;
+ };
+ my $instance;
+ return unless nofatal 'instance = Path::IsDev::Object->new()' => sub {
+ $instance = Path::IsDev::Object->new();
+ };
+ return unless nofatal 'instance->set()' => sub {
+ is( $instance->set(), 'Basic', 'instance->set() == Basic' );
+ };
+ return unless nofatal 'instance->set_prefix()' => sub {
+ is( $instance->set_prefix, 'Path::IsDev::HeuristicSet', 'instance->set_prefix() == Path::IsDev::HeuristicSet' );
+ };
+ return unless nofatal 'instance->set_module()' => sub {
+ is( $instance->set_module, 'Path::IsDev::HeuristicSet::Basic', 'instance->set_module() == Path::IsDev::HeuristicSet::Basic' );
+ };
+ return unless nofatal 'instance->loaded_set_module()' => sub {
+ is(
+ $instance->set_module,
+ 'Path::IsDev::HeuristicSet::Basic',
+ 'instance->loaded_set_module() == Path::IsDev::HeuristicSet::Basic'
+ );
+ };
+ return unless nofatal 'instance->_matches($path_isdev_source)' => sub {
+ my $computed_root = path($FindBin::Bin)->parent->parent;
+ my $result = $instance->_matches($computed_root);
+ ok( defined $result->result, 'instance->_matches($path_isdev_source)->result is defined' );
+ subtest "result_object" => sub {
+ return unless nofatal 'result->path' => sub {
+ my $path = $result->path;
+ ok( defined $path, '->path is defined' );
+ ok( ref $path, '->path is a ref' );
+ };
+ return unless nofatal 'result->result' => sub {
+ my $result = $result->result;
+ ok( defined $result, '->result is defined' );
+ };
+ return unless nofatal 'result->reasons' => sub {
+ my $reasons = $result->reasons;
+ ok( defined $reasons, '->reasons is defined' );
+ ok( ref $reasons, '->reasons is a ref' );
+ is( ref $reasons, 'ARRAY', '->reasons is ARRAY' );
+ };
+ };
+ };
+ return unless nofatal 'instance->matches($corpus_Changes_dir)' => sub {
+ my $result = $instance->matches($corpus_dir);
+ ok( defined $result, 'instance->matches($corpus_Changes_dir) is defined' );
+ };
+ return unless nofatal 'instance->matches($corpus_Changes_dir/../)' => sub {
+ my $result = $instance->matches( $corpus_dir->parent );
+ ok( !defined $result, 'instance->matches($corpus_Changes_dir/../) is not defined' );
+ };
+ return unless nofatal 'instance->_instance_id' => sub {
+ my $result = $instance->_instance_id;
+ ok( defined $result, 'instance->_instance_id is defined' );
+ };
+ return unless nofatal 'instance->_debug(testing)' => sub {
+ my $result = $instance->_debug('testing');
+ pass("_debug(testing) OK ");
+ };
+};
+
+done_testing;
Please sign in to comment.
Something went wrong with that request. Please try again.