use strict; use vars qw($table_depth); $table_depth = 0; use MarkupHandler qw( ret_bal_tag_handlers ret_escape_code ret_ok_attr_val ret_scrubber ); my $href_test = ret_ok_attr_val( sub { shift() =~ m-^'?"?(http://|ftp://|mailto:|#)-i; } ); my @bal_tags = ( a => [ qw(name target), {'href' => $href_test} ], font => [qw(color size)], ol => ['type'], p => ['align'], { name => 'table', pre => sub { if (5 > $table_depth++) { return ''; } else { $table_depth--; return ('', "Exceeded maximum table depth\n"); } }, post => sub { if (0 > --$table_depth) { $table_depth = 0; return ("", "Table depth should not be below 0"); } @_; }, }, [qw(bgcolor border cellpadding cellspacing width)], in_table_tags( colgroup => [ qw(align span valign width) ], td => [qw(align bgcolor colspan height rowspan valign width)], tr => [qw(align valign width)], ), map {$_, []} qw( b big blockquote br dd dl dt em h1 h2 h3 h4 h5 h6 hr i li pre small strike strong sub sup tt u ul ), ); my @handlers = ( ret_bal_tag_handlers(@bal_tags), ret_escape_code(qr(\[/code\]), "[code]"), ); my $scrubber = ret_scrubber(@handlers); my $text = <<'EOT'; Hello world. <<; [code] This is ...see the being escaped? [/code] Hello worldub> hello world hello
EOT print $scrubber->(\$text); sub in_table_tags { my @out; while (@_) { my $name = shift; push @out, { name => $name, pre => sub { $table_depth ? '' : ('', "Cannot open <$name>, not in table"); }, }, shift(); } return @out; }