PciIds/Html/Forms.pm

   1 #       PciIds web database
   2 #       Copyright (C) 2008 Michal Vaner (vorner@ucw.cz)
   3 #
   4 #       This program is free software; you can redistribute it and/or modify
   5 #       it under the terms of the GNU General Public License as published by
   6 #       he Free Software Foundation; either version 2 of the License, or
   7 #       (at your option) any later version.
   8 #
   9 #       This program is distributed in the hope that it will be useful,
  10 #       but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 #       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 #
  13 #       GNU General Public License for more details.
  14 #
  15 #       You should have received a copy of the GNU General Public License
  16 #       along with this program; if not, write to the Free Software
  17 #       Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  18
  19 package PciIds::Html::Forms;
  20 use strict;
  21 use warnings;
  22 use base 'Exporter';
  23 use CGI;
  24 use HTML::Entities;
  25
  26 our @EXPORT = qw(&genForm &getForm &genFormEx &getFormValue &genRadios);
  27
  28 sub genFormEx( $$ ) {
  29         my( $inputs, $values ) = @_;
  30         print "<col class='label'><col class='edit'>\n";
  31         foreach( @{$inputs} ) {
  32                 my( $kind, $label, $type, $name, $other ) = @{$_};
  33                 $other = '' unless( defined $other );
  34                 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";
  35                 if( $kind eq 'textarea' ) {
  36                         print encode_entities( $values->{$name} ) if( defined( $values->{$name} ) );
  37                         print "</$kind>\n";
  38                 }
  39         }
  40 }
  41
  42 sub genForm( $$ ) {
  43         my( $inputs, $values ) = @_;
  44         my @transformed;
  45         foreach( @{$inputs} ) {
  46                 my @ln = @{$_};
  47                 unshift @ln, "input";
  48                 push @transformed, \@ln;
  49         }
  50         genFormEx( \@transformed, $values );
  51 }
  52
  53 sub getFormValue( $$ ) {
  54         my( $name, $default ) = @_;
  55         my $result = CGI::param( $name );
  56         $result = $default unless( defined( $result ) );
  57         return $result;
  58 }
  59
  60 sub getForm( $$ ) {
  61         my( $data, $checks ) = @_;
  62         my %result;
  63         my @errors;
  64         foreach( keys %{$data} ) {
  65                 my $d = CGI::param( $_ );
  66                 my $sub = $data->{$_};
  67                 my ( $err, $newval ) = &{$sub}( $d ) if( defined $sub );
  68                 $d = $newval if( defined $newval );
  69                 push @errors, $err if( defined $err );
  70                 $result{$_} = $d;
  71         }
  72         foreach( @{$checks} ) {
  73                 my $err = &{$_}( \%result );
  74                 push @errors, $err if( defined $err );
  75         }
  76         return ( \%result, ( @errors ) ? ( join '<p>', ( '', @errors ) ) : undef );
  77 }
  78
  79 sub genRadios( $$$ ) {
  80         my( $list, $name, $default ) = @_;
  81         foreach( @{$list} ) {
  82                 my( $label, $value ) = @{$_};
  83                 print "<input type='radio' name='$name' value='$value'".( $value eq $default ? " checked='checked' " : "" )."> $label<br>\n";
  84         }
  85 }
  86
  87 1;