view release on metacpan or  search on metacpan

sbin/asphelper  view on Meta::CPAN

<div>
  <span class="label required">First Name:</span>
  <input type="text" name="first_name" value="<%= \$Server->HTMLEncode( \$Form->{first_name} ) %>" />
  <% \$err->('first_name'); %>
</div>

<div>
  <span class="label required">Last Name:</span>
  <input type="text" name="last_name" value="<%= \$Server->HTMLEncode( \$Form->{last_name} ) %>" />
  <% \$err->('last_name'); %>
</div>

<div>
  <span class="label required">Email Address:</span>
  <input type="text" name="email_address" value="<%= \$Server->HTMLEncode( \$Form->{email_address} ) %>" />
  <% \$err->('email_address'); %>
</div>

<div>
  <span class="label required">Your Message:</span>
  <textarea rows="6" cols="40" name="message"><%= \$Server->HTMLEncode( \$Form->{message} ) %></textarea>
  <% \$err->('email_address'); %>
</div>

<div>
  <span class="label optional">&nbsp;</span>
  <input type="submit" value="Submit Form" />
</div>

</form>
</body>
</html>
<%
  map { delete( \$Session->{\$_} ) } qw/
    validation_errors
    __lastArgs
    msg
  /;
%>
ASP
close($contact_asp);

mkdir( "$args->{domain}/handlers/examples" );
open my $handler_ofh, '>', "$args->{domain}/handlers/examples/contact.pm";
print $handler_ofh <<'HANDLER';

package examples::contact;

use strict;
use warnings 'all';
use base 'Apache2::ASP::FormHandler';
use vars __PACKAGE__->VARS;
use Data::Properties::YAML;


#==============================================================================
sub run
{
  my ($s, $context) = @_;
  
  if( my $errors = $s->validate( $context ) )
  {
    $Session->{__lastArgs} = $Form;
    $Session->{validation_errors} = $errors;
    return $Response->Redirect( $ENV{HTTP_REFERER} );
  }# end if()
  
  # Uncomment to actually email someone:
  if( 0 )
  {
    $Server->Mail(
      From        => 'root@localhost',
      'reply-to'  => $Form->{email},
      To          => 'you@yours.com',
      Subject     => "$ENV{HTTP_HOST} Contact Form Results",
      Message     => <<"EMAIL",
Dear admin,

$Form->{first_name} $Form->{last_name} <$Form->{email}> has sent you the 
following message:

$Form->{message}

EMAIL
    );
  }# end if()
  
  $Response->Write("Thanks for contacting us.<br/>If this were a real form, you would have been redirected someplace.");
}# end run()


#==============================================================================
sub validate
{
  my ($s, $context) = @_;
  
  # Remove leading/trailing whitespace:
  map {
    $Form->{$_} =~ s/^\s+//;
    $Form->{$_} =~ s/\s+$//;
  } keys(%$Form);
  
  no warnings 'uninitialized';
  
  # We pull our warnings from a YAML properties file so they can be changed easily:
  my $props = Data::Properties::YAML->new(
    properties_file => $Config->web->application_root . '/etc/properties.yaml',
  )->contact_form;
  
  my $errors = { };
  
  # Validate first_name:
  unless( length($Form->{first_name}) )
  {
    $errors->{first_name} = $props->first_name->is_missing;
  }# end unless()
  
  # Validate last_name:
  unless( length($Form->{last_name}) )
  {
    $errors->{last_name} = $props->last_name->is_missing;
  }# end unless()
  
  # Validate email:
  if( length($Form->{email}) )
  {
    # Just a simple regex - knock yourself out if you want:
    unless( $Form->{email} =~ m/^.*?@.*?\..+$/ )
    {
      $errors->{email} = $props->email->is_invalid;
    }# end unless()
  }
  else
  {
    $errors->{email} = $props->email->is_missing;
  }# end if()
  
  # Validate message:
  unless( length($Form->{message}) )
  {
    $errors->{message} = $props->message->is_missing;
  }# end unless()
  
  return keys(%$errors) ? $errors : undef;
}# end validate()

1;# return true:

HANDLER
close($handler_ofh);

mkdir "$args->{domain}/t";
open my $t_ofh, '>', "$args->{domain}/t/01.01-contact_form.t";
print $t_ofh <<'TEST';
#!/usr/bin/perl -w

use strict;
use warnings 'all';
use Test::More 'no_plan';
use base 'Apache2::ASP::Test::Base';
use HTML::Form;
use Data::Properties::YAML;

ok( my $s = __PACKAGE__->SUPER::new() );

# Get our contact_form testing data:
my %data = $s->data->contact_form->as_hash;
my $props = Data::Properties::YAML->new(
  properties_file => $s->ua->context->config->web->application_root . '/etc/properties.yaml',
)->contact_form;

# Will it load?:
{
  my $res = $s->ua->get("/examples/contact.asp");
  is( $res->is_success => 1, "/examples/contact.asp loads");
}

### Validation Testing:

# first_name:
{
  local $data{first_name} = '';
  my $res = $s->ua->post("/handlers/examples.contact", [
    %data
  ]);
  
  # Redirected?:
  is( $res->header('location') => '/examples/contact.asp' );
  
  # Correct validation message?:
  is(
    $s->ua->context->session->{validation_errors}->{first_name} => $props->first_name->is_missing
  );
}

# last_name:
{
  local $data{last_name} = '';
  my $res = $s->ua->post("/handlers/examples.contact", [
    %data,
  ]);
  
  # Redirected?:
  is( $res->header('location') => '/handlers/examples.contact' );