Grep/Source/MoinMoin.pm

#!/usr/bin/perl -w

# 02/22/07 15:46:38 CET Dobrica Pavlinusic <dpavlin@rot13.org>
use warnings;
use strict;

package Grep::Source::MoinMoin;

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

=head2 content_have

Return regex to match against content

=cut

sub content_have {
        qr/MoinMoin/
}

=head2 fetch

  Grep::Source::MoinMoin->fetch( $source );

=cut

sub fetch {
        my $self = shift;

        my $parent = shift;
        my ($feed,$uri,$q) = ($parent->feed, $parent->uri,$parent->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 );

        warn "submit form on $uri\n";

        $mech->submit_form(
                fields => {
                        value => $q,
                },
                button => 'fullsearch',
        ) or die "can't submit";

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

        my $div = $tree->look_down( '_tag', 'div', sub {
                        ( $_[0]->attr('class') || '' ) eq 'searchresults'
        });

        die "can't find div with class searchresults" unless ( $div );

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

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

                        my $page_uri = $uri . $a->attr('href');
                        $page_uri =~ s!\Q?highlight=\E.*$!!;

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

                                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 $div = $page_tree->look_down( '_tag', 'div', sub { ( $_[0]->attr('id') || '' ) eq 'page' } );

                                die "can't find <div id=page>" unless ($div);

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

                                $mech->back;

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

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

        $tree->delete; # clear memory!

}

1;
1	#!/usr/bin/perl -w
2
3	# 02/22/07 15:46:38 CET Dobrica Pavlinusic <dpavlin@rot13.org>
4	use warnings;
5	use strict;
6
7	package Grep::Source::MoinMoin;
8
9	use HTML::TreeBuilder;
10	use WWW::Mechanize;
11	use XML::Feed;
12
13	=head2 content_have
14
15	Return regex to match against content
16
17	=cut
18
19	sub content_have {
20	qr/MoinMoin/
21	}
22
23	=head2 fetch
24
25	Grep::Source::MoinMoin->fetch( $source );
26
27	=cut
28
29	sub fetch {
30	my $self = shift;
31
32	my $parent = shift;
33	my ($feed,$uri,$q) = ($parent->feed, $parent->uri,$parent->q);
34	die "no uri" unless ($uri);
35	die "feed is not a Grep::Model::Feed but ", ref $feed unless $feed->isa('Grep::Model::Feed');
36
37	my $mech = WWW::Mechanize->new();
38
39	$mech->get( $uri );
40
41	warn "submit form on $uri\n";
42
43	$mech->submit_form(
44	fields => {
45	value => $q,
46	},
47	button => 'fullsearch',
48	) or die "can't submit";
49
50	warn "parse result page\n";
51
52	my $tree = HTML::TreeBuilder->new or die "can't create html tree";
53	$tree->parse( $mech->content ) or die "can't parse fetched content";
54
55	my $div = $tree->look_down( '_tag', 'div', sub {
56	( $_[0]->attr('class') \|\| '' ) eq 'searchresults'
57	});
58
59	die "can't find div with class searchresults" unless ( $div );
60
61	my $max = 5;
62	my $nr = 1;
63
64	foreach my $dt ( $div->look_down( '_tag', 'dt' ) ) {
65	my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
66	if ( $a ) {
67
68	my $page_uri = $uri . $a->attr('href');
69	$page_uri =~ s!\Q?highlight=\E.*$!!;
70
71	warn "fetching page: ",$a->as_text," from $page_uri\n";
72	if ( $mech->follow_link( url => $a->attr('href') ) ) {
73
74	my $page_tree = HTML::TreeBuilder->new or die "can't create page tree";
75	$page_tree->parse( $mech->content ) or die "can't parse page at $page_uri";
76
77	my $div = $page_tree->look_down( '_tag', 'div', sub { ( $_[0]->attr('id') \|\| '' ) eq 'page' } );
78
79	die "can't find <div id=page>" unless ($div);
80
81	$parent->add_record(
82	in_feed => $feed,
83	title => $mech->title,
84	link => $page_uri,
85	content => $div->as_HTML,
86	# summary =>
87	# category =>
88	# author =>
89	# issued =>
90	# modified =>
91	);
92
93	$mech->back;
94
95	} else {
96	warn "can't follow uri $page_uri: $!\n";
97	}
98	}
99
100	last if ($nr == $max);
101	$nr++;
102	}
103
104	$tree->delete; # clear memory!
105
106	}
107
108	1;