pax_global_header00006660000000000000000000000064146402775640014531gustar00rootroot0000000000000052 comment=79ccd0870eb7a49d64f578e688b2bb2e04120662 libtie-aliashash-perl-1.02/000077500000000000000000000000001464027756400156165ustar00rootroot00000000000000libtie-aliashash-perl-1.02/Build.PL000066400000000000000000000011201464027756400171040ustar00rootroot00000000000000use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'Tie::AliasHash', license => 'perl', dist_author => q{Aldo Calpini }, dist_version_from => 'lib/Tie/AliasHash.pm', configure_requires => { 'Module::Build' => 0, }, add_to_cleanup => [ 'Tie-AliasHash-*' ], create_makefile_pl => 'traditional', meta_merge => { resources => { repository => 'https://github.com/dada/Tie-AliasHash', }, }, ); $builder->create_build_script(); libtie-aliashash-perl-1.02/Changes000066400000000000000000000006311464027756400171110ustar00rootroot00000000000000Revision history for Tie-AliashHash 1.02 2016-03-11 Moved to github, using Build.PL instead of Makefile.PL, added license 1.01 2003-06-26 Fixed a bug in the EXISTS sub, now works as documented (thanks wk) 1.00 2001-03-07 First released version 0.01 2001-02-20 Original version; created by h2xs 1.20 with options -CAXn Tie::AliasHash libtie-aliashash-perl-1.02/MANIFEST000066400000000000000000000001511464027756400167440ustar00rootroot00000000000000lib/Tie/AliasHash.pm Build.PL MANIFEST README Changes t/AliasHash.t Makefile.PL META.yml META.json libtie-aliashash-perl-1.02/META.json000066400000000000000000000015521464027756400172420ustar00rootroot00000000000000{ "abstract" : "Hash with aliases key (multiple keys, one value)", "author" : [ "Aldo Calpini " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4204", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Tie-AliasHash", "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0" } } }, "provides" : { "Tie::AliasHash" : { "file" : "lib/Tie/AliasHash.pm", "version" : "1.02" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "https://github.com/dada/Tie-AliasHash" } }, "version" : "1.02" } libtie-aliashash-perl-1.02/META.yml000066400000000000000000000011121464027756400170620ustar00rootroot00000000000000--- abstract: 'Hash with aliases key (multiple keys, one value)' author: - 'Aldo Calpini ' build_requires: {} configure_requires: Module::Build: 0 dynamic_config: 1 generated_by: 'Module::Build version 0.4204, CPAN::Meta::Converter version 2.131560' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Tie-AliasHash provides: Tie::AliasHash: file: lib/Tie/AliasHash.pm version: 1.02 resources: license: http://dev.perl.org/licenses/ repository: https://github.com/dada/Tie-AliasHash version: 1.02 libtie-aliashash-perl-1.02/Makefile.PL000066400000000000000000000004341464027756400175710ustar00rootroot00000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4204 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Tie::AliasHash', 'VERSION_FROM' => 'lib/Tie/AliasHash.pm', 'PREREQ_PM' => {}, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; libtie-aliashash-perl-1.02/README000066400000000000000000000023141464027756400164760ustar00rootroot00000000000000NAME Tie::AliasHash - Hash with aliases key (multiple keys, one value) SYNOPSIS use Tie::AliasHash; tie %hash, 'Tie::AliasHash'; $hash{ 'foo', 'bar' } = 'baz'; print $hash{foo}; # prints 'baz' print $hash{bar}; # prints 'baz' too $hash{bar} = 'zab'; # $hash{foo} is changed too print $hash{foo}; # prints 'zab' DESCRIPTION Tie::AliasHash creates hashes that can have multiple keys for a single value. This means that some keys are just 'aliases' for other keys. The example shown in the synopsys above creates a key 'foo' and an alias key 'bar'. The two keys share the same value, so that fetching either of them will always return the same value, and storing a value in one of them will change both. HISTORY v1.02 (11 Mar 2016) Moved to github, using Build.PL instead of Makefile.PL, added license. v1.01 (26 Jun 2003) Fixed a bug in the EXISTS sub, now works as documented (thanks wk) v1.00 (07 Mar 2001) First released version v0.01 (20 Feb 2001) Original version; created by h2xs 1.20 with options -CAXn Tie::AliasHash AUTHOR Aldo Calpini libtie-aliashash-perl-1.02/lib/000077500000000000000000000000001464027756400163645ustar00rootroot00000000000000libtie-aliashash-perl-1.02/lib/Tie/000077500000000000000000000000001464027756400171055ustar00rootroot00000000000000libtie-aliashash-perl-1.02/lib/Tie/AliasHash.pm000066400000000000000000000326611464027756400213100ustar00rootroot00000000000000package Tie::AliasHash; use strict; use vars qw( @ISA @EXPORT_OK $VERSION ); require Exporter; @ISA = qw(Exporter); @EXPORT_OK = qw( allkeys ); $VERSION = '1.02'; #### constants sub _HASH () { 0 } sub _ALIAS () { 1 } sub _ALIAS_REV () { 2 } sub _ALIAS_REV_IDX () { 3 } sub _JOLLY () { 4 } #### data structure is: #### $self = [ #### _HASH (the real hash) #### realkey => value #### _ALIAS (the aliases (forward lookup)) #### alias => realkey #### _ALIAS_REV (the aliases (reverse lookup)) #### realkey => [alias1, alias2, aliasN] #### _ALIAS_REV_IDX (the alias indices in _ALIAS_REV) #### alias1 => 0 #### alias2 => 1 #### aliasN => N #### _JOLLY (where unknown keys will be sent) #### ] #### tie stuff sub TIEHASH { my($class, @aliases) = @_; my $self = bless [ {}, {}, {}, {}, undef ], $class; my($key, $alias); foreach $alias ( @aliases ) { if(ref($alias) eq "ARRAY") { $self->add_alias( @$alias ); } else { if($^W) { warn( "Tie::AliasHash: argument '$alias' to hash is not an ARRAY ref!" ); } } } return $self; } sub FETCH { my($self, $key) = @_; $key = $self->realkey($key) if $self->is_alias($key); $key = $self->[_JOLLY] if not $self->is_key($key) and defined $self->[_JOLLY]; return $self->[_HASH]->{$key}; } sub STORE ($\@$) { my($self, $key, $value) = @_; my @keys; if( ref($key) eq "ARRAY" ) { @keys = @$key; } else { @keys = split( $;, $key); } $key = $keys[0] if scalar(@keys) > 1; $key = $self->realkey($key) if $self->is_alias($key); $key = $self->[_JOLLY] if not $self->is_key($key) and defined $self->[_JOLLY]; $self->[_HASH]->{$key} = $value; if(@keys > 1) { $self->add_alias( @keys ); } } sub FIRSTKEY { my($self) = @_; my @init = keys %{ $self->[_HASH] }; my ($k, $v) = each %{ $self->[_HASH] }; return $k; } sub NEXTKEY { my($self) = @_; my ($k, $v) = each %{ $self->[_HASH] }; return $k; } sub EXISTS { my($self, $key) = @_; return ( $self->is_key($key) or $self->is_alias($key) ); } sub DELETE { my($self, $key) = @_; $key = $self->realkey($key) if $self->is_alias($key); $self->remove_aliases( $key ); delete ${ $self->[_HASH] }{$key} if exists $self->[_HASH]->{$key}; } sub CLEAR { my($self) = @_; $self->[_HASH] = {}; $self->[_ALIAS] = {}; $self->[_ALIAS_REV] = {}; $self->[_ALIAS_REV_IDX] = {}; $self->[_JOLLY] = undef; } #### methods sub add_alias { my $self = shift; my $key = shift; $key = $self->realkey($key) if $self->is_alias($key); my $alias; while(defined( $alias = shift )) { $self->[_ALIAS]->{$alias} = $key; if(exists ${ $self->[_ALIAS_REV] }{$key}) { push( @{ $self->[_ALIAS_REV]->{$key} }, $alias ); $self->[_ALIAS_REV_IDX]->{$alias} = $#{ $self->[_ALIAS_REV]->{$key} }; } else { $self->[_ALIAS_REV]->{$key} = [ $alias ]; $self->[_ALIAS_REV_IDX]->{$alias} = 0; } } } sub remove_alias { my($self, $alias) = @_; my $key = $self->realkey( $alias ); delete ${ $self->[_ALIAS] }{$alias}; splice( @{ $self->[_ALIAS_REV]->{$key} }, $self->[_ALIAS_REV_IDX]->{$alias}, 1 ); delete ${ $self->[_ALIAS_REV_IDX] }{$alias}; } sub remove_aliases { my($self, $key) = @_; my $alias; foreach $alias ( @{ $self->[_ALIAS_REV]->{$key} } ) { delete ${ $self->[_ALIAS] }{$alias}; delete ${ $self->[_ALIAS_REV_IDX] }{$alias}; } delete ${ $self->[_ALIAS_REV] }{$key}; } sub aliases { my($self, $key) = @_; return @{ $self->[_ALIAS_REV]->{$key} }; } sub remove { my($self, @keys) = @_; foreach my $key (@keys) { if( $self->is_alias( $key ) ) { $self->remove_alias( $key ); } elsif( $self->is_key( $key ) ) { $self->remove_aliases( $key ); delete ${ $self->[_HASH] }{$key}; } } } sub allkeys(\%) { my $self = shift; $self = tied %{ $self } if ref $self eq "HASH"; return (keys %{$self->[_HASH]}), (keys %{$self->[_ALIAS]}); } sub realkey { my($self, $key) = @_; if($self->is_alias($key)) { return $self->[_ALIAS]->{$key}; } elsif($self->is_key($key)) { return $key; } else { return undef; } } sub is_alias { my($self, $key) = @_; return exists ${ $self->[_ALIAS] }{$key}; } sub is_key { my($self, $key) = @_; return exists ${ $self->[_HASH] }{$key}; } sub set_jolly { my($self, $key) = @_; $self->[_JOLLY] = $key; } sub remove_jolly { my($self) = @_; $self->[_JOLLY] = undef; } 1; __END__ =head1 NAME Tie::AliasHash - Hash with aliases key (multiple keys, one value) =head1 SYNOPSIS use Tie::AliasHash; tie %hash, 'Tie::AliasHash'; $hash{ 'foo', 'bar' } = 'baz'; print $hash{foo}; # prints 'baz' print $hash{bar}; # prints 'baz' too $hash{bar} = 'zab'; # $hash{foo} is changed too print $hash{foo}; # prints 'zab' =head1 DESCRIPTION B creates hashes that can have multiple keys for a single value. This means that some keys are just 'aliases' for other keys. The example shown in the synopsys above creates a key 'foo' and an alias key 'bar'. The two keys share the same value, so that fetching either of them will always return the same value, and storing a value in one of them will change both. The only difference between the two keys is that 'bar' is not reported by keys() and each(): use Tie::AliasHash; tie %hash, 'Tie::AliasHash'; tied(%hash)->add_alias( 'foo', 'bar' ); foreach $k (keys %hash) { print "$k\n"; } # prints 'foo' To get the 'real' keys and the aliases together, use the C function: use Tie::AliasHash; tie %hash, 'Tie::AliasHash'; tied(%hash)->add_alias( 'foo', 'bar' ); foreach $k (tied(%hash)->allkeys) { print "$k\n"; } # prints 'foo' and 'bar' You can create alias keys with 3 methods: =over 4 =item * pre-declaring them while tieing the hash The 'tie' constructor accepts an optional list of key names and aliases. The synopsis is: tie %HASH, 'Tie::AliasHash', KEY => ALIAS, KEY => [ALIAS, ALIAS, ALIAS, ...], ... =item * explicitly with the add_alias method tied(%hash)->add_alias( KEY, ALIAS ); tied(%hash)->add_alias( KEY, ALIAS, ALIAS, ALIAS, ... ); =item * implicitly with a multiple-key hash assignement $hash{ KEY, ALIAS } = VALUE; $hash{ KEY, ALIAS, ALIAS, ALIAS, ... } = VALUE; The list of keys and aliases can be either an array reference, eg.: $hash{ [ 'foo', 'bar', 'baz' ] } = $value; $hash{ \@foobarbaz } = $value; or an explicit list, eg.: $hash{ qw(foo bar baz) } = $value; $hash{ @foobarbaz } = $value; Be warned that, with the last example, Perl uses the C<$;> variable (or subscript separator), which defaults to '\034' (ASCII 28). This can cause problems if you plan to use keys with arbitrary ASCII characters. Always use the first form when in doubt. Consult L for more information. =back =head2 EXPORT None by default. You can optionally export the C function to your main namespace, so that it can be used like the builtin C. use Tie::AliasHash 'allkeys'; tie %hash, 'Tie::AliasHash'; foreach $k (allkeys %hash) { print "$k\n"; } But see L below for important information about C. =head2 METHODS =over 4 =item add_alias( KEY, ALIAS, [ALIAS, ALIAS, ...] ) Add one or more ALIAS for KEY. If KEY itself is an alias, the aliases are added to the real key which KEY points to. =item aliases( KEY ) Returns a list of all the aliases defined for KEY. If KEY itself is an alias, returns the real key pointed by KEY, as well as any other alias (thus excluding KEY itself) it has. =item allkeys Returns all the (real) keys of the hash, as well as all the aliases. =item is_alias( KEY ) Returns true if the specified KEY is an alias, false otherwise (either if KEY does not exists in the hash, or it is a real key). =item is_key( KEY ) Returns true if the specified KEY is a real key, false otherwise (either if KEY does not exists in the hash, or it is an alias for another key). =item remove( KEY ) Remove KEY from the hash: if KEY is a real key, it is removed with all its aliases. If KEY is an alias, B. This is different from the builtin C, see L below. =item remove_alias( ALIAS ) Removes the specified ALIAS from its real key. ALIAS is no longer an alias and can be assigned its own value. The real key which ALIAS used to point to is left unchanged. =item remove_aliases( KEY ) Removes all the aliases defined for KEY. =item remove_jolly( ) Removes the 'jolly' key from the hash. Operations on non-existant keys are restored to normality. =item set_jolly( KEY ) Sets the 'jolly' key to KEY. When you set a jolly key, all fetch and store operations on non-existant keys will be done on KEY instead. =back =head1 CAVEATS This module can generate a wonderful amount of confusion if not used properly. The package should really have a big 'HANDLE WITH CARE' sticker on it. Other than paying special attention to what you're doing, you should be aware of the following subtlenesses: =over 4 =item * transitivity Aliases are 'transitive', and always resolve to their aliased key. This means that if you write: use Tie::AliasHash; tie %hash, 'Tie::AliasHash'; tied(%hash)->add_alias( 'foo', 'bar' ); tied(%hash)->add_alias( 'bar', 'baz' ); C<$hash{baz}> is created as an alias for C<$hash{foo}>, not for C<$hash{bar}> (which isn't a real key). This also means that if you later change C<$hash{bar}> to point to something else, B C<$hash{baz}>: tied(%hash)->add_alias( 'gup', 'bar' ); # $hash{bar} is now really --> $hash{gup} # $hash{baz} is still --> $hash{foo} =item * delete The builtin C function resolves aliases to real keys, so it deletes everything even when called on an alias: use Tie::AliasHash; tie %hash, 'Tie::AliasHash'; tied(%hash)->add_alias( 'foo', 'bar' ); delete $hash{bar}; # deletes $hash{foo} too! To delete an alias leaving its key intact, use the C method instead: use Tie::AliasHash; tie %hash, 'Tie::AliasHash'; tied(%hash)->add_alias( 'foo', 'bar' ); tied(%hash)->remove_alias( 'bar' ); # $hash{foo} remains intact =item * exists The builtin C function returns true on aliases too: use Tie::AliasHash; tie %hash, 'Tie::AliasHash'; tied(%hash)->add_alias( 'foo', 'bar' ); print exists $hash{'foo'}; # TRUE print exists $hash{'bar'}; # TRUE To distinguish between aliases and real keys, use the C method: print exists $hash{'foo'} and tied(%hash)->is_key('foo'); # TRUE print exists $hash{'bar'} and tied(%hash)->is_key('bar'); # FALSE =item * allkeys If you export C into your main namespace, it can be used as the builtin C in the following code: use Tie::AliasHash 'allkeys'; tie %hash, 'Tie::AliasHash'; foreach $key (allkeys %hash) { print "$key\n"; } But note that C is always a function call, so this does not work as you expect: foreach $key (sort allkeys %hash) { print "$key\n"; } You have to fool C, or it will use C as its sort routine. This can be done by providing an explicit sort routine, or forcing the result of C to be interpreted as an array by referencing-dereferencing it, or with a two-step operation where you first assign C to an array, and then operate on it: foreach $key (sort { $a cmp $b } allkeys %hash) { print "$key\n"; } foreach $key (sort @{[ allkeys %hash ]}) { print "$key\n"; } @allkeys = allkeys %hash; foreach $key (sort @allkeys) { print "$key\n"; } =item * the 'jolly' key The most potentially confusing feature of this module is the 'jolly' key. When you set a value for it, all 'unknown' keys become aliases for the jolly key. This means that B in the hash, because if a key does not exists, the value will be 'redirected' to the jolly key. We make an example of how this works and for what can be useful. Suppose you have a table of records with a 'city' field. You want to count the occurrencies for Rome, Paris and London (possibly expressed in different languages), and count every other city as 'Other'. tie %cities, 'Tie::AliasHash'; $cities{['Rome', 'Roma', 'Rom']} = 0; $cities{['Paris', 'Parigi']} = 0; $cities{['London', 'Londra', 'Londres']} = 0; $cities{'Other'} = 0; tied(%cities)->set_jolly('Other'); while($city = get_city()) { $cities{$city}++; } foreach $city (sort keys %cities) { print "$city:\t$cities{$city}\n"; } A possible output for the above script can be: London: 4 Other: 92 Paris: 7 Rome: 16 Also note that the use of the jolly key is limited to fetch and store, it does not affect other hash operations, like exists, delete, each, keys and values. =back =head1 HISTORY =over 4 =item v1.02 (11 Mar 2016) Moved to github, using Build.PL instead of Makefile.PL, added license. =item v1.01 (26 Jun 2003) Fixed a bug in the EXISTS sub, now works as documented (thanks wk) =item v1.00 (07 Mar 2001) First released version =item v0.01 (20 Feb 2001) Original version; created by h2xs 1.20 with options -CAXn Tie::AliasHash =back =head1 AUTHOR Aldo Calpini =cut libtie-aliashash-perl-1.02/t/000077500000000000000000000000001464027756400160615ustar00rootroot00000000000000libtie-aliashash-perl-1.02/t/AliasHash.t000066400000000000000000000062751464027756400201150ustar00rootroot00000000000000use strict; use Test; BEGIN { plan tests => 24 } use vars qw( $loaded $test %hash $eq @keys ); #### use use Tie::AliasHash qw( allkeys ); ok ('1', '1', "use"); #### construction tie %hash, 'Tie::AliasHash', [ 1 => qw( one ein un uno unos ) ], [ 2 => qw( two zwei dois due dos ) ], [ I => 'me' ]; ok( ref(tied %hash), qr/Tie::AliasHash/, "construction", ); #### simple alias $hash{I} = "dada"; ok( "$hash{I}, $hash{me}", "dada, dada", "simple alias (forward)", ); $hash{me} = 'dada@perl.it'; ok ( "$hash{me}, $hash{I}", 'dada@perl.it, dada@perl.it', "simple alias (reverse)", ); #### multiple aliases $hash{1} = 7; $eq = $hash{1} + $hash{one} + $hash{ein} + $hash{un} + $hash{uno} + $hash{unos}; ok( $eq, 42, "multiple aliases", ); #### keys $hash{2} = 2; @keys = sort keys %hash; ok( join( ", ", @keys ), "1, 2, I", "keys", ); #### exists ok( exists($hash{1}), 1, "exists (on key)", ); ok( exists($hash{one}), 1, "exists (on alias)", ); #### allkeys method @keys = sort @{[ (tied %hash)->allkeys ]}; ok( join( ", ", @keys ), "1, 2, I, dois, dos, due, ein, me, one, two, un, uno, unos, zwei", "allkeys (as a method)", ); @keys = sort @{[ allkeys(%hash) ]}; ok( join( ", ", @keys ), "1, 2, I, dois, dos, due, ein, me, one, two, un, uno, unos, zwei", "allkeys (as a function)", ); #### aliases method @keys = sort @{[ tied(%hash)->aliases('1') ]}; ok( join( ", ", @keys ), "ein, one, un, uno, unos", "aliases", ); #### add_alias method (tied %hash)->add_alias( 'foo', 'bar' ); $hash{foo} = 42; ok( $hash{bar}, 42, "add_alias", ); #### remove_alias method (tied %hash)->remove_alias( 'bar' ); $hash{bar} = 0; ok( "$hash{foo}, $hash{bar}", "42, 0", "remove_alias", ); #### is_alias method ok( (tied %hash)->is_alias( 'me' ), '1', "is_alias (on an alias)", ); ok( (tied %hash)->is_alias( 'I' ), '', "is_alias (on a key)", ); #### is_key method ok( (tied %hash)->is_key( 'me' ), '', "is_key (on an alias)", ); ok( (tied %hash)->is_key( 'I' ), '1', "is_key (on a key)" ); #### $; and [] constructs $hash{ qw( foo bar baz ) } = 42; ok( join( ", ", $hash{foo}, $hash{bar}, $hash{baz} ), "42, 42, 42", "multiple assignement (\$; construct)", ); $hash{ [qw( foo bar baz )] } = 42; ok( join( ", ", $hash{foo}, $hash{bar}, $hash{baz} ), "42, 42, 42", "multiple assignement ([] construct)", ); (tied %hash)->remove( 'foo', 'bar', 'baz' ); #### alias transitivity $hash{ 'foo', 'bar' } = 'nothing'; $hash{ 'bar', 'baz' } = 42; ok( $hash{foo}, 42, "alias transitivity (with assignement)", ); $hash{ 'FOO' } = 42; tied(%hash)->add_alias( 'FOO', 'BAR' ); tied(%hash)->add_alias( 'BAR', 'BAZ' ); ok( $hash{BAZ}, 42, "alias transitivity (with add_alias)", ); #### 'jolly' delete $hash{'foo'}; delete $hash{'bar'}; delete $hash{'baz'}; tied(%hash)->set_jolly( 'foo' ); $hash{foo} = 1; $hash{bar} += 1; ok( $hash{foo}, 2, "set_jolly (1)", ); ok( $hash{baz}, 2, "set_jolly (2)", ); tied(%hash)->remove_jolly(); ok( defined($hash{baz}), '', "remove_jolly", ); #### the end untie %hash;