ABNF-Grammar
view release on metacpan or search on metacpan
Revision history for Perl extension ABNF::Grammar.
0.08 Sat Jun 16 12:55:35 2013
- removed recursion increment in Honest repetition
- removed debug output
0.07 Sat Jun 16 12:55:35 2013
- better recursion control in Honest generator in case of repetition or choice
0.06 Fri Jun 15 00:00:26 2013
- fixed dependence from Method::Signatures
0.05 Fri Jun 14 23:47:51 2013
- fixed dependence from Method::Signatures
0.04 Fri Jun 14 23:47:51 2013
- added files to MANIFEST
0.03 Fri Jun 14 23:31:51 2013
- minor changes about pod again
- added Regexp::Grammars dependence
0.02 Fri Jun 14 22:14:15 2013
- minor changes about mail and pod
},
"name" : "ABNF-Grammar",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : 0
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : 0
}
},
"runtime" : {
"requires" : {
"Method::Signatures" : 0,
"Parse::ABNF" : "0.05",
"Readonly" : "1.03",
"Regexp::Grammars" : "1.028",
"Storable" : "2.39",
"perl" : "5.014"
}
}
},
"release_status" : "stable",
"resources" : {
"license" : [
"http://dev.perl.org/licenses/"
]
},
"version" : "0.08"
}
---
abstract: 'Validator and generator module for ABNF grammars'
author:
- 'Arseny Krasikov <nyaapa@cpan.org>'
build_requires:
ExtUtils::MakeMaker: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.112621'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: ABNF-Grammar
no_index:
directory:
- t
- inc
requires:
Method::Signatures: 0
Parse::ABNF: 0.05
Readonly: 1.03
Regexp::Grammars: 1.028
Storable: 2.39
perl: 5.014
resources:
license: http://dev.perl.org/licenses/
version: 0.08
Makefile.PL view on Meta::CPAN
WriteMakefile(
NAME => 'ABNF::Grammar',
DISTNAME => "ABNF-Grammar",
AUTHOR => 'Arseny Krasikov <nyaapa@cpan.org>',
LICENSE => 'perl_5',
VERSION_FROM => 'lib/ABNF/Grammar.pm', # finds $VERSION
ABSTRACT => 'Validator and generator module for ABNF grammars',
PREREQ_PM => {
'Parse::ABNF' => "0.05",
'Storable' => "2.39",
'Method::Signatures' => 0,
'Regexp::Grammars' => "1.028",
'Readonly' => "1.03",
},
META_MERGE => {
requires => { perl => '5.014' },
resources => {
license => 'http://dev.perl.org/licenses/',
},
}
);
perl Makefile.PL
make
make test
make install
DEPENDENCIES
* Parse::ABNF => 0.05;
* Storable => 2.39;
* Method::Signatures => 20130505;
* Readonly => 1.03;
* perl >= 5.014.
BUG REPORTS
Please report bugs in this module via <nyaapa@cpan.org>
AUTHOR / COPYRIGHT / LICENSE
Copyright (c) 2013 Arseny Krasikov <nyaapa@cpan.org>.
lib/ABNF/Generator.pm view on Meta::CPAN
=cut
use 5.014;
use strict;
use warnings;
no warnings "recursion";
use Carp;
use Readonly;
use Method::Signatures;
use Data::Dumper;
use Parse::ABNF;
use List::Util qw(shuffle);
use ABNF::Grammar qw($BASIC_RULES splitRule);
use ABNF::Validator;
use base qw(Exporter);
our @EXPORT_OK = qw($CONVERTERS $BASIC_RULES $RECURSION_LIMIT);
lib/ABNF/Generator.pm view on Meta::CPAN
at init it have only one key -- level == 0.
You can create new object perl call or use one.
See use example in ABNF::Generator::Honest in method _choice
=cut
method _generateChain($rule, $recursion) {
my @result = ();
if ( ref($rule) ) {
croak "Bad rule " . Dumper($rule) unless UNIVERSAL::isa($rule, "HASH");
} elsif ( exists($BASIC_RULES->{$rule}) ) {
$rule = $BASIC_RULES->{$rule};
} else {
$rule = $self->{_grammar}->rule($rule);
}
$self->{handlers}->{ $rule->{class} }
lib/ABNF/Generator.pm view on Meta::CPAN
=pod
=head1 $generator->C<generate>($rule, $tail="")
Generates one sequence string for command $rule.
Using cache $self->{_cache}->{$rule} for this rule, that speeds up this call.
$rule is a command name.
$tail is a string added to result if it absent.
dies if there is no command like $rule.
=cut
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.
$tail is a string added to a result.
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) );
lib/ABNF/Generator/Honest.pm view on Meta::CPAN
no warnings "recursion";
use Data::Dumper;
use Readonly;
use List::Util qw(reduce);
use POSIX;
use base qw(ABNF::Generator Exporter);
use Method::Signatures; #some bug in B<Devel::Declare>...
use ABNF::Generator qw($CONVERTERS);
our @EXPORT_OK = qw(Honest);
our $RECURSION_LIMIT = 16;
=pod
=head1 ABNF::Generator::Honest->C<new>($grammar, $validator?)
lib/ABNF/Generator/Honest.pm view on Meta::CPAN
=pod
=head1 $honest->C<generate>($rule, $tail="")
Generates one valid sequence string for command $rule.
Using cache $self->{_cache}->{$rule} for this rule, that speeds up this call.
$rule is a command name.
$tail is a string added to result if it absent.
dies if there is no command like $rule.
=cut
method _range($rule, $recursion) {
my $converter = $CONVERTERS->{$rule->{type}};
my $min = $converter->($rule->{min});
my $max = $converter->($rule->{max});
return {class => "Atom", value => chr($min + int(rand($max - $min + 1)))};
lib/ABNF/Generator/Honest.pm view on Meta::CPAN
};
}
method _literal($rule, $recursion) {
return {class => "Atom", value => $rule->{value}};
}
method _repetition($rule, $recursion) {
my $min = $rule->{min};
my $count = ($rule->{max} || LONG_MAX) - $min;
my @result = ();
push(@result, $self->_generateChain($rule->{value}, $recursion)) while $min--;
if ( $recursion->{level} < $RECURSION_LIMIT ) {
push(@result, $self->_generateChain($rule->{value}, $recursion)) while $count-- && int(rand(2));
}
return {class => "Sequence", value => \@result};
}
method _proseValue($rule, $recursion) {
return $self->_generateChain($rule->{name}, $recursion);
}
method _reference($rule, $recursion) {
return $self->_generateChain($rule->{name}, $recursion);
}
method _group($rule, $recursion) {
my @result = ();
foreach my $elem ( @{$rule->{value}} ) {
push(@result, $self->_generateChain($elem, $recursion));
}
return {class => "Sequence", value => \@result};
}
method _choice($rule, $recursion) {
$recursion->{level}++;
my @result = ();
if ( $recursion->{level} < $RECURSION_LIMIT ) {
foreach my $choice ( @{$rule->{value}} ) {
push(@result, $self->_generateChain($choice, $recursion));
}
} else {
$recursion->{choices} ||= {};
my $candidate = reduce {
if ( not exists($recursion->{choices}->{$a}) ) {
$b
} elsif ( not exists($recursion->{choices}->{$b}) ) {
$a
} else {
$recursion->{choices}->{$a} <=> $recursion->{choices}->{$b}
}
} @{$rule->{value}};
$recursion->{choices}->{$candidate}++;
push(@result, $self->_generateChain( $candidate, $recursion));
$recursion->{choices}->{$candidate}--;
}
$recursion->{level}--;
return {class => "Choice", value => \@result};
}
method _rule($rule, $recursion) {
return $self->_generateChain($rule->{value}, $recursion);
}
=pod
=head1 $honest->C<withoutArguments>($name, $tail="")
Return a string starts like command $name and without arguments if command may have no arguments.
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
use warnings;
use Readonly;
use Data::Dumper;
use Carp;
use POSIX;
use base qw(ABNF::Generator Exporter);
use Method::Signatures; #some bug in B<Devel::Declare>...
use ABNF::Grammar qw(splitRule $BASIC_RULES);
Readonly my $STRING_LEN => 20;
Readonly my $CHARS => [map { chr($_) } (0 .. 0x0D - 1), (0x0D + 1 .. 255)];
Readonly my $ACHARS => [('A'..'Z', 'a'..'z')];
Readonly our $ENDLESS => 513 * 1024 / 4; # 513 kB of chars
our @EXPORT_OK = qw(Liar);
lib/ABNF/Generator/Liar.pm view on Meta::CPAN
=pod
=head1 $liar->C<generate>($rule, $tail="")
Generates one invalid sequence string for command $rule.
Using cache $self->{_cache}->{$rule} for this rule, that speeds up this call.
$rule is a command name.
$tail is a string added to result if it absent.
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]);
}
return join("", @gen);
}
=pod
=head1 $liar->C<withoutArguments>($name, $tail="")
Return a string starts like command $name and without arguments if it possible.
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)
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>()
Return __PACKAGE__ to reduce class name :3
lib/ABNF/Grammar.pm view on Meta::CPAN
package ABNF::Grammar;
=pod
=head1 NAME
B<ABNF-Grammar> - validator and generator for ABNF grammars.
B<ABNF::Grammar> - class for inner representation ABNF-grammar.
=head1 VERSION
This document describes B<ABNF::Grammar> version 0.08
=head1 SYNOPSIS
use ABNF::Grammar qw(Grammar);
use ABNF::Generator qw(asStrings);
lib/ABNF/Grammar.pm view on Meta::CPAN
=cut
use 5.014;
use strict;
use warnings;
use Carp;
use Readonly;
use Method::Signatures;
use Data::Dumper;
use Parse::ABNF;
use Storable qw(dclone);
use base "Exporter";
our @EXPORT_OK = qw(splitRule Grammar $BASIC_RULES);
our $VERSION = "0.08";
Readonly our $BASIC_RULES => do {
my $res = {};
foreach my $rule ( @{$Parse::ABNF::CoreRules} ) {
die "Multiple definitions for $rule->{name}" if exists($res->{$rule->{name}});
$res->{$rule->{name}} = $rule;
}
$res;
};
=pod
=head1 ABNF::Grammar->C<new>($fname, @commands)
Creates a new B<ABNF::Grammar> object.
Read ABNF rules from file with $fname.
lib/ABNF/Grammar.pm view on Meta::CPAN
=pod
=head1 $grammar->C<rule>($name)
Return rule form $name with name $name.
Result structure is identical to B<Parse::ABNF> structure.
For debug only.
Do not modify result structure.
=cut
method rule(Str $name) {
croak "Unexisted rule $name" unless exists($self->{_rules}->{$name});
$self->{_rules}->{$name};
}
=pod
=head1 $grammar->C<rules>()
Return all rules.
Result structures is identical to B<Parse::ABNF> structure.
For debug only.
Do not modify result structure.
=cut
method rules() {
$self->{_rules};
}
=pod
=head1 $grammar->C<replaceRule>($rule, $value)
lib/ABNF/Grammar.pm view on Meta::CPAN
=head1 DEPENDENCIES
=over 4
=item B<Parse::ABNF>
=item B<Regexp::Grammars>
=item B<Storable>
=item B<Method::Signatures>
=item B<Readonly>
=item B<perl 5.014>
=back
=head1 BUG REPORTS
Please report bugs in this module via <nyaapa@cpan.org>
lib/ABNF/Validator.pm view on Meta::CPAN
=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);
use base qw(Exporter);
our @EXPORT_OK = qw(Validator);
lib/ABNF/Validator.pm view on Meta::CPAN
};
$self->{_rules} = _value([
values($self->{_grammar}->rules()),
values($BASIC_RULES)
]);
$self->{_regexps} = do {
use Regexp::Grammars;
my %res = ();
foreach my $token ( @$commands ) {
# command
my $str = "
#<logfile: /dev/null>
^ <" . _fixRulename($token) . "> \$
$self->{_rules}
";
$res{$token} = qr{$str }ixs;
# arguments
my $value = $self->{_grammar}->rule($token);
my $name = _fixRulename($ARGUMENTS_RULES . $token);
my $rule = {class => "Rule", name => $name};
my $val = (splitRule($value))[-1];
if ( $value->{value} != $val ) {
$rule->{value} = $val;
my $converted = _value($rule);
$res{$name} = qr{
^ <$name> $
$converted
$self->{_rules}
}xis;
}
}
\%res;
};
}
func _value($val, $dent = 0) {
if ( UNIVERSAL::isa($val, 'ARRAY') ) {
return join('', map { _value($_ , $dent) } @$val);
} elsif ( UNIVERSAL::isa($val, 'HASH') && exists($CLASS_MAP->{ $val->{class} }) ) {
return $CLASS_MAP->{ $val->{class} }->($val, $dent);
} else {
( run in 0.298 second using v1.01-cache-2.11-cpan-e9199f4ba4c )