File Coverage

blib/lib/ODS/Utils.pm
Criterion Covered Total %
statement 96 97 98.9
branch 11 16 68.7
condition n/a
subroutine 24 24 100.0
pod 0 11 0.0
total 131 148 88.5


line stmt bran cond sub pod time code
1             package ODS::Utils;
2              
3 74     74   448 use YAOO;
  74         89  
  74         363  
4 74     74   21611 no strict 'refs';
  74         143  
  74         1694  
5 74     74   28426 use Data::GUID;
  74         1209340  
  74         391  
6 74     74   42406 use File::Copy qw/move/;
  74         145459  
  74         3772  
7 74     74   456 use Carp qw/croak/;
  74         79  
  74         2828  
8 74     74   438 use Scalar::Util qw//;
  74         142  
  74         1108  
9 74     74   37404 use Data::Dumper qw/Dumper/;
  74         380514  
  74         3934  
10 74     74   33055 use Email::Valid;
  74         7721082  
  74         7985  
11 74     74   31406 use Phone::Valid::International::Loose qw/valid_phone/;
  74         35729  
  74         1987  
12              
13             our ( %EX, %EX2);
14              
15             BEGIN {
16 74     74   21528 %EX = (
17             load => [qw/all/],
18             clone => [qw/all/],
19             unique_class_name => [qw/all/],
20             build_temp_class => [qw/all/],
21             move => [qw/all/],
22             deep_unblessed => [qw/all/],
23             valid_email => [qw/all/],
24             valid_phone => [qw/all/],
25             reftype => [qw/all/],
26             read_file => [qw/all file_dir/],
27             write_file => [qw/all file_dir/],
28             read_directory => [qw/all file_dir/],
29             write_directory => [qw/all file_dir/],
30             croak => [qw/error/],
31             Dumper => [qw/error/]
32             );
33 74         626 for my $ex (keys %EX) {
34 1096         1376 for (@{ $EX{$ex} }) {
  1096         1811  
35 1388         1698 push @{ $EX2{$_} }, $ex;
  1388         65290  
36             }
37             }
38             }
39              
40             sub import {
41 575     575   2061 my ($self, @functions) = @_;
42              
43 575         1937 my $caller = caller();
44              
45 575         1439 for my $fun (@functions) {
46 1089 100       11183 if ($EX{$fun}) {
    50          
47 721         777 YAOO::make_keyword($caller, $fun, *{"${self}::${fun}"});
  721         5287  
48             } elsif ($EX2{$fun}) {
49 369         554 for (@{ $EX2{$fun} }) {
  369         1702  
50 739         4662 YAOO::make_keyword($caller, $_, *{"${self}::${_}"});
  739         4681  
51             }
52             }
53             }
54              
55             }
56              
57             sub valid_email {
58 3     3 0 18 Email::Valid->address(shift);
59             }
60              
61             sub clone {
62 39428     39428 0 44524 my ($c) = @_;
63 39428         56875 my $n = bless YAOO::deep_clone_ordered_hash($c), ref $c;
64 39428         4372715 return $n;
65             }
66              
67             sub load {
68 1975     1975 0 4414 my ($module) = shift;
69 1975         9591 (my $require = $module) =~ s/\:\:/\//g;
70 1975         304719 require $require . '.pm';
71 1776         51817 return $module;
72             }
73              
74             sub unique_class_name {
75 1877     1877 0 34274 return 'A' . join("", split("-", Data::GUID->new->as_string()));
76             }
77              
78             sub build_temp_class {
79 165     165 0 451 my ($class) = @_;
80 165         468 load $class;
81 165         1100 my $temp = $class . '::' . unique_class_name();
82 165         39418 my $c = sprintf(
83             q|
84             package %s;
85             use YAOO;
86             extends '%s';
87             1;
88             |, $temp, $class );
89 165     73   19815 eval $c;
  72     70   794  
  72         317  
  72         369  
  70         480  
  70         420  
  70         898  
90 165         988 return $temp;
91             }
92              
93             sub deep_unblessed {
94 5     5 0 8 my ($obj) = @_;
95 5         15 $obj = YAOO::deep_clone($obj);
96 5         33 return $obj;
97             }
98              
99             sub read_file {
100 1     1 0 3 my ($file) = @_;
101 1 0       3 open my $fh, '<:encoding(UTF-8)', $file or croak "Cannot open the file for reading: $file $!";
102 1         4 my $data = do { local $/; <$fh> };
  1         2  
  1         6  
103 1         5 close $fh;
104 1         8 return $data;
105             }
106              
107             sub write_file {
108 4     4 0 33 my ($file, $data) = @_;
109 3         8 write_directory($file, 1);
110 3 50       156 open my $fh, '>:encoding(UTF-8)', $file or croak "Cannot open the file for writing: $file $!";
111 3         1566 print $fh $data;
112 3         110 close $fh;
113 3         16 return $file;
114             }
115              
116             sub read_directory {
117 1     2 0 6 my ($directory) = @_;
118 1 50       53 opendir(my $dh, $directory) or croak "Cannot open directory: $directory $!";
119 1         33 my @files = sort { $a cmp $b } grep { $_ !~ m/^\./ } readdir($dh);
  0         0  
  3         13  
120 1         13 closedir $dh;
121 1         7 return @files;
122             }
123              
124             sub write_directory {
125 3701     3702 0 9608 my ($directory, $pop) = @_;
126 3701         22006 my @dir = split "\/", $directory;
127 3701 100       11949 pop @dir if ($pop);
128 3701         8052 my $path = '';
129 3701         10912 while (@dir) {
130 18502 100       42282 $path .= "/" if $path;
131 18502         22522 $path .= shift @dir;
132 18502 100       314377 mkdir $path unless -d $path;
133             }
134 3701         14318 return $directory;
135             }
136              
137             sub reftype {
138 8     9 0 44 Scalar::Util::reftype $_[0];
139             }
140              
141             1;