PciIds/Html/Forms.pm

   1 package PciIds::Html::Forms;
   2 use strict;
   3 use warnings;
   4 use base 'Exporter';
   5 use CGI;
   6 use HTML::Entities;
   7
   8 our @EXPORT = qw(&genForm &getForm &genFormEx &getFormValue &genRadios);
   9
  10 sub genFormEx( $$ ) {
  11         my( $inputs, $values ) = @_;
  12         foreach( @{$inputs} ) {
  13                 my( $kind, $label, $type, $name, $other ) = @{$_};
  14                 $other = '' unless( defined $other );
  15                 print '<tr><td>'.$label.'<td><'.$kind.( ( defined $type ) ? ' type="'.$type.'"' : '' ).' name="'.$name.'" '.$other.( defined( $values->{$name} && ( $label ne 'textarea' ) ) ? 'value="'.encode_entities( $values->{$name} ).'" ' : '' ).">\n";
  16                 if( $kind eq 'textarea' ) {
  17                         print encode_entities( $values->{$name} ) if( defined( $values->{$name} ) );
  18                         print "</$kind>\n";
  19                 }
  20         }
  21 }
  22
  23 sub genForm( $$ ) {
  24         my( $inputs, $values ) = @_;
  25         my @transformed;
  26         foreach( @{$inputs} ) {
  27                 my @ln = @{$_};
  28                 unshift @ln, "input";
  29                 push @transformed, \@ln;
  30         }
  31         genFormEx( \@transformed, $values );
  32 }
  33
  34 sub getFormValue( $$ ) {
  35         my( $name, $default ) = @_;
  36         my $result = CGI::param( $name );
  37         $result = $default unless( defined( $result ) );
  38         return $result;
  39 }
  40
  41 sub getForm( $$ ) {
  42         my( $data, $checks ) = @_;
  43         my %result;
  44         my @errors;
  45         foreach( keys %{$data} ) {
  46                 my $d = CGI::param( $_ );
  47                 my $sub = $data->{$_};
  48                 my ( $err, $newval ) = &{$sub}( $d ) if( defined $sub );
  49                 $d = $newval if( defined $newval );
  50                 push @errors, $err if( defined $err );
  51                 $result{$_} = $d;
  52         }
  53         foreach( @{$checks} ) {
  54                 my $err = &{$_}( \%result );
  55                 push @errors, $err if( defined $err );
  56         }
  57         return ( \%result, ( @errors ) ? ( join '<p>', ( '', @errors ) ) : undef );
  58 }
  59
  60 sub genRadios( $$$ ) {
  61         my( $list, $name, $default ) = @_;
  62         foreach( @{$list} ) {
  63                 my( $label, $value ) = @{$_};
  64                 print "<input type='radio' name='$name' value='$value'".( $value eq $default ? " checked='checked' " : "" )."> $label<br>\n";
  65         }
  66 }
  67
  68 1;