view release on metacpan or  search on metacpan

lib/App/WRT/Markup.pm  view on Meta::CPAN

  freeverse => "</p>\n\n<p>",
  list      => "</li>\n\n<li>"
);

my %newlines = (
  freeverse => "<br />\n"
);

my %dashes = (
  freeverse => ' &mdash; '
);

=over

=item eval_perl

Evaluate embedded Perl in a string, replacing blocks enclosed with <perl> tags
with whatever they return (well, evaluated in a scalar context). Returns the
modified string.

Also handles simple ${variables}, replacing them from the keys to $self.

=cut

sub eval_perl {
  my $self = shift;
  my ($text) = @_;

  while ($text =~ m{<perl>(.*?)</perl>}s) {
    my $block = $1;

    # Run the $block, and include anything returned:
    my $output = eval $block;

    if ($@) {
      # Errors - log and return an empty string:
      carp($@);
      $output = '';
    }

    $text =~ s{<perl>\Q$block\E</perl>}{$output}s;
  }

  # Interpolate variables:
  $text =~ s{
    \$\{ ([a-zA-Z_]+) \}
  }{
    if (defined $self->{$1}) {
      $self->{$1};
    } else {
      # TODO:  Possibly this should be fatal.
      "UNDEFINED: $1";
    }
  }gex;

  return $text;
}

=item line_parse

Performs substitutions on lines called by fragment_slurp, at least.  Calls
include_process(), image_markup(), textile_process(), markdown_process(),
eval_perl().

Applies before-parsing and after-parsing filters.

Returns string.

Parses some special markup.  Specifically:

    <perl>print "hello world";</perl>
    ${variable} interpolation from the WRT object

    <include>path/to/file/from/project/root</include>

    <textile></textile> - Text::Textile to HTML
    <markdown></markdown> - Text::Markdown::Discount to HTML

    <image>filename.ext
    optional alt tag
    optional title text</image>

    <freeverse></freeverse>
    <retcon></retcon>
    <list></list>

=cut

sub line_parse {
    my $self = shift;
    my ($everything, $file) = (@_);

    # Eventually, this should probably only happen for templates:
    $everything = $self->eval_perl($everything);

    # Take care of <include>, <textile>, <markdown>, and <image> tags:
    include_process($self, $everything);
    textile_process($everything);
    markdown_process($everything);
    $everything =~ s!<image>(.*?)</image>!$self->image_markup($file, $1)!seg;

    foreach my $key (keys %tags) {
       # Set some replacements, unless they've been explicitly set already:
       $end_tags{$key} ||= $tags{$key};

        # Transform blocks:
        while ($everything =~ m| (<$key>\n?) (.*?) (\n?</$key>) |sx) {
            my $open = $1;
            my $block = $2;
            my $close = $3;

            # Save the bits between instances of the block:
            my (@interstices) = split /\Q$open$block$close\E/s, $everything;

            # Transform dashes, blank lines, and newlines:
            dashes($dashes{$key}, $block)          if defined $dashes{$key};
            $block =~ s/\n\n/$blank_lines{$key}/gs if defined $blank_lines{$key};
            newlines($newlines{$key}, $block)      if defined $newlines{$key};

            # Slap it all back together as $everything, with start and end
            # tags: