home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _a8dd95bc4ffe9365baae6a94166c651c < prev    next >
Encoding:
Text File  |  2000-03-15  |  8.7 KB  |  362 lines
  1. # $Id: RobotRules.pm,v 1.18 1999/03/20 07:37:36 gisle 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. <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 web site.
  38.  
  39. The parsed file is kept in the WWW::RobotRules object, and this object
  40. provides 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.18 $ =~ /(\d+)\.(\d+)/);
  50. sub Version { $VERSION; }
  51.  
  52. use strict;
  53. use URI ();
  54.  
  55.  
  56. =item $rules = WWW::RobotRules->new($robot_name)
  57.  
  58. This is the constructor for WWW::RobotRules objects.  The first 
  59. argument given to new() is the name of the robot. 
  60.  
  61. =cut
  62.  
  63. sub new {
  64.     my($class, $ua) = @_;
  65.  
  66.     # This ugly hack is needed to ensure backwards compatability.
  67.     # The "WWW::RobotRules" class is now really abstract.
  68.     $class = "WWW::RobotRules::InCore" if $class eq "WWW::RobotRules";
  69.  
  70.     my $self = bless { }, $class;
  71.     $self->agent($ua);
  72.     $self;
  73. }
  74.  
  75.  
  76. =item $rules->parse($url, $content, $fresh_until)
  77.  
  78. The parse() method takes as arguments the URL that was used to
  79. retrieve the F</robots.txt> file, and the contents of the file.
  80.  
  81. =cut
  82.  
  83. sub parse {
  84.     my($self, $url, $txt, $fresh_until) = @_;
  85.     $url = URI->new("$url");
  86.     my $netloc = $url->authority;
  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.     # blank lines are significant, so turn CRLF into LF to avoid generating
  98.     # false ones
  99.     $txt =~ s/\015\012/\012/g;
  100.  
  101.     # split at \012 (LF) or \015 (CR) (Mac text files have just CR for EOL)
  102.     for(split(/[\012\015]/, $txt)) {
  103.  
  104.     # Lines containing only a comment are discarded completely, and
  105.         # therefore do not indicate a record boundary.
  106.     next if /^\s*\#/;
  107.  
  108.     s/\s*\#.*//;        # remove comments at end-of-line
  109.  
  110.     if (/^\s*$/) {        # blank line
  111.         last if $is_me; # That was our record. No need to read the rest.
  112.         $is_anon = 0;
  113.     }
  114.         elsif (/^User-Agent:\s*(.*)/i) {
  115.         $ua = $1;
  116.         $ua =~ s/\s+$//;
  117.         if ($is_me) {
  118.         # This record already had a User-agent that
  119.         # we matched, so just continue.
  120.         }
  121.         elsif ($ua eq '*') {
  122.         $is_anon = 1;
  123.         }
  124.         elsif($self->is_me($ua)) {
  125.         $is_me = 1;
  126.         }
  127.     }
  128.     elsif (/^Disallow:\s*(.*)/i) {
  129.         unless (defined $ua) {
  130.         warn "RobotRules: Disallow without preceding User-agent\n";
  131.         $is_anon = 1;  # assume that User-agent: * was intended
  132.         }
  133.         my $disallow = $1;
  134.         $disallow =~ s/\s+$//;
  135.         if (length $disallow) {
  136.         $disallow = URI->new($disallow, $url)->path_query;
  137.         }
  138.  
  139.         if ($is_me) {
  140.         push(@me_disallowed, $disallow);
  141.         }
  142.         elsif ($is_anon) {
  143.         push(@anon_disallowed, $disallow);
  144.         }
  145.     }
  146.     else {
  147.         warn "RobotRules: Unexpected line: $_\n";
  148.     }
  149.     }
  150.  
  151.     if ($is_me) {
  152.     $self->push_rules($netloc, @me_disallowed);
  153.     } else {
  154.     $self->push_rules($netloc, @anon_disallowed);
  155.     }
  156. }
  157.  
  158. # is_me()
  159. #
  160. # Returns TRUE if the given name matches the
  161. # name of this robot
  162. #
  163. sub is_me {
  164.     my($self, $ua) = @_;
  165.     my $me = $self->agent;
  166.     return index(lc($ua), lc($me)) >= 0;
  167. }
  168.  
  169. =item $rules->allowed($url)
  170.  
  171. Returns TRUE if this robot is allowed to retrieve this URL.
  172.  
  173. =cut
  174.  
  175. sub allowed {
  176.     my($self, $url) = @_;
  177.     $url = URI->new("$url");
  178.     my $netloc = $url->authority;
  179.  
  180.     my $fresh_until = $self->fresh_until($netloc);
  181.     return -1 if !defined($fresh_until) || $fresh_until < time;
  182.  
  183.     my $str = $url->path_query;
  184.     my $rule;
  185.     for $rule ($self->rules($netloc)) {
  186.     return 1 unless length $rule;
  187.     return 0 if index($str, $rule) == 0;
  188.     }
  189.     return 1;
  190. }
  191.  
  192. # The following methods must be provided by the subclass.
  193. sub agent;
  194. sub visit;
  195. sub no_visits;
  196. sub last_visits;
  197. sub fresh_until;
  198. sub push_rules;
  199. sub clear_rules;
  200. sub rules;
  201. sub dump;
  202.  
  203. package WWW::RobotRules::InCore;
  204.  
  205. use vars qw(@ISA);
  206. @ISA = qw(WWW::RobotRules);
  207.  
  208. =item $rules->agent([$name])
  209.  
  210. Get/set the agent name. NOTE: Changing the agent name will clear the robots.txt
  211. rules and expire times out of the cache.
  212.  
  213. =cut
  214.  
  215. sub agent {
  216.     my ($self, $name) = @_;
  217.     my $old = $self->{'ua'};
  218.     if ($name) {
  219.     delete $self->{'loc'};   # all old info is now stale
  220.     $name =~ s!/?\s*\d+.\d+\s*$!!;  # loose version
  221.     $self->{'ua'}=$name;
  222.     }
  223.     $old;
  224. }
  225.  
  226. sub visit {
  227.     my($self, $netloc, $time) = @_;
  228.     $time ||= time;
  229.     $self->{'loc'}{$netloc}{'last'} = $time;
  230.     
  231.     my $count = \$self->{'loc'}{$netloc}{'count'};
  232.     if (!defined $$count) {
  233.     $$count = 1;
  234.     } else {
  235.     $$count++;
  236.     }
  237. }
  238.  
  239. sub no_visits {
  240.     my ($self, $netloc) = @_;
  241.     $self->{'loc'}{$netloc}{'count'};
  242. }
  243.  
  244. sub last_visit {
  245.     my ($self, $netloc) = @_;
  246.     $self->{'loc'}{$netloc}{'last'};
  247. }
  248.  
  249. sub fresh_until {
  250.     my ($self, $netloc, $fresh_until) = @_;
  251.     my $old = $self->{'loc'}{$netloc}{'fresh'};
  252.     if (defined $fresh_until) {
  253.     $self->{'loc'}{$netloc}{'fresh'} = $fresh_until;
  254.     }
  255.     $old;
  256. }
  257.  
  258. sub push_rules {
  259.     my($self, $netloc, @rules) = @_;
  260.     push (@{$self->{'loc'}{$netloc}{'rules'}}, @rules);
  261. }
  262.  
  263. sub clear_rules {
  264.     my($self, $netloc) = @_;
  265.     delete $self->{'loc'}{$netloc}{'rules'};
  266. }
  267.  
  268. sub rules {
  269.     my($self, $netloc) = @_;
  270.     if (defined $self->{'loc'}{$netloc}{'rules'}) {
  271.     return @{$self->{'loc'}{$netloc}{'rules'}};
  272.     } else {
  273.     return ();
  274.     }
  275. }
  276.  
  277. sub dump
  278. {
  279.     my $self = shift;
  280.     for (keys %$self) {
  281.     next if $_ eq 'loc';
  282.     print "$_ = $self->{$_}\n";
  283.     }
  284.     for (keys %{$self->{'loc'}}) {
  285.     my @rules = $self->rules($_);
  286.     print "$_: ", join("; ", @rules), "\n";
  287.     
  288.     }
  289. }
  290.  
  291. 1;
  292.  
  293. __END__
  294.  
  295. =back
  296.  
  297. =head1 ROBOTS.TXT
  298.  
  299. The format and semantics of the "/robots.txt" file are as follows
  300. (this is an edited abstract of
  301. <http://info.webcrawler.com/mak/projects/robots/norobots.html>):
  302.  
  303. The file consists of one or more records separated by one or more
  304. blank lines. Each record contains lines of the form
  305.  
  306.   <field-name>: <value>
  307.  
  308. The field name is case insensitive.  Text after the '#' character on a
  309. line is ignored during parsing.  This is used for comments.  The
  310. following <field-names> can be used:
  311.  
  312. =over 3
  313.  
  314. =item User-Agent
  315.  
  316. The value of this field is the name of the robot the record is
  317. describing access policy for.  If more than one I<User-Agent> field is
  318. present the record describes an identical access policy for more than
  319. one robot. At least one field needs to be present per record.  If the
  320. value is '*', the record describes the default access policy for any
  321. robot that has not not matched any of the other records.
  322.  
  323. =item Disallow
  324.  
  325. The value of this field specifies a partial URL that is not to be
  326. visited. This can be a full path, or a partial path; any URL that
  327. starts with this value will not be retrieved
  328.  
  329. =back
  330.  
  331. =head1 ROBOTS.TXT EXAMPLES
  332.  
  333. The following example "/robots.txt" file specifies that no robots
  334. should visit any URL starting with "/cyberworld/map/" or "/tmp/":
  335.  
  336.   User-agent: *
  337.   Disallow: /cyberworld/map/ # This is an infinite virtual URL space
  338.   Disallow: /tmp/ # these will soon disappear
  339.  
  340. This example "/robots.txt" file specifies that no robots should visit
  341. any URL starting with "/cyberworld/map/", except the robot called
  342. "cybermapper":
  343.  
  344.   User-agent: *
  345.   Disallow: /cyberworld/map/ # This is an infinite virtual URL space
  346.  
  347.   # Cybermapper knows where to go.
  348.   User-agent: cybermapper
  349.   Disallow:
  350.  
  351. This example indicates that no robots should visit this site further:
  352.  
  353.   # go away
  354.   User-agent: *
  355.   Disallow: /
  356.  
  357. =head1 SEE ALSO
  358.  
  359. L<LWP::RobotUA>, L<WWW::RobotRules::AnyDBM_File>
  360.  
  361. =cut
  362.