• Your recent searches
ABNF-Grammar
10 results

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
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

META.json  view on Meta::CPAN 

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
   },
   "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"
}

META.yml  view on Meta::CPAN 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
---
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 

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
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/',
                },
        }
);

README  view on Meta::CPAN 

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
 
   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 

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
=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 

237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
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 

263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
=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 

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
no warnings "recursion";
 
use Data::Dumper;
use Readonly;
use List::Util qw(reduce);
 
use POSIX;
 
use base qw(https://metacpan.org/pod/ABNF::Generator">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 

60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
=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 

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
        };
}
 
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 

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
use warnings;
 
use Readonly;
use Data::Dumper;
use Carp;
 
use POSIX;
 
use base qw(https://metacpan.org/pod/ABNF::Generator">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 

60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
=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 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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 

60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
 
=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 

170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
=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 

329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
=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 

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
=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 

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
        };
 
        $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 1.211 second using v1.01-cache-2.11-cpan-e9199f4ba4c )