File Coverage

blib/lib/CTK/TFVals.pm
Criterion Covered Total %
statement 87 110 79.0
branch 61 84 72.6
condition 21 49 42.8
subroutine 25 36 69.4
pod 30 30 100.0
total 224 309 72.4


line stmt bran cond sub pod time code
1             package CTK::TFVals;
2 3     3   113187 use strict;
  3         24  
  3         80  
3 3     3   1035 use utf8;
  3         27  
  3         15  
4              
5             =encoding utf-8
6              
7             =head1 NAME
8              
9             CTK::TFVals - True & False values conversions
10              
11             =head1 VERSION
12              
13             Version 1.03
14              
15             =head1 SYNOPSIS
16              
17             use CTK::TFVals;
18              
19             # Undef conversions
20             uv2zero( $value ); # Returns 0 if value is undef
21             uv2null( $value ); # Returns "" if value is undef (null/empty/void)
22             # Aliases: uv2empty, uv2void
23              
24             # False conversions
25             fv2undef( $value ); # Returns undef if value is false
26             fv2zero( $value ); # Returns 0 if value is false
27             fv2null( $value ); # Returns "" if value is false (null/empty/void)
28             # Aliases: fv2empty, fv2void
29              
30             # True conversions
31             tv2num( $value ); # Returns 0 unless value ~ ([+-])?\d+
32             # Aliases: tv2number
33             # Check-function: is_num
34             tv2flt( $value ); # Returns 0 unless value ~ ([+-])?\d+\.?\d*
35             # Aliases: tv2float
36             # Check-function: is_flt
37             tv2int( $value ); # Returns 0 unless value ~ \d{1,11}
38             # Returns 0 unless value >= 0 && < 99999999999
39             # Check-function: is_int
40             tv2int8( $value ); # Returns 0 unless value >= 0 && < 255
41             # Check-function: is_int8
42             tv2int16( $value ); # Returns 0 unless value >= 0 && < 65535
43             # Check-function: is_int16
44             tv2int32( $value ); # Returns 0 unless value >= 0 && < 4294967295
45             # Check-function: is_int32
46             tv2int64( $value ); # Returns 0 unless value >= 0 && < 2**64
47             # Check-function: is_int64
48             tv2intx( $value, $x ); # Returns 0 unless value >= 0 && < 2**$x
49             # Check-function: is_intx
50              
51             =head1 DESCRIPTION
52              
53             True & False values conversions
54              
55             =head2 FUNCTIONS
56              
57             =over 8
58              
59             =item B
60              
61             This function returns the 0 value if argument is undef.
62              
63             uv2zero( $value );
64              
65             =item B
66              
67             This function returns the "" value if argument is undef.
68              
69             uv2null( $value );
70              
71             =item B
72              
73             See L
74              
75             =item B
76              
77             See L
78              
79             =item B
80              
81             This function returns the undev value if argument is false.
82              
83             fv2undef( $value );
84              
85             =item B
86              
87             This function returns the 0 value if argument is false.
88              
89             fv2zero( $value );
90              
91             =item B
92              
93             This function returns the "" value if argument is false.
94              
95             fv2null( $value );
96              
97             =item B
98              
99             See L
100              
101             =item B
102              
103             See L
104              
105             =item B
106              
107             This function returns the 0 value unless argument ~ ([+-])?\d+
108              
109             tv2num( $value );
110              
111             =item B
112              
113             See L
114              
115             =item B
116              
117             This function returns the 0 value unless argument ~ ([+-])?\d+\.?\d*
118              
119             tv2flt( $value );
120              
121             =item B
122              
123             See L
124              
125             =item B
126              
127             This function returns the 0 value unless argument ~ \d{1,11} and
128             argument value > 0 && < 99999999999
129              
130             tv2int( $value );
131              
132             =item B
133              
134             This function returns the 0 value unless argument value >= 0 && < 255
135              
136             tv2int8( $value );
137              
138             =item B
139              
140             This function returns the 0 value unless argument value >= 0 && < 65535
141              
142             tv2int16( $value );
143              
144             =item B
145              
146             This function returns the 0 value unless argument value >= 0 && < 4294967295
147              
148             tv2int32( $value );
149              
150             =item B
151              
152             This function returns the 0 value unless argument value >= 0 && < 2**64
153              
154             tv2int64( $value );
155              
156             =item B
157              
158             This function returns the 0 value unless argument value >= 0 && < 2**$x
159              
160             tv2int64( $value, $x );
161              
162             =item B
163              
164             This function returns true if argument ~ ([+-])?\d+
165              
166             is_num( $value );
167              
168             =item B
169              
170             This function returns true if argument ~ ([+-])?\d+\.?\d*
171              
172             is_flt( $value );
173              
174             =item B
175              
176             This function returns true if argument ~ \d{1,20} and
177             argument value >= 0 && < 99999999999999999999
178              
179             is_int( $value );
180              
181             =item B
182              
183             This function returns true if argument value >= 0 && < 255
184              
185             is_int8( $value );
186              
187             =item B
188              
189             This function returns true if argument value >= 0 && < 65535
190              
191             is_int16( $value );
192              
193             =item B
194              
195             This function returns true if argument value >= 0 && < 4294967295
196              
197             is_int32( $value );
198              
199             =item B
200              
201             This function returns true if argument value >= 0 && < 2**64
202              
203             is_int64( $value );
204              
205             =item B
206              
207             This function returns true if argument value >= 0 && < 2**$x
208              
209             is_intx( $value, $x );
210              
211             =item B
212              
213             print "Void" if is_void({});
214              
215             Returns true if the structure contains useful data.
216             Useful data - this data is different from the value undef
217              
218             =item B, B
219              
220             print "NOT Void" if isnt_void({foo=>undef});
221              
222             Returns true if the structure does not contain any nested useful data.
223             Useful data - this data is different from the value undef
224              
225             =back
226              
227             =head2 TAGS
228              
229             =head3 :ALL
230              
231             Export all subroutines:
232              
233             L, L, L, L,
234             L, L, L, L, L,
235             L, L, L,
236             L, L, L,
237             L, L,
238             L, L,
239             L, L,
240             L, L,
241             L, L,
242             L, L,
243             L, L, L
244              
245             =head3 :DEFAULT
246              
247             L, L, L, L,
248             L, L, L, L, L,
249             L, L, L
250              
251             =head3 :UNDEF
252              
253             L, L, L, L
254              
255             =head3 :FALSE
256              
257             L, L, L, L, L
258              
259             =head3 :TRUE
260              
261             L, L, L, L, L,
262             L, L, L, L, L
263              
264             =head3 :CHCK, :CHECK
265              
266             L, L, L, L, L,
267             L, L, L,
268             L, L, L
269              
270             =head1 HISTORY
271              
272             See C file
273              
274             =head1 TO DO
275              
276             See C file
277              
278             =head1 BUGS
279              
280             * none noted
281              
282             =head1 AUTHOR
283              
284             Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE
285              
286             =head1 COPYRIGHT
287              
288             Copyright (C) 1998-2022 D&D Corporation. All Rights Reserved
289              
290             =head1 LICENSE
291              
292             This program is free software; you can redistribute it and/or
293             modify it under the same terms as Perl itself.
294              
295             See C file and L
296              
297             =cut
298              
299 3     3   202 use vars qw/$VERSION/;
  3         4  
  3         172  
300             $VERSION = '1.03';
301              
302 3     3   16 use base qw /Exporter/;
  3         4  
  3         357  
303              
304 3     3   16 use Carp;
  3         5  
  3         150  
305              
306 3     3   14 use constant MAX_DEPTH => 32;
  3         5  
  3         4242  
307              
308             # default
309             our @EXPORT = (qw/
310             uv2zero uv2null uv2empty uv2void
311             fv2undef fv2zero fv2null fv2empty fv2void
312             tv2num tv2int tv2flt
313             /);
314             # Required
315             our @EXPORT_OK = (qw/
316             uv2zero uv2null uv2empty uv2void
317             fv2undef fv2zero fv2null fv2empty fv2void
318             tv2num tv2number is_num
319             tv2flt tv2float is_flt
320             tv2int is_int
321             tv2int8 is_int8
322             tv2int16 is_int16
323             tv2int32 is_int32
324             tv2int64 is_int64
325             tv2intx is_intx
326             is_void isnt_void is_not_void
327             /);
328              
329             # Tags
330             our %EXPORT_TAGS = (
331             DEFAULT => [@EXPORT],
332             ALL => [@EXPORT_OK],
333             UNDEF => [qw/
334             uv2zero uv2null uv2empty uv2void
335             /],
336             FALSE => [qw/
337             fv2undef fv2zero fv2null fv2empty fv2void
338             /],
339             TRUE => [qw/
340             tv2num tv2number
341             tv2flt tv2float
342             tv2int tv2int8 tv2int16 tv2int32 tv2int64 tv2intx
343             /],
344             CHCK => [qw/
345             is_num is_flt is_int is_int8 is_int16 is_int32 is_int64 is_intx
346             is_void isnt_void is_not_void
347             /],
348             CHECK => [qw/
349             is_num is_flt is_int is_int8 is_int16 is_int32 is_int64 is_intx
350             is_void isnt_void is_not_void
351             /],
352             );
353              
354             sub uv2zero($) {
355 4     4 1 77 my $v = shift;
356 4 100       13 return 0 unless defined $v;
357 3         10 return $v;
358             }
359             sub uv2null($) {
360 0     0 1 0 my $v = shift;
361 0 0       0 return '' unless defined $v;
362 0         0 return $v;
363             }
364 0     0 1 0 sub uv2empty($) { goto &uv2null }
365 0     0 1 0 sub uv2void($) { goto &uv2null }
366             sub fv2undef($) {
367 0     0 1 0 my $v = shift;
368 0 0       0 return undef unless $v;
369 0         0 return $v;
370             }
371             sub fv2zero($) {
372 50     50 1 55 my $v = shift;
373 50 100       91 return 0 unless $v;
374 27         32 return $v;
375             }
376             sub fv2null($) {
377 0     0 1 0 my $v = shift;
378 0 0       0 return '' unless $v;
379 0         0 return $v;
380             }
381 0     0 1 0 sub fv2empty($) { goto &fv2null }
382 0     0 1 0 sub fv2void($) { goto &fv2null }
383             sub tv2num($) {
384 5     5 1 15 my $tv = shift;
385 5 100       13 return is_num($tv) ? $tv : 0;
386             }
387 0     0 1 0 sub tv2number($) { goto &tv2num }
388             sub is_num($) {
389 5     5 1 6 my $v = shift;
390 5 100       15 return 0 unless defined $v;
391 4 100       24 return 1 if $v =~ /^[+\-]?[0-9]{1,20}$/; # 64 bit
392 2         9 return 0;
393             }
394             sub tv2flt($) {
395 3     3 1 5 my $tv = shift;
396 3 100       7 return is_flt($tv) ? $tv : 0;
397             }
398 0     0 1 0 sub tv2float($) { goto &tv2flt }
399             sub is_flt($) {
400 3     3 1 4 my $v = shift;
401 3 100       10 return 0 unless defined $v;
402 2 50       27 return 1 if $v =~ /^[+\-]?[0-9]{1,20}\.?[0-9]*$/; # 64 bit min
403 0         0 return 0;
404             }
405             sub tv2int($) {
406 3     3 1 4 my $tv = shift;
407 3 100       7 return is_int($tv) ? $tv : 0;
408             }
409             sub is_int($) {
410 53     53 1 58 my $v = shift;
411 53 100       100 return 0 unless defined $v;
412 52 50       269 return 1 if $v =~ /^[0-9]{1,20}$/; # 64 bit max
413 0         0 return 0;
414             }
415             sub tv2int8($) {
416 2     2 1 4 my $tv = shift;
417 2 100       4 return is_int8($tv) ? $tv : 0;
418             }
419             sub is_int8($) {
420 26     26 1 29 my $v = shift;
421 26 50       40 return 0 unless defined $v;
422 26 100 33     153 return 1 if ($v =~ /^[0-9]{1,3}$/) && ($v >= 0) && ($v < 2**8);
      66        
423 1         5 return 0;
424             }
425             sub tv2int16($) {
426 2     2 1 4 my $tv = shift;
427 2 100       4 return is_int16($tv) ? $tv : 0;
428             }
429             sub is_int16($) {
430 2     2 1 3 my $v = shift;
431 2 50       5 return 0 unless defined $v;
432 2 100 33     26 return 1 if ($v =~ /^[0-9]{1,5}$/) && ($v >= 0) && ($v < 2**16);
      66        
433 1         4 return 0;
434             }
435             sub tv2int32($) {
436 2     2 1 4 my $tv = shift;
437 2 100       5 return is_int32($tv) ? $tv : 0;
438             }
439             sub is_int32($) {
440 2     2 1 4 my $v = shift;
441 2 50       4 return 0 unless defined $v;
442 2 100 33     27 return 1 if ($v =~ /^[0-9]{1,10}$/) && ($v >= 0) && ($v < 2**32);
      66        
443 1         5 return 0;
444             }
445             sub tv2int64($) {
446 0     0 1 0 my $tv = shift;
447 0 0       0 return is_int64($tv) ? $tv : 0;
448             }
449             sub is_int64($) {
450 0     0 1 0 my $v = shift;
451 0 0       0 return 0 unless defined $v;
452 0 0 0     0 return 1 if ($v =~ /^[0-9]{1,20}$/) && ($v >= 0) && ($v < 2**64);
      0        
453 0         0 return 0;
454             }
455              
456             sub tv2intx($$) {
457 2     2 1 5 my $tv = shift;
458 2   50     5 my $x = shift || 0;
459 2 100       5 return is_intx($tv, $x) ? $tv : 0;
460             }
461             sub is_intx($$) {
462 3     3 1 5 my $v = shift;
463 3   50     6 my $x = shift || 0;
464 3 50 33     10 return 0 unless $x && is_int8($x) && ($x >=0) && ($x <= 64);
      33        
      33        
465 3 50       8 return 0 unless defined $v;
466 3 100 33     26 return 1 if ($v =~ /^[0-9]{1,20}$/) && ($v >= 0) && ($v < 2**$x);
      66        
467 1         5 return 0;
468             }
469              
470             sub is_void {
471 46     46 1 129 my $struct = shift;
472 46         59 my $depth = fv2zero(shift);
473 46 100       73 return 1 unless defined($struct); # CATCHED! THIS IS REAL UNDEFINED VALUE
474 42 100 66     138 return 0 if defined($struct) && !ref($struct); # VALUE, NOT REFERENCE
475 35 100 66     47 if (is_int($depth) && $depth > 0) {
476 20 50       29 croak("Depth value MUST BE between 0 and 255") unless is_int8($depth);
477             } else {
478 15 50       26 croak("Depth value IS NOT integer") unless is_int($depth);
479             }
480 35         44 $depth++;
481 35 50       61 return 0 if $depth >= MAX_DEPTH; # Exit from the recursion
482              
483 35         44 my $t = ref($struct);
484 35 100       67 if ($t eq 'SCALAR') {
    100          
    100          
485 2         6 return is_void($$struct, $depth)
486             } elsif ($t eq 'ARRAY') {
487 26         42 for (@$struct) {
488 25 100       38 return 0 unless is_void($_, $depth);
489             }
490 15         33 return 1; # DEFINED DATA NOT FOUND - VOID
491             } elsif ($t eq 'HASH') {
492 4 100       19 return 0 if keys(%$struct);
493 2         7 return 1; # DEFINED DATA NOT FOUND - VOID
494             }
495              
496             # CODE, REF, GLOB, LVALUE, FORMAT, IO, VSTRING and Regexp are not supported here
497 3         20 return 0; # NOT VOID
498             }
499 12 50   12 1 20 sub is_not_void {is_void(@_) ? 0 : 1}
500 12     12 1 33 sub isnt_void { goto &is_not_void }
501              
502             1;
503              
504             __END__