/[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 100 by dpavlin, Sat Feb 24 12:32:31 2007 UTC revision 113 by dpavlin, Sun Mar 25 11:41:54 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) );
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 = {@_};
140    
141          warn "resolving links";          $self->log->debug("resolving links using base ", $rec->{link});
142          my $resolver = HTML::ResolveLink->new( base => $rec->{link} );          my $resolver = HTML::ResolveLink->new( base => $rec->{link} );
143          $rec->{content} = $resolver->resolve( $rec->{content} );          $rec->{content} = $resolver->resolve( $rec->{content} );
144    
# 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 197  sub scrape { Line 200  sub scrape {
200    
201          my $args = {@_};          my $args = {@_};
202    
203          warn "scrape got args ",dump($args);          $self->log->debug("scrape with args ",dump($args));
204    
205          my ($feed,$uri,$q) = ($self->feed, $self->uri,$self->q);          my ($feed,$uri,$q) = ($self->feed, $self->uri,$self->q);
206          die "no uri" unless ($uri);          die "no uri" unless ($uri);
# Line 219  sub scrape { Line 222  sub scrape {
222          $self->save( 'get.html', $mech->content );          $self->save( 'get.html', $mech->content );
223    
224          if ( my $form = $args->{submit_form} ) {          if ( my $form = $args->{submit_form} ) {
225                  warn "submit form on $uri with ", dump( $form ),"\n";                  $self->log->debug("submit form on $uri with ", dump( $form ));
226                  $mech->submit_form( %$form ) or die "can't submit form ", dump( $form );                  $mech->submit_form( %$form ) or die "can't submit form ", dump( $form );
227                  $self->save( 'submit.html', $mech->content );                  $self->save( 'submit.html', $mech->content );
228          }          }
229    
230          warn "parse result page\n";          $self->log->debug("parse result page");
231    
232          my $tree = HTML::TreeBuilder->new or die "can't create html tree";          my $tree = HTML::TreeBuilder->new or die "can't create html tree";
233          $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 235  sub scrape {
235          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 );
236          my ( $el,$attr,$value ) = @{ $args->{wrapper} };          my ( $el,$attr,$value ) = @{ $args->{wrapper} };
237    
238          warn "looking for <$el $attr=\"$value\">";          $self->log->debug("looking for <$el $attr=\"$value\">");
239    
240          my $div = $tree->look_down( '_tag', $el, sub {          my $div = $tree->look_down( '_tag', $el, sub {
                         warn dump( $_[0]->attr( $attr ) ),$/;  
241                          ( $_[0]->attr( $attr ) || '' ) eq $value;                          ( $_[0]->attr( $attr ) || '' ) eq $value;
242          });          });
243    
# Line 244  sub scrape { Line 246  sub scrape {
246                  return;                  return;
247          }          }
248    
249          my $max = 5;          my $max = 15;
250          my $nr = 1;          my $nr = 1;
251    
252          my $base_uri = $uri;          my $base_uri = $uri;
253          $base_uri =~ s!\?.*$!!;          $base_uri =~ s!\?.*$!!;
254    
255          foreach my $dt ( $div->look_down( '_tag', $args->{results} ) ) {          my @r = $div->look_down( '_tag', $args->{results} );
256            $self->log->debug("found ", scalar @r, " <$args->{results}>");
257    
258            foreach my $dt ( @r ) {
259                  my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );                  my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
260                  if ( $a ) {                  if ( $a ) {
261    
# Line 259  sub scrape { Line 264  sub scrape {
264                          $page_uri->query( undef );                          $page_uri->query( undef );
265                          $page_uri = $page_uri->canonical;                          $page_uri = $page_uri->canonical;
266    
267                          warn "fetching page: ",$a->as_text," from $page_uri\n";                          $self->log->debug("fetching page: ",$a->as_text," from $page_uri");
268                          if ( $mech->follow_link( url => $a->attr('href') ) ) {                          if ( $mech->follow_link( url => $a->attr('href') ) ) {
269    
270                                  $self->save( "page-${nr}.html", $mech->content );                                  $self->save( "page-${nr}.html", $mech->content );
Legend:
Removed from v.100  
changed lines
  Added in v.113
  ViewVC Help
Powered by ViewVC 1.1.26