wrt/Display/Markup.pm

package Display::Markup;

use strict;
use warnings;

use base qw(Exporter);
our @EXPORT_OK = qw(line_parse image_markup gallery);

use File::Basename;
use Display::Image qw(image_size gallery);
use Text::Textile;

# Some useful defaults:

my %tags = (
  retcon    => q{div class="retcon"},
  freeverse => 'p',
  list      => "ul>\n<li"
);

my %end_tags = (
  retcon    => 'div',
  freeverse => 'p',
  list      => "li>\n</ul"
);

my %blank_lines = (
  freeverse => "</p>\n\n<p>",
  list      => "</li>\n\n<li>"
);

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

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

=item line_parse

Performs substitutions on lines called by fragment_slurp, at least.  Calls
image_markup, Text::Textile, Wala::wiki_page_to_html, eval_perl.  Returns
string.

Parses some special markup, specifically:

    <perl>embedded perl</perl>
    ${variable} interpolation from %DISPLAY_CONF
    <textile></textile> - Text::Textile to HTML
    <wala></wala> - Wala::wikify();
    <freeverse></freeverse>
    <retcon></retcon>
    <list></list>

    <gallery>directory_name</gallery>

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

=cut

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

    # Take care of <wala>, <textile>, <gallery>, and <image> tags:

    #$everything =~ s/<wala>(.*?)<\/wala>/Wala::wikify($1)/seg;
    textile_process($everything);
    $everything =~ s!<gallery>(.*?)</gallery>!$self->gallery_markup($file, $1)!seg; 
    $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};
       $blank_lines{$key} ||= "\n\n";
       $newlines{$key}    ||= "\n";
       $dashes{$key}      ||= " -- ";

        # Transform blocks:
        while ($everything =~ m/(<$key>.*?<\/$key>)/s) {
            my $block = $1;

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

            # Tags that surround the block:
            $block =~ s{\n?<$key>\n?}{<$tags{$key}>}gs;
            $block =~ s{\n?</$key>\n?}{</$end_tags{$key}>}gs;
            
            # Dashes, blank lines, and newlines:
            $block = dashes($dashes{$key}, $block);
            $block =~ s/\n\n/$blank_lines{$key}/gs;
            $block = newlines($newlines{$key}, $block);

            # ...and slap it all back together as $everything
            $everything = join $block, @interstices;
        }
    }

    return $everything;
}

sub newlines {
  my ($replacement, $block) = @_;

  # Single newlines (i.e., line ends) within the block,
  # except those preceded by a double-quote, which probably
  # indicates a still-open tag:

  $block =~ s/(?<=[^"\n])  # not a double-quote or newline
                           # don't capture

              \n           # end-of-line

              (?=[^\n])    # not a newline
                           # don't capture
             /$replacement/xgs;

  return $block;

}

# might need a rewrite.
sub dashes {
  my ($replacement, $block) =@_;

  $block =~ s/(\s+)      # whitespace - no capture
              \-{2}      # two dashes
              (\n|\s+|$) # newline, whitespace, or eol
             /$1${replacement}$2/xgs;

  return $block;

}

=item textile_process

Inline replace <textile> markup in a string.

Trying to implement some caching here, though it's questionable whether
this makes any sense.  There's also a closure which should retain the
Text::Textile object between invocations, potentially saving some time at
the expense of a little memory.

=cut

{ my %cache;
  my $textile;

  sub textile_process {
    my $replacement;

    unless (defined $textile) {
      # head_offset: use h1., h2. in Textile formatting:
      $textile = Text::Textile->new( head_offset => 2 );
    }

    while ( $_[0] =~ m/<textile>(.*?)<\/textile>/sx ) {
      my $block = $1;

      if (exists $cache{$block}) {
        $replacement = $cache{$block};
      } else {
        $replacement = $textile->process($block);
        $cache{$block} = $replacement;
      }

      $_[0] =~ s/<textile>\Q$block\E<\/textile>/$replacement/sg;
    }

    return;

  }

}


=item image_markup

Parse out an image tag and return the appropriate html.

Relies on image_size from Display::Image.

=cut

sub image_markup {
    my $self = shift;
    my ($file, $block) = @_;

    # Get a basename and directory for the file referencing the image:
    my ($basename, $dir) = fileparse($file);
        
    # Truncated file date that just includes date + sub docs:
    my ($file_date) = $dir =~ m{([0-9]{4}/   # year
                                [0-9]{1,2}/  # month
                                [0-9]{1,2}/  # day
                                ([a-z]*/)*)$ # sub-entries
                               }x;

    # Process the contents of the <image> tag:
    my ($image_url, $alt_text, $title_text) = split /\n/, $block;
    $alt_text   ||= q{};
    $title_text ||= $alt_text;

    # Resolve relative paths:
    my $image_file;
    if (-e "$dir/$image_url" ) {
        $image_file = "$dir/$image_url";
        $image_url = "${file_date}${image_url}";
    } elsif (-e $self->root_dir . "/$image_url") {
        $image_file = $self->root_dir . "/$image_url";
    }

    # Get width & height in pixels for known filetypes:
    my ($width, $height) = image_size($image_file);

    # This probably relies on mod_rewrite working:
    $image_url = $self->image_url_root . $image_url;
    return <<"IMG";
<img src="$image_url"
     width="$width"
     height="$height"
     alt="$alt_text"
     title="$title_text" />
IMG
}

=item gallery_markup

Generate a gallery of images.

=cut

sub gallery_markup {
  my $self = shift;
  my ($file, $block) = @_;

  my ($dir, $basedir) = fileparse($file);

  if (-d "$basedir/$file") {
    return gallery("$basedir/$file", "");
  }
}

# Encapsulate some ugly file-location functionality.
sub resolve_file {
}

1;