sugar-trail/lib/SugarTrail/Template/Master.pm

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}++;
    delete $self->{text};
    return @counts;
}

sub _parse_headers {
    my $self    = shift;
    foreach (split "\n", $self->{head}) {
        my ($n, $v) = split ": ", $_, 2;
        $self->{meta}->{$n} = $v;
    }
    delete $self->{head};
    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;
        }
        my $step = { line => $line };
        $step->{conds} = \@conds if @conds;
        push @{ $self->{steps} }, $step;
    }
    delete $self->{body};
    return scalar @{ $self->{steps} };
}

sub generate_slave {
    my $self = shift;
    my $args = shift;
    my $slave = SugarTrail::Template::Slave->new($args);

    $self->parse() unless $self->{parsed};

    my @slave_steps;
    STEP: foreach my $master_step (@{ $self->{steps} }) {
        my $accept = 1;     # accept by default
        my $slave_step = {
            line        => $master_step->{line},
        };

        # Test against each condition from the pre-parsed condblock.
        # *   refuse step only in case all conditions passed without
        #     warnings
        # *   in all other cases (fail, warning), accept
        if ($master_step->{conds}) {
            COND: foreach my $condstr (@{ $master_step->{conds} }) {
                my $c = SugarTrail::Template::Condition->new($condstr);
                unless ($c) {
                    $self->{error} = "condition error: $c->{error}";
                    return;
                }
                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 || defined $slave_step->{warnings}
                        && scalar @{$slave_step->{warnings}});
    }

    $slave->{meta}->{'Master'} = $self->{source};
    $slave->{meta}->{'Master Revision'} = $self->{revision};
    $slave->{meta}->{'Params'} = mkmymime($args);

    $slave->{steps} = \@slave_steps;
    return $slave;
}

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;