ABNF-Grammar
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
use ABNF::Generator qw(asStrings);
use ABNF::Generator::Honest qw(Honest);
use ABNF::Generator::Liar qw(Liar);
use ABNF::Validator qw(Validator);
my $grammar = Grammar->new("smtp.bnf", qw(ehlo helo mail rcpt data rset vrfy noop quit data data-terminate));
my $valid = Validator->new($grammar);
my $liar = Liar->new($grammar, $valid);
my $honest = Honest->new($grammar, $valid);
$valid->validate("vrfy", "string");
my @strings = $liar->withoutArguments("vrfy");
my $string = $liar->unExistedCommand("vrfy");
my $string = $liar->endlessCommand("vrfy");
my $string = $liar->generate("helo");
my $string = $honest->generate("helo");
lib/ABNF/Generator/Honest.pm view on Meta::CPAN
Return an empty string otherwise.
$tail is a string added to result if it absent.
dies if there is no command like $rule.
=cut
method withoutArguments(Str $name, Str $tail="") {
my $result = $self->SUPER::withoutArguments($name, $tail);
return $self->{_validator}->validate($name, $result) ? $result : "";
}
=pod
=head1 FUNCTIONS
=head1 C<Honest>()
Return __PACKAGE__ to reduce class name :3
lib/ABNF/Generator/Liar.pm view on Meta::CPAN
dies if there is no command like $rule.
=cut
method _rule($rule, $recursion) {
my $result = "";
if ( my $prefix = splitRule($rule) ) {
do {
$result = _stringRand($ACHARS);
} while $self->{_validator}->validateArguments($rule->{name}, $result);
$result = $prefix . $result;
} else {
do {
$result = _stringRand($ACHARS);
} while $self->{_validator}->validate($rule->{name}, $result);
}
return {class => "Atom", value => $result};
}
func _stringRand($chars, $len?) {
$len ||= rand($STRING_LEN) + 1;
my @gen = ();
for ( my $i = 0; $i < $len; $i++ ) {
push(@gen, @$chars[rand @$chars]);
t/ABNF-Validator.t view on Meta::CPAN
name => "CRLF",
value => {
class => "Literal",
value => "\n"
}
});
my $valid = eval { Validator->new($grammar) };
ok($valid, "Create new object on ABNF::Grammar");
ok($valid->validate("noop", "noop\n"), "Ok noop");
ok($valid->validate("expr", "- 1 5"), "Ok valid");
ok(!$valid->validate("expr", "1 + 5"), "Ok invalid");
eval { $valid->validate("lol", "1 + 5") };
ok($@, "Ok no rule");
ok($valid->validateArguments("minus", "1 5"), "Ok valid arguments");
ok(!$valid->validateArguments("minus", "1 + 5"), "Ok invalid arguments");
eval { $valid->validateArguments("lol", "1 + 5") };
ok($@, "Ok no rule");
ok($valid->validateCommand("expr"), "Ok command");
ok(!$valid->validateCommand("lol"), "Ok not a command");
view all matches for this distributionview release on metacpan - search on metacpan
( run in 1.264 second using v1.00-cache-2.02-grep-82fe00e-cpan-20ab987cc5d )