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

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


my $args = { };

$args->{domain}           = prompt("What is the website domain?", "www.example.com");
$args->{cookie_domain}    = prompt("What is the cookie domain?", ".example.com");
$args->{application_name} = prompt("Application name?", "MyApp");
my $folder = lc($args->{application_name});

$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_timeout}        = prompt("Session timeout? (in minutes)", 30);
$args->{session_cookie_name}    = prompt("Session cookie name?", 'session-id');

$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 primary key,
    session_data blob,
    created_on   datetime default NULL,
    modified_on  datetime default NULL
  ) ENGINE=MyISAM 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/asp4-config.json";
print $ofh <<"CONFIG_JSON";
{
  "system": {
    "post_processors": [
      
    ],
    "libs": [
      "\@ServerRoot@/lib"
    ],
    "load_modules": [
      "DBI",
      "DBD::SQLite"
    ],
    "env_vars": {
      "myvar":        "Some-Value",
      "another_var":  "Another Value"
    },
    "settings": {
      "some_setting":     "foo",
      "another_setting":  "bar"
    }
  },
  "errors": {
    "error_handler":    "ASP4::ErrorHandler",
    "mail_errors_to":   "@{[ $args->{mail_errors_to} ]}",
    "mail_errors_from": "@{[ $args->{mail_errors_from} ]}",
    "smtp_server":      "@{[ $args->{smtp_server} ]}"
  },
  "web": {
    "application_name": "@{[ $args->{application_name} ]}",
    "application_root": "\@ServerRoot\@",
    "www_root":         "\@ServerRoot\@/htdocs",
    "handler_root":     "\@ServerRoot\@/handlers",
    "page_cache_root":  "/tmp/PAGE_CACHE",
    "handler_resolver": "ASP4::HandlerResolver",
    "handler_runner":   "ASP4::HandlerRunner",
    "filter_resolver":  "ASP4::FilterResolver",
    "request_filters": [
    
    ],
    "disable_persistence": [
      {
        "uri_match":            "^/no/sessions/here",
        "disable_session":      true
      },
      {
        "uri_match":            "^/no/sessions\\\\.asp",
        "disable_session":      true
      }
    ]
  },
  "data_connections": {
    "session": {
      "manager":          "ASP4::SessionStateManager",
      "cookie_name":      "@{[ $args->{session_cookie_name} ]}",
      "cookie_domain":    "@{[ $args->{cookie_domain} ]}",
      "session_timeout":  @{[ $args->{session_timeout} ]},
      "dsn":              "@{[ $args->{session_dsn} ]}",
      "username":         "@{[ $args->{session_user} ]}",
      "password":         "@{[ $args->{session_pass} ]}"
    },
    "main": {
      "dsn":      "@{[ $args->{main_dsn} ]}",
      "username": "@{[ $args->{main_user} ]}",
      "password": "@{[ $args->{main_pass} ]}"
    }
  }
}
CONFIG_JSON
close($ofh);


open my $conf_ofh, '>', "$args->{domain}/conf/httpd.conf";
print $conf_ofh <<"CONF";


# Load up some important modules:
PerlModule DBI
PerlModule ASP4::ModPerl

# Admin website:
<VirtualHost *:80>

  ServerName    @{[ $args->{domain} ]}
  DocumentRoot  @{[ cwd() . '/' . $args->{domain} . '/htdocs' ]}
  
  # Set the directory index:
  DirectoryIndex index.asp
  
  # All *.asp files are handled by ASP4::ModPerl
  <Files ~ (\.asp\$)>
    SetHandler  perl-script
    PerlResponseHandler ASP4::ModPerl
  </Files>
  
  # !IMPORTANT! Prevent anyone from viewing your GlobalASA.pm
  <Files ~ (\.pm\$)>
    Order allow,deny
    Deny from all
  </Files>
  
  # All requests to /handlers/* will be handled by their respective handler:
  <Location /handlers>
    SetHandler  perl-script
    PerlResponseHandler ASP4::ModPerl
  </Location>
  
</VirtualHost>

CONF
close($conf_ofh);

open my $asa_ofh, '>', "$args->{domain}/htdocs/GlobalASA.pm";
print $asa_ofh <<"ASA";

package @{[ $args->{application_name} ]}::GlobalASA;

use strict;
use warnings 'all';
use base 'ASP4::GlobalASA';
use vars __PACKAGE__->VARS;

# sub Script_OnStart;
# sub Script_OnEnd;
# sub Session_OnStart;

1;# return true:

ASA
close($asa_ofh);

warn "\nSetup is almost complete.
Make sure to add the following lines to your main httpd.conf:

  # Unless you've already done this:
  NameVirtualHost *:80
  
  # And this (unless you already have):
  AddModule perl_module modules/mod_perl.so
  
  # And *Don't* forget about this line:
  Include @{[ cwd() ]}/@{[ $args->{domain} ]}/conf/httpd.conf
";

open my $asp_ofh, '>', "$args->{domain}/htdocs/index.asp";
print $asp_ofh <<'ASP';
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en" dir="ltr">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>ASP4 Test Page</title>
</head>
<body>
<h1>Congratulations</h1>
<p>You have successfully installed ASP4.</p>
<p>
  Visit your <a href="/examples/contact.asp">example contact form</a> to see 
  several concepts in action.
</p>
</body>
</html>
ASP
close($asp_ofh);

open my $props_ofh, '>', "$args->{domain}/etc/properties.yaml";
print $props_ofh <<"YAML";
---
contact_form:
  first_name:
    is_missing: Required
  last_name:
    is_missing: Required
  email:
    is_missing: Required
    is_invalid: Invalid
  message:
    is_missing: Required

YAML
close($props_ofh);

open my $data_ofh, '>', "$args->{domain}/etc/test_fixtures.yaml";
print $data_ofh <<"YAML";
---
  contact_form:
    first_name: John
    last_name:  Doe
    email:      john.doe\@test.com
    message:    This is a test message...just a test.

YAML
close($data_ofh);

mkdir "$args->{domain}/htdocs/examples" or die "CANNOT MKDIR examples: $!";
open my $contact_asp, '>', "$args->{domain}/htdocs/examples/contact.asp";
print $contact_asp <<"ASP";
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<%
  # Make a "sticky form":
  if( my \$args = \$Session->{__lastArgs} )
  {
    \$Form->{\$_} = \$args->{\$_} foreach keys(\%\$args);
  }# end if()
  my \$errors = \$Session->{validation_errors} || { };
  my \$err = sub {
    my \$name = shift;
    return unless \$errors->{\$name};
%><span class="field_error"><%= \$Server->HTMLEncode( \$errors->{\$name} ) %></span><%
  };
%>
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en" dir="ltr">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
  <title>ASP4 Example Contact Form</title>
  <style type="text/css">
  .field_error {
    color: #FF0000;
    font-weight: bold;
  }
  
  .label {
    display: block;
    float: left;
    width: 150px;
    text-align: right;
    padding-right: 5px;
    margin-right: 5px;
    position: relative;
    top: 2px;
  }
  
  .required {
    border-right: solid 6px #FF0000;
  }
  
  .optional {
    border-right: solid 6px transparent;
  }
  </style>
</head>
<body>
<form method="post" action="/handlers/$folder.examples.contact">

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

package $folder\::examples::contact;
HANDLER

print $handler_ofh <<'HANDLER';
use strict;
use warnings 'all';
use base 'ASP4::FormHandler';
use vars __PACKAGE__->VARS;


sub run
{
  my ($s, $context) = @_;
  
  if( my $errors = $s->validate( $context ) )
  {
    $Session->{__lastArgs} = $Form;
    $Session->{validation_errors} = $errors;
    return $Response->Redirect( "/examples/contact.asp" );
  }# 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 from all form params:
  $s->trim_form();
  
  no warnings 'uninitialized';
  
  # We pull our warnings from a YAML properties file so they can be changed easily:
  my $props = $s->properties->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";
my $test = <<'TEST';
#!/usr/bin/perl -w

use strict;
use warnings 'all';
use Test::More 'no_plan';
use ASP4::API;
use HTML::Form;
use Data::Properties::YAML;

my $api; BEGIN { $api = ASP4::API->new }

# Get our contact_form testing data:
my %data = $api->test_data->contact_form->as_hash;
my $props = $api->properties->contact_form;

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

### Validation Testing:

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

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

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

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

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

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

TEST
$test =~ s/FOLDER/$folder/sg;
print $t_ofh $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()

=pod

=head1 NAME

asphelper - Generate an ASP4 skeleton web application

=head1 USAGE

  asphelper

Upon execution, C<asphelper> will ask you several questions about the web application
it should create.

=head1 DESCRIPTION

The C<asphelper> program offers a way to get up-and-running quickly with a new ASP4 web application.

After successfully answering its questions, C<asphelper> will generate a skeleton web application
including config files, full directory structure, unit test and a working contact form example.

Use the resulting application as a starting-point for your own development.

=cut

