package Base::HTML::Inline; use strict; use warnings; use Exporter qw(import); our @EXPORT_OK = qw(inline); # Written by an Anonymous Monk on PerlMonks (http://www.perlmonks.org/?node_id=1028699) use Test::More qw' no_plan '; use Regexp::Common qw/ balanced /; use Data::Dump qw/ dd pp /; use vars qw/ $re_balanced_angles /; sub TRACE; sub DEBUG; *TRACE = *DEBUG = sub { print STDERR @_,"\n" }; our $re_balanced_angles = qr{\<(?:(?>[^\<\>]+)|(??{ $re_balanced_angles }))*\>}x; our $allowed = join '|', qw[ A ABBR ACRONYM B BIG CITE CODE DFN EM I KBD Q SAMP SMALL SPAN STRONG SUB SUP TT VAR ]; sub inline { local $_ = $_[0]; my $dent = $_[1] || 0; pos = 0; my $ret = ""; inlineLOOP: while( length > pos ){ m{\G(\s+)}gcsx and do { $ret .= $1; next inlineLOOP; }; m{\G( $allowed )( $re_balanced_angles )}gcsx and do { TRACE "# $dent allowed<> { $1 ( $2 ) }"; $ret .= inline_allowed( "$1" , "$2" , $dent ); next inlineLOOP; }; m{\G([^<]+\s)}gcmx and do { TRACE "# $dent text { $1 }"; $ret .= inline_text( "$1" ); next inlineLOOP; };;; m{\G([\<\>])}gcmx and do { TRACE "## $dent error-stray<> { $1 } at pos(@{[pos]})"; last inlineLOOP; };;; m{\G(\S)}gcmx and do { TRACE "# $dent inch-forward { $1 }"; $ret .= inline_text( "$1" ); next inlineLOOP; };;; } $ret; } sub inline_allowed { my( $tag , $stuff, $dent ) = @_; $stuff = $1 if $stuff =~ m{^<(.*)>$}gs; my $ret = ""; $ret .= "<\L$tag\E" if $tag; $stuff =~ s{\|([^<>]+)$}{$ret .= " $1"; "";}gsex if defined $stuff ; ## inline_allowed_atts($tag,$1); $ret .= ">" if $tag; if( defined $stuff and length $stuff and $stuff =~ m{[<>]}g ){ $ret .= inline( $stuff , $dent+1) ; ## recurse } else { $ret .= $stuff; } $ret .= "" if $tag; $ret; } sub inline_text { join'',@_ } 1;