| Pod-WikiText documentation | Contained in the Pod-WikiText distribution. |
Pod::WikiText - Support for the use of Wiki markup.
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.
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.
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.
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. :-)
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 2008 Brad Adkins <dbijcl@gmail.com>.
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.
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> /gm; $$html =~ s/<\/td>/ <\/td>/gm; return 0; }
sub html_pad_empty_cells { my ($self, $html) = @_; $$html =~ s/ \. / /gm; return 0; }
sub html_insert_line_breaks { my ($self, $html) = @_; $$html =~ s/##BR##/ <br \/> /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>( )\#\#BGR([A-Fa-f0-9]{6,6})\#\#( ?)/<tr bgcolor=\"\#$3\">$1<td>$2/gms; $$html =~ s/<td>( )\#\#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/>/>/gms; $code =~ s/</</gms; $code =~ s/'/'/gms; $code =~ s/"e;/"/gms; $code =~ s/&/&/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 => { "<" => "<", ">" => ">", "&" => "&", " " => " ", "\t" => " ", "\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/ /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__