#! /local/bin/perl

######################################################################
# $Header: /loc/adm/slink-1.0/src/slink-5.0/Slink/RCS/Omniopter.pm,v 5.0 1996/05/13 17:14:27 couch Exp $
#  Slink::Omniopter.pm: general option-list parsing mechanisms
#  Revision 5.0
#  by
#  Alva L. Couch,                       
#  Associate Prof. of EE/CS          
#  Department of EE/CS             
#  Tufts University,            
#  Medford, Massachusetts, 02155.
#  couch@cs.tufts.edu
#
#  Copyright (C) 1996 by Alva L. Couch 
#
#  This file is part of SLINK
#
#  SLINK 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, or (at your option)
#  any later version.
#
#  SLINK 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 GNU CC; see the file COPYING.  If not, write to
#  the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
######################################################################

package Slink::Omniopter;
require 5.001;
require Exporter;
use strict;

BEGIN { 
    @Slink::Omniopter::ISA = qw(Exporter);
    @Slink::Omniopter::EXPORT = qw();
    @Slink::Omniopter::EXPORT_OK 
	= qw(illegal omitted allow merge_r2l merge_l2r); 
}

# modifies an option hash so only legal options are included
sub allow {
    my($ref,@allopts) = @_; 
    my %newref = %$ref; 
    my $thing; 
    foreach $thing (@allopts) { delete $newref{$thing}; }
    foreach $thing (keys %newref) { delete $ref->{$thing}; }
    return $ref; 
}

# returns a list of options that don't match options we're expecting
sub illegal {
    my($ref,@allopts) = @_; 
    my %newref = %$ref; 
    my $thing; 
    foreach $thing (@allopts) { delete $newref{$thing}; }
    return keys %newref; 
}

# returns a list of unset options from an option list
sub omitted {
    my($ref,@allopts) = @_; 
    my @unset = (); 
    my $thing ; 
    foreach $thing (@allopts) {
	push(@unset,$thing) if ! defined $ref->{$thing}; 
    }
    return @unset; 
}

# this subroutine merges any number of option refs into one, 
# where the first instance of an option wins
sub merge_r2l { 
    my (@refs) = @_; 
    my $newref = {}; 
    my $i; 
    for ($i=$#refs; $i>=0; $i--) {
	my $ref = $refs[$i]; 
	my ($key,$value); 
	while (($key,$value) = each %$ref) {
	    $newref->{$key} = $value; 
	}
    }
    return $newref; 
}

# this subroutine merges any number of option refs into one, 
# where the last instance of an option wins
sub merge_l2r { 
    my (@refs) = @_; 
    my $newref = {}; 
    my $ref; 
    foreach $ref (@refs) { 
	my ($key,$value); 
	while (($key,$value) = each %$ref) {
	    $newref->{$key} = $value; 
	}
    }
    return $newref; 
}

1;