/[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 74 by dpavlin, Fri Feb 23 17:16:33 2007 UTC revision 96 by dpavlin, Sat Feb 24 11:56:18 2007 UTC
# Line 10  use Module::Pluggable search_path => 'Gr Line 10  use Module::Pluggable search_path => 'Gr
10  use base qw(Class::Accessor);  use base qw(Class::Accessor);
11  Grep::Source->mk_accessors( qw(feed uri q new_items collection) );  Grep::Source->mk_accessors( qw(feed uri q new_items collection) );
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    
21  =head1 NAME  =head1 NAME
# Line 102  sub search { Line 108  sub search {
108          my $class = $self->feed->source || 'Grep::Source::Feed';          my $class = $self->feed->source || 'Grep::Source::Feed';
109          Jifty->log->debug("using $class");          Jifty->log->debug("using $class");
110    
111          $class->fetch( $self );          my $parent = $self;
112            $class->fetch( $parent );
113            undef $parent;
114    
115          Grep::Search->finish if $self->new_items;          Grep::Search->finish if $self->new_items;
116    
# Line 125  sub add_record { Line 133  sub add_record {
133    
134          my $i = Grep::Model::Item->new();          my $i = Grep::Model::Item->new();
135    
136          my ($ok,$msg) = $i->load_or_create( @_ );          my $rec = {@_};
137    
138            warn "resolving links";
139            my $resolver = HTML::ResolveLink->new( base => $rec->{link} );
140            $rec->{content} = $resolver->resolve( $rec->{content} );
141    
142            my ($ok,$msg) = $i->load_or_create( %$rec );
143    
144          $msg ||= '';          $msg ||= '';
145    
# Line 158  sub content_class { Line 172  sub content_class {
172    
173          foreach my $s ( $self->sources ) {          foreach my $s ( $self->sources ) {
174                  Jifty->log->debug("testing source class $s");                  Jifty->log->debug("testing source class $s");
175                  if ($s->can('content_have') && $s->content_have( $content ) ) {                  if ( $s->can('content_have') ) {
176                          Jifty->log->debug("${s}->content_have succesful");                          my $regex =     $s->content_have( $content ) or
177                          return "$s";                                  die "${s}->content_have didn't return anything";
178                            die "${s}->content_have didn't return regex but ", dump( $regex ), " ref ", ref( $regex )
179                                    unless ( ref($regex) eq 'Regexp' );
180                            if ( $content =~ $regex ) {
181                                    Jifty->log->debug("${s}->content_have succesful");
182                                    return $s;
183                            }
184                    }
185            }
186    }
187    
188    =head2 scrape
189    
190    Create semi-complex L<WWW::Mechanize> rules to scrape page
191    
192    
193    =cut
194    
195    sub scrape {
196            my $self = shift;
197    
198            my $args = {@_};
199    
200            warn "scrape got args ",dump($args);
201    
202            my ($feed,$uri,$q) = ($self->feed, $self->uri,$self->q);
203            die "no uri" unless ($uri);
204            die "feed is not a Grep::Model::Feed but ", ref $feed unless $feed->isa('Grep::Model::Feed');
205    
206            sub mech_warn {
207                    my $m = shift || return;
208                    warn $m;
209            }
210    
211            my $mech = WWW::Mechanize->new(
212                    cookie_jar => {},
213                    onwarn => \&mech_warn,
214                    onerror => \&mech_warn,
215            );
216    
217            $mech->get( $uri );
218    
219            $self->save( 'get.html', $mech->content );
220    
221            if ( my $form = $args->{submit_form} ) {
222                    warn "submit form on $uri with ", dump( $form ),"\n";
223                    $mech->submit_form( %$form ) or die "can't submit form ", dump( $form );
224                    $self->save( 'submit.html', $mech->content );
225            }
226    
227            warn "parse result page\n";
228    
229            my $tree = HTML::TreeBuilder->new or die "can't create html tree";
230            $tree->parse( $mech->content ) or die "can't parse fetched content";
231    
232            die "wrapper doesn't have 3 elements but ", $#{ $args->{wrapper} } unless ( $#{ $args->{wrapper} } == 2 );
233            my ( $el,$attr,$value ) = @{ $args->{wrapper} };
234    
235            warn "looking for <$el $attr=\"$value\">";
236    
237            my $div = $tree->look_down( '_tag', $el, sub {
238                            warn dump( $_[0]->attr( $attr ) ),$/;
239                            ( $_[0]->attr( $attr ) || '' ) eq $value;
240            });
241    
242            if ( ! $div ) {
243                    warn "can't find results wrapper <$el $attr=\"$value\">";
244                    return;
245            }
246    
247            my $max = 5;
248            my $nr = 1;
249    
250            my $base_uri = $uri;
251            $base_uri =~ s!\?.*$!!;
252    
253            foreach my $dt ( $div->look_down( '_tag', $args->{results} ) ) {
254                    my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
255                    if ( $a ) {
256    
257                            my $href = $a->attr('href') or die "can't find href inside <", $args->{results}, ">";
258                            my $page_uri = URI->new_abs( $a->attr('href'), $base_uri );
259                            $page_uri->query( undef );
260                            $page_uri = $page_uri->canonical;
261    
262                            warn "fetching page: ",$a->as_text," from $page_uri\n";
263                            if ( $mech->follow_link( url => $a->attr('href') ) ) {
264    
265                                    $self->save( "page-${nr}.html", $mech->content );
266    
267                                    my $page_tree = HTML::TreeBuilder->new or die "can't create page tree";
268                                    $page_tree->parse( $mech->content ) or die "can't parse page at $page_uri";
269    
270                                    ( $el,$attr,$value ) = @{ $args->{scrape} };
271                                    $div = $page_tree->look_down( '_tag', $el, sub { ( $_[0]->attr( $attr ) || '' ) eq $value } );
272    
273                                    die "can't find <$el $attr=\"$value\">" unless ($div);
274    
275                                    $self->add_record(
276                                            in_feed => $feed,
277                                            title => $mech->title,
278                                            link => $page_uri,
279                                            content => $div->as_HTML,
280    #                                       summary =>
281    #                                       category =>
282    #                                       author =>
283    #                                       issued =>
284    #                                       modified =>
285                                    );
286    
287                                    $mech->back;
288                                    $page_tree->delete;
289    
290                            } else {
291                                    warn "can't follow uri $page_uri: $!\n";
292                            }
293                  }                  }
294    
295                    last if ($nr == $max);
296                    $nr++;
297            }
298    
299            $tree->delete; # clear memory!
300    
301    }
302    
303    =head2 save
304    
305      save( 'name', $content );
306    
307    Save dumps into C</tmp/grep> if writable
308    
309    =cut
310    
311    sub save {
312            my $self = shift;
313            my ( $file, $content ) = @_;
314            if ( -w '/tmp/grep' ) {
315                    open(my $f, '>', "/tmp/grep/$file") or die "can't open $file: $!";
316                    print $f $content or die "can't write to $file: $!";
317                    close $f or die "can't close $file: $!";
318                    Jifty->log->debug("saved $file ",length($content)," bytes");
319          }          }
320  }  }
321    
Legend:
Removed from v.74  
changed lines
  Added in v.96
  ViewVC Help
Powered by ViewVC 1.1.26