File Coverage

blib/lib/Parse/RandGen/Subrule.pm

Criterion	Covered	Total	%
statement	38	52	73.0
branch	14	32	43.7
condition	6	9	66.6
subroutine	9	12	75.0
pod	4	7	57.1
total	71	112	63.3

# $Revision: #4 $$Date: 2005/08/31 $$Author: jd150722 $
######################################################################
#
# This program is Copyright 2003-2005 by Jeff Dutton.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of either the GNU General Public License or the
# Perl Artistic License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# If you do not have a copy of the GNU General Public License write to
# the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
# MA 02139, USA.
######################################################################

package Parse::RandGen::Subrule;

require 5.006_001;
use Carp;
use Parse::RandGen qw($Debug);
use strict;
use vars qw(@ISA $Debug);
@ISA = ('Parse::RandGen::Condition');

sub _newDerived {  }   # Nothing to do

sub isSubrule { return 1; }
sub isTerminal { return 0; }
sub isQuantSupported { return 1; }

sub subrule {
    my $self = shift or confess ("%Error:  Cannot call without a valid object!");
    my $subrule = $self->element();
    if (ref($subrule)) {
	UNIVERSAL::isa($subrule, "Parse::RandGen::Rule") or confess("subrule() contains a reference ($subrule), but it is not a Rule!");
	return($subrule);
    } else {
	defined($self->grammar()) or confess ("%Error:  Parse::RandGen::Subrule::subrule() called, but the \"$subrule\" rule cannot be found, because grammar() is undef!");
	return($self->grammar()->rule($subrule));
    }
}

sub dump {
    my $self = shift or confess ("%Error:  Cannot call without a valid object!");
    my $subrule = $self->element();
    if (ref($subrule)) {
	return ($subrule->dumpHeir() . $self->quant());
    } else {
	# Named non-reference rule
	my $output = $subrule;
	if (defined($self->max()) && ($self->min() == $self->max())) {
	    $output .= "(" . $self->min() . ")" unless ($self->min() == 1);
	} else {
	    my $max = defined($self->max()) ? $self->max() : "";
	    $output .= "(" . $self->min() . ".." . $max . ")";
	}
	return $output;
    }
}

sub pick {
    my $self = shift or confess ("%Error:  Cannot call without a valid object!");
    my %args = ( match=>1, # Default is to pick matching data
		 @_ );
    my $rule = $self->subrule();
    my $ruleName = $self->element();
    defined($rule) or confess("Subrule::pick():  $ruleName subrule cannot be found in the grammar!\n");

    my %result = $self->pickRepetitions(%args);
    my $matchCnt = $result{matchCnt};
    my $badOne = $result{badOne};

    my $val = "";
    for (my $i=0; $i<$matchCnt; $i++) {
	my $matchThis = (defined($badOne) && ($i==$badOne))?0:1;  # Only don't match for corrupted data
	my $specifiedVals = ($matchThis && ($i==($matchCnt-1))) ? $args{vals} : { }; # Only specify rules for last capture value
	$val .= $rule->pick(%args, match=>$matchThis, vals => $specifiedVals);
    }
    if ($Debug) {
	print("Parse::RandGen::Subrule::pick(match=>$args{match}, matchCnt=>$matchCnt, badOne=>".(defined($badOne)?$badOne:"undef")
	      .") on the rule \"".$rule->dumpHeir()."\" has a value of ".$self->dumpVal($val)."\n");
    }
    return ($val);
}

# Returns true (1) if this subrule contains any of the rules specified by the "vals" argument
sub containsVals {
    my $self = shift or confess("%Error:  Cannot call without a valid object!");
    my %args = ( vals => { },   # Hash of values of various hard-coded sub-rules (by name)
		 @_ );
    return $self->subrule()->containsVals(%args);
}

######################################################################
#### Package return
1;
__END__