File Coverage

blib/lib/qbit/Packages.pm
Criterion Covered Total %
statement 27 49 55.1
branch 0 4 0.0
condition 0 5 0.0
subroutine 9 13 69.2
pod n/a
total 36 71 50.7


line stmt bran cond sub pod time code
1              
2             =head1 Name
3              
4             qbit::Packages - Functions to manipulate data in packages.
5              
6             =cut
7              
8             package qbit::Packages;
9             $qbit::Packages::VERSION = '2.2';
10 8     8   33 use strict;
  8         14  
  8         200  
11 8     8   29 use warnings;
  8         11  
  8         197  
12 8     8   28 use utf8;
  8         10  
  8         47  
13              
14 8     8   164 use base qw(Exporter);
  8         10  
  8         611  
15              
16 8     8   35 use Data::Dumper;
  8         10  
  8         862  
17             require qbit::StringUtils;
18              
19             BEGIN {
20 8     8   19 our (@EXPORT, @EXPORT_OK);
21              
22 8         26 @EXPORT = qw(
23             package_sym_table
24             package_stash
25             package_merge_isa_data
26             require_class
27             );
28 8         321 @EXPORT_OK = @EXPORT;
29             }
30              
31             =head1 Functions
32              
33             =head2 package_sym_table
34              
35             B
36              
37             =over
38              
39             =item
40              
41             B<$package> - string, package name.
42              
43             =back
44              
45             B hash ref, all package's symbols.
46              
47             =cut
48              
49             sub package_sym_table($) {
50 0     0     my ($package) = @_;
51              
52 8     8   35 no strict 'refs';
  8         11  
  8         615  
53 0           return \%{$package . '::'};
  0            
54             }
55              
56             =head2 package_stash
57              
58             B
59              
60             =over
61              
62             =item
63              
64             B<$package> - string, package name.
65              
66             =back
67              
68             B hash ref, package stash.
69              
70             =cut
71              
72             sub package_stash($) {
73 0     0     my ($package) = @_;
74              
75 8     8   31 no strict 'refs';
  8         9  
  8         650  
76 0 0         *{$package . '::QBitStash'} = {} unless *{$package . '::QBitStash'};
  0            
  0            
77 0           return \%{$package . '::QBitStash'};
  0            
78             }
79              
80             =head2 package_merge_isa_data
81              
82             B
83              
84             =over
85              
86             =item
87              
88             B<$package> - string, package name;
89              
90             =item
91              
92             B<$res> - scalar, result's stash;
93              
94             =item
95              
96             B<$func> - code, function to merge. Arguments:
97              
98             =over
99              
100             =item
101              
102             B<$package> - string, package name;
103              
104             =item
105              
106             B<$res> - scalar, result's stash;
107              
108             =back
109              
110             =item
111              
112             B<$baseclass> - string, upper level package name.
113              
114             =back
115              
116             Recursive merge data into $res from all levels packages hierarchy.
117              
118             =cut
119              
120             sub package_merge_isa_data {
121 0     0     my ($package, $res, $func, $baseclass) = @_;
122              
123 0           my $isa;
124             {
125 8     8   27 no strict 'refs';
  8         10  
  8         1270  
  0            
126 0           $isa = \@{$package . '::ISA'};
  0            
127             }
128 0           foreach my $pkg (@$isa) {
129 0 0 0       next if defined($baseclass) && !$pkg->isa($baseclass);
130 0           package_merge_isa_data($pkg, $res, $func, $baseclass);
131             }
132              
133 0           $func->($package, $res);
134             }
135              
136             =head2 require_class
137              
138             B
139              
140             =over
141              
142             =item
143              
144             B<$class> - string, class name.
145              
146             =back
147              
148             Convert class name to .pm file path and require it.
149              
150             B return value of CORE::require if all is Ok or throw Exception if cannot load .pm file.
151              
152             =cut
153              
154             sub require_class {
155 0     0     my ($class) = @_;
156              
157 0           $class = "$class.pm";
158 0           $class =~ s/::/\//g;
159              
160 0   0       return require($class) || die die "Cannot requre file \"$class\": " . qbit::StringUtils::fix_utf($!);
161             }
162              
163             1;