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 Jifty::Object);
Grep::Source->mk_accessors( qw(feed uri q new_items collection search_obj tree) );

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

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 );

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

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

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

        $self->search_obj( Grep::Search->new() );
        $self->log->debug("created " . $self->search_obj);

        $class->fetch( $self );

        $self->search_obj->finish;

        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;

        $self->log->confess("no search_obj") unless ($self->search_obj);

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

        my $rec = {@_};

        $self->log->debug("resolving links using base ", $rec->{link});
        my $resolver = HTML::ResolveLink->new( base => $rec->{link} );
        $rec->{content} = $resolver->resolve( $rec->{content} );

        my ($ok,$msg) = $i->load_or_create( %$rec );

        $msg ||= '';

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

                # is new record?
                if ( $msg !~ m/^Found/ ) {
                        $self->search_obj->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 ) {
                $self->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 ) {
                                $self->log->debug("${s}->content_have succesful");
                                return $s;
                        }
                }
        }
}


=head2 element_by_triplet

Helper method to select element(s) using C<element/attribute/value> triplet using
L<HTML::TreeBuilder> trees.

  my $el = $self->element_by_triplet(
        tree => $tree_or_element,
        triplets => [ qw/
                div id target
                div class another
        / ],
        message => 'find search result element',
        fatal => 1,     # die instead of warn
  );

=cut

sub element_by_triplet {
        my $self = shift;

        my $args = {@_};

        my $tree = $args->{tree} || die "no tree";
        my $message = $args->{message} || '';
        my $fatal = $args->{fatal};
        die "no triplets" unless defined( $args->{triplets} );
        my @triplets;
        if ( ref( $args->{triplets} ) eq 'ARRAY' ) {
                @triplets = @{ $args->{triplets} };
        } else {
                @triplets = ( $args->{triplets} );
        }

        push @triplets, ( undef, undef ) if ( $#triplets == 0 );

        die "triplet doesn't have 3 elements but ", $#triplets unless (
                ( $#triplets + 1 ) % 3 == 0
        );

        my ( $el, $attr, $value );

        my @results;
        my @tags;

warn "triplets = ",dump( @triplets );

        while ( @triplets ) {
                ( $el,$attr,$value ) = splice( @triplets, 0, 3 );
                my $tag = $attr ? "<$el $attr=\"$value\">" : "<$el>";
                push @tags, $tag;
                $self->log->debug("looking for $message $tag");
                @results = $tree->look_down( '_tag', $el, sub {
                                return 1 unless ( $attr && $value );
                                ( $_[0]->attr( $attr ) || '' ) =~ m/\b\Q$value\E\b/
                });
                last if @results;
        }

        if ( ! @results ) {
                my $msg = "can't find $message ", join(" ", @tags);
                die $msg if ( $fatal );
                warn $msg;
                return;
        }

        $self->log->debug("found ", $#results + 1, " results");

        #warn dump( map { $_->as_HTML } @results );

        return @results if wantarray;
        return shift @results;
}

=head2 scrape

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

  $parent->scrape(
                # if search string isn't part or URI
                submit_form => {
                        fields => {
                                value => $parent->q,
                        },
                        button => 'fullsearch',
                },
                # element with search results
                wrapper => [ qw/div class searchresults/ ],
                # element (or tripple) for each result with link
                # <a href=".."> inside it to full-text result
                results => 'dt',
                # collect which element on page linked from results
                scrape => [ qw/div id page/ ],
                # when search returns just single hit, it will redirect to result page
                redirect_single_result => 1,
  );

=cut

sub scrape {
        my $self = shift;

        my $args = {@_};

        $self->log->debug("scrape with 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');

        sub mech_warn {
                my $m = shift || return;
                warn $m;
        }

        my $mech = WWW::Mechanize->new(
                cookie_jar => {},
                onwarn => \&mech_warn,
                onerror => \&mech_warn,
        );

        $mech->get( $uri );

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

        if ( my $form = $args->{submit_form} ) {
                $self->log->debug("submit form on $uri with ", dump( $form ));
                $mech->submit_form( %$form ) or die "can't submit form ", dump( $form );
                $self->save( 'submit.html', $mech->content );
        }

        $self->log->debug("parse result page");

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

        my @wrapper_divs = $self->element_by_triplet(
                tree => $tree,
                triplets => $args->{wrapper},
                message => 'wrapper for all results',
                fatal => $args->{redirect_single_result} ? 0 : 1,
        );

        my $max = 15;
        my $nr = 1;

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

        # directly got first result
        if ( $args->{redirect_single_result} && ! @wrapper_divs ) {

                my $uri = $mech->uri; $uri->query( undef ); $uri = $uri->canonical;

                my $div = $self->element_by_triplet(
                        tree => $tree,
                        message => "single result - redirect to $uri",
                        triplets => $args->{scrape},
                        fatal => 1,
                );

                $self->add_record(
                        in_feed => $feed,
                        title => $mech->title,
                        link => $uri,
                        content => $div->as_HTML,
                );

                $tree->delete; # clear memory!
                return;
        }

        my @r;

        foreach my $div ( @wrapper_divs ) {

                my @r_here = $self->element_by_triplet(
                        tree => $div,
                        triplets => $args->{results},
                        message => 'result element',
                );

                push @r, @r_here if (@r_here);
        }

        $self->log->debug("in total, found ", $#r + 1, " results in ", $#wrapper_divs + 1, " result wrapper elements");

        foreach my $dt ( @r ) {
                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( $href, $base_uri );
                        $page_uri->query( undef );
                        $page_uri = $page_uri->canonical;

                        $self->log->debug("fetching page: ",$a->as_text," from $page_uri");
                        if ( $mech->follow_link( url => $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 @divs = $self->element_by_triplet(
                                        tree => $page_tree,
                                        message => "result page $nr",
                                        triplets => $args->{scrape}
                                );

                                if ( @divs ) {

                                        my $html = join("<hr/>\n", map { $_->as_HTML } @divs );
                                        $self->log->debug("found ", $#divs + 1, " element ", length($html), " bytes");

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

                                } else {
                                        $self->log->debug("NO CONTENT scraped from page $nr");
                                }

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

                        } else {
                                warn "can't follow uri $page_uri: $!\n";
                        }
                } else {
                        $self->log->debug("result $nr doesn't have link inside, ignoring...");
                }

                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 ) = @_;
        return unless ( defined($file) && defined($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: $!";
                $self->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	dpavlin	100	use base qw(Class::Accessor Jifty::Object);
11	dpavlin	121	Grep::Source->mk_accessors( qw(feed uri q new_items collection search_obj tree) );
12	dpavlin	72
13	dpavlin	85	use HTML::TreeBuilder;
14			use WWW::Mechanize;
15			use XML::Feed;
16			use URI;
17	dpavlin	96	use HTML::ResolveLink;
18	dpavlin	85
19	dpavlin	72	use Data::Dump qw/dump/;
20
21			=head1 NAME
22
23			Grep::Source - base class for implementation of different sources for Grep
24
25			=head1 METHODS
26
27			This is mostly documentation because most of methods are implemented by plugins.
28
29			=head2 sources
30
31			my @sources = Grep::Source->sources();
32
33			Returns all available sources.
34
35			=cut
36
37	dpavlin	73	Jifty->log->debug("Found source plugins: ", join(", ", __PACKAGE__->sources() ) );
38	dpavlin	72
39			=head2 new
40
41			my $source = Grep::Source->new({ feed => $feed_record });
42
43	dpavlin	73	This will also setup:
44
45			=head2 feed
46
47			isa L<Grep::Model::Feed>
48
49	dpavlin	72	=head2 search
50
51			my $collection = $source->search( 'query string' );
52
53			It will also setup following accessors:
54
55	dpavlin	73	=head2 q
56	dpavlin	72
57			Search query
58
59	dpavlin	73	=head2 uri
60	dpavlin	72
61			URI of feed with embedded search query
62
63	dpavlin	73	=head2 new_items
64	dpavlin	72
65			Number of new items in result collection
66
67			=head2 collection
68
69			Actuall results which is L<Grep::Model::ItemCollection>, so following will
70			work:
71
72			print "and ", $self->collection->count, " total items";
73
74
75			Also setups number of new items
76
77			print $source->new_items, " items new";
78
79			=cut
80
81			sub search {
82			my $self = shift;
83
84			my $q = shift;
85
86			$q ? $self->q( $q ) : $q = $self->q;
87
88			die "no q?" unless ( $self->q );
89			die "no feed?" unless ( $self->feed );
90			die "feed not Grep::Model::Feed" unless ( $self->feed->isa('Grep::Model::Feed') );
91
92			my $message;
93			my $uri = $self->feed->uri;
94			if ($uri =~ m/%s/) {
95			$uri = $self->feed->search_uri( $q );
96			$message = 'Searching';
97			} else {
98			$message = 'Fetching';
99			}
100			$message .= ' ' . $self->feed->title . " at $uri";
101
102			$self->uri( $uri );
103
104	dpavlin	100	$self->log->info( $message );
105	dpavlin	72
106			$self->collection( Grep::Model::ItemCollection->new() );
107
108	dpavlin	73	my $class = $self->feed->source \|\| 'Grep::Source::Feed';
109	dpavlin	100	$self->log->debug("using $class");
110	dpavlin	72
111	dpavlin	110	$self->search_obj( Grep::Search->new() );
112			$self->log->debug("created " . $self->search_obj);
113	dpavlin	72
114	dpavlin	110	$class->fetch( $self );
115
116			$self->search_obj->finish;
117
118	dpavlin	72	return $self->collection;
119			}
120
121			=head2 add_record
122
123	dpavlin	73	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	dpavlin	72	$parent->add_record( id => 42, foo => 'bar', ... );
127
128	dpavlin	73	This will also update L</new_items>
129
130	dpavlin	72	=cut
131
132			sub add_record {
133			my $self = shift;
134
135	dpavlin	110	$self->log->confess("no search_obj") unless ($self->search_obj);
136	dpavlin	109
137	dpavlin	72	my $i = Grep::Model::Item->new();
138
139	dpavlin	96	my $rec = {@_};
140	dpavlin	72
141	dpavlin	102	$self->log->debug("resolving links using base ", $rec->{link});
142	dpavlin	96	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	dpavlin	72	$msg \|\|= '';
148
149			if ( $ok ) {
150	dpavlin	100	$self->log->debug("item ", $i->id, ": $msg");
151	dpavlin	72	$self->collection->add_record( $i );
152
153			# is new record?
154			if ( $msg !~ m/^Found/ ) {
155	dpavlin	110	$self->search_obj->add( $i );
156	dpavlin	74	$self->new_items( ( $self->new_items \|\| 0 ) + 1 );
157	dpavlin	72	}
158			} else {
159			warn "can't add entry ", dump( @_ ), "\n";
160			}
161			}
162
163	dpavlin	73	=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	dpavlin	100	$self->log->debug("testing source class $s");
178	dpavlin	82	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	dpavlin	100	$self->log->debug("${s}->content_have succesful");
185	dpavlin	82	return $s;
186			}
187	dpavlin	73	}
188			}
189			}
190
191	dpavlin	85
192	dpavlin	132	=head2 element_by_triplet
193	dpavlin	85
194	dpavlin	132	Helper method to select element(s) using C<element/attribute/value> triplet using
195			L<HTML::TreeBuilder> trees.
196	dpavlin	85
197	dpavlin	132	my $el = $self->element_by_triplet(
198			tree => $tree_or_element,
199			triplets => [ qw/
200			div id target
201			div class another
202			/ ],
203			message => 'find search result element',
204			fatal => 1, # die instead of warn
205			);
206
207	dpavlin	85	=cut
208
209	dpavlin	121	sub element_by_triplet {
210			my $self = shift;
211
212			my $args = {@_};
213
214			my $tree = $args->{tree} \|\| die "no tree";
215	dpavlin	123	my $message = $args->{message} \|\| '';
216	dpavlin	121	my $fatal = $args->{fatal};
217	dpavlin	126	die "no triplets" unless defined( $args->{triplets} );
218			my @triplets;
219			if ( ref( $args->{triplets} ) eq 'ARRAY' ) {
220			@triplets = @{ $args->{triplets} };
221	dpavlin	123	} else {
222	dpavlin	126	@triplets = ( $args->{triplets} );
223	dpavlin	123	}
224	dpavlin	121
225	dpavlin	126	push @triplets, ( undef, undef ) if ( $#triplets == 0 );
226	dpavlin	121
227	dpavlin	132	die "triplet doesn't have 3 elements but ", $#triplets unless (
228	dpavlin	126	( $#triplets + 1 ) % 3 == 0
229	dpavlin	121	);
230
231	dpavlin	123	my ( $el, $attr, $value );
232	dpavlin	121
233	dpavlin	123	my @results;
234	dpavlin	121	my @tags;
235
236	dpavlin	133	warn "triplets = ",dump( @triplets );
237
238	dpavlin	126	while ( @triplets ) {
239			( $el,$attr,$value ) = splice( @triplets, 0, 3 );
240	dpavlin	121	my $tag = $attr ? "<$el $attr=\"$value\">" : "<$el>";
241			push @tags, $tag;
242			$self->log->debug("looking for $message $tag");
243	dpavlin	123	@results = $tree->look_down( '_tag', $el, sub {
244	dpavlin	121	return 1 unless ( $attr && $value );
245	dpavlin	134	( $_[0]->attr( $attr ) \|\| '' ) =~ m/\b\Q$value\E\b/
246	dpavlin	121	});
247	dpavlin	123	last if @results;
248	dpavlin	121	}
249
250	dpavlin	123	if ( ! @results ) {
251	dpavlin	121	my $msg = "can't find $message ", join(" ", @tags);
252			die $msg if ( $fatal );
253			warn $msg;
254			return;
255			}
256
257	dpavlin	123	$self->log->debug("found ", $#results + 1, " results");
258
259	dpavlin	133	#warn dump( map { $_->as_HTML } @results );
260
261	dpavlin	123	return @results if wantarray;
262			return shift @results;
263	dpavlin	121	}
264
265	dpavlin	132	=head2 scrape
266
267			Create semi-complex L<WWW::Mechanize> rules to scrape page easily
268
269			$parent->scrape(
270			# if search string isn't part or URI
271			submit_form => {
272			fields => {
273			value => $parent->q,
274			},
275			button => 'fullsearch',
276			},
277			# element with search results
278			wrapper => [ qw/div class searchresults/ ],
279			# element (or tripple) for each result with link
280			# <a href=".."> inside it to full-text result
281			results => 'dt',
282			# collect which element on page linked from results
283			scrape => [ qw/div id page/ ],
284			# when search returns just single hit, it will redirect to result page
285			redirect_single_result => 1,
286			);
287
288			=cut
289
290	dpavlin	85	sub scrape {
291			my $self = shift;
292
293			my $args = {@_};
294
295	dpavlin	102	$self->log->debug("scrape with args ",dump($args));
296	dpavlin	85
297			my ($feed,$uri,$q) = ($self->feed, $self->uri,$self->q);
298			die "no uri" unless ($uri);
299			die "feed is not a Grep::Model::Feed but ", ref $feed unless $feed->isa('Grep::Model::Feed');
300
301	dpavlin	92	sub mech_warn {
302			my $m = shift \|\| return;
303			warn $m;
304			}
305	dpavlin	85
306	dpavlin	92	my $mech = WWW::Mechanize->new(
307			cookie_jar => {},
308			onwarn => \&mech_warn,
309			onerror => \&mech_warn,
310			);
311
312	dpavlin	85	$mech->get( $uri );
313
314	dpavlin	86	$self->save( 'get.html', $mech->content );
315	dpavlin	85
316	dpavlin	92	if ( my $form = $args->{submit_form} ) {
317	dpavlin	102	$self->log->debug("submit form on $uri with ", dump( $form ));
318	dpavlin	92	$mech->submit_form( %$form ) or die "can't submit form ", dump( $form );
319	dpavlin	86	$self->save( 'submit.html', $mech->content );
320	dpavlin	85	}
321
322	dpavlin	102	$self->log->debug("parse result page");
323	dpavlin	85
324			my $tree = HTML::TreeBuilder->new or die "can't create html tree";
325			$tree->parse( $mech->content ) or die "can't parse fetched content";
326
327	dpavlin	133	my @wrapper_divs = $self->element_by_triplet(
328	dpavlin	121	tree => $tree,
329	dpavlin	126	triplets => $args->{wrapper},
330	dpavlin	121	message => 'wrapper for all results',
331	dpavlin	132	fatal => $args->{redirect_single_result} ? 0 : 1,
332	dpavlin	121	);
333	dpavlin	85
334	dpavlin	103	my $max = 15;
335	dpavlin	85	my $nr = 1;
336
337			my $base_uri = $uri;
338			$base_uri =~ s!\?.*$!!;
339
340	dpavlin	132	# directly got first result
341	dpavlin	133	if ( $args->{redirect_single_result} && ! @wrapper_divs ) {
342	dpavlin	132
343			my $uri = $mech->uri; $uri->query( undef ); $uri = $uri->canonical;
344
345	dpavlin	133	my $div = $self->element_by_triplet(
346	dpavlin	132	tree => $tree,
347			message => "single result - redirect to $uri",
348			triplets => $args->{scrape},
349			fatal => 1,
350			);
351
352			$self->add_record(
353			in_feed => $feed,
354			title => $mech->title,
355			link => $uri,
356			content => $div->as_HTML,
357			);
358
359			$tree->delete; # clear memory!
360			return;
361			}
362
363	dpavlin	133	my @r;
364	dpavlin	113
365	dpavlin	133	foreach my $div ( @wrapper_divs ) {
366
367			my @r_here = $self->element_by_triplet(
368			tree => $div,
369			triplets => $args->{results},
370			message => 'result element',
371			);
372
373			push @r, @r_here if (@r_here);
374			}
375
376			$self->log->debug("in total, found ", $#r + 1, " results in ", $#wrapper_divs + 1, " result wrapper elements");
377
378	dpavlin	113	foreach my $dt ( @r ) {
379	dpavlin	85	my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
380			if ( $a ) {
381
382			my $href = $a->attr('href') or die "can't find href inside <", $args->{results}, ">";
383	dpavlin	132
384			my $page_uri = URI->new_abs( $href, $base_uri );
385	dpavlin	85	$page_uri->query( undef );
386			$page_uri = $page_uri->canonical;
387
388	dpavlin	102	$self->log->debug("fetching page: ",$a->as_text," from $page_uri");
389	dpavlin	132	if ( $mech->follow_link( url => $href ) ) {
390	dpavlin	85
391	dpavlin	86	$self->save( "page-${nr}.html", $mech->content );
392	dpavlin	85
393			my $page_tree = HTML::TreeBuilder->new or die "can't create page tree";
394			$page_tree->parse( $mech->content ) or die "can't parse page at $page_uri";
395	dpavlin	134	my @divs = $self->element_by_triplet(
396	dpavlin	121	tree => $page_tree,
397	dpavlin	133	message => "result page $nr",
398	dpavlin	126	triplets => $args->{scrape}
399	dpavlin	121	);
400	dpavlin	85
401	dpavlin	134	if ( @divs ) {
402	dpavlin	85
403	dpavlin	134	my $html = join("<hr/>\n", map { $_->as_HTML } @divs );
404			$self->log->debug("found ", $#divs + 1, " element ", length($html), " bytes");
405
406			$self->add_record(
407			in_feed => $feed,
408			title => $mech->title,
409			link => $page_uri,
410			content => $html,
411			# summary =>
412			# category =>
413			# author =>
414			# issued =>
415			# modified =>
416			);
417
418			} else {
419			$self->log->debug("NO CONTENT scraped from page $nr");
420			}
421
422	dpavlin	85	$mech->back;
423			$page_tree->delete;
424
425			} else {
426			warn "can't follow uri $page_uri: $!\n";
427			}
428	dpavlin	121	} else {
429			$self->log->debug("result $nr doesn't have link inside, ignoring...");
430	dpavlin	85	}
431
432			last if ($nr == $max);
433			$nr++;
434			}
435
436			$tree->delete; # clear memory!
437
438			}
439
440	dpavlin	86	=head2 save
441
442			save( 'name', $content );
443
444			Save dumps into C</tmp/grep> if writable
445
446			=cut
447
448			sub save {
449			my $self = shift;
450			my ( $file, $content ) = @_;
451	dpavlin	100	return unless ( defined($file) && defined($content) );
452	dpavlin	86	if ( -w '/tmp/grep' ) {
453			open(my $f, '>', "/tmp/grep/$file") or die "can't open $file: $!";
454			print $f $content or die "can't write to $file: $!";
455			close $f or die "can't close $file: $!";
456	dpavlin	100	$self->log->debug("saved $file ",length($content)," bytes");
457	dpavlin	86	}
458			}
459
460	dpavlin	72	1;