RTx-Foundry

 view release on metacpan or  search on metacpan

html/Foundry/Project/Wiki/lib/CGI/Kwiki/Formatter/HLB.pm  view on Meta::CPAN

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 "<code><pre>$text</pre></code>\n";
}

sub escape_html {
my ($self, $text) = @_;
$text =~ s/&/&amp;/g;
$text =~ s/</&lt;/g;
$text =~ s/>/&gt;/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';

	    $text .= ($level && $new_level == $level) ? '</li><li>' : '';
	    if ($new_level > $level) {
		for (1..($new_level - $level)) {
		    push @tag_stack, $tag;
		    $text .= "<$tag><li>\n";
		}
		$level = $new_level;
	    }
	    elsif ($new_level < $level) {
		for (1..($level - $new_level)) {
		    $tag = pop @tag_stack;
		    $text .= $level ? '</li>' : '';
		    $text .= "</$tag>\n";
		}
		$level = $new_level;
		$text .= $level ? '</li><li>' : '';
	    }
	    $text .= "$line";
        }
        for (1..$level) {
            my $tag = pop @tag_stack;
            $text .= "</li></$tag>\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 "<p>\n$text\n</p>\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 = "<hr />\n";
    if ($slide_num) {
        my $page_id = $self->cgi->page_id;
	my $go = $self->loc('Go');
        $text .= qq{<a target="SlideShow" href="index.cgi?action=slides&page_id=$page_id&slide_num=$slide_num">$go</a>\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 "<!-- $text -->\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 "<h$num>$text</h$num>\n";
    };
}

1;



( run in 0.801 second using v1.01-cache-2.11-cpan-71847e10f99 )