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   27759 use parent qw(Exporter);
  2         454  
  2         9  
3 2     2   90 use strict;
  2         3  
  2         30  
4 2     2   9 use warnings;
  2         7  
  2         86  
5             our $VERSION = '0.05';
6             our @EXPORT_OK = qw(expand_variable);
7 2     2   659 use PadWalker qw(peek_my);
  2         932  
  2         441  
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 42 my ($string, $peek_level, $options_href) = @_;
57              
58 10         77 my $walker = peek_my($peek_level + 1);
59 10         19 my $value = undef;
60 10         17 my $variable_gen_code = "sub {\n";
61 10         18 $variable_gen_code .= " no warnings 'all';\n";
62              
63 10         21 my %values = ();
64 10         16 for my $variable_name ( keys %{ $walker } ) {
  10         33  
65 24         43 my $sigil = substr $variable_name, 0, 1;
66 24         42 $values{$variable_name} = $walker->{$variable_name};
67 24         54 $variable_gen_code .= " my $variable_name = ${sigil}{ \$values{ '$variable_name' } };\n";
68             }
69 10 100       28 my $stringify = defined $options_href->{stringify} ? $options_href->{stringify} : 1;
70 10 100       24 if ( !$stringify ) {
71 2         5 $variable_gen_code .= " return $string;\n";
72             }
73             else {
74 8         16 $variable_gen_code .= " return \"$string\";\n";
75             }
76 10         15 $variable_gen_code .= "}->()\n";
77             #warn $variable_gen_code; use Data::Dumper; warn Dumper(\%values);
78             ## no critic
79 10     1   606 eval "\$value = $variable_gen_code";
  1     1   7  
  1     1   2  
  1     1   71  
  1     1   6  
  1     1   2  
  1     1   50  
  1     1   6  
  1     1   2  
  1     1   86  
  1         6  
  1         2  
  1         59  
  1         6  
  1         2  
  1         62  
  1         7  
  1         2  
  1         70  
  1         6  
  1         3  
  1         74  
  1         6  
  1         2  
  1         71  
  1         5  
  1         2  
  1         91  
  1         6  
  1         2  
  1         76  
80             ## use critic
81 10         125 return $value;
82             }
83              
84              
85              
86              
87             1;
88             __END__