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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
package Zonemaster::Engine::NSArray;
use v5.16.0;
use warnings;
use version; our $VERSION = version->declare("v1.0.3");
use Carp qw( confess croak );
use Zonemaster::Engine::Recursor;
use Zonemaster::Engine::Nameserver;
use Class::Accessor 'antlers';
has 'names' => ( is => 'ro', isa => 'ArrayRef', required => 1 );
has 'ary' => ( is => 'ro', isa => 'ArrayRef', default => sub { [] } );
sub TIEARRAY {
my ( $class, @names ) = @_;
return $class->new(
{
ary => [],
names => [ sort { $a cmp $b } @names ]
}
);
}
sub STORE {
my ( $self, $index, $value ) = @_;
croak "STORE forbidden for this type of array.";
}
sub STORESIZE {
my ( $self, $index, $value ) = @_;
croak "STORESIZE forbidden for this type of array.";
}
sub FETCH {
my ( $self, $index ) = @_;
if ( exists $self->ary->[$index] ) {
return $self->ary->[$index];
}
elsif ( scalar( @{ $self->names } ) == 0 ) {
return;
}
else {
$self->_load_name( shift @{ $self->names } );
return $self->FETCH( $index );
}
}
sub FETCHSIZE {
my ( $self ) = @_;
while ( my $name = shift @{ $self->names } ) {
$self->_load_name( $name );
}
return scalar( @{ $self->ary } );
}
sub EXISTS {
my ( $self, $index ) = @_;
if ( $self->FETCH( $index ) ) {
return 1;
}
else {
return;
}
}
sub DELETE {
my ( $self, $index ) = @_;
croak "DELETE forbidden for this type of array.";
}
sub CLEAR {
my ( $self ) = @_;
croak "CLEAR forbidden for this type of array.";
}
sub PUSH {
my ( $self, @values ) = @_;
croak "PUSH forbidden for this type of array.";
}
sub UNSHIFT {
my ( $self, @values ) = @_;
croak "UNSHIFT forbidden for this type of array.";
}
sub POP {
my ( $self ) = @_;
croak "POP forbidden for this type of array.";
}
sub SHIFT {
my ( $self ) = @_;
croak "SHIFT forbidden for this type of array.";
}
sub SPLICE {
my ( $self, $offset, $length, @values ) = @_;
croak "SPLICE forbidden for this type of array.";
}
sub UNTIE {
my ( $self ) = @_;
return;
}
sub _load_name {
my ( $self, $name ) = @_;
my @addrs = Zonemaster::Engine::Recursor->get_addresses_for( $name );
foreach my $addr ( sort { $a->ip cmp $b->ip } @addrs ) {
my $ns = Zonemaster::Engine::Nameserver->new( { name => $name, address => $addr } );
if ( not grep { "$ns" eq "$_" } @{ $self->ary } ) {
push @{ $self->ary }, $ns;
}
}
return;
}
1;
=head1 NAME
Zonemaster::Engine::NSArray - Class implementing arrays that lazily looks up name server addresses from their names
=head1 SYNOPSIS
tie @ary, 'Zonemaster::Engine::NSArray', @ns_names
=head1 DESCRIPTION
This class is used for the C<glue> and C<ns> attributes of the
L<Zonemaster::Engine::Zone> class. It is initially seeded with a list of
names, which will be expanded into proper L<Zonemaster::Engine::Nameserver>
objects on demand. Be careful with using Perl functions that act on
whole arrays (particularly C<foreach>), since they will usually force
the entire array to expand, negating the use of the lazy-loading.
=head1 METHODS
These are all methods implementing the Perl tie interface. They have no independent use.
=over
=item TIEARRAY
=item STORE
=item STORESIZE
=item FETCH
=item FETCHSIZE
=item EXISTS
=item DELETE
=item CLEAR
=item PUSH
=item UNSHIFT
=item POP
=item SHIFT
=item SPLICE
=item UNTIE
=back
=head1 AUTHOR
Calle Dybedahl, C<< <calle at init.se> >>
=cut
|
