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]);

lib/ABNF/Generator/Liar.pm  view on Meta::CPAN

Return an empty string if command may have no arguments.

$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 $liar->C<unExistedCommand>()

Return an string starts with char sequence that doesn't match any command

$tail is a string added to result if it absent.

dies if there is no command like $rule.

=cut

method unExistedCommand(Str $tail="") {
	my $result = "";
	do {
		$result = _stringRand($ACHARS);
	} while $self->{_validator}->validateCommand($result);

	my $rx = eval { qr/$tail$/ };
	croak "Bad tail" if $@;
	return $result =~ $rx ? $result : $result . $tail;
}

=pod

=head1 $liar->C<endlessCommand>($name)

lib/ABNF/Grammar.pm  view on Meta::CPAN

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/Grammar.pm  view on Meta::CPAN

L<http://www.ietf.org/rfc/rfc5234.txt>

=item * Abnf parser

L<Parse::ABNF>

=item * Validator base

L<Regexp::Grammars>

=item * Cool guy from monks with idea how to validate

L<http://www.perlmonks.org/?node_id=957506>

=back

=head1 AUTHOR / COPYRIGHT / LICENSE

Copyright (c) 2013 Arseny Krasikov <nyaapa@cpan.org>.

This module is licensed under the same terms as Perl itself.

lib/ABNF/Validator.pm  view on Meta::CPAN

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

=head1 $validator->C<validateCommand>($command)

Return 1 if there exists command like $command and 0 otherwise

=cut

method validateCommand($command) {
	return $command =~ $self->{_commandsPattern};
}

=pod

=head1 $validator->C<hasCommand>($command)

Return 1 if there exists command like $command and 0 otherwise

=cut

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");