PROXY  WHOIS  RQUOTE  TEXTS  SOFT  FOREX  BBOARD
 Music  Philosophy  Code  Literature  Russian

= ROOT|Technical|Code_Examples|Perl|site_perl|Class|XPath.pm =

page 2 of 7



        $xpath = $1;
        # this is a match-anywhere pattern, which should be tried on
        # all nodes
        foreach_node { push(@targets, $_) } $get_root->($self), $get_children;
    } elsif ($xpath =~ m!^/(.*)$!) {
        $xpath = $1;
        # this match starts at the root
        @targets = ($get_root->($self));
    } elsif ($xpath =~ m!^\.\./(.*)$!) {
        $xpath = $1;
        # this match starts at the parent
        @targets = ($get_parent->($self));
    } elsif ($xpath =~ m!^\./(.*)$!) {
        $xpath = $1;
        @targets = ($self);
    } else {
        # this match starts here
        @targets = ($self);
    }
        
    # pattern breakdown
    my @parts = split('/', $xpath);
    my $count = 0;
    for (@parts) {
        $count++;
        if (/^$NAME$/) {
            # it's a straight name match
            push(@patterns, { name => $_ });
        } elsif (/^($NAME)\[(-?\d+)\]$/o) {
            # it's an indexed name
            push(@patterns, { name => $1, index => $2 });
        } elsif (/^($NAME)\[\@($NAME)\s*=\s*"([^"]+)"\]$/o or 
                 /^($NAME)\[\@($NAME)\s*=\s*'([^']+)'\]$/o) {
            # it's a string attribute match
            push(@patterns, { name => $1, attr => $2, value => $3 });
        } elsif (/^($NAME)\[\@($NAME)\s*(=|>|<|<=|>=|!=)\s*(\d+)\]$/o) {
            # it's a numeric attribute match
            push(@patterns, { name => $1, attr => $2, op => $3, value => $4 });
        } elsif (/^($NAME)\[($NAME|\.)\s*=\s*"([^"]+)"\]$/o or 
                 /^($NAME)\[($NAME|\.)\s*=\s*'([^']+)'\]$/o) {
            # it's a string child match
            push(@patterns, { name => $1, child => $2, value => $3 });
        } elsif (/^($NAME)\[($NAME|\.)\s*(=|>|<|<=|>=|!=)\s*(\d+)\]$/) {
            # it's a numeric child match
            push(@patterns, { name => $1, child => $2, op => $3, value => $4 });
        } elsif (/^\@($NAME)$/) {
            # it's an attribute name
            push(@patterns, { attr => $1 });

            # it better be last
            croak("Bad call to $args->{call_match}: '$xpath' contains an attribute selector in the middle of the 
expression.")
              if $count != @parts;
        } else {
            # unrecognized token
            croak("Bad call to $args->{call_match}: '$xpath' contains unknown token '$_'");
        }
    }

    croak("Bad call to $args->{call_match}: '$xpath' contains no search tokens.")
      unless @patterns;
    
    # apply the patterns to all available targets and collect results
    my @results = map { $pkg->_do_match($_, $args, @patterns) } @targets;
    
    return @results;
}
      
# the underlying match engine.  this takes a list of patterns and
# applies them to child elements
sub _do_match {    
    my ($pkg, $self, $args, @patterns) = @_;
    my ($get_parent, $get_children, $get_name, $get_attr_value, $get_attr_names, $get_content) = 
      @{$args}{qw(get_parent get_children get_name get_attr_value get_attr_names get_content)};
    local $_;

    print STDERR "_do_match(" . $get_name->($self) . " => " . 
      join(', ', map { '{' . join(',', %$_) . '}' } @patterns) . 
        ") called.\n" 
          if DEBUG;

    # get pattern to apply to direct descendants
    my $pat = shift @patterns;

    # find matches and put in @results
    my @results;
    my @kids;

    { no warnings 'uninitialized';
        @kids = grep { $get_name->($_) eq $pat->{name} } $get_children->($self);
    }

    if (defined $pat->{index}) {
        # get a child by index
        push @results, $kids[$pat->{index}]
          if (abs($pat->{index}) <= $#kids);
    } elsif (defined $pat->{attr}) {
        if (defined $pat->{name}) {
        # default op is 'eq' for string matching
        my $op = $pat->{op} || 'eq';

=2=

1| < PREV = PAGE 2 = NEXT > |3|4|5|6|7

UP TO ROOT | UP TO DIR | TO FIRST PAGE

Google
 


E-mail Facebook Google Digg del.icio.us BlinkList Fark Furl Ma.gnolia Netscape NewsVine Reddit Slashdot Spurl StumbleUpon Technorati YahooMyWeb LiveJournal Blogmarks TwitThis Live News2.ru BobrDobr.ru Memori.ru MoeMesto.ru

0.00562596 wallclock secs ( 0.00 usr + 0.00 sys = 0.00 CPU)