[Catalyst] HTML::Widget - new filters suggestion

[Lyo Kato]

Skipped content of type multipart/alternative-------------- next part --------------
diff -urN HTML-Widget-1.01.origin/Makefile.PL HTML-Widget-1.01/Makefile.PL
--- HTML-Widget-1.01.origin/Makefile.PL	2006-01-11 21:13:02.019021152 +0900
+++ HTML-Widget-1.01/Makefile.PL	2006-01-11 20:34:04.437387576 +0900
@@ -10,6 +10,7 @@
 requires 'Email::Valid';
 requires 'Date::Calc';
 requires 'Test::MockObject';
+requires 'HTML::Scrubber';
 
 auto_install;
 &WriteAll;
diff -urN HTML-Widget-1.01.origin/lib/HTML/Widget/Filter/HTMLEscape.pm HTML-Widget-1.01/lib/HTML/Widget/Filter/HTMLEscape.pm
--- HTML-Widget-1.01.origin/lib/HTML/Widget/Filter/HTMLEscape.pm	1970-01-01 09:00:00.000000000 +0900
+++ HTML-Widget-1.01/lib/HTML/Widget/Filter/HTMLEscape.pm	2006-01-11 19:50:30.932700680 +0900
@@ -0,0 +1,45 @@
+package HTML::Widget::Filter::HTMLEscape;
+
+use warnings;
+use strict;
+use base 'HTML::Widget::Filter';
+
+=head1 NAME
+
+HTML::Widget::Filter::HTMLEscape - HTML Escaping Filter
+
+=head1 SYNOPSIS
+
+    my $f = $widget->filter( 'HTMLEscape', 'foo' );
+
+=head1 DESCRIPTION
+
+HTML Escaping Filter.
+
+=head1 METHODS
+
+=head2 $self->filter($value)
+
+=cut
+
+sub filter {
+    my ( $self, $value ) = @_;
+    $value =~ s/&(?!(amp|lt|gt|quot);)/&/g;
+    $value =~ s/</&lt;/g;
+    $value =~ s/>/&gt;/g;
+    $value =~ s/\"/&quot;/g;
+    return $value;
+}
+
+=head1 AUTHOR
+
+Lyo Kato, C<lyo.kato at gmail.com>
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
diff -urN HTML-Widget-1.01.origin/lib/HTML/Widget/Filter/HTMLStrip.pm HTML-Widget-1.01/lib/HTML/Widget/Filter/HTMLStrip.pm
--- HTML-Widget-1.01.origin/lib/HTML/Widget/Filter/HTMLStrip.pm	1970-01-01 09:00:00.000000000 +0900
+++ HTML-Widget-1.01/lib/HTML/Widget/Filter/HTMLStrip.pm	2006-01-11 20:06:21.516190024 +0900
@@ -0,0 +1,46 @@
+package HTML::Widget::Filter::HTMLStrip;
+
+use warnings;
+use strict;
+use base 'HTML::Widget::Filter';
+use HTML::Scrubber;
+
+__PACKAGE__->mk_accessors(qw/allow/);
+
+=head1 NAME
+
+HTML::Widget::Filter::HTMLStrip - HTML Strip Filter
+
+=head1 SYNOPSIS
+
+    my $f = $widget->filter( 'HTMLStrip', 'foo' )->allow( 'br', 'a' );
+
+=head1 DESCRIPTION
+
+HTML Strip Filter.
+
+=head1 METHODS
+
+=head2 $self->filter($value)
+
+=cut
+
+sub filter {
+    my ( $self, $value ) = @_;
+    my $allowed  = $self->allow || [];
+    my $scrubber = HTML::Scrubber->new( allow => $allowed );
+    return $scrubber->scrub($value);
+}
+
+=head1 AUTHOR
+
+Lyo Kato, C<lyo.kato at gmail.com>
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
diff -urN HTML-Widget-1.01.origin/lib/HTML/Widget/Filter/LowerCase.pm HTML-Widget-1.01/lib/HTML/Widget/Filter/LowerCase.pm
--- HTML-Widget-1.01.origin/lib/HTML/Widget/Filter/LowerCase.pm	1970-01-01 09:00:00.000000000 +0900
+++ HTML-Widget-1.01/lib/HTML/Widget/Filter/LowerCase.pm	2006-01-11 20:46:25.120786584 +0900
@@ -0,0 +1,41 @@
+package HTML::Widget::Filter::LowerCase;
+
+use warnings;
+use strict;
+use base 'HTML::Widget::Filter';
+
+=head1 NAME
+
+HTML::Widget::Filter::LowerCase - Lower Case Filter
+
+=head1 SYNOPSIS
+
+    my $f = $widget->filter( 'LowerCase', 'foo' );
+
+=head1 DESCRIPTION
+
+Lower Case Filter.
+
+=head1 METHODS
+
+=head2 $self->filter($value)
+
+=cut
+
+sub filter {
+    my ( $self, $value ) = @_;
+    return lc $value;
+}
+
+=head1 AUTHOR
+
+Lyo Kato, C<lyo.kato at gmail.com>
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
diff -urN HTML-Widget-1.01.origin/lib/HTML/Widget/Filter/UpperCase.pm HTML-Widget-1.01/lib/HTML/Widget/Filter/UpperCase.pm
--- HTML-Widget-1.01.origin/lib/HTML/Widget/Filter/UpperCase.pm	1970-01-01 09:00:00.000000000 +0900
+++ HTML-Widget-1.01/lib/HTML/Widget/Filter/UpperCase.pm	2006-01-11 20:44:34.805557048 +0900
@@ -0,0 +1,41 @@
+package HTML::Widget::Filter::UpperCase;
+
+use warnings;
+use strict;
+use base 'HTML::Widget::Filter';
+
+=head1 NAME
+
+HTML::Widget::Filter::UpperCase - Upper Case Filter
+
+=head1 SYNOPSIS
+
+    my $f = $widget->filter( 'UpperCase', 'foo' );
+
+=head1 DESCRIPTION
+
+Upper Case Filter.
+
+=head1 METHODS
+
+=head2 $self->filter($value)
+
+=cut
+
+sub filter {
+    my ( $self, $value ) = @_;
+    return uc $value;
+}
+
+=head1 AUTHOR
+
+Lyo Kato, C<lyo.kato at gmail.com>
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;