File Coverage

blib/lib/Bot/Cobalt/Core/ContextMeta.pm
Criterion Covered Total %
statement 38 40 95.0
branch 9 18 50.0
condition 5 14 35.7
subroutine 12 13 92.3
pod 7 7 100.0
total 71 92 77.1


line stmt bran cond sub pod time code
1             package Bot::Cobalt::Core::ContextMeta;
2             $Bot::Cobalt::Core::ContextMeta::VERSION = '0.021002';
3             ## Base class for context-specific dynamic hashes
4             ## (ignores, auth, .. )
5              
6 8     8   119807 use strictures 2;
  8         1682  
  8         295  
7 8     8   1154 use Carp;
  8         8  
  8         416  
8              
9 8     8   430 use Bot::Cobalt::Common ':types';
  8         11  
  8         41  
10              
11 8     8   39 use Scalar::Util 'reftype';
  8         12  
  8         331  
12              
13              
14 8     8   749 use Moo;
  8         8292  
  8         42  
15              
16              
17             has _list => (
18             is => 'rw',
19             isa => HashRef,
20 5     5   9537 builder => sub { +{} },
21             );
22              
23              
24             sub add {
25 5     5 1 588 my ($self, $context, $key, $meta) = @_;
26 5 50 33     31 confess "add() needs at least a context and key"
27             unless defined $context and defined $key;
28              
29 5         25 my $ref = +{ AddedAt => time };
30              
31             ## Allow AddedAt to be adjusted:
32 5 50 33     45 if (ref $meta && reftype $meta eq 'HASH') {
33 5         32 $ref->{$_} = $meta->{$_} for keys %$meta;
34             }
35            
36 5         85 $self->_list->{$context}->{$key} = $ref;
37              
38 5         2069 $key
39             }
40              
41             sub clear {
42 1     1 1 444 my ($self, $context) = @_;
43              
44 1 50       5 $self->_list(+{}) unless defined $context;
45              
46 1         32 delete $self->_list->{$context}
47             }
48              
49             sub del {
50 2     2 1 1267 my ($self, $context, $key) = @_;
51              
52 2 50 33     19 confess "del() needs a context and item"
53             unless defined $context and defined $key;
54            
55 2   50     71 my $list = $self->_list->{$context} // return;
56              
57 2         26 delete $list->{$key}
58             }
59              
60             sub fetch {
61 5     5 1 991 my ($self, $context, $key) = @_;
62            
63 5 50 33     31 confess "fetch() needs a context and key"
64             unless defined $context and defined $key;
65              
66 5 50       134 return unless exists $self->_list->{$context};
67              
68 5         127 $self->_list->{$context}->{$key}
69             }
70              
71             sub list {
72 3     3 1 2178 my $self = shift;
73 3 50       13 wantarray ? $self->list_as_array(@_) : $self->list_as_ref(@_)
74             }
75              
76             ## Less ambiguous list methods.
77              
78 0 0   0 1 0 sub list_as_array { keys %{ shift->list_as_ref(@_) || +{} } }
  0         0  
79              
80             sub list_as_ref {
81 3     3 1 3 my ($self, $context) = @_;
82 3 100       78 defined $context ? $self->_list->{$context} : $self->_list ;
83             }
84              
85             1;
86             __END__