File Coverage

blib/lib/Defaults/Modern/Define.pm
Criterion Covered Total %
statement 26 26 100.0
branch 5 8 62.5
condition 1 3 33.3
subroutine 6 6 100.0
pod n/a
total 38 43 88.3


line stmt bran cond sub pod time code
1             package Defaults::Modern::Define;
2             $Defaults::Modern::Define::VERSION = '0.009003';
3 1     1   3 use strictures 2;
  1         8  
  1         32  
4              
5             =for Pod::Coverage .*
6              
7             =cut
8              
9             # Forked from TOBYINK's PerlX::Define, copyright Toby Inkster
10             # (... to avoid the Moops dep)
11             # This probably goes away if PerlX::Define gets pulled out later.
12              
13 1     1   153 use Carp ();
  1         1  
  1         13  
14              
15 1     1   5 use B ();
  1         1  
  1         19  
16 1     1   363 use Keyword::Simple ();
  1         21618  
  1         260  
17              
18             sub import {
19 10     10   1268 shift;
20 10 100       35 if (@_) {
21 2         3 my ($name, $val) = @_;
22 2         3 my $pkg = caller;
23 2 50       7 my $code = ref $val ?
24             qq[package $pkg; sub $name () { \$val }; 1;]
25 2         9 : qq[package $pkg; sub $name () { ${\ B::perlstring($val) } }; 1;];
26 2         3 local $@;
27 2 50 33     148 eval $code and not $@ or Carp::croak "eval: $@";
28             return
29 2         114 }
30              
31             Keyword::Simple::define( define => sub {
32 2     2   73 my ($line) = @_;
33 2 50       16 my ($ws1, $name, $ws2, $equals) =
34             ($$line =~ m{\A([\n\s]*)(\w+)([\n\s]*)(=\>?)}s)
35             or Carp::croak("Syntax error near 'define'");
36 2         5 my $len = length join '', $ws1, $name, $ws2, $equals;
37 2         78 substr $$line, 0, $len, ";use Defaults::Modern::Define $name => ";
38 8         56 });
39             }
40              
41             1;