File Coverage

blib/lib/Magrathea/API/Emergency.pm
Criterion Covered Total %
statement 29 116 25.0
branch 0 38 0.0
condition 0 8 0.0
subroutine 10 22 45.4
pod 8 10 80.0
total 47 194 24.2


line stmt bran cond sub pod time code
1             package Magrathea::API::Emergency;
2              
3 1     1   7 use strict;
  1         3  
  1         29  
4 1     1   5 use warnings;
  1         2  
  1         22  
5 1     1   10 use 5.10.0;
  1         3  
6 1     1   5 use utf8;
  1         2  
  1         5  
7              
8 1     1   53 use Scalar::Util qw{ dualvar };
  1         3  
  1         52  
9 1     1   7 use Attribute::Boolean;
  1         2  
  1         6  
10 1     1   100 use Carp;
  1         2  
  1         50  
11 1     1   635 use Data::Dumper;
  1         6771  
  1         77  
12              
13 1     1   432 use Magrathea::API::Abbreviation qw{abbreviate};
  1         3  
  1         134  
14              
15 1     1   8 use constant POSTCODE_RE => qr/^([Gg][Ii][Rr] 0[Aa]{2})|((([A-Za-z][0-9]{1,2})|(([A-Za-z][A-Ha-hJ-Yj-y][0-9]{1,2})|(([A-Za-z][0-9][A-Za-z])|([A-Za-z][A-Ha-hJ-Yj-y][0-9]?[A-Za-z])))) [0-9][A-Za-z]{2})$/;
  1         2  
  1         1138  
16              
17             =encoding utf8
18              
19             =head2 NAME
20              
21             Magrathea::API::Emergency - Access to the Magrathea 999 Interface
22              
23             =head2 EXAMPLE
24              
25             use Magrathea::API;
26             my $mt = new Magrathea::API($username, $password);
27             my $emerg = $mt->emergency_info($phone_number);
28             # Get the status, print it and check it
29             my $status = $emerg->status;
30             say "Status is: $status" if $status != 0;
31             # Print the thoroughfare, update it and print it again
32             say "Thoroughfare is currently: ", $emerg->thoroughfare;
33             $emerg->thoroughfare("He is a justice of the peace and in accommodation.");
34             say "Thoroughfare is now ", $emerg->thoroughfare;
35             # prints: He is a J.P. & in Accom.
36             # Update the changes
37             $emerge->update
38              
39             =cut
40              
41             =head2 DESCRIPTION
42              
43             This module represents the
44             L.
45              
46             It should not be constructed by user code; it is only avalible through
47             the main L code as follows:
48              
49             my $mt = new Magrathea::API($username, $password);
50             my $emerg = $mt->emergency_info($phone_number, $is_ported);
51              
52             =cut
53              
54             #################################################################
55             ##
56             ## Local Prototyped Functions
57             ##
58             #################################################################
59              
60              
61             #################################################################
62             ##
63             ## Private Instance Functions
64             ##
65             #################################################################
66              
67             sub sendline
68             {
69 0     0 0   my $self = shift;
70 0   0       my $message = shift // '';
71 0 0 0       say ">> $message" if $self->{debug} && $message;
72 0 0         $self->{telnet}->print($message) if $message;
73 0           my $response = $self->{telnet}->getline;
74 0           chomp $response;
75 0           my ($val, $msg) = $response =~ /^(\d)\s+(.*)/;
76 0 0         croak qq(Unknown response: "$response") unless defined $val;
77 0 0         say "<<$val $msg" if $self->{debug};
78 0           return dualvar $val, $msg;
79             }
80              
81             #################################################################
82             ##
83             ## Class Functions
84             ##
85             #################################################################
86              
87             =head2 METHODS
88              
89             =cut
90              
91             sub new
92             {
93 0     0 0   my $class = shift;
94 0           my $api = shift;
95 0           my $number = shift;
96 0           my $ported : Boolean = shift;
97 0           local $_;
98 0 0         croak "This package must not be called directly" unless ref $api eq 'Magrathea::API';
99             my $self = {
100             telnet => $api->{telnet},
101             debug => $api->{params}{debug},
102 0           number => $number,
103             ported => $ported,
104             };
105 0           bless $self, $class;
106 0           my %info;
107 0           my $response = $self->DATA;
108 0           while ($response == 0) {
109 0           chomp $response;
110 0           my ($key, $value) = split / /, $response, 2;
111 0           $info{lc $key} = $value;
112 0           $response = $self->sendline;
113             }
114 0           $self->{info} = \%info;
115 0           my $exists : Boolean = keys(%info) > 0;
116 0           $self->{exists} = $exists;
117 0           $self;
118             }
119              
120             =head2 create
121              
122             This is used the first time a number is put onto the database and
123             then only if the owner changes. It needs to be followed by an
124             L after entering all the data.
125              
126             =cut
127              
128             sub create
129             {
130 0     0 1   my $self = shift;
131 0           my $result = $self->CREATE;
132 0 0         croak "$result" unless $result == 0;
133 0           $self->{exists} = true;
134             }
135              
136             =head3 number
137              
138             This returns the number currently being worked on as a L.
139              
140             =cut
141              
142             sub number
143             {
144 0     0 1   my $self = shift;
145 0           return $self->{number};
146             }
147              
148             =head3 exists
149              
150             This is a boolean which can be tested to find out if the number
151             already exists on the Magrathea database. It is set during
152             the call to L and updated after
153             a successful call to L.
154              
155             =cut
156              
157             sub exists
158             {
159 0     0 1   my $self = shift;
160 0           return $self->{exists};
161             }
162              
163             =head3 info
164              
165             This returns all the fields in a hash or as a pointer to a hash
166             depending on list or scalar context. The fields are as documented for
167             methods below.
168              
169             =cut
170              
171             sub info
172             {
173 0     0 1   my $self = shift;
174 0           my %info = %{$self->{info}}; # Copy it so it can't be changed
  0            
175 0 0         return wantarray ? %info : \%info;
176             }
177              
178             =head3 status
179              
180             This returns a single value for status. The valuse returned can be
181             used as a string and returns the message or as a number which returns
182             the status code. The possible statuses are curently as below but they
183             are returned from Magrathea so the
184             L<999 Appendix|https://www.magrathea-telecom.co.uk/assets/Client-Downloads/Magrathea-NTSAPI-999-Appendix.pdf>
185             should be treated as authoritive.
186              
187             =over
188              
189             =item 0 Accepted
190              
191             =item 1 Info received
192              
193             =item 2 Info awaiting further validation
194              
195             =item 3 Info submitted
196              
197             =item 6 Submitted – Awaiting manual processing
198              
199             =item 8 Rejected
200              
201             =item 9 No record found
202              
203             =back
204              
205             =cut
206              
207             sub status
208             {
209 0     0 1   my $self = shift;
210 0           my $status = eval {
211 0           $self->STATUS;
212             };
213 0           return $status;
214             }
215              
216              
217             =head3 title
218              
219             =head3 forename
220              
221             =head3 name
222              
223             =head3 honours
224              
225             =head3 bussuffix
226              
227             =head3 premises
228              
229             =head3 thoroughfare
230              
231             =head3 locality
232              
233             =head3 postcode
234              
235             The above methods will get or set a field in the 999 record.
236              
237             Abbreviations are substituted and they are then checked for
238             maximum length. These routines will croak if an invalid length
239             (or invalid postcode) is passed
240              
241             To get the data, simply call the method, to change the data, pass
242             it as a parameter.
243              
244             Nothing is sent to Magrathea until L is called.
245              
246             =cut
247              
248             sub postcode
249             {
250 0     0 1   my $self = shift;
251 0           my $postcode = shift;
252 0 0         if ($postcode) {
253 0 0         if ($postcode ne "") {
254 0 0         croak "Invalid postcode" unless $postcode =~ POSTCODE_RE;
255             }
256 0           $self->{info}{postcode} = $postcode;
257 0           $self->POSTCODE($postcode);
258             }
259 0           return $self->{info}{postcode};
260             }
261              
262             =head3 ported
263              
264             This is a boolean value showing whether or not the number has been
265             ported in from another provider. It will always evaluate to C
266             though unless set by this method as there is no way to store the
267             information on the Magrathea database.
268              
269              
270             $emerge->ported(true); # Assuming true is set to 1
271             my $ported = $emerg->ported;
272              
273             =cut
274              
275             sub ported
276             {
277 0     0 1   my $self = shift;
278 0           my $val = shift;
279 0           my $value : Boolean = $val;
280 0 0         $self->{ported} = $value if defined $val;
281 0           $value = $self->{ported};
282 0           return $value;
283             }
284              
285             =head3 update
286              
287             This will take the current data and send it to Magrathea. The possible
288             valid responses are C (0 in numeric context) or
289             C (1 in numeric context).
290              
291             If Magrathea's validation fails, the update will croak.
292              
293             =cut
294              
295             sub update
296             {
297 0     0 1   my $self = shift;
298 0           my $info = $self->info;
299 0 0 0       unless ($self->postcode and $self->name) {
300 0           croak "Name and postcode are mandatory";
301             }
302 0           my $response = $self->VALIDATE;
303 0 0         croak "Update failed: $response" if $response >= 2;
304 0           return $response;
305             }
306              
307             sub AUTOLOAD
308             {
309 0     0     my $self = shift;
310 0           my $commands = qr{^(?:
311             CREATE|VALIDATE|STATUS|DATA|
312             TITLE|FORENAME|NAME|HONOURS|BUSSUFFIX|
313             PREMISES|THOROUGHFARE|LOCALITY|POSTCODE
314             )$}x;
315 0           my %fields = (
316             title => 20,
317             forename => 20,
318             name => 50,
319             honours => 30,
320             bussuffix => 50,
321             premises => 60,
322             thoroughfare => 55,
323             locality => 30
324             );
325 0           (my $name = our $AUTOLOAD) =~ s/.*://;
326 0 0         if ($name =~ /^[A-Z]+$/) {
327 0 0         croak "Unknown Command: $name" unless $name =~ $commands;
328 0           my $number = $self->number->packed;
329 0 0         $number =~ s/^0/P/ if $self->ported;
330 0           my @cmd = ('INFO', $number, 999, $name, @_);
331 0           return $self->sendline("@cmd");
332             }
333             else {
334 0           my $value = shift;
335 0 0         croak "Unknown method: $name" unless exists $fields{$name};
336 0 0         if (defined $value) {
337 0           my $abbr = abbreviate $value;
338 0           my $len = length $abbr;
339 0           my $max = $fields{$name};
340 0 0         croak "$abbr ($len charancters abbreviated)\n" .
341             "is longer than the max. length of $max" .
342             "for field $name" if $len > $max;
343 0           $self->{info}{$name} = $abbr;
344 0           my $cmd = uc $name;
345 0           $self->$cmd($abbr);
346             }
347 0           return $self->{info}{$name};
348             }
349             }
350              
351       0     sub DESTROY {
352             # Avoid AUTOLOAD
353             }
354              
355             =head2 AUTHOR
356              
357             Cliff Stanford, Ecliff@may.beE
358              
359             =head2 ISSUES
360              
361             Please open any issues with this code on the
362             L.
363              
364             =head2 COPYRIGHT AND LICENCE
365              
366             Copyright (C) 2012 - 2018 by Cliff Stanford
367              
368             This library is free software; you can redistribute it and/or modify
369             it under the same terms as Perl itself, either Perl version 5.10.1 or,
370             at your option, any later version of Perl 5 you may have available.
371              
372             =cut
373              
374             1;