/[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 73 by dpavlin, Fri Feb 23 11:48:39 2007 UTC revision 165 by dpavlin, Mon Jun 11 22:56:53 2007 UTC
# Line 7  package Grep::Source; Line 7  package Grep::Source;
7    
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);  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;
14    use WWW::Mechanize;
15    use XML::Feed;
16    use URI;
17    use HTML::ResolveLink;
18    
19  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
20    
# Line 95  sub search { Line 101  sub search {
101    
102          $self->uri( $uri );          $self->uri( $uri );
103    
104          Jifty->log->info( $message );          $self->log->info( $message );
105    
106          $self->collection( Grep::Model::ItemCollection->new() );          $self->collection( Grep::Model::ItemCollection->new() );
107    
108          my $class = $self->feed->source || 'Grep::Source::Feed';          my $class = $self->feed->source || 'Grep::Source::Feed';
109          Jifty->log->debug("using $class");          $self->log->debug("using $class");
110    
111            $self->search_obj( Grep::Search->new() );
112            $self->log->debug("created " . $self->search_obj);
113    
114          $class->fetch( $self );          $class->fetch( $self );
115    
116          Grep::Search->finish if $self->new_items;          $self->search_obj->finish;
117    
118          return $self->collection;          return $self->collection;
119  }  }
# Line 123  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 ($ok,$msg) = $i->load_or_create( @_ );          my $rec = {@_};
140    
141            $self->log->debug("resolving links using base ", $rec->{link});
142            my $resolver = HTML::ResolveLink->new( base => $rec->{link} );
143            $rec->{content} = $resolver->resolve( $rec->{content} );
144    
145            my ($ok,$msg) = $i->load_or_create( %$rec );
146    
147          $msg ||= '';          $msg ||= '';
148    
149          if ( $ok ) {          if ( $ok ) {
150                  Jifty->log->debug("item ", $i->id, ": $msg");                  $self->log->debug("item ", $i->id, ": $msg");
151                  $self->collection->add_record( $i );                  $self->collection->add_record( $i );
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 + 1 );                          $self->new_items( ( $self->new_items || 0 ) + 1 );
157                  }                  }
158          } else {          } else {
159                  warn "can't add entry ", dump( @_ ), "\n";                  warn "can't add entry ", dump( @_ ), "\n";
# Line 157  sub content_class { Line 174  sub content_class {
174          my $content = shift or die "no content?";          my $content = shift or die "no content?";
175    
176          foreach my $s ( $self->sources ) {          foreach my $s ( $self->sources ) {
177                  Jifty->log->debug("testing source class $s");                  $self->log->debug("testing source class $s");
178                  if ($s->can('content_have') && $s->content_have( $content ) ) {                  if ( $s->can('content_have') ) {
179                          Jifty->log->debug("${s}->content_have succesful");                          my $regex =     $s->content_have( $content ) or
180                          return "$s";                                  die "${s}->content_have didn't return anything";
181                            die "${s}->content_have didn't return regex but ", dump( $regex ), " ref ", ref( $regex )
182                                    unless ( ref($regex) eq 'Regexp' );
183                            if ( $content =~ $regex ) {
184                                    $self->log->debug("${s}->content_have succesful");
185                                    return $s;
186                            }
187                    }
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            $self->log->debug("looking for $message ", dump( @triplets ));
237            while ( @triplets ) {
238                    ( $el,$attr,$value ) = splice( @triplets, 0, 3 );
239                    my $tag = $attr ? "<$el $attr=\"$value\">" : "<$el>";
240                    push @tags, $tag;
241                    @results = $tree->look_down( '_tag', $el, sub {
242                                    return 1 unless ( $attr && $value );
243                                    ( $_[0]->attr( $attr ) || '' ) =~ m/\b\Q$value\E\b/
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, " elements");
256            #warn dump( map { $_->as_HTML } @results );
257    
258            return @results if wantarray;
259            return shift @results;
260    }
261    
262    =head2 scrape
263    
264    Create semi-complex L<WWW::Mechanize> rules to scrape page easily
265    
266      $parent->scrape(
267                    # if search string isn't part or URI
268                    submit_form => {
269                            fields => {
270                                    value => $parent->q,
271                            },
272                            button => 'fullsearch',
273                    },
274                    # element with search results
275                    wrapper => [ qw/div class searchresults/ ],
276                    # element (or tripple) for each result with link
277                    # <a href=".."> inside it to full-text result
278                    results => 'dt',
279                    # collect which element on page linked from results
280                    scrape => [ qw/div id page/ ],
281                    # when search returns just single hit, it will redirect to result page
282                    redirect_single_result => 1,
283      );
284    
285    =cut
286    
287    sub scrape {
288            my $self = shift;
289    
290            my $args = {@_};
291    
292            $self->log->debug("scrape with args ",dump($args));
293    
294            my ($feed,$uri,$q) = ($self->feed, $self->uri,$self->q);
295            die "no uri" unless ($uri);
296            die "feed is not a Grep::Model::Feed but ", ref $feed unless $feed->isa('Grep::Model::Feed');
297    
298            sub mech_warn {
299                    my $m = shift || return;
300                    warn $m;
301            }
302    
303            my $mech = WWW::Mechanize->new(
304                    cookie_jar => {},
305                    onwarn => \&mech_warn,
306                    onerror => \&mech_warn,
307            );
308    
309            $mech->get( $uri );
310    
311            $self->save( 'get.html', $mech->content );
312    
313            if ( my $form = $args->{submit_form} ) {
314                    $self->log->debug("submit form on $uri with ", dump( $form ));
315                    $mech->submit_form( %$form ) or die "can't submit form ", dump( $form );
316                    $self->save( 'submit.html', $mech->content );
317            }
318    
319            $self->log->debug("parse result page");
320    
321            my $tree = HTML::TreeBuilder->new or die "can't create html tree";
322            $tree->parse( $mech->content ) or die "can't parse fetched content";
323    
324            my @wrapper_divs = $self->element_by_triplet(
325                    tree => $tree,
326                    triplets => $args->{wrapper},
327                    message => 'wrapper for all results',
328                    # on closer recollection, this shouldn't be ever fatal, because
329                    # "no results found" page might not contain wrapper
330                    #fatal => $args->{redirect_single_result} ? 0 : 1,
331            );
332    
333            my $max = 15;
334            my $nr = 1;
335    
336            my $base_uri = $uri;
337            $base_uri =~ s!\?.*$!!;
338    
339            # directly got first result
340            if ( $args->{redirect_single_result} && ! @wrapper_divs ) {
341    
342                    my $uri = $mech->uri; $uri->query( undef ); $uri = $uri->canonical;
343    
344                    my $div = $self->element_by_triplet(
345                            tree => $tree,
346                            message => "single result - redirect to $uri",
347                            triplets => $args->{scrape},
348                            fatal => 1,
349                    );
350    
351                    $self->add_record(
352                            in_feed => $feed,
353                            title => $mech->title,
354                            link => $uri,
355                            content => $div->as_HTML,
356                    );
357    
358                    $tree->delete; # clear memory!
359                    return;
360            }
361    
362            my @r;
363    
364            foreach my $div ( @wrapper_divs ) {
365    
366                    my @r_here = $self->element_by_triplet(
367                            tree => $div,
368                            triplets => $args->{results},
369                            message => 'result element',
370                    );
371    
372                    push @r, @r_here if (@r_here);
373            }
374    
375            $self->log->debug("in total, found ", $#r + 1, " results in ", $#wrapper_divs + 1, " result wrapper elements");
376    
377            foreach my $dt ( @r ) {
378                    my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
379                    if ( $a ) {
380    
381                            my $href = $a->attr('href') or die "can't find href inside <", $args->{results}, ">";
382    
383                            my $page_uri = URI->new_abs( $href, $base_uri );
384                            $page_uri->query( undef );
385                            $page_uri = $page_uri->canonical;
386    
387                            $self->log->debug("fetching page: ",$a->as_text," from $page_uri");
388                            if ( $mech->follow_link( url => $href ) ) {
389    
390                                    $self->save( "page-${nr}.html", $mech->content );
391    
392                                    my $page_tree = HTML::TreeBuilder->new or die "can't create page tree";
393                                    $page_tree->parse( $mech->content ) or die "can't parse page at $page_uri";
394                                    my @divs = $self->element_by_triplet(
395                                            tree => $page_tree,
396                                            message => "result page $nr",
397                                            triplets => $args->{scrape}
398                                    );
399    
400                                    if ( @divs ) {
401    
402                                            my $html = join("<hr/>\n", map { $_->as_HTML } @divs );
403                                            $self->log->debug("combined ", $#divs + 1, " elements elements in ", length($html), " bytes");
404    
405                                            $self->add_record(
406                                                    in_feed => $feed,
407                                                    title => $mech->title,
408                                                    link => $page_uri,
409                                                    content => $html,
410    #                                               summary =>
411    #                                               category =>
412    #                                               author =>
413    #                                               issued =>
414    #                                               modified =>
415                                            );
416    
417                                    } else {
418                                            $self->log->debug("NO CONTENT scraped from page $nr");
419                                    }
420    
421                                    $mech->back;
422                                    $page_tree->delete;
423    
424                            } else {
425                                    warn "can't follow uri $page_uri: $!\n";
426                            }
427                    } else {
428                            $self->log->debug("result $nr doesn't have link inside, ignoring...");
429                  }                  }
430    
431                    last if ($nr == $max);
432                    $nr++;
433            }
434    
435            $tree->delete; # clear memory!
436    
437    }
438    
439    =head2 save
440    
441      save( 'name', $content );
442    
443    Save dumps into C</tmp/grep> if writable
444    
445    =cut
446    
447    sub save {
448            my $self = shift;
449            my ( $file, $content ) = @_;
450            return unless ( defined($file) && defined($content) );
451            if ( -w '/tmp/grep' ) {
452                    open(my $f, '>', "/tmp/grep/$file") or die "can't open $file: $!";
453                    print $f $content or die "can't write to $file: $!";
454                    close $f or die "can't close $file: $!";
455                    $self->log->debug("saved $file ",length($content)," bytes");
456          }          }
457  }  }
458    
Legend:
Removed from v.73  
changed lines
  Added in v.165
  ViewVC Help
Powered by ViewVC 1.1.26