File Coverage

blib/lib/Net/DRI/Data/StatusList.pm
Criterion Covered Total %
statement 63 89 70.7
branch 18 28 64.2
condition 5 15 33.3
subroutine 13 23 56.5
pod 15 19 78.9
total 114 174 65.5


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, Handling of statuses list (order is irrelevant) (base class)
2             ##
3             ## Copyright (c) 2005-2008,2010-2011,2013-2014 Patrick Mevzek . All rights reserved.
4             ##
5             ## This file is part of Net::DRI
6             ##
7             ## Net::DRI is free software; you can redistribute it and/or modify
8             ## it under the terms of the GNU General Public License as published by
9             ## the Free Software Foundation; either version 2 of the License, or
10             ## (at your option) any later version.
11             ##
12             ## See the LICENSE file that comes with this distribution for more details.
13             ####################################################################################################
14              
15             package Net::DRI::Data::StatusList;
16              
17 60     60   682 use strict;
  60         313  
  60         2227  
18 60     60   277 use warnings;
  60         94  
  60         1587  
19              
20 60     60   579 use Net::DRI::Exception;
  60         93  
  60         59168  
21              
22             =pod
23              
24             =head1 NAME
25              
26             Net::DRI::Data::StatusList - Handle a collection of statuses for an object, in a registry independent fashion for Net::DRI
27              
28             =head1 DESCRIPTION
29              
30             You should never have to use this class directly, but you may get back objects that
31             are instances of subclasses of this class. An object of this class can store the statuses' names,
32             with a message for each and a language tag, and any other stuff, depending on registry.
33              
34             =head1 METHODS
35              
36             =head2 is_active()
37              
38             returns 1 if these statuses enable an object to be active
39              
40             =head2 is_published()
41              
42             returns 1 if these statuses enable the object to be published on registry DNS servers
43              
44             =head2 is_pending()
45              
46             returns 1 if these statuses are for an object that is pending some action at registry
47              
48             =head2 is_linked()
49              
50             returns 1 if these statuses are for an object that is linked to another one at registry
51              
52             =head2 is_grace()
53              
54             returns 1 if these statuses are for an object into some grace period at registry
55              
56             =head2 can_update()
57              
58             returns 1 if these statuses allow to update the object at registry
59              
60             =head2 can_transfer()
61              
62             returns 1 if these statuses allow to transfer the object at registry
63              
64             =head2 can_delete()
65              
66             returns 1 if these statuses allow to delete the object at registry
67              
68             =head2 can_renew()
69              
70             returns 1 if these statuses allow to renew the object at registry
71              
72             =head2 possible_no()
73              
74             returns an array with the list of available status to use in the no() call
75              
76             =head2 no()
77              
78             can be used to build a status, which will be added to the list. Must be given three parameters:
79             a status (from list given by C), a message (optional), a lang (optional, default to 'en')
80              
81             =head1 INTERNAL METHODS
82              
83             You may also use the following methods, but they should be less useful as
84             the purpose of the module is to give an abstract view of the underlying statuses.
85              
86             =head2 list_status()
87              
88             to get only the statuses' names, as an array of sorted names;
89             if passed a true value, will return an array of strings, each one
90             being the status name, plus message & lang if available, plus short description
91             of other information tied to this status name
92              
93             =head2 status_details()
94              
95             to get an hash ref with all status information
96              
97             =head2 has_any()
98              
99             returns 1 if the object has any of the statuses given as arguments
100              
101             =head2 has_not()
102              
103             returns 1 if the object has none of the statuses given as arguments
104              
105             =head1 SUPPORT
106              
107             For now, support questions should be sent to:
108              
109             Enetdri@dotandco.comE
110              
111             Please also see the SUPPORT file in the distribution.
112              
113             =head1 SEE ALSO
114              
115             http://www.dotandco.com/services/software/Net-DRI/
116              
117             =head1 AUTHOR
118              
119             Patrick Mevzek, Enetdri@dotandco.comE
120              
121             =head1 COPYRIGHT
122              
123             Copyright (c) 2005-2008,2010-2011,2013-2014 Patrick Mevzek .
124             All rights reserved.
125              
126             This program is free software; you can redistribute it and/or modify
127             it under the terms of the GNU General Public License as published by
128             the Free Software Foundation; either version 2 of the License, or
129             (at your option) any later version.
130              
131             See the LICENSE file that comes with this distribution for more details.
132              
133             =cut
134              
135             ####################################################################################################
136              
137             sub new
138             {
139 7     7 0 26 my ($class,$pname,$pversion,@args)=@_;
140 7 100       20 $pname='?' unless defined $pname;
141 7 100       18 $pversion='?' unless defined $pversion;
142              
143 7         23 my $self={ proto_name => $pname,
144             proto_version => $pversion,
145             sl => {}, ## statusname => { lang => lc(lang), msg => '', other per class }
146             };
147              
148 7         20 bless($self,$class);
149 7 100       21 $self->add(@args) if @args;
150 7         16 return $self;
151             }
152              
153             sub _register_pno
154             {
155 3     3   14 my ($self,$rs)=@_;
156 3         11 $self->{possible_no}=$rs;
157 3         6 return;
158             }
159              
160             sub add
161             {
162 7     7 0 14 my ($self,@args)=@_;
163 7         11 my $rs=$self->{sl};
164              
165 7         10 foreach my $el (@args)
166             {
167 7 100       18 if (ref($el))
168             {
169 2         3 my %tmp=%{$el};
  2         7  
170 2         4 my $name=$tmp{name};
171 2         3 delete($tmp{name});
172 2         6 $rs->{$name}=\%tmp;
173             } else
174             {
175 5         17 $rs->{$el}={};
176             }
177             }
178 7         14 return $self;
179             }
180              
181             sub rem
182             {
183 0     0 0 0 my ($self,$status)=@_;
184 0         0 my $rs=$self->{sl};
185 0 0       0 delete($rs->{$status}) if exists($rs->{$status});
186 0         0 return $self;
187             }
188              
189             sub list_status
190             {
191 14     14 1 13 my ($self,$full)=@_;
192 14         15 my @names=sort { $a cmp $b } keys %{$self->{sl}};
  3         9  
  14         59  
193 14 50 33     71 return @names if ! defined $full || ! $full;
194              
195 0         0 my @r;
196 0         0 foreach my $name (@names)
197             {
198 0         0 my $r=$name;
199 0 0 0     0 $r.=sprintf(' (%s:%s)',$self->{sl}->{$name}->{lang},$self->{sl}->{$name}->{msg}) if exists $self->{sl}->{$name}->{lang} && $self->{sl}->{$name}->{msg};
200 0         0 my @ek=sort { $a cmp $b } grep { ! /^(?:lang|msg)$/ } keys %{$self->{sl}->{$name}};
  0         0  
  0         0  
  0         0  
201 0 0       0 $r.=join('',map { '['.$_.']' } @ek) if @ek;
  0         0  
202 0         0 push @r,$r;
203             }
204 0         0 return @r;
205             }
206              
207             sub status_details
208             {
209 1     1 1 2 my $self=shift;
210 1         8 return $self->{sl};
211             }
212              
213             sub is_empty
214             {
215 4     4 0 1145 my $self=shift;
216 4         9 my @a=$self->list_status();
217 4 100       18 return (@a > 0)? 0 : 1;
218             }
219              
220             sub has_any
221             {
222 5     5 1 18 my ($self,@args)=@_;
223 5         22 my %tmp=map { uc($_) => 1 } $self->list_status();
  6         29  
224              
225 5         11 foreach my $el (@args)
226             {
227 13 100       43 return 1 if exists($tmp{uc($el)});
228             }
229 2         10 return 0;
230             }
231              
232             sub has_not
233             {
234 1     1 1 3 my ($self,@args)=@_;
235 1         4 my %tmp=map { uc($_) => 1 } $self->list_status();
  2         6  
236              
237 1         2 foreach my $el (@args)
238             {
239 1 50       7 return 0 if exists($tmp{uc($el)});
240             }
241 0         0 return 1;
242             }
243              
244             sub possible_no
245             {
246 1     1 1 5 my $self=shift;
247 1         1 my @r=sort { $a cmp $b } keys %{$self->{possible_no}};
  1         3  
  1         5  
248 1         7 return @r;
249             }
250              
251             sub no ## no critic (Subroutines::ProhibitBuiltinHomonyms)
252             {
253 2     2 1 5 my ($self,$what,$msg,$lang)=@_;
254 2         2 my $rs=$self->{possible_no};
255 2 50 33     14 return $self unless (defined($what) && exists($rs->{$what}));
256 2 100 66     8 if (defined($msg) && $msg)
257             {
258 1 50 33     9 $self->add({name=>$rs->{$what},msg=>$msg,lang=>(defined($lang) && $lang)? $lang : 'en'});
259             } else
260             {
261 1         3 $self->add($rs->{$what});
262             }
263 2         3 return $self;
264             }
265              
266             ####################################################################################################
267             ## Methods that must be defined in subclasses
268              
269 0     0 1   sub is_active { Net::DRI::Exception::method_not_implemented('is_active',ref $_[0]); } ## no critic (Subroutines::RequireArgUnpacking Subroutines::RequireFinalReturn)
270 0     0 1   sub is_published { Net::DRI::Exception::method_not_implemented('is_published',ref $_[0]); } ## no critic (Subroutines::RequireArgUnpacking Subroutines::RequireFinalReturn)
271 0     0 1   sub is_pending { Net::DRI::Exception::method_not_implemented('is_pending',ref $_[0]); } ## no critic (Subroutines::RequireArgUnpacking Subroutines::RequireFinalReturn)
272 0     0 1   sub is_linked { Net::DRI::Exception::method_not_implemented('is_linked',ref $_[0]); } ## no critic (Subroutines::RequireArgUnpacking Subroutines::RequireFinalReturn)
273 0     0 1   sub is_grace { Net::DRI::Exception::method_not_implemented('is_grace',ref $_[0]); } ## no critic (Subroutines::RequireArgUnpacking Subroutines::RequireFinalReturn)
274 0     0 1   sub can_update { Net::DRI::Exception::method_not_implemented('can_update',ref $_[0]); } ## no critic (Subroutines::RequireArgUnpacking Subroutines::RequireFinalReturn)
275 0     0 1   sub can_transfer { Net::DRI::Exception::method_not_implemented('can_transfer',ref $_[0]); } ## no critic (Subroutines::RequireArgUnpacking Subroutines::RequireFinalReturn)
276 0     0 1   sub can_delete { Net::DRI::Exception::method_not_implemented('can_delete',ref $_[0]); } ## no critic (Subroutines::RequireArgUnpacking Subroutines::RequireFinalReturn)
277 0     0 1   sub can_renew { Net::DRI::Exception::method_not_implemented('can_renew',ref $_[0]); } ## no critic (Subroutines::RequireArgUnpacking Subroutines::RequireFinalReturn)
278              
279             ####################################################################################################
280             1;