4
# Indexed hash implementation for Perl
6
# See below for documentation.
16
$VERSION = $VERSION = '1.21';
19
# standard tie functions
25
$s->[0] = {}; # hashkey index
26
$s->[1] = []; # array of keys
27
$s->[2] = []; # array of data
28
$s->[3] = 0; # iter count
37
#sub DESTROY {} # costly if there's nothing to do
40
my($s, $k) = (shift, shift);
41
return exists( $s->[0]{$k} ) ? $s->[2][ $s->[0]{$k} ] : undef;
45
my($s, $k, $v) = (shift, shift, shift);
47
if (exists $s->[0]{$k}) {
56
$s->[0]{$k} = $#{$s->[1]};
61
my($s, $k) = (shift, shift);
63
if (exists $s->[0]{$k}) {
65
for ($i+1..$#{$s->[1]}) { # reset higher elt indexes
66
$s->[0]{$s->[1][$_]}--; # timeconsuming, is there is better way?
69
splice @{$s->[1]}, $i, 1;
70
return (splice(@{$s->[2]}, $i, 1))[0];
76
exists $_[0]->[0]{ $_[1] };
85
return $_[0][1][$_[0][3]++] if ($_[0][3] <= $#{$_[0][1]});
93
# class functions that provide additional capabilities
97
sub new { TIEHASH(@_) }
100
# add pairs to end of indexed hash
101
# note that if a supplied key exists, it will not be reordered
106
$s->STORE(shift, shift);
108
return scalar(@{$s->[1]});
113
$s->Splice($#{$s->[1]}+1, 0, @_);
114
return scalar(@{$s->[1]});
123
$k = pop(@{$s->[1]});
124
$v = pop(@{$s->[2]});
133
return $_[0]->Splice(-1);
142
$k = shift(@{$s->[1]});
143
$v = shift(@{$s->[2]});
146
for (keys %{$s->[0]}) {
155
return $_[0]->Splice(0, 1);
160
# if a supplied key exists, it will not be reordered
164
my($k, $v, @k, @v, $len, $i);
167
($k, $v) = (shift, shift);
168
if (exists $s->[0]{$k}) {
181
for (keys %{$s->[0]}) {
188
unshift(@{$s->[1]}, @k);
189
return unshift(@{$s->[2]}, @v);
191
return scalar(@{$s->[1]});
197
return scalar(@{$s->[1]});
203
# any existing hash key order is preserved. the value is replaced for
204
# such keys, and the new keys are spliced in the regular fashion.
206
# supports -ve offsets but only +ve lengths
208
# always assumes a 0 start offset
211
my($s, $start, $len) = (shift, shift, shift);
212
my($k, $v, @k, @v, @r, $i, $siz);
213
my($end); # inclusive
216
($start, $end, $len) = $s->_lrange($start, $len);
218
if (defined $start) {
220
my(@k) = splice(@{$s->[1]}, $start, $len);
221
my(@v) = splice(@{$s->[2]}, $start, $len);
225
push(@r, $k, shift(@v));
227
for ($start..$#{$s->[1]}) {
228
$s->[0]{$s->[1][$_]} -= $len;
232
($k, $v) = (shift, shift);
233
if (exists $s->[0]{$k}) {
247
for ($start..$#{$s->[1]}) {
248
$s->[0]{$s->[1][$_]} += $siz;
254
splice(@{$s->[1]}, $start, 0, @k);
255
splice(@{$s->[2]}, $start, 0, @v);
262
# delete elements specified by key
263
# other elements higher than the one deleted "slide" down
270
# XXX potential optimization: could do $s->DELETE only if $#_ < 4.
271
# otherwise, should reset all the hash indices in one loop
278
# replace hash element at specified index
280
# if the optional key is not supplied the value at index will simply be
281
# replaced without affecting the order.
283
# if an element with the supplied key already exists, it will be deleted first.
285
# returns the key of replaced value if it succeeds.
289
my($i, $v, $k) = (shift, shift, shift);
290
if (defined $i and $i <= $#{$s->[1]} and $i >= 0) {
292
delete $s->[0]{ $s->[1][$i] };
293
$s->DELETE($k) ; #if exists $s->[0]{$k};
308
# Given an $start and $len, returns a legal start and end (where start <= end)
309
# for the current hash.
310
# Legal range is defined as 0 to $#s+1
311
# $len defaults to number of elts upto end of list
314
# | X | X | X ... X | X | X |
316
# X's above are the elements
320
my($offset, $len) = @_;
321
my($start, $end); # both inclusive
322
my($size) = $#{$s->[1]}+1;
324
return undef unless defined $offset;
326
$start = $offset + $size;
327
$start = 0 if $start < 0;
330
($offset > $size) ? ($start = $size) : ($start = $offset);
334
$len = -$len if $len < 0;
335
$len = $size - $start if $len > $size - $start;
338
$len = $size - $start;
340
$end = $start + $len - 1;
342
return ($start, $end, $len);
346
# Return keys at supplied indices
347
# Returns all keys if no args.
359
# Returns values at supplied indices
360
# Returns all values if no args.
372
# get indices of specified hash keys
376
return ( @_ == 1 ? $s->[0]{$_[0]} : @{$s->[0]}{@_} );
380
# number of k-v pairs in the ixhash
381
# note that this does not equal the highest index
382
# owing to preextended arrays
385
return scalar @{$_[0]->[1]};
389
# Reorder the hash in the supplied key order
391
# warning: any unsupplied keys will be lost from the hash
392
# any supplied keys that dont exist in the hash will be ignored
401
if (exists $s->[0]{$_}) {
403
push(@v, $s->[2][ $s->[0]{$_} ] );
415
$s->Reorder(sort $s->Keys);
420
$s->Reorder(sort { $s->FETCH($a) cmp $s->FETCH($b) } $s->Keys)
428
Tie::IxHash - ordered associative arrays for Perl
435
tie HASHVARIABLE, Tie::IxHash [, LIST];
437
# OO interface with more powerful features
439
TIEOBJECT = Tie::IxHash->new( [LIST] );
440
TIEOBJECT->Splice( OFFSET [, LENGTH [, LIST]] );
441
TIEOBJECT->Push( LIST );
444
TIEOBJECT->Unshift( LIST );
445
TIEOBJECT->Keys( [LIST] );
446
TIEOBJECT->Values( [LIST] );
447
TIEOBJECT->Indices( LIST );
448
TIEOBJECT->Delete( [LIST] );
449
TIEOBJECT->Replace( OFFSET, VALUE, [KEY] );
450
TIEOBJECT->Reorder( LIST );
451
TIEOBJECT->SortByKey;
452
TIEOBJECT->SortByValue;
458
This Perl module implements Perl hashes that preserve the order in which the
459
hash elements were added. The order is not affected when values
460
corresponding to existing keys in the IxHash are changed. The elements can
461
also be set to any arbitrary supplied order. The familiar perl array
462
operations can also be performed on the IxHash.
465
=head2 Standard C<TIEHASH> Interface
467
The standard C<TIEHASH> mechanism is available. This interface is
468
recommended for simple uses, since the usage is exactly the same as
469
regular Perl hashes after the C<tie> is declared.
472
=head2 Object Interface
474
This module also provides an extended object-oriented interface that can be
475
used for more powerful operations with the IxHash. The following methods
480
=item FETCH, STORE, DELETE, EXISTS
482
These standard C<TIEHASH> methods mandated by Perl can be used directly.
483
See the C<tie> entry in perlfunc(1) for details.
485
=item Push, Pop, Shift, Unshift, Splice
487
These additional methods resembling Perl functions are available for
488
operating on key-value pairs in the IxHash. The behavior is the same as the
489
corresponding perl functions, except when a supplied hash key already exists
490
in the hash. In that case, the existing value is updated but its order is
491
not affected. To unconditionally alter the order of a supplied key-value
492
pair, first C<DELETE> the IxHash element.
496
Returns an array of IxHash element keys corresponding to the list of supplied
497
indices. Returns an array of all the keys if called without arguments.
498
Note the return value is mostly only useful when used in a list context
499
(since perl will convert it to the number of elements in the array when
500
used in a scalar context, and that may not be very useful).
502
If a single argument is given, returns the single key corresponding to
503
the index. This is usable in either scalar or list context.
507
Returns an array of IxHash element values corresponding to the list of supplied
508
indices. Returns an array of all the values if called without arguments.
509
Note the return value is mostly only useful when used in a list context
510
(since perl will convert it to the number of elements in the array when
511
used in a scalar context, and that may not be very useful).
513
If a single argument is given, returns the single value corresponding to
514
the index. This is usable in either scalar or list context.
518
Returns an array of indices corresponding to the supplied list of keys.
519
Note the return value is mostly only useful when used in a list context
520
(since perl will convert it to the number of elements in the array when
521
used in a scalar context, and that may not be very useful).
523
If a single argument is given, returns the single index corresponding to
524
the key. This is usable in either scalar or list context.
528
Removes elements with the supplied keys from the IxHash.
532
Substitutes the IxHash element at the specified index with the supplied
533
value-key pair. If a key is not supplied, simply substitutes the value at
534
index with the supplied value. If an element with the supplied key already
535
exists, it will be removed from the IxHash first.
539
This method can be used to manipulate the internal order of the IxHash
540
elements by supplying a list of keys in the desired order. Note however,
541
that any IxHash elements whose keys are not in the list will be removed from
546
Returns the number of IxHash elements.
550
Reorders the IxHash elements by textual comparison of the keys.
554
Reorders the IxHash elements by textual comparison of the values.
564
$t = tie(%myhash, Tie::IxHash, 'a' => 1, 'b' => 2);
565
%myhash = (first => 1, second => 2, third => 3);
567
@keys = keys %myhash;
568
@values = values %myhash;
569
print("y") if exists $myhash{third};
572
$t = Tie::IxHash->new(first => 1, second => 2, third => 3);
573
$t->Push(fourth => 4); # same as $myhash{'fourth'} = 4;
574
($k, $v) = $t->Pop; # $k is 'fourth', $v is 4
575
$t->Unshift(neg => -1, zeroth => 0);
576
($k, $v) = $t->Shift; # $k is 'neg', $v is -1
577
@oneandtwo = $t->Splice(1, 2, foo => 100, bar => 101);
580
@values = $t->Values;
581
@indices = $t->Indices('foo', 'zeroth');
582
@itemkeys = $t->Keys(@indices);
583
@itemvals = $t->Values(@indices);
584
$t->Replace(2, 0.3, 'other');
585
$t->Delete('second', 'zeroth');
586
$len = $t->Length; # number of key-value pairs
588
$t->Reorder(reverse @keys);
595
You cannot specify a negative length to C<Splice>. Negative indexes are OK,
598
Indexing always begins at 0 (despite the current C<$[> setting) for
604
Addition of elements with keys that already exist to the end of the IxHash
605
must be controlled by a switch.
607
Provide C<TIEARRAY> interface when it stabilizes in Perl.
609
Rewrite using XSUBs for efficiency.
614
Gurusamy Sarathy gsar@umich.edu
616
Copyright (c) 1995 Gurusamy Sarathy. All rights reserved.
617
This program is free software; you can redistribute it and/or
618
modify it under the same terms as Perl itself.
623
Version 1.21 20 Nov 1997