ABNF-Grammar

 view release on metacpan or  search on metacpan

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

				}
		
				$begin = \@new_begin;
			}

			return $begin;
		}

		when ( "Choice" ) {
			return [
				map { @{_asStrings($_)} } @{$generated->{value}}
			];
		}

		default { die "Unknown class " . $generated->{class} . Dumper $generated }
	}
}

1;

=pod

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

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

method _string($rule, $recursion) {
	my $converter = $CONVERTERS->{$rule->{type}};
	return {
		class => "Atom",
		value => join("", map { chr($converter->($_)) } @{$rule->{value}})
	};
}

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;

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

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

=pod

=head1 ABNF::Generator::Liar->C<new>($grammar, $validator?)

Creates a new B<ABNF::Generator::Liar> object.

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

Read ABNF rules from file with $fname.

@commands consists of main command names for generation and validation.

=cut

method new(Str $fname, @commands) {

	my $class = ref($self) || $self;

	$self = {_commands => { map {$_ => 1} @commands} };

	bless($self, $class);


	open(my $file, $fname)
	or croak "Cant open $fname";

	my $content = join("", <$file>) . "\n";

	close($file)

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

Get ABNF rules from string $rule

@commands consists of main command names for generation and validation.

=cut

method fromString(Str $content, @commands) {

	my $class = ref($self) || $self;

	$self = {_commands => { map {$_ => 1} @commands} };

	bless($self, $class);

	$self->_init($content . "\n");

	foreach my $command ( @commands ) {
		croak "Grammar doesn't have command $command" unless exists($self->{_rules}->{$command});
	}

	return $self;

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

			}
		}

		\%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 {
		croak "Unknown substance " . Dumper($val);
	}
}


func _choice($val, $dent) {
    return "(?: " . join(' | ', map { _value($_ , $dent + 1) } @{$val->{value}}) . ")";
}

func _group($val, $dent) {
    return '(?: ' . _value($val->{value}, $dent + 1) . ' )';
}

func _reference($val, $dent) {
    return "<" . _fixRulename($val->{name}) . ">";
}

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

func _fixRulename($name) {
    $name =~ s/[-\W]/_/g;
    $name;
}

func _range($val, $dent) {
    my $ret = "";
    $ret .= '[';
    given ( $val->{type} ) {
		when ( 'hex' ) {
			$ret .= join('-', map { '\x{' . $_ . '}' } $val->{min}, $val->{max});
		}
		when ( 'binary' ) {
	        $ret .= join('-', map { sprintf('\\%o', oct("0b$_")) } $val->{min}, $val->{max});
	    }
		when ( 'decimal' ) {
			$ret .= join('-', map { sprintf('\\%o', $_) } $val->{min}, $val->{max});
		}
		default {
			croak "## Range type $val->{type}  $val->{value} \n";
		}
	}
    $ret .= "]";
    $ret;
}

func _string($val, $dent) {
    my $ret = "";
    given ( $val->{type} ) {
		when ( 'hex' ) {
		    $ret = join('', map { '\x' . $_ } @{$val->{value}});
		}
		when ( 'binary' ) {
			$ret .= join('', map { sprintf('\\%o', oct("0b$_")) } @{$val->{value}});
		}
		when ( 'decimal' ) {
			$ret .= join('', map { sprintf('\\%o', $_) } @{$val->{value}});
		}
		default {
			die "## String type $val->{type}  $val->{value} \n";
		}
#~         warn "##",  map({ "$_ ( $val->{$_} ) " } sort keys %$val ), "\n";
    }
#~     " $ret ";
    $ret;
}

func _literal($val, $dent) {
    return quotemeta($val->{value});
}

func _proseValue($val, $dent) {