view release on metacpan or  search on metacpan

sbin/asphelper  view on Meta::CPAN

#!/usr/local/bin/perl -w

use strict;
use warnings 'all';
use Cwd 'cwd';
use DBI;


my $args = { };

$args->{domain}           = prompt("What is the web application domain?", "www.example.com");
$args->{application_name} = prompt("Application name?", "MyApp");

$args->{mail_errors_to}   = prompt("Email errors to?", 'you@domain.com');
$args->{mail_errors_from} = prompt("Email errors from?", 'root@localhost.com');
$args->{smtp_server}      = prompt("SMTP Server?", 'localhost');

$args->{session_dsn}            = prompt("Session DSN?", "DBI:mysql:dbname:localhost");
$args->{session_user}           = prompt("Session db username?");
$args->{session_pass}           = prompt("Session db password?");
$args->{session_cookie_domain}  = prompt("Session cookie domain?", $args->{domain});
$args->{session_timeout}        = prompt("Session timeout? (in minutes)", 30);
$args->{session_cookie_name}    = prompt("Session cookie name?", 'session-id');

$args->{app_dsn}  = prompt("Application DSN?", $args->{session_dsn});
$args->{app_user} = prompt("Application db username?", $args->{session_user});
$args->{app_pass} = prompt("Application db password?", $args->{session_pass});

$args->{main_dsn}   = prompt("Main DSN?", $args->{session_dsn});
$args->{main_user}  = prompt("Main db username?", $args->{session_user});
$args->{main_pass}  = prompt("Main db password?", $args->{session_pass});


warn "="x79, "\n";
warn "Creating database tables...\n";
eval {
  my $dbh = DBI->connect( $args->{session_dsn}, $args->{session_user}, $args->{session_pass} );
  $dbh->do(q~
  DROP TABLE IF EXISTS asp_sessions
  ~);
  $dbh->do(q~
  CREATE TABLE `asp_sessions` (
    `session_id`   char(32) NOT NULL,
    `session_data` blob,
    `created_on`   datetime default NULL,
    `modified_on`  datetime default NULL,
    PRIMARY KEY  (`session_id`)
  ) ENGINE=InnoDB DEFAULT CHARSET=latin1
  ~);
  $dbh->disconnect();
  1;
} or die $@;
eval {
  my $dbh = DBI->connect( $args->{app_dsn}, $args->{app_user}, $args->{app_pass} );
  $dbh->do(q~
  DROP TABLE IF EXISTS asp_applications
  ~);
  $dbh->do(q~
  CREATE TABLE `asp_applications` (
    `application_id`   varchar(100) NOT NULL,
    `application_data` blob,
    PRIMARY KEY  (`application_id`)
  ) ENGINE=InnoDB DEFAULT CHARSET=latin1
  ~);
  $dbh->disconnect();
  1;
} or die $@;


warn "="x79, "\n";
warn "Creating directory structure...\n";

mkdir($args->{domain}) or die "Cannot mkdir('$args->{domain}'): $!";
foreach my $dir (qw( lib etc conf htdocs handlers PAGE_CACHE MEDIA ))
{
  mkdir("$args->{domain}/$dir") or die "Cannot mkdir('$args->{domain}'): $!";
}# end foreach()

open my $ofh, '>', "$args->{domain}/conf/apache2-asp-config.xml";
print $ofh <<"CONFIG_XML";
<?xml version="1.0" ?>
<configuration>

  <system>
    <post_processors>
<!--
      <class>My::PostProcessor</class>
      <class>My::PostProcessor2</class>
-->
    </post_processors>
    <libs>

sbin/asphelper  view on Meta::CPAN

  
  # Redirected?:
  is( $res->header('location') => '/handlers/examples.contact' );
  
  # Correct validation message?:
  is(
    $s->ua->context->session->{validation_errors}->{email} => $props->email->is_missing
  );
}

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

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

# And make sure everything works when we submit the form nicely:
{
  $s->ua->get("/examples/contact.asp");
  my $res = $s->ua->post("/handlers/examples.contact", [
    %data,
  ]);
  
  # No error messages:
  is(
    $s->ua->context->session->{validation_errors} => undef
  );
}


TEST
close($t_ofh);

#==============================================================================
sub prompt
{
  my ($q, $default) = @_;
  
  local $| = 1;
  my $answer;
  
  if( defined($default) )
  {
    print "\n$q: [$default] ";
  }
  else
  {
    print "\n$q: ";
  }# end if()
  chomp($answer = <STDIN>);

  return $default if defined($default) && ! length($answer);
  
  until( length($answer) )
  {
    print "$q: ";
    chomp($answer = <STDIN>);
  }# end until()
  
  return $answer;
}# end prompt()