#!/usr/bin/perl -w

use strict;

sub kill_empty_tail(@) {
	# Ignore space at end of line;
	my $last = pop @_;
	if ($last ne '') {
		push @_, $last; # Oops, add it back.
	}
	return @_;
}

my %masseurs = (
	'plain' => sub {},
	'bae' => sub {
		if ($_[1] =~ m/^(\s*\/\'[\w-]+\'\/)(\s+)(.*)(;.*)/) {
			my ($net, $space, $pinlist, $trailing) = ($1, $2, $3, $4);
			my @pins = sort {
				# Sort pinlist with same comparison as gnetlist core uses.
				"$a=$b" =~ m/^(\w+)\.(\w+)=(\w+)\.(\w+)$/;
				"$1-$2" cmp "$3-$4";
			} split /=/, $pinlist;
			$_[1] = "$net$space" . join('=', @pins) . "$trailing";
		}
	},
	'calay' => sub {
		if ($_[1] =~ m/^(\/[\w-]+)(\s+)(.*)(;.*)/) {
			my ($net, $space, $pinlist, $trailing) = ($1, $2, $3, $4);
			my @pins = sort {
				# Sort pinlist with same comparison as gnetlist core uses.
				"$a $b" =~ m/^(\w+)\((\w+)\) (\w+)\((\w+)\)$/;
				"$1-$2" cmp "$3-$4";
			} split /\s+/, $pinlist;
			$_[1] = "$net$space" . join(' ', @pins) . "$trailing";
		}
	},
	'drc2' => sub {
		if ($_[1] =~ m/^(ERROR:\s*Pin[^:]*:\s*)(.*)/) {
			my ($pintype, $pinlist) = ($1, $2);
			my @pins = sort {
				# Sort pinlist with same comparison as gnetlist core uses.
				"$a $b" =~ m/^(\w+):(\w+) (\w+):(\w+)$/;
				"$1-$2" cmp "$3-$4";
			} split /\s+/, $pinlist;
			@pins = kill_empty_tail(@pins);
			$_[1] = $pintype . join(' ', @pins);
		} elsif ($_[1] =~ m/^(\s*to pin[^:]*:\s*)(.*)/) {
			my ($pintype, $pinlist) = ($1, $2);
			my @pins = sort {
				# Sort pinlist with same comparison as gnetlist core uses.
				"$a $b" =~ m/^(\w+):(\w+) (\w+):(\w+)$/;
				"$1-$2" cmp "$3-$4";
			} split /\s+/, $pinlist;
			@pins = kill_empty_tail(@pins);
			$_[1] = $pintype . join(' ', @pins);
		}
	},
	'geda' => sub {
		if ($_[1] =~ m/^([\w-]+\s+:\s*)(.*)/) {
			my ($net, $pinlist) = ($1, $2);
			my @pins = sort {
				# Sort pinlist with same comparison as gnetlist core uses.
				"$a,$b" =~ m/^(\w+)\s+(\w+)\s*,(\w+)\s+(\w+)\s*$/ or die "$a !! $b";
				"$1-$2" cmp "$3-$4";
			} split /,\s*/, $pinlist;
			foreach (@pins) {
				s/\s*$//;
			}
			$_[1] = $net . join(' ', @pins);
		}
	},
	'mathematica' => sub {
		$_[1] =~ s/\};$/,/;
		if ($_[1] =~ m/^(.+)==(.+)$/) {
			my ($lhs, $rhs) = ($1, $2);
			foreach ($lhs, $rhs) {
				$_ = join '+', sort { $a cmp $b } split /\+/, $_;
			}
			$_[1] = "$lhs==$rhs";
		}
	},
	'maxascii' => sub {
		if ($_[1] =~ m/^(\*NET\s+"[\w-]*"\s+)(.*)/) {
			my ($net, $pinlist) = ($1, $2);
			my @pins = sort {
				# Sort pinlist with same comparison as gnetlist core uses.
				"$a $b" =~ m/^(\w+)\."(\w+)" (\w+)\."(\w+)"$/;
				"$1-$2" cmp "$3-$4";
			} kill_empty_tail split /\s+/, $pinlist;
			$_[1] = $net . join(' ', @pins);
		}
	},
	'osmond' => sub {
		if ($_[1] =~ m/^(\s*\{\s*)([^\}]*)(\}.*)/) {
			my ($leading, $pinlist, $trailing) = ($1, $2, $3);
			# osmond pinlist is in gnetlist core format, no need to fix sort.
			my @pins = sort { $a cmp $b } kill_empty_tail split /\s+/, $pinlist;
			$_[1] = "$leading" . join(' ', @pins) . "$trailing";
		}
	},
	'pads' => sub {
		if ($_[1] =~ m/[\w]+\.[\w]+/) {
			$_[1] = join ' ', sort { $a cmp $b; } split /\s+/, $_[1];
		}
	},
	'PCB' => sub {
		if ($_[1] =~ m/^([\w]+)(\s+)(.*)/) {
			my ($net, $space, $pinlist) = ($1, $2, $3);
			# PCB pinlist is in gnetlist core format, no need to fix sort.
			my @pins = sort { $a cmp $b } split /\s+/, $pinlist;
			# Ignore space at end of line;
			my $last = pop @pins;
			if ($last ne '') {
				push @pins, $last; # Oops, add it back.
			}
			$_[1] = "$net$space" . join(' ', @pins);
		}
	},
	'redac' => sub {
		if ($_[1] =~ m/^((?:\s*[\w-]*\s+\w+)*)/) {
			my $pinlist = $1;
			my @tokens = split /\s+/, $pinlist;
			my @pins;
			while (my @pin = splice @tokens, 0, 2) {
				push @pins, "$pin[0] $pin[1]";
			}
			$_[1] = join ' ', sort {
				# Sort pinlist with same comparison as gnetlist core uses.
				"$a $b" =~ m/^(\w+) (\w+) (\w+) (\w+)$/;
				"$1-$2" cmp "$3-$4";
			} @pins
		}
	},
);

my $mode = shift @ARGV;
my (@added, @deleted);

if (!exists($masseurs{$mode})) {
	print STDERR "no diff processor for $mode\n";
	exit 1;
}

my $hunk = 0;
while (<>) {
	if ($hunk && m/^[ +\-]/) {
		if (m/^\+(.*)/s) {
			push @added, [$., $1];
		} elsif (m/^\-(.*)/s) {
			push @deleted, [$., $1];
		}
	} elsif (m/^\@\@/) {
		$hunk = 1;
	} else {
		$hunk = 0;
	}
}

if (@added != @deleted) {
	printf "%d lines added but %d lines deleted\n", scalar(@added), scalar(@deleted);
	exit 1;
}

foreach (@added, @deleted) {
	chomp $_->[1];
	$masseurs{$mode}->(@$_);
	print STDERR "@$_\n";
}

# Ignore differences in the order of lines.
@added = sort { $a->[1] cmp $b->[1] } @added;
@deleted = sort { $a->[1] cmp $b->[1] } @deleted;

# The sorted list of additions and deletions should be identical.
for (my $i = 0; $i < @added; $i++) {
	if ($added[$i]->[1] ne $deleted[$i]->[1]) {
		print "diff contains unbalanced additions or deletions\n";
		print "added line $added[$i]->[0]:\n";
		print "<<$added[$i]->[1]>>\n";
		print "deleted line $deleted[$i]->[0]:\n";
		print "<<$deleted[$i]->[1]>>\n";
		exit 1;
	}
}

print "all changes are balanced\n";
exit 0;