/[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 121 by dpavlin, Sat Apr 28 13:08:50 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 195  Create semi-complex L<WWW::Mechanize> ru Line 195  Create semi-complex L<WWW::Mechanize> ru
195    
196  =cut  =cut
197    
198    sub element_by_triplet {
199            my $self = shift;
200    
201            my $args = {@_};
202    
203            my $tree = $args->{tree} || die "no tree";
204            my $message = $args->{message};
205            my $fatal = $args->{fatal};
206            die "no templates" unless defined( $args->{templates} );
207            my @templates = @{ $args->{templates} };
208    
209            push @templates, ( undef, undef ) if ( $#templates == 0 );
210    
211            die "wrapper doesn't have 3 elements but ", $#templates unless (
212                    ( $#templates + 1 ) % 3 == 0
213            );
214    
215            my ( $result, $el, $attr, $value );
216    
217            my @tags;
218    
219            while ( @templates ) {
220                    ( $el,$attr,$value ) = splice( @templates, 0, 3 );
221                    my $tag = $attr ? "<$el $attr=\"$value\">" : "<$el>";
222                    push @tags, $tag;
223                    $self->log->debug("looking for $message $tag");
224                    $result = $tree->look_down( '_tag', $el, sub {
225                                    return 1 unless ( $attr && $value );
226                                    ( $_[0]->attr( $attr ) || '' ) eq $value;
227                    });
228                    last if $result;
229            }
230    
231            if ( ! $result ) {
232                    my $msg = "can't find $message ", join(" ", @tags);
233                    die $msg if ( $fatal );
234                    warn $msg;
235                    return;
236            }
237    
238            return $result;
239    }
240    
241  sub scrape {  sub scrape {
242          my $self = shift;          my $self = shift;
243    
# Line 232  sub scrape { Line 275  sub scrape {
275          my $tree = HTML::TreeBuilder->new or die "can't create html tree";          my $tree = HTML::TreeBuilder->new or die "can't create html tree";
276          $tree->parse( $mech->content ) or die "can't parse fetched content";          $tree->parse( $mech->content ) or die "can't parse fetched content";
277    
278          die "wrapper doesn't have 3 elements but ", $#{ $args->{wrapper} } unless ( $#{ $args->{wrapper} } == 2 );          my $div = $self->element_by_triplet(
279          my ( $el,$attr,$value ) = @{ $args->{wrapper} };                  tree => $tree,
280                    templates => $args->{wrapper},
281          $self->log->debug("looking for <$el $attr=\"$value\">");                  message => 'wrapper for all results',
282                    fatal => 1
283          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;  
         }  
284    
285          my $max = 15;          my $max = 15;
286          my $nr = 1;          my $nr = 1;
# Line 252  sub scrape { Line 288  sub scrape {
288          my $base_uri = $uri;          my $base_uri = $uri;
289          $base_uri =~ s!\?.*$!!;          $base_uri =~ s!\?.*$!!;
290    
291          my @r = $div->look_down( '_tag', $args->{results} );          my @r = $self->element_by_triplet(
292          $self->log->debug("found ", scalar @r, " <$args->{results}>");                  tree => $tree,
293                    templates => $args->{results},
294                    message => 'result element',
295            );
296    
297          foreach my $dt ( @r ) {          foreach my $dt ( @r ) {
298                  my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );                  my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
# Line 271  sub scrape { Line 310  sub scrape {
310    
311                                  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";
312                                  $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";
313                                    $div = $self->element_by_triplet(
314                                  ( $el,$attr,$value ) = @{ $args->{scrape} };                                          tree => $page_tree,
315                                  $div = $page_tree->look_down( '_tag', $el, sub { ( $_[0]->attr( $attr ) || '' ) eq $value } );                                          message => "result $nr",
316                                            templates => $args->{scrape}
317                                  die "can't find <$el $attr=\"$value\">" unless ($div);                                  );
318    
319                                  $self->add_record(                                  $self->add_record(
320                                          in_feed => $feed,                                          in_feed => $feed,
# Line 287  sub scrape { Line 326  sub scrape {
326  #                                       author =>  #                                       author =>
327  #                                       issued =>  #                                       issued =>
328  #                                       modified =>  #                                       modified =>
329                                  );                                  ) if ( $div );
330    
331                                  $mech->back;                                  $mech->back;
332                                  $page_tree->delete;                                  $page_tree->delete;
# Line 295  sub scrape { Line 334  sub scrape {
334                          } else {                          } else {
335                                  warn "can't follow uri $page_uri: $!\n";                                  warn "can't follow uri $page_uri: $!\n";
336                          }                          }
337                    } else {
338                            $self->log->debug("result $nr doesn't have link inside, ignoring...");
339                  }                  }
340    
341                  last if ($nr == $max);                  last if ($nr == $max);

Legend:
Removed from v.113  
changed lines
  Added in v.121

  ViewVC Help
Powered by ViewVC 1.1.26