/[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 72 by dpavlin, Fri Feb 23 09:54:28 2007 UTC revision 123 by dpavlin, Sat Apr 28 17:55:37 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;
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    
# Line 28  Returns all available sources. Line 34  Returns all available sources.
34    
35  =cut  =cut
36    
37  warn "Found source plugins: ", dump( __PACKAGE__->sources() );  Jifty->log->debug("Found source plugins: ", join(", ", __PACKAGE__->sources() ) );
38    
39  =head2 new  =head2 new
40    
41    my $source = Grep::Source->new({ feed => $feed_record });    my $source = Grep::Source->new({ feed => $feed_record });
42    
43    This will also setup:
44    
45    =head2 feed
46    
47    isa L<Grep::Model::Feed>
48    
49  =head2 search  =head2 search
50    
51    my $collection = $source->search( 'query string' );    my $collection = $source->search( 'query string' );
52    
53  It will also setup following accessors:  It will also setup following accessors:
54    
55  =over 8  =head2 q
   
 =item q  
56    
57  Search query  Search query
58    
59  =item uri  =head2 uri
60    
61  URI of feed with embedded search query  URI of feed with embedded search query
62    
63  =item new_items  =head2 new_items
64    
65  Number of new items in result collection  Number of new items in result collection
66    
# Line 91  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 = 'Grep::Source::Feed';          my $class = $self->feed->source || 'Grep::Source::Feed';
109          $class = 'Grep::Source::MoinMoin';          $self->log->debug("using $class");
110          Jifty->log->debug("using $class");  
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  }  }
120    
121  =head2 add_record  =head2 add_record
122    
123    Plugins will be called with parametar C<$parent> so they can call this method to add
124    record into result collection (and store in cache and index).
125    
126    $parent->add_record( id => 42, foo => 'bar', ... );    $parent->add_record( id => 42, foo => 'bar', ... );
127    
128    This will also update L</new_items>
129    
130  =cut  =cut
131    
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 + 1 );                          $self->new_items( ( $self->new_items || 0 ) + 1 );
157                  }                  }
158          } else {          } else {
159                  warn "can't add entry ", dump( @_ ), "\n";                  warn "can't add entry ", dump( @_ ), "\n";
160          }          }
161  }  }
162    
163    =head2 content_class
164    
165    Return class registred for particular content.
166    
167      my $class = $source->content_class( $content );
168    
169    =cut
170    
171    sub content_class {
172            my $self = shift;
173    
174            my $content = shift or die "no content?";
175    
176            foreach my $s ( $self->sources ) {
177                    $self->log->debug("testing source class $s");
178                    if ( $s->can('content_have') ) {
179                            my $regex =     $s->content_have( $content ) or
180                                    die "${s}->content_have didn't return anything";
181                            die "${s}->content_have didn't return regex but ", dump( $regex ), " ref ", ref( $regex )
182                                    unless ( ref($regex) eq 'Regexp' );
183                            if ( $content =~ $regex ) {
184                                    $self->log->debug("${s}->content_have succesful");
185                                    return $s;
186                            }
187                    }
188            }
189    }
190    
191    =head2 scrape
192    
193    Create semi-complex L<WWW::Mechanize> rules to scrape page
194    
195    
196    =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            if ( ref( $args->{template} ) eq 'ARRAY' ) {
209                    @templates = @{ $args->{templates} };
210            } else {
211                    @templates = ( $args->{templates} );
212            }
213    
214            push @templates, ( undef, undef ) if ( $#templates == 0 );
215    
216            die "wrapper doesn't have 3 elements but ", $#templates unless (
217                    ( $#templates + 1 ) % 3 == 0
218            );
219    
220            my ( $el, $attr, $value );
221    
222            my @results;
223            my @tags;
224    
225            while ( @templates ) {
226                    ( $el,$attr,$value ) = splice( @templates, 0, 3 );
227                    my $tag = $attr ? "<$el $attr=\"$value\">" : "<$el>";
228                    push @tags, $tag;
229                    $self->log->debug("looking for $message $tag");
230                    @results = $tree->look_down( '_tag', $el, sub {
231                                    return 1 unless ( $attr && $value );
232                                    ( $_[0]->attr( $attr ) || '' ) eq $value;
233                    });
234                    last if @results;
235            }
236    
237            if ( ! @results ) {
238                    my $msg = "can't find $message ", join(" ", @tags);
239                    die $msg if ( $fatal );
240                    warn $msg;
241                    return;
242            }
243    
244            $self->log->debug("found ", $#results + 1, " results");
245    
246            return @results if wantarray;
247            return shift @results;
248    }
249    
250    sub scrape {
251            my $self = shift;
252    
253            my $args = {@_};
254    
255            $self->log->debug("scrape with args ",dump($args));
256    
257            my ($feed,$uri,$q) = ($self->feed, $self->uri,$self->q);
258            die "no uri" unless ($uri);
259            die "feed is not a Grep::Model::Feed but ", ref $feed unless $feed->isa('Grep::Model::Feed');
260    
261            sub mech_warn {
262                    my $m = shift || return;
263                    warn $m;
264            }
265    
266            my $mech = WWW::Mechanize->new(
267                    cookie_jar => {},
268                    onwarn => \&mech_warn,
269                    onerror => \&mech_warn,
270            );
271    
272            $mech->get( $uri );
273    
274            $self->save( 'get.html', $mech->content );
275    
276            if ( my $form = $args->{submit_form} ) {
277                    $self->log->debug("submit form on $uri with ", dump( $form ));
278                    $mech->submit_form( %$form ) or die "can't submit form ", dump( $form );
279                    $self->save( 'submit.html', $mech->content );
280            }
281    
282            $self->log->debug("parse result page");
283    
284            my $tree = HTML::TreeBuilder->new or die "can't create html tree";
285            $tree->parse( $mech->content ) or die "can't parse fetched content";
286    
287            my $div = $self->element_by_triplet(
288                    tree => $tree,
289                    templates => $args->{wrapper},
290                    message => 'wrapper for all results',
291                    fatal => 1
292            );
293    
294            my $max = 15;
295            my $nr = 1;
296    
297            my $base_uri = $uri;
298            $base_uri =~ s!\?.*$!!;
299    
300            my @r = $self->element_by_triplet(
301                    tree => $tree,
302                    templates => $args->{results},
303                    message => 'result element',
304            );
305    
306            foreach my $dt ( @r ) {
307                    my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
308                    if ( $a ) {
309    
310                            my $href = $a->attr('href') or die "can't find href inside <", $args->{results}, ">";
311                            my $page_uri = URI->new_abs( $a->attr('href'), $base_uri );
312                            $page_uri->query( undef );
313                            $page_uri = $page_uri->canonical;
314    
315                            $self->log->debug("fetching page: ",$a->as_text," from $page_uri");
316                            if ( $mech->follow_link( url => $a->attr('href') ) ) {
317    
318                                    $self->save( "page-${nr}.html", $mech->content );
319    
320                                    my $page_tree = HTML::TreeBuilder->new or die "can't create page tree";
321                                    $page_tree->parse( $mech->content ) or die "can't parse page at $page_uri";
322                                    $div = $self->element_by_triplet(
323                                            tree => $page_tree,
324                                            message => "result $nr",
325                                            templates => $args->{scrape}
326                                    );
327    
328                                    $self->add_record(
329                                            in_feed => $feed,
330                                            title => $mech->title,
331                                            link => $page_uri,
332                                            content => $div->as_HTML,
333    #                                       summary =>
334    #                                       category =>
335    #                                       author =>
336    #                                       issued =>
337    #                                       modified =>
338                                    ) if ( $div );
339    
340                                    $mech->back;
341                                    $page_tree->delete;
342    
343                            } else {
344                                    warn "can't follow uri $page_uri: $!\n";
345                            }
346                    } else {
347                            $self->log->debug("result $nr doesn't have link inside, ignoring...");
348                    }
349    
350                    last if ($nr == $max);
351                    $nr++;
352            }
353    
354            $tree->delete; # clear memory!
355    
356    }
357    
358    =head2 save
359    
360      save( 'name', $content );
361    
362    Save dumps into C</tmp/grep> if writable
363    
364    =cut
365    
366    sub save {
367            my $self = shift;
368            my ( $file, $content ) = @_;
369            return unless ( defined($file) && defined($content) );
370            if ( -w '/tmp/grep' ) {
371                    open(my $f, '>', "/tmp/grep/$file") or die "can't open $file: $!";
372                    print $f $content or die "can't write to $file: $!";
373                    close $f or die "can't close $file: $!";
374                    $self->log->debug("saved $file ",length($content)," bytes");
375            }
376    }
377    
378  1;  1;
Legend:
Removed from v.72  
changed lines
  Added in v.123
  ViewVC Help
Powered by ViewVC 1.1.26