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
#
#                   HashJoin            Join array of args to a Hash
#                   HashUniqueJoin      Join New items from array of args to a Hash
#                   UniquePush          Push items unless already in array
#                   ArrayDelete         Delete items from array
#                   ArrayList           Convert a list of scalars and/or array
#                                       references to array
#......................................................................#


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

package ArrayHashUtils;
require 5.006_001;
use strict;
use warnings;

#
#   Package interface
#
use base qw(Exporter);
our $VERSION = 1.00;
our @EXPORT = qw(
            HashJoin
            HashUniqueJoin
            UniquePush
            ArrayList
            ArrayDelete
            );

#-------------------------------------------------------------------------------
# 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);
}

#-------------------------------------------------------------------------------
# Function        : ArrayDelete
#
# Description     : Delete items from an array
#
# Inputs          : $pArray             - Ref to an array
#                   @arguments          - Arguments to process
#
# Returns         : Number of items that were removed
#

sub ArrayDelete
{
    my( $pArray, @arguments ) = @_;
    my( $ret ) = 0;
    my %deleteMe = map { $_ => 1 } @arguments;
    my @array;

    foreach ( @$pArray )
    {
        unless ( exists $deleteMe{$_} )
        {
            push @array, $_;
            $ret++;
        }
    }
    @$pArray = @array;
    return ($ret);
}



#-------------------------------------------------------------------------------
# Function        : ArrayList
#
# Description     : Convert a list of scalars and/or array references
#                   return an array
#
# Inputs          : items            - May be a scalar or an array ref
#
# Returns         : An array
#
sub ArrayList
{
    my @ret;
    foreach my $item ( @_ )
    {
        push @ret, (ref($item) eq 'ARRAY') ? @$item : $item;
    }
    return @ret;
}

1;