File Coverage

blib/lib/Variable/Expand/AnyLevel.pm
Criterion Covered Total %
statement 60 60 100.0
branch 4 4 100.0
condition n/a
subroutine 15 15 100.0
pod 1 1 100.0
total 80 80 100.0


line stmt bran cond sub pod time code
1             package Variable::Expand::AnyLevel;
2 2     2   43640 use parent qw(Exporter);
  2         609  
  2         12  
3 2     2   92 use strict;
  2         4  
  2         40  
4 2     2   10 use warnings;
  2         7  
  2         160  
5             our $VERSION = '0.03';
6             our @EXPORT_OK = qw(expand_variable);
7 2     2   1399 use PadWalker qw(peek_my);
  2         1344  
  2         629  
8              
9             =head1 NAME
10              
11             Variable::Expand::AnyLevel - expand variables exist at any level.
12              
13             =head1 SYNOPSIS
14              
15             use Variable::Expand::AnyLevel qw(expand_variable);
16             my $value1 = 'aaa';
17             my $value2 = expand_variable('$value1', 0);
18             # $value2 is 'aaa';
19              
20             =head1 DESCRIPTION
21              
22             Variable::Expand::AnyLevel enables to expand variables which exist at any level. (level means same as Carp or PadWalker)
23              
24             =cut
25              
26             =head1 FUNCTIONS
27              
28             =cut
29              
30             =head2 expand_variable($string, $peek_level, $options_href)
31              
32             Expand variable in $string which exists in $peek_level. $peek_level is same as caller().
33              
34             If stringify option specified(it is default) $string is correctly expanded. For example,
35              
36             my $aa = 'aa';
37             my $result = $expand_variable('$aa 123', 0);
38              
39             $result is expanded 'aa 123'
40              
41             If stringify option is set to '0', $string is not expanded.
42              
43             my $aa = 'aa';
44             my $result = $expand_variable('$aa 123', 0, { stringify => '0' });
45              
46             $result is undef.
47              
48              
49             available options are as follows
50              
51             stringify: stringify variable(1) or not(0). default value is 1
52              
53             =cut
54              
55             sub expand_variable {
56 10     10 1 39 my ($string, $peek_level, $options_href) = @_;
57              
58 10         86 my $walker = peek_my($peek_level + 1);
59 10         17 my $value = undef;
60 10         20 my $variable_gen_code = "sub {\n";
61 10         16 $variable_gen_code .= " no warnings 'all';\n";
62              
63 10         21 my %values = ();
64 10         15 for my $variable_name ( keys %{ $walker } ) {
  10         42  
65 24         49 my $sigil = substr $variable_name, 0, 1;
66 24         52 $values{$variable_name} = $walker->{$variable_name};
67 24         74 $variable_gen_code .= " my $variable_name = ${sigil}{ \$values{ '$variable_name' } };\n";
68             }
69 10 100       36 my $stringify = defined $options_href->{stringify} ? $options_href->{stringify} : 1;
70 10 100       21 if ( !$stringify ) {
71 2         8 $variable_gen_code .= " return $string;\n";
72             }
73             else {
74 8         23 $variable_gen_code .= " return \"$string\";\n";
75             }
76 10         14 $variable_gen_code .= "}->()\n";
77             #warn $variable_gen_code; use Data::Dumper; warn Dumper(\%values);
78             ## no critic
79 10     1   916 eval "\$value = $variable_gen_code";
  1     1   6  
  1     1   2  
  1     1   84  
  1     1   7  
  1     1   3  
  1     1   79  
  1     1   7  
  1     1   3  
  1     1   95  
  1         7  
  1         2  
  1         110  
  1         7  
  1         3  
  1         96  
  1         8  
  1         2  
  1         105  
  1         7  
  1         2  
  1         108  
  1         7  
  1         2  
  1         119  
  1         7  
  1         2  
  1         120  
  1         16  
  1         3  
  1         115  
80             ## use critic
81 10         118 return $value;
82             }
83              
84              
85              
86              
87             1;
88             __END__