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;

sub new {
    my $class = shift;
    my $args = { @_ };
    my $self = {};
    $self->{args} = $args;
    return bless $self, $class;
}

sub parse {
    my $self = shift;
    my ($head, $body) = split "\n\n", $self->{text}, 2;
    $self->{head} = $head;
    $self->{body} = $body;
    return (
        $self->_parse_headers(),
        $self->_parse_body()
    );
}

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 ($line, $cond) = $_ =~ m/^(.*?)(\{(.*)\})?$/;
        $line =~ s/ *$//;
        push @{ $self->{steps} }, { line => $line, cond => $cond };
    }
    return scalar @{ $self->{steps} };
}

sub generate_slave {
    my $self = shift;
    my $args = shift;

    my $slave = SugarTrail::Template::Slave->new($args);

    my @lines;

    STEP: foreach (@{ $self->{steps} }) {
        unless ($_->{cond}) {
            push @lines, $_->{line};
            next STEP;
        } else {
            push @lines, $_->{line} if &matches($_->{cond}, $args);
        }
    }

    $slave->{meta}->{'Stm'} = $self->{stm};
    $slave->{meta}->{'Stm Revision'} = $self->get_current_revision();
    $slave->{meta}->{'Params'} = mkmymime($args);

    $slave->{lines} = \@lines;
    return $slave;
}

# skel: matches if cond has m
sub matches {
    my $cond = shift;
    my $args = shift;
    $cond =~ m/m/;
}

# 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;
}

1;