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