Subversion Repositories DevTools

#! perl
########################################################################
# Copyright ( C ) 2005 ERG Limited, All rights reserved
#
# Module name   : jats.sh
# Module type   : Perl Package
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : This package contains functions to manipulate arrays
#                 and hashes
#
#
#......................................................................#

require 5.6.1;
use strict;
use warnings;

################################################################################
#   Global variables used by functions in this package
#   For historical reasons many of these variabeles are global
#

package ArrayHashUtils;

our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
use Exporter;

$VERSION = 1.00;
@ISA = qw(Exporter);

# Symbols to autoexport (:DEFAULT tag)
@EXPORT = qw(
            HashJoin
            HashUniqueJoin
            UniquePush
            );

#-------------------------------------------------------------------------------
# Function        : HashJoin
#
# Description     : Join an array of arguments to a hash
#
#                       HashJoin( \%BUILDALIAS, $;, $alias, @args );
#                   
#
# Inputs          : $pHash          - Reference to a hash
#                   $sep            - Join seperator
#                   $key            - Hash key. Identify the element
#                   @arguments      - Argumenst to join to the existing entry
#
# Returns         : Nothing
#
sub HashJoin
{
    my( $pHash, $sep, $key, @arguments ) = @_;

    if ( $key )
    {
        foreach my $arg ( @arguments )
        {
            if ( @$pHash{ $key } )
            {
                @$pHash{ $key } = join( $sep, @$pHash{ $key }, $arg );
            }
            else
            {
                @$pHash{ $key } = $arg;
            }
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : HashUniqueJoin
#
# Description     : Join an array of arguments to a hash
#                   Only add new items
#
#                       HashJoin( \%BUILDALIAS, $;, $alias, @args );
#                   
#
# Inputs          : $pHash          - Reference to a hash
#                   $sep            - Join seperator
#                   $key            - Hash key. Identify the element
#                   @arguments      - Argumenst to join to the existing entry
#
# Returns         : Number of items that were unique
#
sub HashUniqueJoin
{
    my( $pHash, $sep, $key, @arguments ) = @_;
    my( $ret ) = 0;

    if ( $key )
    {
        foreach my $arg ( @arguments )
        {
            if ( @$pHash{ $key } )
            {
                my( @args ) = split( $sep, @$pHash{ $key } );
                my( $quoted_arg ) = quotemeta( $arg );

                if ( ! grep /^$quoted_arg$/, @args )
                {
                    @$pHash{ $key } = join( $sep, @$pHash{ $key }, $arg );
                    $ret++;
                }
            }
            else
            {
                @$pHash{ $key } = $arg;
                $ret++;
            }
        }
    }
    return $ret;
}

#-------------------------------------------------------------------------------
# Function        : UniquePush
#
# Description     : Push onto the specified array only if 'arg' is unique
#
# Inputs          : $pArray             - Ref to an array
#                   @arguments          - Argumenst to process
#
# Returns         : Number of items that were unique
#

sub UniquePush
{
    my( $pArray, @arguments ) = @_;
    my( $ret ) = 0;

    foreach my $arg ( @arguments )
    {
        if ( $arg )
        {
            my( $quoted_arg ) = quotemeta( $arg );

            if ( ! grep /^$quoted_arg$/, @$pArray )
            {
                push( @$pArray, $arg );
                $ret++;
            }
        }
    }
    return ($ret);
}
            

1;