home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Archived / Updates / Perl / libwww_for_perl_109 / site_perl / WWW / RobotRules.pm
Text File  |  1997-12-02  |  8KB  |  361 lines
  1. # $Id: RobotRules.pm,v 1.15 1997/12/02 13:31:36 aas Exp $
  2.  
  3. package WWW::RobotRules;
  4.  
  5. =head1 NAME
  6.  
  7. WWW::RobotsRules - Parse robots.txt files
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.  require WWW::RobotRules;
  12.  my $robotsrules = new WWW::RobotRules 'MOMspider/1.0';
  13.  
  14.  use LWP::Simple qw(get);
  15.  
  16.  $url = "http://some.place/robots.txt";
  17.  my $robots_txt = get $url;
  18.  $robotsrules->parse($url, $robots_txt);
  19.  
  20.  $url = "http://some.other.place/robots.txt";
  21.  my $robots_txt = get $url;
  22.  $robotsrules->parse($url, $robots_txt);
  23.  
  24.  # Now we are able to check if a URL is valid for those servers that
  25.  # we have obtained and parsed "robots.txt" files for.
  26.  if($robotsrules->allowed($url)) {
  27.      $c = get $url;
  28.      ...
  29.  }
  30.  
  31. =head1 DESCRIPTION
  32.  
  33. This module parses a F<robots.txt> file as specified in
  34. "A Standard for Robot Exclusion", described in
  35. <URL:http://info.webcrawler.com/mak/projects/robots/norobots.html>
  36. Webmasters can use the F<robots.txt> file to disallow conforming
  37. robots access to parts of their WWW server.
  38.  
  39. The parsed file is kept in the WWW::RobotRules object, and this object
  40. provide methods to check if access to a given URL is prohibited.  The
  41. same WWW::RobotRules object can parse multiple F<robots.txt> files.
  42.  
  43. The following methods are provided:
  44.  
  45. =over 4
  46.  
  47. =cut
  48.  
  49. $VERSION = sprintf("%d.%02d", q$Revision: 1.15 $ =~ /(\d+)\.(\d+)/);
  50. sub Version { $VERSION; }
  51.  
  52.  
  53. use URI::URL ();
  54. use strict;
  55.  
  56.  
  57. =item $rules = new WWW::RobotRules 'MOMspider/1.0'
  58.  
  59. This is the constructor for WWW::RobotRules objects.  The first 
  60. argument given to new() is the name of the robot. 
  61.  
  62. =cut
  63.  
  64. sub new {
  65.     my($class, $ua) = @_;
  66.  
  67.     # This ugly hack is needed to ensure backwards compatability.
  68.     # The "WWW::RobotRules" class is now really abstract.
  69.     $class = "WWW::RobotRules::InCore" if $class eq "WWW::RobotRules";
  70.  
  71.     my $self = bless { }, $class;
  72.     $self->agent($ua);
  73.     $self;
  74. }
  75.  
  76.  
  77. =item $rules->parse($url, $content, $fresh_until)
  78.  
  79. The parse() method takes as arguments the URL that was used to
  80. retrieve the F</robots.txt> file, and the contents of the file.
  81.  
  82. =cut
  83.  
  84. sub parse {
  85.     my($self, $url, $txt, $fresh_until) = @_;
  86.  
  87.     $url = new URI::URL $url unless ref($url);    # make it URL
  88.     my $netloc = $url->netloc;
  89.  
  90.     $self->clear_rules($netloc);
  91.     $self->fresh_until($netloc, $fresh_until || (time + 365*24*3600));
  92.  
  93.     my $ua;
  94.     my $is_me = 0;        # 1 iff this record is for me
  95.     my $is_anon = 0;        # 1 iff this record is for *
  96.     my @me_disallowed = ();    # rules disallowed for me
  97.     my @anon_disallowed = ();    # rules disallowed for *
  98.  
  99.     for(split(/\n/, $txt)) {
  100.     s/\015$//g;
  101.  
  102.     # Lines containing only a comment are discarded completely, and
  103.         # therefore do not indicate a record boundary.
  104.     next if /^\s*\#/;
  105.  
  106.     s/\s*\#.*//;        # remove comments at end-of-line
  107.  
  108.     if (/^\s*$/) {        # blank line
  109.         last if $is_me; # That was our record. No need to read the rest.
  110.         $is_anon = 0;
  111.     }
  112.         elsif (/^User-Agent:\s*(.*)/i) {
  113.         $ua = $1;
  114.         $ua =~ s/\s+$//;
  115.         if ($is_me) {
  116.         # This record already had a User-agent that
  117.         # we matched, so just continue.
  118.         }
  119.         elsif ($ua eq '*') {
  120.         $is_anon = 1;
  121.         }
  122.         elsif($self->is_me($ua)) {
  123.         $is_me = 1;
  124.         }
  125.     }
  126.     elsif (/^Disallow:\s*(.*)/i) {
  127.         unless (defined $ua) {
  128.         warn "RobotRules: Disallow without preceding User-agent\n";
  129.         $is_anon = 1;  # assume that User-agent: * was intended
  130.         }
  131.         my $disallow = $1;
  132.         $disallow =~ s/\s+$//;
  133.         if (length $disallow) {
  134.         $disallow = URI::URL->new($disallow, $url)->full_path;
  135.         }
  136.  
  137.         if ($is_me) {
  138.         push(@me_disallowed, $disallow);
  139.         }
  140.         elsif ($is_anon) {
  141.         push(@anon_disallowed, $disallow);
  142.         }
  143.     }
  144.     else {
  145.         warn "RobotRules: Unexpected line: $_\n";
  146.     }
  147.     }
  148.  
  149.     if ($is_me) {
  150.     $self->push_rules($netloc, @me_disallowed);
  151.     } else {
  152.     $self->push_rules($netloc, @anon_disallowed);
  153.     }
  154. }
  155.  
  156. # is_me()
  157. #
  158. # Returns TRUE if the given name matches the
  159. # name of this robot
  160. #
  161. sub is_me {
  162.     my($self, $ua) = @_;
  163.     my $me = $self->agent;
  164.     return index(lc($ua), lc($me)) >= 0;
  165. }
  166.  
  167. =item $rules->allowed($url)
  168.  
  169. Returns TRUE if this robot is allowed to retrieve this URL.
  170.  
  171. =cut
  172.  
  173. sub allowed {
  174.     my($self, $url) = @_;
  175.     $url = URI::URL->new($url) unless ref $url;    # make it URL
  176.  
  177.     my $netloc = $url->netloc;
  178.  
  179.     my $fresh_until = $self->fresh_until($netloc);
  180.     return -1 if !defined($fresh_until) || $fresh_until < time;
  181.  
  182.     my $str = $url->full_path;
  183.     my $rule;
  184.     for $rule ($self->rules($netloc)) {
  185.     return 1 unless length $rule;
  186.     return 0 if index($str, $rule) == 0;
  187.     }
  188.     return 1;
  189. }
  190.  
  191. # The following methods must be provided by the subclass.
  192. sub agent;
  193. sub visit;
  194. sub no_visits;
  195. sub last_visits;
  196. sub fresh_until;
  197. sub push_rules;
  198. sub clear_rules;
  199. sub rules;
  200. sub dump;
  201.  
  202. package WWW::RobotRules::InCore;
  203.  
  204. use vars qw(@ISA);
  205. @ISA = qw(WWW::RobotRules);
  206.  
  207. =item $rules->agent([$name])
  208.  
  209. Get/set the agent name. NOTE: Changing the agent name will clear the robots.txt
  210. rules and expire times out of the cache.
  211.  
  212. =cut
  213.  
  214. sub agent {
  215.     my ($self, $name) = @_;
  216.     my $old = $self->{'ua'};
  217.     if ($name) {
  218.     delete $self->{'loc'};   # all old info is now stale
  219.     $name =~ s!/?\s*\d+.\d+\s*$!!;  # loose version
  220.     $self->{'ua'}=$name;
  221.     }
  222.     $old;
  223. }
  224.  
  225. sub visit {
  226.     my($self, $netloc, $time) = @_;
  227.     $time ||= time;
  228.     $self->{'loc'}{$netloc}{'last'} = $time;
  229.     
  230.     my $count = \$self->{'loc'}{$netloc}{'count'};
  231.     if (!defined $$count) {
  232.     $$count = 1;
  233.     } else {
  234.     $$count++;
  235.     }
  236. }
  237.  
  238. sub no_visits {
  239.     my ($self, $netloc) = @_;
  240.     $self->{'loc'}{$netloc}{'count'};
  241. }
  242.  
  243. sub last_visit {
  244.     my ($self, $netloc) = @_;
  245.     $self->{'loc'}{$netloc}{'last'};
  246. }
  247.  
  248. sub fresh_until {
  249.     my ($self, $netloc, $fresh_until) = @_;
  250.     my $old = $self->{'loc'}{$netloc}{'fresh'};
  251.     if (defined $fresh_until) {
  252.     $self->{'loc'}{$netloc}{'fresh'} = $fresh_until;
  253.     }
  254.     $old;
  255. }
  256.  
  257. sub push_rules {
  258.     my($self, $netloc, @rules) = @_;
  259.     push (@{$self->{'loc'}{$netloc}{'rules'}}, @rules);
  260. }
  261.  
  262. sub clear_rules {
  263.     my($self, $netloc) = @_;
  264.     delete $self->{'loc'}{$netloc}{'rules'};
  265. }
  266.  
  267. sub rules {
  268.     my($self, $netloc) = @_;
  269.     if (defined $self->{'loc'}{$netloc}{'rules'}) {
  270.     return @{$self->{'loc'}{$netloc}{'rules'}};
  271.     } else {
  272.     return ();
  273.     }
  274. }
  275.  
  276. sub dump
  277. {
  278.     my $self = shift;
  279.     for (keys %$self) {
  280.     next if $_ eq 'loc';
  281.     print "$_ = $self->{$_}\n";
  282.     }
  283.     for (keys %{$self->{'loc'}}) {
  284.     my @rules = $self->rules($_);
  285.     print "$_: ", join("; ", @rules), "\n";
  286.     
  287.     }
  288. }
  289.  
  290. 1;
  291.  
  292. __END__
  293.  
  294. =back
  295.  
  296. =head1 ROBOTS.TXT
  297.  
  298. The format and semantics of the "/robots.txt" file are as follows
  299. (this is an edited abstract of
  300. <URL:http://info.webcrawler.com/mak/projects/robots/norobots.html>):
  301.  
  302. The file consists of one or more records separated by one or more
  303. blank lines. Each record contains lines of the form
  304.  
  305.   <field-name>: <value>
  306.  
  307. The field name is case insensitive.  Text after the '#' character on a
  308. line is ignored during parsing.  This is used for comments.  The
  309. following <field-names> can be used:
  310.  
  311. =over 3
  312.  
  313. =item User-Agent
  314.  
  315. The value of this field is the name of the robot the record is
  316. describing access policy for.  If more than one I<User-Agent> field is
  317. present the record describes an identical access policy for more than
  318. one robot. At least one field needs to be present per record.  If the
  319. value is '*', the record describes the default access policy for any
  320. robot that has not not matched any of the other records.
  321.  
  322. =item Disallow
  323.  
  324. The value of this field specifies a partial URL that is not to be
  325. visited. This can be a full path, or a partial path; any URL that
  326. starts with this value will not be retrieved
  327.  
  328. =back
  329.  
  330. =head1 ROBOTS.TXT EXAMPLES
  331.  
  332. The following example "/robots.txt" file specifies that no robots
  333. should visit any URL starting with "/cyberworld/map/" or "/tmp/":
  334.  
  335.   User-agent: *
  336.   Disallow: /cyberworld/map/ # This is an infinite virtual URL space
  337.   Disallow: /tmp/ # these will soon disappear
  338.  
  339. This example "/robots.txt" file specifies that no robots should visit
  340. any URL starting with "/cyberworld/map/", except the robot called
  341. "cybermapper":
  342.  
  343.   User-agent: *
  344.   Disallow: /cyberworld/map/ # This is an infinite virtual URL space
  345.  
  346.   # Cybermapper knows where to go.
  347.   User-agent: cybermapper
  348.   Disallow:
  349.  
  350. This example indicates that no robots should visit this site further:
  351.  
  352.   # go away
  353.   User-agent: *
  354.   Disallow: /
  355.  
  356. =head1 SEE ALSO
  357.  
  358. L<LWP::RobotUA>, L<WWW::RobotRules::AnyDBM_File>
  359.  
  360. =cut
  361.