You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
218 lines
5.6 KiB
218 lines
5.6 KiB
package Display::Markup;
|
|
|
|
use base qw(Exporter);
|
|
our @EXPORT_OK = qw(line_parse);
|
|
|
|
use Display::Image qw(image_size);
|
|
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 => ' — ' );
|
|
|
|
=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>
|
|
|
|
<image>filename.ext
|
|
optional alt tag</image>
|
|
|
|
=cut
|
|
|
|
sub line_parse {
|
|
my ($everything, $file) = (@_);
|
|
|
|
# take care of wala markup
|
|
$everything =~ s/<wala>(.*?)<\/wala>/Wala::wikify($1)/seg;
|
|
|
|
# take care of textile markup, if we've got any
|
|
textile_process($everything);
|
|
|
|
# evaluate <image> tags.
|
|
$everything =~ s!<image>(.*?)</image>!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} unless $end_tags{$key};
|
|
$blank_lines{$key} = "\n\n" unless $blank_lines{$key};
|
|
$newlines{$key} = "\n" unless $newlines{$key};
|
|
$dashes{$key} = " -- " unless $dashes{$key};
|
|
|
|
while ($everything =~ m/(<$key>.*?<\/$key>)/s) {
|
|
my $block = $1;
|
|
|
|
# save the bits between instances of the block --
|
|
my (@interstice_array) = split /\Q$block\E/s, $everything;
|
|
|
|
# now, transform the contents of the block we've found:
|
|
|
|
# tags that surround the block
|
|
$block =~ s/\n?<$key>\n?/<$tags{$key}>/gs;
|
|
$block =~ s!\n?</$key>\n?!</$end_tags{$key}>!gs;
|
|
|
|
# dashes
|
|
$block = dashes($dashes{$key}, $block);
|
|
|
|
# blank lines within the 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, @interstice_array;
|
|
|
|
}
|
|
}
|
|
|
|
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 ($file, $block) = @_;
|
|
my %DISPLAY_CONF = %Display::DISPLAY_CONF;
|
|
|
|
# get a directory for the file we're working with
|
|
$file =~ s'[^/]* # everything not a /
|
|
$ # up to end of string
|
|
''x;
|
|
|
|
# truncated file date that just includes date + sub docs
|
|
my ($file_date) = $file =~ m{([0-9]{4}/ # year
|
|
[0-9]{1,2}/ # month
|
|
[0-9]{1,2}/ # day
|
|
([a-z]*/)*)$ # sub-entries
|
|
}x;
|
|
|
|
my ($image_name, $alt_text, $title_text) = split /\n/, $block;
|
|
$title_text = $alt_text unless $title_text;
|
|
|
|
my $image_file;
|
|
if (-e "$file/$image_name" ) {
|
|
$image_file = "$file/$image_name";
|
|
$image_name = "${file_date}${image_name}";
|
|
} elsif (-e "$DISPLAY_CONF{ROOT_DIR}/$image_name") {
|
|
$image_file = "$DISPLAY_CONF{ROOT_DIR}/$image_name";
|
|
}
|
|
|
|
# get width & height in pixels for known filetypes
|
|
my ($width, $height) = image_size($image_file);
|
|
|
|
# this relies on mod_rewrite working:
|
|
return<<"IMG";
|
|
<img src="$DISPLAY_CONF{IMAGE_URL_ROOT}$image_name"
|
|
height="$height"
|
|
width="$width"
|
|
alt="$alt_text"
|
|
title="$title_text" />
|
|
IMG
|
|
}
|
|
|
|
1;
|