lib/Grep/Source.pm

# Dobrica Pavlinusic, <dpavlin@rot13.org> 02/22/07 20:30:00 CET

use strict;
use warnings;

package Grep::Source;

use Carp qw/verbose/;
use Module::Pluggable search_path => 'Grep::Source', sub_name => 'sources', require => 1;
use base qw(Class::Accessor);
Grep::Source->mk_accessors( qw(feed uri q new_items collection) );

use HTML::TreeBuilder;
use WWW::Mechanize;
use XML::Feed;
use URI;

use Data::Dump qw/dump/;

=head1 NAME

Grep::Source - base class for implementation of different sources for Grep

=head1 METHODS

This is mostly documentation because most of methods are implemented by plugins.

=head2 sources

  my @sources = Grep::Source->sources();

Returns all available sources.

=cut

Jifty->log->debug("Found source plugins: ", join(", ", __PACKAGE__->sources() ) );

=head2 new

  my $source = Grep::Source->new({ feed => $feed_record });

This will also setup:

=head2 feed

isa L<Grep::Model::Feed>

=head2 search

  my $collection = $source->search( 'query string' );

It will also setup following accessors:

=head2 q

Search query 

=head2 uri

URI of feed with embedded search query

=head2 new_items

Number of new items in result collection

=head2 collection

Actuall results which is L<Grep::Model::ItemCollection>, so following will
work:

  print "and ", $self->collection->count, " total items";


Also setups number of new items

  print $source->new_items, " items new";

=cut

sub search {
        my $self = shift;

        my $q = shift;

        $q ? $self->q( $q ) : $q = $self->q;

        die "no q?" unless ( $self->q );
        die "no feed?" unless ( $self->feed );
        die "feed not Grep::Model::Feed" unless ( $self->feed->isa('Grep::Model::Feed') );

        my $message;
        my $uri = $self->feed->uri;
        if ($uri =~ m/%s/) {
                $uri = $self->feed->search_uri( $q );
                $message = 'Searching';
        } else {
                $message = 'Fetching';
        }
        $message .= ' ' . $self->feed->title . " at $uri";

        $self->uri( $uri );

        Jifty->log->info( $message );

        $self->collection( Grep::Model::ItemCollection->new() );

        my $class = $self->feed->source || 'Grep::Source::Feed';
        Jifty->log->debug("using $class");

        $class->fetch( $self );

        Grep::Search->finish if $self->new_items;

        return $self->collection;
}

=head2 add_record

Plugins will be called with parametar C<$parent> so they can call this method to add
record into result collection (and store in cache and index).

  $parent->add_record( id => 42, foo => 'bar', ... );

This will also update L</new_items>

=cut

sub add_record {
        my $self = shift;

        my $i = Grep::Model::Item->new();

        my ($ok,$msg) = $i->load_or_create( @_ );

        $msg ||= '';

        if ( $ok ) {
                Jifty->log->debug("item ", $i->id, ": $msg");
                $self->collection->add_record( $i );

                # is new record?
                if ( $msg !~ m/^Found/ ) {
                        Grep::Search->add( $i );
                        $self->new_items( ( $self->new_items || 0 ) + 1 );
                }
        } else {
                warn "can't add entry ", dump( @_ ), "\n";
        }
}

=head2 content_class

Return class registred for particular content.

  my $class = $source->content_class( $content );

=cut

sub content_class {
        my $self = shift;

        my $content = shift or die "no content?";

        foreach my $s ( $self->sources ) {
                Jifty->log->debug("testing source class $s");
                if ( $s->can('content_have') ) {
                        my $regex =     $s->content_have( $content ) or
                                die "${s}->content_have didn't return anything";
                        die "${s}->content_have didn't return regex but ", dump( $regex ), " ref ", ref( $regex )
                                unless ( ref($regex) eq 'Regexp' );
                        if ( $content =~ $regex ) {
                                Jifty->log->debug("${s}->content_have succesful");
                                return $s;
                        }
                }
        }
}

=head2 scrape

Create semi-complex L<WWW::Mechanize> rules to scrape page


=cut

sub scrape {
        my $self = shift;

        my $args = {@_};

        warn "scrape got args ",dump($args);

        my ($feed,$uri,$q) = ($self->feed, $self->uri,$self->q);
        die "no uri" unless ($uri);
        die "feed is not a Grep::Model::Feed but ", ref $feed unless $feed->isa('Grep::Model::Feed');

        my $mech = WWW::Mechanize->new();

        $mech->get( $uri );

        $self->save( 'get.html', $mech->content );

        if ( $args->{submit_form} ) {
                warn "submit form on $uri\n";
                $mech->submit_form( %{ $args->{submit_form} } ) or die "can't submit form";
                $self->save( 'submit.html', $mech->content );
        }

        warn "parse result page\n";

        my $tree = HTML::TreeBuilder->new or die "can't create html tree";
        $tree->parse( $mech->content ) or die "can't parse fetched content";

        die "wrapper doesn't have 3 elements but ", $#{ $args->{wrapper} } unless ( $#{ $args->{wrapper} } == 2 );
        my ( $el,$attr,$value ) = @{ $args->{wrapper} };

        warn "looking for <$el $attr=\"$value\">";

        my $div = $tree->look_down( '_tag', $el, sub {
                        warn dump( $_[0]->attr( $attr ) ),$/;
                        ( $_[0]->attr( $attr ) || '' ) eq $value;
        });

        die "can't find results wrapper <$el $attr=\"$value\">" unless ( $div );

        my $max = 5;
        my $nr = 1;

        my $base_uri = $uri;
        $base_uri =~ s!\?.*$!!;

        foreach my $dt ( $div->look_down( '_tag', $args->{results} ) ) {
                my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
                if ( $a ) {

                        my $href = $a->attr('href') or die "can't find href inside <", $args->{results}, ">";
                        my $page_uri = URI->new_abs( $a->attr('href'), $base_uri );
                        $page_uri->query( undef );
                        $page_uri = $page_uri->canonical;

                        warn "fetching page: ",$a->as_text," from $page_uri\n";
                        if ( $mech->follow_link( url => $a->attr('href') ) ) {

                                $self->save( "page-${nr}.html", $mech->content );

                                my $page_tree = HTML::TreeBuilder->new or die "can't create page tree";
                                $page_tree->parse( $mech->content ) or die "can't parse page at $page_uri";

                                my ( $el,$attr,$value ) = @{ $args->{scrape} };
                                my $div = $page_tree->look_down( '_tag', $el, sub { ( $_[0]->attr( $attr ) || '' ) eq $value } );

                                die "can't find <$el $attr=\"$value\">" unless ($div);

                                $self->add_record(
                                        in_feed => $feed,
                                        title => $mech->title,
                                        link => $page_uri,
                                        content => $div->as_HTML,
#                                       summary => 
#                                       category => 
#                                       author => 
#                                       issued => 
#                                       modified => 
                                );

                                $mech->back;
                                $page_tree->delete;

                        } else {
                                warn "can't follow uri $page_uri: $!\n";
                        }
                }

                last if ($nr == $max);
                $nr++;
        }

        $tree->delete; # clear memory!

}

=head2 save

  save( 'name', $content );

Save dumps into C</tmp/grep> if writable

=cut

sub save {
        my $self = shift;
        my ( $file, $content ) = @_;
        if ( -w '/tmp/grep' ) {
                open(my $f, '>', "/tmp/grep/$file") or die "can't open $file: $!";
                print $f $content or die "can't write to $file: $!";
                close $f or die "can't close $file: $!";
                Jifty->log->debug("saved $file ",length($content)," bytes");
        }
}

1;
1	dpavlin	72	# Dobrica Pavlinusic, <dpavlin@rot13.org> 02/22/07 20:30:00 CET
2
3			use strict;
4			use warnings;
5
6			package Grep::Source;
7
8			use Carp qw/verbose/;
9			use Module::Pluggable search_path => 'Grep::Source', sub_name => 'sources', require => 1;
10			use base qw(Class::Accessor);
11			Grep::Source->mk_accessors( qw(feed uri q new_items collection) );
12
13	dpavlin	85	use HTML::TreeBuilder;
14			use WWW::Mechanize;
15			use XML::Feed;
16			use URI;
17
18	dpavlin	72	use Data::Dump qw/dump/;
19
20			=head1 NAME
21
22			Grep::Source - base class for implementation of different sources for Grep
23
24			=head1 METHODS
25
26			This is mostly documentation because most of methods are implemented by plugins.
27
28			=head2 sources
29
30			my @sources = Grep::Source->sources();
31
32			Returns all available sources.
33
34			=cut
35
36	dpavlin	73	Jifty->log->debug("Found source plugins: ", join(", ", __PACKAGE__->sources() ) );
37	dpavlin	72
38			=head2 new
39
40			my $source = Grep::Source->new({ feed => $feed_record });
41
42	dpavlin	73	This will also setup:
43
44			=head2 feed
45
46			isa L<Grep::Model::Feed>
47
48	dpavlin	72	=head2 search
49
50			my $collection = $source->search( 'query string' );
51
52			It will also setup following accessors:
53
54	dpavlin	73	=head2 q
55	dpavlin	72
56			Search query
57
58	dpavlin	73	=head2 uri
59	dpavlin	72
60			URI of feed with embedded search query
61
62	dpavlin	73	=head2 new_items
63	dpavlin	72
64			Number of new items in result collection
65
66			=head2 collection
67
68			Actuall results which is L<Grep::Model::ItemCollection>, so following will
69			work:
70
71			print "and ", $self->collection->count, " total items";
72
73
74			Also setups number of new items
75
76			print $source->new_items, " items new";
77
78			=cut
79
80			sub search {
81			my $self = shift;
82
83			my $q = shift;
84
85			$q ? $self->q( $q ) : $q = $self->q;
86
87			die "no q?" unless ( $self->q );
88			die "no feed?" unless ( $self->feed );
89			die "feed not Grep::Model::Feed" unless ( $self->feed->isa('Grep::Model::Feed') );
90
91			my $message;
92			my $uri = $self->feed->uri;
93			if ($uri =~ m/%s/) {
94			$uri = $self->feed->search_uri( $q );
95			$message = 'Searching';
96			} else {
97			$message = 'Fetching';
98			}
99			$message .= ' ' . $self->feed->title . " at $uri";
100
101			$self->uri( $uri );
102
103			Jifty->log->info( $message );
104
105			$self->collection( Grep::Model::ItemCollection->new() );
106
107	dpavlin	73	my $class = $self->feed->source \|\| 'Grep::Source::Feed';
108	dpavlin	72	Jifty->log->debug("using $class");
109
110			$class->fetch( $self );
111
112			Grep::Search->finish if $self->new_items;
113
114			return $self->collection;
115			}
116
117			=head2 add_record
118
119	dpavlin	73	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	dpavlin	72	$parent->add_record( id => 42, foo => 'bar', ... );
123
124	dpavlin	73	This will also update L</new_items>
125
126	dpavlin	72	=cut
127
128			sub add_record {
129			my $self = shift;
130
131			my $i = Grep::Model::Item->new();
132
133			my ($ok,$msg) = $i->load_or_create( @_ );
134
135			$msg \|\|= '';
136
137			if ( $ok ) {
138			Jifty->log->debug("item ", $i->id, ": $msg");
139			$self->collection->add_record( $i );
140
141			# is new record?
142			if ( $msg !~ m/^Found/ ) {
143			Grep::Search->add( $i );
144	dpavlin	74	$self->new_items( ( $self->new_items \|\| 0 ) + 1 );
145	dpavlin	72	}
146			} else {
147			warn "can't add entry ", dump( @_ ), "\n";
148			}
149			}
150
151	dpavlin	73	=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	dpavlin	82	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	dpavlin	73	}
176			}
177			}
178
179	dpavlin	85	=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			my $mech = WWW::Mechanize->new();
198
199			$mech->get( $uri );
200
201	dpavlin	86	$self->save( 'get.html', $mech->content );
202	dpavlin	85
203			if ( $args->{submit_form} ) {
204			warn "submit form on $uri\n";
205			$mech->submit_form( %{ $args->{submit_form} } ) or die "can't submit form";
206	dpavlin	86	$self->save( 'submit.html', $mech->content );
207	dpavlin	85	}
208
209			warn "parse result page\n";
210
211			my $tree = HTML::TreeBuilder->new or die "can't create html tree";
212			$tree->parse( $mech->content ) or die "can't parse fetched content";
213
214			die "wrapper doesn't have 3 elements but ", $#{ $args->{wrapper} } unless ( $#{ $args->{wrapper} } == 2 );
215			my ( $el,$attr,$value ) = @{ $args->{wrapper} };
216
217			warn "looking for <$el $attr=\"$value\">";
218
219			my $div = $tree->look_down( '_tag', $el, sub {
220			warn dump( $_[0]->attr( $attr ) ),$/;
221			( $_[0]->attr( $attr ) \|\| '' ) eq $value;
222			});
223
224			die "can't find results wrapper <$el $attr=\"$value\">" unless ( $div );
225
226			my $max = 5;
227			my $nr = 1;
228
229			my $base_uri = $uri;
230			$base_uri =~ s!\?.*$!!;
231
232			foreach my $dt ( $div->look_down( '_tag', $args->{results} ) ) {
233			my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
234			if ( $a ) {
235
236			my $href = $a->attr('href') or die "can't find href inside <", $args->{results}, ">";
237			my $page_uri = URI->new_abs( $a->attr('href'), $base_uri );
238			$page_uri->query( undef );
239			$page_uri = $page_uri->canonical;
240
241			warn "fetching page: ",$a->as_text," from $page_uri\n";
242			if ( $mech->follow_link( url => $a->attr('href') ) ) {
243
244	dpavlin	86	$self->save( "page-${nr}.html", $mech->content );
245	dpavlin	85
246			my $page_tree = HTML::TreeBuilder->new or die "can't create page tree";
247			$page_tree->parse( $mech->content ) or die "can't parse page at $page_uri";
248
249			my ( $el,$attr,$value ) = @{ $args->{scrape} };
250			my $div = $page_tree->look_down( '_tag', $el, sub { ( $_[0]->attr( $attr ) \|\| '' ) eq $value } );
251
252			die "can't find <$el $attr=\"$value\">" unless ($div);
253
254			$self->add_record(
255			in_feed => $feed,
256			title => $mech->title,
257			link => $page_uri,
258			content => $div->as_HTML,
259			# summary =>
260			# category =>
261			# author =>
262			# issued =>
263			# modified =>
264			);
265
266			$mech->back;
267			$page_tree->delete;
268
269			} else {
270			warn "can't follow uri $page_uri: $!\n";
271			}
272			}
273
274			last if ($nr == $max);
275			$nr++;
276			}
277
278			$tree->delete; # clear memory!
279
280			}
281
282	dpavlin	86	=head2 save
283
284			save( 'name', $content );
285
286			Save dumps into C</tmp/grep> if writable
287
288			=cut
289
290			sub save {
291			my $self = shift;
292			my ( $file, $content ) = @_;
293			if ( -w '/tmp/grep' ) {
294			open(my $f, '>', "/tmp/grep/$file") or die "can't open $file: $!";
295			print $f $content or die "can't write to $file: $!";
296			close $f or die "can't close $file: $!";
297			Jifty->log->debug("saved $file ",length($content)," bytes");
298			}
299			}
300
301	dpavlin	72	1;