ABNF-Grammar
view release on metacpan or search on metacpan
lib/ABNF/Validator.pm view on Meta::CPAN
func _choice($val, $dent) {
return "(?: " . join(' | ', map { _value($_ , $dent + 1) } @{$val->{value}}) . ")";
}
func _group($val, $dent) {
return '(?: ' . _value($val->{value}, $dent + 1) . ' )';
}
func _reference($val, $dent) {
return "<" . _fixRulename($val->{name}) . ">";
}
func _repetition($val, $dent) {
no warnings 'uninitialized';
my %maxMin = (
# max min
"1 0" => '?',
" 0" => '*',
" 1" => '+',
);
if ( my $mm = $maxMin{"$val->{max} $val->{min}"} ) {
return " (?: " . _value($val->{value}, $dent + 1) . " )$mm ";
} elsif( $val->{min} == $val->{max} ){
return " (?: ". _value($val->{value}, $dent + 1) . " ){$val->{max}} ";
} else {
return " (?: " . _value($val->{value}, $dent+1) . " ){$val->{min}, $val->{max}} ";
}
}
func _rule($val, $dent) {
my $ret = "";
my $name = $val->{name};
if ( 'ws' eq lc($name) ) {
warn "Changing rule ws to token to avoid 'infinitely recursive unpleasantness.'\n";
$ret .= "<rule: ws>\n "; # may be token
} else {
$ret .= "<token: " . _fixRulename($val->{name}) . ">\n ";
}
$ret .= _value($val->{value}, $dent + 1);
$ret . "\n\n";
}
#~ @{[_fixRulename($$v{name})]}
func _fixRulename($name) {
$name =~ s/[-\W]/_/g;
$name;
}
func _range($val, $dent) {
my $ret = "";
$ret .= '[';
given ( $val->{type} ) {
when ( 'hex' ) {
$ret .= join('-', map { '\x{' . $_ . '}' } $val->{min}, $val->{max});
}
when ( 'binary' ) {
$ret .= join('-', map { sprintf('\\%o', oct("0b$_")) } $val->{min}, $val->{max});
}
when ( 'decimal' ) {
$ret .= join('-', map { sprintf('\\%o', $_) } $val->{min}, $val->{max});
}
default {
croak "## Range type $val->{type} $val->{value} \n";
}
}
$ret .= "]";
$ret;
}
func _string($val, $dent) {
my $ret = "";
given ( $val->{type} ) {
when ( 'hex' ) {
$ret = join('', map { '\x' . $_ } @{$val->{value}});
}
when ( 'binary' ) {
$ret .= join('', map { sprintf('\\%o', oct("0b$_")) } @{$val->{value}});
}
when ( 'decimal' ) {
$ret .= join('', map { sprintf('\\%o', $_) } @{$val->{value}});
}
default {
die "## String type $val->{type} $val->{value} \n";
}
#~ warn "##", map({ "$_ ( $val->{$_} ) " } sort keys %$val ), "\n";
}
#~ " $ret ";
$ret;
}
func _literal($val, $dent) {
return quotemeta($val->{value});
}
func _proseValue($val, $dent) {
return "<" . _fixRulename($val->{value}) . ">";
}
=pod
=head1 $validator->C<validate>($rule, $string)
Return 1 if $string matches $rule and 0 otherwise.
$rule is rulename.
$string is arguments string.
dies if there is no command like $rule.
=cut
method validate(Str $rule, Str $string) {
croak "Unexisted command $rule" unless exists($self->{_regexps}->{$rule});
scalar($string =~ $self->{_regexps}->{$rule});
}
=pod
=head1 $validator->C<validateArguments>($rule, $string)
Return 1 if $string matches arguments rules form $rule and 0 otherwise.
$rule is rulename.
$string is arguments string.
dies if there is no command like $rule.
=cut
method validateArguments($rule, $string) {
croak "Unexisted command $rule" unless exists($self->{_regexps}->{$rule});
my $args = _fixRulename($ARGUMENTS_RULES . $rule);
scalar(exists($self->{_regexps}->{$args}) && ($string =~ $self->{_regexps}->{$args}));
}
=pod
( run in 2.842 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )