view release on metacpan or  search on metacpan

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

  }{
    retrieve_include($wrt, $1);
  }xesg;
}

=item retrieve_include

Get the contents of an included file.  This probably needs a great
deal more thought than I am presently giving it.

=cut

sub retrieve_include {
  my $wrt = shift;
  my ($file) = @_;

  # Trim leading and trailing spaces:
  $file =~ s/^\s+//;
  $file =~ s/\s+$//;

  if ($file =~ m{^ (/ | [.]/) }x) {
    # TODO: Leads with a slash or a ./
    croak('Tried to open an include path with a leading / or ./ - not yet supported.');
  } else {
    # Use the archive root as path.
    $file = $wrt->{root_dir} . '/' . $file;
  }

  if ($wrt->{cache_includes}) {
    if (defined $wrt->{include_cache}->{$file}) {
      return $wrt->{include_cache}->{$file};
    }
  }

  unless (-e $file) {
    carp "No such file: $file";
    return '';
  }

  if (-d $file) {
    carp("Tried to open a directory as an include path: $file");
    return '';
  }

  if ($wrt->{cache_includes}) {
    $wrt->{include_cache}->{$file} = file_get_contents($file);
    return $wrt->{include_cache}->{$file};
  } else {
    return file_get_contents($file);
  }
}

=item textile_process

Inline replace <textile> markup in a string.

=cut

# This is exactly the kind of code that, even though it isn't doing anything
# especially over the top, looks ghastly to people who don't read Perl, so I'll
# try to explain a bit.

sub textile_process {

  # First, there's a state variable here which can retain the Text::Textile
  # object between invocations of the function, saving us a bit of time on
  # subsequent calls.  This should be equivalent to creating a closure around
  # the function and keeping a $textile variable there.
  state $textile;

  # Second, instead of unrolling the arguments to the function, we just act
  # directly on the first (0th) one.  =~ more or less means "do a regexy
  # thing on this".  It's followed by s, the substitution operator, which can
  # use curly braces as delimiters between pattern and replacement.

  $_[0] =~ s{

    # Find tags...

    <textile>  # start tag
      (.*?)    # anything (non-greedy)
    </textile> # end tag

  }{

    # ...and replace them with the result of evaluating this block.

    # //= means "defined-or-equals"; if the var hasn't been defined yet,
    # then make a new Textile object:
    $textile //= Text::Textile->new();

    # Process the stuff we slurped out of our tags - this value will be
    # used to replace the entire match from above (in Perl, the last
    # expression evaluated is the return value of subs, evals, etc.):
    $textile->process($1);

  }xesg;

  # x: eXtended regexp - whitespace ignored by default, comments allowed
  # e: Execute the replacement as Perl code, and use its value
  # s: treat all lines of the search subject as a Single string
  # g: Globally replace all matches

  # For the genuinely concise version of this, see markdown_process().
}

=item markdown_process

Inline replace <markdown> markup in a string.

=cut

sub markdown_process {
  state $markdown;

  my $flags = Text::Markdown::Discount::MKD_EXTRA_FOOTNOTE();

  $_[0] =~ s{
    <markdown>(.*?)</markdown>
  }{