1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889 |
- 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->{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;
- }
-
- 1;
|