view release on metacpan or  search on metacpan

lib/Decl/Template.pm  view on Meta::CPAN

sub new {
   my ($class, %values) = @_;
   my $self = bless \%values, $class;
   #TODO: 'brackets' split
   $self->{left} = '\[\[' unless $self->{left};
   $self->{right} = '\]\]' unless $self->{right};
   $self->{leftp} = $self->{left};
   $self->{leftp} =~ s/\\//g;
   $self->{rightp} = $self->{right};
   $self->{rightp} =~ s/\\//g;
   $self->{valuator} = \&default_valuator unless $self->{valuator};
   $self->{leave_misses} = 1 unless defined $self->{leave_misses};
   
   $self->{spanners} = {} unless $self->{spanners};
   $self->{spanners}->{with}   = \&do_with   unless defined $self->{spanners}->{with};
   $self->{spanners}->{if}     = \&do_if     unless defined $self->{spanners}->{if};
   $self->{spanners}->{repeat} = \&do_repeat unless defined $self->{spanners}->{repeat};
   
   $self;
}

=head2 default_valuator

Given a value environment (by default, a hashref) and the name of a value, a valuator finds the value.

If nothing else is specified, the hashref valuator is used.  In the Decl context, a node will generally
be used and the node's own valuation function is used as the valuator.

=cut

sub default_valuator {
   my ($name, $env) = @_;
   $$env{$name};
}

=head2 prepare_varname

Given a variable specification, prepare it for use as a lookup key.

=cut

sub prepare_varname {
   my ($name) = @_;
   $name =~ s/\n */ /sg;
   $name =~ s/^ *//g;
   $name =~ s/ *$//g;
   $name;
}

=head2 parse_spanning_command

Given a spanning command string, parse out the initial word (the command) and leave the arguments (the rest).  Drop the . or +.

=cut

sub parse_spanning_command {
   my $piece = shift;
   
   $piece =~ s/^[+\.] *//;
   split m[ +], $piece, 2;
}

=head2 handle_spanning_command

Given a parsed spanning command and the value object and valuator function to be used, express the command.  This is really just
a dispatcher for a command table.

=cut

sub handle_spanning_command {
   my ($self, $command, $values, $valuator) = @_;
   
   my $c = $self->{spanners}->{$$command[0]};
   return $c->($self, $command, $values, $valuator) if $c;
   return '';   # TODO: consider better error handling.  As always.
}

=head2 register_spanning_command ($name, $closure)

Here's how you register a spanning command.  Just name it and provide a closure for it, and you're good to go.

=cut

sub register_spanning_command {
   my ($self, $name, $sub) = @_;
   
   $self->{spanners}->{$name} = $sub;
}

=head2 do_with, do_if, do_repeat, express_repeat

These are our three default spanning commands.  More can be added to the table.

The C<express_repeat> does the heavy lifting in expressing the list template and can be recycled in other forms of list template.

=cut

sub do_with {
   my ($self, $command, $values, $valuator) = @_;
   
   my $with = do_lookup($$command[1], $values, $valuator);
   $self->express_parsed ($$command[2], $with, \&default_valuator);
}

sub do_if {
   my ($self, $command, $values, $valuator) = @_;

   my $test = do_lookup ($$command[1], $values, $valuator);
   if ($test) {
      return $self->express_parsed ($$command[2], $values, $valuator);
   }
   my @alternatives = @{$$command[3]};
   foreach my $check (@alternatives) {
      if ($$check[0] eq 'elif') {
         $test = do_lookup ($$check[1], $values, $valuator);
         if ($test) {
            return $self->express_parsed ($$check[2], $values, $valuator);
         }
      }
      if ($$check[0] eq 'else') {