Subversion Repositories DevTools

Rev

Rev 317 | Rev 4362 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

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