0 package Apache::AdBlocker;
1
2 use strict;
3 use vars qw(@ISA $VERSION);
4 use Apache::Constants qw(:common);
5 use GD ();
6 use Image::Size qw(imgsize);
7 use LWP::UserAgent ();
8
9 @ISA = qw(LWP::UserAgent);
10 $VERSION = ’1.00’;
11
12 my $UA = __PACKAGE__->new;
13 $UA->agent(join "/", __PACKAGE__, $VERSION);
14 my $Ad = join "|", qw{ads? advertisements? banners? adv promotions?};
15
16 sub handler {
17 my($r) = @_;
18 return DECLINED unless $r->proxyreq;
19 $r->handler("perl-script"); # Okay, let’s do it
20 $r->push_handlers(PerlHandler => \&proxy_handler);
21 return OK;
22 }
23
24 sub proxy_handler {
25 my ($r) = @_;
26
27 my $request = HTTP::Request->new($r->method => $r->uri);
28 my %headers_in = $r->headers_in;
29
30 while (my($key,$val) = each %headers_in) {
31 $request->header($key,$val);
32 }
33
34 if($r->method eq ’POST’) {
35 my $len = $r->header_in(’Content-length’);
36 my $buf;
37 $r->read($buf, $len);
38 $request->content($buf);
39 }
40
41 my $response = $UA->request($request);
42 $r->content_type($response->header(’Content-type’));
43
44 # Feed response back into our request
45 $r->status($response->code);
46 $r->status_line(join " ", $response->code, $response->message);
47 $response->scan(sub {
48 $r->header_out(@_);
49 });
50
51 $r->send_http_header();
52 my $content = \$response->content;
53
54 if ($r->content_type =~ /^image/ && $r->uri =~ /\b($Ad)\b/i) {
55 $r->content_type("image/gif");
56 block_ad($content);
57 }
58
59 $r->print($$content);
60
61 return OK;
62 }
63
64 sub block_ad {
65 my $data = shift;
66 my($x, $y) = imgsize($data);
67
68 my $im = GD::Image->new($x,$y);
69
70 my $white = $im->colorAllocate(255, 255, 255);
71 my $black = $im->colorAllocate(0, 0, 0 );
72 my $red = $im->colorAllocate(255, 0, 0 );
73
74 $im->transparent($white);
75 $im->string(GD::gdLargeFont(), 5, 5, "Blocked Ad", $red);
76 $im->rectangle(0, 0, $x-1, $y-1, $black);
77
78 $$data = $im->gif;
79 }
80
81 1;
82
83 __END__