File Coverage

blib/lib/DBIx/MyParsePP/Rule.pm

Criterion	Covered	Total	%
statement	89	103	86.4
branch	37	46	80.4
condition	11	15	73.3
subroutine	15	20	75.0
pod	0	14	0.0
total	152	198	76.7

package DBIx::MyParsePP::Rule;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(MYPARSEPP_SHRINK_IDENTICAL MYPARSEPP_SHRINK_LEAFS MYPARSEPP_SHRINK_SINGLES MYPARSEPP_SHRINK_CHILDREN);

use strict;

1;

use constant RULE_NAME	=> 0;

use constant MYPARSEPP_SHRINK_IDENTICAL	=> 1;
use constant MYPARSEPP_SHRINK_LEAFS	=> 2;
use constant MYPARSEPP_SHRINK_SINGLES	=> 4;
use constant MYPARSEPP_SHRINK_CHILDREN	=> 8;

sub new {
	my $class = shift;
	my $rule = bless (\@_, $class);
	return $rule;
}

sub getName {
	return $_[0]->[RULE_NAME];
}

sub name {
	return $_[0]->[RULE_NAME];
}

sub children {
	my @rule = @{$_[0]};
	return @rule[1..$#rule];
}

sub getChildren {
	my @rule = @{$_[0]};
	return @rule[1..$#rule];
}

sub toString {
	my $rule = shift;

	if ($#{$rule} > -1) {
		return join('', map {
			$rule->[$_]->toString();
		} (1..$#{$rule}) );
	} else {
		return undef;
	}
}

sub shrink {
	my ($parent, $flags) = @_;

	$flags = MYPARSEPP_SHRINK_IDENTICAL | MYPARSEPP_SHRINK_LEAFS | MYPARSEPP_SHRINK_SINGLES | MYPARSEPP_SHRINK_CHILDREN if not defined $flags;

	if (($#{$parent} == 0) && ($flags & MYPARSEPP_SHRINK_LEAFS)) {
		return undef;
	} elsif (($#{$parent} == 1) && ($flags & MYPARSEPP_SHRINK_SINGLES)) {
		if ($flags & MYPARSEPP_SHRINK_CHILDREN) {
			return $parent->[1]->shrink($flags);
 		} else {
			return $parent->[1];
		}
	} elsif ($flags & MYPARSEPP_SHRINK_CHILDREN) {
		my @new_children;

		foreach my $i (1..$#{$parent}) {
			my $child = $parent->[$i]->shrink($flags);
			if (
				($flags & MYPARSEPP_SHRINK_IDENTICAL) &&
				(ref($child) eq 'DBIx::MyParsePP::Rule') &&
				($child->name() eq $parent->name())
			) {
				push @new_children, $child->children() if defined $child->children();
			} else {
				push @new_children, $child if defined $child;
			}
		}

		my $new_rule = DBIx::MyParsePP::Rule->new($parent->name(), @new_children);
		return $new_rule->shrink($flags & ~MYPARSEPP_SHRINK_CHILDREN);
	} else {
		return $parent;
	}
}


sub extractInner {
	my $rule = shift;
	return undef if ($#{$rule} == 0);

	my @matches;
	foreach my $i (1..$#{$rule}) {
		my $extract = $rule->[$i]->extract(@_);
		next if not defined $extract;
		if (ref($extract) eq 'ARRAY') {
			push @matches, @{$extract};
		} else {
			push @matches, $extract;
		}
	}

	if ($#matches == -1) {
		return undef;
	} elsif ($#matches == 0) {
		return $matches[0];
	} else {
		return \@matches;
	}
}

sub getFields {
	return $_[0]->extract('simple_ident_q','table_ident','ident');
}

sub fields {
	return $_[0]->getFields();
}

sub tables {
	return $_[0]->getTables();
}

sub getTables {
	my $rule = shift;

	my @tables_array;
	my %tables_hash;

	my $idents = $rule->extract('table_wild','table_ident','simple_ident_q');
	$idents = [$idents] if ref($idents) ne 'ARRAY';

	foreach my $ident (@{$idents}) {
		my $shrinked_ident = $ident->shrink();
		my @children = $shrinked_ident->children();

		my $table;

		if ($#children == -1) {			# No children
			$table = $shrinked_ident;
		} elsif ($#children == 0) {		# One child
			$table = $children[0];
		} elsif ($#children == 2) {
			if (
				($shrinked_ident->name() eq 'simple_ident_q') ||
				($shrinked_ident->name() eq 'table_wild')
			) {
				$table = $children[0];			# We have "database.table"
			} elsif ($shrinked_ident->name() eq 'table_ident') {
				$table = $children[2];			# We have "table.field"
			} else {
				print STDERR "Assertion: \$\#children == $#children but name() = ".$shrinked_ident->name()."\n";
				return undef;
			}
		} elsif ($#children == 4) {				# We have "database.table.field"
			$table = DBIx::MyParsePP::Rule->new( $ident->name(), @children[0..2] );
		} else {
			print STDERR "Assertion: \$\#children == $#children\n";
			return undef;
		}

		if (not exists $tables_hash{$table->toString()}) {
			push @tables_array, $table;
			$tables_hash{$table->toString()} = 1;
		}
	}

	return \@tables_array;

}

sub extract {
	my $rule = shift;
	foreach my $match (@_) {
		return $rule if ($rule->name() eq $match);
	}
	return $rule->extractInner(@_);
}

sub print {
	return $_[0]->toString();
}

1;

__END__