File Coverage

lib/constant/abs.pm
Criterion Covered Total %
statement 32 32 100.0
branch 9 12 75.0
condition 1 2 50.0
subroutine 5 5 100.0
pod n/a
total 47 51 92.1


line stmt bran cond sub pod time code
1             package constant::abs;
2              
3 2     2   40733 use strict;
  2         5  
  2         77  
4 2     2   11 use warnings;
  2         4  
  2         55  
5 2     2   10 use constant ();
  2         3  
  2         103  
6              
7 2 50   2   828 BEGIN { defined &DEBUG or *DEBUG = sub () { 0 } }
8              
9             =head1 NAME
10              
11             constant::abs - Perl pragma to declare previously constants using absolute name
12              
13             =head1 VERSION
14              
15             Version 0.01
16              
17             =cut
18              
19             our $VERSION = '0.01';
20              
21              
22             =head1 SYNOPSIS
23              
24             Define compile-time constant using full package name.
25             The main reason is to use for forward definition of debugging constants.
26             Created as an addition for C
27              
28             # complex way
29             # in main.pl
30             BEGIN { *My::Module::Debug = sub () { 1 }; }
31             use My::Module;
32              
33             ################
34              
35             # using this distribution
36             # in main.pl
37             use constant::abs 'My::Module::DEBUG' => 1;
38             use My::Module;
39              
40             Syntax is fully compatible with C
41              
42             =cut
43              
44             sub import {
45 4     4   4098 my $class = shift;
46 4 100       25 return unless @_;
47 3         6 my $pkg = caller;
48 3         5 my %const;
49 3 100       10 if (ref $_[0] eq 'HASH') {
50 1         2 %const = map { $_ => [ $_[0]->{$_} ] } keys %{$_[0]};
  1         7  
  1         5  
51             } else {
52 2 50       20 %const = ( $_[0] => [ @_ ? @_[1..$#_] : () ] );
53             }
54 3         10 for ( keys %const ) {
55 3         20 my ($pkg,$name) = $_ =~ m{^(?:(.+?)::|)([^:]+)$};
56 3         6 my @val = @{ $const{$_} };
  3         9  
57 3   50     9 $pkg ||= 'main';
58 3         4 DEBUG and warn "Abs definition for $pkg : $name = @val";
59 3         217 eval qq{
60             package $pkg;
61             constant::import( constant => \$name, \@val );
62             };
63 3 100       15 if (local $_ = $@) {
64 1         5 s{at \(eval \d+\) line \d+\s*$}{};
65 1         8 require Carp;
66 1         123 Carp::croak($_);
67             }
68 2 50       20 warn if $@;
69             }
70 2         99 return;
71             }
72              
73              
74             =head1 SEE ALSO
75              
76             L, L
77              
78             =head1 AUTHOR
79              
80             Mons Anderson, C<< >>
81              
82             =head1 COPYRIGHT & LICENSE
83              
84             Copyright 2009 Mons Anderson.
85              
86             This program is free software; you can redistribute it and/or modify it
87             under the same terms as Perl itself.
88              
89              
90             =cut
91              
92             1; # End of constant::abs