This is an automated email from the git hooks/post-receive script. fsfs pushed a commit to annotated tag HTML-Scrubber-0.06 in repository libhtml-scrubber-perl.
commit 6fe3115fa733f5a0ce9dc0c0e2df45b1998f0b73 Author: D. H. <[email protected]> Date: Sun Nov 2 11:15:28 2003 +0000 Imported from HTML-Scrubber-0.06.tar.gz. --- Changes | 4 ++++ MANIFEST | 1 + META.yml | 2 +- Scrubber.pm | 37 ++++++++++++++++++++---------------- t/06_scrub_file.t | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 84 insertions(+), 17 deletions(-) diff --git a/Changes b/Changes index 62b9a20..6e87c9a 100755 --- a/Changes +++ b/Changes @@ -1,5 +1,9 @@ Revision history for Perl extension HTML::Scrubber. +0.06 Sun Nov 2 01:26:42 2003 + - fixed more typos + - added t\06_scrub_file.t (that part was broken, now fixed) + 0.05 Thu Oct 30 23:27:37 2003 - fixed up various typos in tests ... - bumped up version number ;( diff --git a/MANIFEST b/MANIFEST index a57c3ae..07f07a1 100755 --- a/MANIFEST +++ b/MANIFEST @@ -10,4 +10,5 @@ t/02_basic.t t/03_more.t t/04_style_script.t t/05_pi_comment.t +t/06_scrub_file.t META.yml Module meta-data (added by MakeMaker) diff --git a/META.yml b/META.yml index 70dba05..1bcefcb 100755 --- a/META.yml +++ b/META.yml @@ -1,7 +1,7 @@ # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: HTML-Scrubber -version: 0.05 +version: 0.06 version_from: Scrubber.pm installdirs: site requires: diff --git a/Scrubber.pm b/Scrubber.pm index 1ad47c2..b32e347 100755 --- a/Scrubber.pm +++ b/Scrubber.pm @@ -59,21 +59,21 @@ If you're new to perl, good luck to you. package HTML::Scrubber; use HTML::Parser(); use HTML::Entities; -use vars qw[ $VERSION $_scrub $_scrub_fh ]; +use vars qw[ $VERSION @_scrub @_scrub_fh ]; use strict; -$VERSION = '0.05'; +$VERSION = '0.06'; # my my my my, these here to prevent foolishness like # http://perlmonks.org/index.pl?node_id=251127#Stealing+Lexicals -$_scrub = [\&_scrub, "self, event, tagname, attr, text"]; -$_scrub_fh = [\&_scrub_fh, "self, event, tagname, attr, text"]; +(@_scrub )= ( \&_scrub, "self, event, tagname, attr, text"); +(@_scrub_fh )= ( \&_scrub_fh, "self, event, tagname, attr, text"); sub new { my $package = shift; my $p = HTML::Parser->new( api_version => 3, - default_h => $_scrub, + default_h => \@_scrub, marked_sections => 0, strict_comment => 0, unbroken_text => 1, @@ -283,8 +283,10 @@ sub default { =cut sub scrub_file { - if(@_ == 3) { + if(@_ > 2){ return unless defined $_[0]->_out($_[2]); + } else { + $_[0]->{_p}->handler( default => @_scrub ); } $_[0]->_optimize() ;#if $_[0]->{_optimize}; @@ -292,6 +294,7 @@ sub scrub_file { $_[0]->{_p}->parse_file($_[1]); return delete $_[0]->{_r} unless exists $_[0]->{_out}; + delete $_[0]->{_out}; return 1; } @@ -307,8 +310,10 @@ sub scrub_file { =cut sub scrub { - if(@_ == 3) { + if(@_ > 2){ return unless defined $_[0]->_out($_[2]); + } else { + $_[0]->{_p}->handler( default => @_scrub ); } $_[0]->_optimize();# if $_[0]->{_optimize}; @@ -317,13 +322,14 @@ sub scrub { $_[0]->{_p}->eof(); return delete $_[0]->{_r} unless exists $_[0]->{_out}; + delete $_[0]->{_out}; return 1; } =for comment _out - $scrubber->out(*STDOUT) if fileno STDOUT; - $scrubber->out('foo.html') or die "eeek $!"; + $scrubber->_out(*STDOUT) if fileno STDOUT; + $scrubber->_out('foo.html') or die "eeek $!"; =cut @@ -332,15 +338,15 @@ sub _out { unless( ref $o and ref \$o ne 'GLOB') { local *F; - open F, $o or return undef; + open F, ">$o" or return undef; binmode F; $self->{_out} = *F; - $self->{_p}->handler( default => $_scrub_fh ); } else { $self->{_out} = $o; - $self->{_p}->handler( default => $_scrub ); } + $self->{_p}->handler( default => @_scrub_fh ); + return 1; } @@ -455,7 +461,7 @@ sub _scrub_fh { } } -=for comment _scrub_fh +=for comment _scrub I<default> handler, does the scrubbing if we're returning a giant string. =cut @@ -526,7 +532,6 @@ sub _optimize { if( $self->{_rules}{'*'} ){ # default allow $self->{_p}->report_tags(); # so clear it -# warn "\nreporting all\n"; } else { my(@reports) = @@ -539,7 +544,6 @@ sub _optimize { $self->{_p}->report_tags( # default deny, so optimize @reports ) if @reports; -# warn "\nreporting only @reports\n"; } # sub deny @@ -547,6 +551,8 @@ sub _optimize { my(@ignores)= grep { not $self->{_rules}{$_} + } grep { + $_ ne '*' } keys %{ $self->{_rules} }; @@ -554,7 +560,6 @@ sub _optimize { $self->{_p}->ignore_tags( # always ignore stuff we don't want @ignores ) if @ignores; -# warn "\nignoring @ignores\n" if @ignores; $self->{_optimize}=0; return; diff --git a/t/06_scrub_file.t b/t/06_scrub_file.t new file mode 100755 index 0000000..8c0cba8 --- /dev/null +++ b/t/06_scrub_file.t @@ -0,0 +1,57 @@ +# perl Makefile.PL && nmake realclean && cls && perl Makefile.PL && nmake test + +use strict; +use File::Spec; +use Test::More tests => 10; +BEGIN { $^W = 1 } + + use_ok( 'HTML::Scrubber' ); + +my $s = HTML::Scrubber->new; +my $html = q[<html><body><p>hi<br>start <!--comment--> mid1 <?html pi> mid2 <?xml pi?> end</body></html>]; + + isa_ok($s, 'HTML::Scrubber'); + +my $tmpdir = File::Spec->tmpdir(); + +SKIP: { + skip "no writable temporary directory found", 6 + unless length $tmpdir + and -d $tmpdir; + + my $tmpfile = File::Spec->catfile($tmpdir,"html-scrubber.test.html"); + my $r = $s->scrub($html,$tmpfile); + $r = "Error: \$@=$@ \$!=$!" unless $r; + is($r, 1, "scrub(\$html,\$tmpfile=$tmpfile)"); + +# use Data::Dumper;die Dumper($s); + + local *FILIS; + open FILIS, "+>$tmpfile" or die "can't write to $tmpfile"; + + $r = $s->scrub($html,\*FILIS); + $r = "Error: \$@=$@ \$!=$!" unless $r; + + is($r, 1, q[scrub($html,\*FILIS)]); + + seek *FILIS,0,0; + $r = join '', readline *FILIS; + is($r,"histart mid1 mid2 end","FILIS has the right stuff"); + is(close(FILIS),1,q[close(FILIS)]); + + $r = $s->scrub_file($tmpfile,"$tmpfile.html"); + $r = "Error: \$@=$@ \$!=$!" unless $r; + + is($r, 1, qq[scrub_file(\$tmpfile,"\$tmpfile.html"=$tmpfile.html)]); + + open FILIS, "+>$tmpfile.html" or die "can't write to $tmpfile"; + $r = $s->scrub_file($tmpfile,\*FILIS); + $r = "Error: \$@=$@ \$!=$!" unless $r; + + is($r, 1, q[scrub_file($tmpfile,\*FILIS)]); + seek *FILIS,0,0; + $r = join '', readline *FILIS; + is($r,"histart mid1 mid2 end","FILIS has the right stuff"); + is(close(FILIS),1,q[close(FILIS)]); + +}; -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libhtml-scrubber-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
