1# $Id: /mirror/gungho/lib/Gungho/Component/RobotRules/Rule.pm 31623 2007-12-01T04:12:45.036041Z lestrrat $ 2 3package Gungho::Component::RobotRules::Rule; 4use strict; 5use warnings; 6use base qw(Gungho::Base); 7use URI; 8 9__PACKAGE__->mk_accessors($_) for qw(rules); 10 11sub new 12{ 13 my $class = shift; 14 my $self = $class->next::method(); 15 $self->setup(@_); 16 $self; 17} 18 19sub setup 20{ 21 my $self = shift; 22 my $rules = shift; 23 $self->rules($rules); 24} 25 26sub allowed 27{ 28 my $self = shift; 29 my $c = shift; 30 my $uri = shift; 31 32 $uri = URI->new($uri) unless ref $uri; 33 my $str = $uri->path_query || '/'; 34 my $rules = $self->rules; 35 36 # XXX - There seems to be a problem where each %$rules doesn't get 37 # reset when we get out of the while loop in the middle of execution. 38 # We do this stupid hack to make sure that the context is reset correctly 39 keys %$rules; 40 while (my ($key, $list) = each %$rules) { 41 next unless $self->is_me($c, $key); 42 43 foreach my $rule (@$list) { 44 return 1 unless length $rule; 45 return 0 if index($str, $rule) == 0; 46 } 47 return 1; 48 } 49 return 1; 50} 51 52sub is_me 53{ 54 my $self = shift; 55 my $c = shift; 56 my $name = shift; 57 58 return $name eq '*' || index(lc($c->user_agent), lc($name)) >= 0; 59} 60 611; 62 63__END__ 64 65=head1 NAME 66 67Gungho::Component::RobotRules::Rule - A Rule Object 68 69=head1 SYNOPSIS 70 71 use Gungho::Component::RobotRules::Rule; 72 my $rule = Gungho::Component::RobotRules::Rule->new( 73 'UserAgent A' => [ '/foo', '/bar' ], 74 'UserAgent B' => [ '/baz', '/quux' ], 75 ); 76 77=head1 DESCRIPTION 78 79This modules stores the RobotRules ruleset for a particular host. 80 81=head1 METHODS 82 83=head2 new 84 85Creates a new rule. A single rule is a set of subrules that represents 86an user-agent to a list of denied paths. 87 88No host information is stored. 89 90=head2 setup 91 92Initializes the rule. 93 94=head2 allowed($c, $uri) 95 96Returns true if the given URL is allowed within this ruleset 97 98=head2 is_me($c,$string) 99 100Returns true if $string matches our user agent string contained in $c->user_agent 101 102=cut 103