]> git.somenet.org - irc/bugbot.git/blob - BotModules/WWW.bm
GITOLITE.txt
[irc/bugbot.git] / 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 }