File Coverage

blib/lib/HTML/FormsDj.pm

Criterion	Covered	Total	%
statement	99	317	31.2
branch	26	136	19.1
condition	6	23	26.0
subroutine	18	35	51.4
pod	5	13	38.4
total	154	524	29.3

package HTML::FormsDj;

use strict;
use warnings;

our $VERSION = '0.03';

use Data::FormValidator;
use Data::FormValidator::Constraints;
use Data::Dumper;
use Carp::Heavy;
use Digest::SHA;
use Carp;

our $_csrftoken;

sub new {
  my($this, %param) = @_;
  my $class = ref($this) || $this;
  my $self = \%param;
  bless $self, $class;


  if (exists $self->{meta}->{fields} && exists  $self->{meta}->{fieldsets}) {
    croak 'Either use meta->fields or meta->fieldsets, not both!';
  }

  if (! exists $self->{field}) {
    croak 'No FIELDS hash specified!';
  }

  if (! exists $self->{meta}) {
    $self->{meta} = {};
  }

  if (! exists $self->{meta}->{fields} && ! exists $self->{meta}->{fieldsets}) {
    # generate them if the user doesn't bother
    $self->{meta}->{fields} = [];
    foreach my $field (sort keys %{$self->{field}}) {
      my $n = $field;
      $n =~ s/^(.)/uc($1)/e;
      push @{$self->{meta}->{fields}}, { field => $field, label => $n };
    }
  }

  if (exists $self->{csrf}) {
    if ($self->{csrf} && ! $_csrftoken) {
      my $sha = Digest::SHA->new('SHA-256');
      $sha->reset();
      $self->{sha} = $sha;
      $_csrftoken = $self->_gen_csrf_token();
    }
  }
  else {
    $self->{csrf} = 0;
  }

  return $self;
}

sub cleandata {
  my($this, %data) = @_;

  # construct validator structs
  my(@required, @optional, %input, %attrs, %constraints);

  $this->{isclean} = 0;

  if ($this->{csrf}) {
    if(! $this->_check_csrf(%data)) {
      # CSRF check failed, so we don't tamper with input
      # further. die and done.
      return ();
    }
  }

  if (exists $this->{dfv}) {
    # override all
    %input = %{$this->{dfv}};
  }
  else {
    # generate dfv hash
    foreach my $field (keys %{$this->{field}}) {
      if($this->{field}->{$field}->{required}) {
	push @required, $field;
      }
      else {
	push @optional, $field;
      }
      $constraints{ $field } = $this->{field}->{$field}->{validate};
      $input{ $field } = $data{ $field } || qq();
    }
  }

  if (exists $this->{attributes}) {
    # there are dfv options, pass them as is
    %attrs = %{$this->{attributes}};
  }
  if(! exists $attrs{required}) {
    $attrs{required} = \@required;
  }
  if(! exists $attrs{optional}) {
    $attrs{optional} = \@optional;
  }
  if(! exists $attrs{constraint_methods}) {
    $attrs{constraint_methods} = \%constraints;
  }

  # validate the input
  my $results = Data::FormValidator->check(\%input, \%attrs);

  if ($results->has_invalid or $results->has_missing) {
    # store errors for later output
    $this->{isclean} = 0;
    if ( $results->has_missing ) {
      foreach my $field ( $results->missing ) {
	$this->{missing}->{$field} = 1;
      }
    }
    if ( $results->has_invalid ) {
      foreach my $field ( $results->invalid ) {
	my $failed = $results->invalid( $field );
	if (ref($failed) eq 'HASH') {
	  $this->{invalid}->{$field} = join ', ', @{$failed->{$field}};
	}
	else {
	  $this->{invalid}->{$field} = join ', ', @{$failed};
	}
      }
    }
  }
  else {
    if(exists $this->{clean}) {
      # call the custom clean() closure supplied by the user
      ($this->{isclean}, $this->{error}) = $this->{clean}(%{$results->valid});
    }
    else {
      $this->{isclean} = 1;
    }
  }


  # store cleaned and raw data
  $this->{cleaned} = $results->valid;
  $this->{raw}     = \%data;

  return %{$this->{cleaned}};
}

sub clean {
  my($this) = @_;
  return $this->{isclean};
}

sub error {
  my($this) = @_;
  if(exists $this->{error}) {
    return $this->{error};
  }
  else {
    return qq();
  }
}

sub _check_csrf {
  my ($this, %data) = @_;

  if (! exists $data{csrftoken}) {
    $this->{error}   = 'CSRF ERROR: CSRF token is not supplied with POST data!';
    return 0;
  }

  if (! exists $this->{'_csrf_cookie'}) {
    $this->{error}   = 'CSRF ERROR: CSRF cookie is not set correctly(notexist)!';
    return 0;
  }
  else {
    if(! $this->{'_csrf_cookie'} ) {
      $this->{error}   = 'CSRF ERROR: CSRF cookie is not set correctly(undef)!';
      return 0;
    }
  }

  my $posttoken   = $data{csrftoken};          # hidden post var
  my $cookietoken = $this->{'_csrf_cookie'};   # cookie

  if ($posttoken ne $cookietoken) {
    $this->{error}   = 'CSRF ERROR:  supplied COOKIE csrftoken doesnt match stored csrf token!';
    $this->{error}  .= sprintf "post: %scookie: %s", $posttoken, $cookietoken;
    return 0;
  }

  return 1;
}

sub as_p {
  my($this) = @_;
  my $html;
  $this->_normalize();

  if ($this->{csrf}) {
    $html = $this->csrftoken();
  }

  if (exists $this->{meta}->{fields}) {
    # just an array of fields
    foreach my $field( @{$this->{meta}->{fields}}) {
      $html .= $this->_p_field($field);
    }
  }
  else {
    # it's a fieldset
    foreach my $fieldset (@{$this->{meta}->{fieldsets}}) {
      my $htmlfields;
      foreach my $field (@{$fieldset->{fields}}) {
	$htmlfields .= $this->_p_field($field);
      }
      $html .= $this->_fieldset(
				join(' ', @{$fieldset->{classes}}),
				$fieldset->{id},
				$fieldset->{legend},
				$htmlfields
				);
    }
  }

  return $html;
}

sub as_table {
  my($this) = @_;
  my $html;
  $this->_normalize();

  if ($this->{csrf}) {
    $html = $this->csrftoken();
  }

  if (exists $this->{meta}->{fields}) {
    # just an array of fields
    foreach my $field( @{$this->{meta}->{fields}}) {
      $html .= $this->_tr_field($field);
    }
    return $this->_table('formtable', $html);
  }
  else {
    # it's a fieldset
    foreach my $fieldset (@{$this->{meta}->{fieldsets}}) {
      my $htmlfields;
      foreach my $field (@{$fieldset->{fields}}) {
	$htmlfields .= $this->_tr_field($field);
      }
      $html .= $this->_table($fieldset->{id}, $htmlfields, $fieldset->{legend});
    }
  }

  return $html;
}

sub as_is {
  my($this) = @_;
  $this->_normalize();
  return $this->{meta};
}

sub fields {
  my($this) = @_;
  if (exists $this->{meta}->{fields}) {
    return @{$this->{meta}->{fields}};
  }
  else {
    return ();
  }
}

sub fieldsets {
  my($this) = @_;
  if (exists $this->{meta}->{fieldsets}) {
    return @{ $this->{meta}->{fieldsets} };
  }
  else {
    return ();
  }
}

sub dumpmeta {
  my($this) = @_;
  my $dump = Dumper($this->{meta});
  $dump =~ s/^\$VAR1 = /        /;
  return sprintf qq(%s), $dump;
}

sub csrftoken {
  my($this) = @_;
  if ($this->{csrf}) {
    return sprintf qq(), $_csrftoken;
  }
  else {
    return qq();
  }
}

sub getcsrf {
  my($this) = @_;
  if ($this->{csrf}) {
    return $_csrftoken;
  }
  else {
    return qq();
  }
}

sub csrfcookie {
  my($this, $token) = @_;
  if ($this->{csrf}) {
    $this->{'_csrf_cookie'} = $token;
  }
  return 1;
}

#
# INTERNALS HERE
#

sub _message {
  my($this, $message, $id) = @_;
  return sprintf qq(%s), $id, $message;
}

sub _tr_field {
  my($this, $field) = @_;
  return $this->_tr(
		   join(q( ), @{$field->{classes}}),
		   $field->{id},
		   $this->_label(
				 $field->{id} . '_input',
				 $field->{label}
				),
		   $this->_input(
				 $field->{id} . '_input',
				 $field->{type},
				 $field->{field},
				 $field->{value},
				 $field->{default} # hashref, arrayref or scalar
				) .
		    $this->_message($field->{message}, $field->{id} . '_message')
		  );
}

sub _tr {
  my($this, $class, $id, $label, $input) = @_;
  return sprintf qq(
    $id, $class, $label, $class, $input;
}

sub _table {
  my($this, $id, $cdata, $legend) = @_;
  my $html = sprintf qq(), $id; \n), $legend; %s




359




0




  
  0
  




 





 





 





0



   if ($legend) { 




360




0





 





 





 





 





0



     $html .= sprintf qq(%s




361




 





 





 





 





 





 



   } 




362




0





 





 





 





 





0



   $html .= sprintf qq(\n), $cdata;
  if ($legend) {
    $html .= sprintf qq(
  }
  $html .= sprintf qq(
  return $html;
}

sub _normalize_field {
  my($this, $field) = @_;

  if (! exists $field->{label}) {
    $field->{label} = $field->{field};
    $field->{label} =~ s/^(.)/uc($1)/e;
  }

  if (exists $this->{markrequired} && $this->{field}->{$field->{field}}->{required}) {
    if ($this->{markrequired} eq 'asterisk') {
      $field->{label} = $field->{label} . ' *';
    }
    elsif ($this->{markrequired} eq 'bold') {
      $field->{label} = $this->_b($field->{label});
    }
    else {
      $field->{label} = $field->{label} . $this->{markrequired};
    }
  }

  if (! exists $field->{classes}) {
    $field->{classes} = [ qw(formfield) ];
  }

  if (! exists $field->{id}) {
    $field->{id} = 'id_formfield_' . $field->{field};
  }

  if (! exists  $field->{message}) {
    $field->{message} = qq();
  }
  if (exists $this->{invalid}->{$field->{field}}) {
    if (! exists $field->{message}) {
      $field->{message} = 'invalid input';
    }
    $field->{error} = $this->{invalid}->{$field->{field}};
  }

  if (exists $this->{missing}->{$field->{field}}) {
    if (! exists $field->{message}) {
      $field->{message} = 'missing input';
    }
    $field->{error} = 'missing input';
  }

  if (! exists $this->{raw}->{$field->{field}}) {
    $field->{value} = qq();
  }
  else {
    $field->{value} = $this->{raw}->{$field->{field}};
  }

  if (! exists $this->{field}->{$field->{field}}->{type}) {
    $field->{type} = 'text';
  }
  else {
    $field->{type} = $this->{field}->{$field->{field}}->{type};
  }

  if (! exists $field->{default}) {
    $field->{default} = qq();
  }

  return $field;
}

sub _normalize {
  my($this) = @_;

  if (exists $this->{meta}->{fields}) {
    my @normalized;
    foreach my $field( @{$this->{meta}->{fields}}) {
      if (! exists $field->{field}) {
	carp 'unnamed field, ignoring!';
	next;
      }

      push @normalized, $this->_normalize_field($field);
    }
    $this->{meta}->{fields} = \@normalized;
  }

  if (exists $this->{meta}->{fieldsets}) {

    my @fieldsets;
    foreach my $fieldset (@{$this->{meta}->{fieldsets}}) {
      if (! exists $fieldset->{id}) {
	if (! exists $fieldset->{name}) {
	  $fieldset->{id} = 'id_fieldset_' . $.;
	}
	else {
	  $fieldset->{id} = 'id_fieldset_' . $fieldset->{name};
	}
      }

      if (! exists $fieldset->{classes}) {
	$fieldset->{classes} = [ qw(formfieldset) ];
      }

      if (! exists $fieldset->{legend}) {
	$fieldset->{legend} = qq();
      }

      my @normalized;
      foreach my $field (@{$fieldset->{fields}}) {
	if (! exists $field->{field}) {
	  carp 'unnamed field, ignoring!';
	  next;
	}
	push @normalized, $this->_normalize_field($field);
      }

      $fieldset->{fields} = \@normalized;
      push @fieldsets, $fieldset;
    }
    $this->{meta}->{fieldsets} = \@fieldsets;
  }

  return;
}


sub _fieldset {
  my($this, $class, $id, $legend, $cdata) = @_;
  return sprintf qq(%s\n%s\n\n),
    $class, $id, $legend, $cdata;
}

sub _p_field {
  my($this, $field) = @_;
  return $this->_p(
		   join(' ', @{$field->{classes}}),
		   $field->{id},
		   $this->_label(
				 $field->{id} . '_input',
				 $field->{label}
				) .
		   $this->_input(
				 $field->{id} . '_input',
				 $field->{type},
				 $field->{field},
				 $field->{value},
				 $field->{default} # hashref, arrayref or scalar
				) .
		   $this->_message($field->{message}, $field->{id} . '_message')
		  );
}

sub _p {
  my ($this, $class, $id, $cdata) = @_;
  return sprintf qq(%s\n), $class, $id, $cdata;
}

sub _label {
  my ($this, $id, $name) = @_;
  return sprintf qq(\n  %s), $id, $name;
}

sub _input {
  my ($this, $id, $type, $name, $value, $default) = @_;

  my $html;

  if ($type eq 'text' || $type eq 'password') {
    if (! $value) {
      $value = $default;
    }
    $html = sprintf qq(\n  \n), $type, $id, $name, $value;
  }
  elsif ($type eq 'choice') {
    my $html = sprintf qq(\n  ), $name, $id;
    if (ref($default) eq 'HASH') {
      foreach my $option (sort keys %{$default}) {
	$html .= sprintf qq(\n    %s), $option, $default->{$option};
      }
    }
    elsif (ref($default) eq 'ARRAY') {
      foreach my $option (@{$default}) {
	my $selected = qq();
	if ($value eq $option->{value}) {
	  $selected = ' selected';
	}
	$html .= sprintf qq(\n    %s), $option->{value}, $selected, $option->{label};
      }
    }
    $html .= qq(\n  \n);

  }
  elsif ($type eq 'option') {
    $html = qq(\n\n);
    if (ref($default) eq 'HASH') {
      foreach my $option (sort keys %{$default}) {
	my $checked = qq();
	if ($value eq $option->{value}) {
	  $checked = qq( checked="checked");
	}
	$html .= qq() . $this->_label(
					 $id . $option,
					 sprintf (qq(), $option, $name, $checked)
					 . $default->{$option}
					 ) .
                 qq(\n\n);
      }
    }
    elsif (ref($default) eq 'ARRAY') {
      foreach my $option (@{$default}) {
	my $checked = qq();
	if ($value eq $option->{value}) {
	  $checked = qq( checked="checked");
	}
	$html .= qq() . $this->_label(
					 $id . $option->{value},
					 sprintf (qq(), $option->{value}, $name, $checked)
					 . $option->{label}
					 ) .
                 qq(\n\n);
	;
      }
    }
    $html .= qq(\n);
  }
  elsif ($type eq 'textarea') {
    $html = sprintf qq(%s\n), $id, $name, $value;
  }
  return $html;
}

sub _b {
  my($this, $cdata) = @_;
  return sprintf qq(%s), $cdata;
}

sub _gen_csrf_token {
  my($this) = @_;
  $this->{sha}->add(rand(10));
  $this->{sha}->add(time);
  my $csrftoken = $this->{sha}->hexdigest();
  $this->{sha}->reset();
  return $csrftoken;
}

1;

__END__