File Coverage

blib/lib/Text/Textile.pm

Criterion	Covered	Total	%
statement	360	1208	29.8
branch	122	872	13.9
condition	23	269	8.5
subroutine	28	59	47.4
pod	40	44	90.9
total	573	2452	23.3

package Text::Textile;

use strict;
use warnings;

use base 'Exporter';
our @EXPORT_OK = qw(textile);
our $VERSION = 2.13;
our $debug = 0;

sub new {
    my $class = shift;
    my %options = @_;
    $options{filters} ||= {};
    $options{charset} ||= 'iso-8859-1';

    for ( qw( char_encoding do_quotes smarty_mode ) ) {
        $options{$_} = 1 unless exists $options{$_};
    }
    for ( qw( trim_spaces preserve_spaces head_offset disable_encode_entities ) ) {
        $options{$_} = 0 unless exists $options{$_};
    }

    my $self = bless \%options, $class;
    if (exists $options{css}) {
        $self->css($options{css});
    }
    $options{macros} ||= $self->default_macros();
    if (exists $options{flavor}) {
        $self->flavor($options{flavor});
    } else {
        $self->flavor('xhtml1/css');
    }
    return $self;
}

# getter/setter methods...

sub set {
    my $self = shift;
    my $opt = shift;
    if (ref $opt eq 'HASH') {
        $self->set($_, $opt->{$_}) foreach %{$opt};
    } else {
        my $value = shift;
        # the following options have special set methods
        # that activate upon setting:
        if ($opt eq 'charset') {
            $self->charset($value);
        } elsif ($opt eq 'css') {
            $self->css($value);
        } elsif ($opt eq 'flavor') {
            $self->flavor($value);
        } else {
            $self->{$opt} = $value;
        }
    }
    return;
}

sub get {
    my $self = shift;
    return $self->{shift} if @_;
    return undef;
}

sub disable_html {
    my $self = shift;
    if (@_) {
        $self->{disable_html} = shift;
    }
    return $self->{disable_html} || 0;
}

sub head_offset {
    my $self = shift;
    if (@_) {
        $self->{head_offset} = shift;
    }
    return $self->{head_offset} || 0;
}

sub flavor {
    my $self = shift;
    if (@_) {
        my $flavor = shift;
        $self->{flavor} = $flavor;
        if ($flavor =~ m/^xhtml(\d)?(\D|$)/) {
            if ($1 eq '2') {
                $self->{_line_open} = '';
                $self->{_line_close} = '';
                $self->{_blockcode_open} = '';
                $self->{_blockcode_close} = '';
                $self->{css_mode} = 1;
            } else {
                # xhtml 1.x
                $self->{_line_open} = '';
                $self->{_line_close} = '';
                $self->{_blockcode_open} = '';
                $self->{_blockcode_close} = '';
                $self->{css_mode} = 1;
            }
        } elsif ($flavor =~ m/^html/) {
            $self->{_line_open} = '';
            $self->{_line_close} = '';
            $self->{_blockcode_open} = '';
            $self->{_blockcode_close} = '';
            $self->{css_mode} = $flavor =~ m/\/css/;
        }
        $self->_css_defaults() if $self->{css_mode} && !exists $self->{css};
    }
    return $self->{flavor};
}

sub css {
    my $self = shift;
    if (@_) {
        my $css = shift;
        if (ref $css eq 'HASH') {
            $self->{css} = $css;
            $self->{css_mode} = 1;
        } else {
            $self->{css_mode} = $css;
            $self->_css_defaults() if $self->{css_mode} && !exists $self->{css};
        }
    }
    return $self->{css_mode} ? $self->{css} : 0;
}

sub charset {
    my $self = shift;
    if (@_) {
        $self->{charset} = shift;
        if ($self->{charset} =~ m/^utf-?8$/i) {
            $self->char_encoding(0);
        } else {
            $self->char_encoding(1);
        }
    }
    return $self->{charset};
}

sub docroot {
    my $self = shift;
    $self->{docroot} = shift if @_;
    return $self->{docroot};
}

sub trim_spaces {
    my $self = shift;
    $self->{trim_spaces} = shift if @_;
    return $self->{trim_spaces};
}

sub filter_param {
    my $self = shift;
    $self->{filter_param} = shift if @_;
    return $self->{filter_param};
}

sub preserve_spaces {
    my $self = shift;
    $self->{preserve_spaces} = shift if @_;
    return $self->{preserve_spaces};
}

sub filters {
    my $self = shift;
    $self->{filters} = shift if @_;
    return $self->{filters};
}

sub char_encoding {
    my $self = shift;
    $self->{char_encoding} = shift if @_;
    return $self->{char_encoding};
}

sub disable_encode_entities {
    my $self = shift;
    $self->{disable_encode_entities} = shift if @_;
    return $self->{disable_encode_entities};
}

sub handle_quotes {
    my $self = shift;
    $self->{do_quotes} = shift if @_;
    return $self->{do_quotes};
}

# end of getter/setter methods

# a URL discovery regex. This is from Mastering Regex from O'Reilly.
# Some modifications by Brad Choate
use vars qw($urlre $blocktags $clstyre $clstypadre $clstyfiltre
            $alignre $valignre $halignre $imgalignre $tblalignre
            $codere $punct);
$urlre = qr{
    # Must start out right...
    (?=[a-zA-Z0-9./#])
    # Match the leading part (proto://hostname, or just hostname)
    (?:
        # ftp://, http://, or https:// leading part
        (?:ftp|https?|telnet|nntp)://(?:\w+(?::\w+)?@)?[-\w]+(?:\.\w[-\w]*)+
        |
        (?:mailto:)?[-\+\w]+\@[-\w]+(?:\.\w[-\w]*)+
        |
        # or, try to find a hostname with our more specific sub-expression
        (?i: [a-z0-9] (?:[-a-z0-9]*[a-z0-9])? \. )+ # sub domains
        # Now ending .com, etc. For these, require lowercase
        (?-i: com\b
            | edu\b
            | biz\b
            | gov\b
            | in(?:t|fo)\b # .int or .info
            | mil\b
            | net\b
            | org\b
            | museum\b
            | aero\b
            | coop\b
            | name\b
            | pro\b
            | [a-z][a-z]\b # two-letter country codes
        )
    )?

    # Allow an optional port number
    (?: : \d+ )?

    # The rest of the URL is optional, and begins with / . . .
    (?:
     /?
     # The rest are heuristics for what seems to work well
     [^.!,?;:"'<>()\[\]{}\s\x7F-\xFF]*
     (?:
        [.!,?;:]+  [^.!,?;:"'<>()\[\]{}\s\x7F-\xFF]+ #'"
     )*
    )?
}x;

$punct = qr{[\!"#\$%&'()\*\+,\-\./:;<=>\?@\[\\\]\^_`{\|}\~]};
$valignre = qr/[\-^~]/;
$tblalignre = qr/[<>=]/;
$halignre = qr/(?:<>|[<>=])/;
$alignre = qr/(?:$valignre|<>$valignre?|$valignre?<>|$valignre?$halignre?|$halignre?$valignre?)(?!\w)/;
$imgalignre = qr/(?:[<>]|$valignre){1,2}/;

$clstypadre = qr/
  (?:\([A-Za-z0-9_\- \#]+\))
  |
  (?:{
      (?: \( [^)]+ \) | [^}] )+
     })
  |
  (?:\(+? (?![A-Za-z0-9_\-\#]) )
  |
  (?:\)+?)
  |
  (?: \[ [a-zA-Z\-]+? \] )
/x;

$clstyre = qr/
  (?:\([A-Za-z0-9_\- \#]+\))
  |
  (?:{
      [A-Za-z0-9_\-](?: \( [^)]+ \) | [^}] )+
     })
  |
  (?: \[ [a-zA-Z\-]+? \] )
/x;

$clstyfiltre = qr/
  (?:\([A-Za-z0-9_\- \#]+\))
  |
  (?:{
      [A-Za-z0-9_\-](?: \( [^)]+ \) | [^}] )+
     })
  |
  (?:\|[^\|]+\|)
  |
  (?:\(+?(?![A-Za-z0-9_\-\#]))
  |
  (?:\)+)
  |
  (?: \[ [a-zA-Z]+? \] )
/x;

$codere = qr/
    (?:
      [\[{]
      @                           # opening
      (?:\[([A-Za-z0-9]+)\])?     # $1: language id
      (.+?)                       # $2: code
      @                           # closing
      [\]}]
    )
    |
    (?:
      (?:^|(?<=[\s\(]))
      @                           # opening
      (?:\[([A-Za-z0-9]+)\])?     # $3: language id
      ([^\s].*?[^\s]?)            # $4: code itself
      @                           # closing
      (?:$|(?=$punct{1,2}|\s))
    )
/x;

$blocktags = qr{
    <
    (( /? ( h[1-6]
     | p
     | pre
     | div
     | table
     | t[rdh]
     | [ou]l
     | li
     | block(?:quote|code)
     | form
     | input
     | select
     | option
     | textarea
     )
    [ >]
    )
    | !--
    )
}x;

sub process {
    my $self = shift;
    return $self->textile(@_);
}

sub textile {
    my $self = shift;
    my ($str) = @_;

    # disable warnings for the sake of various regex that
    # have optional matches
    local $^W = 0;

    if (!ref $self) {
        # oops -- procedural technique used, so make
        # set $str to $self and instantiate a new object
        # for self
        $str = $self;
        $self = new Text::Textile;
    }

    return "" unless defined($str);

    # quick translator for abbreviated block names
    # to their tag
    my %macros = ('bq' => 'blockquote');

    # an array to hold any portions of the text to be preserved
    # without further processing by Textile
    my @repl;

    # strip out extra newline characters. we're only matching for \n herein
    #$str =~ s!(?:\r?\n|\r)!\n!g;
    $str =~ s!(?:\015?\012|\015)!\n!g;

    # optionally remove trailing spaces
    $str =~ s/ +$//gm if $self->{trim_spaces};

    # preserve contents of the '==', 'pre', 'blockcode' sections
    $str =~ s{(^|\n\n)==(.+?)==($|\n\n)}
             {$1."\n\n"._repl(\@repl, $self->format_block(text => $2))."\n\n".$3}ges;

    unless ($self->{disable_html}) {
        # preserve style, script tag contents
        $str =~ s{(<(style|script)(?:>| .+?>).*?)}{_repl(\@repl, $1)}ges;

        # preserve HTML comments
        $str =~ s{()}{_repl(\@repl, $1)}ges;

        # preserve pre block contents, encode contents by default
        my $pre_start = scalar(@repl);
        $str =~ s{(]*)?>)(.+?)()}
                 {"\n\n"._repl(\@repl, $1.$self->encode_html($2, 1).$3)."\n\n"}ges;
        # fix code tags within pre blocks we just saved.
        for (my $i = $pre_start; $i < scalar(@repl); $i++) {
            $repl[$i] =~ s{<(/?)code(.*?)>}{<$1code$2>}gs;
        }

        # preserve code blocks by default, encode contents
        $str =~ s{(]+)?>)(.+?)()}
                 {_repl(\@repl, $1.$self->encode_html($2, 1).$3)}ges;

        # encode blockcode tag (an XHTML 2 tag) and encode it's
        # content by default
        $str =~ s{(]+)?>)(.+?)()}
                 {"\n\n"._repl(\@repl, $1.$self->encode_html($2, 1).$3)."\n\n"}ges;

        # preserve PHPish, ASPish code
        $str =~ s!(<([\?\%]).*?(\2)>)!_repl(\@repl, $1)!ges;
    }

    # pass through and remove links that follow this format
    # [id_without_spaces (optional title text)]url
    # lines like this are stripped from the content, and can be
    # referred to using the "link text":id_without_spaces syntax
    my %links;
    $str =~ s{(?:\n|^) [ ]* \[ ([^ ]+?) [ ]*? (?:\( (.+?) \) )?  \] ((?:(?:ftp|https?|telnet|nntp)://|/)[^ ]+?) [ ]* (\n|$)}
             {($links{$1} = {url => $3, title => $2}),"$4"}gemx;
    local $self->{links} = \%links;

    # eliminate starting/ending blank lines
    $str =~ s/^\n+//s;
    $str =~ s/\n+$//s;

    # split up text into paragraph blocks, capturing newlines too
    my @para = split /(\n{2,})/, $str;
    my ($block, $bqlang, $filter, $class, $sticky, @lines,
        $style, $stickybuff, $lang, $clear);

    my $out = '';

    foreach my $para (@para) {
        if ($para =~ m/^\n+$/s) {
            if ($sticky && defined $stickybuff) {
                $stickybuff .= $para;
            } else {
                $out .= $para;
            }
            next;
        }

        if ($sticky) {
            $sticky++;
        } else {
            $block = undef;
            $class = undef;
            $style = '';
            $lang = undef;
        }

        my ($id, $cite, $align, $padleft, $padright, @lines, $buffer);
        if ($para =~ m/^(h[1-6]|p|bq|bc|fn\d+)
                        ((?:$clstyfiltre*|$halignre)*)
                        (\.\.?)
                        (?::(\d+|$urlre))?\ /gx) {
            if ($sticky) {
                if ($block eq 'bc') {
                    # close our blockcode section
                    $out =~ s/\n\n$//;
                    $out .= $self->{_blockcode_close}."\n\n";
                } elsif ($block eq 'bq') {
                    $out =~ s/\n\n$//;
                    $out .= ''."\n\n";
                } elsif ($block eq 'table') {
                    my $table_out = $self->format_table(text => $stickybuff);
                    $table_out = '' if !defined $table_out;
                    $out .= $table_out;
                    $stickybuff = undef;
                } elsif ($block eq 'dl') {
                    my $dl_out = $self->format_deflist(text => $stickybuff);
                    $dl_out = '' if !defined $dl_out;
                    $out .= $dl_out;
                    $stickybuff = undef;
                }
                $sticky = 0;
            }
            # block macros: h[1-6](class)., bq(class)., bc(class)., p(class).
            #warn "paragraph: [[$para]]\n\tblock: $1\n\tparams: $2\n\tcite: $4";
            $block = $1;
            my $params = $2;
            $cite = $4;
            if ($3 eq '..') {
                $sticky = 1;
            } else {
                $sticky = 0;
                $class = undef;
                $bqlang = undef;
                $lang = undef;
                $style = '';
                $filter = undef;
            }
            if ($block =~ m/^h([1-6])$/) {
                if ($self->{head_offset}) {
                    $block = 'h' . ($1 + $self->{head_offset});
                }
            }
            if ($params =~ m/($halignre+)/) {
                $align = $1;
                $params =~ s/$halignre+//;
            }
            if (defined $params) {
                if ($params =~ m/\|(.+)\|/) {
                    $filter = $1;
                    $params =~ s/\|.+?\|//;
                }
                if ($params =~ m/{([^}]+)}/) {
                    $style = $1;
                    $style =~ s/\n/ /g;
                    $params =~ s/{[^}]+}//g;
                }
                if ($params =~ m/\(([A-Za-z0-9_\-\ ]+?)(?:\#(.+?))?\)/ ||
                    $params =~ m/\(([A-Za-z0-9_\-\ ]+?)?(?:\#(.+?))\)/) {
                    if ($1 || $2) {
                        $class = $1;
                        $id = $2;
                        if ($class) {
                            $params =~ s/\([A-Za-z0-9_\-\ ]+?(#.*?)?\)//g;
                        } elsif ($id) {
                            $params =~ s/\(#.+?\)//g;
                        }
                    }
                }
                if ($params =~ m/(\(+)/) {
                    $padleft = length($1);
                    $params =~ s/\(+//;
                }
                if ($params =~ m/(\)+)/) {
                    $padright = length($1);
                    $params =~ s/\)+//;
                }
                if ($params =~ m/\[(.+?)\]/) {
                    $lang = $1;
                    if ($block eq 'bc') {
                        $bqlang = $lang;
                        $lang = undef;
                    }
                    $params =~ s/\[.+?\]//;
                }
            }
            #warn "settings:\n\tblock: $block\n\tpadleft: $padleft\n\tpadright: $padright\n\tclass: $class\n\tstyle: $style\n\tid: $id\n\tfilter: $filter\n\talign: $align\n\tlang: $lang\n\tsticky: $sticky";
            $para = substr($para, pos($para));
        } elsif ($para =~ m/^$/) {
            $buffer = $repl[$1-1];
        } elsif ($para =~ m/^clear([<>]+)?\.$/) {
            if ($1 eq '<') {
                $clear = 'left';
            } elsif ($1 eq '>') {
                $clear = 'right';
            } else {
                $clear = 'both';
            }
            next;
        } elsif ($sticky && (defined $stickybuff) &&
                 ($block eq 'table' || $block eq 'dl')) {
            $stickybuff .= $para;
            next;
        } elsif ($para =~ m/^(?:$halignre|$clstypadre*)*
                             [\*\#]
                             (?:$halignre|$clstypadre*)*
                             \ /x) {
            # '*', '#' prefix means a list
            $buffer = $self->format_list(text => $para);
        } elsif ($para =~ m/^(?:table(?:$tblalignre|$clstypadre*)*
                             (\.\.?)\s+)?
                             (?:_|$alignre|$clstypadre*)*\|/x) {
            # handle wiki-style tables
            if (defined $1 && ($1 eq '..')) {
                $block = 'table';
                $stickybuff = $para;
                $sticky = 1;
                next;
            } else {
                $buffer = $self->format_table(text => $para);
            }
        } elsif ($para =~ m/^(?:dl(?:$clstyre)*(\.\.?)\s+)/) {
            # handle definition lists
            if (defined $1 && ($1 eq '..')) {
                $block = 'dl';
                $stickybuff = $para;
                $sticky = 1;
                next;
            } else {
                $buffer = $self->format_deflist(text => $para);
            }
        }
        if (defined $buffer) {
            $out .= $buffer;
            next;
        }
        @lines = split /\n/, $para;
        next unless @lines;

        $block ||= 'p';

        $buffer = '';
        my $pre = '';
        my $post = '';

        if ($block eq 'bc') {
            if ($sticky <= 1) {
                $pre .= $self->{_blockcode_open};
                $pre =~ s/>$//s;
                $pre .= qq{ language="$bqlang"} if $bqlang;
                if ($align) {
                    my $alignment = _halign($align);
                    if ($self->{css_mode}) {
                        if (($padleft || $padright) &&
                            (($alignment eq 'left') || ($alignment eq 'right'))) {
                            $style .= ';float:'.$alignment;
                        } else {
                            $style .= ';text-align:'.$alignment;
                        }
                        $class .= ' '.$self->{css}{"class_align_$alignment"} || $alignment;
                    } else {
                        $pre .= qq{ align="$alignment"} if $alignment;
                    }
                }
                $style .= qq{;padding-left:${padleft}em} if $padleft;
                $style .= qq{;padding-right:${padright}em} if $padright;
                $style .= qq{;clear:${clear}} if $clear;
                $class =~ s/^ // if $class;
                $pre .= qq{ class="$class"} if $class;
                $pre .= qq{ id="$id"} if $id;
                $style =~ s/^;// if $style;
                $pre .= qq{ style="$style"} if $style;
                $pre .= qq{ lang="$lang"} if $lang;
                $pre .= '>';
                $lang = undef;
                $bqlang = undef;
                $clear = undef;
            }
            $para =~ s{(?:^|(?<=[\s>])|([{[]))
                       ==(.+?)==
                       (?:$|([\]}])|(?=$punct{1,2}|\s))}
                      {_repl(\@repl, $self->format_block(text => $2, inline => 1, pre => $1, post => $3))}gesx;
            $buffer .= $self->encode_html_basic($para, 1);
            $buffer =~ s/<textile#(\d+)>//g;
            if ($sticky == 0) {
                $post .= $self->{_blockcode_close};
            }
            $out .= $pre . $buffer . $post;
            next;
        } elsif ($block eq 'bq') {
            if ($sticky <= 1) {
                $pre .= '
                if ($align) {
                    my $alignment = _halign($align);
                    if ($self->{css_mode}) {
                        if (($padleft || $padright) &&
                            (($alignment eq 'left') || ($alignment eq 'right'))) {
                            $style .= ';float:'.$alignment;
                        } else {
                            $style .= ';text-align:'.$alignment;
                        }
                        $class .= ' '.$self->{css}{"class_align_$alignment"} || $alignment;
                    } else {
                        $pre .= qq{ align="$alignment"} if $alignment;
                    }
                }
                $style .= qq{;padding-left:${padleft}em} if $padleft;
                $style .= qq{;padding-right:${padright}em} if $padright;
                $style .= qq{;clear:${clear}} if $clear;
                $class =~ s/^ // if $class;
                $pre .= qq{ class="$class"} if $class;
                $pre .= qq{ id="$id"} if $id;
                $style =~ s/^;// if $style;
                $pre .= qq{ style="$style"} if $style;
                $pre .= qq{ lang="$lang"} if $lang;
                $pre .= q{ cite="} . $self->format_url(url => $cite) . '"' if defined $cite;
                $pre .= '>';
                $clear = undef;
            }
            $pre .= '';
        } elsif ($block =~ m/fn(\d+)/) {
            my $fnum = $1;
            $pre .= '
            $class .= ' '.$self->{css}{class_footnote} if $self->{css}{class_footnote};
            if ($align) {
                my $alignment = _halign($align);
                if ($self->{css_mode}) {
                    if (($padleft || $padright) &&
                        (($alignment eq 'left') || ($alignment eq 'right'))) {
                        $style .= ';float:'.$alignment;
                    } else {
                        $style .= ';text-align:'.$alignment;
                    }
                    $class .= $self->{css}{"class_align_$alignment"} || $alignment;
                } else {
                    $pre .= qq{ align="$alignment"};
                }
            }
            $style .= qq{;padding-left:${padleft}em} if $padleft;
            $style .= qq{;padding-right:${padright}em} if $padright;
            $style .= qq{;clear:${clear}} if $clear;
            $class =~ s/^ // if $class;
            $pre .= qq{ class="$class"} if $class;
            $pre .= qq{ id="}.($self->{css}{id_footnote_prefix}||'fn').$fnum.'"';
            $style =~ s/^;// if $style;
            $pre .= qq{ style="$style"} if $style;
            $pre .= qq{ lang="$lang"} if $lang;
            $pre .= '>';
            $pre .= ''.$fnum.' ';
            # we can close like a regular paragraph tag now
            $block = 'p';
            $clear = undef;
        } else {
            $pre .= '<' . ($macros{$block} || $block);
            if ($align) {
                my $alignment = _halign($align);
                if ($self->{css_mode}) {
                    if (($padleft || $padright) &&
                        (($alignment eq 'left') || ($alignment eq 'right'))) {
                        $style .= ';float:'.$alignment;
                    } else {
                        $style .= ';text-align:'.$alignment;
                    }
                    $class .= ' '.$self->{css}{"class_align_$alignment"} || $alignment;
                } else {
                    $pre .= qq{ align="$alignment"};
                }
            }
            $style .= qq{;padding-left:${padleft}em} if $padleft;
            $style .= qq{;padding-right:${padright}em} if $padright;
            $style .= qq{;clear:${clear}} if $clear;
            $class =~ s/^ // if $class;
            $pre .= qq{ class="$class"} if $class;
            $pre .= qq{ id="$id"} if $id;
            $style =~ s/^;// if $style;
            $pre .= qq{ style="$style"} if $style;
            $pre .= qq{ lang="$lang"} if $lang;
            $pre .= qq{ cite="} . $self->format_url(url => $cite) . '"' if defined $cite && $block eq 'bq'; #'
            $pre .= '>';
            $clear = undef;
        }

        $buffer = $self->format_paragraph(text => $para);

        if ($block eq 'bq') {
            $post .= '' if $buffer !~ m/]/;
            if ($sticky == 0) {
                $post .= '';
            }
        } else {
            $post .= '';
        }

        if ($buffer =~ m/$blocktags/) {
            $buffer =~ s/^\n\n//s;
            $out .= $buffer;
        } else {
            $buffer = $self->format_block(text => "|$filter|".$buffer, inline => 1) if defined $filter;
            $out .= $pre . $buffer . $post;
        }
    }

    if ($sticky) {
        if ($block eq 'bc') {
            # close our blockcode section
            $out .= $self->{_blockcode_close}; # . "\n\n";
        } elsif ($block eq 'bq') {
            $out .= ''; # . "\n\n";
        } elsif (($block eq 'table') && ($stickybuff)) {
            my $table_out = $self->format_table(text => $stickybuff);
            $out .= $table_out if defined $table_out;
        } elsif (($block eq 'dl') && ($stickybuff)) {
            my $dl_out = $self->format_deflist(text => $stickybuff);
            $out .= $dl_out if defined $dl_out;
        }
    }

    # cleanup-- restore preserved blocks
    my $i = scalar(@repl);
    $out =~ s!(?:<|<)textile#$i(?:>|>)!$_!, $i-- while local $_ = pop @repl;

    # scan for br, hr tags that are not closed and close them
    # only for xhtml! just the common ones -- don't fret over input
    # and the like.
    if ($self->{flavor} =~ m/^xhtml/i) {
        $out =~ s/(<(?:img|br|hr)[^>]*?(?/$1 \/>/g;
    }

    return $out;
}

sub format_paragraph {
    my $self = shift;
    my (%args) = @_;
    my $buffer = defined $args{text} ? $args{text} : '';

    my @repl;
    $buffer =~ s{(?:^|(?<=[\s>])|([{[]))
                 ==(.+?)==
                 (?:$|([\]}])|(?=$punct{1,2}|\s))}
                {_repl(\@repl, $self->format_block(text => $2, inline => 1, pre => $1, post => $3))}gesx;

    my $tokens;
    if ($buffer =~ m/{disable_html})) {  # optimization -- no point in tokenizing if we
                            # have no tags to tokenize
        $tokens = _tokenize($buffer);
    } else {
        $tokens = [['text', $buffer]];
    }
    my $result = '';
    foreach my $token (@{$tokens}) {
        my $text = $token->[1];
        if ($token->[0] eq 'tag') {
            $text =~ s/&(?!amp;)/&/g;
            $result .= $text;
        } else {
            $text = $self->format_inline(text => $text);
            $result .= $text;
        }
    }

    # now, add line breaks for lines that contain plaintext
    my @lines = split /\n/, $result;
    $result = '';
    my $needs_closing = 0;
    foreach my $line (@lines) {
        if (($line !~ m/($blocktags)/)
            && (($line =~ m/^[^<]/ || $line =~ m/>[^<]/)
                || ($line !~ m/
            if ($self->{_line_open}) {
                $result .= "\n" if $result ne '';
                $result .= $self->{_line_open} . $line . $self->{_line_close};
            } else {
                if ($needs_closing) {
                    $result .= $self->{_line_close} ."\n";
                } else {
                    $needs_closing = 1;
                    $result .= "\n" if $result ne '';
                }
                $result .= $line;
            }
        } else {
            if ($needs_closing) {
                $result .= $self->{_line_close} ."\n";
            } else {
                $result .= "\n" if $result ne '';
            }
            $result .= $line;
            $needs_closing = 0;
        }
    }

    # at this point, we will restore the \001's to \n's (reversing
    # the step taken in _tokenize).
    #$result =~ s/\r/\n/g;
    $result =~ s/\001/\n/g;

    my $i = scalar(@repl);
    $result =~ s||$_|, $i-- while local $_ = pop @repl;

    # quotalize
    if ($self->{do_quotes}) {
        $result = $self->process_quotes($result);
    }

    return $result;
}

{
my @qtags = (['**', 'b',      '(?
             ['__', 'i',      '(?
             ['??', 'cite',   '\?\?(?!\?)', '\?'],
             ['*',  'strong', '(?
             ['_',  'em',     '(?
             ['-',  'del',    '(?
             ['+',  'ins',    '(?
             ['++', 'big',    '(?
             ['--', 'small',  '(?
             ['~',  'sub',    '(?


sub format_inline {
    my $self = shift;
    my (%args) = @_;
    my $text = defined $args{text} ? $args{text} : '';

    my @repl;

    no warnings 'uninitialized';
    $text =~ s{$codere}{_repl(\@repl, $self->format_code(text => $2.$4, lang => $1.$3))}gem;

    # images must be processed before encoding the text since they might
    # have the <, > alignment specifiers...

    # !blah (alt)! -> image
    $text =~ s!(?:^|(?<=[\s>])|([{[]))     # $1: open brace/bracket
               \!                          # opening
               ($imgalignre?)              # $2: optional alignment
               ($clstypadre*)              # $3: optional CSS class/id
               ($imgalignre?)              # $4: optional alignment
               (?:(?<=[^\!])\s+)?          # optional space between alignment/css stuff
               ([^\s\(\!]+)                # $5: filename
               (\s*[^\(\!]*(?:\([^\)]+\))?[^\!]*) # $6: extras (alt text)
               \!                          # closing
               (?::(\d+|$urlre))?          # $7: optional URL
               (?:$|([\]}])|(?=$punct{1,2}|\s))# $8: closing brace/bracket
              !_repl(\@repl, $self->format_image(pre => $1, src => $5, align => $2||$4, extra => $6, url => $7, clsty => $3, post => $8))!gemx;

    $text =~ s!(?:^|(?<=[\s>])|([{[]))     # $1: open brace/bracket
               \%                          # opening
               ($halignre?)                # $2: optional alignment
               ($clstyre*)                 # $3: optional CSS class/id
               ($halignre?)                # $4: optional alignment
               (?:\s*)                     # spacing
               ([^\%]+?)                   # $5: text
               \%                          # closing
               (?::(\d+|$urlre))?          # $6: optional URL
               (?:$|([\]}])|(?=$punct{1,2}|\s))# $7: closing brace/bracket
              !_repl(\@repl, $self->format_span(pre => $1,text => $5,align => $2||$4, cite => $6, clsty => $3, post => $7))!gemx;

    $text = $self->encode_html($text);
    $text =~ s!<textile#(\d+)>!!g;
    $text =~ s!&quot;!"!g;
    $text =~ s!&(([a-zA-Z0-9]+|#\d+|#x[0-9A-Fa-f]+);)!&$1!g;
    $text =~ s!"!"!g; #"

    # These create markup with entities. Do first and 'save' result for later:
    # "text":url -> hyperlink
    # links with brackets surrounding
    my $parenre = qr/\( (?: [^()] )* \)/x;
    $text =~ s!(
               [{[]
               (?:
                   (?:"                    # quote character
                      ($clstyre*)?         # $2: optional CSS class/id
                      ([^"]+?)             # $3: link text
                      (?:\( ( (?:[^()]|$parenre)*) \))? # $4: optional link title
                      "                    # closing quote
                   )
                   |
                   (?:'                    # open single quote
                      ($clstyre*)?         # $5: optional CSS class/id
                      ([^']+?)             # $6: link text
                      (?:\( ( (?:[^()]|$parenre)*) \))? # $7: optional link title
                      '                    # closing quote
                   )
               )
               :(.+?)                      # $8: URL suffix
               [\]}]
              )
              !_repl(\@repl,
                    $self->format_link(
                        text     => $1,
                        linktext => defined $3 ? $3 : $6,
                        title    => $self->encode_html_basic( defined $4 ? $4 : $7 ),
                        url      => $8,
                        clsty    => defined $2 ? $2 : $5)
                )!gemx;

    $text =~ s!((?:^|(?<=[\s>\(]))         # $1: open brace/bracket
               (?: (?:"                    # quote character "
                      ($clstyre*)?         # $2: optional CSS class/id
                      ([^"]+?)             # $3: link text "
                      (?:\( ( (?:[^()]|$parenre)*) \))?    # $4: optional link title
                      "                    # closing quote # "
                   )
                   |
                   (?:'                    # open single quote '
                      ($clstyre*)?         # $5: optional CSS class/id
                      ([^']+?)             # $6: link text '
                      (?:\( ( (?:[^()]|$parenre)*) \))?  # $7: optional link title
                      '                    # closing quote '
                   )
               )
               :(\d+|$urlre)               # $8: URL suffix
               (?:$|(?=$punct{1,2}|\s)))   # $9: closing brace/bracket
              !_repl(\@repl,
                    $self->format_link(
                        text     => $1,
                        linktext => defined $3 ? $3 : $6,
                        title    => $self->encode_html_basic( defined $4 ? $4 : $7 ),
                        url      => $8,
                        clsty    => defined $2 ? $2 : $5)
                )!gemx;

    if ($self->{flavor} =~ m/^xhtml2/) {
        # citation with cite link
        $text =~ s!(?:^|(?<=[\s>'"\(])|([{[])) # $1: open brace/bracket '
                   \?\?                        # opening '??'
                   ([^\?]+?)                   # $2: characters (can't contain '?')
                   \?\?                        # closing '??'
                   :(\d+|$urlre)               # $3: optional citation URL
                   (?:$|([\]}])|(?=$punct{1,2}|\s))# $4: closing brace/bracket
                  !_repl(\@repl, $self->format_cite(pre => $1,text => $2,cite => $3,post => $4))!gemx;
    }

    # footnotes
    if ($text =~ m/[^ ]\[\d+\]/) {
        my $fntag = '
        $fntag .= ' class="'.$self->{css}{class_footnote}.'"' if $self->{css}{class_footnote};
        $fntag .= '>
986
        $text =~ s{([^ ])\[(\d+)\]}{$1$fntag$2">$2}g;
    }

    # translate macros:
    $text =~ s{(\{)(.+?)(\})}
              {$self->format_macro(pre => $1, post => $3, macro => $2)}gex;

    # these were present with textile 1 and are common enough
    # to not require macro braces...
    # (tm) -> ™
    $text =~ s{[\(\[]TM[\)\]]}{™}gi;
    # (c) -> ©
    $text =~ s{[\(\[]C[\)\]]}{©}gi;
    # (r) -> ®
    $text =~ s{[\(\[]R[\)\]]}{®}gi;

    if ($self->{preserve_spaces}) {
        # replace two spaces with an em space
        $text =~ s/(?
    }

    $text = $self->format_phrase_modifiers( text => $text );

    # ABC(Aye Bee Cee) -> acronym
    $text =~ s{\b([A-Z][A-Za-z0-9]*?[A-Z0-9]+?)\b(?:[(]([^)]*)[)])}
              {_repl(\@repl,qq{$1})}ge;

    # ABC -> 'capped' span
    if (my $caps = $self->{css}{class_caps}) {
        $text =~ s/(^|[^"][>\s])  # "
                   ((?:[A-Z](?:[A-Z0-9\.,']|\&){2,}\ *)+?) # '
                   (?=[^A-Z\.0-9]|$)
                  /$1._repl(\@repl, qq{$2<\/span>})/gemx;
    }

    # nxn -> n×n
    $text =~ s{((?:[0-9\.]0|[1-9]|\d['"])\ ?)x(\ ?\d)}{$1×$2}g;

    # translate these entities to the Unicode equivalents:
    $text =~ s/…/…/g;
    $text =~ s/‘/‘/g;
    $text =~ s/’/’/g;
    $text =~ s/“/“/g;
    $text =~ s/”/”/g;
    $text =~ s/–/–/g;
    $text =~ s/—/—/g;

    # Restore replacements done earlier:
    my $i = scalar(@repl);
    $text =~ s||$_|, $i-- while local $_ = pop @repl;

    # translate entities to characters for highbit stuff since
    # we're using utf8
    # removed for backward compatability with older versions of Perl
    #if ($self->{charset} =~ m/^utf-?8$/i) {
    #    # translate any unicode entities to native UTF-8
    #    $text =~ s/\&\#(\d+);/($1 > 127) ? pack('U',$1) : chr($1)/ge;
    #}

    $text;
}

sub format_phrase_modifiers {
    my $self = shift;
    my (%args) = @_;
    my $text = defined $args{text} ? $args{text} : '';

    my $redo = $text =~ m/[\*_\?\-\+\^\~]/;
    my $last = $text;
    while ($redo) {
        # simple replacements...
        $redo = 0;
        foreach my $tag (@qtags) {
            my ($f, $r, $qf, $cls) = @{$tag};
            if ($text =~ s/(?:^|(?<=[\s>'"])|([{[])) # "' $1 - pre
                           $qf                       #
                           (?:($clstyre*))?          # $2 - attributes
                           ([^$cls\s].*?)            # $3 - content
                           (?<=\S)$qf                #
                           (?:$|([\]}])|(?=$punct{1,2}|\s)) # $4 - post
                          /$self->format_tag(tag => $r, marker => $f, pre => $1, text => $3, clsty => $2, post => $4)/gemx) {
                    $redo ||= $last ne $text;
                    $last = $text;
            }
        }
    }

    # superscript is an even simpler replacement...
    $text =~ s/(?$1<\/sup>/g;

    return $text;

}

}

{
    # pull in charnames, but only for Perl 5.8 or later (and
    # disable strict subs for backward compatability
    my $Have_Charnames = 0;
    if ($] >= 5.008) {
        eval 'use charnames qw(:full);';
        $Have_Charnames = 1;
    }

    sub format_macro {
        my $self = shift;
        my %attrs = @_;
        my $macro = $attrs{macro};
        if (defined $self->{macros}->{$macro}) {
            return $self->{macros}->{$macro};
        }

        # handle full unicode name translation
        if ($Have_Charnames) {
            # charnames::vianame is only available in Perl 5.8.0 and later...
            if (defined (my $unicode = charnames::vianame(uc($macro)))) {
                return '&#'.$unicode.';';
            }
        }

        return $attrs{pre}.$macro.$attrs{post};
    }
}

sub format_cite {
    my $self = shift;
    my (%args) = @_;
    my $pre  = defined $args{pre}  ? $args{pre}  : '';
    my $text = defined $args{text} ? $args{text} : '';
    my $post = defined $args{post} ? $args{post} : '';
    my $cite = $args{cite};
    _strip_borders(\$pre, \$post);
    my $tag = $pre.'
    if (($self->{flavor} =~ m/^xhtml2/) && defined $cite && $cite) {
        $cite = $self->format_url(url => $cite);
        $tag .= qq{ cite="$cite"};
    } else {
        $post .= ':';
    }
    $tag .= '>';
    return $tag . $self->format_inline(text => $text) . ''.$post;
}

sub format_code {
    my $self = shift;
    my (%args) = @_;
    my $code = defined $args{text} ? $args{text} : '';
    my $lang = $args{lang};
    $code = $self->encode_html($code, 1);
    $code =~ s/<textile#(\d+)>//g;
    my $tag = '
    $tag .= " language=\"$lang\"" if $lang;
    return $tag . '>' . $code . '';
}

sub format_classstyle {
    my $self = shift;
    my ($clsty, $class, $style) = @_;

    $style = ''      if not defined $style;
    $class =~ s/^ // if     defined $class;

    my ($lang, $padleft, $padright, $id);
    if ($clsty && ($clsty =~ m/{([^}]+)}/)) {
        my $_style = $1;
        $_style =~ s/\n/ /g;
        $style .= ';'.$_style;
        $clsty =~ s/{[^}]+}//g;
    }
    if ($clsty && ($clsty =~ m/\(([A-Za-z0-9_\- ]+?)(?:#(.+?))?\)/ ||
                   $clsty =~ m/\(([A-Za-z0-9_\- ]+?)?(?:#(.+?))\)/)) {
        if ($1 || $2) {
            if ($class) {
                $class = $1 . ' ' . $class;
            } else {
                $class = $1;
            }
            $id = $2;
            if ($class) {
                $clsty =~ s/\([A-Za-z0-9_\- ]+?(#.*?)?\)//g;
            }
            if ($id) {
                $clsty =~ s/\(#.+?\)//g;
            }
        }
    }
    if ($clsty && ($clsty =~ m/(\(+)/)) {
        $padleft = length($1);
        $clsty =~ s/\(+//;
    }
    if ($clsty && ($clsty =~ m/(\)+)/)) {
        $padright = length($1);
        $clsty =~ s/\)+//;
    }
    if ($clsty && ($clsty =~ m/\[(.+?)\]/)) {
        $lang = $1;
        $clsty =~ s/\[.+?\]//g;
    }
    my $attrs = '';

    $style .= qq{;padding-left:${padleft}em} if $padleft;
    $style .= qq{;padding-right:${padright}em} if $padright;
    $style =~ s/^;//;

    if ( $class ) {
        $class =~ s/^ //;
        $class =~ s/ $//;
        $attrs .= qq{ class="$class"};
    }
    $attrs .= qq{ id="$id"} if $id;
    $attrs .= qq{ style="$style"} if $style;
    $attrs .= qq{ lang="$lang"} if $lang;
    $attrs =~ s/^ //;

    return $attrs;
}

sub format_tag {
    my $self = shift;
    my (%args) = @_;
    my $tagname = $args{tag};
    my $text  = defined $args{text}  ? $args{text}  : '';
    my $pre   = defined $args{pre}   ? $args{pre}   : '';
    my $post  = defined $args{post}  ? $args{post}  : '';
    my $clsty = defined $args{clsty} ? $args{clsty} : '';
    _strip_borders(\$pre, \$post);
    my $tag = "<$tagname";
    my $attr = $self->format_classstyle($clsty);
    $tag .= qq{ $attr} if $attr;
    $tag .= qq{>$text};

    return $pre.$tag.$post;
}

sub format_deflist {
    my $self = shift;
    my (%args) = @_;
    my $str = defined $args{text} ? $args{text} : '';
    my $clsty;
    my @lines = split /\n/, $str;
    if ($lines[0] =~ m/^(dl($clstyre*?)\.\.?(?:\ +|$))/) {
        $clsty = $2;
        $lines[0] = substr($lines[0], length($1));
    }


    my ($dt, $dd);
    my $out = '';
    foreach my $line (@lines) {
        if ($line =~ m/^((?:$clstyre*)(?:[^\ ].*?)(?
            $out .= add_term($self, $dt, $dd) if ($dt && $dd);
            $dt = $1;
            $dd = $2;
        } else {
            $dd .= "\n" . $line;
        }
    }
    $out .= add_term($self, $dt, $dd) if $dt && $dd;

    my $tag = '
    my $attr;
    $attr = $self->format_classstyle($clsty) if $clsty;
    $tag .= qq{ $attr} if $attr;
    $tag .= '>'."\n";

    return $tag.$out."\n";
}

sub add_term {
    my ($self, $dt, $dd) = @_;
    my ($dtattr, $ddattr);
    my $dtlang;
    if ($dt =~ m/^($clstyre*)/) {
        my $param = $1;
        $dtattr = $self->format_classstyle($param);
        if ($param =~ m/\[([A-Za-z]+?)\]/) {
            $dtlang = $1;
        }
        $dt = substr($dt, length($param));
    }
    if ($dd =~ m/^($clstyre*)/) {
        my $param = $1;
        # if the language was specified for the term,
        # then apply it to the definition as well (unless
        # already specified of course)
        if ($dtlang && ($param =~ m/\[([A-Za-z]+?)\]/)) {
            undef $dtlang;
        }
        $ddattr = $self->format_classstyle(($dtlang ? "[$dtlang]" : '') . $param);
        $dd = substr($dd, length($param));
    }
    my $out = '
    $out .= qq{ $dtattr} if $dtattr;
    $out .= '>' . $self->format_inline(text => $dt) . '' . "\n";
    if ($dd =~ m/\n\n/) {
        $dd = $self->textile($dd) if $dd =~ m/\n\n/;
    } else {
        $dd = $self->format_paragraph(text => $dd);
    }
    $out .= '
    $out .= qq{ $ddattr} if $ddattr;
    $out .= '>' . $dd . '' . "\n";

    return $out;
}


sub format_list {
    my $self = shift;
    my (%args) = @_;
    my $str = defined $args{text} ? $args{text} : '';

    my %list_tags = ('*' => 'ul', '#' => 'ol');

    my @lines = split /\n/, $str;

    my @stack;
    my $last_depth = 0;
    my $item = '';
    my $out = '';
    foreach my $line (@lines) {
        if ($line =~ m/^((?:$clstypadre*|$halignre)*)
                       ([\#\*]+)
                       ((?:$halignre|$clstypadre*)*)
                       \ (.+)$/x) {
            if ($item ne '') {
                if ($item =~ m/\n/) {
                    if ($self->{_line_open}) {
                        $item =~ s/(]*>|^)/$1$self->{_line_open}/gm;
                        $item =~ s/(\n|$)/$self->{_line_close}$1/gs;
                    } else {
                        $item =~ s/(\n)/$self->{_line_close}$1/gs;
                    }
                }
                $out .= $item;
                $item = '';
            }
            my $type = substr($2, 0, 1);
            my $depth = length($2);
            my $blockparam = $1;
            my $itemparam = $3;
            $line = $4;
            my ($blockclsty, $blockalign, $blockattr, $itemattr, $itemclsty,
                $itemalign);
            if ($blockparam =~ m/($clstypadre+)/) {
                $blockclsty = $1;
            }
            if ($blockparam =~ m/($halignre+)/) {
                $blockalign = $1;
            }
            if ($itemparam =~ m/($clstypadre+)/) {
                $itemclsty = $1;
            }
            if ($itemparam =~ m/($halignre+)/) {
                $itemalign = $1;
            }
            $itemattr = $self->format_classstyle($itemclsty) if $itemclsty;
            if ($depth > $last_depth) {
                for (my $j = $last_depth; $j < $depth; $j++) {
                    $out .= qq{<$list_tags{$type}};
                    push @stack, $type;
                    if ($blockclsty) {
                        $blockattr = $self->format_classstyle($blockclsty);
                        $out .= ' '.$blockattr if $blockattr;
                    }
                    $out .= ">\n
                    $out .= qq{ $itemattr} if $itemattr;
                    $out .= ">";
                }
            } elsif ($depth < $last_depth) {
                for (my $j = $depth; $j < $last_depth; $j++) {
                    $out .= "\n" if $j == $depth;
                    my $type = pop @stack;
                    $out .= qq{\n\n};
                }
                if ($depth) {
                    $out .= '
                    $out .= qq{ $itemattr} if $itemattr;
                    $out .= '>';
                }
            } else {
                $out .= "\n
                $out .= qq{ $itemattr} if $itemattr;
                $out .= '>';
            }
            $last_depth = $depth;
        }
        $item .= "\n" if $item ne '';
        $item .= $self->format_paragraph(text => $line);
    }

    if ($item =~ m/\n/) {
        if ($self->{_line_open}) {
            $item =~ s/(]*>|^)/$1$self->{_line_open}/gm;
            $item =~ s/(\n|$)/$self->{_line_close}$1/gs;
        } else {
            $item =~ s/(\n)/$self->{_line_close}$1/gs;
        }
    }
    $out .= $item;

    for (my $j = 1; $j <= $last_depth; $j++) {
        $out .= '' if $j == 1;
        my $type = pop @stack;
        $out .= "\n".'';
        $out .= '' if $j != $last_depth;
    }

    return $out;
}

sub format_block {
    my $self = shift;
    my (%args) = @_;
    my $str    = defined $args{text} ? $args{text} : '';
    my $pre    = defined $args{pre}  ? $args{pre}  : '';
    my $post   = defined $args{post} ? $args{post} : '';
    my $inline = $args{inline};
    _strip_borders(\$pre, \$post);
    my ($filters) = $str =~ m/^(\|(?:(?:[a-z0-9_\-]+)\|)+)/;
    if ($filters) {
        my $filtreg = quotemeta($filters);
        $str =~ s/^$filtreg//;
        $filters =~ s/^\|//;
        $filters =~ s/\|$//;
        my @filters = split /\|/, $filters;
        $str = $self->apply_filters(text => $str, filters => \@filters);
        my $count = scalar(@filters);
        if ($str =~ s!(){$count}!$1!gs) {
            $str =~ s!(){$count}!$1!gs;
            $str =~ s!(){$count}!$1!gs;
        }
    }
    if ($inline) {
        # strip off opening para, closing para, since we're
        # operating within an inline block
        $str =~ s/^\s*]*>//;
        $str =~ s/<\/p>\s*$//;
    }

    return $pre.$str.$post;
}

sub format_link {
    my $self = shift;
    my (%args) = @_;
    my $text     = defined $args{text}     ? $args{text}     : '';
    my $linktext = defined $args{linktext} ? $args{linktext} : '';
    my $title    = $args{title};
    my $url      = $args{url};
    my $clsty    = $args{clsty};

    if (!defined $url || $url eq '') {
        return $text;
    }
    if ($self->{links} && $self->{links}{$url}) {
        $title ||= $self->{links}{$url}{title};
        $url     = $self->{links}{$url}{url};
    }
    $linktext =~ s/ +$//;
    $linktext = $self->format_paragraph(text => $linktext);
    $url = $self->format_url(linktext => $linktext, url => $url);
    my $tag = qq{
    my $attr = $self->format_classstyle($clsty);
    $tag .= qq{ $attr} if $attr;
    if (defined $title) {
        $title =~ s/^\s+//;
        $tag .= qq{ title="$title"} if length($title);
    }
    $tag .= qq{>$linktext};

    return $tag;
}

sub format_url {
    my $self = shift;
    my (%args) = @_;
    my $url = defined $args{url} ? $args{url} : '';
    if ($url =~ m/^(mailto:)?([-\+\w]+\@[-\w]+(\.\w[-\w]*)+)$/) {
        $url = 'mailto:'.$self->mail_encode($2);
    }
    if ($url !~ m{^(/|\./|\.\./|#)}) {
        $url = "http://$url" if $url !~ m{^(?:https?|ftp|mailto|nntp|telnet)};
    }
    $url =~ s/&(?!amp;)/&/g;
    $url =~ s/ /\+/g;
    $url =~ s/^((?:.+?)\?)(.+)$/$1.$self->encode_url($2)/ge;

    return $url;
}

sub format_span {
    my $self = shift;
    my (%args) = @_;
    my $text = defined $args{text} ? $args{text} : '';
    my $pre  = defined $args{pre}  ? $args{pre}  : '';
    my $post = defined $args{post} ? $args{post} : '';
    my $cite = defined $args{cite} ? $args{cite} : '';
    my $align = $args{align};
    my $clsty = $args{clsty};
    _strip_borders(\$pre, \$post);
    my ($class, $style);
    my $tag  = qq{
    $style = '';
    if (defined $align) {
        if ($self->{css_mode}) {
            my $alignment = _halign($align);
            $style .= qq{;float:$alignment} if $alignment;
            $class .= ' '.$self->{css}{"class_align_$alignment"} if $alignment;
        } else {
            my $alignment = _halign($align) || _valign($align);
            $tag .= qq{ align="$alignment"} if $alignment;
        }
    }
    my $attr = $self->format_classstyle($clsty, $class, $style);
    $tag .= qq{ $attr} if $attr;
    if (defined $cite) {
        $cite =~ s/^://;
        $cite = $self->format_url(url => $cite);
        $tag .= qq{ cite="$cite"};
    }

    return $pre.$tag.'>'.$self->format_paragraph(text => $text).''.$post;
}

sub format_image {
    my $self = shift;
    my (%args) = @_;
    my $src   = defined $args{src}  ? $args{src}  : '';
    my $pre   = defined $args{pre}  ? $args{pre}  : '';
    my $post  = defined $args{post} ? $args{post} : '';
    my $extra = $args{extra};
    my $align = $args{align};
    my $link  = $args{url};
    my $clsty = $args{clsty};
    _strip_borders(\$pre, \$post);
    return $pre.'!!'.$post if length($src) == 0;
    my $tag;
    if ($self->{flavor} =~ m/^xhtml2/) {
        my $type; # poor man's mime typing. need to extend this externally
        if ($src =~ m/(?:\.jpeg|\.jpg)$/i) {
            $type = 'image/jpeg';
        } elsif ($src =~ m/\.gif$/i) {
            $type = 'image/gif';
        } elsif ($src =~ m/\.png$/i) {
            $type = 'image/png';
        } elsif ($src =~ m/\.tiff$/i) {
            $type = 'image/tiff';
        }
        $tag = qq{
        $tag .= qq{ type="$type"} if $type;
        $tag .= qq{ data="$src"};
    } else {
        $tag = qq{
    }
    my ($class, $style);
    if (defined $align) {
        if ($self->{css_mode}) {
            my $alignment = _halign($align);
            $style .= qq{;float:$alignment} if $alignment;
            $class .= ' '.$alignment if $alignment;
            $alignment = _valign($align);
            if ($alignment) {
                my $imgvalign = ($alignment =~ m/(top|bottom)/ ? 'text-' . $alignment : $alignment);
                $style .= qq{;vertical-align:$imgvalign} if $imgvalign;
                $class .= ' '.$self->{css}{"class_align_$alignment"} if $alignment;
            }
        } else {
            my $alignment = _halign($align) || _valign($align);
            $tag .= qq{ align="$alignment"} if $alignment;
        }
    }
    my ($pctw, $pcth, $w, $h, $alt);
    if (defined $extra) {
        ($alt) = $extra =~ m/\(([^\)]+)\)/;
        $extra =~ s/\([^\)]+\)//;
        my ($pct) = ($extra =~ m/(^|\s)(\d+)%(\s|$)/)[1];
        if (!$pct) {
            ($pctw, $pcth) = ($extra =~ m/(^|\s)(\d+)%x(\d+)%(\s|$)/)[1,2];
        } else {
            $pctw = $pcth = $pct;
        }
        if (!$pctw && !$pcth) {
            ($w,$h) = ($extra =~ m/(^|\s)(\d+|\*)x(\d+|\*)(\s|$)/)[1,2];
            $w = '' if $w && $w eq '*';
            $h = '' if $h && $h eq '*';
            if (!$w) {
                ($w) = ($extra =~ m/(^|[,\s])(\d+)w([\s,]|$)/)[1];
            }
            if (!$h) {
                ($h) = ($extra =~ m/(^|[,\s])(\d+)h([\s,]|$)/)[1];
            }
        }
    }
    $alt = '' unless defined $alt;
    if ($self->{flavor} !~ m/^xhtml2/) {
        $tag .= ' alt="' . $self->encode_html_basic($alt) . '"';
    }
    if ($w && $h) {
        if ($self->{flavor} !~ m/^xhtml2/) {
            $tag .= qq{ height="$h" width="$w"};
        } else {
            $style .= qq{;height:$h}.qq{px;width:$w}.q{px};
        }
    } else {
        my ($image_w, $image_h) = $self->image_size($src);
        if (($image_w && $image_h) && ($w || $h)) {
            # image size determined, but only width or height specified
            if ($w && !$h) {
                # width defined, scale down height proportionately
                $h = int($image_h * ($w / $image_w));
            } elsif ($h && !$w) {
                $w = int($image_w * ($h / $image_h));
            }
        } else {
            $w = $image_w;
            $h = $image_h;
        }
        if ($w && $h) {
            if ($pctw || $pcth) {
                $w = int($w * $pctw / 100);
                $h = int($h * $pcth / 100);
            }
            if ($self->{flavor} !~ m/^xhtml2/) {
                $tag .= qq{ height="$h" width="$w"};
            } else {
                $style .= qq{;height:$h}.qq{px;width:$w}.q{px};
            }
        }
    }
    my $attr = $self->format_classstyle($clsty, $class, $style);
    $tag .= qq{ $attr} if $attr;
    if ($self->{flavor} =~ m/^xhtml2/) {
        $tag .= '>' . $self->encode_html_basic($alt) . '';
    } elsif ($self->{flavor} =~ m/^xhtml/) {
        $tag .= ' />';
    } else {
        $tag .= '>';
    }
    if (defined $link) {
        $link =~ s/^://;
        $link = $self->format_url(url => $link);
        $tag = ''.$tag.'';
    }

    return $pre.$tag.$post;
}

sub format_table {
    my $self = shift;
    my (%args) = @_;
    my $str = defined $args{text} ? $args{text} : '';

    my @lines = split /\n/, $str;
    my @rows;
    my $line_count = scalar(@lines);
    for (my $i = 0; $i < $line_count; $i++) {
       if ($lines[$i] !~ m/\|\s*$/) {
           if ($i + 1 < $line_count) {
               $lines[$i+1] = $lines[$i] . "\n" . $lines[$i+1] if $i+1 <= $#lines;
           } else {
               push @rows, $lines[$i];
           }
       } else {
           push @rows, $lines[$i];
       }
    }
    my ($tid, $tpadl, $tpadr, $tlang);
    my $tclass = '';
    my $tstyle = '';
    my $talign = '';
    if ($rows[0] =~ m/^table[^\.]/) {
        my $row = $rows[0];
        $row =~ s/^table//;
        my $params = 1;
        # process row parameters until none are left
        while ($params) {
            if ($row =~ m/^($tblalignre)/) {
                # found row alignment
                $talign .= $1;
                $row = substr($row, length($1)) if $1;
                redo if $1;
            }
            if ($row =~ m/^($clstypadre)/) {
                # found a class/id/style/padding indicator
                my $clsty = $1;
                $row = substr($row, length($clsty)) if $clsty;
                if ($clsty =~ m/{([^}]+)}/) {
                    $tstyle = $1;
                    $clsty =~ s/{([^}]+)}//;
                    redo if $tstyle;
                }
                if ($clsty =~ m/\(([A-Za-z0-9_\- ]+?)(?:#(.+?))?\)/ ||
                    $clsty =~ m/\(([A-Za-z0-9_\- ]+?)?(?:#(.+?))\)/) {
                    if ($1 || $2) {
                        $tclass = $1;
                        $tid = $2;
                        redo;
                    }
                }
                $tpadl = length($1) if $clsty =~ m/(\(+)/;
                $tpadr = length($1) if $clsty =~ m/(\)+)/;
                $tlang = $1 if $clsty =~ m/\[(.+?)\]/;
                redo if $clsty;
            }
            $params = 0;
        }
        $row =~ s/\.\s+//;
        $rows[0] = $row;
    }
    my $out = '';
    my @cols = split /\|/, $rows[0].' ';
    my (@colalign, @rowspans);
    foreach my $row (@rows) {
        my @cols = split /\|/, $row.' ';
        my $colcount = $#cols;
        pop @cols;
        my $colspan = 0;
        my $row_out = '';
        my ($rowclass, $rowid, $rowalign, $rowstyle, $rowheader);
        $cols[0] = '' if !defined $cols[0];
        if ($cols[0] =~ m/_/) {
            $cols[0] =~ s/_//g;
            $rowheader = 1;
        }
        if ($cols[0] =~ m/{([^}]+)}/) {
            $rowstyle = $1;
            $cols[0] =~ s/{[^}]+}//g;
        }
        if ($cols[0] =~ m/\(([^\#]+?)?(#(.+))?\)/) {
            $rowclass = $1;
            $rowid = $3;
            $cols[0] =~ s/\([^\)]+\)//g;
        }
        $rowalign = $1 if $cols[0] =~ m/($alignre)/;
        for (my $c = $colcount - 1; $c > 0; $c--) {
            if ($rowspans[$c]) {
                $rowspans[$c]--;
                next if $rowspans[$c] > 1;
            }
            my ($colclass, $colid, $header, $colparams, $colpadl, $colpadr, $collang);
            my $colstyle = '';
            my $colalign = $colalign[$c];
            my $col = pop @cols;
            $col ||= '';
            my $attrs = '';
            if ($col =~ m/^(((_|[\/\\]\d+|$alignre|$clstypadre)+)\. )/) {
                my $colparams = $2;
                $col = substr($col, length($1));
                my $params = 1;
                # keep processing column parameters until there
                # are none left...
                while ($params) {
                    if ($colparams =~ m/^(_|$alignre)/g) {
                        # found alignment or heading indicator
                        $attrs .= $1;
                        $colparams = substr($colparams, pos($colparams)) if $1;
                        redo if $1;
                    }
                    if ($colparams =~ m/^($clstypadre)/g) {
                        # found a class/id/style/padding marker
                        my $clsty = $1;
                        $colparams = substr($colparams, pos($colparams)) if $clsty;
                        if ($clsty =~ m/{([^}]+)}/) {
                            $colstyle = $1;
                            $clsty =~ s/{([^}]+)}//;
                        }
                        if ($clsty =~ m/\(([A-Za-z0-9_\- ]+?)(?:#(.+?))?\)/ ||
                            $clsty =~ m/\(([A-Za-z0-9_\- ]+?)?(?:#(.+?))\)/) {
                            if ($1 || $2) {
                                $colclass = $1;
                                $colid = $2;
                                if ($colclass) {
                                    $clsty =~ s/\([A-Za-z0-9_\- ]+?(#.*?)?\)//g;
                                } elsif ($colid) {
                                    $clsty =~ s/\(#.+?\)//g;
                                }
                            }
                        }
                        if ($clsty =~ m/(\(+)/) {
                            $colpadl = length($1);
                            $clsty =~ s/\(+//;
                        }
                        if ($clsty =~ m/(\)+)/) {
                            $colpadr = length($1);
                            $clsty =~ s/\)+//;
                        }
                        if ($clsty =~ m/\[(.+?)\]/) {
                            $collang = $1;
                            $clsty =~ s/\[.+?\]//;
                        }
                        redo if $clsty;
                    }
                    if ($colparams =~ m/^\\(\d+)/) {
                        $colspan = $1;
                        $colparams = substr($colparams, length($1)+1);
                        redo if $1;
                    }
                    if ($colparams =~ m/\/(\d+)/) {
                        $rowspans[$c] = $1 if $1;
                        $colparams = substr($colparams, length($1)+1);
                        redo if $1;
                    }
                    $params = 0;
                }
            }
            if (length($attrs)) {
                $header = 1 if $attrs =~ m/_/;
                $colalign = '' if $attrs =~ m/($alignre)/ && length($1);
                # determine column alignment
                if ($attrs =~ m/<>/) {
                    $colalign .= '<>';
                } elsif ($attrs =~ m/
                    $colalign .= '<';
                } elsif ($attrs =~ m/=/) {
                    $colalign = '=';
                } elsif ($attrs =~ m/>/) {
                    $colalign = '>';
                }
                if ($attrs =~ m/\^/) {
                    $colalign .= '^';
                } elsif ($attrs =~ m/~/) {
                    $colalign .= '~';
                } elsif ($attrs =~ m/-/) {
                    $colalign .= '-';
                }
            }
            $header = 1 if $rowheader;
            $colalign[$c] = $colalign if $header;
            $col =~ s/^ +//; $col =~ s/ +$//;
            if (length($col)) {
                # create one cell tag
                my $rowspan = $rowspans[$c] || 0;
                my $col_out = '<' . ($header ? 'th' : 'td');
                if (defined $colalign) {
                    # horizontal, vertical alignment
                    my $halign = _halign($colalign);
                    $col_out .= qq{ align="$halign"} if $halign;
                    my $valign = _valign($colalign);
                    $col_out .= qq{ valign="$valign"} if $valign;
                }
                # apply css attributes, row, column spans
                $colstyle .= qq{;padding-left:${colpadl}em} if $colpadl;
                $colstyle .= qq{;padding-right:${colpadr}em} if $colpadr;
                $col_out .= qq{ class="$colclass"} if $colclass;
                $col_out .= qq{ id="$colid"} if $colid;
                $colstyle =~ s/^;// if $colstyle;
                $col_out .= qq{ style="$colstyle"} if $colstyle;
                $col_out .= qq{ lang="$collang"} if $collang;
                $col_out .= qq{ colspan="$colspan"} if $colspan > 1;
                $col_out .= qq{ rowspan="$rowspan"} if ($rowspan||0) > 1;
                $col_out .= '>';
                # if the content of this cell has newlines OR matches
                # our paragraph block signature, process it as a full-blown
                # textile document
                if (($col =~ m/\n\n/) ||
                    ($col =~ m/^(?:$halignre|$clstypadre*)*
                                [\*\#]
                                (?:$clstypadre*|$halignre)*\ /x)) {
                    $col_out .= $self->textile($col);
                } else {
                    $col_out .= $self->format_paragraph(text => $col);
                }
                $col_out .= '';
                $row_out = $col_out . $row_out;
                $colspan = 0 if $colspan;
            } else {
                $colspan = 1 if $colspan == 0;
                $colspan++;
            }
        }
        if ($colspan > 1) {
            # handle the spanned column if we came up short
            $colspan--;
            $row_out = q{
                     . ($colspan>1 ? qq{ colspan="$colspan"} : '')
                     . qq{>
        }

        # build one table row
        $out .= q{
        if ($rowalign) {
            my $valign = _valign($rowalign);
            $out .= qq{ valign="$valign"} if $valign;
        }
        $out .= qq{ class="$rowclass"} if $rowclass;
        $out .= qq{ id="$rowid"} if $rowid;
        $out .= qq{ style="$rowstyle"} if $rowstyle;
        $out .= qq{>$row_out
    }

    # now, form the table tag itself
    my $table = '';
    $table .= q{
    if ($talign) {
        if ($self->{css_mode}) {
            # horizontal alignment
            my $alignment = _halign($talign);
            if ($talign eq '=') {
                $tstyle .= ';margin-left:auto;margin-right:auto';
            } else {
                $tstyle .= ';float:'.$alignment if $alignment;
            }
            $tclass .= ' '.$alignment if $alignment;
        } else {
            my $alignment = _halign($talign);
            $table .= qq{ align="$alignment"} if $alignment;
        }
    }
    $tstyle .= qq{;padding-left:${tpadl}em} if $tpadl;
    $tstyle .= qq{;padding-right:${tpadr}em} if $tpadr;
    $tclass =~ s/^ // if $tclass;
    $table .= qq{ class="$tclass"} if $tclass;
    $table .= qq{ id="$tid"} if $tid;
    $tstyle =~ s/^;// if $tstyle;
    $table .= qq{ style="$tstyle"} if $tstyle;
    $table .= qq{ lang="$tlang"} if $tlang;
    $table .= q{ cellspacing="0"} if $tclass || $tid || $tstyle;
    $table .= qq{>$out