/[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 101 by dpavlin, Sat Feb 24 12:32:31 2007 UTC revision 102 by dpavlin, Sun Mar 4 22:16:23 2007 UTC
# Line 135  sub add_record { Line 135  sub add_record {
135    
136          my $rec = {@_};          my $rec = {@_};
137    
138          warn "resolving links";          $self->log->debug("resolving links using base ", $rec->{link});
139          my $resolver = HTML::ResolveLink->new( base => $rec->{link} );          my $resolver = HTML::ResolveLink->new( base => $rec->{link} );
140          $rec->{content} = $resolver->resolve( $rec->{content} );          $rec->{content} = $resolver->resolve( $rec->{content} );
141    
# Line 197  sub scrape { Line 197  sub scrape {
197    
198          my $args = {@_};          my $args = {@_};
199    
200          warn "scrape got args ",dump($args);          $self->log->debug("scrape with args ",dump($args));
201    
202          my ($feed,$uri,$q) = ($self->feed, $self->uri,$self->q);          my ($feed,$uri,$q) = ($self->feed, $self->uri,$self->q);
203          die "no uri" unless ($uri);          die "no uri" unless ($uri);
# Line 219  sub scrape { Line 219  sub scrape {
219          $self->save( 'get.html', $mech->content );          $self->save( 'get.html', $mech->content );
220    
221          if ( my $form = $args->{submit_form} ) {          if ( my $form = $args->{submit_form} ) {
222                  warn "submit form on $uri with ", dump( $form ),"\n";                  $self->log->debug("submit form on $uri with ", dump( $form ));
223                  $mech->submit_form( %$form ) or die "can't submit form ", dump( $form );                  $mech->submit_form( %$form ) or die "can't submit form ", dump( $form );
224                  $self->save( 'submit.html', $mech->content );                  $self->save( 'submit.html', $mech->content );
225          }          }
226    
227          warn "parse result page\n";          $self->log->debug("parse result page");
228    
229          my $tree = HTML::TreeBuilder->new or die "can't create html tree";          my $tree = HTML::TreeBuilder->new or die "can't create html tree";
230          $tree->parse( $mech->content ) or die "can't parse fetched content";          $tree->parse( $mech->content ) or die "can't parse fetched content";
# Line 232  sub scrape { Line 232  sub scrape {
232          die "wrapper doesn't have 3 elements but ", $#{ $args->{wrapper} } unless ( $#{ $args->{wrapper} } == 2 );          die "wrapper doesn't have 3 elements but ", $#{ $args->{wrapper} } unless ( $#{ $args->{wrapper} } == 2 );
233          my ( $el,$attr,$value ) = @{ $args->{wrapper} };          my ( $el,$attr,$value ) = @{ $args->{wrapper} };
234    
235          warn "looking for <$el $attr=\"$value\">";          $self->log->debug("looking for <$el $attr=\"$value\">");
236    
237          my $div = $tree->look_down( '_tag', $el, sub {          my $div = $tree->look_down( '_tag', $el, sub {
                         warn dump( $_[0]->attr( $attr ) ),$/;  
238                          ( $_[0]->attr( $attr ) || '' ) eq $value;                          ( $_[0]->attr( $attr ) || '' ) eq $value;
239          });          });
240    
# Line 259  sub scrape { Line 258  sub scrape {
258                          $page_uri->query( undef );                          $page_uri->query( undef );
259                          $page_uri = $page_uri->canonical;                          $page_uri = $page_uri->canonical;
260    
261                          warn "fetching page: ",$a->as_text," from $page_uri\n";                          $self->log->debug("fetching page: ",$a->as_text," from $page_uri");
262                          if ( $mech->follow_link( url => $a->attr('href') ) ) {                          if ( $mech->follow_link( url => $a->attr('href') ) ) {
263    
264                                  $self->save( "page-${nr}.html", $mech->content );                                  $self->save( "page-${nr}.html", $mech->content );
Legend:
Removed from v.101  
changed lines
  Added in v.102
  ViewVC Help
Powered by ViewVC 1.1.26