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