]>
git.proxmox.com Git - pmg-api.git/blob - PMG/RuleDB/Disclaimer.pm
1 package PMG
:: RuleDB
:: Disclaimer
;
16 use PMG
:: RuleDB
:: Object
;;
18 use base
qw(PMG::RuleDB::Object) ;
41 return 'Add a Disclaimer' ;
56 my $std_discl = <<_EOD_;
57 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>
58 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>
59 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.
63 my ( $type, $value, $ogroup ) = @_ ;
65 my $class = ref ( $type ) || $type ;
67 $value // = $std_discl ;
69 my $self = $class -> SUPER :: new
( $class -> otype (), $ogroup );
71 $self ->{ value
} = $value ;
77 my ( $type, $ruledb, $id, $ogroup, $value ) = @_ ;
79 my $class = ref ( $type ) || $type ;
81 defined ( $value ) || croak
"undefined object attribute: ERROR" ;
83 my $obj = $class -> new ( $value, $ogroup );
87 $obj ->{ digest
} = Digest
:: SHA
:: sha1_hex
( $id, $value, $ogroup );
93 my ( $self, $ruledb ) = @_ ;
95 defined ( $self ->{ ogroup
}) || croak
"undefined object attribute: ERROR" ;
96 defined ( $self ->{ value
}) || croak
"undefined object attribute: ERROR" ;
98 if ( defined ( $self ->{ id
})) {
102 "UPDATE Object SET Value = ? WHERE ID = ?" ,
103 undef , $self ->{ value
}, $self ->{ id
});
108 my $sth = $ruledb ->{ dbh
}-> prepare (
109 "INSERT INTO Object (Objectgroup_ID, ObjectType, Value) " .
110 "VALUES (?, ?, ?);" );
112 $sth -> execute ( $self -> ogroup , $self -> otype , $self ->{ value
});
114 $self ->{ id
} = PMG
:: Utils
:: lastid
( $ruledb ->{ dbh
}, 'object_id_seq' );
121 my ( $self, $entity, $data ) = @_ ;
123 $entity -> bodyhandle || return undef ;
127 # always use the decoded data
128 if ( my $path = $entity ->{ PMX_decoded_path
}) {
129 $fh = IO
:: File-
> new ( "< $path " );
131 $fh = $entity -> open ( "r" );
134 return undef if ! $fh ;
136 # in memory (we cant modify the file, because
137 # a.) that would modify all entities (see ModGroup)
138 # b.) bad performance
139 my $body = new MIME
:: Body
:: InCore
|| return undef ;
141 my $newfh = $body -> open ( "w" ) || return undef ;
143 while ( defined ( $_ = $fh -> getline ())) {
144 $newfh -> print ( $_ ); # copy contents
147 $newfh -> print ( " \n " ); # add final \n
149 $newfh -> print ( $data );
151 $newfh -> close || return undef ;
153 $entity -> bodyhandle ( $body );
159 my ( $self, $entity, $html, $text ) = @_ ;
163 if ( $entity -> head -> mime_type =~ m{multipart/alternative} ) {
164 foreach my $p ( $entity -> parts ) {
165 $found = 1 if $self -> sign ( $p, $html, $text );
167 } elsif ( $entity -> head -> mime_type =~ m{multipart/} ) {
168 foreach my $p ( $entity -> parts ) {
169 if ( $self -> sign ( $p, $html, $text )) {
174 } elsif ( $entity -> head -> mime_type =~ m{text/} ) {
175 if ( $entity -> head -> mime_type =~ m{text/html} ) {
176 $self -> add_data ( $entity, $html );
178 } elsif ( $entity -> head -> mime_type =~ m{text/plain} ) {
179 my $cs = $entity -> head -> mime_attr ( "content-type.charset" );
181 my $enc_text = encode
( $cs, $text, Encode
:: FB_CROAK
);
182 $self -> add_data ( $entity, $enc_text );
184 # simply ignore if we can't represent the disclainer
188 # do nothing - unknown format
196 my ( $self, $queue, $ruledb, $mod_group, $targets,
197 $msginfo, $vars, $marks ) = @_ ;
199 my $subgroups = $mod_group -> subgroups ( $targets );
201 foreach my $ta ( @$subgroups ) {
202 my ( $tg, $entity ) = ( @$ta [ 0 ], @$ta [ 1 ]);
204 my $html = "<br>--<br>" . PMG
:: Utils
:: subst_values
( $self ->{ value
}, $vars );
207 my $parser = HTML
:: Parser-
> new (
208 api_version
=> 3 , text_h
=> [ sub { $text .= shift ;}, "dtext" ]);
214 $parser -> parse ( $tmp );
217 $self -> sign ( $entity, " $html\n " , " $text\n " );
234 =head1 PMG::RuleDB::Disclaimer