[Templates-cvs] cvs commit: TT3/lib/Template/VObject Hash.pm
cvs@template-toolkit.org
cvs@template-toolkit.org
Mon, 29 Mar 2004 14:50:04 +0100
cvs 04/03/29 13:50:03
Added: lib/Template/VObject Hash.pm
Log:
* added Template::VObject::Hash
Revision Changes Path
1.1 TT3/lib/Template/VObject/Hash.pm
Index: Hash.pm
===================================================================
#========================================================================
#
# Template::VObject::Hash
#
# DESCRIPTION
# Virtual object providing providing methods for manipulating hash
# arrays.
#
# AUTHOR
# Andy Wardley <abw@wardley.org>
#
# COPYRIGHT
# Copyright (C) 1996-2004 Andy Wardley. All Rights Reserved.
# Copyright (C) 1998-2002 Canon Research Centre Europe Ltd.
# Copyright (C) 2004 Fotango Ltd.
#
# This module is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# REVISION
# $Id: Hash.pm,v 1.1 2004/03/29 13:50:03 abw Exp $
#
#========================================================================
package Template::VObject::Hash;
use strict;
use warnings;
use Template::VObject;
use base qw( Template::VObject );
use vars qw( $VERSION $DEBUG $ERROR $THROW $METHODS );
$VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
$DEBUG = 0 unless defined $DEBUG;
$ERROR = '';
$THROW = 'Hash';
$METHODS = {
# contructor methods
new => \&new,
clone => \&clone,
copy => \©,
# metadata methods
ref => __PACKAGE__->can('ref'),
type => \&type,
# converter methods
hash => \&hash,
list => \&list,
text => \&text,
# inspector methods
size => \&size,
each => \&each,
keys => \&keys,
values => \&values,
kvhash => \&kvhash,
kvlist => \&kvlist,
# accessor methods
item => \&item,
exists => \&exists,
defined => \&defined,
# sorting methods
sort => \&sort,
nsort => \&nsort,
# mutating methods
delete => \&delete,
import => \&import,
};
# TODO: get(), set(), any others?
#------------------------------------------------------------------------
# new() [% Hash.new(a=10, b=20) %]
#
# Accepts a hash reference which is blessed into a hash object, or
# a list of named parameters which are merged into a hash and blessed.
#------------------------------------------------------------------------
sub new {
my $class = shift;
$class = ref $class || $class;
my $self;
if (@_ && UNIVERSAL::isa($_[0], $class)) {
# copy Hash object passed as argument
$self = shift;
$self = $self->copy();
}
elsif (@_ && UNIVERSAL::isa($_[0], 'HASH')) {
# bless hash array passed as argument
$self = shift;
}
else {
# construct new hash array from list of named parameters
$self = { @_ };
}
bless $self, $class;
}
#------------------------------------------------------------------------
# clone() [% hash.clone %]
#
# Returns a copy of the hash blessed as another Hash object.
#------------------------------------------------------------------------
sub clone {
my $self = shift;
$self->new($self, @_);
}
#------------------------------------------------------------------------
# copy() [% hash.copy %]
#
# Returns an unblessed copy of the hash.
#------------------------------------------------------------------------
sub copy {
my $self = shift;
my $hash = @_ && UNIVERSAL::isa($_[0], 'HASH') ? shift : { @_ };
return { %$self, %$hash };
}
#------------------------------------------------------------------------
# type() [% hash.type %]
#
# Returns 'Hash'.
#------------------------------------------------------------------------
sub type {
return 'Hash';
}
#------------------------------------------------------------------------
# hash() [% hash.hash %]
#
# Returns a reference to the hash array/object unmodified.
#------------------------------------------------------------------------
sub hash {
return $_[0];
}
#------------------------------------------------------------------------
# list() [% hash.list %]
#
# Returns the hash reference as the single item in a list.
#------------------------------------------------------------------------
sub list {
return [ $_[0] ];
}
#------------------------------------------------------------------------
# text() [% hash.text %]
#
# Generate a text representation of the hash.
#------------------------------------------------------------------------
sub text {
my ($hash, $joint1, $joint2) = @_;
$joint1 = ' => ' unless defined $joint1;
$joint2 = ', ' unless defined $joint2;
return join($joint2, map {
my $val = $hash->{ $_ };
$val = '' unless defined $val;
"$_$joint1$val";
} sort keys %$hash);
}
#------------------------------------------------------------------------
# size() [% hash.size %]
#
# Returns the nubmer of key/value pairs in the hash.
#------------------------------------------------------------------------
sub size {
my $self = shift;
return scalar CORE::keys %$self;
}
#------------------------------------------------------------------------
# each() [% hash.each %]
#
# Returns the hash keys and values flattened to a list.
#------------------------------------------------------------------------
sub each {
my $self = shift;
[ %$self ];
}
#------------------------------------------------------------------------
# keys() [% hash.keys %]
#
# Returns a list of the hash keys.
#------------------------------------------------------------------------
sub keys {
my $self = shift;
[ CORE::keys %$self ]
}
#------------------------------------------------------------------------
# values() [% hash.values %]
#
# Returns a list of the hash values.
#------------------------------------------------------------------------
sub values {
my $self = shift;
[ CORE::values %$self ];
}
#------------------------------------------------------------------------
# kvhash() [% hash.kvhash %]
#
# Returns a reference to a list containing references to hash arrays,
# each of which contains a key and value from the hash array.
#------------------------------------------------------------------------
sub kvhash {
my $self = shift;
[ map { { key => $_, value => $self->{ $_ } } } CORE::keys %$self ];
}
#------------------------------------------------------------------------
# kvlist() [% hash.kvlist %]
#
# Returns a reference to a list containing references to lists, each of
# which contains a key and value from the hash array.
#------------------------------------------------------------------------
sub kvlist {
my $self = shift;
[ map { [ $_, $self->{ $_ } ] } CORE::keys %$self ];
}
#------------------------------------------------------------------------
# item($key) [% hash.item('foo') %]
#
# Returns the item in the hash corresponding to the key passed as an
# argument.
#------------------------------------------------------------------------
sub item {
my ($self, $key) = @_;
$key = '' unless defined $key;
$self->{ $key };
}
#------------------------------------------------------------------------
# exists($key) [% hash.exists('foo') %]
#
# Returns true if the $key specified exists in the hash.
#------------------------------------------------------------------------
sub exists {
my ($self, $key) = @_;
$key = '' unless defined $key;
CORE::exists $self->{ $key };
}
#------------------------------------------------------------------------
# defined($key) [% hash.defined('foo') %]
#
# Returns true if the $key specified is defined in the hash.
#------------------------------------------------------------------------
sub defined {
my ($self, $key) = @_;
$key = '' unless defined $key;
CORE::defined $self->{ $key };
}
#------------------------------------------------------------------------
# sort() [% hash.sort %]
#
# Returns the keys of the hash alphabetically sorted according to the
# values.
#------------------------------------------------------------------------
sub sort {
my $hash = shift;
[ CORE::sort { lc $hash->{$a} cmp lc $hash->{$b} } (CORE::keys %$hash) ];
}
#------------------------------------------------------------------------
# nsort() [% hash.nsort %]
#
# Returns the keys of the hash numerically sorted according to the
# values.
#------------------------------------------------------------------------
sub nsort {
my $hash = shift;
no warnings;
[ CORE::sort { $hash->{$a} <=> $hash->{$b} } (CORE::keys %$hash) ];
}
#------------------------------------------------------------------------
# delete($key) [% hash.delete(key) %]
#
# Deletes the entry in the hash indexed by the key passed as an argument.
# Returns the value deleted, if any.
#------------------------------------------------------------------------
sub delete {
my ($self, $key) = @_;
$key = '' unless defined $key;
CORE::delete $self->{ $key };
}
#------------------------------------------------------------------------
# import($newhash) [% hash.import(newhash) %]
#
# Imports the values in the hash passed by reference as the $newhash
# argument into the current hash.
#------------------------------------------------------------------------
sub import {
my $self = shift;
return unless CORE::ref $self; # ignore call at load time by use
my $hash = @_ && UNIVERSAL::isa($_[0], 'HASH') ? shift : { @_ };
@$self{ CORE::keys %$hash } = CORE::values %$hash;
return $self;
}
1;
__END__
=head1 NAME
Template::VObject::Hash - hash virtual object
=head1 SYNOPSIS
# TODO
=head1 DESCRIPTION
Note: we use the term 'list' interchangeably with 'array' here. Technically
speaking we mean "reference to an array" when we say "reference to a list"
and so on, but we don't worry too much about the distinction in TT land.
Note: all these methods can be called as subroutines, passing a reference to
a hash array as the first argument.
my $hash = Template::VObject::Hash->new( a => 10 );
$hash->keys(); # [ a ]
my $data = { b => 20 };
Template::VObject::Hash::keys($data); # [ b ]
# lookup method from hash object, pass raw hash data as argument
$hash->can('keys')->($data); # [ b ]
=head2 METHODS
=head3 new()
Constructor method to create a new hash array. A reference to a Hash
object, hash array or a list of named parameters can be passed as
argument(s) to define the contents of the Hash object. If a Hash
object is passed as an argument then it is first cloned. If a
reference to a hash array is passed then it is blessed into a Hash
object without being copied. If a list of named parameters is passed
then they are merged into a new hash array which is then blessed and
returned as a Hash object.
=head3 clone()
Creates a new Hash object as a copy of the current one. A reference
to a Hash object, hash array or a list of named parameters can be
passed as argument(s) to define any additional data items to be added
to the cloned Hash object.
=head3 copy()
Returns a reference to an unblessed hash array containing a copy of
the current Hash object and any additional items passed by reference
to another Hash object, hash array or as a list of named parameters.
=head3 ref()
Returns the string 'HASH', equivalent to Perl's ref() function.
=head3 type()
Returns the string 'Hash' to indicate the TT data type.
=head3 hash()
Returns the Hash object unchanged, effectively a null operation.
=head3 list()
Returns a reference to a list containing the Hash object as a single item.
=head3 text($keyval_delim,$items_delim)
Returns a text representation of the hash array. One or two optional
arguments can be provided. The first is used to define a delimiter to
be used between key/value pairs. The default value is C<< S< =E<gt> > >>.
The second argument can be used to provide an alternate delimiter to be
used between successive pairs of items. The default value is
C<< S<, > >>.
=head3 keys()
Returns a reference to a list containing the keys of the hash array,
as per Perl's keys() function.
=head3 values()
Returns a reference to a list containing the values of the hash array,
as per Perl's values() function.
=head3 each()
Returns a reference to a list containing the interleaved keys and
values of the hash array.
=head3 kvlist()
Returns a reference to a list containing references to lists, each of which
contains a key and value from the hash array.
=head3 kvhash()
Returns a reference to a list containing references to hash arrays,
each of which contains a key and value from the hash array.
=head3 item($key)
TODO
=head3 exists($key)
TODO
=head3 defined($key)
TODO
=head3 sort()
Sorts the I<values> in the hash array alphabetically and returns a
list of I<keys> corresponding to that order. If you want a list of
keys in sorted order, then simply call the keys() method and sort the
values returned.
=head3 nsort()
As per sort(), but returns the keys corresponding to the values sorted
numerically.
=head3 delete($key)
Delete an item from the hash.
=head3 import($hash)
Import the contents of another hash.
=head1 AUTHOR
Andy Wardley E<lt>abw@wardley.orgE<gt>
=head1 VERSION
$Revision: 1.1 $
=head1 COPYRIGHT
Copyright (C) 1996-2004 Andy Wardley. All Rights Reserved.
Copyright (C) 1998-2002 Canon Research Centre Europe Ltd.
Copyright (C) 2004 Fotango Ltd.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4: