File Coverage

blib/lib/Text/MicroMason/AllowGlobals.pm
Criterion Covered Total %
statement 28 28 100.0
branch 6 8 75.0
condition n/a
subroutine 6 6 100.0
pod 4 4 100.0
total 44 46 95.6


line stmt bran cond sub pod time code
1             package Text::MicroMason::AllowGlobals;
2              
3 1     1   62511 use strict;
  1         2  
  1         32  
4 1     1   4 use Carp;
  1         0  
  1         334  
5              
6             ######################################################################
7              
8             sub allow_globals {
9 8     8 1 9 my $self = shift;
10 8         8 my $globals = $self->{allow_globals};
11 8 50       20 my @current = ref( $globals ) ? @$globals :
    100          
12             ! defined( $globals ) ? () :
13             split ' ' , $globals;
14            
15 8 100       15 if ( scalar @_ ) {
16 4         4 my %once_each;
17 4         5 @current = grep { ! ( $once_each{$_} ++ ) } @current, @_;
  5         28  
18 4         9 $self->{allow_globals} = \@current;
19             }
20            
21 8 50       49 wantarray ? @current : join(' ', @current);
22             }
23              
24             ######################################################################
25              
26             sub set_globals {
27 1     1 1 3 my ( $self, %globals ) = @_;
28            
29 1         3 my @globals = keys %globals;
30 1         2 $self->allow_globals( @globals );
31            
32             my $sub = join( "\n",
33             $self->allow_globals_statement(),
34             " sub { ",
35             map( {
36 1         2 my $var = $_; $var =~ s/^[\@\%]/*/; $var =~ s/^(\w)/\$$1/;
  1         1  
  1         2  
  1         2  
37 1         3 "$var = \$_[0]{'$_'};"
38             } @globals ),
39             " }"
40             );
41            
42 1         4 $self->eval_sub( $sub )->( \%globals )
43             }
44              
45             ######################################################################
46              
47             sub allow_globals_statement {
48 4     4 1 4 my $self = shift;
49 4         6 "use vars qw(" . $self->allow_globals() . ");"
50             }
51              
52             sub assemble {
53 3     3 1 3 my $self = shift;
54 3         5 $self->NEXT('assemble', once => $self->allow_globals_statement(), @_);
55             }
56              
57             ######################################################################
58              
59             1;
60              
61             __END__