package CGI::Kwiki::Formatter; $VERSION = '0.18'; use strict; use base 'CGI::Kwiki', 'CGI::Kwiki::Privacy'; use CGI::Kwiki qw(:char_classes); sub process_order { return qw( table code function header_1 header_2 header_3 header_4 header_5 header_6 escape_html lists comment horizontal_line paragraph named_http_link no_http_link http_link no_mailto_link mailto_link no_wiki_link force_wiki_link wiki_link inline version negation bold italic underscore ); } my $slide_num; sub process { $slide_num = 0; my ($self, $wiki_text) = @_; my $array = []; push @$array, $wiki_text; for my $method ($self->process_order) { $array = $self->dispatch($array, $method); } return $self->combine_chunks($array); } sub dispatch { my ($self, $old_array, $method) = @_; return $old_array unless $self->can($method); my $new_array; for my $chunk (@$old_array) { if (ref $chunk eq 'ARRAY') { push @$new_array, $self->dispatch($chunk, $method); } else { if (ref $chunk) { push @$new_array, $chunk; } else { push @$new_array, $self->$method($chunk); } } } return $new_array; } sub combine_chunks { my ($self, $chunk_array) = @_; my $formatted_text = ''; for my $chunk (@$chunk_array) { $formatted_text .= (ref $chunk eq 'ARRAY') ? $self->combine_chunks($chunk) : (ref $chunk) ? $$chunk : $chunk } return $formatted_text; } sub split_method { my ($self, $text, $regexp, $method) = @_; my $i = 0; map {$i++ % 2 ? \ $self->$method($_) : $_} split $regexp, $text; } sub user_functions { qw( SLIDESHOW_SELECTOR total_bullets ); } sub isa_function { my ($self, $function) = @_; defined { map { ($_, 1) } $self->user_functions }->{$function} and $self->can($function) } sub function { my ($self, $text) = @_; $self->split_method($text, qr{\[\&(\w+\b.*?)\]}, 'function_format', ); } sub function_format { my ($self, $text) = @_; my ($method, @args) = split; $self->isa_function($method) ? $self->$method(@args) : "\n"; } sub total_bullets { my ($self) = @_; scalar(() = $self->database->load($self->cgi->page_id) =~ /^\* /gm); } sub SLIDESHOW_SELECTOR { my ($self) = @_; $slide_num = 1; my $page_id = $self->cgi->page_id; my $start = $self->loc('start'); my $html = < END $html; } sub TRANSCLUDE_HTTP_BODY { my ($self, $url) = @_; require LWP::Simple; my $html = LWP::Simple::get($url) or return ''; $html =~ s#.*(.*).*#$1#is; \ $html; } sub table { my ($self, $text) = @_; my @array; while ($text =~ /(.*?)(^\|[^\n]*\|\n.*)/ms) { push @array, $1; my $table; ($table, $text) = $self->parse_table($2); push @array, $table; } push @array, $text if length $text; return @array; } sub parse_table { my ($self, $text) = @_; my $error = ''; my $rows; while ($text =~ s/^(\|(.*)\|\n)//) { $error .= $1; my $data = $2; my $row = []; for my $datum (split /\|/, $data) { $datum =~ s/^\s*(.*?)\s*$/$1/; if ($datum =~ s/^<<(\S+)$//) { my $marker = $1; while ($text =~ s/^(.*\n)//) { my $line = $1; $error .= $line; if ($line eq "$marker\n") { $marker = ''; last; } $datum .= $line; } if (length $marker) { return ($error, $text); } } push @$row, $datum; } push @$rows, $row; } return ($self->format_table($rows), $text); } sub format_table { my ($self, $rows) = @_; my $cols = 0; for (@$rows) { $cols = @$_ if @$_ > $cols; } my $table = qq{

\n\n}; for my $row (@$rows) { $table .= qq{\n}; for (my $i = 0; $i < @$row; $i++) { my $colspan = ''; if ($i == $#{$row} and $cols - $i > 1) { $colspan = ' colspan="' . ($cols - $i) . '"'; } my $cell = $self->escape_html($row->[$i]); $cell = qq{
$cell
\n} if $cell =~ /\n/; $cell = ' ' unless length $cell; $table .= qq{$cell\n}; } $table .= qq{\n}; } $table .= qq{

\n}; return \$table; } sub no_wiki_link { my ($self, $text) = @_; $self->split_method($text, qr{!([$UPPER](?=[$WIKIWORD]*[$UPPER])(?=[$WIKIWORD]*[$LOWER])[$WIKIWORD]+)}, 'no_wiki_link_format', ); } sub no_wiki_link_format { my ($self, $text) = @_; return $text; } sub wiki_link { my ($self, $text) = @_; $self->split_method($text, qr{([$UPPER](?=[$WIKIWORD]*[$UPPER])(?=[$WIKIWORD]*[$LOWER])[$WIKIWORD]+)}, 'wiki_link_format', ); } sub force_wiki_link { my ($self, $text) = @_; $self->split_method($text, qr{(?script; my $url = $self->escape($text); my $wiki_link = qq{$text}; if (not $self->database->exists($text)) { $wiki_link =~ s/is_readable($text)) { $url = $self->escape($self->loc("KwikiPrivatePage")); $wiki_link = qq{$text}; } return $wiki_link; } sub no_http_link { my ($self, $text) = @_; $self->split_method($text, qr{(!(?:https?|ftp|irc):\S+?)}m, 'no_http_link_format', ); } sub no_http_link_format { my ($self, $text) = @_; $text =~ s#!##; return $text; } sub http_link { my ($self, $text) = @_; $self->split_method($text, qr{((?:https?|ftp|irc):\S+?(?=[),.:;]?\s|$))}m, 'http_link_format', ); } sub http_link_format { my ($self, $text) = @_; if ($text =~ /^http.*\.(?i:jpg|gif|jpeg|png)$/) { return $self->img_format($text); } else { return $self->link_format($text); } } sub no_mailto_link { my ($self, $text) = @_; $self->split_method($text, qr{(![$ALPHANUM][$WORD\-\.]*@[$WORD][$WORD\-\.]+)}m, 'no_mailto_link_format', ); } sub no_mailto_link_format { my ($self, $text) = @_; $text =~ s#!##; return $text; } sub mailto_link { my ($self, $text) = @_; $self->split_method($text, qr{([$ALPHANUM][$WORD\-\.]*@[$WORD][$WORD\-\.]+)}m, 'mailto_link_format', ); } sub mailto_link_format { my ($self, $text) = @_; my $dot = ($text =~ s/\.$//) ? '.' : ''; qq{$text$dot}; } sub img_format { my ($self, $url) = @_; return qq{

}; } sub link_format { my ($self, $text) = @_; $text =~ s/(^\s*|\s+(?=\s)|\s$)//g; my $url = $text; $url = $1 if $text =~ s/(.*?) +//; $url =~ s/^http:(?!=\/\/)//; # relative links return qq{$text}; } sub named_http_link { my ($self, $text) = @_; $self->split_method($text, qr{(?link_format($text); } sub version { my ($self, $text) = @_; $text =~ s#(?split_method($text, qr{(?$text"; } sub negation { my ($self, $text) = @_; $text =~ s#\!(?=\[)##g; return $text; } sub bold { my ($self, $text) = @_; $text =~ s#(?$1#g; return $text; } sub italic { my ($self, $text) = @_; $text =~ s#(?$1#g; return $text; } sub underscore { my ($self, $text) = @_; $text =~ s#(?$1#g; return $text; } sub code { my ($self, $text) = @_; $self->split_method($text, qr{(^ +[^ \n].*?\n)(?-ms:(?=[^ \n]|$))}ms, 'code_format', ); } sub code_format { my ($self, $text) = @_; $self->code_postformat($self->code_preformat($text)); } sub code_preformat { my ($self, $text) = @_; my ($indent) = sort { $a <=> $b } map { length } $text =~ /^( *)\S/mg; $text =~ s/^ {$indent}//gm; return $self->escape_html($text); } sub code_postformat { my ($self, $text) = @_; return "

$text

\n"; } sub escape_html { my ($self, $text) = @_; $text =~ s/&/&/g; $text =~ s//>/g; $text; } sub lists { my ($self, $text) = @_; my $switch = 0; return map { my $level = 0; my @tag_stack; if ($switch++ % 2) { my $text = ''; my @lines = /(.*\n)/g; for my $line (@lines) { $line =~ s/^([0\*]+) //; my $new_level = length($1); my $tag = ($1 =~ /0/) ? 'ol' : 'ul'; if ($new_level > $level) { for (1..($new_level - $level)) { push @tag_stack, $tag; $text .= "<$tag>\n"; } $level = $new_level; } elsif ($new_level < $level) { for (1..($level - $new_level)) { $tag = pop @tag_stack; $text .= "\n"; } $level = $new_level; } $text .= "

$line"; } for (1..$level) { my $tag = pop @tag_stack; $text .= "\n"; } $_ = $self->lists_format($text); } $_; } split m!(^[0\*]+ .*?\n)(?=(?:[^0\*]|$))!ms, $text; } sub lists_format { my ($self, $text) = @_; return $text; } sub paragraph { my ($self, $text) = @_; my $switch = 0; return map { unless ($switch++ % 2) { $_ = $self->paragraph_format($_); } $_; } split m!(\n\s*\n)!ms, $text; } sub paragraph_format { my ($self, $text) = @_; return '' if $text =~ /^[\s\n]*$/; return $text if $text =~ /^<(o|u)l>/i; return "

\n$text\n

\n"; } sub horizontal_line { my ($self, $text) = @_; $self->split_method($text, qr{(^----+\n)}m, 'horizontal_line_format', ); } sub horizontal_line_format { my ($self) = @_; my $text = "

\n"; if ($slide_num) { my $page_id = $self->cgi->page_id; my $go = $self->loc('Go'); $text .= qq{$go\n}; $slide_num++; } return $text; } sub comment { my ($self, $text) = @_; $self->split_method($text, qr{^\# (.*)\n}m, 'comment_line_format', ); } sub comment_line_format { my ($self, $text) = @_; return "\n"; } for my $num (1..6) { no strict 'refs'; *{"header_$num"} = sub { my ($self, $text) = @_; $self->split_method($text, qr{^={$num} (.*?)(?: ={$num})?\n}m, "header_${num}_format", ); }; *{"header_${num}_format"} = sub { my ($self, $text) = @_; return "$text\n"; }; } 1; __END__ =head1 NAME CGI::Kwiki::Formatter - Formatter Base Class for CGI::Kwiki =head1 DESCRIPTION See installed kwiki pages for more information. =head1 AUTHOR Brian Ingerson =head1 COPYRIGHT Copyright (c) 2003. Brian Ingerson. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See http://www.perl.com/perl/misc/Artistic.html =cut