view release on metacpan or  search on metacpan

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

    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 "<br>post: %s<br>cookie: %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(<pre>%s</pre>), $dump;
}

sub csrftoken {
  my($this) = @_;
  if ($this->{csrf}) {
    return sprintf qq(<input type="hidden" name="csrftoken" value="%s"/>), $_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(<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};
  }

  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(<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);

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

All other parameters are optional. If you omit them, or if you omit
the whole meta parameter, B<HTML::FormsDj> will generate it itself
using reasonable defaults based on the variable names.

Parameters of a field hash are:

=over

=item B<field>

As mentioned above, the name of the form variable.

=item B<label>

A label which will be put before the input field.

=item B<message>

A message, which will be shown if there are some
errors or if the field were missing.

=item B<classes>

A list (arrayref) of CSS class names to apply to the
field.

=item B<id>

A CSS id you may assign to the field.

=back

=head2 META FIELDSET

Sometimes a plain list of fields may not be sufficient, especially
if you have to render a large input form. You may use a B<fieldset>
instead of a B<field> to better organize the display of the form.

Again, using the example used above, you could write:

   my $form = new HTML::FormsDj(
      field => {
		title   => {
			    type     => 'text',
			    validate => valid_string(),
			    required => 1,
			},
		author  => {
			    type     => 'text',
			    validate => valid_string(),
			    required => 1,
			   },
	       },
      name => 'registerform',
      meta => {
                 fieldsets => [
                                {
                                  name        => 'titleset',
                                  description => 'Enter book title data here',
                                  legend      => 'Book Title',
                                  fields      => [
                                                   {
                                                    field    => 'title',
                                                    label    => 'Enter a book title',
                                                    message  => 'A book title must be at least 4 characters long',
                                                    classes  => [ qw(titlefield) ],
                                                   },
                                                  ]
                                },
                                {
                                  name        => 'authorset',
                                  description => 'Enter book author data here',
                                  legend      => 'Book Author',
                                  fields      => [
                                                   {
                                                    field    => 'author',
                                                    label    => 'Enter an author name',
                                                    message  => 'A book title must be at least 4 characters long',
                                                    classes  => [ qw(authorfield) ],
                                                   },
                                                  ]
                                },
                              ]
      }
   );

Ok, this looks a little bit more complicated. Essentially
there is just one more level in the definition. A fieldset
is just a list of groups of fields. It is defined as a list
(an arrayref) which contains hashes, one hash per fieldset.

Each fieldset hash consists of some parameters, like a B<name>
or a B<legend> plus a list of fields, which is exactly defined
as in the B<meta> parameter B<fields> as seen above.

The output of the form is just devided into fieldsets, which
is a HTML tag as well. Each fieldset will have a title, the B<legend>
parameter, an (optional) B<description> and a B<name>.

This is the very same as the META subclass in django forms
is working.

B<Please note: you cannot mix a field list and fieldsets!>

Only one of the two is possible.

If you omit the B<meta> parameter at all, B<HTML::FormsDj> will
always generate a plain field list.

=head2 ADDING DEFAULT VALUES

IN some cases you'll need to put some defaults for form
variables, eg. for choices or options.

You can do this by adding a B<default> parameter to
the field definition in your meta hash.

For text type variables this can just be a scalar. For choices
and options you can supply a hash- or an array reference.

An example for a choice:

  # other fields
  ,
  {
    field => 'redirect',
    label => 'Redirect to page',
    default => [
                   {
                    value => 1,
                    label => '/home'
                   },
                   {
                    value => 2,
                    label => '/profile'
                   }
                ],
  }
  ,
  # other fields

In this example we've a choice which contains two values
for the generated select form tag. Here we've used an array,
which is the preferred way since this preserves order.

However, you might also supply a hash:

  # other fields
  ,
  {
    field => 'redirect',
    label => 'Redirect to page',
    default => {
                 1 => '/home',
                 2 => '/profile'
                }
  }