/[Grep]/lib/Grep/Source.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /lib/Grep/Source.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 113 by dpavlin, Sun Mar 25 11:41:54 2007 UTC revision 132 by dpavlin, Tue May 1 12:20:49 2007 UTC
# Line 8  package Grep::Source; Line 8  package Grep::Source;
8  use Carp qw/verbose/;  use Carp qw/verbose/;
9  use Module::Pluggable search_path => 'Grep::Source', sub_name => 'sources', require => 1;  use Module::Pluggable search_path => 'Grep::Source', sub_name => 'sources', require => 1;
10  use base qw(Class::Accessor Jifty::Object);  use base qw(Class::Accessor Jifty::Object);
11  Grep::Source->mk_accessors( qw(feed uri q new_items collection search_obj) );  Grep::Source->mk_accessors( qw(feed uri q new_items collection search_obj tree) );
12    
13  use HTML::TreeBuilder;  use HTML::TreeBuilder;
14  use WWW::Mechanize;  use WWW::Mechanize;
# Line 188  sub content_class { Line 188  sub content_class {
188          }          }
189  }  }
190    
191    
192    =head2 element_by_triplet
193    
194    Helper method to select element(s) using C<element/attribute/value> triplet using
195    L<HTML::TreeBuilder> trees.
196    
197      my $el = $self->element_by_triplet(
198            tree => $tree_or_element,
199            triplets => [ qw/
200                    div id target
201                    div class another
202            / ],
203            message => 'find search result element',
204            fatal => 1,     # die instead of warn
205      );
206    
207    =cut
208    
209    sub element_by_triplet {
210            my $self = shift;
211    
212            my $args = {@_};
213    
214            my $tree = $args->{tree} || die "no tree";
215            my $message = $args->{message} || '';
216            my $fatal = $args->{fatal};
217            die "no triplets" unless defined( $args->{triplets} );
218            my @triplets;
219            if ( ref( $args->{triplets} ) eq 'ARRAY' ) {
220                    @triplets = @{ $args->{triplets} };
221            } else {
222                    @triplets = ( $args->{triplets} );
223            }
224    
225            push @triplets, ( undef, undef ) if ( $#triplets == 0 );
226    
227            die "triplet doesn't have 3 elements but ", $#triplets unless (
228                    ( $#triplets + 1 ) % 3 == 0
229            );
230    
231            my ( $el, $attr, $value );
232    
233            my @results;
234            my @tags;
235    
236            while ( @triplets ) {
237                    ( $el,$attr,$value ) = splice( @triplets, 0, 3 );
238                    my $tag = $attr ? "<$el $attr=\"$value\">" : "<$el>";
239                    push @tags, $tag;
240                    $self->log->debug("looking for $message $tag");
241                    @results = $tree->look_down( '_tag', $el, sub {
242                                    return 1 unless ( $attr && $value );
243                                    ( $_[0]->attr( $attr ) || '' ) eq $value;
244                    });
245                    last if @results;
246            }
247    
248            if ( ! @results ) {
249                    my $msg = "can't find $message ", join(" ", @tags);
250                    die $msg if ( $fatal );
251                    warn $msg;
252                    return;
253            }
254    
255            $self->log->debug("found ", $#results + 1, " results");
256    
257            return @results if wantarray;
258            return shift @results;
259    }
260    
261  =head2 scrape  =head2 scrape
262    
263  Create semi-complex L<WWW::Mechanize> rules to scrape page  Create semi-complex L<WWW::Mechanize> rules to scrape page easily
264    
265      $parent->scrape(
266                    # if search string isn't part or URI
267                    submit_form => {
268                            fields => {
269                                    value => $parent->q,
270                            },
271                            button => 'fullsearch',
272                    },
273                    # element with search results
274                    wrapper => [ qw/div class searchresults/ ],
275                    # element (or tripple) for each result with link
276                    # <a href=".."> inside it to full-text result
277                    results => 'dt',
278                    # collect which element on page linked from results
279                    scrape => [ qw/div id page/ ],
280                    # when search returns just single hit, it will redirect to result page
281                    redirect_single_result => 1,
282      );
283    
284  =cut  =cut
285    
# Line 232  sub scrape { Line 320  sub scrape {
320          my $tree = HTML::TreeBuilder->new or die "can't create html tree";          my $tree = HTML::TreeBuilder->new or die "can't create html tree";
321          $tree->parse( $mech->content ) or die "can't parse fetched content";          $tree->parse( $mech->content ) or die "can't parse fetched content";
322    
323          die "wrapper doesn't have 3 elements but ", $#{ $args->{wrapper} } unless ( $#{ $args->{wrapper} } == 2 );          my $div = $self->element_by_triplet(
324          my ( $el,$attr,$value ) = @{ $args->{wrapper} };                  tree => $tree,
325                    triplets => $args->{wrapper},
326          $self->log->debug("looking for <$el $attr=\"$value\">");                  message => 'wrapper for all results',
327                    fatal => $args->{redirect_single_result} ? 0 : 1,
328          my $div = $tree->look_down( '_tag', $el, sub {          );
                         ( $_[0]->attr( $attr ) || '' ) eq $value;  
         });  
   
         if ( ! $div ) {  
                 warn "can't find results wrapper <$el $attr=\"$value\">";  
                 return;  
         }  
329    
330          my $max = 15;          my $max = 15;
331          my $nr = 1;          my $nr = 1;
# Line 252  sub scrape { Line 333  sub scrape {
333          my $base_uri = $uri;          my $base_uri = $uri;
334          $base_uri =~ s!\?.*$!!;          $base_uri =~ s!\?.*$!!;
335    
336          my @r = $div->look_down( '_tag', $args->{results} );          # directly got first result
337          $self->log->debug("found ", scalar @r, " <$args->{results}>");          if ( $args->{redirect_single_result} && ! $div ) {
338    
339                    my $uri = $mech->uri; $uri->query( undef ); $uri = $uri->canonical;
340    
341                    $div = $self->element_by_triplet(
342                            tree => $tree,
343                            message => "single result - redirect to $uri",
344                            triplets => $args->{scrape},
345                            fatal => 1,
346                    );
347    
348                    $self->add_record(
349                            in_feed => $feed,
350                            title => $mech->title,
351                            link => $uri,
352                            content => $div->as_HTML,
353                    );
354    
355                    $tree->delete; # clear memory!
356                    return;
357            }
358    
359            my @r = $self->element_by_triplet(
360                    tree => $div,
361                    triplets => $args->{results},
362                    message => 'result element',
363            );
364    
365          foreach my $dt ( @r ) {          foreach my $dt ( @r ) {
366                  my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );                  my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
367                  if ( $a ) {                  if ( $a ) {
368    
369                          my $href = $a->attr('href') or die "can't find href inside <", $args->{results}, ">";                          my $href = $a->attr('href') or die "can't find href inside <", $args->{results}, ">";
370                          my $page_uri = URI->new_abs( $a->attr('href'), $base_uri );  
371                            my $page_uri = URI->new_abs( $href, $base_uri );
372                          $page_uri->query( undef );                          $page_uri->query( undef );
373                          $page_uri = $page_uri->canonical;                          $page_uri = $page_uri->canonical;
374    
375                          $self->log->debug("fetching page: ",$a->as_text," from $page_uri");                          $self->log->debug("fetching page: ",$a->as_text," from $page_uri");
376                          if ( $mech->follow_link( url => $a->attr('href') ) ) {                          if ( $mech->follow_link( url => $href ) ) {
377    
378                                  $self->save( "page-${nr}.html", $mech->content );                                  $self->save( "page-${nr}.html", $mech->content );
379    
380                                  my $page_tree = HTML::TreeBuilder->new or die "can't create page tree";                                  my $page_tree = HTML::TreeBuilder->new or die "can't create page tree";
381                                  $page_tree->parse( $mech->content ) or die "can't parse page at $page_uri";                                  $page_tree->parse( $mech->content ) or die "can't parse page at $page_uri";
382                                    $div = $self->element_by_triplet(
383                                  ( $el,$attr,$value ) = @{ $args->{scrape} };                                          tree => $page_tree,
384                                  $div = $page_tree->look_down( '_tag', $el, sub { ( $_[0]->attr( $attr ) || '' ) eq $value } );                                          message => "result $nr",
385                                            triplets => $args->{scrape}
386                                  die "can't find <$el $attr=\"$value\">" unless ($div);                                  );
387    
388                                  $self->add_record(                                  $self->add_record(
389                                          in_feed => $feed,                                          in_feed => $feed,
# Line 287  sub scrape { Line 395  sub scrape {
395  #                                       author =>  #                                       author =>
396  #                                       issued =>  #                                       issued =>
397  #                                       modified =>  #                                       modified =>
398                                  );                                  ) if ( $div );
399    
400                                  $mech->back;                                  $mech->back;
401                                  $page_tree->delete;                                  $page_tree->delete;
# Line 295  sub scrape { Line 403  sub scrape {
403                          } else {                          } else {
404                                  warn "can't follow uri $page_uri: $!\n";                                  warn "can't follow uri $page_uri: $!\n";
405                          }                          }
406                    } else {
407                            $self->log->debug("result $nr doesn't have link inside, ignoring...");
408                  }                  }
409    
410                  last if ($nr == $max);                  last if ($nr == $max);
Legend:
Removed from v.113  
changed lines
  Added in v.132
  ViewVC Help
Powered by ViewVC 1.1.26