use strict;
use warnings;
package Data::Hive::Store::Param;
# ABSTRACT: CGI::param-like store for Data::Hive
$Data::Hive::Store::Param::VERSION = '1.012';
use parent 'Data::Hive::Store';
#pod =head1 DESCRIPTION
#pod
#pod This hive store will soon be overhauled.
#pod
#pod Basically, it expects to access a hive in an object with CGI's C<param> method,
#pod or the numerous other things with that interface.
#pod
#pod =method new
#pod
#pod # use default method name 'param'
#pod my $store = Data::Hive::Store::Param->new($obj);
#pod
#pod # use different method name 'info'
#pod my $store = Data::Hive::Store::Param->new($obj, { method => 'info' });
#pod
#pod # escape certain characters in keys
#pod my $store = Data::Hive::Store::Param->new($obj, { escape => './!' });
#pod
#pod Return a new Param store.
#pod
#pod Several interesting arguments can be passed in a hashref after the first
#pod (mandatory) object argument.
#pod
#pod =begin :list
#pod
#pod = method
#pod
#pod Use a different method name on the object (default is 'param').
#pod
#pod This method should have the "usual" behavior for a C<param> method:
#pod
#pod =for :list
#pod * calling C<< $obj->param >> with no arguments returns all param names
#pod * calling C<< $obj->param($name) >> returns the value for that name
#pod * calling C<< $obj->param($name, $value) >> sets the value for the name
#pod
#pod The Param store does not check the types of values, but for interoperation with
#pod other stores, sticking to simple scalars is a good idea.
#pod
#pod = path_packer
#pod
#pod This is an object providing the L<Data::Hive::PathPacker> interface. It will
#pod convert a string to a path (arrayref) or the reverse. It defaults to a
#pod L<Data::Hive::PathPacker::Strict>.
#pod
#pod = exists
#pod
#pod This is a coderef used to check whether a given parameter name exists. It will
#pod be called as a method on the Data::Hive::Store::Param object with the path name
#pod as its argument.
#pod
#pod The default behavior gets a list of all parameters and checks whether the given
#pod name appears in it.
#pod
#pod = delete
#pod
#pod This is a coderef used to delete the value for a path from the hive. It will
#pod be called as a method on the Data::Hive::Store::Param object with the path name
#pod as its argument.
#pod
#pod The default behavior is to call the C<delete> method on the object providing
#pod the C<param> method.
#pod
#pod =end :list
#pod
#pod =cut
sub path_packer { $_[0]{path_packer} }
sub name { $_[0]->path_packer->pack_path($_[1]) }
sub new {
my ($class, $obj, $arg) = @_;
$arg ||= {};
my $guts = {
obj => $obj,
path_packer => $arg->{path_packer} || do {
require Data::Hive::PathPacker::Strict;
Data::Hive::PathPacker::Strict->new;
},
method => $arg->{method} || 'param',
exists => $arg->{exists} || sub {
my ($self, $key) = @_;
my $method = $self->{method};
my $exists = grep { $key eq $_ } $self->param_store->$method;
return ! ! $exists;
},
delete => $arg->{delete} || sub {
my ($self, $key) = @_;
$self->param_store->delete($key);
},
};
return bless $guts => $class;
}
sub param_store { $_[0]{obj} }
sub _param {
my $self = shift;
my $meth = $self->{method};
my $path = $self->name(shift);
return $self->param_store->$meth($path, @_);
}
sub get {
my ($self, $path) = @_;
return $self->_param($path);
}
sub set {
my ($self, $path, $val) = @_;
return $self->_param($path => $val);
}
sub exists {
my ($self, $path) = @_;
my $code = $self->{exists};
my $key = $self->name($path);
return $self->$code($key);
}
sub delete {
my ($self, $path) = @_;
my $code = $self->{delete};
my $key = $self->name($path);
return $self->$code($key);
}
sub keys {
my ($self, $path) = @_;
my $method = $self->{method};
my @names = $self->param_store->$method;
my %is_key;
PATH: for my $name (@names) {
my $this_path = $self->path_packer->unpack_path($name);
next unless @$this_path > @$path;
for my $i (0 .. $#$path) {
next PATH unless $this_path->[$i] eq $path->[$i];
}
$is_key{ $this_path->[ $#$path + 1 ] } = 1;
}
return keys %is_key;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Data::Hive::Store::Param - CGI::param-like store for Data::Hive
=head1 VERSION
version 1.012
=head1 DESCRIPTION
This hive store will soon be overhauled.
Basically, it expects to access a hive in an object with CGI's C<param> method,
or the numerous other things with that interface.
=head1 METHODS
=head2 new
# use default method name 'param'
my $store = Data::Hive::Store::Param->new($obj);
# use different method name 'info'
my $store = Data::Hive::Store::Param->new($obj, { method => 'info' });
# escape certain characters in keys
my $store = Data::Hive::Store::Param->new($obj, { escape => './!' });
Return a new Param store.
Several interesting arguments can be passed in a hashref after the first
(mandatory) object argument.
=over 4
=item method
Use a different method name on the object (default is 'param').
This method should have the "usual" behavior for a C<param> method:
=over 4
=item *
calling C<< $obj->param >> with no arguments returns all param names
=item *
calling C<< $obj->param($name) >> returns the value for that name
=item *
calling C<< $obj->param($name, $value) >> sets the value for the name
=back
The Param store does not check the types of values, but for interoperation with
other stores, sticking to simple scalars is a good idea.
=item path_packer
This is an object providing the L<Data::Hive::PathPacker> interface. It will
convert a string to a path (arrayref) or the reverse. It defaults to a
L<Data::Hive::PathPacker::Strict>.
=item exists
This is a coderef used to check whether a given parameter name exists. It will
be called as a method on the Data::Hive::Store::Param object with the path name
as its argument.
The default behavior gets a list of all parameters and checks whether the given
name appears in it.
=item delete
This is a coderef used to delete the value for a path from the hive. It will
be called as a method on the Data::Hive::Store::Param object with the path name
as its argument.
The default behavior is to call the C<delete> method on the object providing
the C<param> method.
=back
=head1 AUTHORS
=over 4
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Ricardo Signes <rjbs@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Hans Dieter Pearcey.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut