Subversion Repositories DevTools

Rev

Rev 255 | Rev 317 | 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
36 
            );
37 
 
38 
#-------------------------------------------------------------------------------
39 
# Function        : HashJoin
40 
#
41 
# Description     : Join an array of arguments to a hash
42 
#
43 
#                       HashJoin( \%BUILDALIAS, $;, $alias, @args );
44 
#
45 
#
46 
# Inputs          : $pHash          - Reference to a hash
47 
#                   $sep            - Join seperator
48 
#                   $key            - Hash key. Identify the element
49 
#                   @arguments      - Argumenst to join to the existing entry
50 
#
51 
# Returns         : Nothing
52 
#
53 
sub HashJoin
54 
{
55 
    my( $pHash, $sep, $key, @arguments ) = @_;
56 
 
57 
    if ( $key )
58 
    {
59 
        foreach my $arg ( @arguments )
60 
        {
61 
            if ( @$pHash{ $key } )
62 
            {
63 
                @$pHash{ $key } = join( $sep, @$pHash{ $key }, $arg );
64 
            }
65 
            else
66 
            {
67 
                @$pHash{ $key } = $arg;
68 
            }
69 
        }
70 
    }
71 
}
72 
 
73 
#-------------------------------------------------------------------------------
74 
# Function        : HashUniqueJoin
75 
#
76 
# Description     : Join an array of arguments to a hash
77 
#                   Only add new items
78 
#
79 
#                       HashJoin( \%BUILDALIAS, $;, $alias, @args );
80 
#
81 
#
82 
# Inputs          : $pHash          - Reference to a hash
83 
#                   $sep            - Join seperator
84 
#                   $key            - Hash key. Identify the element
85 
#                   @arguments      - Argumenst to join to the existing entry
86 
#
87 
# Returns         : Number of items that were unique
88 
#
89 
sub HashUniqueJoin
90 
{
91 
    my( $pHash, $sep, $key, @arguments ) = @_;
92 
    my( $ret ) = 0;
93 
 
94 
    if ( $key )
95 
    {
96 
        foreach my $arg ( @arguments )
97 
        {
98 
            if ( @$pHash{ $key } )
99 
            {
100 
                my( @args ) = split( $sep, @$pHash{ $key } );
101 
                my( $quoted_arg ) = quotemeta( $arg );
102 
 
103 
                if ( ! grep /^$quoted_arg$/, @args )
104 
                {
105 
                    @$pHash{ $key } = join( $sep, @$pHash{ $key }, $arg );
106 
                    $ret++;
107 
                }
108 
            }
109 
            else
110 
            {
111 
                @$pHash{ $key } = $arg;
112 
                $ret++;
113 
            }
114 
        }
115 
    }
116 
    return $ret;
117 
}
118 
 
119 
#-------------------------------------------------------------------------------
120 
# Function        : UniquePush
121 
#
122 
# Description     : Push onto the specified array only if 'arg' is unique
123 
#
124 
# Inputs          : $pArray             - Ref to an array
125 
#                   @arguments          - Argumenst to process
126 
#
127 
# Returns         : Number of items that were unique
128 
#
129 
 
130 
sub UniquePush
131 
{
132 
    my( $pArray, @arguments ) = @_;
133 
    my( $ret ) = 0;
134 
 
135 
    foreach my $arg ( @arguments )
136 
    {
137 
        if ( $arg )
138 
        {
139 
            my( $quoted_arg ) = quotemeta( $arg );
140 
 
141 
            if ( ! grep /^$quoted_arg$/, @$pArray )
142 
            {
143 
                push( @$pArray, $arg );
144 
                $ret++;
145 
            }
146 
        }
147 
    }
148 
    return ($ret);
149 
}
150 
 
151 
 
152 
1;
153