#       encmp - compare two associative arrays
#               'syntax sugar' is removed before comparing!
#
# Copyright (c) 1993, 1994, 1995, 1996, 1997, 1998, 1999 by RIPE NCC
#
# All Rights Reserved
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation, and that the name of the author not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission.
#
# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#
# $Id: encmp.pl,v 2.9 1999/10/06 16:41:07 marek Exp $
#
#	$RCSfile: encmp.pl,v $
#	$Revision: 2.9 $
#	$Author: marek $
#	$Date: 1999/10/06 16:41:07 $
#
#	This routine takes two objects and compares them case insensitive
#	Returns 1 if objects are equal, else returns 0;
#
#       Arguments:
#	*this, *that		two pointers to assoc arrays
#       @what                   list of attributes to exclude from comparison


sub encmp {

    local(*this, *that, $what, $ignorewhitespace)=@_;
    
    local($a,$b);
    local(@syntacticsugar)=();
    local($atype)=&entype(%this);

    my @what = split(/ /, $what);

    # check if types are different

#    &dpr("First object =", join("*", %this), "\n");
#    &dpr("Second object =", join("*", %that), "\n");
    &dpr("\@what=", join(" ", @what), "\n");
    &dpr("Ignoring whitespace...\n") if ($ignorewhitespace);

    return 0 if ($atype ne &entype(%that));

    # check every attribute line by line...
    # but do the difficult cases last.

    my(@compareattrs) = split(/\s+/, $OBJATSQ{$atype});
    my(%excludeattrs) = undef;
    grep($excludeattrs{$_}++, @what); 

    foreach (@compareattrs) {
        
        $a=$this{$_};
	$b=$that{$_};
        
	next if ($excludeattrs{$_});

	&dpr("Comparing $_: *$a* *$b*\n");

	if ($ignorewhitespace) {
	    $a =~ s/\s+/ /g;
	    $b =~ s/\s+/ /g;
	}        

	# we need to do quite a bit of work for comparing attributes
	# that might have syntactic sugar so let's store these attributes 
	# and process them last!

        if (/^a[eio]|i[to]$/) {
           
           # optimize a bit
	   
	   return 0 if (((!$a) && ($b)) || ((!$b) && ($a)));
           
           # keep the values for later checking
           
           push(@syntacticsugar,$_,$a,$b);
           
        }
	else {
	   
	   $a=~ tr/A-Z/a-z/;
	   $b=~ tr/A-Z/a-z/;
	   
	   return 0 if ($a ne $b);
	   
	}
	
    }
    
    #
    # and finally do the attributes that might contain syntactic sugar
    
    local($key);
    local($match)='\S+\s+\S+\s+\S+';
    
    #    
    # we are going to do multi line matching 
    
    local($*)=1;
    
    while ($key=shift(@syntacticsugar)) {
        
        $a=shift(@syntacticsugar);
	$b=shift(@syntacticsugar);
        
	$a=~ tr/A-Z/a-z/;
	$b=~ tr/A-Z/a-z/;
	
	# print STDERR "-$a-$b-";
	
	# we do a compare after the syntactic sugar has been removed.

        if ($key eq "ae") {
 	   $a=~ s/(^|\n)exclude\s+(as\d+)\s+to\s+/$1$2 /g;
 	   $b=~ s/(^|\n)exclude\s+(as\d+)\s+to\s+/$1$2 /g;
 	}
        elsif ($key eq "ai") {
 	   $a=~ s/(^|\n)from\s+(as\d+\s+\d+)\s+accept\s+/$1$2 /g;
 	   $b=~ s/(^|\n)from\s+(as\d+\s+\d+)\s+accept\s+/$1$2 /g;
        }
        elsif ($key eq "ao") {
           $a=~ s/(^|\n)to\s+(as\d+)\s+announce\s+/$1$2 /g;
           $b=~ s/(^|\n)to\s+(as\d+)\s+announce\s+/$1$2 /g;
        }   
        elsif ($key eq "it") {
           $a=~ s/(^|\n)from\s+($match)\s+(\(\s*pref[\=\s\S]+\))?accept\s+/$1$2 $3/go;
           $b=~ s/(^|\n)from\s+($match)\s+(\(\s*pref[\=\s\S]+\))?accept\s+/$1$2 $3/go;
 	}			
 	elsif ($key eq "io") {
 	   $a=~ s/(^|\n)to\s+($match)\s+(\(\s*metric\-out[\=\s\S]+\))?announce\s+/$1$2 $3/go;
           $b=~ s/(^|\n)to\s+($match)\s+(\(\s*metric\-out[\=\s\S]+\))?announce\s+/$1$2 $3/go;
        }
            
        return 0 if ($a ne $b);

    }

    return 1;

}

1;

