File Coverage

blib/lib/Parse/RandGen/CharClass.pm

Criterion	Covered	Total	%
statement	18	55	32.7
branch	3	24	12.5
condition	0	3	0.0
subroutine	6	9	66.6
pod	1	3	33.3
total	28	94	29.7

# $Revision: #5 $$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::CharClass;

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

sub _newDerived {
    my $self = shift or confess ("%Error:  Cannot call without a valid object!");
    my $type = ref($self);
    my $elem = $self->element();
    (ref($elem) eq "Regexp") or confess("%Error:  CharClass element is not a regular expression (\"$elem\")!  Must be a regular expression!");
    ($elem =~ m/(\(\?[imsx]*-?[imsx]*\:)+((\[\^?.+\])|\.)/ ) or confess("%Error:  CharClass element is malformed (\"$elem\")!  Must be a regular expression matching a single character of a character class (e.g. (?-imsx:[^a-f\n]).");
    $self->_buildCharset();
}

sub isQuantSupported { return 1; }

sub dump {
    my $self = shift or confess ("%Error:  Cannot call without a valid object!");
    return ($self->element().$self->quant());
}

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 %result = $self->pickRepetitions(%args);
    my $matchCnt = $result{matchCnt};
    my $badOne = $result{badOne};

    my $min; my $max;
    my $val = "";
    for (my $i=0; $i < $matchCnt; $i++) {
	if (defined($badOne) && ($i==$badOne)) {
	    $min = $self->{_charsetEndOffset};
	    $max = 256;
	} else {
	    $min = 0;
	    $max = $self->{_charsetEndOffset};
	}
	my $chrOffset = $min + int(rand($max-$min));
	$val .= substr($self->{_charset}, $chrOffset, 1);
    }
    my $elem = $self->element();
    if ($Debug) {
	print("Parse::RandGen::CharClass($elem)::pick(match=>$args{match}, matchCnt=>$matchCnt, badOne=>".(defined($badOne)?$badOne:"undef")
	      ." with value of ".$self->dumpVal($val)."\n");
    }
    return ($val);
}

sub _buildCharset {
    my $self = shift or confess ("%Error:  Cannot call without a valid object!");
    my $elem = $self->element();
    ($elem =~ /(\[\^?.+\])|\./) or confess("%Error:  CharClass element is malformed (\"$elem\")!  Must be a regular expression looking character class (e.g. [^a-f\n]).");

    my $reCharSet = qr/$elem/;
    my $strGood = "";
    my $strBad = "";
    foreach my $ord (0..255) {
	my $char = chr($ord);
	if ($char =~ $reCharSet) {
	    $strGood .= $char;
	} else {
	    $strBad .= $char;
	}
    }
    $self->{_charsetEndOffset} = length($strGood);
    $self->{_charset} = ($strGood . $strBad);
    my $len = length($self->{_charset});
    ($len == 256) or confess("Charset length is $len (all charsets should be 256 characters)!\n");
}

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