/[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 100 by dpavlin, Sat Feb 24 12:32:31 2007 UTC revision 133 by dpavlin, Tue May 1 20:50:14 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) );  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 108  sub search { Line 108  sub search {
108          my $class = $self->feed->source || 'Grep::Source::Feed';          my $class = $self->feed->source || 'Grep::Source::Feed';
109          $self->log->debug("using $class");          $self->log->debug("using $class");
110    
111          my $parent = $self;          $self->search_obj( Grep::Search->new() );
112          $class->fetch( $parent );          $self->log->debug("created " . $self->search_obj);
         undef $parent;  
113    
114          Grep::Search->finish if $self->new_items;          $class->fetch( $self );
115    
116            $self->search_obj->finish;
117    
118          return $self->collection;          return $self->collection;
119  }  }
# Line 131  This will also update L</new_items> Line 132  This will also update L</new_items>
132  sub add_record {  sub add_record {
133          my $self = shift;          my $self = shift;
134    
135            $self->log->confess("no search_obj") unless ($self->search_obj);
136    
137          my $i = Grep::Model::Item->new();          my $i = Grep::Model::Item->new();
138    
139          my $rec = {@_};          my $rec = {@_};
140    
141          warn "resolving links";          $self->log->debug("resolving links using base ", $rec->{link});
142          my $resolver = HTML::ResolveLink->new( base => $rec->{link} );          my $resolver = HTML::ResolveLink->new( base => $rec->{link} );
143          $rec->{content} = $resolver->resolve( $rec->{content} );          $rec->{content} = $resolver->resolve( $rec->{content} );
144    
# Line 149  sub add_record { Line 152  sub add_record {
152    
153                  # is new record?                  # is new record?
154                  if ( $msg !~ m/^Found/ ) {                  if ( $msg !~ m/^Found/ ) {
155                          Grep::Search->add( $i );                          $self->search_obj->add( $i );
156                          $self->new_items( ( $self->new_items || 0 ) + 1 );                          $self->new_items( ( $self->new_items || 0 ) + 1 );
157                  }                  }
158          } else {          } else {
# Line 185  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    warn "triplets = ",dump( @triplets );
237    
238            while ( @triplets ) {
239                    ( $el,$attr,$value ) = splice( @triplets, 0, 3 );
240                    my $tag = $attr ? "<$el $attr=\"$value\">" : "<$el>";
241                    push @tags, $tag;
242                    $self->log->debug("looking for $message $tag");
243                    @results = $tree->look_down( '_tag', $el, sub {
244                                    return 1 unless ( $attr && $value );
245                                    ( $_[0]->attr( $attr ) || '' ) eq $value;
246                    });
247                    last if @results;
248            }
249    
250            if ( ! @results ) {
251                    my $msg = "can't find $message ", join(" ", @tags);
252                    die $msg if ( $fatal );
253                    warn $msg;
254                    return;
255            }
256    
257            $self->log->debug("found ", $#results + 1, " results");
258    
259            #warn dump( map { $_->as_HTML } @results );
260    
261            return @results if wantarray;
262            return shift @results;
263    }
264    
265  =head2 scrape  =head2 scrape
266    
267  Create semi-complex L<WWW::Mechanize> rules to scrape page  Create semi-complex L<WWW::Mechanize> rules to scrape page easily
268    
269      $parent->scrape(
270                    # if search string isn't part or URI
271                    submit_form => {
272                            fields => {
273                                    value => $parent->q,
274                            },
275                            button => 'fullsearch',
276                    },
277                    # element with search results
278                    wrapper => [ qw/div class searchresults/ ],
279                    # element (or tripple) for each result with link
280                    # <a href=".."> inside it to full-text result
281                    results => 'dt',
282                    # collect which element on page linked from results
283                    scrape => [ qw/div id page/ ],
284                    # when search returns just single hit, it will redirect to result page
285                    redirect_single_result => 1,
286      );
287    
288  =cut  =cut
289    
# Line 197  sub scrape { Line 292  sub scrape {
292    
293          my $args = {@_};          my $args = {@_};
294    
295          warn "scrape got args ",dump($args);          $self->log->debug("scrape with args ",dump($args));
296    
297          my ($feed,$uri,$q) = ($self->feed, $self->uri,$self->q);          my ($feed,$uri,$q) = ($self->feed, $self->uri,$self->q);
298          die "no uri" unless ($uri);          die "no uri" unless ($uri);
# Line 219  sub scrape { Line 314  sub scrape {
314          $self->save( 'get.html', $mech->content );          $self->save( 'get.html', $mech->content );
315    
316          if ( my $form = $args->{submit_form} ) {          if ( my $form = $args->{submit_form} ) {
317                  warn "submit form on $uri with ", dump( $form ),"\n";                  $self->log->debug("submit form on $uri with ", dump( $form ));
318                  $mech->submit_form( %$form ) or die "can't submit form ", dump( $form );                  $mech->submit_form( %$form ) or die "can't submit form ", dump( $form );
319                  $self->save( 'submit.html', $mech->content );                  $self->save( 'submit.html', $mech->content );
320          }          }
321    
322          warn "parse result page\n";          $self->log->debug("parse result page");
323    
324          my $tree = HTML::TreeBuilder->new or die "can't create html tree";          my $tree = HTML::TreeBuilder->new or die "can't create html tree";
325          $tree->parse( $mech->content ) or die "can't parse fetched content";          $tree->parse( $mech->content ) or die "can't parse fetched content";
326    
327          die "wrapper doesn't have 3 elements but ", $#{ $args->{wrapper} } unless ( $#{ $args->{wrapper} } == 2 );          my @wrapper_divs = $self->element_by_triplet(
328          my ( $el,$attr,$value ) = @{ $args->{wrapper} };                  tree => $tree,
329                    triplets => $args->{wrapper},
330                    message => 'wrapper for all results',
331                    fatal => $args->{redirect_single_result} ? 0 : 1,
332            );
333    
334            my $max = 15;
335            my $nr = 1;
336    
337            my $base_uri = $uri;
338            $base_uri =~ s!\?.*$!!;
339    
340            # directly got first result
341            if ( $args->{redirect_single_result} && ! @wrapper_divs ) {
342    
343          warn "looking for <$el $attr=\"$value\">";                  my $uri = $mech->uri; $uri->query( undef ); $uri = $uri->canonical;
344    
345          my $div = $tree->look_down( '_tag', $el, sub {                  my $div = $self->element_by_triplet(
346                          warn dump( $_[0]->attr( $attr ) ),$/;                          tree => $tree,
347                          ( $_[0]->attr( $attr ) || '' ) eq $value;                          message => "single result - redirect to $uri",
348          });                          triplets => $args->{scrape},
349                            fatal => 1,
350                    );
351    
352                    $self->add_record(
353                            in_feed => $feed,
354                            title => $mech->title,
355                            link => $uri,
356                            content => $div->as_HTML,
357                    );
358    
359          if ( ! $div ) {                  $tree->delete; # clear memory!
                 warn "can't find results wrapper <$el $attr=\"$value\">";  
360                  return;                  return;
361          }          }
362    
363          my $max = 5;          my @r;
         my $nr = 1;  
364    
365          my $base_uri = $uri;          foreach my $div ( @wrapper_divs ) {
366          $base_uri =~ s!\?.*$!!;  
367                    my @r_here = $self->element_by_triplet(
368                            tree => $div,
369                            triplets => $args->{results},
370                            message => 'result element',
371                    );
372    
373                    push @r, @r_here if (@r_here);
374            }
375    
376          foreach my $dt ( $div->look_down( '_tag', $args->{results} ) ) {          $self->log->debug("in total, found ", $#r + 1, " results in ", $#wrapper_divs + 1, " result wrapper elements");
377    
378            foreach my $dt ( @r ) {
379                  my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );                  my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
380                  if ( $a ) {                  if ( $a ) {
381    
382                          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}, ">";
383                          my $page_uri = URI->new_abs( $a->attr('href'), $base_uri );  
384                            my $page_uri = URI->new_abs( $href, $base_uri );
385                          $page_uri->query( undef );                          $page_uri->query( undef );
386                          $page_uri = $page_uri->canonical;                          $page_uri = $page_uri->canonical;
387    
388                          warn "fetching page: ",$a->as_text," from $page_uri\n";                          $self->log->debug("fetching page: ",$a->as_text," from $page_uri");
389                          if ( $mech->follow_link( url => $a->attr('href') ) ) {                          if ( $mech->follow_link( url => $href ) ) {
390    
391                                  $self->save( "page-${nr}.html", $mech->content );                                  $self->save( "page-${nr}.html", $mech->content );
392    
393                                  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";
394                                  $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";
395                                    my $div = $self->element_by_triplet(
396                                  ( $el,$attr,$value ) = @{ $args->{scrape} };                                          tree => $page_tree,
397                                  $div = $page_tree->look_down( '_tag', $el, sub { ( $_[0]->attr( $attr ) || '' ) eq $value } );                                          message => "result page $nr",
398                                            triplets => $args->{scrape}
399                                  die "can't find <$el $attr=\"$value\">" unless ($div);                                  );
400    
401                                  $self->add_record(                                  $self->add_record(
402                                          in_feed => $feed,                                          in_feed => $feed,
# Line 282  sub scrape { Line 408  sub scrape {
408  #                                       author =>  #                                       author =>
409  #                                       issued =>  #                                       issued =>
410  #                                       modified =>  #                                       modified =>
411                                  );                                  ) if ( $div );
412    
413                                  $mech->back;                                  $mech->back;
414                                  $page_tree->delete;                                  $page_tree->delete;
# Line 290  sub scrape { Line 416  sub scrape {
416                          } else {                          } else {
417                                  warn "can't follow uri $page_uri: $!\n";                                  warn "can't follow uri $page_uri: $!\n";
418                          }                          }
419                    } else {
420                            $self->log->debug("result $nr doesn't have link inside, ignoring...");
421                  }                  }
422    
423                  last if ($nr == $max);                  last if ($nr == $max);
Legend:
Removed from v.100  
changed lines
  Added in v.133
  ViewVC Help
Powered by ViewVC 1.1.26