ABNF-Grammar

 view release on metacpan or  search on metacpan

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

method generate(Str $rule, Str $tail="") {
	croak "Unexisted command" unless $self->{_grammar}->hasCommand($rule);

	$self->{_cache}->{$rule} ||= [];
	unless ( @{$self->{_cache}->{$rule}} ) {
		$self->{_cache}->{$rule} = _asStrings( $self->_generateChain($rule, {level => 0}) );
	}
	my $result = pop($self->{_cache}->{$rule});
	
	my $rx = eval { qr/$tail$/ };
	croak "Bad tail" if $@;
	return $result =~ $rx ? $result : $result . $tail;
}

=pod

=head1 $generator->C<withoutArguments>($name, $tail="")

Return an strings starts like command $name and without arguments.

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

dies if there is no command like $rule.

=cut

method withoutArguments(Str $name, Str $tail="") {
	croak "Unexisted command" unless $self->{_grammar}->hasCommand($name);

	my ($prefix, $args) = splitRule( $self->{_grammar}->rule($name) );
	
	my $rx = eval { qr/$tail$/ };
	croak "Bad tail" if $@;
	return $prefix =~ $rx ? $prefix : $prefix . $tail;
}

=pod

=head1 $generator->C<hasCommand>($name)

Return 1 if there is a $name is command, 0 otherwise

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

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)

Return an string starts like command $name and length more then $ENDLESS = 513 * 1024 / 4

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

dies if there is no command like $rule.

=cut

method endlessCommand($name, Str $tail="") {
	croak "Unexisted commadn $name" unless $self->hasCommand($name);
	my $prefix = splitRule($self->{_grammar}->rule($name));
	my $result = $prefix . _stringRand($ACHARS, $ENDLESS);
	my $rx = eval { qr/$tail$/ };
	croak "Bad tail" if $@;
	return $result =~ $rx ? $result : $result . $tail;
}

=pod

=head1 FUNCTIONS

=head1 C<Liar>()

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

=head1 DESCRIPTION

=head1 METHODS

=cut

use 5.014;

use strict;
use warnings;
use re 'eval';

use Carp;
use Readonly;
use Method::Signatures;
use Data::Dumper;

use Parse::ABNF;

use ABNF::Grammar qw(splitRule $BASIC_RULES);

t/ABNF-Generator-Honest.t  view on Meta::CPAN

my $grammar = Grammar->new("t/data/test.abnf", qw(token pair expr noop minus));
$grammar->replaceBasicRule("CRLF", {
	class => "Rule",
	name => "CRLF",
	value => {
		class => "Literal",
		value => "\n"
	}
});
my $valid = Validator->new($grammar);
my $honest = eval { Honest->new($grammar, $valid) };

ok($honest, "Create Honest validator");

eval { $honest->generate("lol") };
ok($@, "Ok no rule");

for ( 1 .. 20 ) {
	my $str = $honest->generate("expr");
	1 while $str =~ s@[\+\-\*\/]\s\d+\s\d+@0@g;
	like($str, qr/^\d+$/, "Generated str is ok");
}

is($honest->withoutArguments("noop", "\n"), "noop\n", "Without arguments for noop");
is($honest->withoutArguments("minus", "\n"), "", "Without arguments for minus");

eval { $honest->withoutArguments("lol") };
ok($@, "Ok no rule");

t/ABNF-Generator-Liar.t  view on Meta::CPAN

use strict;
use warnings;

use Test::More tests => 29;
use ABNF::Grammar qw(Grammar);
use ABNF::Validator qw(Validator);
BEGIN {
	use_ok('ABNF::Generator::Liar', qw(Liar))
};
my $grammar = eval { Grammar->new("t/data/test.abnf", qw(token pair expr minus noop)) };
$grammar->replaceBasicRule("CRLF", {
	class => "Rule",
	name => "CRLF",
	value => {
		class => "Literal",
		value => "\n"
	}
});
my $valid = Validator->new($grammar);
my $liar = Liar->new($grammar, $valid);

ok($liar, "Create Liar validator");

eval { $liar->generate("lol") };
ok($@, "Ok no rule");

for ( 1 .. 20 ) {
	my $str = $liar->generate("minus");
	1 while $str =~ s@[\+\-\*\/]\s\d+\s\d+@0@g;
	unlike($str, qr/^\d+$/, "Generated str isn't ok");
}

is($liar->withoutArguments("noop", "\n"), "", "Without arguments for noop");
like($liar->withoutArguments("minus", "\n"), qr/^-\s*\n$/, "Without arguments for minus");

eval { $liar->withoutArguments("lol") };
ok($@, "Ok no rule");

ok(!$liar->hasCommand($liar->unExistedCommand()), "Ok unexisted command");

ok(length($liar->endlessCommand("minus", "\n")) > 1024, "Ok long rule");

eval { $liar->endlessCommand("noopasa", "\n") };
ok($@, "Ok no rule");

t/ABNF-Grammar.t  view on Meta::CPAN

use strict;
use warnings;

use Test::More tests => 14;
BEGIN { use_ok('ABNF::Grammar', qw(Grammar)) };

my $grammar = eval { Grammar->new("t/data/test.abnf", qw(token pair expr)) };
isa_ok(
	$grammar,
	"ABNF::Grammar",
	"Create test grammar"
);

ok(
	!eval {
		Grammar->new("t/data/test.abnf", qw(token pair expr lol))
	},
	"Cant create with unexisted command"
);

my $token = eval { $grammar->rule("expr") };
ok(
	$token,
	"Get token rule"
);

ok(
	!eval {
		eval { $grammar->rule("DIGIT") }
	},
	"Cant get unexisted rule"
);

ok(
   $grammar->rules(),
   "Get all rules"
);

ok(
	$grammar->hasCommand("expr"),
	"Is command on command good"
);

ok(
	!$grammar->hasCommand("lol"),
	"Is command on non-command bad"
);

eval{
	$grammar->replaceBasicRule("CRLF", {
		class => "Rule",
		name => "CRLF",
		value => {
			class => "Literal",
			value => "\n"
		}
	})
};

ok(!$@, "Ok replace");

eval{
	$grammar->replaceBasicRule("CRLF", {
		class => "Rule",
		name => "CRLFAA",
		value => {
			class => "Literal",
			value => "\n"
		}
	})
};

ok($@, "Cant replace with name != rule");

eval{
	$grammar->replaceBasicRule("CRLFAA", {
		class => "Rule",
		name => "CRLFAA",
		value => {
			class => "Literal",
			value => "\n"
		}
	})
};

ok($@, "Cant replace unexisted rule");

eval{
	$grammar->replaceRule("noop", {
		class => "Rule",
		name => "noop",
		value => {
			class => "Literal",
			value => "\n"
		}
	})
};

ok(!$@, "Ok replace");

eval{
	$grammar->replaceRule("noop", {
		class => "Rule",
		name => "noopaa",
		value => {
			class => "Literal",
			value => "\n"
		}
	})
};

ok($@, "Cant replace with name != rule");

eval{
	$grammar->replaceRule("noopaa", {
		class => "Rule",
		name => "noopaa",
		value => {
			class => "Literal",
			value => "\n"
		}
	})
};

t/ABNF-Validator.t  view on Meta::CPAN

my $grammar = Grammar->new("t/data/test.abnf", qw(token pair expr minus noop));
$grammar->replaceBasicRule("CRLF", {
	class => "Rule",
	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");