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
|
# 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::Tie::HASH;{
our $VERSION = '4.01';
}
use parent 'Mail::Box::Tie';
use strict;
use warnings;
use Log::Report 'mail-box', import => [ qw/__x warning/ ];
#--------------------
sub TIEHASH(@)
{ my ($class, $folder) = @_;
$class->new($folder, 'HASH');
}
#--------------------
#--------------------
sub FETCH($) { $_[0]->folder->messageId($_[1]) }
sub STORE($$)
{ my ($self, $key, $basicmsg) = @_;
! defined $key || $key eq 'undef'
or warning __x"use undef as key, because the message-id of the message is used.";
$self->folder->addMessages($basicmsg);
}
sub FIRSTKEY()
{ my $self = shift;
$self->{MBT_each_index} = 0;
$self->NEXTKEY();
}
sub NEXTKEY($)
{ my $self = shift;
my $folder = $self->{MBT_folder};
my $nrmsgs = $folder->messages;
my $msg;
while(1)
{ my $index = $self->{MBT_each_index}++;
$index < $nrmsgs or return undef;
$msg = $folder->message($index);
$msg->isDeleted or last;
}
$msg->messageId;
}
sub EXISTS($)
{ my ($self, $msgid) = @_;
my $msg = $self->folder->messageId($msgid);
defined $msg && ! $msg->isDeleted;
}
sub DELETE($)
{ my ($self, $msgid) = @_;
$self->folder->messageId($msgid)->delete;
}
sub CLEAR()
{ my $self = shift;
$_->delete for $self->folder->messages;
}
1;
|
