File Coverage

lib/Net/ISC/DHCPd/Types.pm
Criterion Covered Total %
statement 11 23 47.8
branch 0 8 0.0
condition n/a
subroutine 5 7 71.4
pod 3 3 100.0
total 19 41 46.3


line stmt bran cond sub pod time code
1             package Net::ISC::DHCPd::Types;
2              
3             =head1 NAME
4              
5             Net::ISC::DHCPd::Types - Moose type constraint declaration
6              
7             =head1 SYNOPSIS
8              
9             use Net::ISC::DHCPd::Types @types;
10             has foo => ( isa => SomeType, ... );
11              
12             =cut
13              
14 27     27   16940 use Moose;
  27         342210  
  27         163  
15 27     27   136626 use MooseX::Types;
  27         60966  
  27         218  
16 27     27   82717 use MooseX::Types::Moose ':all';
  27         22413  
  27         249  
17              
18             my @type_list;
19             my @failover_states = (
20             "na", "partner down",
21             "normal", "communications interrupted",
22             "resolution interrupted", "potential conflict",
23             "recover", "recover done",
24             "shutdown", "paused",
25             "startup", "recover wait",
26             );
27             my @states = qw/
28             na free active expired released
29             abandoned reset backup reserved bootp
30             /;
31              
32             BEGIN {
33 27     27   177603 MooseX::Types->import(-declare => [@type_list = qw/
34             HexInt Ip Mac State Time Statements FailoverState
35             ConfigObject LeasesObject OMAPIObject ProcessObject
36             /]);
37             }
38              
39             =head1 TYPES
40              
41             =head2 HexInt
42              
43             =head2 Ip
44              
45             =head2 Mac
46              
47             =head2 State
48              
49             =head2 Time
50              
51             =cut
52              
53             subtype State, as Str,
54             where { my $s = $_; return grep { $s eq $_ } @states };
55             subtype FailoverState, as Str,
56             where { my $s = $_; return grep { $s eq $_ } @failover_states };
57             subtype HexInt, as Int;
58             subtype Ip, as Str,
59             where { /^[\d.]+$/ };
60             subtype Mac, as Str,
61             where { /^[a-f0-9:]{17}$/i };
62              
63             subtype Time, as Int;
64              
65             coerce State, (
66             from Str, via { /(\d+)$/ ? $states[$1] : undef }
67             );
68              
69             =head2 from_State
70              
71             =cut
72              
73             sub from_State {
74 0     0 1 0 my $self = shift;
75 0         0 my $attr = shift;
76 0 0       0 my $value = $self->$attr or return 0;
77              
78 0         0 for my $i (0..@states) {
79 0 0       0 return $i if($states[$i] eq $value);
80             }
81              
82 0         0 return 0;
83             }
84              
85             coerce FailoverState, (
86             from Str
87             );
88              
89             =head2 from_FailoverState
90              
91             =cut
92              
93             sub from_FailoverState {
94 0     0 1 0 my $self = shift;
95 0         0 my $attr = shift;
96 0 0       0 my $value = $self->$attr or return 0;
97              
98 0         0 for my $i (0..@failover_states) {
99 0 0       0 return $i if($failover_states[$i] eq $value);
100             }
101              
102 0         0 return 0;
103             }
104              
105             coerce HexInt, (
106             from Str, via { s/://g; hex $_ },
107             );
108              
109             coerce Ip, (
110             from Str, via { join ".", map { hex $_ } split /:/ },
111             );
112              
113             coerce Mac, (
114             from Str, via { s/[\-\.:]//g; join ":", /(\w\w)/g },
115             );
116              
117             coerce Time, (
118             from Str, via { s/://g; hex $_ },
119             );
120              
121             =head2 Statements
122              
123             =cut
124              
125             subtype Statements, as Str, where { /^[\w,]+$/ };
126              
127             coerce Statements, (
128             from Str, via { s/\s+/,/g; $_; },
129             from ArrayRef, via { join ",", @$_ },
130             );
131              
132             =head2 ConfigObject
133              
134             =head2 LeasesObject
135              
136             =head2 OMAPIObject
137              
138             =head2 ProcessObject
139              
140             =cut
141              
142             subtype ConfigObject, as Object;
143             subtype LeasesObject, as Object;
144             subtype OMAPIObject, as Object;
145             subtype ProcessObject, as Object;
146              
147             coerce ConfigObject, from HashRef, via {
148             eval "require Net::ISC::DHCPd::Config" or confess $@;
149             Net::ISC::DHCPd::Config->new($_);
150             };
151             coerce LeasesObject, from HashRef, via {
152             eval "require Net::ISC::DHCPd::Leases" or confess $@;
153             Net::ISC::DHCPd::Leases->new($_);
154             };
155             coerce OMAPIObject, from HashRef, via {
156             eval "require Net::ISC::DHCPd::OMAPI" or confess $@;
157             Net::ISC::DHCPd::OMAPI->new($_);
158             };
159             coerce ProcessObject, from HashRef, via {
160             eval "require Net::ISC::DHCPd::Process" or confess $@;
161             Net::ISC::DHCPd::Process->new($_);
162             };
163              
164             =head2 get_type_list
165              
166             @names = $class->get_type_list;
167              
168             Returns the types defined in this package.
169              
170             =cut
171              
172             sub get_type_list {
173 7     7 1 230 return @type_list;
174             }
175              
176             =head1 COPYRIGHT & LICENSE
177              
178             =head1 AUTHOR
179              
180             See L<Net::ISC::DHCPd>.
181              
182             =cut
183             __PACKAGE__->meta->make_immutable;
184             1;