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	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.4';
10	8			8	30	use strict;
	8				8
	8				195
11	8			8	24	use warnings;
	8				11
	8				164
12	8			8	27	use utf8;
	8				10
	8				37
13
14	8			8	146	use base qw(Exporter);
	8				8
	8				542
15
16	8			8	29	use Data::Dumper;
	8				8
	8				679
17						require qbit::StringUtils;
18
19						BEGIN {
20	8			8	9	our (@EXPORT, @EXPORT_OK);
21
22	8				18	@EXPORT = qw(
23						package_sym_table
24						package_stash
25						package_merge_isa_data
26						require_class
27						);
28	8				284	@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	40	no strict 'refs';
	8				14
	8				484
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	29	no strict 'refs';
	8				15
	8				580
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	25	no strict 'refs';
	8				8
	8				1177
	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;