Subversion Repositories DevTools

Rev

Rev 283 | Rev 3987 | 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 
#
13 
#
14 
#......................................................................#
15 
 
16 
 
17 
################################################################################
18 
#   Global variables used by functions in this package
19 
#   For historical reasons many of these variabeles are global
20 
#
21 
 
22 
package ArrayHashUtils;
283 dpurdie 23 
require 5.006_001;
24 
use strict;
25 
use warnings;
227 dpurdie 26 
 
283 dpurdie 27 
#
28 
#   Package interface
29 
#
30 
use base qw(Exporter);
31 
our $VERSION = 1.00;
32 
our @EXPORT = qw(
227 dpurdie 33 
            HashJoin
34 
            HashUniqueJoin
35 
            UniquePush
317 dpurdie 36 
            ArrayList
227 dpurdie 37 
            );
38 
 
39 
#-------------------------------------------------------------------------------
40 
# Function        : HashJoin
41 
#
42 
# Description     : Join an array of arguments to a hash
43 
#
44 
#                       HashJoin( \%BUILDALIAS, $;, $alias, @args );
45 
#
46 
#
47 
# Inputs          : $pHash          - Reference to a hash
48 
#                   $sep            - Join seperator
49 
#                   $key            - Hash key. Identify the element
50 
#                   @arguments      - Argumenst to join to the existing entry
51 
#
52 
# Returns         : Nothing
53 
#
54 
sub HashJoin
55 
{
56 
    my( $pHash, $sep, $key, @arguments ) = @_;
57 
 
58 
    if ( $key )
59 
    {
60 
        foreach my $arg ( @arguments )
61 
        {
62 
            if ( @$pHash{ $key } )
63 
            {
64 
                @$pHash{ $key } = join( $sep, @$pHash{ $key }, $arg );
65 
            }
66 
            else
67 
            {
68 
                @$pHash{ $key } = $arg;
69 
            }
70 
        }
71 
    }
72 
}
73 
 
74 
#-------------------------------------------------------------------------------
75 
# Function        : HashUniqueJoin
76 
#
77 
# Description     : Join an array of arguments to a hash
78 
#                   Only add new items
79 
#
80 
#                       HashJoin( \%BUILDALIAS, $;, $alias, @args );
81 
#
82 
#
83 
# Inputs          : $pHash          - Reference to a hash
84 
#                   $sep            - Join seperator
85 
#                   $key            - Hash key. Identify the element
86 
#                   @arguments      - Argumenst to join to the existing entry
87 
#
88 
# Returns         : Number of items that were unique
89 
#
90 
sub HashUniqueJoin
91 
{
92 
    my( $pHash, $sep, $key, @arguments ) = @_;
93 
    my( $ret ) = 0;
94 
 
95 
    if ( $key )
96 
    {
97 
        foreach my $arg ( @arguments )
98 
        {
99 
            if ( @$pHash{ $key } )
100 
            {
101 
                my( @args ) = split( $sep, @$pHash{ $key } );
102 
                my( $quoted_arg ) = quotemeta( $arg );
103 
 
104 
                if ( ! grep /^$quoted_arg$/, @args )
105 
                {
106 
                    @$pHash{ $key } = join( $sep, @$pHash{ $key }, $arg );
107 
                    $ret++;
108 
                }
109 
            }
110 
            else
111 
            {
112 
                @$pHash{ $key } = $arg;
113 
                $ret++;
114 
            }
115 
        }
116 
    }
117 
    return $ret;
118 
}
119 
 
120 
#-------------------------------------------------------------------------------
121 
# Function        : UniquePush
122 
#
123 
# Description     : Push onto the specified array only if 'arg' is unique
124 
#
125 
# Inputs          : $pArray             - Ref to an array
126 
#                   @arguments          - Argumenst to process
127 
#
128 
# Returns         : Number of items that were unique
129 
#
130 
 
131 
sub UniquePush
132 
{
133 
    my( $pArray, @arguments ) = @_;
134 
    my( $ret ) = 0;
135 
 
136 
    foreach my $arg ( @arguments )
137 
    {
138 
        if ( $arg )
139 
        {
140 
            my( $quoted_arg ) = quotemeta( $arg );
141 
 
142 
            if ( ! grep /^$quoted_arg$/, @$pArray )
143 
            {
144 
                push( @$pArray, $arg );
145 
                $ret++;
146 
            }
147 
        }
148 
    }
149 
    return ($ret);
150 
}
151 
 
317 dpurdie 152 
 
153 
#-------------------------------------------------------------------------------
154 
# Function        : ArrayList
155 
#
156 
# Description     : Convert a list of scalars and/or array references
157 
#                   return an array
158 
#
159 
# Inputs          : items            - May be a scalar or an array ref
160 
#
161 
# Returns         : An array
162 
#
163 
sub ArrayList
164 
{
165 
    my @ret;
166 
    foreach my $item ( @_ )
167 
    {
168 
        push @ret, (ref($item) eq 'ARRAY') ? @$item : $item;
169 
    }
170 
    return @ret;
171 
}
172 
 
227 dpurdie 173 
1;
174