File Coverage

blib/lib/NetSDS/Util/Types.pm
Criterion Covered Total %
statement 21 43 48.8
branch 0 26 0.0
condition 0 15 0.0
subroutine 7 16 43.7
pod 9 9 100.0
total 37 109 33.9


line stmt bran cond sub pod time code
1             #===============================================================================
2             #
3             # FILE: Types.pm
4             #
5             # DESCRIPTION:
6             #
7             # NOTES: ---
8             # AUTHOR: Michael Bochkaryov (Rattler),
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::Types - type checking routines
17              
18             =head1 SYNOPSIS
19              
20             use NetSDS::Util::Types;
21              
22             # Check if variable contains integer value
23             if (is_int($var)) {
24             $var++;
25             } else {
26             print "Value is not integer!";
27             }
28              
29             =head1 DESCRIPTION
30              
31             C module contains functions for
32             checking data for being of exact data types.
33              
34             =cut
35              
36             package NetSDS::Util::Types;
37              
38 2     2   4384 use 5.8.0;
  2         6  
  2         77  
39 2     2   8 use warnings 'all';
  2         2  
  2         74  
40 2     2   17 use strict;
  2         2  
  2         116  
41              
42 2     2   14 use base 'Exporter';
  2         2  
  2         147  
43              
44 2     2   10 use version; our $VERSION = '1.044';
  2         2  
  2         29  
45              
46 2     2   128 use POSIX;
  2         2  
  2         15  
47              
48 2         1165 use Scalar::Util qw(
49             blessed
50             reftype
51 2     2   3500 );
  2         4  
52              
53             our @EXPORT = qw(
54             is_int
55             is_float
56             is_date
57             is_binary
58             is_ref_scalar
59             is_ref_array
60             is_ref_hash
61             is_ref_code
62             is_ref_obj
63             );
64              
65             #***********************************************************************
66              
67             =head1 EXPORTED FUNCTIONS
68              
69             =over
70              
71             =item B - check if parameter is integer
72              
73             Check if given parameter is integer
74              
75             =cut
76              
77             #-----------------------------------------------------------------------
78             sub is_int {
79 0     0 1   my ($value) = @_;
80              
81 0 0         return 0 unless defined $value;
82              
83 0 0 0       return ( ( $value =~ /^[-+]?\d+$/ ) and ( $value >= INT_MIN ) and ( $value <= INT_MAX ) ) ? 1 : 0;
84             }
85              
86             #***********************************************************************
87              
88             =item B - check if parameter is float number
89              
90             Check if given parameter is float number
91              
92             =cut
93              
94             #-----------------------------------------------------------------------
95             sub is_float {
96 0     0 1   my ($value) = @_;
97              
98 0 0         return 0 unless defined $value;
99              
100             # return ( ( $value =~ m/^[-+]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([-+]?\d+))?$/ ) and ( ( $value >= 0 ) and ( $value >= DBL_MIN() ) and ( $value <= DBL_MAX() ) ) or ( ( $value < 0 ) and ( $value >= -DBL_MAX() ) and ( $value <= -DBL_MIN() ) ) ) ? 1 : 0;
101 0 0         return ( $value =~ m/^[-+]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([-+]?\d+))?$/ ) ? 1 : 0;
102             }
103              
104             #***********************************************************************
105              
106             =item B - check if parameter is date string
107              
108             Return 1 if parameter is date string
109              
110             =cut
111              
112             #-----------------------------------------------------------------------
113             sub is_date {
114 0     0 1   my ($value) = @_;
115              
116 0 0         return 0 unless defined $value;
117              
118 0 0         return ( $value =~ m/^\d{8}T\d{2}:\d{2}:\d{2}(Z|[-+]\d{1,2}(?::\d{2})*)$/ ) ? 1 : 0;
119             }
120              
121             #***********************************************************************
122              
123             =item B - check for binary content
124              
125             Return 1 if parameter is non text.
126              
127             =cut
128              
129             #-----------------------------------------------------------------------
130             sub is_binary {
131 0     0 1   my ($value) = @_;
132              
133 0 0         if ( has_utf8($value) ) {
134 0           return 0;
135             } else {
136 0 0         return ( $value =~ m/[^\x09\x0a\x0d\x20-\x7f[:print:]]/ ) ? 1 : 0;
137             }
138             }
139              
140             #**************************************************************************
141              
142             =item B - check if reference to scalar value
143              
144             Return true if parameter is a scalar reference.
145              
146             my $var = 'Scalar string';
147             if (is_ref_scalar(\$var)) {
148             print "It's scalar value";
149             }
150              
151             =cut
152              
153             #-----------------------------------------------------------------------
154             sub is_ref_scalar {
155 0     0 1   my $ref = reftype( $_[0] );
156              
157 0 0 0       return ( $ref and ( $ref eq 'SCALAR' ) ) ? 1 : 0;
158             }
159              
160             #***********************************************************************
161              
162             =item B - check if reference to array
163              
164             Return true if parameter is an array reference.
165              
166             =cut
167              
168             #-----------------------------------------------------------------------
169             sub is_ref_array {
170 0     0 1   my $ref = reftype( $_[0] );
171              
172 0 0 0       return ( $ref and ( $ref eq 'ARRAY' ) ) ? 1 : 0;
173             }
174              
175             #***********************************************************************
176              
177             =item B - check if hashref
178              
179             Return true if parameter is a hash reference.
180              
181             =cut
182              
183             #-----------------------------------------------------------------------
184             sub is_ref_hash {
185 0     0 1   my $ref = reftype( $_[0] );
186              
187 0 0 0       return ( $ref and ( $ref eq 'HASH' ) ) ? 1 : 0;
188             }
189              
190             #***********************************************************************
191              
192             =item B - check if code reference
193              
194             Return true if parameter is a code reference.
195              
196             =cut
197              
198             #-----------------------------------------------------------------------
199             sub is_ref_code {
200 0     0 1   my $ref = reftype( $_[0] );
201              
202 0 0 0       return ( $ref and ( $ref eq 'CODE' ) ) ? 1 : 0;
203             }
204              
205             #***********************************************************************
206              
207             =item B - check if blessed object
208              
209             Return true if parameter is an object.
210              
211             =cut
212              
213             #-----------------------------------------------------------------------
214             sub is_ref_obj {
215 0 0   0 1   return blessed( $_[0] ) ? 1 : 0;
216             }
217              
218             1;
219             __END__