Pod::WikiText - Support for the use of Wiki markup.


Pod-WikiText documentation Contained in the Pod-WikiText distribution.

Index


Code Index:

NAME

Top

Pod::WikiText - Support for the use of Wiki markup.

SUMMARY

Top

Support the use of Wiki markup for general documentation purposes. This module uses the Text-Tiki module for markup support. The purpose of this module is to provide a convenient way to incorporate Wiki markup into lots of different types of documents including, but not limited to, your own Perl source files.

SYNOPSIS

Top

    use Pod::WikiText;

    my $formatter = Pod::WikiText->new(
        format  => 'html',
        author  => 'Brad Adkins',
        infile  => 'test.pl',
        outfile => 'stdout',
        title   => 'Example',
    );

    $formatter->format;

You can create multiple Pod::WikiText objects if needed.

RATIONALE

Top

Provided an alternative for documentation of Perl source files which allows the use of a robust flavor of Wiki markup in place of POD markup. This allows the creation of more expressive POD in your Perl source files, and hence better documentation when published.

DESCRIPTION

Top

POD sections in source files are marked in the standard way with 'begin' and 'cut' tags. The 'begin' tag must be followed by the keyword 'wiki', as in: "=begin wiki". (See this source file for examples.)

This module can be used for many purporses beyond Perl source documentation. Presentations and other forms of documentaiton are candiates for use. This is possible because the markup support provided by the Text::Tiki module is very good, and several options are provided by Pod::WikiText specifically with general documentation purposes in mind.

Caveat: You should probably not use WikiText as POD in source files that you plan to upload to CPAN, unless you include normal POD as well. :-)

ADDITIONAL INFORMATION

Top

Please see the WikiText documentation embedded in this source file for additional details on how to use WikiText.pm. You can view this documentation using WikiText.pm itself to format the WikiText content in this file. Hint: download and install WikiText.pm.

Thank you!

COPYRIGHT

Top

AUTHOR

Top

Brad Adkins, dbijcl@gmail.com


Pod-WikiText documentation Contained in the Pod-WikiText distribution.
package Pod::WikiText;

use strict;
use warnings;
use Carp;
use Cwd;
use File::Spec;
use Text::Wrap;
use Text::Tiki;
use Syntax::Highlight::Engine::Kate;

our $VERSION = "0.12";
our $PROGRAMNAME = "WikiText";

my (%docinfo,@aotoc,%hotoc,@inpod,@lines,@format,@nonformat);
my $debug = 0;
my $sysdate = localtime();
$sysdate =~ s/ \d\d:\d\d:\d\d/,/;
$sysdate =~ s/  / /g;
my @file_management_keys = (
    "file","directory","clearcase","ftp","publish","url"
);
my @object_param_keys = (
    "format","section","infile","outfile","author","title","header","useheader",
    "footer","usefooter","toc","navigation","borders","wrapcol","codelabels",
    "usesvg","language","startinpod","linkback","debug","outdir"
);

sub new {
    my ($class, %arg) = @_;

    my $sig = "<p><em>Created using $PROGRAMNAME, Version $VERSION<br>$sysdate</em></p>";

    my $podwikitext = bless {
        _format     => lc($arg{format})     || "html",
        _section    => $arg{section}        || '',
        _infile     => $arg{infile}         || croak("no infile given"),
        _outfile    => $arg{outfile}        || "stdout",
        _outdir     => $arg{outdir}         || '',
        _author     => $arg{author}         || '',  ## for html head
        _title      => $arg{title}          || '',  ## for html head
        _header     => $arg{header}         || '',
        _useheader  => lc($arg{useheader})  || "no",
        _footer     => $arg{footer}         || $sig,
        _usefooter  => lc($arg{usefooter})  || "yes",
        _toc        => lc($arg{toc})        || "yes",
        _navigation => lc($arg{navigation}) || "no",
        _borders    => lc($arg{borders})    || "yes",
        _wrapcol    => $arg{wrapcol}        || 72,
        _codelabels => lc($arg{codelabels}) || "yes",
        _usesvg     => lc($arg{usesvg})     || "yes",
        _language   => $arg{language}       || "Perl",
        _startinpod => lc($arg{startinpod}) || "no",
        _linkback   => $arg{linkback}       || "<!-- no linkback provided -->",
        _debug      => lc($arg{debug})      || "no",
    }, $class;

    croak("param 'format' invalid")     unless $podwikitext->{_format} =~ /html|text|reference|codetext|codehtml/;
    croak("param 'infile' not found")   unless -e $podwikitext->{_infile};
    croak("param 'useheader' invalid")  unless $podwikitext->{_useheader} =~ /yes|no/;
    croak("param 'usefooter' invalid")  unless $podwikitext->{_usefooter} =~ /yes|no/;
    croak("param 'toc' invalid")        unless $podwikitext->{_toc} =~ /yes|no/;
    croak("param 'navigation' invalid") unless $podwikitext->{_navigation} =~ /yes|no/;
    croak("param 'borders' invalid")    unless $podwikitext->{_borders} =~ /yes|no/;
    croak("param 'codelabels' invalid") unless $podwikitext->{_codelabels} =~ /yes|no/;
    croak("param 'usesvg' invalid")     unless $podwikitext->{_usesvg} =~ /yes|no/;
    croak("param 'startinpod' invalid") unless $podwikitext->{_startinpod} =~ /yes|no/;
    croak("param 'debug' invalid")      unless $podwikitext->{_debug} =~ /yes|no/;

    ## may also be specified in the source document
    $docinfo{author} = $podwikitext->{_author};
    $docinfo{title} = $podwikitext->{_title};
    $docinfo{linkback} = $podwikitext->{_linkback};

    $podwikitext->{_bordertype} = 'hidden';
    if ( $podwikitext->{_borders} eq "yes" ) {
        $podwikitext->{_bordertype} = 'solid';
    }

    if ( $podwikitext->{_debug} eq 'yes' ) { $debug = 1; }  ## turn debug on

    return $podwikitext;
}

sub get_param {
    my ($self, $ukey) = @_;
    my $val = '';

    my $key = '_'.$ukey;
    if ( defined $self->{$key} ) { $val = $self->{$key}; }
    return $val;
}

sub set_param {
    my ($self, $ukey, $val) = @_;

    my $key = '_'.$ukey;
    if ( is_valid_param( $key ) ) {
        $self->{$key} = $val;
    } else {
        $val = '';
    }
    return $val;
}

sub get_sections {
    my $self = shift;
    my @sections;

    $self->read_input;

    foreach my $toce ( @aotoc ) {
        my $title = $toce->{line};
        next unless $toce->{line} =~ /^!1 /;
        $title =~ s/^![1-4]{1,1} //;
        push @sections, $title;
    }

    return @sections;
}

sub set_section {
    my ($self,$section) = @_;
    $self->{_section} = $section;
    return 0;
}

sub is_section {
    my ($self,$section) = @_;

    $self->read_input;

    my $found = 0;
    foreach my $toce ( @aotoc ) {
        my $title = $toce->{line};
        if ( $toce->{line} =~ /^!1 / ) {;
            $title =~ s/^!1 //;
            if ( $title eq $section ) {
                $found = 1;
                last;
            }
        }
    }

    return $found;
}

sub format {
    my $self = shift;

    $self->read_input;
    if ( $debug ) { $self->debug_read; }

    if ( $self->{_format} eq "html" ) {
        $self->format_html;
    }
    if ( $self->{_format} eq "text" ) {
        $self->format_text;
    }
    if ( $self->{_format} eq "reference" ) {
        $self->format_reference;
    }
    if ( $self->{_format} eq "codetext" ) {
        $self->format_codetext;
    }
    if ( $self->{_format} eq "codehtml" ) {
        $self->format_codehtml;
    }
}

sub is_valid_param {
    my $key = shift;

    $key =~ s/^_//;
    if ( $key =~ /format|section|infile|outfile|author|title|header|useheader|
                                    footer|usefooter|toc|navigation|borders|wrapcol|startinpod|
                                    linkback|debug|outdir/x ) {
        return 1;
    }
    return 0;
}

sub init_stores {
    my $self = shift;

    @aotoc = ();
    %hotoc = ();
    @inpod = ();
    @lines = ();
    @format = ();
    @nonformat = ();

    return 0;
}

sub read_input {
    my $self = shift;

    my $infile = $self->{_infile};

    $self->init_stores;

    my $inpod = 0;

    my $beginfold = '^beginfold\{\{\{';  ## default
    my $endfold   = '^endfold\}\}\}';    ## default

    ## initialize source editor meta tags
    if ( $infile =~ /\.pl$|\.pm$/ ) {  ## recognize Foldmaster 'source' files
        $beginfold = '^\#{1,2}\{\{\{';
        $endfold = '^\#{1,2}\}\}\}';
        $inpod = 0;
    }
    if ( $infile =~ /\.txt$|\.wiki$/ ) {  ## recognize Foldmaster 'text' files
        $beginfold = '^\(\*\{\{\{';
        $endfold = '^\(\*\}\}\}';
        $inpod = 1;
    }

    if ( $self->{_startinpod} eq "yes" ) {
        $inpod = 1;
    }

    my $line = '';    ## line continuation buffer
    my $linenum = 0;  ## current line number
    my $prevtoc = 0;  ## previous toc entry

    open(my $fh, "<", $infile) or die "unable to open $infile";
    while ( <$fh> ) {
        chomp;

        ## check for source editor meta tags
        if ( /$beginfold/ ) {
            push @lines, "";
            next;
        }
        if ( /$endfold/   ) {
            ##push @lines, "";
            next;
        }

        ## depricated tags
        if ( /^\#\#(\@\@|\$\$|\/\/)/ ) {  ##@@, @@$$ ##// are depricated
            next;
        }

        ## comment tag
        if ( /^\#\#:/ ) {  ##: is a comment tag
            next;
        }

        ## load document information from meta tags
        if ( /^\#\#([a-z]+):(.*)/ ) {
            my $key = $1;
            my $val = $2;
            $val =~ s/\s+$//;
            $docinfo{$key} = $val;
            next;
        }

        ## check for pod status
        if ( /^=begin wiki/ ) { $inpod = 1; next; }  ## =cut
        if ( /^=cut/ ) { $inpod = 0; next; }

        ## save headings information
        if ( /^!([1-4]{1,1}) / ) {
            my $toc_entry = $_;
            my $toc_level = $1;
            my $id = $_;
            $id =~ s/^![1-4]{1,1} //;     ## remove header markup
            $id =~ s/[^\s\w\d]+//g;       ## remove non alpha/ws characters
            $id =~ s/\b([a-z])/\u\L$1/g;  ## proper case
            $id =~ s/\s+//g;              ## remove whitespace
            push @aotoc, {  ## array of toc entries
                line    => $toc_entry,
                anchor  => $id,
                level   => $toc_level,
            };
            my $key = sprintf("%05d", $linenum);
            if ( $toc_level == 1 ) {  ## hash of level 1 toc entries
                $hotoc{$key} = {
                    line    => $toc_entry,
                    anchor  => $id,
                    prevtoc => $prevtoc,
                    nexttoc => 0,
                };
                $prevtoc = $key;
            }
            push @lines, $key.':'.$toc_entry;  ## "key" the heading
            push @inpod, $inpod;
            $linenum++;
            next;
        }

        ## store the line or cat to line continuation buffer
        $line .= $_;
        if ( /\\$|\\\s+$/ ) {  ## line continuation found
            $line =~ s/\\\s+$/ /;    ## replace \ + ws
            $line =~ s/\s+\\\n$/ /;  ## replace ws + \ + \n
            $line =~ s/\s+\\$/ /;    ## replace ws + \
            next;
        } else {
            push @lines, $line;
            push @inpod, $inpod;
            $line = '';
            $linenum++;
        }
    }
    close $fh;

    ## finish headings linked list
    foreach my $toc ( reverse sort keys %hotoc ) {
        my $prevtoc = $hotoc{$toc}{prevtoc};
        if ( $prevtoc > 0 ) {
            $hotoc{$prevtoc}{nexttoc} = $toc;
        }
    }

    ## update object params from doc info, all params are fair game
    foreach my $key ( keys %docinfo ) {
        $key = lc($key);
        $self->{'_'.$key} = $docinfo{$key};
    }

    if ( $self->{_debug} eq "yes" ) { $self->debug_params; }

    return 0;
}

sub format_html {
    my $self = shift;

    if ( $self->{_section} ) {
        $self->prep_html_section;
    } else {
        $self->prep_html;
    }
    if ( $debug ) { $self->debug_prep; }

    my $formatter = Text::Tiki->new;
    my $html = $formatter->format(\@format);

    if ( ( $self->{_toc} eq "yes" ) && ( ! $self->{_section} ) ) {
        $html = $self->create_toc . $html;
    }

    $self->post_process( \$html );
    $self->output_format( \$html );

    return 0;
}

sub format_text {
    my $self = shift;

    if ( $self->{_section} ) {
        $self->prep_html_section;
    } else {
        $self->prep_html;
    }
    if ( $debug ) { $self->debug_prep; }

    $self->text_wrap( \@format );
    my $text = join "\n", @format;
    $self->output_format( \$text );

    return 0;
}

sub format_reference {
    my $self = shift;

    $self->prep_html;
    if ( $debug ) { $self->debug_prep; }

    my $language = $self->{_language};
    my @rformat = ();
    my $podblock = 1;
    my $line;
    my $i = 0;
    foreach my $ispod ( @inpod ) {
        if ( $ispod++ ) {
            if ( ! $podblock ) {  ## entering first line of pod block
                push @rformat, " %%";  ## end previous code block
                push @rformat, "";
                push @rformat, "/end code block/";
                push @rformat, "";
                $podblock = 1;
            }
            $line = shift @format;
            push @rformat, $line;
        } else {
            if ( $podblock ) {  ## entering first line of code block
                push @rformat, "";  ## start a new code block
                push @rformat, "/begin code block/";
                push @rformat, "";
                push @rformat, " % language=$language";
                $podblock = 0;
            }
            $line = shift @nonformat;
            push @rformat, " % $line";
        }
    }

    if ( ! $podblock ) {
        push @rformat, " %%";  ## end previous code block
        push @rformat, "";
        push @rformat, "/end code block/";
        push @rformat, "";
    }

    my $formatter = Text::Tiki->new;
    my $html = $formatter->format(\@rformat);

    if ( $self->{_toc} ) {
        $html = $self->create_toc . $html;
    }

    $self->post_process( \$html );
    $self->html_codeblock_tags( \$html );
    $self->output_format( \$html );

    return 0;
}

sub format_codetext {
    my $self = shift;

    if ( $self->{_section} ) {
        $self->prep_html_section;
    } else {
        $self->prep_html;
    }
    if ( $debug ) { $self->debug_prep; }

    my $text = join "\n", @nonformat;
    $self->output_format( \$text );

    return 0;
}

sub format_codehtml {
    my $self = shift;

    if ( $self->{_section} ) {
        $self->prep_html_section;
    } else {
        $self->prep_html;
    }
    if ( $debug ) { $self->debug_prep; }

    my @html = map { " % " . $_ . "\n" } @nonformat;
    my $language = " % language=" . $self->{_language} . "\n";
    unshift @html, $language;
    push @html, " %%\n";

    my $html = join "", @html;

    $self->html_syntax_highlight( \$html );
    $self->output_format( \$html );

    return 0;
}

sub prep_html {
    my $self = shift;

    @format = ();
    @nonformat = ();
    my $i = 0;
    foreach my $line ( @lines ) {
        if ( $inpod[$i++] ) {
            if ( $line =~ /^(\d{5,5}):!(\d){1,1} / ) {  ## level 1 heading
                my $key = $1;
                my $level = $2;
                $line =~ s/^\d{5,5}://;
                if ( $level == 1 && $self->{_navigation} eq "yes" ) {  ## insert nav line
                    push @format, $line;
                    push @format, ' ';

                    my $nextlink = "Next";
                    my $prevlink = "Prev";
                    my $nextkey = $hotoc{$key}{nexttoc};
                    my $prevkey = $hotoc{$key}{prevtoc};
                    if ( $nextkey > 0 ) {
                        my $nextanchor = "#".$hotoc{$nextkey}{anchor};
                        $nextlink = "[Next]:$nextanchor";
                    }
                    if ( $prevkey > 0 ) {
                        my $prevanchor = "#".$hotoc{$prevkey}{anchor};
                        $prevlink = "[Prev]:$prevanchor";
                    }
                    push @format, "$prevlink | $nextlink | [Index]:#WikiIndex00000";
                    next;
                }
            }
            push @format, $line;
        } else {
            push @nonformat, $line;
        }
    }

    return 0;
}

sub prep_html_section {
    my $self = shift;

    my $section = '!1 ' . $self->{_section};
    my $insection = 0;

    @format = ();
    my $i = 0;
    foreach my $line ( @lines ) {
        if ( $inpod[$i++] ) {
            if ( $line =~ /^(\d{5,5}):!(\d){1,1} / ) {  ## level 1 heading
                my $key = $1;
                my $level = $2;
                $line =~ s/^\d{5,5}://;
                if ( $level == 1 && $line eq $section ) {
                    $insection = 1;
                    push @format, $line;
                    push @format, ' ';
                    next;
                }
                if ( $level == 1 && $insection ) {
                    last;
                }
            }
            if ( $insection ) { push @format, $line; }
        }
    }

    return 0;
}

sub post_process {
    my ($self, $html) = @_;

    if ( $self->{_useheader} ) {
        $self->header_vars;
        $$html = $self->{_header} . $$html;
    }
    if ( $self->{_usefooter} ) {
        $self->footer_vars;
        $$html .= $self->{_footer};
    }

    $self->html_add_cell_spacing( $html );
    $self->html_pad_empty_cells( $html );
    $self->html_insert_checkmarks( $html );
    $self->html_insert_line_breaks( $html );
    $self->html_set_borders( $html );
    $self->html_set_bgcolors( $html );
    $self->html_replace_nul( $html );
    $self->html_fixes( $html );
    $self->html_syntax_highlight( $html );
    $self->html_add_header( $html );
    $self->html_add_footer( $html );

    return 0;
}

sub output_format {
    my ($self, $output) = @_;

    my $outfile = $self->{_outfile};
    if ( $self->{_outdir} ) {
        $outfile = $self->{_outdir} . $outfile;
    }
    if ( $outfile =~ /stdout/i ) {
        print $$output;
    } else {
        open(my $fh, ">", $outfile) or die "unable to create $outfile";
        print $fh $$output;
        close $fh;
    }

    return 0;
}

sub create_toc {
    my $self = shift;

    my $plevel = 0;
    my $indent = 0;
    my $i = 0;
    my @toclines;

    my $beginlist = '<ul>';
    my $endlist = '</ul>';

    push @toclines, "<!-- INDEX -->";
    foreach my $toce ( @aotoc ) {
        my $line = $toce->{line};
        $line =~ s/^![1-4]{1,1} //;  ## remove wiki markup
        my $anchor = $toce->{anchor};
        my $level = $toce->{level};

        if ( $level > $plevel ) {
            my $ntags = $level - $plevel;
            for (my $i=1; $i<=$ntags; $i++) {
                push @toclines, ' ' x ($level * 2) . $beginlist;
            }
            push @toclines, ' ' x ($level * 2) . "<li><a href=\"#$anchor\">$line</a></li>";
        }
        if ( $level == $plevel ) {
            push @toclines, ' ' x ($level * 2) . "<li><a href=\"#$anchor\">$line</a></li>";
        }
        if ( $level < $plevel ) {
            my $ntags = $plevel - $level;
            for (my $i=1; $i<=$ntags; $i++) {
                push @toclines, ' ' x ($level * 2) . $endlist;
            }
            push @toclines, ' ' x ($level * 2) . "<li><a href=\"#$anchor\">$line</a></li>";
        }
        ## next iteration
        $plevel = $level;
        $i++;
    }
    for (my $i=$plevel; $i>0; $i--) {
        push @toclines, ' ' x ($i * 2) . $endlist;
    }
    push @toclines, "<!-- INDEX -->";
    push @toclines, "<hr />";

    return join("\n", @toclines);
}

sub debug_read {
    my $self = shift;
    my ($db, $i);

    $i = 0;
    my $file = "_debug_lines.debug";
    open($db, ">", $file) or die "unable to open $file";
    foreach my $line ( @lines ) {
        print $db $line, "\n";
    }
    close($db);

    $i = 0;
    $file = "_debug_aotoc.debug";
    open($db, ">", $file)   or die "unable to open $file";
    foreach my $toc ( @aotoc ) {
        print $db "line   :";
        print $db $toc->{line}, "\n";
        print $db "anchor :";
        print $db $toc->{anchor}, "\n";
        print $db "level  :";
        print $db $toc->{level}, "\n";
        $i++;
    }
    close($db);

    $i = 0;
    $file = "_debug_hotoc.debug";
    open($db, ">", $file)   or die "unable to open $file";
    foreach my $toc ( sort keys %hotoc ) {
        print $db "key    :";
        print $db $toc, "\n";
        print $db "line   :";
        print $db $hotoc{$toc}{line}, "\n";
        print $db "anchor :";
        print $db $hotoc{$toc}{anchor}, "\n";
        print $db "prevtoc:";
        print $db $hotoc{$toc}{prevtoc}, "\n";
        print $db "nexttoc:";
        print $db $hotoc{$toc}{nexttoc}, "\n";
        $i++;
    }
    close($db);

    $i = 0;
    $file = "_debug_inpod.debug";
    open($db, ">", $file) or die "unable to open $file";
    foreach my $inpod ( @inpod ) {
        print $db $inpod, "\n";
    }
    close($db);

    return 0;
}

sub debug_prep {
    my $self = shift;
    my ($db, $i);

    $i = 0;
    my $file = "_debug_format.debug";
    open($db, ">", $file) or die "unable to open $file";
    foreach my $line ( @format ) {
        print $db $line, "\n";
    }
    close($db);

    $i = 0;
    $file = "_debug_nonformat.debug";
    open($db, ">", $file) or die "unable to open $file";
    foreach my $line ( @nonformat ) {
        print $db $line, "\n";
    }
    close($db);

    return 0;
}

sub debug_params {
    my $self = shift;

    my $width = 0;
    foreach my $key ( @object_param_keys ) {
        if ( length($key) > $width ) { $width = length($key); }
    }

    foreach my $key ( sort @object_param_keys ) {
        printf("%-${width}s docinfo: ", $key);
        if ( defined $docinfo{$key} ) {
            print $docinfo{$key};
        } else {
            print "UNDEFINED";
        }
        print "\n";
        printf("%-${width}s object : ", '');
        if ( defined $self->{'_'.$key} ) {
            print $self->{'_'.$key};
        } else {
            print "UNDEFINED";
        }
        print "\n", '-'x(19), "\n";
    }

    return 0;
}

sub html_add_cell_spacing {
    my ($self, $html) = @_;

    $$html =~ s/<td>/<td>&nbsp;&nbsp;/gm;
    $$html =~ s/<\/td>/&nbsp;&nbsp;<\/td>/gm;

    return 0;
}

sub html_pad_empty_cells {
    my ($self, $html) = @_;

    $$html =~ s/&nbsp;&nbsp;\.&nbsp;&nbsp;/&nbsp;&nbsp;&nbsp;&nbsp;/gm;

    return 0;
}

sub html_insert_line_breaks {
    my ($self, $html) = @_;

    $$html =~ s/##BR##/&nbsp;&nbsp;<br \/>&nbsp;&nbsp;/gm;

    return 0;
}

sub html_insert_checkmarks {
    my ($self, $html) = @_;

    if ( $self->{_usesvg} eq "yes" ) {
        if ( $$html =~ /##CM##/ ) {
            $$html =~ s/##CM##/<object type=\"image\/svg+xml\" name=\"checkmark\" data=\"checkmark.svg\" width=\"18\" height=\"18\" border=\"0\"<\/object>/gm;
            $self->write_checkmark_svg;
        }
    } else {
        $$html =~ s/##CM##/<em>V<\/em>/gm;
    }

    return 0;
}

sub html_set_borders {
    my ($self, $html) = @_;

    $$html =~ s/(<table>)(.*?<tr>.*?<td>)(.*?)(\#\#NOBORDERS\#\#)/<table class=\"hidden\">$2$3/gms;
    $$html =~ s/(<table>)(.*?<tr>.*?<td>)(.*?)(\#\#BORDERS\#\#)/<table class=\"solid\">$2$3/gms;

    return 0;
}

sub html_set_bgcolors {
    my ($self, $html) = @_;

    $$html =~ s/<tr>(.)<td>(&nbsp;&nbsp;)\#\#BGR([A-Fa-f0-9]{6,6})\#\#( ?)/<tr bgcolor=\"\#$3\">$1<td>$2/gms;
    $$html =~ s/<td>(&nbsp;&nbsp;)\#\#BGC([A-Fa-f0-9]{6,6})\#\#( ?)/<td bgcolor=\"\#$2\">$1/gms;

    return 0;
}

sub html_replace_nul {
    my ($self, $html) = @_;

    $$html =~ s/<nul>//gm;

    return 0;
}

sub html_fixes {
    my ($self, $html) = @_;

    ## modifier s treats the string as a single line so . will match newline
    $$html =~ s#</table>.<hr />#</table><br /></p><hr />#gs;

    return 0;
}

sub html_syntax_highlight {
    my ($self, $html) = @_;

    $$html =~ s/^ <h1>/<h1>/g;  ## other clean-up... move?

    while ( $$html =~ /(^ % .*?^ %%)/gms ) {
        my $code = $1;

        $code =~ /^ % language=(\w+)/;
        my $language = $1;
        $language = "Perl" unless $language;
        ## herein lies a problem, this translates to 2 <BR>'s before getting to code
        $code =~ s/^ % language=(.*)//;  ## remove language
        $code =~ s/^ %%//ms;             ## clean up code block
        $code =~ s/^ % ?//gms;           ## clean up code block

        ## Tiki encodes special chars, decode before highlighting
        $code =~ s/&gt;/>/gms;
        $code =~ s/&lt;/</gms;
        $code =~ s/&#39;/'/gms;
        $code =~ s/&quote;/"/gms;
        $code =~ s/&amp;/&/gms;
        ## there are probably more...

        ## implement plain text language oursleves
        if ( $language eq 'PlainText' ) {
            $$html =~ s/^ % .*? %%/$code/ms;
            return 0;
        }
        ## this is a hack to remove extra space, needs fixing
        if ( ! $self->{_format} eq "html" ) { $code =~ s/\n//; }

        my $highlighted = $self->html_syntax_highlight_language( $code, $language );
        $$html =~ s/^ % .*? %%/$highlighted/ms;
    }

    $$html =~ s/<pre>//gms;    ## need to incorporate this into regex above
    $$html =~ s/<\/pre>//gms;  ## need to incorporate this into regex above

    return 0;
}

sub html_syntax_highlight_language {
    my ($self, $code, $language) = @_;

    if ( $language =~ /INI FILES|INIFILE|INIFILES|INI_FILES/i ) {
        $language = "INI Files";
    }
    if ( $language =~ /SQL|SQLPLUS/i ) {
        $language = "SQL";
    }

    $code =~ s/<q>/"/gms;
    $code =~ s/<\/q>/"/gms;

    my $hl = new Syntax::Highlight::Engine::Kate(
        language => $language,
        substitutions => {
            "<"  => "&lt;",
            ">"  => "&gt;",
            "&"  => "&amp;",
            " "  => "&nbsp;",
            "\t" => "&nbsp;&nbsp;&nbsp;&nbsp;",
            "\n" => "<BR>\n",
        },
        ## since a style is applied, the "face" and "size" attributes can be removed...
        format_table => {
            Alert => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#0000ff\">", "</font>"],
            BaseN => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#007f00\">", "</font>"],
            BString => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#c9a7ff\">", "</font>"],
            Char => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#ff00ff\">", "</font>"],
            Comment => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#7f7f7f\"><i>", "</i></font>"],
            DataType => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#0000ff\">", "</font>"],
            DecVal => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#00007f\">", "</font>"],
            Error => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#ff0000\"><b><i>", "</i></b></font>"],
            Float => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#00007f\">", "</font>"],
            Function => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#007f00\">", "</font>"],
            IString => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#ff0000\">", "</font>"],
            Keyword => ["<b><font face=\"courier new,courier,monospace\" size=\"2\">", "</font></b>"],
            Normal => ["<font face=\"courier new,courier,monospace\" size=\"2\">", "</font>"],
            Operator => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#ffa500\">", "</font>"],
            Others => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#b03060\">", "</font>"],
            RegionMarker => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#96b9ff\"><i>", "</i></font>"],
            Reserved => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#9b30ff\"><b>", "</b></font>"],
            String => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#ff0000\">", "</font>"],
            Variable => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#0000ff\"><b>", "</b></font>"],
            Warning => ["<font face=\"courier new,courier,monospace\" size=\"2\" color=\"#0000ff\"><b><i>", "</b></i></font>"],
            ##Alert        => ["<font color=\"#0000ff\">", "</font>"],
            ##BaseN        => ["<font color=\"#007f00\">", "</font>"],
            ##BString      => ["<font color=\"#c9a7ff\">", "</font>"],
            ##Char         => ["<font color=\"#ff00ff\">", "</font>"],
            ##Comment      => ["<font color=\"#7f7f7f\"><i>", "</i></font>"],
            ##DataType     => ["<font color=\"#0000ff\">", "</font>"],
            ##DecVal       => ["<font color=\"#00007f\">", "</font>"],
            ##Error        => ["<font color=\"#ff0000\"><b><i>", "</i></b></font>"],
            ##Float        => ["<font color=\"#00007f\">", "</font>"],
            ##Function     => ["<font color=\"#007f00\">", "</font>"],
            ##IString      => ["<font color=\"#ff0000\">", "</font>"],
            ##Keyword      => ["<b>", "</b></font>"],
            ##Normal       => ["", ""],
            ##Operator     => ["<font color=\"#ffa500\">", "</font>"],
            ##Others       => ["<font color=\"#b03060\">", "</font>"],
            ##RegionMarker => ["<font color=\"#96b9ff\"><i>", "</i></font>"],
            ##Reserved     => ["<font color=\"#9b30ff\"><b>", "</b></font>"],
            ##String       => ["<font color=\"#ff0000\">", "</font>"],
            ##Variable     => ["<font color=\"#0000ff\"><b>", "</b></font>"],
            ##Warning      => ["<font color=\"#0000ff\"><b><i>", "</b></i></font>"],
        },
    );

    my $highlight = '';
    foreach my $line ( split "\n", $code ) {
        my $high = $hl->highlightText( ' '.$line."\n" );
        $highlight .= " " . $high;
    }
    if ( $self->{_format} eq "codehtml" ) {
        return "<div class=\"syntaxhi\">\n".$highlight."<br></div>";
    } else {
        ##return "<div class=\"syntaxhi\">\n".$highlight."<br></div>";
        return "<div class=\"syntaxhi\" style=\"background-color: #efefef; border-style: dashed; border-width: 1px\">\n".$highlight."<br></div>";
    }
}

sub html_codeblock_tags {
    my ($self, $html) = @_;

    ## code begin/end labels inserted by default
    if ( $self->{_codelabels} eq "yes" ) { return 0; }

    $$html =~ s/begin code block/&nbsp;/gm;
    $$html =~ s/<p><em>end code block<\/em><\/p>/<br>/gm;

    return 0;
}

sub html_add_header {
    my ($self, $html) = @_;

    my $header;

    $header = <<'    HEADER';
        <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
        <html>
        <head>
        <meta name="author" content="$author">
        <meta name="revised" content="$sysdate">
        <meta name="generator" content="WikiPod $VERSION">
        <title>$title</title>
        <style type="text/css">
          a:link {
            color: blue
          }
          a:visited {
            color: blue
          }
          table
          {
            border-collapse: collapse;
            border: 1px $bordertype;
            empty-cells: show
          }
          th
          {
            border-right: 1px $bordertype;
            border-left: 1px $bordertype;
            border-top: 1px $bordertype;
            border-bottom: 1px $bordertype;
            padding: 0.25em;
          }
          td
          {
            border-right: 1px $bordertype;
            border-left: 1px $bordertype;
            border-top: 1px $bordertype;
            border-bottom: 1px $bordertype;
            padding: 0.25em;
          }
          table.hidden
          {
            border-collapse: collapse;
            border: 1px hidden;
          }
          table.hidden th
          {
            border-collapse: collapse;
            border-style: hidden hidden hidden hidden;
          }
          table.hidden td
          {
            border-collapse: collapse;
            border-style: hidden hidden hidden hidden;
          }
          table.solid
          {
            border-collapse: collapse;
            border: 1px solid;
          }
          table.solid th
          {
            border-collapse: collapse;
            border-style: solid solid solid solid;
          }
          table.solid td
          {
            border-collapse: collapse;
            border-style: solid solid solid solid;
          }
          div#syntaxhi
          {
            background-color: #efefef;
            border-style: dashed;
            border-width: 1px
          }
        </style>
        </head>
        <body style="background-color: white">
        $linkback
    HEADER
    $header =~ s/^ {8,8}//gm;

    $header =~ s/\$title/$docinfo{title}/;
    $header =~ s/\$author/$docinfo{author}/;
    $header =~ s/\$bordertype/$self->{_bordertype}/gm;
    $header =~ s/\$linkback/$docinfo{linkback}/;
    $header =~ s/\$VERSION/$VERSION/;
    $header =~ s/\$sysdate/$sysdate/;

    $$html = $header . $$html;

    return 0;
}

sub html_add_footer {
    my ($self, $html) = @_;

    my $footer;
    $footer = <<'    FOOTER';
        </body>
        </html>
    FOOTER
    $footer =~ s/^ {8,8}//gm;

    $$html .= $footer;

    return 0;
}

sub text_wrap {
    my ($self, $lines) = @_;

    my @temp = @{$lines};
    @{$lines} = ();

    my $len = $self->{_wrapcol};
    $Text::Wrap::columns = $self->{_wrapcol};
    my @wrapin;

    foreach my $line ( @temp ) {
        $line =~ s/^!(\d){1,1} //;  ## remove heading markup
        if ( $line =~ /^ % language/ ) { next; }  ## skip over start code
        if ( $line =~ /^ %%/ ) { next; }  ## skip over end code
        $line =~ s/^ % ?/  /;  ## skip over end code
        $line =~ s/\#\#BORDERS\#\#//g;  ## remove
        $line =~ s/\#\#NOBORDERS\#\#//g;  ## remove

        if ( length($line) > $len ) {
            $wrapin[0] = $line;
            my $wrapped = wrap('', '', @wrapin);
            push @{$lines}, $wrapped;
        } else {
            push @{$lines}, $line;
        }
    }

    return 0;
}

sub header_vars {
    my $self = shift;

    my $header = $self->{_header};
    chomp $header;
    $header .= ' ';
    while ( $header =~ /\$(\w+) / ) {
        my $var = $1;
        $header =~ s/\$$var/$docinfo{$var}/;
    }
    chomp $header;
    $self->{_header} = $header;

    return 0;
}

sub footer_vars {
    my $self = shift;

    my $footer = $self->{_footer};
    chomp $footer;
    $footer .= ' ';
    while ( $footer =~ /\$(\w+) / ) {
        my $var = $1;
        $footer =~ s/\$$var/$docinfo{$var}/;
    }
    chomp $footer;
    $self->{_footer} = $footer;

    return 0;
}

sub write_checkmark_svg {
    my ($self) = @_;

    my $svgimage = <<'    ENDSVG';
    <?xml version="1.0" encoding="UTF-8" standalone="no"?>
    <!-- Created with Inkscape (http://www.inkscape.org/) -->
    <svg
       xmlns:dc="http://purl.org/dc/elements/1.1/"
       xmlns:cc="http://web.resource.org/cc/"
       xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
       xmlns:svg="http://www.w3.org/2000/svg"
       xmlns="http://www.w3.org/2000/svg"
       xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
       xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
       width="19.21315"
       height="18.294994"
       id="svg2"
       sodipodi:version="0.32"
       inkscape:version="0.45"
       sodipodi:modified="true"
       version="1.0">
      <defs
         id="defs4" />
      <sodipodi:namedview
         id="base"
         pagecolor="#ffffff"
         bordercolor="#666666"
         borderopacity="1.0"
         gridtolerance="10000"
         guidetolerance="10"
         objecttolerance="10"
         inkscape:pageopacity="0.0"
         inkscape:pageshadow="2"
         inkscape:zoom="7.9195959"
         inkscape:cx="17.757032"
         inkscape:cy="7.298821"
         inkscape:document-units="px"
         inkscape:current-layer="layer1"
         inkscape:window-width="984"
         inkscape:window-height="852"
         inkscape:window-x="148"
         inkscape:window-y="66" />
      <metadata
         id="metadata7">
        <rdf:RDF>
          <cc:Work
             rdf:about="">
            <dc:format>image/svg+xml</dc:format>
            <dc:type
               rdf:resource="http://purl.org/dc/dcmitype/StillImage" />

          </cc:Work>
        </rdf:RDF>
      </metadata>
      <g
         inkscape:label="Layer 1"
         inkscape:groupmode="layer"
         id="layer1"
         transform="translate(-192.905,-516.02064)">
        <path
           style="fill:#000000"
           d="M 197.67968,534.31563 C 197.40468,534.31208 196.21788,532.53719 195.04234,530.37143 L 192.905,526.43368 L 193.45901,525.87968 C 193.76371,525.57497 194.58269,525.32567 195.27896,525.32567 L 196.5449,525.32567 L 197.18129,527.33076 L 197.81768,529.33584 L 202.88215,523.79451 C 205.66761,520.74678 208.88522,517.75085 210.03239,517.13691 L 212.11815,516.02064 L 207.90871,520.80282 C 205.59351,523.43302 202.45735,527.55085 200.93947,529.95355 C 199.42159,532.35625 197.95468,534.31919 197.67968,534.31563 z "
           id="path2223" />
      </g>
    </svg>
    ENDSVG
    $svgimage =~ s/^ {4,4}//gm;

    my $dir = $self->{_outdir};
    my $fil = $self->{_outfile};
    if ( $dir ) { $fil = $dir.$fil; };
    my ($volume,$outpath,$file) = File::Spec->splitpath($fil);
    my $svgfile = $outpath . 'checkmark.svg';
    open(my $fh, ">", $svgfile) or die "unable to create svg file";
    print $fh $svgimage;
    close $fh;

    return 0;
}

1;

__END__