File Coverage

blib/lib/Net/Radio/Modem/Adapter/Static.pm
Criterion Covered Total %
statement 33 35 94.2
branch 4 6 66.6
condition 3 6 50.0
subroutine 8 8 100.0
pod 3 3 100.0
total 51 58 87.9


line stmt bran cond sub pod time code
1             package Net::Radio::Modem::Adapter::Static;
2              
3 1     1   81 use 5.010;
  1         4  
  1         48  
4              
5 1     1   6 use strict;
  1         2  
  1         30  
6 1     1   5 use warnings;
  1         2  
  1         40  
7              
8 1     1   5 use Carp qw(croak);
  1         1  
  1         89  
9              
10             =head1 NAME
11              
12             Net::Radio::Modem::Adapter::Static - static modem information adapter
13              
14             =head1 DESCRIPTION
15              
16             Allows mocking by defining static information for radio modems.
17              
18             =head1 SYNOPSIS
19              
20             use Net::Radio::Modem;
21             my $modem = Net::Radio::Modem->new('Static',
22             '/test_0' => {
23             MNC => '262', MCC => '02', IMSI => '262020555017753',
24             LAC => ...},
25             '/test_1' => { ... } ... );
26             my @modems = $modem->get_modems(); # returns ('/test_0', 'test_1', ...)
27             my $local_modem = grep {
28             $modem->get_modem_property($_, 'MobileCountryCode') == 364
29             } @modems; # find the one for Bahamas
30              
31             To fill in reasonable value, see
32              
33             =over 4
34              
35             =item *
36              
37             L
38              
39             =item *
40              
41             L
42              
43             =back
44              
45             =cut
46              
47             our $VERSION = '0.002';
48 1     1   4 use base qw(Net::Radio::Modem::Adapter);
  1         1  
  1         620  
49              
50             =head1 METHODS
51              
52             =head2 new
53              
54             Instantiates new static modem adapter.
55              
56             B: clone (depending on refcount?) provided information to allow
57             further modification in caller.
58              
59             =cut
60              
61             sub new
62             {
63 2     2 1 4 my $class = shift;
64 2         3 my %params;
65              
66 2 100 66     16 if ( scalar(@_) == 1 and ref( $_[0] ) eq "HASH" )
    50          
67             {
68 1         20 %params = %{ $_[0] };
  1         10  
69             }
70             elsif ( 0 == ( scalar(@_) % 2 ) )
71             {
72 1         4 %params = @_;
73             }
74             else
75             {
76 0         0 croak("Expecting hash or hash reference as argument(s)");
77             }
78              
79 2         5 my %info;
80 2         7 foreach my $modem ( keys %params )
81             {
82 10         11 foreach my $property ( keys %{ $params{$modem} } )
  10         29  
83             {
84 36         63 my $value = $params{$modem}->{$property};
85 36         108 $property = __PACKAGE__->get_alias_for($property);
86 36         134 $info{$modem}->{$property} = $value;
87             }
88             }
89              
90 2         17 return bless( { config => \%info }, $class );
91             }
92              
93             =head2 get_modems
94              
95             Returns the keys of given initialisation hash as list of known modems.
96              
97             =cut
98              
99             sub get_modems
100             {
101 2     2 1 2 return keys %{ $_[0]->{config} };
  2         18  
102             }
103              
104             =head2 get_modem_property
105              
106             Return the specified modem property, when known. Empty value otherwise.
107              
108             =cut
109              
110             sub get_modem_property
111             {
112 40     40 1 60 my ( $self, $modem, $property ) = @_;
113              
114 40 50 33     416 defined( $self->{config}->{$modem} )
115             and defined( $self->{config}->{$modem}->{$property} )
116             and return $self->{config}->{$modem}->{$property};
117              
118 0           return;
119             }
120              
121             =head1 BUGS
122              
123             Please report any bugs or feature requests to C, or through
124             the web interface at L. I will be notified, and then you'll
125             automatically be notified of progress on your bug as I make changes.
126              
127             If you think you've found a bug then please read "How to Report Bugs
128             Effectively" by Simon Tatham:
129             L.
130              
131             =head1 SUPPORT
132              
133             You can find documentation for this module with the perldoc command.
134              
135             perldoc Net::Radio::Modem
136              
137             You can also look for information at:
138              
139             =over 4
140              
141             =item * RT: CPAN's request tracker (report bugs here)
142              
143             L
144              
145             If you think you've found a bug then please read "How to Report Bugs
146             Effectively" by Simon Tatham:
147             L.
148              
149             =item * AnnoCPAN: Annotated CPAN documentation
150              
151             L
152              
153             =item * CPAN Ratings
154              
155             L
156              
157             =item * Search CPAN
158              
159             L
160              
161             =back
162              
163             =head2 Where can I go for help with a concrete version?
164              
165             Bugs and feature requests are accepted against the latest version
166             only. To get patches for earlier versions, you need to get an
167             agreement with a developer of your choice - who may or not report the
168             issue and a suggested fix upstream (depends on the license you have
169             chosen).
170              
171             =head2 Business support and maintenance
172              
173             For business support you can contact Jens via his CPAN email
174             address rehsackATcpan.org. Please keep in mind that business
175             support is neither available for free nor are you eligible to
176             receive any support based on the license distributed with this
177             package.
178              
179             =head1 ACKNOWLEDGEMENTS
180              
181             =head1 AUTHOR
182              
183             Jens Rehsack, C<< >>
184              
185             =head1 LICENSE AND COPYRIGHT
186              
187             Copyright 2012 Jens Rehsack.
188              
189             This program is free software; you can redistribute it and/or modify it
190             under the terms of either: the GNU General Public License as published
191             by the Free Software Foundation; or the Artistic License.
192              
193             See http://dev.perl.org/licenses/ for more information.
194              
195             =cut
196              
197             1;