File Coverage

blib/lib/Mail/Box/Tie/HASH.pm
Criterion Covered Total %
statement 33 41 80.4
branch 6 10 60.0
condition 3 6 50.0
subroutine 9 12 75.0
pod n/a
total 51 69 73.9


line stmt bran cond sub pod time code
1             # Copyrights 2001-2019 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              
9             package Mail::Box::Tie::HASH;
10 2     2   1101 use vars '$VERSION';
  2         3  
  2         83  
11             $VERSION = '3.008';
12              
13              
14 2     2   10 use strict;
  2         3  
  2         32  
15 2     2   17 use warnings;
  2         4  
  2         39  
16              
17 2     2   8 use Carp;
  2         4  
  2         840  
18              
19              
20             sub TIEHASH(@)
21 1     1   461 { my ($class, $folder) = @_;
22 1 50 33     11 croak "No folder specified to tie to."
23             unless ref $folder && $folder->isa('Mail::Box');
24              
25 1         7 bless { MBT_folder => $folder, MBT_type => 'HASH' }, $class;
26             }
27              
28             #-------------------------------------------
29              
30 139     139   21471 sub FETCH($) { shift->{MBT_folder}->messageId(shift) }
31              
32              
33             sub STORE($$)
34 2     2   64054 { my ($self, $key, $basicmsg) = @_;
35              
36 2 50 66     13 carp "Use undef as key, because the message-id of the message is used."
37             if defined $key && $key ne 'undef';
38              
39 2         22 $self->{MBT_folder}->addMessages($basicmsg);
40             }
41              
42              
43             sub FIRSTKEY()
44 6     6   131 { my $self = shift;
45 6         14 my $folder = $self->{MBT_folder};
46              
47 6         10 $self->{MBT_each_index} = 0;
48 6         14 $self->NEXTKEY();
49             }
50              
51             #-------------------------------------------
52              
53              
54             sub NEXTKEY($)
55 274     274   922 { my $self = shift;
56 274         290 my $folder = $self->{MBT_folder};
57 274         370 my $nrmsgs = $folder->messages;
58              
59 274         287 my $msg;
60 274         256 while(1)
61 277         290 { my $index = $self->{MBT_each_index}++;
62 277 100       372 return undef if $index >= $nrmsgs;
63              
64 271         398 $msg = $folder->message($index);
65 271 100       459 last unless $msg->isDeleted;
66             }
67              
68 268         393 $msg->messageId;
69             }
70              
71              
72             sub EXISTS($)
73 0     0     { my $folder = shift->{MBT_folder};
74 0           my $msgid = shift;
75 0           my $msg = $folder->messageId($msgid);
76 0 0         defined $msg && ! $msg->isDeleted;
77             }
78              
79              
80             sub DELETE($)
81 0     0     { my ($self, $msgid) = @_;
82 0           $self->{MBT_folder}->messageId($msgid)->delete;
83             }
84              
85             #-------------------------------------------
86              
87              
88             sub CLEAR()
89 0     0     { my $folder = shift->{MBT_folder};
90 0           $_->delete foreach $folder->messages;
91             }
92              
93             #-------------------------------------------
94              
95             1;