]>
Commit | Line | Data |
---|---|---|
758c7b6b DM |
1 | package PMG::RuleDB::Disclaimer; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
758c7b6b DM |
5 | use DBI; |
6 | use Digest::SHA; | |
7 | use HTML::Parser; | |
8 | use HTML::Entities; | |
9 | use MIME::Body; | |
10 | use IO::File; | |
11 | use Encode; | |
12 | ||
13 | use PMG::Utils; | |
14 | use PMG::ModGroup; | |
15 | use PMG::RuleDB::Object;; | |
16 | ||
17 | use base qw(PMG::RuleDB::Object); | |
18 | ||
19 | sub otype { | |
20 | return 4009; | |
21 | } | |
22 | ||
23 | sub oclass { | |
24 | return 'action'; | |
25 | } | |
26 | ||
27 | sub otype_text { | |
28 | return 'Disclaimer'; | |
29 | } | |
30 | ||
758c7b6b DM |
31 | sub oisedit { |
32 | return 1; | |
33 | } | |
34 | ||
35 | sub final { | |
36 | return 0; | |
37 | } | |
38 | ||
39 | sub priority { | |
40 | return 49; | |
41 | } | |
42 | ||
43 | my $std_discl = <<_EOD_; | |
44 | This e-mail and any attached files are confidential and may be legally privileged. If you are not the addressee, any disclosure, reproduction, copying, distribution, or other dissemination or use of this communication is strictly prohibited. If you have received this transmission in error please notify the sender immediately and then delete this mail.<br> | |
45 | E-mail transmission cannot be guaranteed to be secure or error free as information could be intercepted, corrupted, lost, destroyed, arrive late or incomplete, or contain viruses. The sender therefore does not accept liability for any errors or omissions in the contents of this message which arise as a result of e-mail transmission or changes to transmitted date not specifically approved by the sender.<br> | |
46 | If this e-mail or attached files contain information which do not relate to our professional activity we do not accept liability for such information. | |
47 | _EOD_ | |
48 | ||
49 | sub new { | |
50 | my ($type, $value, $ogroup) = @_; | |
51 | ||
52 | my $class = ref($type) || $type; | |
53 | ||
54 | $value //= $std_discl; | |
55 | ||
7a2cf7e6 | 56 | my $self = $class->SUPER::new($class->otype(), $ogroup); |
758c7b6b DM |
57 | |
58 | $self->{value} = $value; | |
59 | ||
60 | return $self; | |
61 | } | |
62 | ||
63 | sub load_attr { | |
64 | my ($type, $ruledb, $id, $ogroup, $value) = @_; | |
65 | ||
66 | my $class = ref($type) || $type; | |
67 | ||
9ef3f143 | 68 | defined($value) || die "undefined object attribute: ERROR"; |
758c7b6b DM |
69 | |
70 | my $obj = $class->new($value, $ogroup); | |
71 | ||
72 | $obj->{id} = $id; | |
73 | ||
74 | $obj->{digest} = Digest::SHA::sha1_hex($id, $value, $ogroup); | |
75 | ||
76 | return $obj; | |
77 | } | |
78 | ||
79 | sub save { | |
80 | my ($self, $ruledb) = @_; | |
81 | ||
9ef3f143 DM |
82 | defined($self->{ogroup}) || die "undefined object attribute: ERROR"; |
83 | defined($self->{value}) || die "undefined object attribute: ERROR"; | |
758c7b6b DM |
84 | |
85 | if (defined ($self->{id})) { | |
86 | # update | |
87 | ||
88 | $ruledb->{dbh}->do( | |
89 | "UPDATE Object SET Value = ? WHERE ID = ?", | |
90 | undef, $self->{value}, $self->{id}); | |
91 | ||
92 | } else { | |
93 | # insert | |
94 | ||
95 | my $sth = $ruledb->{dbh}->prepare( | |
96 | "INSERT INTO Object (Objectgroup_ID, ObjectType, Value) " . | |
97 | "VALUES (?, ?, ?);"); | |
98 | ||
99 | $sth->execute($self->ogroup, $self->otype, $self->{value}); | |
100 | ||
101 | $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq'); | |
102 | } | |
103 | ||
104 | return $self->{id}; | |
105 | } | |
106 | ||
107 | sub add_data { | |
108 | my ($self, $entity, $data) = @_; | |
109 | ||
110 | $entity->bodyhandle || return undef; | |
111 | ||
112 | my $fh; | |
113 | ||
114 | # always use the decoded data | |
115 | if (my $path = $entity->{PMX_decoded_path}) { | |
116 | $fh = IO::File->new("<$path"); | |
117 | } else { | |
118 | $fh = $entity->open("r"); | |
119 | } | |
120 | ||
121 | return undef if !$fh; | |
122 | ||
123 | # in memory (we cant modify the file, because | |
124 | # a.) that would modify all entities (see ModGroup) | |
125 | # b.) bad performance | |
126 | my $body = new MIME::Body::InCore || return undef; | |
127 | ||
128 | my $newfh = $body->open ("w") || return undef; | |
129 | ||
130 | while (defined($_ = $fh->getline())) { | |
131 | $newfh->print($_); # copy contents | |
132 | } | |
133 | ||
134 | $newfh->print("\n"); # add final \n | |
135 | ||
136 | $newfh->print($data); | |
137 | ||
138 | $newfh->close || return undef; | |
139 | ||
140 | $entity->bodyhandle($body); | |
141 | ||
142 | return 1; | |
143 | } | |
144 | ||
145 | sub sign { | |
146 | my ($self, $entity, $html, $text) = @_; | |
147 | ||
148 | my $found = 0; | |
149 | ||
150 | if ($entity->head->mime_type =~ m{multipart/alternative}) { | |
151 | foreach my $p ($entity->parts) { | |
152 | $found = 1 if $self->sign ($p, $html, $text); | |
153 | } | |
154 | } elsif ($entity->head->mime_type =~ m{multipart/}) { | |
155 | foreach my $p ($entity->parts) { | |
156 | if ($self->sign ($p, $html, $text)) { | |
157 | $found = 1; | |
158 | last; | |
159 | } | |
160 | } | |
161 | } elsif ($entity->head->mime_type =~ m{text/}) { | |
162 | if ($entity->head->mime_type =~ m{text/html}) { | |
163 | $self->add_data ($entity, $html); | |
164 | $found = 1; | |
165 | } elsif ($entity->head->mime_type =~ m{text/plain}) { | |
166 | my $cs = $entity->head->mime_attr("content-type.charset"); | |
167 | eval { | |
168 | my $enc_text = encode($cs, $text, Encode::FB_CROAK); | |
169 | $self->add_data($entity, $enc_text); | |
170 | }; | |
171 | # simply ignore if we can't represent the disclainer | |
172 | # with that encoding | |
173 | $found = 1; | |
174 | } else { | |
175 | # do nothing - unknown format | |
176 | } | |
177 | } | |
178 | ||
179 | return $found; | |
180 | } | |
181 | ||
182 | sub execute { | |
183 | my ($self, $queue, $ruledb, $mod_group, $targets, | |
184 | $msginfo, $vars, $marks) = @_; | |
185 | ||
186 | my $subgroups = $mod_group->subgroups($targets); | |
187 | ||
188 | foreach my $ta (@$subgroups) { | |
189 | my ($tg, $entity) = (@$ta[0], @$ta[1]); | |
190 | ||
191 | my $html = "<br>--<br>" . PMG::Utils::subst_values ($self->{value}, $vars); | |
192 | ||
193 | my $text = ""; | |
194 | my $parser = HTML::Parser->new( | |
195 | api_version => 3, text_h => [ sub {$text .= shift;}, "dtext" ]); | |
196 | ||
197 | my $tmp = $html; | |
198 | $tmp =~ s/\r?\n//g; | |
199 | $tmp =~ s/<br>/\n/g; | |
200 | ||
201 | $parser->parse($tmp); | |
202 | $parser->eof; | |
203 | ||
204 | $self->sign($entity, "$html\n", "$text\n"); | |
205 | ||
206 | return; | |
207 | } | |
208 | } | |
209 | ||
210 | sub short_desc { | |
211 | my $self = shift; | |
212 | ||
213 | return "disclaimer"; | |
214 | } | |
215 | ||
f1d2c9e5 DC |
216 | sub properties { |
217 | my ($class) = @_; | |
218 | ||
219 | return { | |
220 | disclaimer => { | |
221 | description => "The Disclaimer", | |
222 | type => 'string', | |
223 | maxLength => 2048, | |
224 | }, | |
225 | }; | |
226 | } | |
227 | ||
228 | sub get { | |
229 | my ($self) = @_; | |
230 | ||
231 | return { | |
232 | disclaimer => $self->{value}, | |
233 | }; | |
234 | } | |
235 | ||
236 | sub update { | |
237 | my ($self, $param) = @_; | |
238 | ||
239 | $self->{value} = $param->{disclaimer}; | |
240 | } | |
758c7b6b DM |
241 | |
242 | 1; | |
243 | ||
244 | __END__ | |
245 | ||
246 | =head1 PMG::RuleDB::Disclaimer | |
247 | ||
248 | Add disclaimer. |