1# Copyrights 2001-2020 by [Mark Overmeer]. 2# For other contributors see ChangeLog. 3# See the manual pages for details on the licensing terms. 4# Pod stripped from pm file by OODoc 2.02. 5# This code is part of distribution Mail-Box. Meta-POD processed with 6# OODoc into POD and HTML manual-pages. See README.md 7# Copyright Mark Overmeer. Licensed under the same terms as Perl itself. 8 9package Mail::Box::Message::Destructed; 10use vars '$VERSION'; 11$VERSION = '3.009'; 12 13use base 'Mail::Box::Message'; 14 15use strict; 16use warnings; 17 18use Carp; 19 20 21sub new(@) 22{ my $class = shift; 23 $class->log(ERROR => 'You cannot instantiate a destructed message'); 24 undef; 25} 26 27sub isDummy() { 1 } 28 29 30sub head(;$) 31{ my $self = shift; 32 return undef if @_ && !defined(shift); 33 34 $self->log(ERROR => "You cannot take the head of a destructed message"); 35 undef; 36} 37 38 39sub body(;$) 40{ my $self = shift; 41 return undef if @_ && !defined(shift); 42 43 $self->log(ERROR => "You cannot take the body of a destructed message"); 44 undef; 45} 46 47 48sub coerce($) 49{ my ($class, $message) = @_; 50 51 unless($message->isa('Mail::Box::Message')) 52 { $class->log(ERROR=>"Cannot coerce a ",ref($message), " into destruction"); 53 return (); 54 } 55 56 $message->body(undef); 57 $message->head(undef); 58 $message->modified(0); 59 60 bless $message, $class; 61} 62 63sub modified(;$) 64{ my $self = shift; 65 66 $self->log(ERROR => 'Do not set the modified flag on a destructed message') 67 if @_ && $_[0]; 68 69 0; 70} 71 72sub isModified() { 0 } 73 74 75sub label($;@) 76{ my $self = shift; 77 78 if(@_==1) 79 { my $label = shift; 80 return $self->SUPER::label('deleted') if $label eq 'deleted'; 81 $self->log(ERROR => "Destructed message has no labels except 'deleted', requested is $label"); 82 return 0; 83 } 84 85 my %flags = @_; 86 unless(keys %flags==1 && exists $flags{deleted}) 87 { $self->log(ERROR => "Destructed message has no labels except 'deleted', trying to set @{[ keys %flags ]}"); 88 return; 89 } 90 91 $self->log(ERROR => "Destructed messages can not be undeleted") 92 unless $flags{deleted}; 93 94 1; 95} 96 97sub labels() { wantarray ? ('deleted') : +{deleted => 1} } 98 991; 100