#!/usr/bin/perl
#
# $Id: SetOps.pm,v 1.5 2000/04/28 04:32:05 levine Exp $
#
# Copyright (C) 2000  James D. Levine (jdl@vinecorp.com)
#
#
#   This program is free software; you can redistribute it and/or
#   modify it under the terms of the GNU General Public License
#   as published by the Free Software Foundation; either version 2
#   of the License, or (at your option) any later version.
# 
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
# 
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 
#   02111-1307, USA.
#
####################################################################


use strict;

package PortScan::SetOps;

use Exporter;
use vars qw( @ISA @EXPORT );

@EXPORT = qw( 
	      list_union list_intersection list_complement unified_list_complement
	      inverted_list_intersection
	      hash_union hash_intersection hash_complement inverted_hash_intersection
	      inverted_hash_complement unified_hash_complement
	      );

@ISA = qw( Exporter );


sub tests
{
    my @a = (1, 2, 3, 4, 5);
    my @b = (3, 4, 5, 6);
    my @c = (2, 3);


    my $l_union = list_union (\@a, \@b);
    my $l_intersection = list_intersection(\@a, \@b);
    my $l_complement = list_complement(\@a, \@c);
    my $l_inverted_intersection = inverted_list_intersection(\@a, \@b);
    my $l_unified_complement = &unified_list_complement(\@a, \@b);

    print "list_union (@a) (@b) -> (@$l_union)\n";
    print "list_intersection (@a) (@b) -> (@$l_intersection)\n";
    print "list_complement (@a) (@c) -> (@$l_complement)\n";
    print "unified_list_complement (@a) (@b) -> (@$l_unified_complement)\n";
    print "inverted_list_intersection (@a) (@b) -> (@$l_inverted_intersection)\n";


    my %ah = (a => 1, b => 2, c => 3, d => 4, e => 5);
    my %bh = (c => 3, d => 4 => e => 5, f => 6);
    my %ch = (b => 2, c => 3);

    my $h_union = hash_union (\%ah, \%bh);
    my $h_intersection = hash_intersection(\%ah, \%bh);
    my $h_complement = hash_complement(\%ah, \%ch);
    my $h_unified_complement = &unified_hash_complement(\%ah, \%bh);
    my $h_inverted_intersection = inverted_hash_intersection(\%ah, \%bh);


    print "hash_union (" , %ah ,") (", %bh, ") -> (", %$h_union, ")\n";
    print "hash_intersection (" , %ah ,") (", %bh, ") -> (", %$h_intersection, ")\n";
    print "hash_complement (" , %ah ,") (", %ch, ") -> (", %$h_complement, ")\n";
    print "unified_hash_complement (" , %ah ,") (", %bh, ") -> (",
       %$h_unified_complement, ")\n";
    print "inverted_hash_complement (" , %ah ,") (", %bh, ") -> (",
        %$h_inverted_intersection, ")\n";

}

sub list_union {
# assumes inputs are both listrefs with unique scalar members
    my ($a, $b) = @_;

    my %h;
    @h{(@$a, @$b)} = "" x (@$a, @$b);
    
    [keys %h];
}


sub list_intersection {
# assumes inputs are both listrefs with unique scalar members
    my ($a, $b) = @_;

    my %bh;
    @bh{@$b} = ("") x @$b;

    my $intersection = [];

    foreach my $e (@$a) {
	push (@$intersection, $e) if defined $bh{$e};
    }

    $intersection;
}

sub list_complement {
# assumes inputs are both listrefs with unique scalar members
# returns members of a not in b; assumes b is a subset of a
    my ($a, $b) = @_;

    my %bh;
    @bh{@$b} = ("") x @$b;
    my %complement;

    @complement{@$a} = ("") x @$a;

    foreach my $e (@$b) {
	delete $complement{$e} if exists $bh{$e};
    }

    [keys %complement];
}

sub unified_list_complement {
# assumes inputs are both listrefs with unique scalar members
# returns members of (a U b) not in b
    my ($a, $b) = @_;

    my $unified_list = list_union($a, $b);
    list_complement($unified_list, $b);
}

sub inverted_list_intersection {
# assumes inputs are both listrefs with unique scalar members
# returns all members of (a U b) which are not in (a n b)
    my ($a, $b) = @_;

    my $union = list_union($a, $b);
    my $intersection = list_intersection($a, $b);
    list_complement($union, $intersection);
}


sub hash_union
{
# assumes inputs are both hashrefs; where keys of a and b intersect,
# the values from b will override a's in the result
    my ($a, $b) = @_;

    my $union = {%$a};
    @$union{keys %$b} = (values %$b);
    $union;
}

sub hash_intersection {
# assumes inputs are both hashrefs; returns intersection, b's values
# override a's

    my ($a, $b) = @_;

    my $intersection = {};

    foreach my $e (keys %$a) {
	$intersection->{$e} = $b->{$e} if defined $b->{$e};
    }

    $intersection;
}

sub hash_complement {
# assumes inputs are both hashrefs
# returns members of a not in b; assumes b is a subset of a
    my ($a, $b) = @_;

    my $complement = {%$a};

    foreach my $e (keys %$b) {
	delete ( $complement->{$e} ) ;# if exists $complement->{$e};
    }
    $complement;
}

sub inverted_hash_intersection {
    my($a, $b) = @_;

    my $union = hash_union($a, $b);
    my $intersection = hash_intersection($a, $b);
    hash_complement($union, $intersection);
}

sub unified_hash_complement {
# assumes inputs are both hashrefs
# returns members of (a U b) not in b
    my ($a, $b) = @_;

    my $unified_hash = hash_union($a, $b);
    hash_complement($unified_hash, $b);
}

1;