view release on metacpan or  search on metacpan

lib/HTML/FormsDj.pm  view on Meta::CPAN

  }
  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(<span class="fielderror" id="%s">%s</span>), $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(<tr id="%s"><td class="%s tdlabel">%s</td><td class="%s tdinput">%s</td></tr>\n),
    $id, $class, $label, $class, $input;
}

sub _table {
  my($this, $id, $cdata, $legend) = @_;
  my $html = sprintf qq(<table id="%s">), $id;
  if ($legend) {
    $html .= sprintf qq(<thead><tr><td colspan="2">%s</td></tr></thead>\n), $legend;
  }
  $html .= sprintf qq(<tbody>%s</tbody></table>\n), $cdata;
  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};

lib/HTML/FormsDj.pm  view on Meta::CPAN

  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(<fieldset class="%s" id="%s"><legend>%s</legend>\n%s\n</fieldset>\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(<p class="%s" id="%s">%s</p>\n), $class, $id, $cdata;
}

sub _label {
  my ($this, $id, $name) = @_;
  return sprintf qq(\n  <label for="%s">%s</label>), $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  <input type="%s" id="%s" name="%s" value="%s"/>\n), $type, $id, $name, $value;
  }
  elsif ($type eq 'choice') {
    my $html = sprintf qq(\n  <select name="%s" id="%s">), $name, $id;
    if (ref($default) eq 'HASH') {
      foreach my $option (sort keys %{$default}) {
	$html .= sprintf qq(\n    <option value="%s">%s</option>), $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    <option value="%s"%s>%s</option>), $option->{value}, $selected, $option->{label};
      }
    }
    $html .= qq(\n  </select>\n);

  }
  elsif ($type eq 'option') {
    $html = qq(\n<ul>\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(<li>) . $this->_label(
					 $id . $option,
					 sprintf (qq(<input type="radio" value="%s" name="%s"%s/>), $option, $name, $checked)
					 . $default->{$option}
					 ) .
                 qq(\n</li>\n);
      }
    }
    elsif (ref($default) eq 'ARRAY') {
      foreach my $option (@{$default}) {
	my $checked = qq();
	if ($value eq $option->{value}) {
	  $checked = qq( checked="checked");
	}
	$html .= qq(<li>) . $this->_label(
					 $id . $option->{value},
					 sprintf (qq(<input type="radio" value="%s" name="%s"%s/>), $option->{value}, $name, $checked)
					 . $option->{label}
					 ) .
                 qq(\n</li>\n);
	;
      }
    }
    $html .= qq(\n</ul>);
  }
  elsif ($type eq 'textarea') {
    $html = sprintf qq(<textarea id="%s" name="%s">%s</textarea>\n), $id, $name, $value;
  }
  return $html;
}

sub _b {
  my($this, $cdata) = @_;
  return sprintf qq(<strong>%s</strong>), $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__

=head1 NAME

HTML::FormsDj - a web forms module the django way

=head1 SYNOPSIS

In your L<Dancer> app:

 use HTML::FormsDj;
 use Data::FormValidator;
 
 # a custom DFV constraint. You may also use one
 # of the supplied ones of Data::FormValidator
 sub valid_string { 
   return sub {
     my $dfv = shift;
     $dfv->name_this('valid_string');
     my $val = $dfv->get_current_constraint_value();
     return $val =~ /^[a-zA-Z0-9\-\._ ]{4,}$/;
   }
 }

 # our route, we act on GET and POST requests
 any '/addbook' => sub {
   my $form = new HTML::FormsDj(
      # the form, we maintain 2 form variables, title and author
      field => {
		title   => {
			    type     => 'text',
			    validate => valid_string(),
			    required => 1,
			},
		author  => {
			    type     => 'text',
			    validate => valid_string(),
			    required => 1,
			   },
	       },
      name         => 'registerform'
   );

  if ( request->method() eq "POST" ) {
    # a POST request, fetch the raw input and pass it to the form
    my %input = params;