/[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 92 by dpavlin, Sat Feb 24 11:16:05 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 28  Returns all available sources. Line 33  Returns all available sources.
33    
34  =cut  =cut
35    
36  warn "Found source plugins: ", dump( __PACKAGE__->sources() );  Jifty->log->debug("Found source plugins: ", join(", ", __PACKAGE__->sources() ) );
37    
38  =head2 new  =head2 new
39    
40    my $source = Grep::Source->new({ feed => $feed_record });    my $source = Grep::Source->new({ feed => $feed_record });
41    
42    This will also setup:
43    
44    =head2 feed
45    
46    isa L<Grep::Model::Feed>
47    
48  =head2 search  =head2 search
49    
50    my $collection = $source->search( 'query string' );    my $collection = $source->search( 'query string' );
51    
52  It will also setup following accessors:  It will also setup following accessors:
53    
54  =over 8  =head2 q
   
 =item q  
55    
56  Search query  Search query
57    
58  =item uri  =head2 uri
59    
60  URI of feed with embedded search query  URI of feed with embedded search query
61    
62  =item new_items  =head2 new_items
63    
64  Number of new items in result collection  Number of new items in result collection
65    
# Line 95  sub search { Line 104  sub search {
104    
105          $self->collection( Grep::Model::ItemCollection->new() );          $self->collection( Grep::Model::ItemCollection->new() );
106    
107          my $class = 'Grep::Source::Feed';          my $class = $self->feed->source || 'Grep::Source::Feed';
         $class = 'Grep::Source::MoinMoin';  
108          Jifty->log->debug("using $class");          Jifty->log->debug("using $class");
109    
110          $class->fetch( $self );          $class->fetch( $self );
# Line 108  sub search { Line 116  sub search {
116    
117  =head2 add_record  =head2 add_record
118    
119    Plugins will be called with parametar C<$parent> so they can call this method to add
120    record into result collection (and store in cache and index).
121    
122    $parent->add_record( id => 42, foo => 'bar', ... );    $parent->add_record( id => 42, foo => 'bar', ... );
123    
124    This will also update L</new_items>
125    
126  =cut  =cut
127    
128  sub add_record {  sub add_record {
# Line 128  sub add_record { Line 141  sub add_record {
141                  # is new record?                  # is new record?
142                  if ( $msg !~ m/^Found/ ) {                  if ( $msg !~ m/^Found/ ) {
143                          Grep::Search->add( $i );                          Grep::Search->add( $i );
144                          $self->new_items( $self->new_items + 1 );                          $self->new_items( ( $self->new_items || 0 ) + 1 );
145                  }                  }
146          } else {          } else {
147                  warn "can't add entry ", dump( @_ ), "\n";                  warn "can't add entry ", dump( @_ ), "\n";
148          }          }
149  }  }
150    
151    =head2 content_class
152    
153    Return class registred for particular content.
154    
155      my $class = $source->content_class( $content );
156    
157    =cut
158    
159    sub content_class {
160            my $self = shift;
161    
162            my $content = shift or die "no content?";
163    
164            foreach my $s ( $self->sources ) {
165                    Jifty->log->debug("testing source class $s");
166                    if ( $s->can('content_have') ) {
167                            my $regex =     $s->content_have( $content ) or
168                                    die "${s}->content_have didn't return anything";
169                            die "${s}->content_have didn't return regex but ", dump( $regex ), " ref ", ref( $regex )
170                                    unless ( ref($regex) eq 'Regexp' );
171                            if ( $content =~ $regex ) {
172                                    Jifty->log->debug("${s}->content_have succesful");
173                                    return $s;
174                            }
175                    }
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 mech_warn {
198                    my $m = shift || return;
199                    warn $m;
200            }
201    
202            my $mech = WWW::Mechanize->new(
203                    cookie_jar => {},
204                    onwarn => \&mech_warn,
205                    onerror => \&mech_warn,
206            );
207    
208            $mech->get( $uri );
209    
210            $self->save( 'get.html', $mech->content );
211    
212            if ( my $form = $args->{submit_form} ) {
213                    warn "submit form on $uri with ", dump( $form ),"\n";
214                    $mech->submit_form( %$form ) or die "can't submit form ", dump( $form );
215                    $self->save( 'submit.html', $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            if ( ! $div ) {
234                    warn "can't find results wrapper <$el $attr=\"$value\">";
235                    return;
236            }
237    
238            my $max = 5;
239            my $nr = 1;
240    
241            my $base_uri = $uri;
242            $base_uri =~ s!\?.*$!!;
243    
244            foreach my $dt ( $div->look_down( '_tag', $args->{results} ) ) {
245                    my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
246                    if ( $a ) {
247    
248                            my $href = $a->attr('href') or die "can't find href inside <", $args->{results}, ">";
249                            my $page_uri = URI->new_abs( $a->attr('href'), $base_uri );
250                            $page_uri->query( undef );
251                            $page_uri = $page_uri->canonical;
252    
253                            warn "fetching page: ",$a->as_text," from $page_uri\n";
254                            if ( $mech->follow_link( url => $a->attr('href') ) ) {
255    
256                                    $self->save( "page-${nr}.html", $mech->content );
257    
258                                    my $page_tree = HTML::TreeBuilder->new or die "can't create page tree";
259                                    $page_tree->parse( $mech->content ) or die "can't parse page at $page_uri";
260    
261                                    ( $el,$attr,$value ) = @{ $args->{scrape} };
262                                    $div = $page_tree->look_down( '_tag', $el, sub { ( $_[0]->attr( $attr ) || '' ) eq $value } );
263    
264                                    die "can't find <$el $attr=\"$value\">" unless ($div);
265    
266                                    $self->add_record(
267                                            in_feed => $feed,
268                                            title => $mech->title,
269                                            link => $page_uri,
270                                            content => $div->as_HTML,
271    #                                       summary =>
272    #                                       category =>
273    #                                       author =>
274    #                                       issued =>
275    #                                       modified =>
276                                    );
277    
278                                    $mech->back;
279                                    $page_tree->delete;
280    
281                            } else {
282                                    warn "can't follow uri $page_uri: $!\n";
283                            }
284                    }
285    
286                    last if ($nr == $max);
287                    $nr++;
288            }
289    
290            $tree->delete; # clear memory!
291    
292    }
293    
294    =head2 save
295    
296      save( 'name', $content );
297    
298    Save dumps into C</tmp/grep> if writable
299    
300    =cut
301    
302    sub save {
303            my $self = shift;
304            my ( $file, $content ) = @_;
305            if ( -w '/tmp/grep' ) {
306                    open(my $f, '>', "/tmp/grep/$file") or die "can't open $file: $!";
307                    print $f $content or die "can't write to $file: $!";
308                    close $f or die "can't close $file: $!";
309                    Jifty->log->debug("saved $file ",length($content)," bytes");
310            }
311    }
312    
313  1;  1;
Legend:
Removed from v.72  
changed lines
  Added in v.92
  ViewVC Help
Powered by ViewVC 1.1.26