123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125 |
- package SugarTrail::Template::Master;
- # Master template holder
- # new()
- # parse()
- # _parse_headers()
- # _parse_body()
-
- use strict;
- use warnings;
- use Carp;
- use SugarTrail::Template::Slave;
- use SugarTrail::Template::Condition;
-
- sub new {
- my $class = shift;
- my $args = { @_ };
- my $self = {};
- $self->{args} = $args;
- $self->{parsed} = 0;
- return bless $self, $class;
- }
-
- sub parse {
- my $self = shift;
- my ($head, $body) = split "\n\n", $self->{text}, 2;
- $self->{head} = $head;
- $self->{body} = $body;
- my @counts = (
- $self->_parse_headers(),
- $self->_parse_body()
- );
- $self->{parsed}++;
- return @counts;
- }
-
- sub _parse_headers {
- my $self = shift;
- foreach (split "\n", $self->{head}) {
- my ($n, $v) = split ": ", $_, 2;
- $self->{meta}->{$n} = $v;
- }
- return scalar keys %{ $self->{meta} };
- }
-
- sub _parse_body {
- my $self = shift;
- $self->{steps} = [];
- foreach (split "\n", $self->{body}) {
- chomp; s/ *$//;
- my @conds;
- my ($line, $cond_block) = $_ =~ m/^(.*?)(\{(.*)\})?$/;
- $line =~ s/ *$//;
- if ($cond_block) {
- $cond_block =~ s/\}$//;
- $cond_block =~ s/^\{//;
- @conds = split m/\s*;\s*/, $cond_block;
- }
- push @{ $self->{steps} }, { line => $line, conds => \@conds };
- }
- return scalar @{ $self->{steps} };
- }
-
- sub generate_slave {
- my $self = shift;
- my $args = shift;
- $self->parse() unless $self->{parsed};
-
- #create an "empty" slave
- my $slave = SugarTrail::Template::Slave->new($args);
-
- my @slave_steps;
- STEP: foreach my $master_step (@{ $self->{steps} }) {
- my $accept = 1; # accept by default
- my $slave_step = {
- line => $master_step->{line},
- warnings => []
- };
- # test against each condition from the pre-parsed condblock
- # if any number of condition warnings is found, accept
- # otherwise accept step unless a condition failed
- COND: foreach my $condstr (@{ $master_step->{conds} }) {
- my $c = SugarTrail::Template::Condition->new($condstr);
- my ($r, $w) = $c->match($args);
-
- # if warnings, store them, prepare to accept and ignore result
- if (scalar @$w) {
- $accept = 1;
- push @{$slave_step->{warnings}}, @$w;
- next COND;
- } else {
- # point of no warnings -- refusal should be valid here
- $accept = 0 unless $r;
- }
- }
-
- push @slave_steps, $slave_step
- if ($accept || scalar @{$slave_step->{warnings}});
- }
-
- $slave->{meta}->{'Stm'} = $self->{stm};
- $slave->{meta}->{'Stm Revision'} = $self->get_current_revision();
- $slave->{meta}->{'Params'} = mkmymime($args);
-
- $slave->{steps} = \@slave_steps;
- return $slave;
- }
-
- # skel: returns time (might be useful in absence of VCS)
- sub get_current_revision {
- return time;
- }
-
- sub mkmymime {
- my $d = shift;
- my $d1 = "; "; my $d2 = "=";
- my @t;
- foreach (sort keys %$d) {
- push @t, $_ . $d2 . $d->{$_};
- }
- return join $d1, @t;
- }
-
- sub source { return $_[0]->{text} }
-
- 1;
|