ABNF-Grammar

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

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 distribution
 view release on metacpan -  search on metacpan