diff --git a/Changelog b/Changelog index 8459cdf..f07eb1b 100644 --- a/Changelog +++ b/Changelog @@ -1,3 +1,8 @@ + 2.42 + - dist tarball for 2.41 missed t/Tie/LxHash.pm. Dammit. + the File to the MANIFEST. + + 2.41 - fixed rt.cpan.org#38635. apache-like include now supports quoted strings. diff --git a/General.pm b/General.pm index adafb7b..bd8abbd 100644 --- a/General.pm +++ b/General.pm @@ -32,7 +32,7 @@ use Carp::Heavy; use Carp; use Exporter; -$Config::General::VERSION = 2.41; +$Config::General::VERSION = 2.42; use vars qw(@ISA @EXPORT_OK); use base qw(Exporter); @@ -2522,7 +2522,7 @@ Thomas Linden =head1 VERSION -2.41 +2.42 =cut diff --git a/MANIFEST b/MANIFEST index 383fa8e..c540efd 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,3 +1,9 @@ +General/Extended.pm +General/Interpolated.pm +t/Tie/IxHash.pm +t/Tie/README +t/complex/n1.cfg +t/complex/n2.cfg t/sub1/sub2/sub3/cfg.sub3 t/sub1/sub2/cfg.sub2 t/sub1/sub2/cfg.sub2b @@ -16,26 +22,27 @@ t/cfg.20.b t/cfg.20.c t/cfg.3 t/cfg.34 +t/cfg.39 t/cfg.4 +t/cfg.40 +t/cfg.41 +t/cfg.42 +t/cfg.43 +t/cfg.45 +t/cfg.46 t/cfg.5 t/cfg.6 t/cfg.7 t/cfg.8 +t/complex.cfg t/dual-include.conf -t/included.conf t/run.t +t/included.conf t/test.rc -t/cfg.39 -t/cfg.41 -t/cfg.40 -t/cfg.42 -t/cfg.43 -General/Extended.pm -General/Interpolated.pm +Changelog General.pm MANIFEST +Makefile.PL README example.cfg -Changelog -Makefile.PL META.yml Module meta-data (added by MakeMaker) diff --git a/META.yml b/META.yml index 7a24753..3e0995a 100644 --- a/META.yml +++ b/META.yml @@ -1,7 +1,7 @@ # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Config-General -version: 2.41 +version: 2.42 version_from: General.pm installdirs: site requires: diff --git a/t/Tie/IxHash.pm b/t/Tie/IxHash.pm new file mode 100644 index 0000000..d98b6dc --- /dev/null +++ b/t/Tie/IxHash.pm @@ -0,0 +1,630 @@ +# +# Tie/IxHash.pm +# +# Indexed hash implementation for Perl +# +# See below for documentation. +# + +require 5.003; + +package Tie::IxHash; +use integer; +require Tie::Hash; +@ISA = qw(Tie::Hash); + +$VERSION = $VERSION = '1.21'; + +# +# standard tie functions +# + +sub TIEHASH { + my($c) = shift; + my($s) = []; + $s->[0] = {}; # hashkey index + $s->[1] = []; # array of keys + $s->[2] = []; # array of data + $s->[3] = 0; # iter count + + bless $s, $c; + + $s->Push(@_) if @_; + + return $s; +} + +#sub DESTROY {} # costly if there's nothing to do + +sub FETCH { + my($s, $k) = (shift, shift); + return exists( $s->[0]{$k} ) ? $s->[2][ $s->[0]{$k} ] : undef; +} + +sub STORE { + my($s, $k, $v) = (shift, shift, shift); + + if (exists $s->[0]{$k}) { + my($i) = $s->[0]{$k}; + $s->[1][$i] = $k; + $s->[2][$i] = $v; + $s->[0]{$k} = $i; + } + else { + push(@{$s->[1]}, $k); + push(@{$s->[2]}, $v); + $s->[0]{$k} = $#{$s->[1]}; + } +} + +sub DELETE { + my($s, $k) = (shift, shift); + + if (exists $s->[0]{$k}) { + my($i) = $s->[0]{$k}; + for ($i+1..$#{$s->[1]}) { # reset higher elt indexes + $s->[0]{$s->[1][$_]}--; # timeconsuming, is there is better way? + } + delete $s->[0]{$k}; + splice @{$s->[1]}, $i, 1; + return (splice(@{$s->[2]}, $i, 1))[0]; + } + return undef; +} + +sub EXISTS { + exists $_[0]->[0]{ $_[1] }; +} + +sub FIRSTKEY { + $_[0][3] = 0; + &NEXTKEY; +} + +sub NEXTKEY { + return $_[0][1][$_[0][3]++] if ($_[0][3] <= $#{$_[0][1]}); + return undef; +} + + + +# +# +# class functions that provide additional capabilities +# +# + +sub new { TIEHASH(@_) } + +# +# add pairs to end of indexed hash +# note that if a supplied key exists, it will not be reordered +# +sub Push { + my($s) = shift; + while (@_) { + $s->STORE(shift, shift); + } + return scalar(@{$s->[1]}); +} + +sub Push2 { + my($s) = shift; + $s->Splice($#{$s->[1]}+1, 0, @_); + return scalar(@{$s->[1]}); +} + +# +# pop last k-v pair +# +sub Pop { + my($s) = shift; + my($k, $v, $i); + $k = pop(@{$s->[1]}); + $v = pop(@{$s->[2]}); + if (defined $k) { + delete $s->[0]{$k}; + return ($k, $v); + } + return undef; +} + +sub Pop2 { + return $_[0]->Splice(-1); +} + +# +# shift +# +sub Shift { + my($s) = shift; + my($k, $v, $i); + $k = shift(@{$s->[1]}); + $v = shift(@{$s->[2]}); + if (defined $k) { + delete $s->[0]{$k}; + for (keys %{$s->[0]}) { + $s->[0]{$_}--; + } + return ($k, $v); + } + return undef; +} + +sub Shift2 { + return $_[0]->Splice(0, 1); +} + +# +# unshift +# if a supplied key exists, it will not be reordered +# +sub Unshift { + my($s) = shift; + my($k, $v, @k, @v, $len, $i); + + while (@_) { + ($k, $v) = (shift, shift); + if (exists $s->[0]{$k}) { + $i = $s->[0]{$k}; + $s->[1][$i] = $k; + $s->[2][$i] = $v; + $s->[0]{$k} = $i; + } + else { + push(@k, $k); + push(@v, $v); + $len++; + } + } + if (defined $len) { + for (keys %{$s->[0]}) { + $s->[0]{$_} += $len; + } + $i = 0; + for (@k) { + $s->[0]{$_} = $i++; + } + unshift(@{$s->[1]}, @k); + return unshift(@{$s->[2]}, @v); + } + return scalar(@{$s->[1]}); +} + +sub Unshift2 { + my($s) = shift; + $s->Splice(0,0,@_); + return scalar(@{$s->[1]}); +} + +# +# splice +# +# any existing hash key order is preserved. the value is replaced for +# such keys, and the new keys are spliced in the regular fashion. +# +# supports -ve offsets but only +ve lengths +# +# always assumes a 0 start offset +# +sub Splice { + my($s, $start, $len) = (shift, shift, shift); + my($k, $v, @k, @v, @r, $i, $siz); + my($end); # inclusive + + # XXX inline this + ($start, $end, $len) = $s->_lrange($start, $len); + + if (defined $start) { + if ($len > 0) { + my(@k) = splice(@{$s->[1]}, $start, $len); + my(@v) = splice(@{$s->[2]}, $start, $len); + while (@k) { + $k = shift(@k); + delete $s->[0]{$k}; + push(@r, $k, shift(@v)); + } + for ($start..$#{$s->[1]}) { + $s->[0]{$s->[1][$_]} -= $len; + } + } + while (@_) { + ($k, $v) = (shift, shift); + if (exists $s->[0]{$k}) { + # $s->STORE($k, $v); + $i = $s->[0]{$k}; + $s->[1][$i] = $k; + $s->[2][$i] = $v; + $s->[0]{$k} = $i; + } + else { + push(@k, $k); + push(@v, $v); + $siz++; + } + } + if (defined $siz) { + for ($start..$#{$s->[1]}) { + $s->[0]{$s->[1][$_]} += $siz; + } + $i = $start; + for (@k) { + $s->[0]{$_} = $i++; + } + splice(@{$s->[1]}, $start, 0, @k); + splice(@{$s->[2]}, $start, 0, @v); + } + } + return @r; +} + +# +# delete elements specified by key +# other elements higher than the one deleted "slide" down +# +sub Delete { + my($s) = shift; + + for (@_) { + # + # XXX potential optimization: could do $s->DELETE only if $#_ < 4. + # otherwise, should reset all the hash indices in one loop + # + $s->DELETE($_); + } +} + +# +# replace hash element at specified index +# +# if the optional key is not supplied the value at index will simply be +# replaced without affecting the order. +# +# if an element with the supplied key already exists, it will be deleted first. +# +# returns the key of replaced value if it succeeds. +# +sub Replace { + my($s) = shift; + my($i, $v, $k) = (shift, shift, shift); + if (defined $i and $i <= $#{$s->[1]} and $i >= 0) { + if (defined $k) { + delete $s->[0]{ $s->[1][$i] }; + $s->DELETE($k) ; #if exists $s->[0]{$k}; + $s->[1][$i] = $k; + $s->[2][$i] = $v; + $s->[0]{$k} = $i; + return $k; + } + else { + $s->[2][$i] = $v; + return $s->[1][$i]; + } + } + return undef; +} + +# +# Given an $start and $len, returns a legal start and end (where start <= end) +# for the current hash. +# Legal range is defined as 0 to $#s+1 +# $len defaults to number of elts upto end of list +# +# 0 1 2 ... +# | X | X | X ... X | X | X | +# -2 -1 (no -0 alas) +# X's above are the elements +# +sub _lrange { + my($s) = shift; + my($offset, $len) = @_; + my($start, $end); # both inclusive + my($size) = $#{$s->[1]}+1; + + return undef unless defined $offset; + if($offset < 0) { + $start = $offset + $size; + $start = 0 if $start < 0; + } + else { + ($offset > $size) ? ($start = $size) : ($start = $offset); + } + + if (defined $len) { + $len = -$len if $len < 0; + $len = $size - $start if $len > $size - $start; + } + else { + $len = $size - $start; + } + $end = $start + $len - 1; + + return ($start, $end, $len); +} + +# +# Return keys at supplied indices +# Returns all keys if no args. +# +sub Keys { + my($s) = shift; + return ( @_ == 1 + ? $s->[1][$_[0]] + : ( @_ + ? @{$s->[1]}[@_] + : @{$s->[1]} ) ); +} + + +# Returns values at supplied indices +# Returns all values if no args. +# +sub Values { + my($s) = shift; + return ( @_ == 1 + ? $s->[2][$_[0]] + : ( @_ + ? @{$s->[2]}[@_] + : @{$s->[2]} ) ); +} + +# +# get indices of specified hash keys +# +sub Indices { + my($s) = shift; + return ( @_ == 1 ? $s->[0]{$_[0]} : @{$s->[0]}{@_} ); +} + +# +# number of k-v pairs in the ixhash +# note that this does not equal the highest index +# owing to preextended arrays +# +sub Length { + return scalar @{$_[0]->[1]}; +} + +# +# Reorder the hash in the supplied key order +# +# warning: any unsupplied keys will be lost from the hash +# any supplied keys that dont exist in the hash will be ignored +# +sub Reorder { + my($s) = shift; + my(@k, @v, %x, $i); + return unless @_; + + $i = 0; + for (@_) { + if (exists $s->[0]{$_}) { + push(@k, $_); + push(@v, $s->[2][ $s->[0]{$_} ] ); + $x{$_} = $i++; + } + } + $s->[1] = \@k; + $s->[2] = \@v; + $s->[0] = \%x; + return $s; +} + +sub SortByKey { + my($s) = shift; + $s->Reorder(sort $s->Keys); +} + +sub SortByValue { + my($s) = shift; + $s->Reorder(sort { $s->FETCH($a) cmp $s->FETCH($b) } $s->Keys) +} + +1; +__END__ + +=head1 NAME + +Tie::IxHash - ordered associative arrays for Perl + + +=head1 SYNOPSIS + + # simple usage + use Tie::IxHash; + tie HASHVARIABLE, Tie::IxHash [, LIST]; + + # OO interface with more powerful features + use Tie::IxHash; + TIEOBJECT = Tie::IxHash->new( [LIST] ); + TIEOBJECT->Splice( OFFSET [, LENGTH [, LIST]] ); + TIEOBJECT->Push( LIST ); + TIEOBJECT->Pop; + TIEOBJECT->Shift; + TIEOBJECT->Unshift( LIST ); + TIEOBJECT->Keys( [LIST] ); + TIEOBJECT->Values( [LIST] ); + TIEOBJECT->Indices( LIST ); + TIEOBJECT->Delete( [LIST] ); + TIEOBJECT->Replace( OFFSET, VALUE, [KEY] ); + TIEOBJECT->Reorder( LIST ); + TIEOBJECT->SortByKey; + TIEOBJECT->SortByValue; + TIEOBJECT->Length; + + +=head1 DESCRIPTION + +This Perl module implements Perl hashes that preserve the order in which the +hash elements were added. The order is not affected when values +corresponding to existing keys in the IxHash are changed. The elements can +also be set to any arbitrary supplied order. The familiar perl array +operations can also be performed on the IxHash. + + +=head2 Standard C Interface + +The standard C mechanism is available. This interface is +recommended for simple uses, since the usage is exactly the same as +regular Perl hashes after the C is declared. + + +=head2 Object Interface + +This module also provides an extended object-oriented interface that can be +used for more powerful operations with the IxHash. The following methods +are available: + +=over 8 + +=item FETCH, STORE, DELETE, EXISTS + +These standard C methods mandated by Perl can be used directly. +See the C entry in perlfunc(1) for details. + +=item Push, Pop, Shift, Unshift, Splice + +These additional methods resembling Perl functions are available for +operating on key-value pairs in the IxHash. The behavior is the same as the +corresponding perl functions, except when a supplied hash key already exists +in the hash. In that case, the existing value is updated but its order is +not affected. To unconditionally alter the order of a supplied key-value +pair, first C the IxHash element. + +=item Keys + +Returns an array of IxHash element keys corresponding to the list of supplied +indices. Returns an array of all the keys if called without arguments. +Note the return value is mostly only useful when used in a list context +(since perl will convert it to the number of elements in the array when +used in a scalar context, and that may not be very useful). + +If a single argument is given, returns the single key corresponding to +the index. This is usable in either scalar or list context. + +=item Values + +Returns an array of IxHash element values corresponding to the list of supplied +indices. Returns an array of all the values if called without arguments. +Note the return value is mostly only useful when used in a list context +(since perl will convert it to the number of elements in the array when +used in a scalar context, and that may not be very useful). + +If a single argument is given, returns the single value corresponding to +the index. This is usable in either scalar or list context. + +=item Indices + +Returns an array of indices corresponding to the supplied list of keys. +Note the return value is mostly only useful when used in a list context +(since perl will convert it to the number of elements in the array when +used in a scalar context, and that may not be very useful). + +If a single argument is given, returns the single index corresponding to +the key. This is usable in either scalar or list context. + +=item Delete + +Removes elements with the supplied keys from the IxHash. + +=item Replace + +Substitutes the IxHash element at the specified index with the supplied +value-key pair. If a key is not supplied, simply substitutes the value at +index with the supplied value. If an element with the supplied key already +exists, it will be removed from the IxHash first. + +=item Reorder + +This method can be used to manipulate the internal order of the IxHash +elements by supplying a list of keys in the desired order. Note however, +that any IxHash elements whose keys are not in the list will be removed from +the IxHash. + +=item Length + +Returns the number of IxHash elements. + +=item SortByKey + +Reorders the IxHash elements by textual comparison of the keys. + +=item SortByValue + +Reorders the IxHash elements by textual comparison of the values. + +=back + + +=head1 EXAMPLE + + use Tie::IxHash; + + # simple interface + $t = tie(%myhash, Tie::IxHash, 'a' => 1, 'b' => 2); + %myhash = (first => 1, second => 2, third => 3); + $myhash{fourth} = 4; + @keys = keys %myhash; + @values = values %myhash; + print("y") if exists $myhash{third}; + + # OO interface + $t = Tie::IxHash->new(first => 1, second => 2, third => 3); + $t->Push(fourth => 4); # same as $myhash{'fourth'} = 4; + ($k, $v) = $t->Pop; # $k is 'fourth', $v is 4 + $t->Unshift(neg => -1, zeroth => 0); + ($k, $v) = $t->Shift; # $k is 'neg', $v is -1 + @oneandtwo = $t->Splice(1, 2, foo => 100, bar => 101); + + @keys = $t->Keys; + @values = $t->Values; + @indices = $t->Indices('foo', 'zeroth'); + @itemkeys = $t->Keys(@indices); + @itemvals = $t->Values(@indices); + $t->Replace(2, 0.3, 'other'); + $t->Delete('second', 'zeroth'); + $len = $t->Length; # number of key-value pairs + + $t->Reorder(reverse @keys); + $t->SortByKey; + $t->SortByValue; + + +=head1 BUGS + +You cannot specify a negative length to C. Negative indexes are OK, +though. + +Indexing always begins at 0 (despite the current C<$[> setting) for +all the functions. + + +=head1 TODO + +Addition of elements with keys that already exist to the end of the IxHash +must be controlled by a switch. + +Provide C interface when it stabilizes in Perl. + +Rewrite using XSUBs for efficiency. + + +=head1 AUTHOR + +Gurusamy Sarathy gsar@umich.edu + +Copyright (c) 1995 Gurusamy Sarathy. All rights reserved. +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + + +=head1 VERSION + +Version 1.21 20 Nov 1997 + + +=head1 SEE ALSO + +perl(1) + +=cut diff --git a/t/Tie/README b/t/Tie/README new file mode 100644 index 0000000..6567ff7 --- /dev/null +++ b/t/Tie/README @@ -0,0 +1,7 @@ +This module exists here just to satisfy 'make test' +because it tests the -tie functionality. It is NOT +part of Config::General itself, which doesn't depend +on it. + + +Tom