File Coverage

blib/lib/Mail/Box/Tie/HASH.pm
Criterion Covered Total %
statement 31 38 81.5
branch 5 8 62.5
condition 2 3 66.6
subroutine 9 12 75.0
pod n/a
total 47 61 77.0


line stmt bran cond sub pod time code
1             # This code is part of Perl distribution Mail-Box version 4.01.
2             # The POD got stripped from this file by OODoc version 3.05.
3             # For contributors see file ChangeLog.
4              
5             # This software is copyright (c) 2001-2025 by Mark Overmeer.
6              
7             # This is free software; you can redistribute it and/or modify it under
8             # the same terms as the Perl 5 programming language system itself.
9             # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
10              
11              
12             package Mail::Box::Tie::HASH;{
13             our $VERSION = '4.01';
14             }
15              
16 2     2   2138 use parent 'Mail::Box::Tie';
  2         5  
  2         14  
17              
18 2     2   186 use strict;
  2         5  
  2         86  
19 2     2   11 use warnings;
  2         3  
  2         111  
20              
21 2     2   12 use Log::Report 'mail-box', import => [ qw/__x warning/ ];
  2         4  
  2         13  
22              
23             #--------------------
24              
25             sub TIEHASH(@)
26 1     1   669 { my ($class, $folder) = @_;
27 1         13 $class->new($folder, 'HASH');
28             }
29              
30             #--------------------
31              
32             #--------------------
33              
34 139     139   41342 sub FETCH($) { $_[0]->folder->messageId($_[1]) }
35              
36              
37             sub STORE($$)
38 2     2   68187 { my ($self, $key, $basicmsg) = @_;
39              
40 2 50 66     12 ! defined $key || $key eq 'undef'
41             or warning __x"use undef as key, because the message-id of the message is used.";
42              
43 2         10 $self->folder->addMessages($basicmsg);
44             }
45              
46              
47             sub FIRSTKEY()
48 6     6   753 { my $self = shift;
49 6         17 $self->{MBT_each_index} = 0;
50 6         16 $self->NEXTKEY();
51             }
52              
53              
54             sub NEXTKEY($)
55 274     274   1193 { my $self = shift;
56 274         383 my $folder = $self->{MBT_folder};
57 274         495 my $nrmsgs = $folder->messages;
58              
59 274         361 my $msg;
60 274         330 while(1)
61 277         375 { my $index = $self->{MBT_each_index}++;
62 277 100       501 $index < $nrmsgs or return undef;
63 271         479 $msg = $folder->message($index);
64 271 100       600 $msg->isDeleted or last;
65             }
66              
67 268         1582 $msg->messageId;
68             }
69              
70              
71             sub EXISTS($)
72 0     0     { my ($self, $msgid) = @_;
73 0           my $msg = $self->folder->messageId($msgid);
74 0 0         defined $msg && ! $msg->isDeleted;
75             }
76              
77              
78             sub DELETE($)
79 0     0     { my ($self, $msgid) = @_;
80 0           $self->folder->messageId($msgid)->delete;
81             }
82              
83              
84             sub CLEAR()
85 0     0     { my $self = shift;
86 0           $_->delete for $self->folder->messages;
87             }
88              
89             1;