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
95
96
97
98
99
100
|
package Zonemaster::Engine::Nameserver::Cache::LocalCache;
use v5.16.0;
use warnings;
use version; our $VERSION = version->declare("v1.0.4");
use Carp qw( confess );
use Scalar::Util qw( blessed );
use Zonemaster::Engine;
use Zonemaster::Engine::Nameserver::Cache;
use base qw( Zonemaster::Engine::Nameserver::Cache );
our $object_cache = \%Zonemaster::Engine::Nameserver::Cache::object_cache;
sub new {
my $proto = shift;
my $class = ref $proto || $proto;
my $attrs = shift;
confess "Attribute \(address\) is required"
if !exists $attrs->{address};
# Type coercions
$attrs->{address} = Net::IP::XS->new( $attrs->{address} )
if !blessed $attrs->{address} || !$attrs->{address}->isa( 'Net::IP::XS' );
# Type constraint
confess "Argument must be coercible into a Net::IP::XS: address"
if !$attrs->{address}->isa( 'Net::IP::XS' );
confess "Argument must be a HASHREF: data"
if exists $attrs->{data} && ref $attrs->{data} ne 'HASH';
# Default value
$attrs->{data} //= {};
my $ip = $attrs->{address}->ip;
if ( exists $object_cache->{ $ip } ) {
Zonemaster::Engine->logger->add( CACHE_FETCHED => { ip => $ip } );
return $object_cache->{ $ip };
}
my $obj = Class::Accessor::new( $class, $attrs );
Zonemaster::Engine->logger->add( CACHE_CREATED => { ip => $ip } );
$object_cache->{ $ip } = $obj;
return $obj;
}
sub set_key {
my ( $self, $idx, $packet ) = @_;
$self->data->{$idx} = $packet;
}
sub get_key {
my ( $self, $idx ) = @_;
if ( exists $self->data->{$idx} ) {
# cache hit
return ( 1, $self->data->{$idx} );
}
return ( 0, undef );
}
1;
=head1 NAME
Zonemaster::Engine::Nameserver::LocalCache - local shared caches for nameserver objects
=head1 SYNOPSIS
This class should not be used directly.
=head1 ATTRIBUTES
Subclass of L<Zonemaster::Engine::Nameserver::Cache>.
=head1 CLASS METHODS
=over
=item new
Construct a new Cache object.
=item set_key($idx, $packet)
Store C<$packet> (data) with key C<$idx>.
=item get_key($idx)
Retrieve C<$packet> (data) at key C<$idx>.
=back
=cut
|
