package ASP4;
use strict;
use warnings 'all';
our $VERSION = '1.087';
1;# return true:
=pod
=head1 NAME
ASP4 - Fast, Simple and Scalable Web Development for Perl [DEPRECATED]
=head1 DEPRECATED
ASP4 has been deprecated as of 2012-05-07.
=head1 DESCRIPTION
ASP4 is a modern web development platform for Perl with a focus on speed, simplicity
and scalability.
=head1 ASP OBJECTS
ASP4 brings our old friends C<$Request>, C<$Response>, C<$Server> and C<$Session>
back from the 1990's, but adds some new ever-present objects as well. Together
the ASP objects provide a consistent interface to the incoming request, outgoing response,
server environment and configuration in-use by the application itself.
=head2 $Form
This is a simple hash reference which contains the names and values of the incoming
request parameters for both GET and POST requests.
For example, the following request...
/foo.asp?name=joe&color=red
...produces the following C<$Form> object:
$VAR1 = {
name => 'joe',
color => 'red'
};
Access form data just like any other hashref:
Hello, <%= $Form->{name} %>, I see your favorite color is <%= $Form->{color} %>.
=head2 $Server
The C<$Server> object offers a few utility methods that don't really fit anywhere else.
=head3 $Server->HTMLEncode( $string )
Given a string like C<< >> returns a string like C<< <br/> >>
=head3 $Server->HTMLDecode( $string )
Given a string like C<< <br/> >> returns a string like C<< >>
=head3 $Server->URLEncode( $string )
Given a string like C<< billg@microsoft.com >> returns a string like C<< billg%40microsoft.com >>
=head3 $Server->URLDecode( $string )
Given a string like C<< billg%40microsoft.com >> returns a string like C<< billg@microsoft.com >>
=head3 $Server->MapPath( $path )
Given a C<$path> of C would return something like C
=head3 $Server->Mail( %args )
Sends an email via L. In fact it simply calls the C function
provided by L.
Simple Example:
$Server->Mail(
from => 'foo@bar.com',
to => 'bar@foo.com',
subject => 'Hello, world!',
message => 'this is a test message'
);
To send an HTML email do the following:
use MIME::Base64;
$Server->Mail(
from => 'foo@bar.com',
to => 'bar@foo.com',
subject => 'Hello, world!',
'content-type' => 'text/html',
'content-transfer-encoding' => 'base64',
message => encode_base64(<<"HTML")
This is an html email.
You can see that this text is bold.
HTML
);
Please see L for further details and examples.
=head3 $Server->RegisterCleanup( sub { ... }, \@args )
After the final response has been sent to the client, the server will execute
your subref and provide it the C<\@args> passed in.
This is useful for long-running or asynchronous processes that don't require the
client to wait for a response.
=head2 $Request
An instance of L, the C<$Request> object contains specialized methods
for dealing with whatever the browser sent us.
Examples:
=head3 $Request->Cookies( $name )
my $cookie = $Request->Cookies("some-cookie-name");
=head3 $Request->FileUpload( $field_name )
if( my $file = $Request->FileUpload('avatar_pic') ) {
# Handle the uploaded file:
$file->SaveAs( "/var/media/$Session->{user_id}/avatar/" . $file->FileName );
}
See also the L documentation.
=head2 $Response
An instance of L, the C<$Response> object gives shortcuts for dealing
with the outgoing reply from the server back to the client.
Examples:
=head3 $Response->Write( $string )
The following example prints the string C to the browser:
$Response->Write("Hello, World!");
Or, within an ASP script, C<< <%= "Hello, World" %> >>
=head3 $Response->Redirect( $url )
$Response->Redirect( "/new/url/?foo=bar" );
=head3 $Response->SetCookie( %args )
Setting cookies works as follows:
$Response->SetCookie(
name => "cookie-name",
value => "the-value",
# The rest of these arguments are optional:
# Expires: (If you don't specify the "expires" argument, the cookie will
# be deleted when the browser is closed.
expires => "3D", # 3 days
expires => "3H", # or 3 hours
expires => "3M", # or 3 minutes
# Domain: (defaults to $ENV{HTTP_HOST})
domain => ".example.com", # works for *.example.com
domain => "www.example.com", # will ONLY work for www.example.com
# Path:
path => "/some/folder/" # will ONLY work within /some/folder/ on your website
);
=head3 $Response->Include( $path, %args )
ASP4's C<$Response> object offers 3 different include methods.
If you want to supply arguments to the included ASP script you can use C<< $Response->Include($path, \%args) >>
# Add the output of C to the current output buffer:
my %args = ( foo => "bar" );
$Response->Include( $Server->MapPath("/includes/page.asp"), \%args );
C<\%args> is optional.
Within the included ASP script, C<\%args> is accessible like this:
<%
my ($self, $context, $args) = @_;
%>
=head3 $Response->TrapInclude( $path, %args )
Or if you need to capture the result of executing an ASP script and use it within
a variable, use C<< $Response->TrapInclude($path, \%args) >>
# Capture the output of C:
my %args = ( foo => "bar" );
my $html = $Response->TrapInclude( $Server->MapPath("/includes/page.asp"), \%args );
C<\%args> is optional.
Within the included ASP script, C<\%args> is accessible like this:
<%
my ($self, $context, $args) = @_;
%>
=head2 $Session
The C<$Session> object is an instance of a subclass of L
(depending on your website's configuration).
The C<$Session> object is a simple blessed hashref and should be used like a hashref.
Examples:
=head3 Set a session variable
$Session->{foo} = "bar";
$Session->{thing} = {
banana => "yellow",
cherry => "red",
peach => "pink,
};
=head3 Get a session variable
my $foo = $Session->{foo};
=head3 $Session->save()
Called automatically at the end of every successful request, causes any changes
to the C<$Session> to be saved to the database.
=head3 $Session->reset()
Call C<< $Session->reset() >> to clear all the data out of the session and save
it to the database.
=head2 $Config
The ASP4 C<$Config> object is stored in a simple JSON format on disk, and accessible
everywhere within your entire ASP4 application as the global C<$Config> object.
If ever you find yourself in a place without a C<$Config> object, you can get one
like this:
use ASP4::ConfigLoader;
my $Config = ASP4::ConfigLoader->load();
See L for full details on the ASP4 C<$Config> object and its usage.
=head2 $Stash
The C<$Stash> is a simple hashref that is guaranteed to be the exact same hashref
throughout the entire lifetime of a request.
Anything placed within the C<$Stash> at the very beginning of processing a request -
such as in a RequestFilter - will still be there at the very end of the request -
as in a RegisterCleanup handler.
Use the C<$Stash> as a great place to store a piece of data for the duration of
a single request.
=head1 DATABASE
While ASP4 B its users to choose any specific database (eg: MySQL or PostgreSQL)
or ORM (object-relational mapper) the B ORM is L
since it has been completely and thoroughly tested to be 100% compatible with ASP4.
For full documentation about L please view its documentation.
B L must be installed in addition to ASP4 as it is a separate library.
=head1 ASP4 QuickStart
Here is an example project to get things going.
In the C section of C you should have
something like this:
...
"main": {
"dsn": "DBI:mysql:database_name:data.mywebsite.com",
"username": "db-username",
"password": "db-pAsswOrd"
}
...
Suppose you had the following tables in your database:
create table users (
user_id bigint unsigned not null primary key auto_increment,
email varchar(200) not null,
password char(32) not null,
created_on timestamp not null default current_timestamp,
unique(email)
) engine=innodb charset=utf8;
create table messages (
message_id bigint unsigned not null primary key auto_increment,
from_user_id bigint unsigned not null,
to_user_id bigint unsigned not null,
subject varchar(100) not null,
body text,
created_on timestamp not null default current_timestamp,
foreign key fk_messages_to_senders (from_user_id) references users (user_id) on delete cascade,
foreign key fk_messages_to_recipients (to_user_id) references users (user_id) on delete cascade
) engine=innodb charset=utf8;
B It's best to assign every ASP4 application its own namespace. For this
example the namespace is C
Create the file C and add the following lines:
package App::db::model;
use strict;
use warnings 'all';
use base 'Class::DBI::Lite::mysql';
use ASP4::ConfigLoader;
# Get our configuration object:
my $Config = ASP4::ConfigLoader->load();
# Get our main database connection info:
my $conn = $Config->data_connections->main;
# Setup our database connection:
__PACKAGE__->connection(
$conn->dsn,
$conn->username,
$conn->password
);
1;# return true:
Add the following C entity classes:
C
package App::db::user;
use strict;
use warnings 'all';
use base 'App::db::model';
use Digest::MD5 'md5_hex';
use ASP4::ConfigLoader;
__PACKAGE__->set_up_table('users');
__PACKAGE__->has_many(
messages_in =>
'App::db::message' =>
'to_user_id'
);
__PACKAGE__->has_many(
messages_out =>
'App::db::message' =>
'from_user_id'
);
# Hash the password before storing it in the database:
__PACKAGE__->add_trigger( before_create => sub {
my ($self) = @_;
# Sign the password instead of storing it as plaintext:
unless( $self->{password} =~ m{^([a-f0-9]{32})$}i ) {
$self->{password} = $self->hash_password( $self->password );
}
});
# Hash the new password before storing it in the database:
__PACKAGE__->add_trigger( before_update_password => sub {
my ($self, $old, $new) = @_;
unless( $new =~ m{^([a-f0-9]{32})$}i ) {
$self->{password} = $self->hash_password( $new );
}
});
# Verify an email/password combination and return the user if a match is found:
sub check_credentials {
my ($self, %args) = @_;
my ($result) = $self->search(
email => $args{email},
password => $self->hash_password( $args{password} ),
);
$result ? return $result : return;
}
# Convert a password string into its hashed value:
sub hash_password {
my ($self, $str) = @_;
my $key = ASP4::ConfigLoader->load->system->settings->signing_key;
return md5_hex( $str . $key );
}
1;# return true:
C
package App::db::message;
use strict;
use warnings 'all';
use base 'App::db::model';
__PACKAGE__->set_up_table('messages');
__PACKAGE__->belongs_to(
sender =>
'App::db::user' =>
'from_user_id'
);
__PACKAGE__->belongs_to(
recipient =>
'App::db::user' =>
'to_user_id'
);
1;# return true:
Create your MasterPage like this:
File: C
<%@ MasterPage %>
<asp:ContentPlaceHolder id="meta_title"></asp:ContentPlaceHolder>
File: C
<%@ Page UseMasterPage="/masters/global.asp" %>
RegisterRegister
<%
# Sticky forms work like this:
if( my $args = $Session->{__lastArgs} ) {
map { $Form->{$_} = $args->{$_} } keys %$args;
}
# Our validation errors:
my $errors = $Session->{validation_errors} || { };
$::err = sub {
my $field = shift;
my $error = $errors->{$field} or return;
%><%= $Server->HTMLEncode( $error ) %><%
};
%>
The form submits to the URL C which means C
File: C
package app::register;
use strict;
use warnings 'all';
use base 'ASP4::FormHandler';
use vars __PACKAGE__->VARS; # Import $Response, $Form, $Session, etc
use App::db::user;
sub run {
my ($self, $context) = @_;
# If there is an error, return the user to the registration page:
if( my $errors = $self->validate() ) {
$Session->{validation_errors} = $errors;
$Session->{__lastArgs} = $Form;
$Session->save;
return $Response->Redirect( $ENV{HTTP_REFERER} );
}
# Create the user:
my $user = eval {
App::db::user->do_transaction(sub {
return App::db::user->create(
email => $Form->{email},
password => $Form->{password},
);
});
};
if( $@ ) {
# There was an error:
$Session->{validation_errors} = {email => "Server error. Sorry!"};
$Session->{__lastArgs} = $Form;
$Session->save;
return $Response->Redirect( $ENV{HTTP_REFERER} );
}
else {
# No error - Sign them in:
$Session->{user_id} = $user->id;
$Session->{msg} = "Thank you for registering!";
$Session->save;
# Redirect to /profile.asp:
return $Response->Redirect("/profile.asp");
}# end if()
}
sub validate {
my ($self) = @_;
$self->trim_form;
my $errors = { };
no warnings 'uninitialized';
# email:
if( length($Form->{email}) ) {
# Basic email validation:
unless( $Form->{email} =~ m{[^@]+@[^@]+\.[^@]+} ) {
$errors->{email} = "Invalid email address";
}
}
else {
$errors->{email} = "Required";
}
# password:
unless( length($Form->{password} ) {
$errors->{password} = "Required";
}
# password2:
if( length($Form->{password2}) ) {
if( length($Form->{password}) ) {
unless( $Form->{password} eq $Form->{password2} ) {
$errors->{password2} = "Passwords don't match";
}
}
}
else {
$errors->{password2} = "Required";
}
# Bail out of we already have errors:
return $errors if keys %$errors;
# See if the user already exists:
if( App::db::user->count_search( email => $Form->{email} ) ) {
$errors->{email} = "Already in use";
}
# Errors or not?:
keys %$errors ? return $errors : return;
}
1;# return true:
File: C
<%@ Page UseMasterPage="/masters/global.asp" %>
My ProfileMy Profile
<%
if( my $msg = $Session->{msg} ) {
%>
<%= $msg %>
<%
}# end if()
%>
<%
# Get our $user:
use App::db::user;
my $user = App::db::user->retrieve( $Session->{user_id} );
%>
The form submits to C which maps to C
File: C
package app::send;
use strict;
use warnings 'all';
use base 'ASP4::FormHandler';
use vars __PACKAGE__->VARS;
use App::db::user;
use App::db::message;
sub run {
my ($self, $context) = @_;
# Create the message:
my $msg = eval {
App::db::message->do_transaction(sub {
my $msg = App::db::message->create(
from_user_id => $Session->{user_id},
to_user_id => $Form->{to_user_id},
subject => $Form->{subject},
body => $Form->{body},
);
# Send an email to the recipient:
$Server->Mail(
from => 'root@localhost',
'reply-to' => $msg->sender->email,
to => $msg->recipient->email,
subject => 'New in-club message',
message => <<"MSG",
Dear user,
Another user (@{[ $msg->sender->email ]}) has sent you an in-club message.
Please login and view it on your profile at http://$ENV{HTTP_HOST}/
Yours,
The "In Club"
MSG
);
# Finally:
return $msg;
});
};
if( $@ ) {
$Session->{msg} = "Error: Your message could not be sent.";
$Session->save;
return $Response->Redirect( $ENV{HTTP_REFERER} );
}
else {
$Session->{msg} = "New message sent successfully.";
$Session->save;
return $Response->Redirect( $ENV{HTTP_REFERER} );
}
}
=head1 BUGS
It's possible that some bugs have found their way into this release.
Use RT L to submit bug reports.
=head1 HOMEPAGE
Please visit the ASP4 homepage at L to see examples
of ASP4 in action.
=head1 AUTHOR
John Drago
=head1 COPYRIGHT
This software is Free software and may be used and redistributed under the same
terms as perl itself.
=cut