Apache2-ASP

 view release on metacpan or  search on metacpan

lib/Apache2/ASP/FormHandler.pm  view on Meta::CPAN

  package mysite::contact::form;
  
  use strict;
  use warnings 'all';
  use base 'Apache2::ASP::FormHandler';
  use vars __PACKAGE__->VARS;
  
  sub run {
    my ($s, $context) = @_;
    
    if( my $errors = $s->validate( $context ) ) {
      $Session->{validation_errors} = $errors;
      $Session->{__lastArgs} = $Form;
      return $Response->Redirect( $ENV{HTTP_REFERER} );
    }
    
    # Do stuff:
    
    # Finally:
    return $Response->Redirect( "/some/other/place.asp" );
  }
  
  sub validate {
    my ($s, $context) = @_;
    
    my $errors = { };
    
    # Did they fill out the form?
    foreach my $field (qw/ name email message /) {
      $errors->{$field} = "Required"
        unless $Form->{$field};
    }
    

lib/Apache2/ASP/Manual/BestPractices.pod  view on Meta::CPAN

  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 ) )
    {
      # We found some kind of validation error:
      $Session->{__lastArgs} = $Form;
      $Session->{validation_errors} = $errors;
      return $Response->Redirect( $ENV{HTTP_REFERER} );
    }# end if()
    
    # Success! - no validation errors:
    my ($user) = find_user( ... );
    $Session->{user} = $user;

lib/Apache2/ASP/Manual/BestPractices.pod  view on Meta::CPAN

    my $props = Data::Properties::YAML->new(
      properties_file => $Config->web->application_root . '/etc/properties.yaml'
    )->user_login;
    $Session->{msg} = $props->general->success;
    
    # Redirect the user to the logged-in page:
    return $Response->Redirect("/logged-in.asp");
  }# end run()
  
  #============================================================================
  sub validate
  {
    my ($s, $context) = @_;
    
    # Remove leading and trailing whitespace:
    map {
      $Form->{$_} =~ s/^\s+//;
      $Form->{$_} =~ s/\s+$//;
    } keys(%$Form);
    
    my $props = Data::Properties::YAML->new(

lib/Apache2/ASP/Manual/BestPractices.pod  view on Meta::CPAN

    unless( keys(%$errors) )
    {
      if( ! find_user( ... ) )
      {
        $errors->{general} = $props->general->fail;
      }# end if()
    }# end unless()
    
    return unless keys(%$errors);
    return $errors;
  }# end validate()
  
  1;# return true:

=head1 UNIT TESTING

Unit testing was the number one reason behind the development of Apache2::ASP.

Apache2::ASP offers a unit testing environment that is not dependent on Apache
or any other server.

sbin/asphelper  view on Meta::CPAN

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(

sbin/asphelper  view on Meta::CPAN

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';

sbin/asphelper  view on Meta::CPAN

    $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