use warnings;
use strict;

package Mixin::ExtraFields::Param;
use base qw(Mixin::ExtraFields);

use Carp ();

=head1 NAME

Mixin::ExtraFields::Param - make your class provide a familiar "param" method

=head1 VERSION

version 0.011

 $Id: /my/cs/projects/Mixin-ExtraFields-Param/trunk/lib/Mixin/ExtraFields/Param.pm 29059 2006-12-11T03:20:29.045283Z rjbs  $

=cut

our $VERSION = '0.011';

=head1 SYNOPSIS

  package Widget::Parametric;
  use Mixin::ExtraFields::Param -fields => { driver => 'HashGuts' };;

  ...

  my $widget = Widget::Parametric->new({ flavor => 'vanilla' });

  printf "%s: %s\n", $_, $widget->param($_) for $widget->param;

=head1 DESCRIPTION

This module mixes in to your class to provide a C<param> method like the ones
provided by L<CGI>, L<CGI::Application>, and other classes.  It uses
Mixin::ExtraFields, which means it can use any Mixin::ExtraFields driver to
store your data.

By default, the methods provided are:

=over

=item * param

=item * exists_param

=item * delete_param

=back

These methods are imported by the C<fields> group, which must be requested.  If
a C<moniker> argument is supplied, the moniker is used instead of "param".  For
more information, see L<Mixin::ExtraFields>.

=cut

sub default_moniker { 'param' }

sub methods { qw(param exists delete) }

sub method_name {
  my ($self, $method, $moniker) = @_;

  return $moniker if $method eq 'param';
  return $self->SUPER::method_name($method, $moniker);
}

sub build_method {
  my ($self, $method_name, $arg) = @_;
  
  return $self->_build_param_method($arg) if $method_name eq 'param';
  return $self->SUPER::build_method($method_name, $arg);
}

=head1 METHODS

=cut

=head2 param

 my @params = $object->param;        # get names of existing params

 my $value = $object->param('name'); # get value of a param

 my $value = $object->param(name => $value); # set a param's value

 my @values = $object->param(n1 => $v1, n2 => $v2, ...); # set many values

This method sets or retrieves parameters.

=cut

sub _build_param_method {
  my ($self, $arg) = @_;

  my $id_method = $arg->{id_method};
  my $driver    = $arg->{driver};

  my $names_method = $self->driver_method_name('get_all_names');
  my $get_method   = $self->driver_method_name('get');
  my $set_method   = $self->driver_method_name('set');

  sub {
    my $self = shift;
    my $id   = $self->$$id_method;

    # If called as ->param, return all names.
    return $$driver->$names_method($self, $id) unless @_;

    # If given a hashref, as first arg, operate on its contents.  In the
    # future, we might want to complain if we get a hashref /and/ further
    # arguments.
    @_ = %{$_[0]} if @_ == 1 and ref $_[0] eq 'HASH';
    
    Carp::croak "invalid call to param: odd, non-one number of params"
      if @_ > 1 and @_ % 2 == 1;

    # If called as ->param($name), return the value
    return $$driver->$get_method($self, $id, $_[0]) if @_ == 1;

    # Otherwise we're doing... BULK ASSIGNMENT!
    my @assigned;
    while (@_) {
      # We don't put @_ into a hash because we guarantee processing (and more
      # importantly return) order. -- rjbs, 2006-03-14
      my ($key, $value) = splice @_, 0, 2;
      $$driver->$set_method($self, $id, $key => $value);
      push @assigned, $value;
    }
    return wantarray ? @assigned : $assigned[0];
  };
}

=head1 AUTHOR

Ricardo SIGNES, C<< <rjbs@cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to L<http://rt.cpan.org>, for
Mixin-ExtraFields-Param.  I will be notified, and then you'll automatically be
notified of progress on your bug as I make changes.

=head1 COPYRIGHT

Copyright 2005-2006 Ricardo Signes, all rights reserved.

This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut

1;