#!/usr/bin/env perl

use strict;
use warnings;

my $success = 1;

sub read_exceptions($)
{
    my ($file) = @_;
    my %exceptions = ();
    open(EXCEPTIONS,"<$file") ||
	die("unable to open exceptions file $file for reading");
    while(<EXCEPTIONS>)
    {
	s/[\012\015]*$//;
        s/\#.*$//;
        s/ *$//;
        if (/^CODE\s+([a-zA-Z0-9]+)\s+(\d+)/)
        {
            $exceptions{$1} = {
                TYPE => 'SYMBOL_CODE',
                SYMBOL => $1,
                CODE => $2
                };
        }
        elsif (/^CATEGORY\s+([a-z0-9_]+)\s+(.*)$/)
        {
            $exceptions{$1} = {
                TYPE => 'CATEGORY_NAME',
                CATEGORY => $1,
                NAME => $2
                };
        }
        else
        {
            die("unable to parse exception: $_");
        }
    }
    close(EXCEPTIONS);
    return \%exceptions;
}

sub descs_match($$)
{
    my ($a, $b) = @_;
    foreach my $category 
        (grep(exists($a->{CATEGORIES}{$_}),keys(%{$b->{CATEGORIES}})))
    {
        my @a = sort(@{$a->{CATEGORIES}{$category}});
        my @b = sort(@{$b->{CATEGORIES}{$category}});
        return 0 if (@a != @b);
        while (@a)
        {
            my $a_desc = shift(@a);
            my $b_desc = shift(@b);
            $a_desc =~ tr/A-Z/a-z/;
            $b_desc =~ tr/A-Z/a-z/;
            return 0 if ($a_desc ne $b_desc);
        }
    }
    return 1;
}

sub errors_match($$)
{
    my ($a, $b) = @_;
    return 0 if ($a->{CLEAN_CODE} != $b->{CLEAN_CODE});
    return descs_match($a,$b);
}

sub record_error($$$$@)
{
    my ($errors, $category, $symbol, $code, @descs) = @_;
    return if (!defined($symbol));
    my $clean_code = $code;
    if ($clean_code =~ /^(\d+)L$/)
    {
        $clean_code = $1;
        $clean_code = ($clean_code & 0xFFFF)
            if ($clean_code > 0xFFFF);
        $clean_code = -(($clean_code ^ 0xFFFF) + 1)
            if ($clean_code > 0x8000);
        $clean_code *= -1;
    }
    if ($clean_code =~ /^0x[a-fA-F0-9]+$/)
    {
	$clean_code = hex($clean_code);
        $clean_code = ($clean_code & 0xFFFF)
            if ($clean_code > 0xFFFF);
        $clean_code = -(($clean_code ^ 0xFFFF) + 1)
            if ($clean_code > 0x8000);
        $clean_code *= -1;
    }
    if ($clean_code =~ /[a-zA-Z]/)
    {
	die("$symbol refers to unknown symbol $code")
	    if (!exists($errors->{$code}));
	if (@descs == 0)
	{
	    @descs = ("See $code");
	}
	elsif (@descs == 1)
	{
	    @descs = ("See $code ($descs[0])");
	}
	else
	{
	    die("referenced symbol has multiple descriptions");
	}
	$clean_code = $errors->{$code}{CLEAN_CODE};
	$code = $errors->{$code}{CODE};
    }
    if ($clean_code > 0xFFFF)
    {
        $clean_code = ($clean_code & 0xFFFF)
            if ($clean_code > 0xFFFF);
        $clean_code = -(($clean_code ^ 0xFFFF) + 1)
            if ($clean_code > 0x8000);
    }
    $category = '' if (!defined($category));
    my $new_error = {
	CATEGORIES => { $category => \@descs },
	SYMBOL => $symbol,
	CLEAN_CODE => $clean_code,
	CODE => $code,
	};
    if (!exists($errors->{$symbol}))
    {
	$errors->{$symbol} = $new_error;
    }
    elsif (errors_match($errors->{$symbol},$new_error))
    {
        $errors->{$symbol}{CATEGORIES}{$category} = \@descs;
    }
    else
    {
        $errors->{$symbol}{CATEGORIES}{$category} = []
            if (!defined($errors->{$symbol}{CATEGORIES}{$category}));
        my $descs = $errors->{$symbol}{CATEGORIES}{$category};
	my %new_descs = map(($_ => 1,),@descs,@{$descs});
	@{$descs} = keys(%new_descs);
    }
}

sub read_errors($$)
{
    my ($file, $exceptions) = @_;
    open(ERRORS,"<$file") ||
	die("unable to open error file $file for reading");
    my %errors = ();
    my %categories = ();
    my $category = undef;
    my $symbol = undef;
    my $code = undef;
    my @descs = ();
  LINE:
    while(<ERRORS>)
    {
	s/[\012\015]*$//;
	s/ *$//;
        my ($indent, $data) = (/^(\s*)(.*)$/);
        $indent = length($indent);
        if ($indent == 0)
        {
	    record_error(\%errors,$category,$symbol,$code,@descs);
	    $symbol = undef;
            my $name = $data;
            $name =~ s/ mgr / Manager /gi;
            $category = $name;
            $category =~ s/ result codes$//i;
            $category =~ s/ error codes$//i;
            $category =~ s/ errors$//i;
            $category =~ tr/A-Z /a-z_/;
            my $url = undef;
            if ($category eq 'result_codes')
            {
                $url = <ERRORS>;
		$url =~ s/[\012\015]*$//;
                die("FATAL ERROR: untitled error category with no URL")
                    if ($url !~ /^  http/);
                $url =~ s/^  //;
                $category = $url;
                $category =~ s/\/[^\/]*$//;
                $category =~ s/^.*\///;
                $category =~ tr/A-Z/a-z/;
                if (!exists($exceptions->{$category}) ||
                    $exceptions->{$category}{TYPE} ne 'CATEGORY_NAME')
                {
                    print STDERR "Untitled error category needs title\n";
                    print STDERR "Add line of the following form to the exception file:\n";
                    print STDERR "CATEGORY $category Category Name Result Codes\n\n";
		    $exceptions->{$category}{NAME} = 'DUMMY CATEGORY NAME';
		    $success = 0;
                }
                $name = $exceptions->{$category}{NAME};
                $category = $name;
                $category =~ s/ result codes$//i;
                $category =~ s/ error codes$//i;
                $category =~ s/ errors$//i;
                $category =~ tr/A-Z /a-z_/;
            }
            if (exists($categories{$category}) &&
                $categories{$category}{NAME} ne $name)
            {
                if (!exists($exceptions->{$category}) ||
                    $exceptions->{$category}{TYPE} ne 'CATEGORY_NAME')
                {
                    print STDERR "Similar categories: $name and $categories{$category}{NAME}\n";
                    print STDERR "Add one of the following lines to the exception file:\n";
                    print STDERR "CATEGORY $category $name\n";
                    print STDERR "CATEGORY $category $categories{$category}{NAME}\n\n";
		    $exceptions->{$category}{NAME} = 'DUMMY CATEGORY NAME';
		    $success = 0;
                }
                $name = $exceptions->{$category}{NAME};
            }
            $categories{$category} = {
                NAME => $name,
                SORT => $category,
                URL => $url
            };
        }
        elsif ($indent == 2)
        {
            if ($data =~ /^http/)
            {
                die("multiple category URL's") 
                    if (defined($categories{$category}{URL}));
                $categories{$category}{URL} = $data;
            }
            elsif (defined($categories{$category}{DESC}))
            {
                print STDERR "Multiple category descriptions:\n";
                print STDERR "$categories{$category}{DESC}\n";
		print STDERR "$data\n\n";
		die;
            }
            else
            {
                $categories{$category}{DESC} = $data;
            }
        }
        elsif ($indent == 4)
        {
	    record_error(\%errors,$category,$symbol,$code,@descs);
            ($symbol, $code) = ($data =~ /^([^ ]+) ([^ ]+)$/);
	    @descs = ();
	}
        else
        {
	    push(@descs,$data);
	}
    }
    record_error(\%errors,$category,$symbol,$code,@descs);
    close(ERRORS);
    return ([map($errors{$_},keys(%errors))],
            [map($categories{$_},keys(%categories))]);
}

sub add_errors($$$)
{
    my ($errors, $new_errors, $exceptions) = @_;
    foreach my $new_error (@{$new_errors})
    {
        my $symbol = $new_error->{SYMBOL};
        if (!exists($errors->{$symbol}))
        {
            $errors->{$symbol} = $new_error;
            next;
        }

        my $old_error = $errors->{$new_error->{SYMBOL}};
        if ($old_error->{CLEAN_CODE} != $new_error->{CLEAN_CODE} &&
            exists($exceptions->{$symbol}) &&
            $exceptions->{$symbol}{TYPE} eq 'SYMBOL_CODE')
        {
            $old_error->{CLEAN_CODE}  = $exceptions->{$symbol}{CODE};
            $new_error->{CLEAN_CODE}  = $exceptions->{$symbol}{CODE};
        }

        if (errors_match($old_error,$new_error))
        {
            foreach my $category (keys(%{$new_error->{CATEGORIES}}))
            {
                next if (defined($old_error->{CATEGORIES}{$category}));
                $old_error->{CATEGORIES}{$category} =
                    $new_error->{CATEGORIES}{$category};
            }
            next;
        }

        if ($old_error->{CLEAN_CODE} != $new_error->{CLEAN_CODE})
        {
            print STDERR "Code Mismatch\n";
            print STDERR "Add one of the following lines to the exceptions file:\n";
            print STDERR "CODE $old_error->{SYMBOL} $old_error->{CODE}\n";
            print STDERR "CODE $old_error->{SYMBOL} $new_error->{CODE}\n\n";
	    $success = 0;
	    $old_error->{CLEAN_CODE} = $new_error->{CLEAN_CODE};
	    $old_error->{CODE} = $new_error->{CODE};
        }

        if ($old_error->{CODE} eq $new_error->{CODE})
        {
            foreach my $category (keys(%{$new_error->{CATEGORIES}}))
            {
		my %descs = map(($_ => 1),
				@{$old_error->{CATEGORIES}{$category}},
				@{$new_error->{CATEGORIES}{$category}});
		$old_error->{CATEGORIES}{$category} = [keys(%descs)];
            }
            next;
        }

        die("FATAL ERROR: inconsistent errors");
    }
}

sub add_categories($$$)
{
    my ($categories, $new_categories, $exceptions) = @_;
    foreach my $category (@{$new_categories})
    {
        my $sort = $category->{SORT};
        if (!exists($categories->{$sort}))
        {
            $categories->{$sort} = $category;
            next;
        }
        
        my $old_category = $categories->{$sort};
	if (defined($old_category->{URL}) &&
	    defined($category->{URL}) &&
	    $old_category->{URL} ne $category->{URL})
	{
	    print STDERR "conflicting category URL's for $category->{SORT}:\n";
	    print STDERR "$old_category->{URL}\n";
	    print STDERR "$category->{URL}\n\n";
	    die;
	}
	if (defined($old_category->{DESC}) &&
	    defined($category->{DESC}) &&
	    $old_category->{DESC} ne $category->{DESC})
	{
	    print STDERR "conflicting category descriptionss for $category->{SORT}:\n";
	    print STDERR "$old_category->{DESC}\n";
	    print STDERR "$category->{DESC}\n\n";
	    die;
	}
        if (defined($old_category->{NAME}) &&
            defined($category->{NAME}) &&
            $old_category->{NAME} ne $category->{NAME})
        {
            if (!exists($exceptions->{$sort}) ||
                $exceptions->{$sort}{TYPE} ne 'CATEGORY_NAME')
            {
                print STDERR "Similar categories: $old_category->{NAME} and $category->{NAME}\n";
                print STDERR "Add one of the following lines to the exception file:\n";
                print STDERR "CATEGORY $sort $old_category->{NAME}\n";
                print STDERR "CATEGORY $sort $category->{NAME}\n\n";
		$exceptions->{$sort}{NAME} = 'DUMMY CATEGORY NAME';
		$success = 0;
            }
            $old_category->{NAME} = $exceptions->{$sort}{NAME};
        }
    }
}

sub main(@)
{
    my ($exceptions_file, @files) = @_;

    print STDERR "Reading exceptions...\n";
    my $exceptions = read_exceptions($exceptions_file);

    my %categories = ( '' => { NAME => undef, SORT => '', URL => undef } );
    my %errors = ();
    foreach my $file (@files)
    {
	print STDERR "Reading $file...\n";
	my ($new_errors, $new_categories) = read_errors($file,$exceptions);
	add_errors(\%errors,$new_errors,$exceptions);
        add_categories(\%categories,$new_categories,$exceptions);
    }
    

    foreach my $category (sort { 
        $categories{$a}{SORT} cmp $categories{$b}{SORT}
        } keys(%categories))
    {
        my $data = $categories{$category};
        my @errors = 
            sort(grep(exists($errors{$_}{CATEGORIES}{$category}),keys(%errors)));
        my $title = $categories{$category}{NAME} || "No Category";
        my $desc = $data->{DESC} || '';
        my $url ||= $data->{URL} || '';
        print "$title\n";
        print "  $desc\n";
        print "  $url\n";
        foreach my $error (@errors)
        {
	    my @descs = @{$errors{$error}{CATEGORIES}{$category}};
	    @descs = ('No description available.')
		if (!@descs);
            print "    $errors{$error}{SYMBOL} $errors{$error}{CODE}\n".
		join('',map("      $_\n",sort(@descs)));
        }
    }

    return $success;
}

exit(main(@ARGV)?0:1);