| Subject: | per-obj names for iterator methods [PATCH] [TESTS] |
This patch takes care of your To-do item from POD.
I did not update the version number or changelog.
--
rjbs
| Subject: | own-names.patch |
diff -Nur Object-Iterate-1.10/MANIFEST Object-Iterate-1.10-rjbs/MANIFEST
--- Object-Iterate-1.10/MANIFEST 2007-01-09 23:36:34.000000000 -0500
+++ Object-Iterate-1.10-rjbs/MANIFEST 2007-01-10 08:57:12.000000000 -0500
@@ -14,6 +14,7 @@
t/iterate.t
t/load.t
t/map.t
+t/own_names.t
t/pod.t
t/pod_coverage.t
t/prereq.t
diff -Nur Object-Iterate-1.10/lib/Iterate.pm Object-Iterate-1.10-rjbs/lib/Iterate.pm
--- Object-Iterate-1.10/lib/Iterate.pm 2007-01-09 23:37:00.000000000 -0500
+++ Object-Iterate-1.10-rjbs/lib/Iterate.pm 2007-01-10 08:54:52.000000000 -0500
@@ -83,16 +83,45 @@
$Init = '__init__';
$Final = '__final__';
+BEGIN {
+ my %method = (
+ next => 'Next',
+ more => 'More',
+ init => 'Init',
+ final => 'Final',
+ );
+
+ no strict 'refs';
+ for my $which (keys %method) {
+ *{"_$which\_method"} = sub {
+ my ($object) = @_;
+ my $custom_finder = "_object_iterate_$which";
+
+ my $method = eval { $object->$custom_finder };
+
+ if (! $method and UNIVERSAL::can( $object, ${$method{$which}} )) {
+ $method = ${$method{$which}};
+ }
+
+ return $method;
+ };
+ }
+}
+
sub _check_object
{
- croak( "iterate object has no $Next() method" )
- unless UNIVERSAL::can( $_[0], $Next );
- croak( "iterate object has no $More() method" )
- unless UNIVERSAL::can( $_[0], $More );
+ my $next = _next_method($_[0]);
+ my $more = _more_method($_[0]);
+
+ croak( "iterate object has no $Next() method" ) unless $next;
+ croak( "iterate object has no $More() method" ) unless $more;
- $_[0]->$Init if UNIVERSAL::can( $_[0], $Init );
+ my $init = _init_method($_[0]);
+ my $final = _final_method($_[0]);
- return 1;
+ $_[0]->$init if $init;
+
+ return ($next, $more, $init, $final);
}
=over 4
@@ -119,18 +148,18 @@
my $sub = shift;
my $object = shift;
- _check_object( $object );
+ my ($next, $more, $init, $final) = _check_object( $object );
- while( $object->$More )
+ while( $object->$more )
{
local $_;
- $_ = $object->$Next;
+ $_ = $object->$next;
$sub->();
}
- $object->$Final if $object->can( $Final );
+ $object->$final if $final;
}
=item igrep BLOCK, OBJECT
@@ -157,20 +186,20 @@
my $sub = shift;
my $object = shift;
- _check_object( $object );
+ my ($next, $more, $init, $final) = _check_object( $object );
my @output = ();
- while( $object->$More )
+ while( $object->$more )
{
local $_;
- $_ = $object->$Next;
+ $_ = $object->$next;
push @output, $_ if $sub->();
}
- $object->$Final if $object->can( $Final );
+ $object->$final if $final;
wantarray ? @output : scalar @output;
}
@@ -199,20 +228,20 @@
my $sub = shift;
my $object = shift;
- _check_object( $object );
+ my ($next, $more, $init, $final) = _check_object( $object );
my @output = ();
- while( $object->$More )
+ while( $object->$more )
{
local $_;
- $_ = $object->$Next;
+ $_ = $object->$next;
push @output, $sub->();
}
- $object->$Final if $object->can( $Final );
+ $object->$final if $final;
@output;
}
@@ -247,10 +276,6 @@
If, for some reason, I disappear from the world, one of the other
members of the project can shepherd this module appropriately.
-=head1 TO DO
-
-* let the methods discover the method names per object.
-
=head1 CREDITS
Thanks to Slaven Rezic for adding C<__init__> support
diff -Nur Object-Iterate-1.10/t/check_arg.t Object-Iterate-1.10-rjbs/t/check_arg.t
--- Object-Iterate-1.10/t/check_arg.t 2002-10-22 14:07:09.000000000 -0400
+++ Object-Iterate-1.10-rjbs/t/check_arg.t 2007-01-10 08:53:42.000000000 -0500
@@ -5,8 +5,9 @@
use Object::Iterate;
use Object::Iterate::Tester;
-ok( Object::Iterate::_check_object(
- Object::Iterate::Tester->new() ),
+my @ok = Object::Iterate::_check_object( Object::Iterate::Tester->new() );
+
+ok( @ok,
'Tester object can use Object::Iterate' );
my $result = not eval{ Object::Iterate::_check_object( {} ) };
diff -Nur Object-Iterate-1.10/t/own_names.t Object-Iterate-1.10-rjbs/t/own_names.t
--- Object-Iterate-1.10/t/own_names.t 1969-12-31 19:00:00.000000000 -0500
+++ Object-Iterate-1.10-rjbs/t/own_names.t 2007-01-10 08:58:49.000000000 -0500
@@ -0,0 +1,29 @@
+# $Id: iterate.t,v 1.3 2002/10/22 23:58:55 comdog Exp $
+use strict;
+
+use Test::More tests => 2;
+
+use Object::Iterate qw(iterate);
+
+my $o = T->new();
+isa_ok( $o, 'T' );
+
+my @out = ();
+iterate { push @out, "$_$_" } $o;
+
+my @expected = qw( AA BB CC DD EE FF );
+
+ok( eq_array( \@out, \@expected ), 'Iterate returned the right thing' );
+
+BEGIN {
+ package T;
+
+ sub new { bless { A => [ 'A' .. 'F' ] }, __PACKAGE__ }
+ sub _object_iterate_init { 'I' }
+ sub _object_iterate_next { 'N' }
+ sub _object_iterate_more { 'M' }
+
+ sub I { $_[0]{Pos} = 0 }
+ sub N { $_[0]{A}[ $_[0]{Pos}++ ] }
+ sub M { $_[0]{Pos} > $#{ $_[0]{A} } ? 0 : 1 }
+ }
diff -Nur Object-Iterate-1.10/t/test_manifest Object-Iterate-1.10-rjbs/t/test_manifest
--- Object-Iterate-1.10/t/test_manifest 2005-03-11 23:12:06.000000000 -0500
+++ Object-Iterate-1.10-rjbs/t/test_manifest 2007-01-10 08:58:06.000000000 -0500
@@ -9,5 +9,6 @@
grep.t
map.t
iterate.t
+own_names.t
init.t
final.t