File Coverage

blib/lib/CGI/State.pm

Criterion	Covered	Total	%
statement	42	44	95.4
branch	19	24	79.1
condition	12	19	63.1
subroutine	7	7	100.0
pod	2	2	100.0
total	82	96	85.4

package CGI::State;

use strict;
use integer;
use overload;
use CGI ();

use vars qw($VERSION);

$VERSION = (qw$Revision: 0.02 $)[-1];

#Returns a state hashref
sub state {
  my $class = shift;
  my $cgi   = shift;
  my $state = shift || {};

  #Alternative calling method is with a hash, rather
  #than a CGI object.  This allows validation before
  #building a multi-dimensional hash from submitted
  #values.
  if(ref $cgi eq 'HASH') {
    $cgi = CGI->new($cgi);
  }

  foreach my $param ($cgi->param) {

    my @words = split(/[\.\[\]]+/o, $param);
    my $node  = $state;

    for( my $w = 0;          #start at the first word
         $w < scalar @words; #go until the end
         $w++ ){             #increment the w count

      #If the next word is undefined, then we must
      #be looking at the last node.  If the next word
      #is a non-number, it must be a hashref, otherwise,
      #it is an arrayref.
      my $over_write = 0;

      my $next = (not defined $words[$w + 1])
        ? ($over_write++, $cgi->param($param))
        : $words[$w + 1] =~ /\D/
          ? {}
          : [];

      #Figures out if this is a reference to a hash,
      #array, an object or even an over-loaded object.
      my ($ref) = overload::StrVal($node) =~ /^(?:.*\=)?([^=]*)\([^\(]*\)$/o;

      $node = $ref eq 'HASH'
          ? $over_write
            ? ($node->{ $words[$w] }   = $next)
            : ($node->{ $words[$w] } ||= $next)
          : $over_write
            ? ($node->[ $words[$w] ]   = $next)
            : ($node->[ $words[$w] ] ||= $next);
    }
  }

  return $state;
}

#Takes the state, and returns a CGI object representing
#a "flattened" representation of state.
sub cgi {
  my $class  = shift;
  my $state  = shift;
  my $cgi    = shift || CGI->new('');
  my $param  = shift || '';

  #Figures out if this is a reference to a hash,
  #array, an object or even an over-loaded object.
  if(my $ref = ref $state) {

    #If it's really necessary, then use overload::StrVal
    unless($ref eq 'HASH' or $ref eq 'ARRAY') {
      $ref = overload::StrVal($state) =~ /([^=]*)\(/o;
    }

    if($ref eq 'ARRAY') {

      for( my $index = 0;           #start at the first word
           $index < scalar @$state; #go until the end
           $index++ ){
        $class->cgi( $state->[$index], $cgi, "$param\[$index\]" );
      }

    } elsif($ref eq 'HASH') {

      $param .= '.' unless $param eq '';

      foreach my $key (keys %$state) {
        $class->cgi( $state->{$key}, $cgi, $param.$key );
      }

    }

  } elsif(defined $state and $param ne '') {

    $cgi->param($param, $state);

  }

  return $cgi;
}

1;

__END__