1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
# This code is part of Perl distribution Mail-Box version 4.01.
# The POD got stripped from this file by OODoc version 3.05.
# For contributors see file ChangeLog.
# This software is copyright (c) 2001-2025 by Mark Overmeer.
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
package Mail::Box::Message::Destructed;{
our $VERSION = '4.01';
}
use parent 'Mail::Box::Message';
use strict;
use warnings;
use Log::Report 'mail-box', import => [ qw/__x error/ ];
#--------------------
sub new(@) { error __x"you cannot instantiate a destructed message." }
sub isDummy() { 1 }
sub head(;$)
{ my ($self, $head) = @_;
@_==1 and error __x"you cannot take the head of a destructed message.";
defined $head and error __x"you cannot set the head on a destructed message.";
undef;
}
sub body(;$)
{ my ($self, $body) = @_;
@_==1 and error __x"you cannot take the body of a destructed message.";
defined $body and error __x"you cannot set the body on a destructed message.";
undef;
}
sub coerce($)
{ my ($class, $message) = @_;
$message->isa('Mail::Box::Message')
or error __x"you cannot coerce a {class} into destruction.", class => ref $message;
$message->body(undef);
$message->head(undef);
$message->modified(0);
bless $message, $class;
}
sub modified(;$)
{ my $self = shift;
! @_ || ! $_[0]
or error __x"you cannot set the modified flag on a destructed message.";
0;
}
sub isModified() { 0 }
sub label($;@)
{ my $self = shift;
if(@_==1)
{ my $label = shift;
return $self->SUPER::label('deleted') if $label eq 'deleted';
error __x"destructed message has no labels except 'deleted', requested is {label}.", label => $label;
}
my %flags = @_;
keys %flags==1 && exists $flags{deleted}
or error __x"destructed message has no labels except 'deleted', trying to set {labels}.", labels => [keys %flags];
$flags{deleted}
or error __x"destructed message can not be undeleted.";
1;
}
sub labels() { wantarray ? ('deleted') : +{deleted => 1} }
1;
|
