123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103 |
- package SugarTrail::STM;
- # STM holder
- # new()
- # parse_headers()
-
-
-
- use strict;
- use warnings;
- use Carp;
- use SugarTrail::STS;
-
- sub new {
- my $class = shift;
- my $args = { @_ };
- my $self = {};
- $self->{args} = $args;
- return bless $self, $class;
- }
-
- sub parse_headers {
- my $self = shift;
-
- my ($head, $body) = split "\n\n", $self->{text}, 2;
-
- my @lines = split "\n", $head;
-
- $self->{head} = $head;
- $self->{body} = $body;
-
- foreach (@lines) {
- my ($n, $v) = split ": ", $_, 2;
- $self->{meta}->{$n} = $v;
- }
-
- return scalar keys %{ $self->{meta} };
- }
-
- sub parse_body {
- my $self = shift;
- my @lines = split "\n", $self->{body};
-
- $self->{steps} = [];
-
- foreach (@lines) {
- chomp;
- s/ *$//;
- my ($line, $cond) = $_ =~ m/^(.*?)(\{(.*)\})?$/;
- $line =~ s/ *$//;
- push @{ $self->{steps} }, { line => $line, cond => $cond };
- }
-
- return scalar @{ $self->{steps} };
- }
-
- sub generate_sts {
- my $self = shift;
- my $args = shift;
-
- my $sts = SugarTrail::STS->new($args);
-
- my @lines;
-
- STEP: foreach (@{ $self->{steps} }) {
- unless ($_->{cond}) {
- push @lines, $_->{line};
- next STEP;
- } else {
- push @lines, $_->{line} if &matches($_->{cond}, $args);
- }
- }
-
- $sts->{meta}->{'Stm'} = $self->{stm};
- $sts->{meta}->{'Stm Revision'} = $self->get_current_revision();
- $sts->{meta}->{'Params'} = mkmymime($args);
-
- $sts->{lines} = \@lines;
- return $sts;
- }
-
- # 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;
|