Re^3: searching for an object reference

Unless you have some expectaton of subclassing this, the object orientation seems like overkill.

Also, for general purpose use, UNIVERSAL is probably better than the stringification/regex approach, as it plays better with string overloading.

A further speed improvement can be gained by using list processing to avoid recursive calling:

use strict;
use UNIVERSAL 'isa';

sub deep_grep (&@) {
  my $test = shift;
  
  my ( @results, %seen );
  
  while ( scalar @_ ) {
    my $target = shift @_;
    
    push @results, grep $test->( $_ ), $target; 
    
    unshift @_, $seen{$target} ++        ? ()              : 
                  isa($target, 'HASH')   ? values %$target :
                  isa($target, 'ARRAY')  ? @$target        :
                  isa($target, 'REF')    ? $$target        :
                  isa($target, 'SCALAR') ? $$target        : ();
  }
  return @results;
}
[download]

The prototype allows you to call it blockwise, like the builtin grep, but isn't needed:

my @loggers = deep_grep( sub { isa( $_, 'Log' ) }, $target );

my @loggers = deep_grep { isa( $_, 'Log' ) } $target;
[download]

Comment on Re^3: searching for an object reference Select or Download Code

Replies are listed 'Best First'.

Re^4: searching for an object reference
by simonm (Vicar) on Jul 09, 2005 at 00:24 UTC

use strict;
use UNIVERSAL 'isa';

sub build_deep_sub {
  my %options = @_;
  
  my $sub = q/ sub / . ( $options{proto} ? "($options{proto})" : '' ) 
+. q/ {
    / . ( $options{init} ) . q/
    my ( @results, %seen );
    
    while ( scalar @_ ) {
      my $target = shift;
      / . ( $options{guard} ? "next unless grep { $options{guard} } \$
+target;" : "" ) . q/
      push @results, / . ( $options{map} ) . q/ $target;
      
      / . ( $options{post_order} ? 'push' : 'unshift' ) . q/  @_,
      / . ( $options{guard} ? "  grep { $options{guard} }" : "" ) . q/
    $seen{$target} ++        ? ()       :    
      isa($target, 'HASH')   ? %$target :
      isa($target, 'ARRAY')  ? @$target :
      isa($target, 'REF')    ? $$target :
      isa($target, 'SCALAR') ? $$target : ();
    }
    @results;
  } /;
  eval $sub or die "$@: $sub";
}

my $type_search = build_deep_sub( init => 'my $type = shift;', map => 
+'grep isa( $_, $type ), ', guard => 'ref($_)' );

my @loggers = $type_search->( 'Log', $target );
[download]

The speed improvement of eliminating a round of subroutine calls will outway the one-time cost of the string eval unless your data structure to be searched is very small.

A library based on this approach could pre-generate a number of generally useful subroutines:

  *{'deep_walk'} = build_deep_sub();
  *{'deep_map'} = build_deep_sub( init => 'my $test = shift;', map => 
+'map $test->($_),' );
  *{'deep_grep'} = build_deep_sub( init => 'my $test = shift;', map =>
+ 'grep $test->($_),' );
  *{'deep_grep_refs'} = build_deep_sub( init => 'my $test = shift;', m
+ap => 'grep $test->($_),', guard => 'ref($_)' );
  *{'deep_grep_type'} = build_deep_sub( init => 'my $type = shift;', m
+ap => 'grep isa( $_, $type ), ', guard => 'ref($_)' );
[download]

(For what it's worth, the prototypes generated above don't seem to be quite right, but I'm sure that could be figured out with a bit of experimentation.)

[reply]
[d/l]
[select]


XP is just a number
	PerlMonks