Dogcows Code - chaz/p5-CGI-Ex/blob - samples/app/cgi_ex_2.cgi

   1 #!/usr/bin/perl -w
   2
   3 =head1 NAME
   4
   5 cgi_ex_2.cgi - Rewrite of cgi_ex_1.cgi using CGI::Ex::App
   6
   7 =cut
   8
   9 use strict;
  10 use base qw(CGI::Ex::App);
  11 use CGI::Ex::Dump qw(debug);
  12
  13 if ($0 eq __FILE__) {
  14     __PACKAGE__->navigate;
  15 }
  16
  17 ### show what hooks ran when we are done
  18 sub post_navigate { debug shift->dump_history }
  19
  20 ### this will work for both userinfo_hash_common and _success_hash_common
  21 sub hash_common {
  22     return {
  23         title => 'My Application',
  24         color => ['#ccccff', '#aaaaff'],
  25     };
  26 }
  27
  28 ###----------------------------------------------------------------###
  29
  30 sub main_hash_validation {
  31     return {
  32         'group order' => ['username', 'password'],
  33         username => {
  34             required => 1,
  35             min_len  => 3,
  36             max_len  => 30,
  37             match    => 'm/^\w+$/',
  38             # could probably all be done with match => 'm/^\w{3,30}$/'
  39         },
  40         password => {
  41             required => 1,
  42             max_len  => 20,
  43         },
  44         password_verify => {
  45             validate_if => 'password',
  46             equals      => 'password',
  47         },
  48     };
  49 }
  50
  51 sub main_finalize {
  52     my $self = shift;
  53     my $form = $self->form;
  54     debug $form;
  55     return 1;
  56 }
  57
  58 sub main_next_step { '_success' }
  59
  60 sub main_file_print {
  61     return \ qq {
  62     <html>
  63     <head>
  64       <title>[% title %]</title>
  65       <style>
  66       .error {
  67         display: block;
  68         color: red;
  69         font-weight: bold;
  70       }
  71       </style>
  72     </head>
  73     <body>
  74     <h1 style='color:blue'>Please Enter information</h1>
  75     <span style='color:red'>[% error_header %]</span>
  76     <br>
  77
  78     <form name="[% form_name %]" action="[% script_name %]" method="POST">
  79     <input type=hidden name=processing value=1>
  80
  81     <table>
  82     <tr bgcolor=[% color.0 %]>
  83       <td>Username:</td>
  84       <td>
  85         <input type=text size=30 name=username>
  86         <span class=error id=username_error>[% username_error %]</span></td>
  87     </tr>
  88     <tr bgcolor=[% color.1 %]>
  89       <td>Password:</td>
  90       <td><input type=password size=20 name=password>
  91         <span class=error id=password_error>[% password_error %]</span></td>
  92     </tr>
  93     <tr bgcolor=[% color.0 %]>
  94       <td>Password Verify:</td>
  95       <td><input type=password size=20 name=password_verify>
  96         <span class=error id=password_verify_error>[% password_verify_error %]</span></td>
  97     </tr>
  98     <tr bgcolor=[% color.1 %]>
  99       <td colspan=2 align=right><input type=submit value=Submit></td>
 100     </tr>
 101
 102     </table>
 103
 104     </form>
 105
 106     [% js_validation %]
 107     </body>
 108     </html>
 109 };
 110 }
 111
 112 ###----------------------------------------------------------------###
 113
 114 sub _success_file_print {
 115     return \ qq{
 116     <html>
 117     <head><title>[% title %]</title></head>
 118     <body>
 119     <h1 style='color:green'>Success</h1>
 120     <br>
 121     I can now continue on with the rest of my script!
 122     </body>
 123     </html>
 124 };
 125 }
 126
 127 ###----------------------------------------------------------------###
 128 ### These methods override the base functionality of CGI::Ex::App
 129
 130 sub ready_validate { shift->form->{'processing'} ? 1 : 0 }
 131
 132 sub set_ready_validate {
 133     my $self = shift;
 134     my ($step, $is_ready) = (@_ == 2) ? @_ : (undef, shift);
 135     if ($is_ready) {
 136         $self->form->{'processing'} = 1;
 137     } else {
 138         delete $self->form->{'processing'};
 139     }
 140 }
 141
 142
 143 __END__
 144