Permalink
Browse files

initial commit

  • Loading branch information...
0 parents commit fd7fd012a1edaa5b3f34cd3bc71bbada8be6cbf9 @kentaro committed Nov 1, 2011
11 .gitignore
@@ -0,0 +1,11 @@
+Makefile
+inc/
+.c
+ppport.h
+*.sw[po]
+*.bak
+*.old
+Build
+_build/
+xshelper.h
+tags
2 .shipit
@@ -0,0 +1,2 @@
+steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN
+git.push_to=origin
4 Changes
@@ -0,0 +1,4 @@
+Revision history for Perl extension HTML5::ValidationRules
+
+0.01 Tue Nov 1 12:54:19 2011
+ - original version
27 MANIFEST.SKIP
@@ -0,0 +1,27 @@
+^\.git/
+\bRCS\b
+\bCVS\b
+^MANIFEST\.
+^Makefile$
+~$
+^#
+\.old$
+^blib/
+^pm_to_blib
+^MakeMaker-\d
+\.gz$
+\.cvsignore
+^t/perlcritic
+^tools/
+\.svn/
+^[^/]+\.yaml$
+^[^/]+\.pl$
+^\.shipit$
+\.sw[po]$
+^Build$
+^ppport.h$
+^xshelper.h$
+cover_db
+nytprof
+perltidy.ERR$
+^tags$
21 Makefile.PL
@@ -0,0 +1,21 @@
+use inc::Module::Install;
+use Module::Install::AuthorTests;
+use Module::Install::ReadmeMarkdownFromPod;
+
+name 'HTML5-ValidationRules';
+all_from 'lib/HTML5/ValidationRules.pm';
+readme_markdown_from 'lib/HTML5/ValidationRules.pm';
+
+# requires '';
+# requires 'Exporter' => 5.63; # use Exporter 'import';
+# requires 'Plack' => 0.9949;
+
+
+
+tests 't/*.t t/*/*.t t/*/*/*.t t/*/*/*/*.t';
+test_requires 'Test::More' => 0.96; # done_testing, subtest
+# test_requires 'Test::Requires';
+author_tests('xt');
+# test_requires 'YAML'; # required for use_test_base.
+# use_test_base;
+WriteAll;
24 README.mkdn
@@ -0,0 +1,24 @@
+# NAME
+
+HTML5::ValidationRules -
+
+# SYNOPSIS
+
+ use HTML5::ValidationRules;
+
+# DESCRIPTION
+
+HTML5::ValidationRules is
+
+# AUTHOR
+
+Kentaro Kuribayashi <kentarok@gmail.com>
+
+# SEE ALSO
+
+# LICENSE
+
+Copyright (C) Kentaro Kuribayashi
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
22 lib/FormValidator/Simple/Plugin/HTML5.pm
@@ -0,0 +1,22 @@
+package FormValidator::Simple::Plugin::HTML5;
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use FormValidator::Simple::Constants;
+
+sub HTML5_URL {
+ my ($self, $params, $args) = @_;
+ $self->HTTP_URL($params, $args);
+}
+
+sub HTML5_EMAIL { SUCCESS }
+sub HTML5_NUMBER { SUCCESS }
+sub HTML5_RANGE { SUCCESS }
+sub HTML5_MAXLENGTH { SUCCESS }
+sub HTML5_MAX { SUCCESS }
+sub HTML5_MIN { SUCCESS }
+sub HTML5_REQUIRED { SUCCESS }
+
+!!1;
56 lib/HTML5/ValidationRules.pm
@@ -0,0 +1,56 @@
+package HTML5::ValidationRules;
+use 5.008001;
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use HTML5::ValidationRules::Parser;
+
+sub new {
+ my ($class, %args) = @_;
+ bless \%args, $class;
+}
+
+sub parser {
+ my ($self) = @_;
+ $self->{parser} ||= HTML5::ValidationRules::Parser->new(%$self);
+}
+
+sub load_rules {
+ my ($self, %args) = @_;
+ $self->parser->load_rules(%args);
+}
+
+!!1;
+
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+HTML5::ValidationRules -
+
+=head1 SYNOPSIS
+
+ use HTML5::ValidationRules;
+
+=head1 DESCRIPTION
+
+HTML5::ValidationRules is
+
+=head1 AUTHOR
+
+Kentaro Kuribayashi E<lt>kentarok@gmail.comE<gt>
+
+=head1 SEE ALSO
+
+=head1 LICENSE
+
+Copyright (C) Kentaro Kuribayashi
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
133 lib/HTML5/ValidationRules/Parser.pm
@@ -0,0 +1,133 @@
+package HTML5::ValidationRules::Parser;
+use strict;
+use warnings;
+use autodie;
+use HTML::Parser;
+
+my %ELEMENTS = (
+ input => [qw(
+ max
+ maxlength
+ min
+ pattern
+ required
+ ), {
+ name => 'type',
+ values => [
+ {
+ name => 'url',
+ content_attrs => [qw(maxlength pattern required)],
+ },
+ {
+ name => 'email',
+ content_attrs => [qw(maxlength pattern required)],
+ },
+ {
+ name => 'number',
+ content_attrs => [qw(max min required)],
+ },
+ {
+ name => 'range',
+ content_attrs => [qw(max min required)],
+ },
+ ],
+ }],
+
+ textarea => [qw(
+ maxlength
+ required
+ )],
+);
+
+my $ELEMENTS_PATTERN = qr/(@{[join '|', (map { quotemeta } keys %ELEMENTS)]})/o;
+my %ATTRS_MAP = map {
+ my $attr = ref $_ ? $_->{name} : $_;
+ $attr => +{ map { $_ => 1 } @{$ELEMENTS{$_}} };
+} keys %ELEMENTS;
+my %TYPE_ATTR_MAP = map {
+ my $attr = $_;
+ map { $_->{name} => $_->{content_attrs} } @{$attr->{values}};
+} grep { ref $_ && $_->{name} eq 'type' } @{$ELEMENTS{input}};
+
+sub new {
+ my ($class, %args) = @_;
+ bless \%args, $class;
+}
+
+sub parser {
+ my ($self) = @_;
+ $self->{parser} ||= HTML::Parser->new(
+ api_version => 3,
+ start_h => [\&start, 'self, tagname, attr, attrseq'],
+ %{$self->{options} || {}},
+ );
+}
+
+sub load_rules {
+ my ($self, %args) = @_;
+ my $file = delete $args{file};
+ my $html = delete $args{html};
+
+ undef $self->parser->{rules};
+
+ if ($file) {
+ $self->parser->parse_file($file);
+ }
+ else {
+ $self->parser->parse($html);
+ $self->eof;
+ }
+
+ $self->parser->{rules};
+}
+
+sub start {
+ my ($parser, $tag, $attr, $attrseq) = @_;
+ return if $tag !~ $ELEMENTS_PATTERN;
+
+ my $name = $attr->{name};
+ return if !defined $name;
+
+ my @rules;
+ my $attrs = $ATTRS_MAP{lc $tag};
+
+ # specific types (eg. url, email, etc)
+ if (my $content_attrs = $TYPE_ATTR_MAP{$attr->{type} || ''}) {
+ my $type = $attr->{type};
+
+ for my $content_attr (@{$content_attrs || []}) {
+ next if !exists $attr->{$content_attr};
+
+ my $value = $attr->{$content_attr};
+
+ if (defined $value && $content_attr ne $value) {
+ push @rules, [ 'HTML5_' . uc $content_attr => $value ];
+ }
+ elsif ($content_attr eq $value) {
+ push @rules, 'HTML5_' . uc $content_attr;
+ }
+ }
+
+ unshift @rules, 'HTML5_' . uc $type;
+ }
+
+ # general types (eg. text, checkbox, etc)
+ else {
+ for my $key (@{$attrseq || []}) {
+ next if !$attrs->{$key};
+
+ my $value = $attr->{$key};
+ if (defined $value && $key ne $value) {
+ push @rules, [ 'HTML5_' . uc $key => $value ];
+ }
+ elsif ($key eq $value) {
+ push @rules, 'HTML5_' . uc $key;
+ }
+ }
+ }
+
+ $parser->{rules} ||= [];
+ push @{$parser->{rules}}, $name => \@rules;
+}
+
+!!1;
7 t/00_compile.t
@@ -0,0 +1,7 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok 'HTML5::ValidationRules';
+ use_ok 'HTML5::ValidationRules::Parser';
+}
20 t/01_basic.t
@@ -0,0 +1,20 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Name::FromLine;
+
+use HTML5::ValidationRules;
+
+my $parser = HTML5::ValidationRules->new;
+my $rules = $parser->load_rules(file => 't/data/form.html');
+
+is_deeply $rules, {
+ text => [[ maxlength => 255 ]],
+ url => [ url => [ maxlength => 255 ], 'required'],
+ email => [ email => [ maxlength => 255 ], 'required'],
+ number => [ number => [ max => 800 ], [ min => 200 ]],
+ range => [ range => [ max => 80 ], [ min => 20 ]],
+ textarea => [[ maxlength => 1000 ], 'required'],
+};
+
+done_testing;
20 t/02_parser.t
@@ -0,0 +1,20 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Name::FromLine;
+
+use HTML5::ValidationRules::Parser;
+
+my $parser = HTML5::ValidationRules::Parser->new;
+my $rules = $parser->load_rules(file => 't/data/form.html');
+
+is_deeply $rules, {
+ text => [[ maxlength => 255 ]],
+ url => [ url => [ maxlength => 255 ], 'required'],
+ email => [ email => [ maxlength => 255 ], 'required'],
+ number => [ number => [ max => 800 ], [ min => 200 ]],
+ range => [ range => [ max => 80 ], [ min => 20 ]],
+ textarea => [[ maxlength => 1000 ], 'required'],
+};
+
+done_testing;
19 t/03_formvalidator_simple.t
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Name::FromLine;
+
+use CGI;
+use FormValidator::Simple qw(HTML5);
+
+use HTML5::ValidationRules;
+
+my $parser = HTML5::ValidationRules->new;
+my $rules = $parser->load_rules(file => 't/data/form.html');
+my $query = CGI->new;
+ $query->param(url => 'http://example.com/');
+
+my $result = FormValidator::Simple->check($query => $rules);
+ok $result->valid('url');
+
+done_testing;
17 t/data/form.html
@@ -0,0 +1,17 @@
+<!doctype html>
+<html>
+ <head>
+ <meta charset="UTF-8">
+ <title>HTML5::ValidationRules</title>
+ </head>
+ <body>
+ <form>
+ <input type="text" name="text" maxlength="255" data-foo="foo" />
+ <input type="url" name="url" maxlength="255" required />
+ <input type="email" name="email" maxlength="255" required="required" />
+ <input type="number" name="number" min="200" max="800" />
+ <input type="range" name="range" min="20" max="80" />
+ <textarea name="textarea" maxlength="1000" required></textarea>
+ </form>
+ </body>
+</html>
36 xt/01_podspell.t
@@ -0,0 +1,36 @@
+use Test::More;
+eval q{ use Test::Spelling };
+plan skip_all => "Test::Spelling is not installed." if $@;
+add_stopwords(map { split /[\s\:\-]/ } <DATA>);
+$ENV{LANG} = 'C';
+all_pod_files_spelling_ok('lib');
+__DATA__
+Kentaro Kuribayashi
+HTML5::ValidationRules
+tokuhirom
+AAJKLFJEF
+GMAIL
+COM
+Tatsuhiko
+Miyagawa
+Kazuhiro
+Osawa
+lestrrat
+typester
+cho45
+charsbar
+coji
+clouder
+gunyarakun
+hio_d
+hirose31
+ikebe
+kan
+kazeburo
+daisuke
+maki
+TODO
+API
+URL
+URI
+db
5 xt/02_perlcritic.t
@@ -0,0 +1,5 @@
+use strict;
+use Test::More;
+eval { use Test::Perl::Critic -profile => 'xt/perlcriticrc' };
+plan skip_all => "Test::Perl::Critic is not installed." if $@;
+all_critic_ok('lib');
4 xt/03_pod.t
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
6 xt/perlcriticrc
@@ -0,0 +1,6 @@
+[TestingAndDebugging::ProhibitNoStrict]
+allow=refs
+[-Subroutines::ProhibitSubroutinePrototypes]
+[-Subroutines::ProhibitExplicitReturnUndef]
+[TestingAndDebugging::RequireUseStrict]
+equivalent_modules = perl5i::2

0 comments on commit fd7fd01

Please sign in to comment.