123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100
  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. return bless $self, $class;
  18. }
  19. sub parse {
  20. my $self = shift;
  21. my ($head, $body) = split "\n\n", $self->{text}, 2;
  22. $self->{head} = $head;
  23. $self->{body} = $body;
  24. return (
  25. $self->_parse_headers(),
  26. $self->_parse_body()
  27. );
  28. }
  29. sub _parse_headers {
  30. my $self = shift;
  31. foreach (split "\n", $self->{head}) {
  32. my ($n, $v) = split ": ", $_, 2;
  33. $self->{meta}->{$n} = $v;
  34. }
  35. return scalar keys %{ $self->{meta} };
  36. }
  37. sub _parse_body {
  38. my $self = shift;
  39. $self->{steps} = [];
  40. foreach (split "\n", $self->{body}) {
  41. chomp; s/ *$//;
  42. my @conds;
  43. my ($line, $cond_block) = $_ =~ m/^(.*?)(\{(.*)\})?$/;
  44. $line =~ s/ *$//;
  45. if ($cond_block) {
  46. $cond_block =~ s/\}$//;
  47. $cond_block =~ s/^\{//;
  48. @conds = split m/\s*;\s*/, $cond_block;
  49. }
  50. push @{ $self->{steps} }, { line => $line, conds => \@conds };
  51. }
  52. return scalar @{ $self->{steps} };
  53. }
  54. sub generate_slave {
  55. my $self = shift;
  56. my $args = shift;
  57. my $slave = SugarTrail::Template::Slave->new($args);
  58. my @lines;
  59. STEP: foreach my $step (@{ $self->{steps} }) {
  60. my $accept = 1;
  61. COND: foreach my $condstr (@{ $step->{conds} }) {
  62. my $c = SugarTrail::Template::Condition->new($condstr);
  63. unless ($c->match($args)) { $accept = 0; last COND; }
  64. }
  65. push @lines, $step->{line} if $accept;
  66. }
  67. $slave->{meta}->{'Stm'} = $self->{stm};
  68. $slave->{meta}->{'Stm Revision'} = $self->get_current_revision();
  69. $slave->{meta}->{'Params'} = mkmymime($args);
  70. $slave->{lines} = \@lines;
  71. return $slave;
  72. }
  73. # skel: returns time (might be useful in absence of VCS)
  74. sub get_current_revision {
  75. return time;
  76. }
  77. sub mkmymime {
  78. my $d = shift;
  79. my $d1 = "; "; my $d2 = "=";
  80. my @t;
  81. foreach (sort keys %$d) {
  82. push @t, $_ . $d2 . $d->{$_};
  83. }
  84. return join $d1, @t;
  85. }
  86. 1;