Changeset 2234

Show
Ignore:
Timestamp:
05/09/07 15:06:58
Author:
miyagawa
Message:

implemented process 'selector', sub { ... } and process_first for that.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved
  • Web-Scraper/trunk/lib/Web/Scraper.pm

    r2233 r2234  
    1515    no strict 'refs'; 
    1616    *{"$pkg\::scraper"} = \&scraper; 
    17     *{"$pkg\::process"} = sub { goto &process }; 
    18     *{"$pkg\::result"}  = sub { goto &result  }; 
     17    *{"$pkg\::process"}       = sub { goto &process }; 
     18    *{"$pkg\::process_first"} = sub { goto &process_first }; 
     19    *{"$pkg\::result"}        = sub { goto &result  }; 
    1920} 
    2021 
     
    5758        }; 
    5859 
    59         my $stash
     60        my $stash = {}
    6061        no warnings 'redefine'; 
    61         local *process = sub { 
    62             my($exp, @attr) = @_; 
    63  
    64             my $xpath = HTML::Selector::XPath::selector_to_xpath($exp); 
    65             my @nodes = $tree->findnodes($xpath) or return; 
    66  
    67             while (my($key, $val) = splice(@attr, 0, 2)) { 
    68                 if ($key =~ s!\[\]$!!) { 
    69                     $stash->{$key} = [ map get_value($_, $val), @nodes ]; 
    70                 } else { 
    71                     $stash->{$key} = get_value($nodes[0], $val); 
    72                 } 
    73             } 
    74  
    75             return; 
    76         }; 
     62        local *process       = create_process(0, $tree, $stash); 
     63        local *process_first = create_process(1, $tree, $stash); 
    7764 
    7865        local *result = sub { 
     
    9784} 
    9885 
     86sub create_process { 
     87    my($first, $tree, $stash) = @_; 
     88 
     89    sub { 
     90        my($exp, @attr) = @_; 
     91 
     92        my $xpath = HTML::Selector::XPath::selector_to_xpath($exp); 
     93        my @nodes = $tree->findnodes($xpath) or return; 
     94        @nodes = ($nodes[0]) if $first; 
     95 
     96        while (my($key, $val) = splice(@attr, 0, 2)) { 
     97            if (ref($key) && ref($key) eq 'CODE' && !defined $val) { 
     98                for my $node (@nodes) { 
     99                    $key->($node); 
     100                } 
     101            } elsif ($key =~ s!\[\]$!!) { 
     102                $stash->{$key} = [ map get_value($_, $val), @nodes ]; 
     103            } else { 
     104                $stash->{$key} = get_value($nodes[0], $val); 
     105            } 
     106        } 
     107 
     108        return; 
     109    }; 
     110} 
     111 
    99112sub get_value { 
    100113    my($node, $val) = @_; 
     
    111124} 
    112125 
    113  
    114 sub process { 
    115     croak "Can't call process() outside scraper block"; 
     126sub stub { 
     127    my $func = shift; 
     128    return sub { 
     129        croak "Can't call $func() outside scraper block"; 
     130    }; 
    116131} 
    117132 
    118 sub result { 
    119     croak "Can't call result() outside scraper block"
    120 
     133*process       = stub 'process'; 
     134*process_first = stub 'process_first'
     135*result        = stub 'result'; 
    121136 
    1221371;