[libhtml-scrubber-perl] 09/11: Moved the common _scrub code to one place
Florian Schlichting
fsfs at moszumanska.debian.org
Sat Nov 11 13:46:04 UTC 2017
This is an automated email from the git hooks/post-receive script.
fsfs pushed a commit to annotated tag release/0.09
in repository libhtml-scrubber-perl.
commit 0182c5514dc165b3fb45021db479e335ed327cac
Author: Nigel Metheringham <nigelm at cpan.org>
Date: Fri Apr 1 16:28:10 2011 +0100
Moved the common _scrub code to one place
This does mean that _scrub_fh outputs everything in one go.
If this is a real problem we can re-implement with IO::String
---
lib/HTML/Scrubber.pm | 151 +++++++++++++++++----------------------------------
1 file changed, 50 insertions(+), 101 deletions(-)
diff --git a/lib/HTML/Scrubber.pm b/lib/HTML/Scrubber.pm
index 68e69e1..26abd4c 100644
--- a/lib/HTML/Scrubber.pm
+++ b/lib/HTML/Scrubber.pm
@@ -391,137 +391,86 @@ sub _validate {
return "<$t>";
}
-=for comment _scrub_fh
-I<default> handler, does the scrubbing if we're scrubbing out to a file.
+=for comment _scrub_str
+
+I<default> handler, used by both _scrub and _scrub_fh
+Moved all the common code (ie all of it) into a single routine for
+ease of maintenance
=cut
-sub _scrub_fh {
- my( $p, $e, $t, $a, $as, $text ) = @_;
- my $s = $p->{"\0_s"} ;
+sub _scrub_str {
+ my ( $p, $e, $t, $a, $as, $text ) = @_;
+
+ my $s = $p->{"\0_s"};
+ my $outstr = '';
- if ( $e eq 'start' )
- {
- if( exists $s->{_rules}->{$t} ) # is there a specific rule
+ if ( $e eq 'start' ) {
+ if ( exists $s->{_rules}->{$t} ) # is there a specific rule
{
- if( ref $s->{_rules}->{$t} ) # is it complicated?(not simple;)
+ if ( ref $s->{_rules}->{$t} ) # is it complicated?(not simple;)
{
- print
- {$s->{_out}}
- $s->_validate($t, $t, $a, $as);
+ $outstr .= $s->_validate( $t, $t, $a, $as );
}
- elsif( $s->{_rules}->{$t} ) # validate using default attribute rule
+ elsif ( $s->{_rules}->{$t} ) # validate using default attribute rule
{
- print
- {$s->{_out}}
- $s->_validate($t, '_', $a, $as);
+ $outstr .= $s->_validate( $t, '_', $a, $as );
}
}
- elsif( $s->{_rules}->{'*'} ) # default allow tags
+ elsif ( $s->{_rules}->{'*'} ) # default allow tags
{
- print
- {$s->{_out}}
- $s->_validate($t, '_', $a, $as);
+ $outstr .= $s->_validate( $t, '_', $a, $as );
}
}
- elsif ( $e eq 'end' )
- {
- if( exists $s->{_rules}->{$t} )
- {
- print
- {$s->{_out}}
- "</$t>"
- if $s->{_rules}->{$t};
-
+ elsif ( $e eq 'end' ) {
+ if ( exists $s->{_rules}->{$t} ) {
+ $outstr .= "</$t>" if $s->{_rules}->{$t};
}
- elsif( $s->{_rules}->{'*'} )
- {
-
- print {$s->{_out}} "</$t>";
+ elsif ( $s->{_rules}->{'*'} ) {
+ $outstr .= "</$t>";
}
}
- elsif ( $e eq 'comment' )
- {
- print
- {$s->{_out}}
- $text
- if $s->{_comment};
+ elsif ( $e eq 'comment' ) {
+ $outstr .= $text if $s->{_comment};
}
- elsif ( $e eq 'process' )
- {
- print
- {$s->{_out}}
- $text
- if $s->{_process};
+ elsif ( $e eq 'process' ) {
+ $outstr .= $text if $s->{_process};
}
- elsif ( $e eq 'text' or $e eq 'default')
- {
- $text =~ s/</</g; #https://rt.cpan.org/Ticket/Attachment/8716/10332/scrubber.patch
+ elsif ( $e eq 'text' or $e eq 'default' ) {
+ $text =~ s/</</g; #https://rt.cpan.org/Ticket/Attachment/8716/10332/scrubber.patch
$text =~ s/>/>/g;
- print
- {$s->{_out}}
- $text;
+ $outstr .= $text;
}
+ elsif ( $e eq 'start_document' ) {
+ $outstr = "";
+ }
+
+ return $outstr;
+}
+
+=for comment _scrub_fh
+
+I<default> handler, does the scrubbing if we're scrubbing out to a file.
+Now calls _scrub_str and pushes that out to a file.
+
+=cut
+
+sub _scrub_fh {
+
+ print { $_[0]->{"\0_s"}->{_out} } _scrub_str(@_);
}
=for comment _scrub
+
I<default> handler, does the scrubbing if we're returning a giant string.
+Now calls _scrub_str and appends that to the output string.
=cut
sub _scrub {
- my( $p, $e, $t, $a, $as, $text ) = @_;
- my $s = $p->{"\0_s"} ;
- if ( $e eq 'start' )
- {
- if( exists $s->{_rules}->{$t} ) # is there a specific rule
- {
- if( ref $s->{_rules}->{$t} ) # is it complicated?(not simple;)
- {
- $s->{_r} .= $s->_validate($t, $t, $a, $as);
- }
- elsif( $s->{_rules}->{$t} ) # validate using default attribute rule
- {
- $s->{_r} .= $s->_validate($t, '_', $a, $as);
- }
- }
- elsif( $s->{_rules}->{'*'} ) # default allow tags
- {
- $s->{_r} .= $s->_validate($t, '_', $a, $as);
- }
- }
- elsif ( $e eq 'end' )
- {
- if( exists $s->{_rules}->{$t} )
- {
- $s->{_r} .= "</$t>" if $s->{_rules}->{$t};
- }
- elsif( $s->{_rules}->{'*'} )
- {
- $s->{_r} .= "</$t>";
- }
- }
- elsif ( $e eq 'comment' )
- {
- $s->{_r} .= $text if $s->{_comment};
- }
- elsif ( $e eq 'process' )
- {
- $s->{_r} .= $text if $s->{_process};
- }
- elsif ( $e eq 'text' or $e eq 'default')
- {
- $text =~ s/</</g; #https://rt.cpan.org/Ticket/Attachment/8716/10332/scrubber.patch
- $text =~ s/>/>/g;
-
- $s->{_r} .= $text;
- }
- elsif ( $e eq 'start_document' )
- {
- $s->{_r} = "";
- }
+ $_[0]->{"\0_s"}->{_r} .= _scrub_str(@_);
}
sub _optimize {
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libhtml-scrubber-perl.git
More information about the Pkg-perl-cvs-commits
mailing list