view release on metacpan or  search on metacpan

lib/TreePath.pm  view on Meta::CPAN

  my $results = [];
  my $tree = $self->tree;
  foreach my $id  ( sort {$a cmp $b} keys %$tree ) {

      my $found = 1;


      foreach my $key ( keys %$args ) {
          my $current;
          if ( $key =~ m/(.*)\.(.*)/) {
              # ex: parent.name
              if ( defined $tree->{$id}->{$1} && ref($tree->{$id}->{$1})) {
                  $current = $tree->{$id}->{$1}->{$2};
              }
              else { next }
          }
          else {
              if ( defined $tree->{$id}->{$key} ){
                  $current = $tree->{$id}->{$key};
              }
              else {
                  #print "the '$key' key is unknown [node obj_key:$id]\n";
                  $found = 0;
                  next;
              }
          }
          my $value = $args->{$key};
          if ( $current ne $value ) {
              $found = 0;
              last;
          }
      }

      if ( $found ){
          if ( wantarray) {
              push(@$results, $tree->{$id});
          }
          # if found and scalar context
          else {
              return $tree->{$id};
          }
      }
  }

  return 0 if (  ! wantarray && ! $$results[0] );

  # wantarray
  return @$results;
}


# ex : search_path(/A/B/C')
#      or search_path(/A/B/C, { by => 'name', source => 'Page'} )
sub search_path {
  my ( $self, $source, $path ) = @_;

  croak "path must be start by '/' !: $!\n" if ( $path !~ m|^/| );

  my $search_key = $self->_get_key_name('search', { source => $source});

  my $nodes = [ split m%/%, $path ];
  $$nodes[0] = '/';

  my $not_found = 0;
  my (@found, @not_found);
  foreach my $node ( @$nodes ) {

    my $result = $self->search({ $search_key => $node, source => $source } );

    if ( ! $not_found && $result ) {
        push(@found, $result);
    }
    else {
        $not_found = 1;
        push(@not_found, $node);
    }
  }

  if ( wantarray ) {
    return ( \@found, \@not_found );
  }
  else {
    if ( $not_found[-1] ) {
      return '';
    }
    else {
      return $found[-1];
    }
  }
}


sub count {
  my $self = shift;

  return scalar keys %{$self->tree};
}

sub dump {
  my $self = shift;
  my $var  = shift;

  $var = $self->tree if ! defined $var;
  $Data::Dumper::Maxdepth = 3;
  $Data::Dumper::Sortkeys = 1;
  $Data::Dumper::Terse = 1;
  return Dumper($var);
}

sub traverse {
  my ($self, $node, $funcref, $args) = @_;

  return 0 if ( ! $node );
  $args ||= {};
  $args->{_count} = 1 if ! defined ($args->{_count});

  my $hasfunc = 0;
  if ( ! $funcref ) {
    $hasfunc = 1;
    $funcref = sub {    my ($node, $args) = @_;
                        $args->{_each_nodes} = []