]>
git.proxmox.com Git - pmg-api.git/blob - PMG/RuleDB/Disclaimer.pm
1 package PMG
:: RuleDB
:: Disclaimer
;
15 use PMG
:: RuleDB
:: Object
;;
17 use base
qw(PMG::RuleDB::Object) ;
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.
50 my ( $type, $value, $ogroup ) = @_ ;
52 my $class = ref ( $type ) || $type ;
54 $value // = $std_discl ;
56 my $self = $class -> SUPER :: new
( $class -> otype (), $ogroup );
58 $self ->{ value
} = $value ;
64 my ( $type, $ruledb, $id, $ogroup, $value ) = @_ ;
66 my $class = ref ( $type ) || $type ;
68 defined ( $value ) || die "undefined object attribute: ERROR" ;
70 my $obj = $class -> new ( $value, $ogroup );
74 $obj ->{ digest
} = Digest
:: SHA
:: sha1_hex
( $id, $value, $ogroup );
80 my ( $self, $ruledb ) = @_ ;
82 defined ( $self ->{ ogroup
}) || die "undefined object attribute: ERROR" ;
83 defined ( $self ->{ value
}) || die "undefined object attribute: ERROR" ;
85 if ( defined ( $self ->{ id
})) {
89 "UPDATE Object SET Value = ? WHERE ID = ?" ,
90 undef , $self ->{ value
}, $self ->{ id
});
95 my $sth = $ruledb ->{ dbh
}-> prepare (
96 "INSERT INTO Object (Objectgroup_ID, ObjectType, Value) " .
99 $sth -> execute ( $self -> ogroup , $self -> otype , $self ->{ value
});
101 $self ->{ id
} = PMG
:: Utils
:: lastid
( $ruledb ->{ dbh
}, 'object_id_seq' );
108 my ( $self, $entity, $data ) = @_ ;
110 $entity -> bodyhandle || return undef ;
114 # always use the decoded data
115 if ( my $path = $entity ->{ PMX_decoded_path
}) {
116 $fh = IO
:: File-
> new ( "< $path " );
118 $fh = $entity -> open ( "r" );
121 return undef if ! $fh ;
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 ;
128 my $newfh = $body -> open ( "w" ) || return undef ;
130 while ( defined ( $_ = $fh -> getline ())) {
131 $newfh -> print ( $_ ); # copy contents
134 $newfh -> print ( " \n " ); # add final \n
136 $newfh -> print ( $data );
138 $newfh -> close || return undef ;
140 $entity -> bodyhandle ( $body );
146 my ( $self, $entity, $html, $text ) = @_ ;
150 if ( $entity -> head -> mime_type =~ m{multipart/alternative} ) {
151 foreach my $p ( $entity -> parts ) {
152 $found = 1 if $self -> sign ( $p, $html, $text );
154 } elsif ( $entity -> head -> mime_type =~ m{multipart/} ) {
155 foreach my $p ( $entity -> parts ) {
156 if ( $self -> sign ( $p, $html, $text )) {
161 } elsif ( $entity -> head -> mime_type =~ m{text/} ) {
162 if ( $entity -> head -> mime_type =~ m{text/html} ) {
163 $self -> add_data ( $entity, $html );
165 } elsif ( $entity -> head -> mime_type =~ m{text/plain} ) {
166 my $cs = $entity -> head -> mime_attr ( "content-type.charset" );
168 my $enc_text = encode
( $cs, $text, Encode
:: FB_CROAK
);
169 $self -> add_data ( $entity, $enc_text );
171 # simply ignore if we can't represent the disclainer
175 # do nothing - unknown format
183 my ( $self, $queue, $ruledb, $mod_group, $targets,
184 $msginfo, $vars, $marks ) = @_ ;
186 my $subgroups = $mod_group -> subgroups ( $targets );
188 foreach my $ta ( @$subgroups ) {
189 my ( $tg, $entity ) = ( @$ta [ 0 ], @$ta [ 1 ]);
191 my $html = "<br>--<br>" . PMG
:: Utils
:: subst_values
( $self ->{ value
}, $vars );
194 my $parser = HTML
:: Parser-
> new (
195 api_version
=> 3 , text_h
=> [ sub { $text .= shift ;}, "dtext" ]);
201 $parser -> parse ( $tmp );
204 $self -> sign ( $entity, " $html\n " , " $text\n " );
221 description
=> "The Disclaimer" ,
232 disclaimer
=> $self ->{ value
},
237 my ( $self, $param ) = @_ ;
239 $self ->{ value
} = $param ->{ disclaimer
};
246 =head1 PMG::RuleDB::Disclaimer