BotModules/WWW.bm

   1 ################################
   2 # WWW Module                   #
   3 ################################
   4
   5 package BotModules::WWW;
   6 use vars qw(@ISA);
   7 # Need HTML::Entities for decode_entities() in wwwtitle
   8 use HTML::Entities;
   9 @ISA = qw(BotModules);
  10 1;
  11
  12 # RegisterConfig - Called when initialised, should call registerVariables
  13 sub RegisterConfig {
  14     my $self = shift;
  15     $self->SUPER::RegisterConfig(@_);
  16     # $self->registerVariables(
  17     #   # [ name, save?, settable? ]
  18     #     ['x', 1, 1, 0],
  19     # );
  20 }
  21
  22 sub Help {
  23     my $self = shift;
  24     my ($event) = @_;
  25     return {
  26         '' => 'The WWW module provides a web interface.',
  27         'wwwsize' => 'Reports on the size of a webpage. Syntax: \'wwwsize http://...\'',
  28         'wwwlint' => 'Reports on whether the webpage contains any obvious (I mean _really_ obvious) no-nos like <layer> or document.all. Syntax: \'wwwlint http://...\'',
  29         'wwwdoctype' => 'Reports on the doctype of a webpage. (Warning: Does not check that the doctype is not commented out!) Syntax: \'wwwdoctype http://...\'',
  30         'wwwtitle' => 'Tries to heuristically determine a web page\'s title. Syntax: \'wwwtitle http://...\'',
  31     };
  32 }
  33
  34 sub Told {
  35     my $self = shift;
  36     my ($event, $message) = @_;
  37     if ($message =~ /^\s*wwwsize\s+(.+?)\s*$/osi) {
  38         $self->Fetch($event, $1, 'size');
  39     } elsif ($message =~ /^\s*wwwlint\s+(.+?)\s*$/osi) {
  40         $self->Fetch($event, $1, 'lint');
  41     } elsif ($message =~ /^\s*wwwdoctype\s+(.+?)\s*$/osi) {
  42         $self->Fetch($event, $1, 'doctype');
  43     } elsif ($message =~ /^\s*wwwtitle\s+(.+?)\s*$/osi) {
  44         $self->Fetch($event, $1, 'title');
  45     } else {
  46         return $self->SUPER::Told(@_);
  47     }
  48     return 0; # dealt with it...
  49 }
  50
  51 sub Fetch {
  52     my $self = shift;
  53     my ($event, $uri, $type) = @_;
  54     $self->getURI($event, $uri, $type);
  55 }
  56
  57 sub GotURI {
  58     my $self = shift;
  59     my ($event, $uri, $output, $type) = @_;
  60     my $chars = length($output);
  61     if ($type eq 'size') {
  62         if ($chars) {
  63             $self->say($event, "$uri is $chars bytes long.");
  64         } else {
  65             $self->say($event, "$uri is either empty, or I could not download it.");
  66         }
  67     } elsif ($type eq 'lint') {
  68         # ignore whether things are commented out or not.
  69         unless ($chars) {
  70             $self->say($event, "$uri is either empty, or I could not download it.");
  71         } else {
  72             my @status;
  73             if ($output =~ /document\.all/os) {
  74                push(@status, 'document.all');
  75             }
  76             if ($output =~ /document\.layers/os) {
  77                push(@status, 'document.layers');
  78             }
  79             if ($output =~ /<i?layer/osi) {
  80                push(@status, 'the <layer> tag');
  81             }
  82             if (@status) {
  83                 my $status = shift(@status);
  84                 if (@status) {
  85                     while (scalar(@status) > 1) {
  86                         $status .= ', '.shift(@status);
  87                     }
  88                     $status .= ' and '.shift(@status);
  89                 }
  90                 $self->say($event, "$uri contains $status.");
  91             } else {
  92                 $self->say($event, "$uri doesn't have any _obvious_ flaws..."); # XXX doesn't work! try php.net
  93             }
  94         }
  95     } elsif ($type eq 'doctype') {
  96         # assume doctype is not commented.
  97         unless ($chars) {
  98             $self->say($event, "$uri is either empty, or I could not download it.");
  99         } elsif ($output =~ /(<!DOCTYPE\s[^>]*>)/osi) {
 100             my $doctype = $1;
 101             $doctype =~ s/[\n\r]+/ /gosi;
 102
 103             # -- #mozilla was here --
 104             #      <Hixie> it would break 99% of the web if we didn't do it that way.
 105             #      <Hixie> including most of my test cases ;-)
 106             #     <dbaron> test cases don't matter...
 107             #     <dbaron> you'll fix them if we decide they're wrong
 108             #     <dbaron> but the web is a problem
 109
 110             if (length($doctype) > 220) { # arbitrary length greater than two 80 character lines
 111                 $self->say($event, "$uri has a very long and possibly corrupted doctype (maybe it has an internal subset).");
 112             } else {
 113                 $self->say($event, "$uri has the following doctype: $doctype");
 114             }
 115         } else {
 116             $self->say($event, "$uri has no specified doctype.");
 117         }
 118     } elsif ($type eq 'title') {
 119         # assume doctype is not commented.
 120         unless ($chars) {
 121             $self->say($event, "$uri is either empty, or I could not download it.");
 122         } elsif ($output =~ /<title\s*>(.*?)<\/title\s*>/osi or
 123                  $output =~ /<h1\s*>(.*?)<\/h1\s*>/osi) {
 124             my $title = $1;
 125             $title =~ s/\s+/ /gosi;
 126             if (length($title) > 100) { # arbitrary length
 127                 $title = substr($title, 0, 100) . '...';
 128             }
 129             $self->say($event, "$uri has the following title: " . decode_entities($title));
 130         } else {
 131             $self->say($event, "$uri has no specified title.");
 132         }
 133     } else {
 134         return $self->SUPER::GotURI(@_);
 135     }
 136 }