File Coverage

blib/lib/Mail/IspMailGate/Filter/Banner.pm
Criterion Covered Total %
statement 3 102 2.9
branch 0 44 0.0
condition 0 18 0.0
subroutine 1 12 8.3
pod 3 6 50.0
total 7 182 3.8


line stmt bran cond sub pod time code
1             # -*- perl -*-
2             #
3              
4             require 5.004;
5 1     1   1088 use strict;
  1         4  
  1         1546  
6              
7             require Mail::IspMailGate::Filter;
8              
9              
10             package Mail::IspMailGate::Filter::Banner;
11              
12             $Mail::IspMailGate::Filter::Banner::VERSION = "1.000";
13             @Mail::IspMailGate::Filter::Banner::ISA = qw(Mail::IspMailGate::Filter);
14              
15              
16 0     0 1   sub getSign { "X-ispMailGateFilter-Banner"; };
17              
18              
19             #####################################################################
20             #
21             # Name: setEncoding
22             #
23             # Purpse: set a reasonable encoding type, for the filtered mail
24             #
25             # Inputs: $self - This class
26             # $entity - The entity
27             #
28             # Returns: error-message if any
29             #
30             #####################################################################
31              
32             sub setEncoding ($$$) {
33 0     0 0   my ($self, $entity) = @_;
34 0           my ($head) = $entity->head();
35            
36 0           '';
37             }
38              
39              
40             #####################################################################
41             #
42             # Name: hookFilter
43             #
44             # Purpose: a function which is called after the filtering process
45             #
46             # Inputs: $self - This class
47             # $entity - the whole message
48             #
49             #
50             # Returns: errormessage if any
51             #
52             #####################################################################
53              
54             sub hookFilter ($$) {
55 0     0 1   my($self, $entity) = @_;
56 0           '';
57             }
58              
59              
60             #####################################################################
61             #
62             # Name: doFilter
63             #
64             # Purpose: does the filtering process
65             #
66             # Inputs: $self - This class
67             # $attr - a hash ref to the attributes
68             # Following things are needed !!!!
69             # 1) 'entity': a ref to the Entity object
70             # 2) 'parser': a ref to a Parser object
71             #
72             # Returns: error message, if any
73             #
74             #####################################################################
75              
76             sub BannerPLAIN ($$$) {
77 0     0 0   my($self, $banner, $contents) = @_;
78 0           "\r\n$banner\r\n$contents";
79             }
80              
81             sub BannerHTML ($$$) {
82 0     0 0   my($self, $banner, $contents) = @_;
83 0           require HTML::Parser;
84              
85 0 0         if (!defined($banner)) {
86 0           return $contents;
87             }
88              
89             # First scan: Try to find a body tag and put the banner behind
90             # the body tag.
91 0           my $parser = Mail::IspMailGate::Filter::Banner::HTML_Parser->new();
92 0           $parser->{_banner_body} = $banner;
93 0           $parser->{_banner_output} = '';
94 0           $parser->parse($contents);
95 0           $parser->eof();
96 0 0         if (!defined($parser->{_banner_body})) {
97 0           return $parser->{_banner_output};
98             }
99              
100             # No body tag found. Did we find a head tag? If so, restart and put
101             # the banner behind the /head.
102 0 0         if ($parser->{_banner_head_found}) {
103 0           my $parser = Mail::IspMailGate::Filter::Banner::HTML_Parser->new();
104 0           $parser->{_banner_head} = $banner;
105 0           $parser->{_banner_output} = '';
106 0           $parser->parse($contents);
107 0           $parser->eof();
108 0           return $parser->{_banner_output};
109             }
110              
111             # No body tag and no head tag. Sigh. Put the banner right behind
112             # the HTML tag.
113 0 0         if ($parser->{_banner_html_found}) {
114 0           my $parser = Mail::IspMailGate::Filter::Banner::HTML_Parser->new();
115 0           $parser->{_banner_html} = $banner;
116 0           $parser->{_banner_output} = '';
117 0           $parser->parse($contents);
118 0           $parser->eof();
119 0           return $parser->{_banner_output};
120             }
121              
122             # Give up...
123 0           $contents;
124             }
125              
126              
127             sub doFilter ($$) {
128 0     0 1   my($self, $attr) = @_;
129 0           my ($entity) = $attr->{'entity'};
130              
131 0           my $parser = $attr->{'parser'};
132              
133 0           my $type = $entity->mime_type();
134              
135 0 0         if (!$type) {
136 0           return '';
137             }
138              
139 0           my ($mult) = $entity->is_multipart();
140 0 0         if (!defined($mult)) {
141 0           die "Could not determine if the Entity is multipart or not";
142             }
143              
144 0 0         if ($mult) {
145 0           my $part;
146 0 0         my $globHead = exists($attr->{'globHead'}) ?
147             $attr->{'globHead'} : $entity->{'head'};
148 0           my $main = $attr->{'main'};
149 0           my $parser = $attr->{'parser'};
150 0           my @parts;
151 0 0         if ($type eq 'multipart/alternative') {
152             # Try any part
153 0           @parts = $entity->parts();
154             } else {
155             # Try the first part only
156 0           push(@parts, $entity->parts(0));
157             }
158 0           foreach $part (@parts) {
159 0 0         if (!$part) {
160 0           next;
161             }
162 0           $self->doFilter({'entity' => $part,
163             'parser' => $parser,
164             'globHead' => $globHead,
165             'main' => $main});
166             }
167             } else {
168 0 0         if ($type =~ /^text\/(html|plain)$/) {
169 0           $type = $1;
170 0           my $file = $self->{$type};
171 0 0         if (defined($file)) {
172 0           my $fh;
173             my $banner;
174 0           local $/ = undef;
175 0 0         if (ref($file)) {
176 0           $fh = $file; # For testing and debugging
177 0           $banner = $fh->getline();
178             } else {
179 0 0         if (!-f $file) {
180 0           return '';
181             }
182 0           require Symbol;
183 0           $fh = Symbol::gensym();
184 0 0         if (!open($fh, "<$file")) {
185 0           return '';
186             }
187 0           $banner = <$fh>;
188             }
189 0           my $method = "Banner" . (uc $type);
190 0 0         if (defined($banner)) {
191 0           my $contents;
192 0           my $io = Symbol::gensym();
193 0           my $path = $entity->bodyhandle()->path();
194 0 0 0       if ($path &&
      0        
      0        
      0        
      0        
195             (!open($io, "+<$path")) ||
196             !defined($contents = <$io>) ||
197             !seek($io,0,0) ||
198             !(print $io ($self->$method($banner, $contents))) ||
199             !close($io)) {
200 0           die "Error while adding banner to $path: $!";
201             }
202             }
203             }
204             }
205             }
206              
207 0           '';
208             }
209              
210              
211             package Mail::IspMailGate::Filter::Banner::HTML_Parser;
212              
213             @Mail::IspMailGate::Filter::Banner::HTML_Parser::ISA = qw(HTML::Parser);
214              
215              
216             sub declaration ($$) {
217 0     0     my($self, $decl) = @_;
218 0           $self->{_banner_output} .= "";
219             }
220              
221             sub start ($$) {
222 0     0     my($self, $tag, $attr, $attrseq, $origtext) = @_;
223 0 0 0       if ((lc $tag) eq 'body' && defined($self->{_banner_body})) {
    0          
224 0           $origtext .= "\r\n" . (delete $self->{_banner_body}) . "\r\n";
225             } elsif ((lc $tag) eq 'html') {
226 0           $self->{_banner_html_found} = 1;
227 0 0         if (defined($self->{_banner_html})) {
228 0           $origtext .= "\r\n" . (delete $self->{_banner_html}) . "\r\n";
229             }
230             }
231 0           $self->{_banner_output} .= $origtext;
232             }
233              
234             sub end ($$) {
235 0     0     my($self, $tag, $origtext) = @_;
236 0 0         if ((lc $tag) eq 'head') {
237 0           $self->{_banner_head_found} = 1;
238 0 0         if (defined($self->{_banner_head})) {
239 0           $origtext .= "\r\n" . (delete $self->{_banner_head}) . "\r\n";
240             }
241             }
242 0           $self->{_banner_output} .= $origtext;
243             }
244              
245             sub text ($$) {
246 0     0     my($self, $text) = @_;
247 0           $self->{_banner_output} .= $text;
248             }
249              
250             sub comment ($$) {
251 0     0     my($self, $comment) = @_;
252 0           $self->{_banner_output} .= "";
253             }
254              
255              
256             1;
257              
258              
259             __END__