view release on metacpan or  search on metacpan

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} }
	or die "Unknown class " . $rule->{class};

	return $self->{handlers}->{ $rule->{class} }->($self, $rule, $recursion);
}

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

=cut

method hasCommand(Str $name) {
	$self->{_grammar}->hasCommand($name);
}

=pod

=head1 FUNCTIONS

=head1 C<_asStrings>($generated)

Return stringification of genereted sequences from C<_generateChain>.

Uses in generate call to stringify chains.

=cut

func _asStrings($generated) {
	given ( $generated->{class} ) {
		when ( "Atom" ) { return [ $generated->{value} ] }

		when ( "Sequence" ) {
			my $value = $generated->{value};
			return [] unless @$value;

			my $begin = _asStrings($value->[0]);

			for ( my $pos = 1; $pos < @$value; $pos++ ) {
				my @new_begin = ();
				my $ends = _asStrings($value->[$pos]);
				next unless @$ends;

				my @ibegin = splice([shuffle(@$begin)], 0, $CHOICE_LIMIT);
				my @iends = splice([shuffle(@$ends)], 0, $CHOICE_LIMIT);
				foreach my $end ( @iends ) {
					foreach my $begin ( @ibegin ) {