Subversion Repositories DevTools

Rev

Rev 227 | Rev 283 | 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 
 
255 dpurdie 16 
require 5.006_001;
227 dpurdie 17 
use strict;
18 
use warnings;
19 
 
20 
################################################################################
21 
#   Global variables used by functions in this package
22 
#   For historical reasons many of these variabeles are global
23 
#
24 
 
25 
package ArrayHashUtils;
26 
 
27 
our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
28 
use Exporter;
29 
 
30 
$VERSION = 1.00;
31 
@ISA = qw(Exporter);
32 
 
33 
# Symbols to autoexport (:DEFAULT tag)
34 
@EXPORT = qw(
35 
            HashJoin
36 
            HashUniqueJoin
37 
            UniquePush
38 
            );
39 
 
40 
#-------------------------------------------------------------------------------
41 
# Function        : HashJoin
42 
#
43 
# Description     : Join an array of arguments to a hash
44 
#
45 
#                       HashJoin( \%BUILDALIAS, $;, $alias, @args );
46 
#
47 
#
48 
# Inputs          : $pHash          - Reference to a hash
49 
#                   $sep            - Join seperator
50 
#                   $key            - Hash key. Identify the element
51 
#                   @arguments      - Argumenst to join to the existing entry
52 
#
53 
# Returns         : Nothing
54 
#
55 
sub HashJoin
56 
{
57 
    my( $pHash, $sep, $key, @arguments ) = @_;
58 
 
59 
    if ( $key )
60 
    {
61 
        foreach my $arg ( @arguments )
62 
        {
63 
            if ( @$pHash{ $key } )
64 
            {
65 
                @$pHash{ $key } = join( $sep, @$pHash{ $key }, $arg );
66 
            }
67 
            else
68 
            {
69 
                @$pHash{ $key } = $arg;
70 
            }
71 
        }
72 
    }
73 
}
74 
 
75 
#-------------------------------------------------------------------------------
76 
# Function        : HashUniqueJoin
77 
#
78 
# Description     : Join an array of arguments to a hash
79 
#                   Only add new items
80 
#
81 
#                       HashJoin( \%BUILDALIAS, $;, $alias, @args );
82 
#
83 
#
84 
# Inputs          : $pHash          - Reference to a hash
85 
#                   $sep            - Join seperator
86 
#                   $key            - Hash key. Identify the element
87 
#                   @arguments      - Argumenst to join to the existing entry
88 
#
89 
# Returns         : Number of items that were unique
90 
#
91 
sub HashUniqueJoin
92 
{
93 
    my( $pHash, $sep, $key, @arguments ) = @_;
94 
    my( $ret ) = 0;
95 
 
96 
    if ( $key )
97 
    {
98 
        foreach my $arg ( @arguments )
99 
        {
100 
            if ( @$pHash{ $key } )
101 
            {
102 
                my( @args ) = split( $sep, @$pHash{ $key } );
103 
                my( $quoted_arg ) = quotemeta( $arg );
104 
 
105 
                if ( ! grep /^$quoted_arg$/, @args )
106 
                {
107 
                    @$pHash{ $key } = join( $sep, @$pHash{ $key }, $arg );
108 
                    $ret++;
109 
                }
110 
            }
111 
            else
112 
            {
113 
                @$pHash{ $key } = $arg;
114 
                $ret++;
115 
            }
116 
        }
117 
    }
118 
    return $ret;
119 
}
120 
 
121 
#-------------------------------------------------------------------------------
122 
# Function        : UniquePush
123 
#
124 
# Description     : Push onto the specified array only if 'arg' is unique
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 
 
153 
 
154 
1;
155