Data-Find-0.03000755000765000120 011210041060 12345 5ustar00andyadmin000000000000Build.PL000444000765000120 71111210041060 13676 0ustar00andyadmin000000000000Data-Find-0.03use strict; use warnings; use Module::Build; use lib 'inc'; use MyBuilder; my $builder = MyBuilder->new( module_name => 'Data::Find', license => 'perl', dist_author => 'Andy Armstrong ', dist_version_from => 'lib/Data/Find.pm', requires => { 'Test::More' => 0, 'Data::Dumper' => 0, 'Scalar::Util' => 0, }, add_to_cleanup => ['Data-Find-*'], ); $builder->create_build_script(); Changes000444000765000120 26011210041060 13674 0ustar00andyadmin000000000000Data-Find-0.03Revision history for Data-Find 0.01 2009-05-21 - Initial release. 0.02 2009-05-21 - Return path /and/ data 0.03 2009-05-29 - Move to GitHub MANIFEST000444000765000120 21111210041060 13526 0ustar00andyadmin000000000000Data-Find-0.03Build.PL Changes inc/MyBuilder.pm lib/Data/Find.pm MANIFEST MANIFEST.SKIP README t/00.load.t t/basic.t t/pod-coverage.t t/pod.t META.yml MANIFEST.SKIP000444000765000120 101511210041060 14316 0ustar00andyadmin000000000000Data-Find-0.03# Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b \b_darcs\b \B\.git\b \B\.gitignore \B\.releaserc # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# #\.bak$ # Avoid Devel::Cover files. \bcover_db\b ^WWW-FogBugz- ^Session\.vim$ \.swp$ ^ref/ META.yml000444000765000120 107611210041060 13700 0ustar00andyadmin000000000000Data-Find-0.03--- name: Data-Find version: 0.03 author: - 'Andy Armstrong ' abstract: Find data in arbitrary data structures license: perl resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Data-Find license: http://dev.perl.org/licenses/ repository: git://github.com/AndyA/Data--Find.git requires: Data::Dumper: 0 Scalar::Util: 0 Test::More: 0 provides: Data::Find: file: lib/Data/Find.pm version: 0.03 generated_by: Module::Build version 0.33 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 README000444000765000120 52011210041060 13260 0ustar00andyadmin000000000000Data-Find-0.03Data-Find version 0.03 INSTALLATION To install this module, run the following commands: perl Build.PL ./Build ./Build test ./Build install DEPENDENCIES None. COPYRIGHT AND LICENCE Copyright (C) 2009, Andy Armstrong This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. inc000755000765000120 011210041060 13037 5ustar00andyadmin000000000000Data-Find-0.03MyBuilder.pm000444000765000120 353111210041060 15430 0ustar00andyadmin000000000000Data-Find-0.03/incpackage MyBuilder; use base qw( Module::Build ); sub create_build_script { my ( $self, @args ) = @_; $self->_auto_mm; return $self->SUPER::create_build_script( @args ); } sub _auto_mm { my $self = shift; my $mm = $self->meta_merge; my @meta = qw( homepage bugtracker MailingList repository ); for my $meta ( @meta ) { next if exists $mm->{resources}{$meta}; my $auto = "_auto_$meta"; next unless $self->can( $auto ); my $av = $self->$auto(); $mm->{resources}{$meta} = $av if defined $av; } $self->meta_merge( $mm ); } sub _auto_repository { my $self = shift; if ( -d '.svn' ) { my $info = `svn info .`; return $1 if $info =~ /^URL:\s+(.+)$/m; } elsif ( -d '.git' ) { my $info = `git remote -v`; return unless $info =~ /^origin\s+(.+)$/m; my $url = $1; # Special case: patch up github URLs $url =~ s!^git\@github\.com:!git://github.com/!; return $url; } return; } sub _auto_bugtracker { 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=' . shift->dist_name; } sub ACTION_testauthor { my $self = shift; $self->test_files( 'xt/author' ); $self->ACTION_test; } sub ACTION_critic { exec qw( perlcritic -1 -q -profile perlcriticrc lib/ ), glob 't/*.t'; } sub ACTION_tags { exec( qw( ctags -f tags --recurse --totals --exclude=blib --exclude=.svn --exclude='*~' --languages=Perl t/ lib/ ) ); } sub ACTION_tidy { my $self = shift; my @extra = qw( Build.PL ); my %found_files = map { %$_ } $self->find_pm_files, $self->_find_file_by_type( 'pm', 't' ), $self->_find_file_by_type( 'pm', 'inc' ), $self->_find_file_by_type( 't', 't' ); my @files = ( keys %found_files, map { $self->localize_file_path( $_ ) } @extra ); for my $file ( @files ) { system 'perltidy', '-b', $file; unlink "$file.bak" if $? == 0; } } 1; lib000755000765000120 011210041060 13034 5ustar00andyadmin000000000000Data-Find-0.03Data000755000765000120 011210041060 13705 5ustar00andyadmin000000000000Data-Find-0.03/libFind.pm000444000765000120 1160311210041060 15301 0ustar00andyadmin000000000000Data-Find-0.03/lib/Datapackage Data::Find; use warnings; use strict; use Carp; use Data::Dumper; use Scalar::Util qw( refaddr ); use base qw( Exporter ); our @EXPORT_OK = qw( diter dfind dwith ); =head1 NAME Data::Find - Find data in arbitrary data structures =head1 VERSION This document describes Data::Find version 0.03 =cut our $VERSION = '0.03'; =head1 SYNOPSIS use Data::Find qw( diter ); my $data = { ar => [1, 2, 3], ha => {one => 1, two => 2, three => 3} }; my $iter = diter $data, 3; while ( defined ( my $path = $iter->() ) ) { print "$path\n"; } =head1 DESCRIPTION =head1 INTERFACE Nothing is exported by default. Use, eg, use Data::Find qw( dwith ); to get the subroutines you need or call them with their fully qualified name: my $iter = Data::Find::diter $data; =head2 C<< diter >> Given an arbitrary data structure and (optionally) an expression to match against elements in that structure returns an iterator which will yield the path through the data structure to each matching element: my $data = { ar => [1, 2, 3], ha => {one => 1, two => 2, three => 3} }; my $iter = diter $data, 3; while ( defined ( my $path = $iter->() ) ) { print "$path\n"; } would print: {ar}[2] {ha}{one} In other words it returns paths to each element that contains the scalar 3. The returned paths can be used in conjunction with C to access the matching elements. The match expression can be =over =item * a scalar =item * a regular expression =item * a code reference =item * C =back When the match expression is a code ref it will be passed each element in the data structure in turn and should return true or false. my $iter = diter $data, sub { my $v = shift; defined $v && !ref $v && $v % 2 == 1; }; while ( defined ( my $path = $iter->() ) ) { print "$path\n"; } Note that the match code will see I of the elements in the data structure - not just the scalars. If the match expression is C it will match those elements whose value is also C. =head3 Iterator In a scalar context the returned iterator yields successive paths within the data structure. In an array context it returns the path and the associated element. my $iter = diter $data; while ( my ( $path, $obj ) = $iter->() ) { print "$path, $obj\n"; } =cut sub diter { my ( $obj, @match ) = @_; my $matcher = @match ? _mk_matcher( @match ) : sub { !ref shift }; my @queue = ( [$obj] ); my %seen = (); my %WALK = ( HASH => sub { my ( $obj, @path ) = @_; for my $key ( sort keys %$obj ) { push @queue, [ $obj->{$key}, @path, '{' . _fmt_key( $key ) . '}' ]; } }, ARRAY => sub { my ( $obj, @path ) = @_; for my $idx ( 0 .. $#$obj ) { push @queue, [ $obj->[$idx], @path, "[$idx]" ]; } } ); return sub { while ( my $spec = shift @queue ) { my ( $obj, @path ) = @$spec; if ( my $ref = ref $obj ) { unless ( $seen{ refaddr $obj}++ ) { my $handler = $WALK{$ref} or croak "Can't walk a $ref"; $handler->( $obj, @path ); } } if ( $matcher->( $obj ) ) { my $path = join '', @path; return wantarray ? ( $path, $obj ) : $path; } } return; }; } =head2 C Similar to C but returns an array of matching paths rather than an iterator. =cut sub dfind { my $iter = diter @_; my @got = (); while ( defined( my $path = $iter->() ) ) { push @got, $path; } return @got; } =head2 C Similar to C but call a supplied callback with each matching path. dwith $data, qr/nice/, sub { my ( $path, $obj ) = @_; print "$path, $obj\n"; }; =cut sub dwith { my $cb = pop @_; my $iter = diter @_; while ( my ( $path, $obj ) = $iter->() ) { $cb->( $path, $obj ); } return; } sub _mk_matcher { my $match = shift; if ( ref $match ) { if ( 'CODE' eq ref $match ) { return $match; } elsif ( 'Regexp' eq ref $match ) { return sub { my $v = shift; return unless defined $v && !ref $v; return $v =~ $match; }; } } if ( defined $match ) { return sub { shift eq $match }; } return sub { !defined shift } } sub _fmt_key { my $key = shift; return $key if $key =~ /^(?:\d+|[a-z]\w*)$/i; chomp( my $rep = Data::Dumper->new( [$key] )->Purity( 1 )->Useqq( 1 )->Terse( 1 ) ->Dump ); return $rep; } 1; __END__ =head1 BUGS AND LIMITATIONS No bugs have been reported. Please report any bugs or feature requests to C, or through the web interface at L. =head1 AUTHOR Andy Armstrong C<< >> =head1 LICENCE AND COPYRIGHT Copyright (c) 2009, Andy Armstrong C<< >>. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. t000755000765000120 011210041060 12531 5ustar00andyadmin000000000000Data-Find-0.0300.load.t000444000765000120 16211210041060 14167 0ustar00andyadmin000000000000Data-Find-0.03/tuse Test::More tests => 1; BEGIN { use_ok( 'Data::Find' ); } diag( "Testing Data::Find $Data::Find::VERSION" ); basic.t000444000765000120 263611210041060 14143 0ustar00andyadmin000000000000Data-Find-0.03/t#!perl use strict; use warnings; use Data::Find qw( diter dfind dwith ); use Test::More; my @cases = ( { name => 'all', args => [ { ar => [ 1, 2, 3 ], ha => { one => 1, two => 2, three => 3 } } ], expect => [ '{ar}[0]', '{ar}[1]', '{ar}[2]', '{ha}{one}', '{ha}{three}', '{ha}{two}', ], }, { name => 'odd', args => [ { ar => [ 1, 2, 3 ], ha => { one => 1, two => 2, three => 3 } }, sub { my $v = shift; defined $v && !ref $v && $v % 2 == 1; } ], expect => [ '{ar}[0]', '{ar}[2]', '{ha}{one}', '{ha}{three}', ], }, { name => 'three', args => [ { ar => [ 1, 2, 3 ], ha => { one => 1, two => 2, three => 3 } }, 3, ], expect => [ '{ar}[2]', '{ha}{three}', ], }, { name => 'circular', args => sub { my $foo = { ar => [ 'a', 'b', 'c' ], }; $foo->{me} = $foo; return [ $foo, qr{c} ]; }, expect => [ '{ar}[2]', ], }, ); plan tests => @cases * 2; for my $case ( @cases ) { my $name = $case->{name}; my $args = $case->{args}; $args = $args->() if 'CODE' eq ref $args; my @got = dfind @$args; my @got2 = (); dwith @$args, sub { push @got2, shift; }; is_deeply [@got], $case->{expect}, "$name: dfind"; is_deeply [@got2], $case->{expect}, "$name: dwith"; } # vim:ts=2:sw=2:et:ft=perl pod-coverage.t000444000765000120 36411210041060 15411 0ustar00andyadmin000000000000Data-Find-0.03/t#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok( { private => [ qr{^BUILD|DEMOLISH|AUTOMETHOD|START$}, qr{^_} ] } ); pod.t000444000765000120 21411210041060 13612 0ustar00andyadmin000000000000Data-Find-0.03/t#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok();