123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126
  1. package SugarTrail::Template::Master;
  2. # Master template holder
  3. # new()
  4. # parse()
  5. # _parse_headers()
  6. # _parse_body()
  7. use strict;
  8. use warnings;
  9. use Carp;
  10. use SugarTrail::Template::Slave;
  11. use SugarTrail::Template::Condition;
  12. sub new {
  13. my $class = shift;
  14. my $args = { @_ };
  15. my $self = {};
  16. $self->{args} = $args;
  17. $self->{parsed} = 0;
  18. return bless $self, $class;
  19. }
  20. sub parse {
  21. my $self = shift;
  22. my ($head, $body) = split "\n\n", $self->{text}, 2;
  23. $self->{head} = $head;
  24. $self->{body} = $body;
  25. my @counts = (
  26. $self->_parse_headers(),
  27. $self->_parse_body()
  28. );
  29. $self->{parsed}++;
  30. return @counts;
  31. }
  32. sub _parse_headers {
  33. my $self = shift;
  34. foreach (split "\n", $self->{head}) {
  35. my ($n, $v) = split ": ", $_, 2;
  36. $self->{meta}->{$n} = $v;
  37. }
  38. return scalar keys %{ $self->{meta} };
  39. }
  40. sub _parse_body {
  41. my $self = shift;
  42. $self->{steps} = [];
  43. foreach (split "\n", $self->{body}) {
  44. chomp; s/ *$//;
  45. my @conds;
  46. my ($line, $cond_block) = $_ =~ m/^(.*?)(\{(.*)\})?$/;
  47. $line =~ s/ *$//;
  48. if ($cond_block) {
  49. $cond_block =~ s/\}$//;
  50. $cond_block =~ s/^\{//;
  51. @conds = split m/\s*;\s*/, $cond_block;
  52. }
  53. push @{ $self->{steps} }, { line => $line, conds => \@conds };
  54. }
  55. return scalar @{ $self->{steps} };
  56. }
  57. sub generate_slave {
  58. my $self = shift;
  59. my $args = shift;
  60. my $slave = SugarTrail::Template::Slave->new($args);
  61. $self->parse() unless $self->{parsed};
  62. my @slave_steps;
  63. STEP: foreach my $master_step (@{ $self->{steps} }) {
  64. my $accept = 1; # accept by default
  65. my $slave_step = {
  66. line => $master_step->{line},
  67. warnings => []
  68. };
  69. # Test against each condition from the pre-parsed condblock.
  70. # * refuse step only in case all conditions passed without
  71. # warnings
  72. # * in all other cases (fail, warning), accept
  73. COND: foreach my $condstr (@{ $master_step->{conds} }) {
  74. my $c = SugarTrail::Template::Condition->new($condstr);
  75. my ($r, $w) = $c->match($args);
  76. # if warnings, store them, prepare to accept and ignore result
  77. if (scalar @$w) {
  78. $accept = 1;
  79. push @{$slave_step->{warnings}}, @$w;
  80. next COND;
  81. } else {
  82. # point of no warnings -- refusal should be valid here
  83. $accept = 0 unless $r;
  84. }
  85. }
  86. push @slave_steps, $slave_step
  87. if ($accept || scalar @{$slave_step->{warnings}});
  88. }
  89. $slave->{meta}->{'Master'} = $self->{source};
  90. $slave->{meta}->{'Master Revision'} = $self->get_current_revision();
  91. $slave->{meta}->{'Params'} = mkmymime($args);
  92. $slave->{steps} = \@slave_steps;
  93. return $slave;
  94. }
  95. # skel: returns time (might be useful in absence of VCS)
  96. sub get_current_revision {
  97. return time;
  98. }
  99. sub mkmymime {
  100. my $d = shift;
  101. my $d1 = "; "; my $d2 = "=";
  102. my @t;
  103. foreach (sort keys %$d) {
  104. push @t, $_ . $d2 . $d->{$_};
  105. }
  106. return join $d1, @t;
  107. }
  108. sub source { return $_[0]->{text} }
  109. 1;