home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2007 September / PCWSEP07.iso / Software / Linux / Linux Mint 3.0 Light / LinuxMint-3.0-Light.iso / casper / filesystem.squashfs / usr / share / perl5 / WWW / RobotRules.pm
Encoding:
Perl POD Document  |  2005-09-21  |  10.9 KB  |  447 lines
  1. package WWW::RobotRules;
  2.  
  3. # $Id: RobotRules.pm,v 1.33 2005/09/21 19:36:19 gisle Exp $
  4.  
  5. $VERSION = sprintf("%d.%02d", q$Revision: 1.33 $ =~ /(\d+)\.(\d+)/);
  6. sub Version { $VERSION; }
  7.  
  8. use strict;
  9. use URI ();
  10.  
  11.  
  12.  
  13. sub new {
  14.     my($class, $ua) = @_;
  15.  
  16.     # This ugly hack is needed to ensure backwards compatibility.
  17.     # The "WWW::RobotRules" class is now really abstract.
  18.     $class = "WWW::RobotRules::InCore" if $class eq "WWW::RobotRules";
  19.  
  20.     my $self = bless { }, $class;
  21.     $self->agent($ua);
  22.     $self;
  23. }
  24.  
  25.  
  26. sub parse {
  27.     my($self, $robot_txt_uri, $txt, $fresh_until) = @_;
  28.     $robot_txt_uri = URI->new("$robot_txt_uri");
  29.     my $netloc = $robot_txt_uri->host . ":" . $robot_txt_uri->port;
  30.  
  31.     $self->clear_rules($netloc);
  32.     $self->fresh_until($netloc, $fresh_until || (time + 365*24*3600));
  33.  
  34.     my $ua;
  35.     my $is_me = 0;        # 1 iff this record is for me
  36.     my $is_anon = 0;        # 1 iff this record is for *
  37.     my $seen_disallow = 0;      # watch for missing record separators
  38.     my @me_disallowed = ();    # rules disallowed for me
  39.     my @anon_disallowed = ();    # rules disallowed for *
  40.  
  41.     # blank lines are significant, so turn CRLF into LF to avoid generating
  42.     # false ones
  43.     $txt =~ s/\015\012/\012/g;
  44.  
  45.     # split at \012 (LF) or \015 (CR) (Mac text files have just CR for EOL)
  46.     for(split(/[\012\015]/, $txt)) {
  47.  
  48.     # Lines containing only a comment are discarded completely, and
  49.         # therefore do not indicate a record boundary.
  50.     next if /^\s*\#/;
  51.  
  52.     s/\s*\#.*//;        # remove comments at end-of-line
  53.  
  54.     if (/^\s*$/) {        # blank line
  55.         last if $is_me; # That was our record. No need to read the rest.
  56.         $is_anon = 0;
  57.         $seen_disallow = 0;
  58.     }
  59.         elsif (/^\s*User-Agent\s*:\s*(.*)/i) {
  60.         $ua = $1;
  61.         $ua =~ s/\s+$//;
  62.  
  63.         if ($seen_disallow) {
  64.         # treat as start of a new record
  65.         $seen_disallow = 0;
  66.         last if $is_me; # That was our record. No need to read the rest.
  67.         $is_anon = 0;
  68.         }
  69.  
  70.         if ($is_me) {
  71.         # This record already had a User-agent that
  72.         # we matched, so just continue.
  73.         }
  74.         elsif ($ua eq '*') {
  75.         $is_anon = 1;
  76.         }
  77.         elsif($self->is_me($ua)) {
  78.         $is_me = 1;
  79.         }
  80.     }
  81.     elsif (/^\s*Disallow\s*:\s*(.*)/i) {
  82.         unless (defined $ua) {
  83.         warn "RobotRules <$robot_txt_uri>: Disallow without preceding User-agent\n" if $^W;
  84.         $is_anon = 1;  # assume that User-agent: * was intended
  85.         }
  86.         my $disallow = $1;
  87.         $disallow =~ s/\s+$//;
  88.         $seen_disallow = 1;
  89.         if (length $disallow) {
  90.         my $ignore;
  91.         eval {
  92.             my $u = URI->new_abs($disallow, $robot_txt_uri);
  93.             $ignore++ if $u->scheme ne $robot_txt_uri->scheme;
  94.             $ignore++ if lc($u->host) ne lc($robot_txt_uri->host);
  95.             $ignore++ if $u->port ne $robot_txt_uri->port;
  96.             $disallow = $u->path_query;
  97.             $disallow = "/" unless length $disallow;
  98.         };
  99.         next if $@;
  100.         next if $ignore;
  101.         }
  102.  
  103.         if ($is_me) {
  104.         push(@me_disallowed, $disallow);
  105.         }
  106.         elsif ($is_anon) {
  107.         push(@anon_disallowed, $disallow);
  108.         }
  109.     }
  110.     else {
  111.         warn "RobotRules <$robot_txt_uri>: Unexpected line: $_\n" if $^W;
  112.     }
  113.     }
  114.  
  115.     if ($is_me) {
  116.     $self->push_rules($netloc, @me_disallowed);
  117.     }
  118.     else {
  119.     $self->push_rules($netloc, @anon_disallowed);
  120.     }
  121. }
  122.  
  123.  
  124. #
  125. # Returns TRUE if the given name matches the
  126. # name of this robot
  127. #
  128. sub is_me {
  129.     my($self, $ua_line) = @_;
  130.     my $me = $self->agent;
  131.  
  132.     # See whether my short-name is a substring of the
  133.     #  "User-Agent: ..." line that we were passed:
  134.     
  135.     if(index(lc($me), lc($ua_line)) >= 0) {
  136.       LWP::Debug::debug("\"$ua_line\" applies to \"$me\"")
  137.        if defined &LWP::Debug::debug;
  138.       return 1;
  139.     }
  140.     else {
  141.       LWP::Debug::debug("\"$ua_line\" does not apply to \"$me\"")
  142.        if defined &LWP::Debug::debug;
  143.       return '';
  144.     }
  145. }
  146.  
  147.  
  148. sub allowed {
  149.     my($self, $uri) = @_;
  150.     $uri = URI->new("$uri");
  151.     
  152.     return 1 unless $uri->scheme eq 'http' or $uri->scheme eq 'https';
  153.      # Robots.txt applies to only those schemes.
  154.     
  155.     my $netloc = $uri->host . ":" . $uri->port;
  156.  
  157.     my $fresh_until = $self->fresh_until($netloc);
  158.     return -1 if !defined($fresh_until) || $fresh_until < time;
  159.  
  160.     my $str = $uri->path_query;
  161.     my $rule;
  162.     for $rule ($self->rules($netloc)) {
  163.     return 1 unless length $rule;
  164.     return 0 if index($str, $rule) == 0;
  165.     }
  166.     return 1;
  167. }
  168.  
  169.  
  170. # The following methods must be provided by the subclass.
  171. sub agent;
  172. sub visit;
  173. sub no_visits;
  174. sub last_visits;
  175. sub fresh_until;
  176. sub push_rules;
  177. sub clear_rules;
  178. sub rules;
  179. sub dump;
  180.  
  181.  
  182.  
  183. package WWW::RobotRules::InCore;
  184.  
  185. use vars qw(@ISA);
  186. @ISA = qw(WWW::RobotRules);
  187.  
  188.  
  189.  
  190. sub agent {
  191.     my ($self, $name) = @_;
  192.     my $old = $self->{'ua'};
  193.     if ($name) {
  194.         # Strip it so that it's just the short name.
  195.         # I.e., "FooBot"                                      => "FooBot"
  196.         #       "FooBot/1.2"                                  => "FooBot"
  197.         #       "FooBot/1.2 [http://foobot.int; foo@bot.int]" => "FooBot"
  198.  
  199.     $name = $1 if $name =~ m/(\S+)/; # get first word
  200.     $name =~ s!/.*!!;  # get rid of version
  201.     unless ($old && $old eq $name) {
  202.         delete $self->{'loc'}; # all old info is now stale
  203.         $self->{'ua'} = $name;
  204.     }
  205.     }
  206.     $old;
  207. }
  208.  
  209.  
  210. sub visit {
  211.     my($self, $netloc, $time) = @_;
  212.     return unless $netloc;
  213.     $time ||= time;
  214.     $self->{'loc'}{$netloc}{'last'} = $time;
  215.     my $count = \$self->{'loc'}{$netloc}{'count'};
  216.     if (!defined $$count) {
  217.     $$count = 1;
  218.     }
  219.     else {
  220.     $$count++;
  221.     }
  222. }
  223.  
  224.  
  225. sub no_visits {
  226.     my ($self, $netloc) = @_;
  227.     $self->{'loc'}{$netloc}{'count'};
  228. }
  229.  
  230.  
  231. sub last_visit {
  232.     my ($self, $netloc) = @_;
  233.     $self->{'loc'}{$netloc}{'last'};
  234. }
  235.  
  236.  
  237. sub fresh_until {
  238.     my ($self, $netloc, $fresh_until) = @_;
  239.     my $old = $self->{'loc'}{$netloc}{'fresh'};
  240.     if (defined $fresh_until) {
  241.     $self->{'loc'}{$netloc}{'fresh'} = $fresh_until;
  242.     }
  243.     $old;
  244. }
  245.  
  246.  
  247. sub push_rules {
  248.     my($self, $netloc, @rules) = @_;
  249.     push (@{$self->{'loc'}{$netloc}{'rules'}}, @rules);
  250. }
  251.  
  252.  
  253. sub clear_rules {
  254.     my($self, $netloc) = @_;
  255.     delete $self->{'loc'}{$netloc}{'rules'};
  256. }
  257.  
  258.  
  259. sub rules {
  260.     my($self, $netloc) = @_;
  261.     if (defined $self->{'loc'}{$netloc}{'rules'}) {
  262.     return @{$self->{'loc'}{$netloc}{'rules'}};
  263.     }
  264.     else {
  265.     return ();
  266.     }
  267. }
  268.  
  269.  
  270. sub dump
  271. {
  272.     my $self = shift;
  273.     for (keys %$self) {
  274.     next if $_ eq 'loc';
  275.     print "$_ = $self->{$_}\n";
  276.     }
  277.     for (keys %{$self->{'loc'}}) {
  278.     my @rules = $self->rules($_);
  279.     print "$_: ", join("; ", @rules), "\n";
  280.     }
  281. }
  282.  
  283.  
  284. 1;
  285.  
  286. __END__
  287.  
  288.  
  289. # Bender: "Well, I don't have anything else
  290. #          planned for today.  Let's get drunk!"
  291.  
  292. =head1 NAME
  293.  
  294. WWW::RobotRules - database of robots.txt-derived permissions
  295.  
  296. =head1 SYNOPSIS
  297.  
  298.  use WWW::RobotRules;
  299.  my $rules = WWW::RobotRules->new('MOMspider/1.0');
  300.  
  301.  use LWP::Simple qw(get);
  302.  
  303.  {
  304.    my $url = "http://some.place/robots.txt";
  305.    my $robots_txt = get $url;
  306.    $rules->parse($url, $robots_txt) if defined $robots_txt;
  307.  }
  308.  
  309.  {
  310.    my $url = "http://some.other.place/robots.txt";
  311.    my $robots_txt = get $url;
  312.    $rules->parse($url, $robots_txt) if defined $robots_txt;
  313.  }
  314.  
  315.  # Now we can check if a URL is valid for those servers
  316.  # whose "robots.txt" files we've gotten and parsed:
  317.  if($rules->allowed($url)) {
  318.      $c = get $url;
  319.      ...
  320.  }
  321.  
  322. =head1 DESCRIPTION
  323.  
  324. This module parses F</robots.txt> files as specified in
  325. "A Standard for Robot Exclusion", at
  326. <http://www.robotstxt.org/wc/norobots.html>
  327. Webmasters can use the F</robots.txt> file to forbid conforming
  328. robots from accessing parts of their web site.
  329.  
  330. The parsed files are kept in a WWW::RobotRules object, and this object
  331. provides methods to check if access to a given URL is prohibited.  The
  332. same WWW::RobotRules object can be used for one or more parsed
  333. F</robots.txt> files on any number of hosts.
  334.  
  335. The following methods are provided:
  336.  
  337. =over 4
  338.  
  339. =item $rules = WWW::RobotRules->new($robot_name)
  340.  
  341. This is the constructor for WWW::RobotRules objects.  The first
  342. argument given to new() is the name of the robot.
  343.  
  344. =item $rules->parse($robot_txt_url, $content, $fresh_until)
  345.  
  346. The parse() method takes as arguments the URL that was used to
  347. retrieve the F</robots.txt> file, and the contents of the file.
  348.  
  349. =item $rules->allowed($uri)
  350.  
  351. Returns TRUE if this robot is allowed to retrieve this URL.
  352.  
  353. =item $rules->agent([$name])
  354.  
  355. Get/set the agent name. NOTE: Changing the agent name will clear the robots.txt
  356. rules and expire times out of the cache.
  357.  
  358. =back
  359.  
  360. =head1 ROBOTS.TXT
  361.  
  362. The format and semantics of the "/robots.txt" file are as follows
  363. (this is an edited abstract of
  364. <http://www.robotstxt.org/wc/norobots.html> ):
  365.  
  366. The file consists of one or more records separated by one or more
  367. blank lines. Each record contains lines of the form
  368.  
  369.   <field-name>: <value>
  370.  
  371. The field name is case insensitive.  Text after the '#' character on a
  372. line is ignored during parsing.  This is used for comments.  The
  373. following <field-names> can be used:
  374.  
  375. =over 3
  376.  
  377. =item User-Agent
  378.  
  379. The value of this field is the name of the robot the record is
  380. describing access policy for.  If more than one I<User-Agent> field is
  381. present the record describes an identical access policy for more than
  382. one robot. At least one field needs to be present per record.  If the
  383. value is '*', the record describes the default access policy for any
  384. robot that has not not matched any of the other records.
  385.  
  386. The I<User-Agent> fields must occur before the I<Disallow> fields.  If a
  387. record contains a I<User-Agent> field after a I<Disallow> field, that
  388. constitutes a malformed record.  This parser will assume that a blank
  389. line should have been placed before that I<User-Agent> field, and will
  390. break the record into two.  All the fields before the I<User-Agent> field
  391. will constitute a record, and the I<User-Agent> field will be the first
  392. field in a new record.
  393.  
  394. =item Disallow
  395.  
  396. The value of this field specifies a partial URL that is not to be
  397. visited. This can be a full path, or a partial path; any URL that
  398. starts with this value will not be retrieved
  399.  
  400. =back
  401.  
  402. =head1 ROBOTS.TXT EXAMPLES
  403.  
  404. The following example "/robots.txt" file specifies that no robots
  405. should visit any URL starting with "/cyberworld/map/" or "/tmp/":
  406.  
  407.   User-agent: *
  408.   Disallow: /cyberworld/map/ # This is an infinite virtual URL space
  409.   Disallow: /tmp/ # these will soon disappear
  410.  
  411. This example "/robots.txt" file specifies that no robots should visit
  412. any URL starting with "/cyberworld/map/", except the robot called
  413. "cybermapper":
  414.  
  415.   User-agent: *
  416.   Disallow: /cyberworld/map/ # This is an infinite virtual URL space
  417.  
  418.   # Cybermapper knows where to go.
  419.   User-agent: cybermapper
  420.   Disallow:
  421.  
  422. This example indicates that no robots should visit this site further:
  423.  
  424.   # go away
  425.   User-agent: *
  426.   Disallow: /
  427.  
  428. This is an example of a malformed robots.txt file.
  429.  
  430.   # robots.txt for ancientcastle.example.com
  431.   # I've locked myself away.
  432.   User-agent: *
  433.   Disallow: /
  434.   # The castle is your home now, so you can go anywhere you like.
  435.   User-agent: Belle
  436.   Disallow: /west-wing/ # except the west wing!
  437.   # It's good to be the Prince...
  438.   User-agent: Beast
  439.   Disallow: 
  440.  
  441. This file is missing the required blank lines between records.
  442. However, the intention is clear.
  443.  
  444. =head1 SEE ALSO
  445.  
  446. L<LWP::RobotUA>, L<WWW::RobotRules::AnyDBM_File>
  447.