root/Apache-AntiSpam/trunk/lib/Apache/AntiSpam.pm

Revision 90 (checked in by miyagawa, 19 years ago)

make subclassing possible
added FilterTest?

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1 package Apache::AntiSpam;
2
3 use strict;
4 use vars qw($VERSION);
5 $VERSION = '0.04';
6
7 use Apache::Constants qw(:common);
8 use Apache::File;
9 use Carp ();
10 use Email::Find 0.04;
11
12 sub handler ($$) {
13     my($class, $r) = @_;
14
15     my $filtered = uc($r->dir_config('Filter')) eq 'ON';
16
17     # makes Apache::Filter aware
18     # snippets stolen from Geoffrey Young's Apache::Clean
19     $r = $r->filter_register if $filtered;
20
21     # AntiSpam filtering is done on text/* files
22     return DECLINED unless ($r->content_type =~ m,^text/, && $r->is_main);
23    
24     my($fh, $status);
25     if ($filtered) {
26         ($fh, $status) = $r->filter_input;
27         undef $fh unless $status == OK;
28     } else {
29         $fh = Apache::File->new($r->filename);
30     }
31
32     return DECLINED unless $fh;
33    
34     # finds and replaces e-mail addresses
35     # if-statement should be outside the sub for efficiency
36     my $replacer;
37     if (uc($r->dir_config('AntiSpamFormat')) eq 'SPACES') {
38         $replacer = sub {
39             my($email, $orig) = @_;
40             $orig =~ s/\@/ at /g;
41             $orig =~ s/\./ dot /g;
42             $orig =~ s/\-/ bar /g;
43             $orig =~ s/  */ /g;
44             return $orig;
45         };
46     } else {
47         $replacer = sub {
48             my($email, $orig) = @_;
49             $orig =~ s/\@/-nospam\@/;
50             return $orig;
51         };
52     }
53
54     $r->send_http_header;
55
56     local $/;           # slurp
57     my $input = <$fh>;
58     find_emails($input, sub { $class->antispamize(@_) });
59     $r->print($input);
60
61     return OK;
62 }   
63
64 sub antispamize {
65     my($class, $email, $orig) = @_;
66     Carp::carp "Apache::AntiSpam should be subclassed. I'll do nothing";
67     return $orig;
68 }
69    
70
71 1;
72 __END__
73
74 =head1 NAME
75
76 Apache::AntiSpam - AntiSpam filter for web pages
77
78 =head1 SYNOPSIS
79
80   # You can't use this class directry
81   # see Apache::AntiSpam::*
82
83   # or ... if you want your own AntiSpam Filter,
84   package Your::AntiSpamFilter;
85   use base qw(Apache::AntiSpam);
86
87   sub antispamize {
88       my($class, $email, $orig) = @_;
89       # do some filtering with $orig, and
90       return $orig;
91   }
92
93   # in httpd.conf
94   <Location /antispam>
95   SetHandler perl-script
96   PerlHandler Your::AntiSpamFilter
97   </Location>
98
99   # filter aware
100   PerlModule Apache::Filter
101   SetHandler perl-script
102   PerlSetVar Filter On
103   PerlHandler Apache::RegistryFilter Your::AntiSpamFilter Apache::Compress
104
105 =head1 DESCRIPTION
106
107 Apache::AntiSpam is a filter module to prevent e-mail addresses
108 exposed as is on web pages. The way to hide addresses from spammers
109 are implemented in each of Apache::Antispam::* subclasses.
110
111 This module is Filter aware, meaning that it can work within
112 Apache::Filter framework without modification.
113
114 =head1 SUBCLASSING
115
116 Here is how to make your own filter.
117
118 =over 4
119
120 =item Declare your class
121
122 =item Inherit from Apache::AntiSpam
123
124 =item define antispamize() method
125
126 =back
127
128 That's all. Template of antispamize() method will be like this:
129
130   sub antispamize {
131       my($class, $email, $orig) = @_;
132       # do some stuff..
133       return $orig;
134   }
135
136 where C<$class> is your class, C<$email> is an instance of
137 Mail::Address, and C<$orig> is an original e-mail address string. See
138 L<Email::Find> for details.
139
140 =head1 TODO
141
142 =over 4
143
144 =item *
145
146 remove mailto: tags using HTML::Parser.
147
148 =back
149
150 =head1 ACKNOWLEDGEMENTS
151
152 The idea of this module is stolen from Apache::AddrMunge by Mark J
153 Dominus. See http://perl.plover.com/AddrMunge/ for details.
154
155 Many thanks to Michael G. Schwern for kindly improving the matching
156 speed of Email::Find.
157
158 =head1 AUTHOR
159
160 Tatsuhiko Miyagawa <miyagawa@bulknews.net>
161
162 This library is free software; you can redistribute it and/or modify
163 it under the same terms as Perl itself.
164
165 =head1 SEE ALSO
166
167 L<Email::Find>, L<Apache::Filter>, L<Apache::AntiSpam::NoSpam>,
168 L<Apache::AntiSpam::Heuristic>, L<Apache::AntiSpam::HTMLEncode>.
169
170 =cut
Note: See TracBrowser for help on using the browser.