File Coverage

lib/Games/Checkers/DeclareConstant.pm
Criterion Covered Total %
statement 29 245 11.8
branch 4 6 66.6
condition 2 2 100.0
subroutine 6 7 85.7
pod n/a
total 41 260 15.7


line stmt bran cond sub pod time code
1             # Games::Checkers, Copyright (C) 1996-2012 Mikhael Goikhman, migo@cpan.org
2             #
3             # This program is free software: you can redistribute it and/or modify
4             # it under the terms of the GNU General Public License as published by
5             # the Free Software Foundation, either version 3 of the License, or
6             # (at your option) any later version.
7             #
8             # This program is distributed in the hope that it will be useful,
9             # but WITHOUT ANY WARRANTY; without even the implied warranty of
10             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11             # GNU General Public License for more details.
12             #
13             # You should have received a copy of the GNU General Public License
14             # along with this program. If not, see .
15              
16 1     1   5 use strict;
  1         2  
  1         21  
17 1     1   4 use warnings;
  1         2  
  1         28  
18              
19             package Games::Checkers::DeclareConstant;
20              
21             ## This is a general purpose module, kind of the next level of "use constant;".
22              
23             # keys are package names, values are hash of constants for the package
24 1     1   4 use vars qw($registered);
  1         2  
  1         62  
25             $registered = {};
26              
27             sub import ($;$$) {
28 3     3   804 my $caller = caller;
29 3 50       10 unless (exists $registered->{$caller}) {
30 1     1   5 no strict 'refs';
  1         1  
  1         231  
31 3         5 $registered->{$caller} = {};
32 3         14 *{"${caller}::import"} = sub ($) {
33 22     22   1681 my $caller2 = caller;
34 22         33 while (my ($name, $value) = each %{$registered->{$caller}}) {
  240         4654  
35 218         517 local $^W = 0; # 5.005 still produces redefined warnings...
36 218     0   11477 eval "*${caller2}::$name = sub () { \$value }";
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  1         3  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  2         15  
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
37 218 50       736 die $@ if $@;
38             }
39             }
40 3         10 }
41 3         4 shift;
42 3   100     13 my $constants = shift || return;
43 2 100       6 $constants = { $constants => shift } unless ref($constants) eq 'HASH';
44 2         50 $registered->{$caller}->{$_} = $constants->{$_} foreach keys %$constants;
45             }
46              
47             1;
48              
49             __END__