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.
231 lines
5.0 KiB
231 lines
5.0 KiB
#!/usr/bin/perl
|
|
|
|
=head1 NAME
|
|
|
|
Wala::Markup - basic wiki markup for Wala.pm
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Wala::Markup;
|
|
my $wikitext = ":'''This''' is some wiki text.";
|
|
my $html = wiki_page_to_html($wikitext);
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module isolates all of Wala.pm's original wiki-text-to-HTML-code, with the
|
|
notable exception of link formatting, in order to pave the way for (somewhat)
|
|
genericized markup plugins.
|
|
|
|
It's unlikely that this code will change significantly, although at some point
|
|
I may use it as a basis for converting existing wala pages to other markup.
|
|
My branch of Wala.pm currently treats this as a black box, more or less.
|
|
|
|
Generally this should produce correct XHTML 1.0 Strict, although it may break
|
|
on some markup.
|
|
|
|
=head1 AUTHORS
|
|
|
|
Substantially refactored and converted to a module by Brennen Bearnes from
|
|
Brent Newhall's original Wala.pm.
|
|
|
|
=cut
|
|
|
|
package Wala::Markup;
|
|
|
|
use strict;
|
|
use warnings;
|
|
no warnings 'uninitialized';
|
|
|
|
use Exporter;
|
|
our @ISA = qw(Exporter);
|
|
our @EXPORT_OK;
|
|
our @EXPORT = qw(wiki_page_to_html);
|
|
|
|
# package globals
|
|
my $last_line_type = '';
|
|
my $current_list_level = 0;
|
|
|
|
###################
|
|
# Wiki Markup #
|
|
###################
|
|
|
|
# The essential function of this module.
|
|
# Called by Wala::wikify().
|
|
sub wiki_page_to_html {
|
|
my ($page) = @_;
|
|
|
|
$last_line_type = '';
|
|
|
|
my @lines = split /\n/, $page;
|
|
|
|
my ($result);
|
|
foreach my $line (@lines)
|
|
{
|
|
if( ord(substr($line, -1)) < 20 ) {
|
|
# Remove EOL
|
|
chop( $line );
|
|
}
|
|
|
|
$result .= line_to_html($line) . "\n";
|
|
}
|
|
|
|
$result .= finish_tags($result);
|
|
|
|
return $result;
|
|
}
|
|
|
|
|
|
|
|
|
|
sub line_to_html {
|
|
my( $text ) = shift;
|
|
|
|
# <brennen> take care of various single characters.
|
|
$text =~ s/&/&/g;
|
|
$text =~ s/</</g;
|
|
$text =~ s/>/>/g;
|
|
|
|
# <brennen> uglyriffic boldification of IRC-style nicknames:
|
|
$text =~ s/(^<[\[\]A-Za-z0-9]*?>)/<strong>$1<\/strong>/g;
|
|
|
|
# <brennen> headers? well, bold, for the moment.
|
|
$text =~ s/^(={1,3}) (.*) (\1)/<strong>$2<\/strong>/;
|
|
|
|
$text = replace_matched_tags($text, "'''", 'strong');
|
|
$text = replace_matched_tags($text, "''", 'em');
|
|
|
|
$text =~ s/----*/<hr \/>/;
|
|
|
|
my $first_char = substr( $text, 0, 1 );
|
|
|
|
my %line_types = (' ' => 'pre',
|
|
':' => 'blockquote><p',
|
|
'*' => 'ul',
|
|
'#' => 'ol',
|
|
'|' => 'table' );
|
|
|
|
if ( exists($line_types{$first_char}) ) {
|
|
$text = setup_line_type($text, $first_char, "<$line_types{$first_char}>");
|
|
} else {
|
|
$text = make_paragraph($text);
|
|
$text = finish_tags($text) . $text;
|
|
}
|
|
|
|
return $text;
|
|
}
|
|
|
|
|
|
|
|
|
|
# Process a Wiki line that starts with a special character like : or #
|
|
sub setup_line_type
|
|
{
|
|
my ($text, $first_char, $tag) = @_;
|
|
my ($index);
|
|
my $num_levels = 0;
|
|
|
|
if ($first_char eq '*' || $first_char eq '#')
|
|
{
|
|
# We have a list.
|
|
|
|
while (substr($text, 0, 1) eq $first_char) {
|
|
$text = substr($text, 1);
|
|
$num_levels++;
|
|
}
|
|
|
|
$text = '<li>' . $text . '</li>';
|
|
|
|
if ($num_levels < $current_list_level && $last_line_type eq $first_char) {
|
|
$text = ('</' . substr($tag, 1)) x ($current_list_level - $num_levels) . $text;
|
|
}
|
|
|
|
if ($num_levels > $current_list_level && $last_line_type eq $first_char) {
|
|
$text = ($tag x ($num_levels - $current_list_level)) . $text;
|
|
}
|
|
|
|
$current_list_level = $num_levels;
|
|
}
|
|
elsif ($first_char eq '|')
|
|
{
|
|
# A table.
|
|
$text = "<tr>\n<td>" . substr($text, 1);
|
|
$text =~ s/\|/<\/td>\n<td>/g;
|
|
$text .= "</td>\n</tr>";
|
|
}
|
|
elsif ($first_char eq ':')
|
|
{
|
|
# A blockquote.
|
|
$text = substr($text, 1);
|
|
}
|
|
|
|
if( $last_line_type ne $first_char )
|
|
{
|
|
$text = $tag . $text;
|
|
}
|
|
|
|
$last_line_type = $first_char;
|
|
|
|
return $text;
|
|
}
|
|
|
|
|
|
|
|
|
|
sub finish_tags
|
|
{
|
|
my( $result, $index );
|
|
my %line_types = (' ' => 'pre',
|
|
':' => 'p></blockquote',
|
|
'|' => 'table');
|
|
|
|
if( $last_line_type ne '' )
|
|
{
|
|
if( exists( $line_types{$last_line_type} ) )
|
|
{
|
|
$result = "</$line_types{$last_line_type}>";
|
|
}
|
|
elsif( $last_line_type eq '*' )
|
|
{
|
|
$result = '</ul>' x $current_list_level;
|
|
}
|
|
elsif( $last_line_type eq '#' )
|
|
{
|
|
$result = '</ol>' x $current_list_level;
|
|
}
|
|
}
|
|
$last_line_type = '';
|
|
return $result;
|
|
}
|
|
|
|
|
|
|
|
# Takes text, a type of Wiki markup (like ''), and start and end HTML tags.
|
|
# Replaces two occurrences of the markup with the start and end tags.
|
|
sub replace_matched_tags
|
|
{
|
|
my ($text, $markup, $tag) = @_;
|
|
$text =~ s/($markup)
|
|
([\s\S]*?)
|
|
($markup)
|
|
/<$tag>$2<\/$tag>/gx;
|
|
return $text;
|
|
}
|
|
|
|
|
|
|
|
|
|
sub make_paragraph
|
|
{
|
|
my ($text) = @_;
|
|
|
|
if( $text ne "" && $text ne "<hr />" && $last_line_type eq '' )
|
|
{
|
|
$text = '<p>' . $text . '</p>';
|
|
}
|
|
|
|
return $text;
|
|
}
|
|
|
|
|
|
1;
|
|
|