######################################################################## # COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED. # # Module name : ArrayHashUtils.pm # Module type : JATS Support library # 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 ################################################################################ # 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 # # NOTE : Do not use in loops over a large number of elements # It is slow. # # 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;