package Pod::WikiText; =head1 NAME Pod::WikiText - Support for the use of Wiki markup. =head1 SUMMARY 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. =head1 SYNOPSIS 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. =head1 RATIONALE 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. =head1 DESCRIPTION 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. :-) =head1 ADDITIONAL INFORMATION 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! =head1 COPYRIGHT Copyright 2008 Brad Adkins . Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, published by the Free Software Foundation; with no Invariant Sections, with no Front-Cover Texts, and with no Back-Cover Texts. =head1 AUTHOR Brad Adkins, dbijcl@gmail.com =cut =begin wiki !1 NAME Pod::WikiText.pm Support for Wiki markup in POD. ---- !1 SYNOPSIS % language=Perl % use Pod::WikiText; % % my $formatter = Pod::WikiText->new( % author => 'Brad Adkins', % infile => 'test.pl', % outfile => 'stdout' % title => 'Example' % ); % % $formatter->format; %% You can create multiple Pod::WikiText objects if needed. ---- !1 RATIONALE 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. ---- !1 DESCRIPTION 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. ---- !1 OPTIONS The primary option is the /format/ option. This options is used to select the \ output format. Usage: -format=/option_value/ |*option values*|*description*| |/html/ | Output embedded pod as html| |/text/ | Output embedded pod as text| |/slideshow/ | Output embedded pod as html slideshow| |/reference/ | Output embedded pod and code as html| |/codetext/ | Output code as text| |/codehtml/ | Output code as html| The remaining options are used to tailor the output generated by the selected \ format. ---- !1 AUTOMATION To process multiple files, you simply create a new WikiText object for each \ file. Something like this should suffice. % language=Perl % foreach my $file ( @files ) { % my $formatter = Pod::WikiText->new( format => 'html', % author => 'Brad Adkins', % infile => $file, % outfile => 'stdout' % title => 'Example' % ); % $formatter->format; % undef $formatter; % } %% Using undef on the old WikiText object saves a small amount of memory when \ creating multiple objects. ---- !1 WIKI MARKUP Pod::WikiText uses the Text::Tiki module for base markup processing. Please \ refer to the POD in that module for additional details and explanation of the \ markup capabilities provided by Text::Tiki. ---- !1 ADDITIONAL MARKUP Several customizations to the Tiki html output are implemented in this module. /*Genearating a Table of Contents*/ If the 'toc' parameter is set to 'yes' when creating a new Pod::WikiText \ object, a Table of Contents will be inserted at the beginning of the html \ output. Level 1 thru level 4 headings in the source document will generate \ entries in the Table of Contents. /*Syntax highlighting of code blocks*/ Code blocks prefaced with ' % ' starting in column 1 will be syntax highlighted. \ You will need to install the Syntax::Highlight::Engine::Kate module. This module \ provides syntax highlighting as implemented in the Kate text editor. The first line of a code block to be highlighted is a command that tells the highlighter what language to use, here is an example for Perl. % language=Perl % if ( $self->{_toc} ) { % $html = $self->create_toc . $html; % } %% /*Insert non-breaking space into table cells for better padding*/ Non-breaking spaces are added around cell contents to provide visual appeal. /*Allow cells which contain a period in column one to be empty cells*/ This: |col1|col2 is longer|col3| |col1|.|col3| |.|col2|col3 is longer too| Will produce: |col1|col2 is longer|col3| |col1|.|col3| |.|col2|col3 is longer too| /*Allow line breaks inside table cells*/ Allow a line break within a table cell using the break macro '##BR##'. This: |col1|col2 is longer|col3| |col1|col2|col3| |col1|col2|col3 is longer too##BR##And has multiple##BR##lines of text| Will produce: |col1|col2 is longer|col3| |col1|col2|col3| |col1|col2|col3 is longer too##BR##And has multiple##BR##lines of text| /*Add support for table borders*/ Use the parameter 'borders' when creating Pod::WikiText objects to control the \ use of borders on all html tables. /* Add support for table borders on a table-by-table basis*/ Allow borders to be defined for individual tables using the border macros \ '##BORDER 0##' and '##BORDER 1##' for no borders and borders, respectively. This: Will produce: /*Add support for table row background color*/ Allow a table row to have a specified background color using the macro \ '##BGxxxxxx###', where 'xxxxxx' is a hex color code. This: Will produce: ---- !1 META TAGS Pod::WikiText supports several meta tags that can be used in source files for \ various purposes. The first set of meta tags are used to support source files maintained using \ the Foldmaster programmer's editor (http://foldmaster.de). These tags are used \ by Foldmaster to indicate explicit folds within the source file. These are: | *Meta Tag* |*Description*| | %##{{{% |start fold in .pl and .pm files| | %##}}}% |end fold in .pl and .pm files| | %(*{{{% |start fold in .wiki and .txt files| | %(*}}}% |end fold in lwiki and .txt files| The second set of meta tags can be inserted in the source document to provide \ file specific options. These tags must begin in column 1. | *Meta Tag* |*Description*| | %##file:% |file name (not used at this time)| | %##dir:% |file path (not used at this time)| | %##remote:% |remote path (not used at this time)| | %##clearcase:% |ClearCase path (not used at this time)| | %##head:% |header (overrides header parameter)| | %##foot:% |footer (overrides footer parameter)| | %##url:% |for web browser invocation| | %##publish:% |for publishing generated html| | %##author:% |for the html header| | %##title:% |for the html header| These are all tags recognized in the source file when processed. Those not \ yet implemented are simply ignored. ---- !1 Development Notes The following notes are largely intended for the developer (me), but you may find them informative. !2 Format Option * /V/ html * /V/ text * /V/ reference * /V/ codetext * /V/ codehtml !2 Additional Options * /V/ section * /V/ infile * /V/ outfile * /V/ author * /V/ title * /V/ useheader * /V/ header * /V/ usefooter * /V/ footer * /V/ toc * /V/ navigation * /V/ borders * /V/ wrapcol * /V/ codelabels * /V/ language * /V/ startinpod * /V/ linkback * /V/ debug !2 Current Enhancements * /V/ Html header and footer * /V/ Genearate a Table of Contents * /V/ Syntax Highlighting of code blocks * /V/ Insert space into table cells for better padding * /V/ Allow cells which contain a period in column one to be empty cells * /V/ Allow line breaking inside of table cells * /V/ Allow global document setting of table borders * /V/ Support for replacement after Tiki markup * /V/ Support for borders/noborders within table source * /V/ Support for linkback html at beginning of document * /V/ Variable substitution in document header and footer * /V/ Provided a full complement of "setters" * /V/ Add support for table row background color * /V/ Add support for table cell background color * /V/ Correct problem where table is followed immediately by
* /V/ Support use of an svg "checkmark" image /V/ = Latin for Veritas, or "truth", signifying the item has been completed. !2 To Do - Support Scripts * wthtml.pl * wttext.pl * wtreference.pl * wtcodetext.pl * wtcodehtml.pl These will gather the appropriate command line parameters. Provide format \ specific help, and invoke Pod::WikiText for that particular format type. These utilities also provide conf file storage for their respective defaults. !2 Documentation * Show this table for all options that are specific to only certain table \ types, just give a list of the others. |*format* |*option1*|*option2*|*option3*|*option4*| |html |yes |no |yes |no | |text |yes |no |yes |no | |reference|yes |no |yes |no | |codetext |yes |no |yes |no | |codehtml |yes |no |yes |no | !2 Tests Tests beyond the basic "can load" need to be written. !2 Future Enhancements * Allow user specified ignore "meta tags" * Allow optional custom style sheet (external style sheet) * Allow optional background image (format html only) ---- =cut 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" ); =begin wiki !1 METHODS !2 Public Methods !3 Method new /Parameters/ The constructor method supports the following named arguments. |*Parameter* |*Default* |*Value*| |%format% |required |valid opiton ^1^| |%section% |none |a level 1 heading| |%infile% |required |filename| |%outfile% |required |filename| |%outdir% |optional |directory| |%author% |none |html meta author| |%title% |none |html title| |%header% |none |WikiText markup| |%useheader% |no |yes/no| |%footer% |basic footer |WikiText markup| |%usefooter% |yes |yes/no| |%toc% |yes |yes/no| |%navigation% |no |yes/no| |%borders% |yes |yes/no| |%wrapcol% |72 |numeric| |%codelabels% |yes |yes/no| |%usesvg% |yes |yes/no| |%startinpod% |no |yes/no| |%linkback% |none |html| |%debug% |no |yes/no| ^1^ Valid format options: html, text, reference, codetext, codehtml /Description/ This is the class constructor. Use this method to create new Pod::WikiText \ objects. /Test/ %insert name of test script here% =cut sub new { my ($class, %arg) = @_; my $sig = "

Created using $PROGRAMNAME, Version $VERSION
$sysdate

"; 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} || "", _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; } =begin wiki !3 Method get_param /Parameters/ * %$self% - reference to our object * %$key% - the parameter name /Description/ Return the value associated with parameter $key. /Test/ %insert name of test script here% =cut sub get_param { my ($self, $ukey) = @_; my $val = ''; my $key = '_'.$ukey; if ( defined $self->{$key} ) { $val = $self->{$key}; } return $val; } =begin wiki !3 Method set_param /Parameters/ * %$self% - reference to our object * %$key% - the parameter name * %$val% - the value to use /Description/ Set a new value for the parameter $key using value $val. /Test/ %insert name of test script here% =cut sub set_param { my ($self, $ukey, $val) = @_; my $key = '_'.$ukey; if ( is_valid_param( $key ) ) { $self->{$key} = $val; } else { $val = ''; } return $val; } =begin wiki !3 Method get_sections /Parameters/ * %$self% - reference to our object /Description/ Return a list of all the level one heading titless contained within the \ current document. /Test/ %insert name of test script here% =cut 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; } =begin wiki !3 Method set_section /Parameters/ * %$self% - reference to our object * %$section% - Title of section to set /Description/ Set the section title to the desired title. /Test/ %insert name of test script here% =cut sub set_section { my ($self,$section) = @_; $self->{_section} = $section; return 0; } =begin wiki !3 Method is_section /Parameters/ * %$self% - reference to our object * %section% - A level one heading to verify /Description/ Verify that the level one heading provided exists in the current document. /Test/ %insert name of test script here% =cut 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; } =begin wiki !3 Method format /Parameters/ * %$self% - reference to our object /Description/ /Test/ %insert name of test script here% =cut 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; } } =begin wiki !2 Private Methods /Test/ %insert name of test script here% !3 Function is_valid_param /Parameters/ * %$key% - paramater to check /Description/ Check object supplied value to see if it is a valid object paramter. /Test/ %insert name of test script here% =cut 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; } =begin wiki !3 Function init_stores /Parameters/ None /Description/ Initialize module level data stores to empty state. /Test/ %insert name of test script here% =cut sub init_stores { my $self = shift; @aotoc = (); %hotoc = (); @inpod = (); @lines = (); @format = (); @nonformat = (); return 0; } =begin wiki !3 Function read_input /Parameters/ * %$self% - reference to our object Sets: * %@lines% - all lines from input file * %@aotoc% - array of header line information * %@hotoc% - hash of header line information * %@inpod% - flags indicating pod or non-pod line /Description/ Read the contents of the file into three arrays. These arrays form the raw \ data for input to Text::Tiki. /Test/ %insert name of test script here% =cut 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; } =begin wiki !3 Function format_html /Parameters/ /Description/ /Test/ %insert name of test script here% =cut 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; } =begin wiki !3 Function format_text /Parameters/ /Description/ /Test/ %insert name of test script here% =cut 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; } =begin wiki !3 Function format_reference /Parameters/ * %$self% - reference to our object /Description/ This function uses both the @format array and the @nonformat array to build a \ new array of lines to be submitted to the Tiki formatter. Lines in the @nonformat \ array have the 'preformat' string appended to the start of each line. Each \ section of non-pod has a language tag inserted at the beginning of the section. \ The default language is 'Perl', but this can be controlled by the user as a \ parameter when the Pod::WikiText object is created. The key to combining both \ input sources is the @inpod array. /Test/ %insert name of test script here% =cut 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; } =begin wiki !3 Function format_codetext /Parameters/ /Description/ /Test/ %insert name of test script here% =cut 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; } =begin wiki !3 Function format_codehtml /Parameters/ /Description/ /Test/ %insert name of test script here% =cut 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; } =begin wiki !3 Function prep_html /Parameters/ /Description/ /Test/ %insert name of test script here% =cut 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; } =begin wiki !3 Function prep_html_section /Parameters/ /Description/ /Test/ %insert name of test script here% =cut 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; } =begin wiki !3 Function post_process /Parameters/ * %$self% - reference to our object * %$html% - reference to the generated html /Description/ =cut 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; } =begin wiki !3 Function output_format /Parameters/ * %$self% - reference to our object - object * %$output% - reference to output lines /Description/ Write to file. =cut 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; } =begin wiki !3 Function create_toc /Parameters/ * %$self% - reference to our object /Description/ Create table of contents html based on entries stored in the @aotoc array. /Test/ %insert name of test script here% =cut sub create_toc { my $self = shift; my $plevel = 0; my $indent = 0; my $i = 0; my @toclines; my $beginlist = ''; push @toclines, ""; 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) . "
  • $line
    • "; } if ( $level == $plevel ) { push @toclines, ' ' x ($level * 2) . "
  • $line
    • "; } 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) . "
  • $line
    • "; } ## next iteration $plevel = $level; $i++; } for (my $i=$plevel; $i>0; $i--) { push @toclines, ' ' x ($i * 2) . $endlist; } push @toclines, ""; push @toclines, "
    "; return join("\n", @toclines); } =begin wiki !3 Function debug_read /Parameters/ None /Description/ This function is used to dump the contents of @lines, @aotoc, %hotoc, and \ @inpod to individual files for inspection. =cut 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; } =begin wiki !3 Function debug_prep /Parameters/ None /Description/ This function is used to dump the contents of @format to an individual file \ for inspection. =cut 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; } =begin wiki !3 Function debug_params /Parameters/ None /Description/ This function is used to dump the contents of the document info hash and \ the object parameters. =cut 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; } =begin wiki !3 Function html_add_cell_spacing /Parameters/ * %$self% - reference to our object * %$html% - reference to the html to be modified /Description/ /Test/ %insert name of test script here% =cut sub html_add_cell_spacing { my ($self, $html) = @_; $$html =~ s//  /gm; $$html =~ s/<\/td>/  <\/td>/gm; return 0; } =begin wiki !3 Function html_pad_empty_cells /Parameters/ * %$self% - reference to our object * %$html% - reference to the html to be modified /Description/ /Test/ %insert name of test script here% =cut sub html_pad_empty_cells { my ($self, $html) = @_; $$html =~ s/  \.  /    /gm; return 0; } =begin wiki !3 Function html_insert_line_breaks /Parameters/ * %$self% - reference to our object * %$html% - reference to the html to be modified /Description/ ---- =cut sub html_insert_line_breaks { my ($self, $html) = @_; $$html =~ s/##BR##/  
      /gm; return 0; } =begin wiki !3 Function html_insert_line_breaks /Parameters/ * %$self% - reference to our object * %$html% - reference to the html to be modified /Description/ ---- =cut sub html_insert_checkmarks { my ($self, $html) = @_; if ( $self->{_usesvg} eq "yes" ) { if ( $$html =~ /##CM##/ ) { $$html =~ s/##CM##//gm; $self->write_checkmark_svg; } } else { $$html =~ s/##CM##/V<\/em>/gm; } return 0; } =begin wiki !3 Function html_set_borders /Parameters/ * %$self% - reference to our object * %$html% - reference to the html to be modified /Description/ If the borders macro is found in the first cell of a table, replace the table \ tag with a style callout that will style the table with the appropriately \ specified border. If the %##NOBORDERS##% tag is found in the first table cell, replace the \ tag with
    . If the %##BORDERS##% tag is found in the first table cell, replace the \ tag with
    . This references the "hidden" and "solid" classes defined for you in the \ embedded style sheet. /Test/ %insert name of test script here% ---- =cut sub html_set_borders { my ($self, $html) = @_; $$html =~ s/(
    )(.*?.*?
    )(.*?)(\#\#NOBORDERS\#\#)/$2$3/gms; $$html =~ s/(
    )(.*?.*?
    )(.*?)(\#\#BORDERS\#\#)/$2$3/gms; return 0; } =begin wiki !3 Function html_set_bgcolors /Parameters/ * %$self% - reference to our object * %$html% - reference to the html to be modified /Description/ Provide support for table background colors. When ##BGRxxxxxx## is placed in \ a tag the table row color will be modified. When ##BGCxxxxxx## is placed \ in a (.)$1
    tag the table cell color will be modified. The string "xxxxxx" is a \ hex color code. ---- =cut sub html_set_bgcolors { my ($self, $html) = @_; $$html =~ s/
    (  )\#\#BGR([A-Fa-f0-9]{6,6})\#\#( ?)/
    $2/gms; $$html =~ s/(  )\#\#BGC([A-Fa-f0-9]{6,6})\#\#( ?)/$1/gms; return 0; } =begin wiki !3 Function html_replace_nul /Parameters/ * %$self% - reference to our object * %$html% - reference to the html to be modified /Description/ Replace tags with blank (nothing). /Test/ %insert name of test script here% =cut sub html_replace_nul { my ($self, $html) = @_; $$html =~ s///gm; return 0; } =begin wiki !3 Function html_fixes /Parameters/ * %$self% - reference to our object * %$html% - reference to the html to be modified /Description/ Perform misc fixes. /Test/ %insert name of test script here% =cut sub html_fixes { my ($self, $html) = @_; ## modifier s treats the string as a single line so . will match newline $$html =~ s#
    .
    #

    #gs; return 0; } =begin wiki !3 Function html_syntax_highlight /Parameters/ * %$html% - reference to the html to be modified /Description/ /Test/ %insert name of test script here% =cut sub html_syntax_highlight { my ($self, $html) = @_; $$html =~ s/^

    /

    /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
    '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/>/>/gms; $code =~ s/</{_format} eq "html" ) { $code =~ s/\n//; } my $highlighted = $self->html_syntax_highlight_language( $code, $language ); $$html =~ s/^ % .*? %%/$highlighted/ms; } $$html =~ s/
    //gms;    ## need to incorporate this into regex above
    $$html =~ s/<\/pre>//gms;  ## need to incorporate this into regex above

    return 0;
}

=begin wiki

!3 Function html_syntax_highlight_language

/Parameters/

* %$code% - code to be highlighted
* %$language% - language to use for highlighting

/Description/

Submit code blocks to Syntax::Highlight::Engine::Kate highlighter.

/Test/

%insert name of test script here%

=cut

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//"/gms;
    $code =~ s/<\/q>/"/gms;

    my $hl = new Syntax::Highlight::Engine::Kate(
        language => $language,
        substitutions => {
            "<"  => "<",
            ">"  => ">",
            "&"  => "&",
            " "  => " ",
            "\t" => "    ",
            "\n" => "
    \n",
        },
        ## since a style is applied, the "face" and "size" attributes can be removed...
        format_table => {
            Alert => ["", ""],
            BaseN => ["", ""],
            BString => ["", ""],
            Char => ["", ""],
            Comment => ["", ""],
            DataType => ["", ""],
            DecVal => ["", ""],
            Error => ["", ""],
            Float => ["", ""],
            Function => ["", ""],
            IString => ["", ""],
            Keyword => ["", ""],
            Normal => ["", ""],
            Operator => ["", ""],
            Others => ["", ""],
            RegionMarker => ["", ""],
            Reserved => ["", ""],
            String => ["", ""],
            Variable => ["", ""],
            Warning => ["", ""],
            ##Alert        => ["", ""],
            ##BaseN        => ["", ""],
            ##BString      => ["", ""],
            ##Char         => ["", ""],
            ##Comment      => ["", ""],
            ##DataType     => ["", ""],
            ##DecVal       => ["", ""],
            ##Error        => ["", ""],
            ##Float        => ["", ""],
            ##Function     => ["", ""],
            ##IString      => ["", ""],
            ##Keyword      => ["", ""],
            ##Normal       => ["", ""],
            ##Operator     => ["", ""],
            ##Others       => ["", ""],
            ##RegionMarker => ["", ""],
            ##Reserved     => ["", ""],
            ##String       => ["", ""],
            ##Variable     => ["", ""],
            ##Warning      => ["", ""],
        },
    );

    my $highlight = '';
    foreach my $line ( split "\n", $code ) {
        my $high = $hl->highlightText( ' '.$line."\n" );
        $highlight .= " " . $high;
    }
    if ( $self->{_format} eq "codehtml" ) {
        return "
    \n".$highlight."
    ";
    } else {
        ##return "
    \n".$highlight."
    ";
        return "
    \n".$highlight."
    ";
    }
}

=begin wiki

!3 Function html_codeblock_tags

/Parameters/

* %$self% - reference to our object
* %$html% - reference to the html to be modified

/Description/

Replace /begin code block/ and /end code block/ markup with blank space.

=cut

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/ /gm;
    $$html =~ s/
    end code block<\/em><\/p>/
    /gm;

    return 0;
}

=begin wiki

!3 Function html_add_header

/Parameters/

* %$self% - reference to our object
* %$html% - reference to the html to be modified

/Description/

=cut

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

    my $header;

    $header = <<'    HEADER';
        
        
        
        
        
        
        $title
        
        
        
        $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;
}

=begin wiki

!3 Function html_add_footer

/Parameters/

* %$self% - reference to our object
* %$html% - reference to the html to be modified

/Description/

/Test/

%insert name of test script here%

=cut

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

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

    $$html .= $footer;

    return 0;
}

=begin wiki

!3 Function text_wrap

/Parameters/

/Description/

/Test/

%insert name of test script here%

=cut

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;
}

=begin wiki

!3 Function header_vars

/Parameters/

None

/Description/

Perform variable substitution in the header and footer strings using the \
%docinfo hash as the source for variable values.

/Test/

%insert name of test script here%

=cut

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;
}

=begin wiki

!3 Function footer_vars

/Parameters/

None

/Description/

Perform variable substitution in the header and footer strings using the \
%docinfo hash as the source for variable values.

=cut

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;
}

=begin wiki

!3 write_checkmark_svg {

/Parameters/

* %$self% - reference to ourself

/Description/

Subroutine to write the checkmark svg file to the output directory where the \
page html is written. CAUTION: Using this feature causes to an svg image file \
to be created wherever an html page is created. An enhancement to this feature \
would be to allow the user to specify a url for the checkmark file.

=cut

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

    my $svgimage = <<'    ENDSVG';
    
    
    
      
      
      
        
          
            image/svg+xml
            

          
        
      
      
        
      
    
    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;
}

=begin wiki

!1 BUGS

Please advise me of any bugs that you may encounter. Bugs will be corrected as \
quickly as possible.

----

!1 TO DO

I am considering adding support for other wiki markup engines besides \
Text::Tiki, but this will probably be request driven.

----

!1 COPYRIGHT

Copyright 2008 Brad Adkins .

Permission is granted to copy, distribute and/or modify this document under the \
terms of the GNU Free Documentation License, published by the Free Software \
Foundation; with no Invariant Sections, with no Front-Cover Texts, and with no \
Back-Cover Texts.

----

!1 AUTHOR

Brad Adkins, dbijcl@gmail.com

----

!1 REFERENCES

The base markup provided by Text::Tiki module. Please see the POD in the \
Text::Tiki module for additional information about Wiki markup in general, and \
Text::Tiki markup in particular.

----

=cut

1;

__END__