File Coverage

blib/lib/NetSDS/Util/Misc.pm
Criterion Covered Total %
statement 24 52 46.1
branch 0 8 0.0
condition 0 6 0.0
subroutine 8 15 53.3
pod 6 6 100.0
total 38 87 43.6


line stmt bran cond sub pod time code
1             #===============================================================================
2             #
3             # FILE: Misc.pm
4             #
5             # DESCRIPTION:
6             #
7             # NOTES: ---
8             # AUTHOR: Michael Bochkaryov (Rattler), <misha@rattler.kiev.ua>
9             # COMPANY: Net.Style
10             # VERSION: 1.044
11             # CREATED: 17.08.2008 17:01:48 EEST
12             #===============================================================================
13              
14             =head1 NAME
15              
16             NetSDS::Util::Misc - miscelaneous utilities
17              
18             =head1 SYNOPSIS
19              
20             use NetSDS::Util::Misc;
21              
22             =head1 DESCRIPTION
23              
24             C<NetSDS::Util::Misc> module contains miscelaneous functions.
25              
26             =cut
27              
28             package NetSDS::Util::Misc;
29              
30 2     2   8431 use 5.8.0;
  2         10  
  2         211  
31 2     2   14 use warnings 'all';
  2         6  
  2         139  
32 2     2   14 use strict;
  2         5  
  2         240  
33              
34 2     2   14 use base 'Exporter';
  2         4  
  2         223  
35              
36 2     2   12 use version; our $VERSION = '1.044';
  2         6  
  2         17  
37              
38             our @EXPORT = qw(
39             cmp_version
40             usage
41             get_cli
42             make_uuid
43             csv_num
44             format_msisdn
45             );
46              
47 2     2   3052 use Getopt::Long;
  2         36403  
  2         16  
48 2     2   2918 use Pod::Usage;
  2         163786  
  2         352  
49 2     2   2073 use Data::UUID;
  2         9748  
  2         1548  
50              
51             #***********************************************************************
52              
53             =head1 EXPORTED FUNCTIONS
54              
55             =over
56              
57             =item B<cmp_version($ver1, $ver2)> - compare versions
58              
59             Funcion comapres two version strings.
60              
61             =cut
62              
63             #-----------------------------------------------------------------------
64             sub cmp_version {
65 0     0 1   my ( $ver1, $ver2 ) = @_;
66              
67 0           return sprintf( "%03d.%03d", split( m/\./, $ver1 ) ) cmp sprintf( "%03d.%03d", split( m/\./, $ver2 ) );
68             }
69              
70             #***********************************************************************
71              
72             =item B<usage(...)> - print C<usage> text
73              
74             This function is wapper to L<Pod::Usage> module printing POD to STDERR.
75              
76             =cut
77              
78             #-----------------------------------------------------------------------
79             sub usage {
80 0     0 1   pod2usage(
81             -message => sprintf( shift(@_), @_ ),
82             -verbose => 0,
83             -exitval => 2,
84             -output => \*STDERR
85             );
86             }
87              
88             #***********************************************************************
89              
90             =item B<get_cli(...)> - get CLI parameters
91              
92             Return command line arguments
93              
94             =cut
95              
96             #-----------------------------------------------------------------------
97             sub get_cli {
98 0     0 1   my ( $res, @opa ) = @_;
99              
100 0           my $ret = undef;
101 0           my @argv = @ARGV; # save @ARGV
102             {
103             # Switch off warnings because of other CLI parameters
104             # still not known
105 0           my $warn = $SIG{__WARN__};
  0            
106 0     0     $SIG{__WARN__} = sub { };
  0            
107 0           $ret = GetOptions( $res, @opa, 'help|h|?', 'man|m' );
108 0           $SIG{__WARN__} = $warn;
109             }
110 0           @ARGV = @argv; # restore @ARGV
111              
112             # GetOptions bug workaround
113             # if ( !$ret ) {
114             # pod2usage( -verbose => 0, -exitval => 2, -output => \*STDERR );
115             # } elsif ( exists( $res->{help} ) and $res->{help} ) {
116 0 0 0       if ( exists( $res->{help} ) and $res->{help} ) {
    0 0        
117 0           pod2usage( -verbose => 1, -exitval => 2, -output => \*STDERR );
118             } elsif ( exists( $res->{man} ) and $res->{man} ) {
119 0           pod2usage( -verbose => 2, -exitval => 2, -output => \*STDERR );
120             }
121              
122 0           return $res;
123             } ## end sub get_cli
124              
125             #***********************************************************************
126              
127             =item B<make_uuid()> - make UUD string
128              
129             Create upper case UUID string.
130              
131             =cut
132              
133             #-----------------------------------------------------------------------
134             sub make_uuid {
135              
136 0     0 1   return Data::UUID->new()->create_str();
137              
138             }
139              
140             #***********************************************************************
141              
142             =item B<csv_num($num)> - format number for CSV
143              
144             Paramters: numeric value
145              
146             Returns: CSV formatted
147              
148             =cut
149              
150             sub csv_num {
151              
152 0     0 1   my ($num) = @_;
153 0           $num =~ s/\./,/g;
154 0           $num = "\"$num\"";
155              
156 0           return $num;
157             }
158              
159             #***********************************************************************
160              
161             =item B<format_msisdn($msisdn)> - format MSISDN
162              
163             Paramters: phone number
164              
165             Returns: well formed MSISDN without leading +.
166              
167             =cut
168              
169             #-----------------------------------------------------------------------
170              
171             sub format_msisdn {
172              
173 0     0 1   my ($msisdn) = @_;
174              
175 0           $msisdn =~ s/[\-\(\)\.\s]//g;
176              
177 0 0         if ( $msisdn =~ /^\+?(\d{12})$/ ) {
    0          
178 0           return $1;
179             } elsif ( $msisdn =~ /^\s*(\d{9,12})\s*$/ ) {
180 0           return "380" . substr( $msisdn, length($1) - 9, 9 );
181             } else {
182 0           return undef;
183             }
184              
185             }
186              
187             #**************************************************************************
188             1;
189             __END__
190              
191             =back
192              
193             =head1 EXAMPLES
194              
195             None
196              
197             =head1 BUGS
198              
199             None
200              
201             =head1 TODO
202              
203             1. Add other encodings support
204              
205             =head1 SEE ALSO
206              
207             L<Pod::Usage>, L<Data::UUID>
208              
209             =head1 AUTHORS
210              
211             Valentyn Solomko <pere@pere.org.ua>
212              
213             Michael Bochkaryov <misha@rattler.kiev.ua>
214              
215             =cut