File Coverage

blib/lib/Bb/Collaborate/Ultra/Util.pm
Criterion Covered Total %
statement 34 38 89.4
branch 29 40 72.5
condition 2 3 66.6
subroutine 6 6 100.0
pod n/a
total 71 87 81.6


line stmt bran cond sub pod time code
1             package Bb::Collaborate::Ultra::Util;
2              
3             =head1 NAME
4              
5             Bb::Collaborate::Ultra::Util - Utility functions for Collaborate Ultra
6              
7             =head1 DESCRIPTION
8              
9             For internal use only.
10              
11             =cut
12              
13 6     6   21 use warnings; use strict;
  6     6   22  
  6         148  
  6         18  
  6         7  
  6         93  
14 6     6   19 use Scalar::Util;
  6         6  
  6         290  
15 6     6   394 use Date::Parse qw;
  6         4698  
  6         2954  
16             sub _freeze {
17 18     18   18 my ($val, $type) = @_;
18              
19 18         20 for ($val) {
20              
21 18 50       20 if (!defined) {
22 0         0 warn "undefined value of type $type\n"
23             }
24             else {
25 18         11 my $raw_val = $_;
26              
27 18 100       29 if ($type =~ m{^Bool}ix) {
    100          
    50          
    100          
    50          
28              
29             #
30             # DBize boolean flags..
31             #
32 3 100       18 $_ = $_ ? 'true' : 'false';
33             }
34             elsif ($type =~ m{^(Str|enum)}ix) {
35              
36             #
37             # low level check for taintness. Only applicable when
38             # perl program is running in taint mode
39             #
40 9 50       68 die "attempt to freeze tainted data (type $type): $_"
41             if Scalar::Util::tainted($_);
42             #
43             # l-r trim
44             #
45 9 50       42 $_ = $1
46             if m{^ \s* (.*?) \s* $}x;
47 9 100       14 $_ = lc if $type =~ m{^enum};
48             }
49             elsif ($type =~ m{^Int}ix) {
50 0         0 $_ = $_ + 0;
51             }
52             elsif ($type =~ m{^Date}) {
53 4         48 my ($sec,$min,$hr,$day,$mon,$year) = gmtime $_;
54 4         21 $_ = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
55             $year+1900, $mon+1, $day, $hr, $min, $sec;
56             }
57             elsif ($type =~ m{^Ref|Any|Hash}ix) {
58             # pass through
59             }
60             else {
61 2 50       47 die "unable to convert $raw_val to $type\n"
62             unless defined;
63             }
64             }
65             };
66              
67 18         68 return $val;
68             }
69              
70             #
71             # thawing of elementary data-types
72             #
73              
74             sub _thaw {
75 24     24   25 my ($val, $type) = @_;
76              
77 24 100 66     82 return $val
78             if !defined $val || $type =~ m{Ref|Array}i;
79              
80 22         131 for ($val) {
81              
82 22 100       26 if ($type =~ m{^Bool}i) {
    100          
    50          
    50          
    0          
83             #
84             # Perlise boolean flags..
85             #
86 6 100       65 $_ = m{^(true|1)$}i ? 1 : 0;
87             }
88             elsif ($type =~ m{^(Str|enum)}i) {
89             #
90             # l-r trim
91             #
92 8 50       75 $_ = $1
93             if m{^ \s* (.*?) \s* $}x;
94 8 100       11 $_ = lc if $type =~ m{^enum}i;
95             }
96             elsif ($type =~ m{^Int}i) {
97 0         0 $_ = $_ + 0;
98             }
99             elsif ($type =~ m{^Date}) {
100 8         89 $_ = str2time $_;
101             }
102             elsif ($type =~ m{^Ref|Any|Hash}ix) {
103             # pass through
104             }
105             else {
106 0         0 die "unknown type: $type";
107             }
108             };
109              
110 22         1102 return $val;
111             }
112              
113             1;