File Coverage

bin/cpppp

Criterion	Covered	Total	%
statement	63	112	56.2
branch	15	42	35.7
condition	3	18	16.6
subroutine	12	22	54.5
pod			n/a
total	93	194	47.9

#! /usr/bin/env perl
# PODNAME: cpppp
our $VERSION = '0.005'; # VERSION
# ABSTRACT: Command line tool to process cpppp templates
use v5.20;
use warnings;
use FindBin;
use experimental 'signatures';
use CodeGen::Cpppp;
use autouse 'Pod::Usage' => 'pod2usage';
use Getopt::Long;


our @original_argv= @ARGV;
our @script;
my %param;
our %option_spec= (
   'param|p=s'             => sub { set_param(split /=/, $_[1], 2) },
   'features=s'            => sub { set_feature($_) for split ',', $_[1] },
   'dump-pl'               => \my $opt_dump_pl,
   'list-sections'         => \my $opt_list_sections,
   'convert-linecomment-to-c89' => \my $convert_linecomment_to_c89,
   'call=s'                => sub { push @script, [ 'call_method', $_[1] ] },
   'eval=s'                => sub { push @script, [ 'do_eval', $_[1] ] },
   'out|section-out|o=s'   => sub { push @script, [ 'output', $_[1] ] },
   '<>'                    => sub { push @script, [ 'process_tpl', $_[0] ] },
   'help'                  => sub { pod2usage(1) },
   'version'               => sub { say CodeGen::Cpppp->VERSION; exit 0 },
);
GetOptions(%option_spec) or pod2usage(2);

# If no 'process_tpl' item exists, create one from STDIN.
unless (grep $_->[0] eq 'process_tpl', @script) {
   unshift @script, [ 'process_tpl', \*STDIN, 'stdin' ];
   # warn unsuspecting users
   STDERR->print("(reading template from stdin)\n")
      if -t STDIN && -t STDERR;
}
# 'process_tpl' needs to happen before any other action in the @script
# but the user may have specified the file name last.
if ($script[0][0] ne 'process_tpl') {
   my $i= 0;
   ++$i while $script[$i][0] ne 'process_tpl';
   unshift @script, splice(@script, $i, 1);
}
# --list-sections suppresses output
if ($opt_list_sections) {
   @script= grep $_->[0] ne 'output', @script;
}
elsif (!grep $_->[0] eq 'output') {
   # If there was no 'out' specified, add one to STDOUT
   push @script, [ 'output', '-' ];
}

sub set_param($var, $value) {
   $var =~ /^( [\$\@\%]? ) [\w_]+ $/x
      or die "Parameter name '$var' is not valid\n";
   if ($1) {
      my $expr= $1 eq '$'? '$param{$var}='.$value
         : $1 eq '@'? '$param{$var}=['.$value.']'
         : '$param{$var}={'.$value.'}';
      # Automatically require modules mentioned in the expression
      while (/\b([A-Za-z][\w_]+(::[A-Za-z0-9][\w_]+)+)\b/) {
         my $fname= $1 . '.pm';
         $fname =~ s,::,/,g;
         eval { require $fname };
      }
      eval "use strict; use warnings; $expr; 1"
         or die "Error evaluating parameter '$var': $@\n";
   } else {
      $param{'$'.$var} //= $value;
      $param{'@'.$var} //= [ split ',', $value ]
         if $value =~ /,/;
      my ($k, $v);
      $param{'%'.$var} //= { map +(($k,$v)=split('=',$_,2)), split ',', $value }
         if $value =~ /=/;
   }
}
sub set_feature($expr) {
   my ($k, $v)= split '=', $expr, 2;
   set_param("feature_$k", $v // 1);
}

my $cpppp= CodeGen::Cpppp->new(
   convert_linecomment_to_c89 => $convert_linecomment_to_c89,
);

my $tpl;
sub process_tpl(@input_args) {
   if ($opt_dump_pl) {
      my $parse= $cpppp->parse_cpppp(@input_args);
      my $code= $cpppp->_gen_perl_template_package($parse, with_data => 1);
      my $sec= $input_args[1] // $input_args[0];
      $cpppp->output->declare_sections($sec);
      $cpppp->output->append($sec, $code)
   } else {
      my $tpl_class= $cpppp->compile_cpppp(@input_args);
      my $tpl_params= $tpl_class->coerce_parameters(\%param);
      $tpl= $cpppp->new_template($tpl_class, $tpl_params);
   }
}

sub do_eval($code) {
   eval $code or die "Eval '$code' failed: $@\n";
}

sub call_method($code) {
   defined $tpl or die "No template is defined, for --call";
   do_eval("\$tpl->$code");
}

sub output($spec) {
   my ($filespec, $sections)= reverse split /=/, $spec, 2;
   if ($filespec eq '-' || !length $filespec) {
      print $cpppp->get_filtered_output($sections);
   } else {
      $cpppp->write_sections_to_file($sections, split('@', $filespec, 2));
   }
   $cpppp->output->consume(defined $sections? ($sections) : ());
}

# All the global options are taken care of.  Now execute the "script options"
# in the order they were given.
for (@script) {
   my ($method, @args)= @$_;
   $method= main->can($method) or die 'bug';
   $method->(@args);
}

if ($opt_list_sections) {
   say "name\tline_count";
   for my $s ($cpppp->output->section_list) {
      my $line_count= ()= $cpppp->output->get($s) =~ /\n/g;
      say "$s\t$line_count";
   }
   exit 0;
}

# Lets a template main::re_exec(@different_args)
sub re_exec(@new_argv) {
   exec($^X, "$FindBin::RealBin/$FindBin::RealScript", @new_argv)
      or die "exec: $!";
}

__END__