use strict; use warnings; use diagnostics; use HTML::TokeParser; use Data::Dumper; # variables my %rules; my $count; my $DEBUG = 1; # get filename of HTML form from commandline and open filehandle to it my $formfile = shift or die "Usage: perl $0 filename\n"; open (my $fh, '<', $formfile) or die "Trouble opening your file!\n$!"; my $parser = HTML::TokeParser->new($fh); while (my $token = $parser->get_tag(qw(input textarea select))) { $count++; my $tag = $token->[0]; my $type = $token->[1]{'type'};# or warn "$count-th Token ($tag tag) has no type!"; my $name = $token->[1]{'name'} or warn "$count-th Token ($tag tag) has no name!"; my $value = $token->[1]{'value'}; my $maxlength = $token->[1]{'maxlength'}; my $required = $token->[1]{'required'}; # non-w3c attribute my $allowed; if ($tag =~ m/select/i) { while (my $option = $parser->get_tag('option')) { push @{$allowed}, $option->[1]{'value'}; } } else { $allowed = [ $token->[1]{'allowed'} ]; # non-w3c attribute } $DEBUG && print "$count\t$tag\t$name\t$type\n"; # $rules{ $name } = sub { print $name, $/; return; }; $rules{$name} = { 'name' => $name, 'type' => $type, 'value' => $value, 'allowed' => $allowed, 'required' => $required, 'maxlength' => $maxlength }; } close $fh; if ($DEBUG and %rules) { open OUT, '>', "$formfile.rules.txt" or die $!; print OUT Dumper(\%rules); close OUT; } exit; ####

text 1:

textarea:

 radio1 option 1  radio1 option 2

check 1 option 1 check 1 option 2

list box:

text 2: