Subversion Repositories DevTools

Rev

Rev 7300 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
227 dpurdie 1 
########################################################################
7300 dpurdie 2 
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
227 dpurdie 3 
#
5679 dpurdie 4 
# Module name   : ArrayHashUtils.pm
5 
# Module type   : JATS Support library
227 dpurdie 6 
# Environment(s): jats
7 
#
8 
# Description   : This package contains functions to manipulate arrays
9 
#                 and hashes
10 
#
3987 dpurdie 11 
#                   HashJoin            Join array of args to a Hash
12 
#                   HashUniqueJoin      Join New items from array of args to a Hash
13 
#                   UniquePush          Push items unless already in array
4362 dpurdie 14 
#                   ArrayDelete         Delete items from array
3987 dpurdie 15 
#                   ArrayList           Convert a list of scalars and/or array
16 
#                                       references to array
227 dpurdie 17 
################################################################################
18 
#
19 
package ArrayHashUtils;
283 dpurdie 20 
require 5.006_001;
21 
use strict;
22 
use warnings;
227 dpurdie 23 
 
283 dpurdie 24 
#
25 
#   Package interface
26 
#
27 
use base qw(Exporter);
28 
our $VERSION = 1.00;
29 
our @EXPORT = qw(
227 dpurdie 30 
            HashJoin
31 
            HashUniqueJoin
32 
            UniquePush
317 dpurdie 33 
            ArrayList
3987 dpurdie 34 
            ArrayDelete
227 dpurdie 35 
            );
36 
 
37 
#-------------------------------------------------------------------------------
38 
# Function        : HashJoin
39 
#
40 
# Description     : Join an array of arguments to a hash
41 
#
42 
#                       HashJoin( \%BUILDALIAS, $;, $alias, @args );
43 
#
44 
#
45 
# Inputs          : $pHash          - Reference to a hash
46 
#                   $sep            - Join seperator
47 
#                   $key            - Hash key. Identify the element
48 
#                   @arguments      - Argumenst to join to the existing entry
49 
#
50 
# Returns         : Nothing
51 
#
52 
sub HashJoin
53 
{
54 
    my( $pHash, $sep, $key, @arguments ) = @_;
55 
 
56 
    if ( $key )
57 
    {
58 
        foreach my $arg ( @arguments )
59 
        {
60 
            if ( @$pHash{ $key } )
61 
            {
62 
                @$pHash{ $key } = join( $sep, @$pHash{ $key }, $arg );
63 
            }
64 
            else
65 
            {
66 
                @$pHash{ $key } = $arg;
67 
            }
68 
        }
69 
    }
70 
}
71 
 
72 
#-------------------------------------------------------------------------------
73 
# Function        : HashUniqueJoin
74 
#
75 
# Description     : Join an array of arguments to a hash
76 
#                   Only add new items
77 
#
78 
#                       HashJoin( \%BUILDALIAS, $;, $alias, @args );
79 
#
80 
#
81 
# Inputs          : $pHash          - Reference to a hash
82 
#                   $sep            - Join seperator
83 
#                   $key            - Hash key. Identify the element
84 
#                   @arguments      - Argumenst to join to the existing entry
85 
#
86 
# Returns         : Number of items that were unique
87 
#
88 
sub HashUniqueJoin
89 
{
90 
    my( $pHash, $sep, $key, @arguments ) = @_;
91 
    my( $ret ) = 0;
92 
 
93 
    if ( $key )
94 
    {
95 
        foreach my $arg ( @arguments )
96 
        {
97 
            if ( @$pHash{ $key } )
98 
            {
99 
                my( @args ) = split( $sep, @$pHash{ $key } );
100 
                my( $quoted_arg ) = quotemeta( $arg );
101 
 
102 
                if ( ! grep /^$quoted_arg$/, @args )
103 
                {
104 
                    @$pHash{ $key } = join( $sep, @$pHash{ $key }, $arg );
105 
                    $ret++;
106 
                }
107 
            }
108 
            else
109 
            {
110 
                @$pHash{ $key } = $arg;
111 
                $ret++;
112 
            }
113 
        }
114 
    }
115 
    return $ret;
116 
}
117 
 
118 
#-------------------------------------------------------------------------------
119 
# Function        : UniquePush
120 
#
121 
# Description     : Push onto the specified array only if 'arg' is unique
7322 dpurdie 122 
#
123 
# NOTE            : Do not use in loops over a large number of elements
124 
#                   It is slow.
227 dpurdie 125 
#
126 
# Inputs          : $pArray             - Ref to an array
127 
#                   @arguments          - Argumenst to process
128 
#
129 
# Returns         : Number of items that were unique
130 
#
131 
 
132 
sub UniquePush
133 
{
134 
    my( $pArray, @arguments ) = @_;
135 
    my( $ret ) = 0;
136 
 
137 
    foreach my $arg ( @arguments )
138 
    {
139 
        if ( $arg )
140 
        {
141 
            my( $quoted_arg ) = quotemeta( $arg );
142 
 
143 
            if ( ! grep /^$quoted_arg$/, @$pArray )
144 
            {
145 
                push( @$pArray, $arg );
146 
                $ret++;
147 
            }
148 
        }
149 
    }
150 
    return ($ret);
151 
}
152 
 
3987 dpurdie 153 
#-------------------------------------------------------------------------------
154 
# Function        : ArrayDelete
155 
#
156 
# Description     : Delete items from an array
157 
#
158 
# Inputs          : $pArray             - Ref to an array
159 
#                   @arguments          - Arguments to process
160 
#
161 
# Returns         : Number of items that were removed
162 
#
317 dpurdie 163 
 
3987 dpurdie 164 
sub ArrayDelete
165 
{
166 
    my( $pArray, @arguments ) = @_;
167 
    my( $ret ) = 0;
168 
    my %deleteMe = map { $_ => 1 } @arguments;
169 
    my @array;
170 
 
171 
    foreach ( @$pArray )
172 
    {
173 
        unless ( exists $deleteMe{$_} )
174 
        {
175 
            push @array, $_;
176 
            $ret++;
177 
        }
178 
    }
179 
    @$pArray = @array;
180 
    return ($ret);
181 
}
182 
 
183 
 
184 
 
317 dpurdie 185 
#-------------------------------------------------------------------------------
186 
# Function        : ArrayList
187 
#
188 
# Description     : Convert a list of scalars and/or array references
189 
#                   return an array
190 
#
191 
# Inputs          : items            - May be a scalar or an array ref
192 
#
193 
# Returns         : An array
194 
#
195 
sub ArrayList
196 
{
197 
    my @ret;
198 
    foreach my $item ( @_ )
199 
    {
200 
        push @ret, (ref($item) eq 'ARRAY') ? @$item : $item;
201 
    }
202 
    return @ret;
203 
}
204 
 
227 dpurdie 205 
1;
206