#!/usr/bin/perl
# Mooix::Thing;
use warnings;
use strict;

# In this method, expressions are represented by array references,
# with the parts of the expression in order.
use constant { 
	ACTION => 0,
	OBJECT => 1,
	METHOD => 2,
	TYPE => 3,
	FIELD => 4,
};

sub stringexp {
	my $exp=shift;
	return join(" ", @$exp);
}

# Checks to see if the first expression catches everything that could be
# matched by the second expression.
sub superset {
	my $a=$_[0];
	my $b=$_[1];
	return (($a->[METHOD] eq '*' || $a->[METHOD] eq $b->[METHOD]) &&
	        ($a->[TYPE]   eq '*' || $a->[TYPE]   eq $b->[TYPE]) &&
	        ($a->[FIELD]  eq '*' || $a->[FIELD]  eq $b->[FIELD]) &&
	        ((! ref $a->[OBJECT] && $a->[OBJECT] eq '*') ||
		 (ref $b->[OBJECT] && ref $a->[OBJECT] &&
		  $a->[OBJECT] == $b->[OBJECT])));
}

# Compares two expressions.
sub equivilant {
	return stringexp(shift) eq stringexp(shift);
}

# Adds an expression to the top of the passed list. Then
# goes through the list and finds expressions that are invalidated by
# the new expression. For example, adding a skip * * * * would invalidate
# all other expressions. Returns the new list.
#
# XXX Find a better algo, please? This one does not even
# find them all, and it's sloow.
sub addexp {
	my $exp=shift;
	my @list=@_;

	my @new=$exp;
	for (my $x = 0; $x < @list; $x++) {
		my $ok=1;
		for (my $y = 0; $y < @new; $y++) {
			if (superset($new[$y], $list[$x])) {
				$ok=0;
				last;
			}
		}
		if ($ok) {
			push @new, $list[$x];
		}
	}

	return @new;
}

# Compares contents of two lists, returns true if they are the same.
sub listeq {
	my @a=@{shift()};
	my @b=@{shift()};
	
	return unless @a == @b;
	for (my $x = 0; $x < @a; $x++) {
		return unless equivilant($a[$x], $b[$x]);
	}
	return 1;
}

run sub {
	my $this=shift;
	%_=@_;

	# Create the new expression.
	my $newexp=[
		$_{action},
		(ref $_{object} ? $_{object} : "*"),
		(length $_{method} ? $_{method} : "*"),
		(length $_{type} ? $_{type} : "*"),
		(length $_{field} ? $_{field} : "*"),
	];
	
	# Parse expressions, and partition out the breakpoints.
	# Each expression is parsed to an array.
	my @breakpoints;
	my @expressions;
	foreach ($this->expressions) {
		my @l=split(' ', $_, 5);
		my $o=Mooix::Thing->get($l[OBJECT]);
		if (ref $o) {
			$l[OBJECT] = $o;
		}
		if ($l[ACTION] eq 'breakpoint') {
			push @breakpoints, \@l;
		}
		else {
			push @expressions, \@l;
		}
	}
	
	if ($newexp->[ACTION] eq 'skip' || $newexp->[ACTION] eq 'trace') {
		my @new=addexp($newexp, @expressions);
		return 0 if listeq(\@new, \@expressions);
		@expressions=@new;
	}
	elsif ($newexp->[ACTION] eq 'breakpoint') {
		my @new=addexp($newexp, @breakpoints);
		return 0 if listeq(\@new, \@breakpoints);
		@breakpoints=@new;
	}
	elsif ($newexp->[ACTION] eq 'clear') {
		# Unlike skip, clearing a breakpoint just removes any
		# matching fully breakpoints. It does not modify existing
		# breakpoints as skip effectively does with traces.
		my @new;
		my $changed=0;
		foreach my $e (@breakpoints) {
			if (! superset($newexp, $e)) {
				push @new, $e;	
			}
			else {
				$changed=1;
			}
		}
		return 0 unless $changed;
		@breakpoints=@new;
	}
	else {
		$this->croak("bad action type: ".$newexp->[ACTION]);
	}
	
	# Write expressions field back out.
	my @e;
	foreach my $expression (@breakpoints, @expressions) {
		push @e, stringexp($expression);
	}
	$this->expressions(@e);

	return 1;
}
