File Coverage

blib/lib/Plosurin/To/Perl5.pm

Criterion	Covered	Total	%
statement	126	172	73.2
branch	5	20	25.0
condition	4	15	26.6
subroutine	22	27	81.4
pod	6	18	33.3
total	163	252	64.6

#===============================================================================
#
#  DESCRIPTION:  Export to Perl 5
#
#       AUTHOR:  Aliaksandr P. Zahatski, <[e-mail]>
#===============================================================================
=head1 NAME

Plosurin::To::Perl5 - export to Perl 5

=head1 SYNOPSIS

    my $p5  = new Plosurin::To::Perl5(
           'context' => $ctx,
           'writer'  => new Plosurin::Writer::Perl5,
           'package' => $package,
        );


=head1 DESCRIPTION

Plosurin::To::Perl5 - export to Perl 5

=cut
package Plosurin::To::Perl5;
use strict;
use warnings;
use v5.10;
use Data::Dumper;
use Plosurin::AbstractVisiter;
use base 'Plosurin::AbstractVisiter';
our $VERSION = '0.01';

=head2 new context=>$ctx, writer=>$writer, package=>"Tmpl"


=cut

sub new {
    my $class = shift;
    my $self = bless( $#_ == 0 ? shift : {@_}, ref($class) || $class );
    $self->{nodeid} = 1;
    $self->{package} //= "Tmpl";
    $self;
}

=head2 writer or wr
Return current writer object.
    $self->wr
    $self->writer
=cut

sub writer { $_[0]->{writer} }
sub wr     { $_[0]->{writer} }

=head2 context or ctx
 retrun current context
=cut

sub context { $_[0]->{context} }
sub ctx     { $_[0]->{context} }



sub start_write {
    my $self = shift;
    my $w    = $self->wr;
    return if $w->{start_write_done}++;
    $w->print(<<"TXT");
# Please don't edit this file by hand.
package $self->{package};
use strict;
use utf8;
=head1 NAME

$self->{package} - set of generated teplates

=head1 SYNOPSIS

 use $self->{package};
 print &$self->{package}::some_template(key1=>val1);

=head1 DESCRIPTION

$self->{package} - set of generated teplates by plosurin

=cut

TXT

}

sub end_write {
    my $self = shift;
    $self->wr->print(<<TMPL);
1;
__END__

=head1 SEE ALSO

Closure Templates Documentation L<http://code.google.com/closure/templates/docs/overview.html>

Perl 6 implementation L<https://github.com/zag/plosurin>

=cut
TMPL
}

sub write {
    my $self   = shift;
    my $writer = $self->{writer};
    foreach my $n (@_) {
        $self->visit($n);
    }
}

#Node container of command. <content>
sub Node {
    my $self = shift;
    my $node = shift;
    $self->visit_childs($node);
}

sub command_call_self {
    my ( $self, $n ) = @_;
    return $self->command_call($n);
}

sub command_call {
    my ( $self, $n ) = @_;
    my $w        = $self->wr;
    my $ctx      = $self->ctx;
    my $template = $n->{tmpl_name};
    my $tmpl     = $ctx->get_template_by_name($template);
    my $sub = $ctx->get_perl5_name($tmpl) || die "Not found template $template";

    #if data='all' or empty params
    # &sub(@_)
    my $attr = $n->attrs;
    if ( scalar( @{ $n->childs } ) == 0
        || exists $attr->{data} && $attr->{data} eq 'all' )
    {

        $w->appendOutputVar( '&' . $sub . '(@_)' );
    }
    else {

        #if need external var ?
        #$self-> !!!!!  #TODO
        #if not
        my @params = ();
        foreach my $ch (
            map { UNIVERSAL::isa( $_, 'Soy::Node' ) ? @{ $_->childs } : $_ }
            @{ $n->childs } )
        {

            # skip not param nodes
            next unless UNIVERSAL::isa( $ch, 'Soy::command_param' );
            my $vname = 'param' . ++${ $w->{nodeid} };
            $w->pushOtputVar($vname);
            $self->visit($ch);
            push @params, { name => $ch->{name}, vname => $vname };
            $w->popOtputVar;
        }
        $w->say(qq!# calling template: $template;!);
        $w->appendOutputVar(
                '&'
              . $sub . '('
              . join( ',',
                map { "'" . $$_{name} . q!' => $! . $$_{vname} } @params )
              . ')'
        );
    }
}

sub command_param {
    my ( $self, $node ) = @_;
    $self->visit_childs($node);
}

sub command_param_self {
    my ( $self, $node ) = @_;
    my $w = $self->wr;
    $w->appendOutputVar( $node->{value} );
}

sub raw_text {
    my ( $self, $node ) = @_;
    my $w = $self->wr;
    my $txt = $node->{''};
    #escape '
    $txt =~ s/'/\\'/g;
    $w->appendOutputVar("'$txt'");
}

=head2 File
Export File
=cut

sub File {
    my ( $self, $node ) = @_;
    my $w = $self->wr;

    #get tempales
    #    $self->visit_childs($node);
    #walk
    foreach my $t ( @{ $node->childs } ) {
        #setup current template
        #setup current params
        #make params map
        my %params = ();
        foreach my $p ($t->params()) {
            $params{$p->name} = 0;
        }
        #setup current template PARAMS
        $self->{PARAMS} = \%params;

        my $tmpl_name = $t->name;
        my $namespace = $node->namespace;
        ( my $converted_name = $namespace . $tmpl_name ) =~ tr/\./_/;
        $w->print(<<TMPL);
=head1 $converted_name

@{[ $t->comment ]}

( I<src>: C<@{[ $node->{file} ]}>, I<template name>: C<$tmpl_name> )

=cut

sub $converted_name \{
    my %args = \@_;
TMPL
        $w->inc_ident;
        my $vname = 'param' . ++${ $w->{nodeid} };
        $w->pushOtputVar($vname);

        #set current namespace (used for {call})
        $self->ctx->{namespace} = $namespace;

        #parse template
        $self->visit_childs($t);
        $w->initOutputVar();
        $w->say("return \$$vname;");
        $w->dec_ident;
        $w->say('}');
        $w->say(''); # empty line

        #collect statistic
        push @{ $self->{tmpls} },
          {
            tmpl         => $t,
            namespace    => $namespace,
            name         => $tmpl_name,
            perl5_name   => $converted_name,
            package_name => $self->{package} . "::" . $converted_name,
          };
        # clear current template PARAMS
        delete $self->{PARAMS};

    }
}
sub command_foreach {
    my ($self, $n) = @_;
    my $w    = $self->wr;
#    die Dumper $self->ctx;
    my $vname = $n->get_var_name();
    my $id = ++${ $w->{nodeid} };
    my $list_var =  "list_". $vname. $id;
    my $list_len_var = "len_". $vname. $id;
    my $exp = $n->{expression}->parse($w->var_map, $self->{PARAMS})->as_perl5();
    $w->say("my \$$list_var = ". $exp .";");
    $w->say("my \$$list_len_var = scalar(\@\$$list_var);");
    $w->initOutputVar();
    #check ifempty
    if ($n->get_ifempty) {
        $w->say("if ( \$$list_len_var > 0 ) {");
        $w->inc_ident();
    }
    #export foreach
    my $index_var_name = "idx_$vname".$id;
    $w->say("for (my \$$index_var_name = 0; \$$index_var_name < \$$list_len_var; \$$index_var_name++) {");
        $w->inc_ident();
        my $data_var_name = "data_$vname".$id;
        #map tempalte variable to actual name
        $w->set_var_map($vname,$data_var_name);
        #data variable
        $w->say("my \$$data_var_name = \$$list_var\->[\$$index_var_name];");
        $self->visit_childs($n);
        $w->dec_ident();
        $w->say('}');
    if (my $ifempty_node = $n->get_ifempty) {
        $w->dec_ident();
        $w->say('} else {');
        $w->inc_ident();
        $w->say('#ifempty content');
        $self->visit_childs($ifempty_node);
        $w->dec_ident();
        $w->say('} # ifempty');
     }

}

sub command_print {
    my ( $self, $n ) = @_;
    my $w    = $self->wr;
    my $p5_code = $n->{expression}->parse($w->var_map, , $self->{PARAMS})->as_perl5();
    $w->appendOutputVar($p5_code)
}

use Perl6::Pod::To::XHTML;
use Perl6::Pod::To;
use Perl6::Pod::Lib;
#pod6xhtml  -nb -t div -M Perl6::Pod::Lib -c \'=Include $file($rule)'
sub command_import {
    my ( $self, $n ) = @_;
    my $w    = $self->wr;
    my $file = $n->attrs->{file};
    my $rule = $n->attrs->{rule} || '';
    unless (-e $file ) {
        die "File for import : $file not found!"
    }
    my %args = (doctype =>'div', body=>0);
    my  $in_fd = "=Include $file" .( $rule ? "($rule)" : '');
    $in_fd = \"=begin pod \n$in_fd\n=end pod";
    my $str ='';
    open FH,'>',\$str;
    my $p = Perl6::Pod::To::to_abstract( 'Perl6::Pod::To::XHTML', \*FH, %args );
    $p->begin_input;
    #include libs ( see $Perl6::Pod::Lib::PERL6POD )
    my @libs = (qw/Perl6::Pod::Lib/);
    if (@libs) {
        my $use  = join "\n" => map { "=begin pod\n=use $_\n=end pod" } @libs;
        $use .= "\n";
        $p->_parse_chunk(\$use);
    }
    $p->_parse_chunk($in_fd);
    $p->end_input;
    close FH;
    #replace ' -> \'
    $str =~ s/\'/\\'/g;
    $w->appendOutputVar( qq!'$str'! );
}


1;
__END__

=head1 SEE ALSO

Closure Templates Documentation L<http://code.google.com/closure/templates/docs/overview.html>

Perl 6 implementation L<https://github.com/zag/plosurin>


=head1 AUTHOR

Zahatski Aliaksandr, <[e-mail]>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2011 by Zahatski Aliaksandr

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut