/[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 84 by dpavlin, Fri Feb 23 18:10:26 2007 UTC revision 85 by dpavlin, Fri Feb 23 20:47:08 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    
18  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
19    
20  =head1 NAME  =head1 NAME
# Line 171  sub content_class { Line 176  sub content_class {
176          }          }
177  }  }
178    
179    =head2 scrape
180    
181    Create semi-complex L<WWW::Mechanize> rules to scrape page
182    
183    
184    =cut
185    
186    sub scrape {
187            my $self = shift;
188    
189            my $args = {@_};
190    
191            warn "scrape got args ",dump($args);
192    
193            my ($feed,$uri,$q) = ($self->feed, $self->uri,$self->q);
194            die "no uri" unless ($uri);
195            die "feed is not a Grep::Model::Feed but ", ref $feed unless $feed->isa('Grep::Model::Feed');
196    
197            sub save_html {
198                    my ( $file, $content ) = @_;
199                    if ( -w '/tmp/grep' ) {
200                            open(my $f, '>', "/tmp/grep/${file}.html") or die "can't open $file: $!";
201                            print $f $content or die "can't write to $file: $!";
202                            close $f or die "can't close $file: $!";
203                    }
204            }
205    
206            my $mech = WWW::Mechanize->new();
207    
208            $mech->get( $uri );
209    
210            save_html( 'get', $mech->content );
211    
212            if ( $args->{submit_form} ) {
213                    warn "submit form on $uri\n";
214                    $mech->submit_form( %{ $args->{submit_form} } ) or die "can't submit form";
215                    save_html( 'submit', $mech->content );
216            }
217    
218            warn "parse result page\n";
219    
220            my $tree = HTML::TreeBuilder->new or die "can't create html tree";
221            $tree->parse( $mech->content ) or die "can't parse fetched content";
222    
223            die "wrapper doesn't have 3 elements but ", $#{ $args->{wrapper} } unless ( $#{ $args->{wrapper} } == 2 );
224            my ( $el,$attr,$value ) = @{ $args->{wrapper} };
225    
226            warn "looking for <$el $attr=\"$value\">";
227    
228            my $div = $tree->look_down( '_tag', $el, sub {
229                            warn dump( $_[0]->attr( $attr ) ),$/;
230                            ( $_[0]->attr( $attr ) || '' ) eq $value;
231            });
232    
233            die "can't find results wrapper <$el $attr=\"$value\">" unless ( $div );
234    
235            my $max = 5;
236            my $nr = 1;
237    
238            my $base_uri = $uri;
239            $base_uri =~ s!\?.*$!!;
240    
241            foreach my $dt ( $div->look_down( '_tag', $args->{results} ) ) {
242                    my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
243                    if ( $a ) {
244    
245                            my $href = $a->attr('href') or die "can't find href inside <", $args->{results}, ">";
246                            my $page_uri = URI->new_abs( $a->attr('href'), $base_uri );
247                            $page_uri->query( undef );
248                            $page_uri = $page_uri->canonical;
249    
250                            warn "fetching page: ",$a->as_text," from $page_uri\n";
251                            if ( $mech->follow_link( url => $a->attr('href') ) ) {
252    
253                                    save_html( "page-${nr}", $mech->content );
254    
255                                    my $page_tree = HTML::TreeBuilder->new or die "can't create page tree";
256                                    $page_tree->parse( $mech->content ) or die "can't parse page at $page_uri";
257    
258                                    my ( $el,$attr,$value ) = @{ $args->{scrape} };
259                                    my $div = $page_tree->look_down( '_tag', $el, sub { ( $_[0]->attr( $attr ) || '' ) eq $value } );
260    
261                                    die "can't find <$el $attr=\"$value\">" unless ($div);
262    
263                                    $self->add_record(
264                                            in_feed => $feed,
265                                            title => $mech->title,
266                                            link => $page_uri,
267                                            content => $div->as_HTML,
268    #                                       summary =>
269    #                                       category =>
270    #                                       author =>
271    #                                       issued =>
272    #                                       modified =>
273                                    );
274    
275                                    $mech->back;
276                                    $page_tree->delete;
277    
278                            } else {
279                                    warn "can't follow uri $page_uri: $!\n";
280                            }
281                    }
282    
283                    last if ($nr == $max);
284                    $nr++;
285            }
286    
287            $tree->delete; # clear memory!
288    
289    }
290    
291  1;  1;
Legend:
Removed from v.84  
changed lines
  Added in v.85
  ViewVC Help
Powered by ViewVC 1.1.26