File Coverage

blib/lib/Plosurin/Writer/Perl5.pm
Criterion Covered Total %
statement 43 46 93.4
branch 6 8 75.0
condition 2 5 40.0
subroutine 15 16 93.7
pod 0 13 0.0
total 66 88 75.0


line stmt bran cond sub pod time code
1             #===============================================================================
2             #
3             # DESCRIPTION: Perl 5 Writer
4             #
5             # AUTHOR: Aliaksandr P. Zahatski, <zahatski@gmail.com>
6             #===============================================================================
7             =head1 NAME
8              
9             Plosurin::Writer::Perl5 - perl5 writer
10              
11             =head1 SYNOPSIS
12              
13             my $p5 = new Plosurin::To::Perl5(
14             'context' => $ctx,
15             'writer' => new Plosurin::Writer::Perl5,
16             'package' => $package,
17             );
18              
19            
20             =head1 DESCRIPTION
21              
22             Plosurin::Writer::Perl5 - perl6 writer
23              
24             =cut
25              
26             package Plosurin::Writer::Perl5;
27 2     2   493 use strict;
  2         6  
  2         61  
28 2     2   13 use warnings;
  2         5  
  2         60  
29 2     2   28 use v5.10;
  2         7  
30             our $VERSION = '0.01';
31              
32             sub new {
33 3     3 0 21 my $class = shift;
34 3 50       17 my $ini = $#_ == 0 ? shift : {@_};
35 3         15 $ini->{varstack} = [ { name => 'res', inited => 0 } ];
36 3         10 $ini->{ident} = 0;
37 3   50     20 $ini->{var_map} //={};
38 3   33     35 bless( $ini, ref($class) || $class );
39              
40             }
41              
42             #ident for generated code
43             sub inc_ident {
44 5     5 0 13 $_[0]->{ident} += 4;
45             }
46              
47 27     27 0 114 sub ident { $_[0]->{ident} }
48              
49             sub dec_ident {
50 5     5 0 9 my $self = shift;
51 5 50       19 $self->{ident} -= 4 if $self->{ident} > 3;
52             }
53              
54             sub say {
55 23     23 0 33 my $self = shift;
56 23         42 return $self->print( @_, "\n" );
57             }
58              
59             sub print {
60 27     27 0 41 my $self = shift;
61 27         55 $self->{code} .= " " x $self->ident . "@_";
62             }
63              
64             sub pushOtputVar {
65 2     2 0 6 my ( $self, $var ) = @_;
66 2         3 push @{ $self->{varstack} }, { name => $var, value => '' };
  2         10  
67              
68             }
69              
70             sub popOtputVar {
71 0     0 0 0 my ( $self, $var ) = @_;
72 0         0 pop @{ $self->{varstack} }; #, {name=> $var, value=>''};
  0         0  
73             }
74              
75             sub initOutputVar {
76 3     3 0 8 my $self = shift;
77 3 100       9 return if $self->currentVar->{inited};
78 1         4 $self->say( 'my $' . $self->currentVar->{name} . ' = "";' );
79 1         3 $self->currentVar->{inited}++;
80             }
81              
82             sub currentVar {
83 12     12 0 23 my $self = shift;
84 12         32 $self->{varstack}[-1];
85             }
86              
87             sub appendOutputVar {
88 7     7 0 12 my $self = shift;
89 7         18 my $data = join '', @_;
90 7         19 my $v = $self->currentVar;
91 7         15 my $name = $v->{name};
92 7 100       19 unless ( $v->{inited} ) {
93 3         18 $self->say( 'my $' . $name . ' = ' . $data . ';' );
94 3         19 $v->{inited}++;
95             }
96             else {
97 4         17 $self->say( '$' . $name . ' .= ' . $data . ';' )
98              
99             }
100             }
101              
102             sub var_map {
103 4     4 0 7 my $self = shift;
104 4         20 return $self->{var_map};
105             }
106              
107             sub set_var_map {
108 1     1 0 5 my ($self, $tmp_var, $new_var) = @_;
109 1         4 $self->var_map()->{$tmp_var} =$new_var;
110             }
111             1;
112             __END__
113              
114             =head1 SEE ALSO
115              
116             Closure Templates Documentation L<http://code.google.com/closure/templates/docs/overview.html>
117              
118             Perl 6 implementation L<https://github.com/zag/plosurin>
119              
120              
121             =head1 AUTHOR
122              
123             Zahatski Aliaksandr, <zag@cpan.org>
124              
125             =head1 COPYRIGHT AND LICENSE
126              
127             Copyright (C) 2011 by Zahatski Aliaksandr
128              
129             This library is free software; you can redistribute it and/or modify
130             it under the same terms as Perl itself.
131              
132             =cut
133