/[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 103 by dpavlin, Sun Mar 4 22:51:01 2007 UTC revision 130 by dpavlin, Sun Apr 29 12:07:06 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 = {@_};
# 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 192  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 triplets" unless defined( $args->{triplets} );
207            my @triplets;
208            if ( ref( $args->{triplets} ) eq 'ARRAY' ) {
209                    @triplets = @{ $args->{triplets} };
210            } else {
211                    @triplets = ( $args->{triplets} );
212            }
213    
214            push @triplets, ( undef, undef ) if ( $#triplets == 0 );
215    
216            die "wrapper doesn't have 3 elements but ", $#triplets unless (
217                    ( $#triplets + 1 ) % 3 == 0
218            );
219    
220            my ( $el, $attr, $value );
221    
222            my @results;
223            my @tags;
224    
225            while ( @triplets ) {
226                    ( $el,$attr,$value ) = splice( @triplets, 0, 3 );
227                    my $tag = $attr ? "<$el $attr=\"$value\">" : "<$el>";
228                    push @tags, $tag;
229                    $self->log->debug("looking for $message $tag");
230                    @results = $tree->look_down( '_tag', $el, sub {
231                                    return 1 unless ( $attr && $value );
232                                    ( $_[0]->attr( $attr ) || '' ) eq $value;
233                    });
234                    last if @results;
235            }
236    
237            if ( ! @results ) {
238                    my $msg = "can't find $message ", join(" ", @tags);
239                    die $msg if ( $fatal );
240                    warn $msg;
241                    return;
242            }
243    
244            $self->log->debug("found ", $#results + 1, " results");
245    
246            return @results if wantarray;
247            return shift @results;
248    }
249    
250  sub scrape {  sub scrape {
251          my $self = shift;          my $self = shift;
252    
# Line 229  sub scrape { Line 284  sub scrape {
284          my $tree = HTML::TreeBuilder->new or die "can't create html tree";          my $tree = HTML::TreeBuilder->new or die "can't create html tree";
285          $tree->parse( $mech->content ) or die "can't parse fetched content";          $tree->parse( $mech->content ) or die "can't parse fetched content";
286    
287          die "wrapper doesn't have 3 elements but ", $#{ $args->{wrapper} } unless ( $#{ $args->{wrapper} } == 2 );          my $div = $self->element_by_triplet(
288          my ( $el,$attr,$value ) = @{ $args->{wrapper} };                  tree => $tree,
289                    triplets => $args->{wrapper},
290          $self->log->debug("looking for <$el $attr=\"$value\">");                  message => 'wrapper for all results',
291                    fatal => 1
292          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;  
         }  
293    
294          my $max = 15;          my $max = 15;
295          my $nr = 1;          my $nr = 1;
# Line 249  sub scrape { Line 297  sub scrape {
297          my $base_uri = $uri;          my $base_uri = $uri;
298          $base_uri =~ s!\?.*$!!;          $base_uri =~ s!\?.*$!!;
299    
300          foreach my $dt ( $div->look_down( '_tag', $args->{results} ) ) {          my @r = $self->element_by_triplet(
301                    tree => $tree,
302                    triplets => $args->{results},
303                    message => 'result element',
304            );
305    
306            foreach my $dt ( @r ) {
307                  my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );                  my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
308                  if ( $a ) {                  if ( $a ) {
309    
# Line 265  sub scrape { Line 319  sub scrape {
319    
320                                  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";
321                                  $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";
322                                    $div = $self->element_by_triplet(
323                                  ( $el,$attr,$value ) = @{ $args->{scrape} };                                          tree => $page_tree,
324                                  $div = $page_tree->look_down( '_tag', $el, sub { ( $_[0]->attr( $attr ) || '' ) eq $value } );                                          message => "result $nr",
325                                            triplets => $args->{scrape}
326                                  die "can't find <$el $attr=\"$value\">" unless ($div);                                  );
327    
328                                  $self->add_record(                                  $self->add_record(
329                                          in_feed => $feed,                                          in_feed => $feed,
# Line 281  sub scrape { Line 335  sub scrape {
335  #                                       author =>  #                                       author =>
336  #                                       issued =>  #                                       issued =>
337  #                                       modified =>  #                                       modified =>
338                                  );                                  ) if ( $div );
339    
340                                  $mech->back;                                  $mech->back;
341                                  $page_tree->delete;                                  $page_tree->delete;
# Line 289  sub scrape { Line 343  sub scrape {
343                          } else {                          } else {
344                                  warn "can't follow uri $page_uri: $!\n";                                  warn "can't follow uri $page_uri: $!\n";
345                          }                          }
346                    } else {
347                            $self->log->debug("result $nr doesn't have link inside, ignoring...");
348                  }                  }
349    
350                  last if ($nr == $max);                  last if ($nr == $max);
Legend:
Removed from v.103  
changed lines
  Added in v.130
  ViewVC Help
Powered by ViewVC 1.1.26