File Coverage

blib/lib/GunghoX/FollowLinks/Parser.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             # $Id: /mirror/perl/GunghoX-FollowLinks/trunk/lib/GunghoX/FollowLinks/Parser.pm 40584 2008-01-29T14:54:08.742000Z daisuke $
2             #
3             # Copyright (c) 2007 Daisuke Maki <daisuke@endeworks.jp>
4             # All rights reserved.
5              
6             package GunghoX::FollowLinks::Parser;
7 3     3   2017 use strict;
  3         4  
  3         78  
8 3     3   8 use warnings;
  3         4  
  3         72  
9 3     3   17 use base qw(Gungho::Base);
  3         4  
  3         1549  
10 3     3   19929 use Gungho::Request;
  0            
  0            
11             use Gungho::Util;
12             use GunghoX::FollowLinks::Rule qw(FOLLOW_ALLOW FOLLOW_DENY FOLLOW_DEFER);
13              
14             __PACKAGE__->mk_accessors($_) for qw(rules filters content_type merge_rule);
15              
16             sub parse { die "Must override parse()" }
17              
18             sub register
19             {
20             my ($self, $c) = @_;
21             my $ct = $self->content_type;
22             $c->follow_links_parsers->{ $ct } = $self;
23             }
24              
25             sub new
26             {
27             my $class = shift;
28             my %args = @_;
29              
30             my @rules;
31             foreach my $rule (@{ $args{rules} }) {
32             if (! eval { $rule->isa('GunghoX::FollowLinks::Rule') } || $@) {
33             my $module = $rule->{module};
34             my $pkg = Gungho::Util::load_module($module, "GunghoX::FollowLinks::Rule");
35             $rule = $pkg->new( %{ $rule->{config} } );
36             }
37             push @rules, $rule;
38             }
39              
40             my @filters;
41             foreach my $filter (@{ $args{filters} }) {
42             if (! eval { $filter->isa('GunghoX::FollowLinks::Filter') } || $@) {
43             my $module = $filter->{module};
44             my $pkg = Gungho::Util::load_module($module, 'GunghoX::FollowLinks::Filter');
45             $filter = $pkg->new( %{ $filter->{config} } );
46             }
47             push @filters, $filter;
48             }
49              
50             return $class->next::method(
51             content_type => 'DEFAULT',
52             merge_rule => 'ANY',
53             @_,
54             rules => \@rules,
55             filters => \@filters,
56             );
57             }
58              
59             sub apply_rules
60             {
61             my ($self, $c, $response, $url, $attrs) = @_;
62              
63             $c->log->debug( "Applying rules for $url" );
64             my $rules = $self->rules ;
65             my $decision;
66             my @decision;
67             foreach my $rule (@{ $rules }) {
68             $decision = $rule->apply( $c, $response, $url, $attrs );
69             if ($decision eq FOLLOW_ALLOW || $decision eq FOLLOW_DENY) {
70             $c->log->debug( " + Rule $rule " . (
71             $decision eq FOLLOW_ALLOW ? "ALLOW" :
72             $decision eq FOLLOW_DENY ? "DENY" :
73             $decision eq FOLLOW_DEFER ? "DEFER" :
74             "UNKNOWN"
75             ) . " for url $url");
76              
77             if ($self->merge_rule eq 'ANY') {
78             $c->log->debug( " * Merge rule is 'ANY', stopping rules");
79             last;
80             }
81             }
82             push @decision, $decision;
83             }
84              
85             if ($self->merge_rule eq 'ALL') {
86             my @allowed = grep { $_ eq FOLLOW_ALLOW } @decision;
87             $c->log->debug( "Merge rule is 'ALL'. " . scalar @allowed . " ALLOWs from " . scalar @decision . " decisions");
88             $decision = (@allowed == @decision) ? FOLLOW_ALLOW : FOLLOW_DENY;
89             }
90              
91             return ($decision || FOLLOW_DEFER) eq FOLLOW_ALLOW;
92             }
93              
94             sub follow_if_allowed
95             {
96             my ($self, $c, $response, $url, $attrs) = @_;
97              
98             my $allowed = 0;
99             if ($self->apply_rules( $c, $response, $url, $attrs ) ) {
100             $self->apply_filters( $c, $url );
101              
102             if (! $url->scheme || ! $url->host) {
103             $c->log->debug( "DENY $url (ALLOW by rule, but URL is invalid)" );
104             $allowed = 0;
105             } else {
106             $c->log->debug( "ALLOW $url" );
107             my $request = $self->construct_follow_request($c, $response, $url, $attrs);
108             $c->pushback_request( $request );
109             $allowed++;
110             }
111             } else {
112             $c->log->debug( "DENY $url" );
113             }
114             return $allowed;
115             }
116              
117             sub apply_filters
118             {
119             my ($self, $c, $uri) = @_;
120              
121             my $filters = $self->filters ;
122             foreach my $filter (@{ $filters }) {
123             $filter->apply($c, $uri);
124             }
125             }
126              
127             sub construct_follow_request
128             {
129             my ($self, $c, $response, $url, $attrs) = @_;
130             my $req = Gungho::Request->new( GET => $url ) ;
131             $req->notes('auto_follow_request', 1);
132             return $req;
133             }
134              
135             1;
136              
137             __END__
138              
139             =head1 NAME
140              
141             GunghoX::FollowLinks::Parser - Base Class For FollowLinks Parser
142              
143             =head1 METHODS
144              
145             =head2 new(%args)
146              
147             =head2 content_type
148              
149             =head2 rules
150              
151             =head2 register
152              
153             =head2 parse
154              
155             =head2 apply_rules
156              
157             =head2 follow_if_allowed
158              
159             =cut