[libhtml-scrubber-perl] 01/01: Imported from HTML-Scrubber-0.06.tar.gz.
Florian Schlichting
fsfs at moszumanska.debian.org
Sat Nov 11 13:45:59 UTC 2017
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. <podmaster at cpan.org>
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
More information about the Pkg-perl-cvs-commits
mailing list