/[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 88 by dpavlin, Fri Feb 23 21:52:29 2007 UTC revision 125 by dpavlin, Sat Apr 28 22:52:08 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;  use HTML::TreeBuilder;
14  use WWW::Mechanize;  use WWW::Mechanize;
15  use XML::Feed;  use XML::Feed;
16  use URI;  use URI;
17    use HTML::ResolveLink;
18    
19  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
20    
# Line 100  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 128  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 || 0 ) + 1 );                          $self->new_items( ( $self->new_items || 0 ) + 1 );
157                  }                  }
158          } else {          } else {
# Line 162  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') ) {                  if ( $s->can('content_have') ) {
179                          my $regex =     $s->content_have( $content ) or                          my $regex =     $s->content_have( $content ) or
180                                  die "${s}->content_have didn't return anything";                                  die "${s}->content_have didn't return anything";
181                          die "${s}->content_have didn't return regex but ", dump( $regex ), " ref ", ref( $regex )                          die "${s}->content_have didn't return regex but ", dump( $regex ), " ref ", ref( $regex )
182                                  unless ( ref($regex) eq 'Regexp' );                                  unless ( ref($regex) eq 'Regexp' );
183                          if ( $content =~ $regex ) {                          if ( $content =~ $regex ) {
184                                  Jifty->log->debug("${s}->content_have succesful");                                  $self->log->debug("${s}->content_have succesful");
185                                  return $s;                                  return $s;
186                          }                          }
187                  }                  }
# Line 183  Create semi-complex L<WWW::Mechanize> ru Line 195  Create semi-complex L<WWW::Mechanize> ru
195    
196  =cut  =cut
197    
198    sub element_by_triplet {
199            my $self = shift;
200    
201            my $args = {@_};
202    
203            my $tree = $args->{tree} || die "no tree";
204            my $message = $args->{message} || '';
205            my $fatal = $args->{fatal};
206            die "no templates" unless defined( $args->{templates} );
207            my @templates;
208    warn dump( $args->{templates} );
209            if ( ref( $args->{templates} ) eq 'ARRAY' ) {
210                    @templates = @{ $args->{templates} };
211            } else {
212                    @templates = ( $args->{templates} );
213            }
214    
215            push @templates, ( undef, undef ) if ( $#templates == 0 );
216    
217            die "wrapper doesn't have 3 elements but ", $#templates unless (
218                    ( $#templates + 1 ) % 3 == 0
219            );
220    
221            my ( $el, $attr, $value );
222    
223            my @results;
224            my @tags;
225    
226            while ( @templates ) {
227                    ( $el,$attr,$value ) = splice( @templates, 0, 3 );
228                    my $tag = $attr ? "<$el $attr=\"$value\">" : "<$el>";
229                    push @tags, $tag;
230                    $self->log->debug("looking for $message $tag");
231                    @results = $tree->look_down( '_tag', $el, sub {
232                                    return 1 unless ( $attr && $value );
233                                    ( $_[0]->attr( $attr ) || '' ) eq $value;
234                    });
235                    last if @results;
236            }
237    
238            if ( ! @results ) {
239                    my $msg = "can't find $message ", join(" ", @tags);
240                    die $msg if ( $fatal );
241                    warn $msg;
242                    return;
243            }
244    
245            $self->log->debug("found ", $#results + 1, " results");
246    
247            return @results if wantarray;
248            return shift @results;
249    }
250    
251  sub scrape {  sub scrape {
252          my $self = shift;          my $self = shift;
253    
254          my $args = {@_};          my $args = {@_};
255    
256          warn "scrape got args ",dump($args);          $self->log->debug("scrape with args ",dump($args));
257    
258          my ($feed,$uri,$q) = ($self->feed, $self->uri,$self->q);          my ($feed,$uri,$q) = ($self->feed, $self->uri,$self->q);
259          die "no uri" unless ($uri);          die "no uri" unless ($uri);
260          die "feed is not a Grep::Model::Feed but ", ref $feed unless $feed->isa('Grep::Model::Feed');          die "feed is not a Grep::Model::Feed but ", ref $feed unless $feed->isa('Grep::Model::Feed');
261    
262          my $mech = WWW::Mechanize->new();          sub mech_warn {
263                    my $m = shift || return;
264                    warn $m;
265            }
266    
267            my $mech = WWW::Mechanize->new(
268                    cookie_jar => {},
269                    onwarn => \&mech_warn,
270                    onerror => \&mech_warn,
271            );
272    
273          $mech->get( $uri );          $mech->get( $uri );
274    
275          $self->save( 'get.html', $mech->content );          $self->save( 'get.html', $mech->content );
276    
277          if ( $args->{submit_form} ) {          if ( my $form = $args->{submit_form} ) {
278                  warn "submit form on $uri\n";                  $self->log->debug("submit form on $uri with ", dump( $form ));
279                  $mech->submit_form( %{ $args->{submit_form} } ) or die "can't submit form";                  $mech->submit_form( %$form ) or die "can't submit form ", dump( $form );
280                  $self->save( 'submit.html', $mech->content );                  $self->save( 'submit.html', $mech->content );
281          }          }
282    
283          warn "parse result page\n";          $self->log->debug("parse result page");
284    
285          my $tree = HTML::TreeBuilder->new or die "can't create html tree";          my $tree = HTML::TreeBuilder->new or die "can't create html tree";
286          $tree->parse( $mech->content ) or die "can't parse fetched content";          $tree->parse( $mech->content ) or die "can't parse fetched content";
287    
288          die "wrapper doesn't have 3 elements but ", $#{ $args->{wrapper} } unless ( $#{ $args->{wrapper} } == 2 );          my $div = $self->element_by_triplet(
289          my ( $el,$attr,$value ) = @{ $args->{wrapper} };                  tree => $tree,
290                    templates => $args->{wrapper},
291          warn "looking for <$el $attr=\"$value\">";                  message => 'wrapper for all results',
292                    fatal => 1
293          my $div = $tree->look_down( '_tag', $el, sub {          );
                         warn dump( $_[0]->attr( $attr ) ),$/;  
                         ( $_[0]->attr( $attr ) || '' ) eq $value;  
         });  
294    
295          if ( ! $div ) {          my $max = 15;
                 warn "can't find results wrapper <$el $attr=\"$value\">";  
                 return;  
         }  
   
         my $max = 5;  
296          my $nr = 1;          my $nr = 1;
297    
298          my $base_uri = $uri;          my $base_uri = $uri;
299          $base_uri =~ s!\?.*$!!;          $base_uri =~ s!\?.*$!!;
300    
301          foreach my $dt ( $div->look_down( '_tag', $args->{results} ) ) {          my @r = $self->element_by_triplet(
302                    tree => $tree,
303                    templates => $args->{results},
304                    message => 'result element',
305            );
306    
307            foreach my $dt ( @r ) {
308                  my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );                  my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
309                  if ( $a ) {                  if ( $a ) {
310    
# Line 241  sub scrape { Line 313  sub scrape {
313                          $page_uri->query( undef );                          $page_uri->query( undef );
314                          $page_uri = $page_uri->canonical;                          $page_uri = $page_uri->canonical;
315    
316                          warn "fetching page: ",$a->as_text," from $page_uri\n";                          $self->log->debug("fetching page: ",$a->as_text," from $page_uri");
317                          if ( $mech->follow_link( url => $a->attr('href') ) ) {                          if ( $mech->follow_link( url => $a->attr('href') ) ) {
318    
319                                  $self->save( "page-${nr}.html", $mech->content );                                  $self->save( "page-${nr}.html", $mech->content );
320    
321                                  my $page_tree = HTML::TreeBuilder->new or die "can't create page tree";                                  my $page_tree = HTML::TreeBuilder->new or die "can't create page tree";
322                                  $page_tree->parse( $mech->content ) or die "can't parse page at $page_uri";                                  $page_tree->parse( $mech->content ) or die "can't parse page at $page_uri";
323                                    $div = $self->element_by_triplet(
324                                  my ( $el,$attr,$value ) = @{ $args->{scrape} };                                          tree => $page_tree,
325                                  my $div = $page_tree->look_down( '_tag', $el, sub { ( $_[0]->attr( $attr ) || '' ) eq $value } );                                          message => "result $nr",
326                                            templates => $args->{scrape}
327                                  die "can't find <$el $attr=\"$value\">" unless ($div);                                  );
328    
329                                  $self->add_record(                                  $self->add_record(
330                                          in_feed => $feed,                                          in_feed => $feed,
# Line 264  sub scrape { Line 336  sub scrape {
336  #                                       author =>  #                                       author =>
337  #                                       issued =>  #                                       issued =>
338  #                                       modified =>  #                                       modified =>
339                                  );                                  ) if ( $div );
340    
341                                  $mech->back;                                  $mech->back;
342                                  $page_tree->delete;                                  $page_tree->delete;
# Line 272  sub scrape { Line 344  sub scrape {
344                          } else {                          } else {
345                                  warn "can't follow uri $page_uri: $!\n";                                  warn "can't follow uri $page_uri: $!\n";
346                          }                          }
347                    } else {
348                            $self->log->debug("result $nr doesn't have link inside, ignoring...");
349                  }                  }
350    
351                  last if ($nr == $max);                  last if ($nr == $max);
# Line 293  Save dumps into C</tmp/grep> if writable Line 367  Save dumps into C</tmp/grep> if writable
367  sub save {  sub save {
368          my $self = shift;          my $self = shift;
369          my ( $file, $content ) = @_;          my ( $file, $content ) = @_;
370            return unless ( defined($file) && defined($content) );
371          if ( -w '/tmp/grep' ) {          if ( -w '/tmp/grep' ) {
372                  open(my $f, '>', "/tmp/grep/$file") or die "can't open $file: $!";                  open(my $f, '>', "/tmp/grep/$file") or die "can't open $file: $!";
373                  print $f $content or die "can't write to $file: $!";                  print $f $content or die "can't write to $file: $!";
374                  close $f or die "can't close $file: $!";                  close $f or die "can't close $file: $!";
375                  Jifty->log->debug("saved $file ",length($content)," bytes");                  $self->log->debug("saved $file ",length($content)," bytes");
376          }          }
377  }  }
378    
Legend:
Removed from v.88  
changed lines
  Added in v.125
  ViewVC Help
Powered by ViewVC 1.1.26