ASP4
view release on metacpan or search on metacpan
2012-01-23 1.073
- Added $Request->Header($name)
(Somehow we've gotten along all this time without it.)
2012-01-23 1.072
- More tweaks on ASP4::SessionStateManager's default internal behavior
has resulted in some more-than-modest performance gains.
- Disabling session-state can result in 630 requests/second on a simple
master/child "content" page, and 475 requests/second on a page that
includes reading data from a database (using Class::DBI::Lite of course).
* Results from `ab` on a Dell E6510 (quad-dual-core-i7, 8GB RAM, Ubuntu 10.10)
2012-01-22 1.071
- ASP4::HTTPContext now triggers the SessionStateManager's save() method
when the context is DESTROY'd.
2012-01-22 1.070
- No longer check session's last-mod when deciding whether or not to save
session state at the end of a request.
- Erikdj pointed out the need for the @AppRoot@ macro and suggested the (excellent) name. Thanks Erik!
2011-09-19 1.053
- Updated asphelper script to genenrate sample app conforming to new App::db::*
root namespace.
2011-09-19 1.052
[Bug Fixes]
- Blank lines in asp4-config.json no longer causes an exception to be thrown.
- Update documentation to reflect preference change from app::* to App::db::*
root namespace for database classes.
2011-08-14 1.051
[Bug Fixes]
- 'Redirect Loop' fixed! Under mod_perl, $context->send_headers() was not
called for non-200 http responses.
Now it is.
This means that if you had `return $Response->Redirect("/foo/")` in a RequestFilter
you may have gotten a "redirect loop" because although the '301 Moved' status
was set, the `location: /foo/` header was *not* set. This would result in
a redirect loop.
was changed - and if it has been more than 60 seconds, the session is saved
and the __lastMod value is updated to time() - thus preventing expiry of
active sessions.
2010-03-08 v1.021
- Removed a warning that popped up now and then about the use of an uninitialized value.
- Added a more informative "Yay you're finished!" message after running asphelper.
2010-03-04 v1.020
- Now asphelper will output sbin/ddl.sql, which contains the structure of the
asp_sessions database table. This is a handy place to start describing the
database structure of a web application.
- If $Config->web->data_connections->session->session_timeout is set to '*' then
the session lasts as long as the browser keeps the cookie around.
- 20% performance increase by using Cwd::fastcwd() instead of Cwd::cwd() and a
few other minor tweaks.
2010-03-02 v1.019
- Fixed a bug in asphelper that caused some problems creating a skeleton website.
2010-03-01 v1.018
- Updated asphelper script so that the POD on CPAN is not contaminated with POD
from within one of the modules that asphelper generates.
2010-03-01 v1.017
- Updated asphelper script to only accept options on the command-line, like "normal" scripts.
2010-02-28 v1.016
- A vestigial "use encoding 'utf8'" was removed from ASP4::Server.
- It was causing Apache to segfault on ubuntu 9.10.
2010-02-19 v1.015
- Hostnames like http://myapplication/ were not setting session cookies properly.
- $Config->data_connections->session->cookie_domain should set to "*" in these cases.
- $Response->SetCookie accepts the "*" value for domain also.
- The result is that no "domain=xyz" attribute is given to these cookies.
2010-02-18 v1.014
- $Response->ContentType now functions correctly.
- Upgrade mandatory!
2010-02-18 v1.013
- ASP4::HandlerResolver was not properly remembering timestamps on handler files.
This resulted in unnecessary reloads of handlers that had not been changed.
Changes
inc/Module/Install.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
inc/Module/Install/Fetch.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/Scripts.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/ASP4.pm
lib/ASP4/API.pm
lib/ASP4/Config.pm
lib/ASP4/ConfigFinder.pm
lib/ASP4/ConfigLoader.pm
lib/ASP4/ConfigNode.pm
lib/ASP4/ConfigNode/System.pm
README.markdown view on Meta::CPAN
/foo.asp?name=joe&color=red
...produces the following `$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} %>.
## $Server
The `$Server` object offers a few utility methods that don't really fit anywhere else.
### $Server->HTMLEncode( $string )
Given a string like `<br/>` returns a string like `<br/>`
README.markdown view on Meta::CPAN
peach => "pink,
};
### Get a session variable
my $foo = $Session->{foo};
### $Session->save()
Called automatically at the end of every successful request, causes any changes
to the `$Session` to be saved to the database.
### $Session->reset()
Call `$Session->reset()` to clear all the data out of the session and save
it to the database.
## $Config
The ASP4 `$Config` object is stored in a simple JSON format on disk, and accessible
everywhere within your entire ASP4 application as the global `$Config` object.
If ever you find yourself in a place without a `$Config` object, you can get one
like this:
use ASP4::ConfigLoader;
README.markdown view on Meta::CPAN
## $Stash
The `$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 `$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 `$Stash` as a great place to store a piece of data for the duration of
a single request.
# DATABASE
While ASP4 __does not require__ its users to choose any specific database (eg: MySQL or PostgreSQL)
or ORM (object-relational mapper) the __recommended__ ORM is [Class::DBI::Lite](http://search.cpan.org/perldoc?Class::DBI::Lite)
since it has been completely and thoroughly tested to be 100% compatible with ASP4.
For full documentation about [Class::DBI::Lite](http://search.cpan.org/perldoc?Class::DBI::Lite) please view its documentation.
__NOTE:__ [Class::DBI::Lite](http://search.cpan.org/perldoc?Class::DBI::Lite) must be installed in addition to ASP4 as it is a separate library.
# ASP4 QuickStart
Here is an example project to get things going.
In the `data_connections.main` section of `conf/asp4-config.json` 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;
README.markdown view on Meta::CPAN
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 `Class::DBI::Lite` entity classes:
README.markdown view on Meta::CPAN
);
__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 );
}
});
inc/Module/Install/Metadata.pm view on Meta::CPAN
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
$VERSION = '0.79';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
my $type = shift;
push @{ $self->{values}{no_index}{$type} }, @_ if $type;
return $self->{values}{no_index};
}
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
} else {
$self->can($key)->($self, $value);
}
}
return $self;
lib/ASP4.pm view on Meta::CPAN
/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<< <br/> >> returns a string like C<< <br/> >>
lib/ASP4.pm view on Meta::CPAN
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;
lib/ASP4.pm view on Meta::CPAN
=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<does not require> its users to choose any specific database (eg: MySQL or PostgreSQL)
or ORM (object-relational mapper) the B<recommended> ORM is L<Class::DBI::Lite>
since it has been completely and thoroughly tested to be 100% compatible with ASP4.
For full documentation about L<Class::DBI::Lite> please view its documentation.
B<NOTE:> L<Class::DBI::Lite> 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<data_connections.main> section of C<conf/asp4-config.json> 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 (
lib/ASP4.pm view on Meta::CPAN
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<Class::DBI::Lite> entity classes:
lib/ASP4.pm view on Meta::CPAN
'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 {
lib/ASP4/API.pm view on Meta::CPAN
use ASP4::Test::Fixtures;
BEGIN { ASP4::ConfigLoader->load }
sub new
{
my ($class) = @_;;
my $config = ASP4::ConfigLoader->load;
# Our test fixtures:
my $test_data;
if( -f $config->web->application_root . '/etc/test_fixtures.json' )
{
eval { require Data::Properties::JSON };
$test_data = Data::Properties::JSON->new(
properties_file => $config->web->application_root . '/etc/test_fixtures.json'
) unless $@;
}
elsif( -f $config->web->application_root . '/etc/test_fixtures.yaml' )
{
$test_data = ASP4::Test::Fixtures->new(
properties_file => $config->web->application_root . '/etc/test_fixtures.yaml'
);
}# end if()
# Our diagnostic messages:
my $properties = Data::Properties::YAML->new(
properties_file => $config->web->application_root . '/etc/properties.yaml'
) if -f $config->web->application_root . '/etc/properties.yaml';
return bless {
test_fixtures => $test_data,
properties => $properties,
ua => ASP4::UserAgent->new(),
config => $config,
}, $class;
}# end new()
*init = \&new;
sub test_fixtures { shift->{test_fixtures} }
sub properties { shift->{properties} }
sub ua { shift->{ua} }
sub context { ASP4::HTTPContext->current }
sub config { shift->{config} }
sub data { shift->test_fixtures } # XXX: Deprecated! - for Apache2::ASP compat only.
sub test_data { shift->test_fixtures } # XXX: Deprecated!
sub DESTROY
{
my $s = shift;
undef(%$s);
}# end DESTROY()
1;# return true:
=pod
lib/ASP4/API.pm view on Meta::CPAN
# Create an api object:
my $api = ASP4::API->new;
# Use the API:
my $res = $api->ua->get('/index.asp');
if( $res->is_success ) {
print $res->content;
}
# Access your test data:
warn $res->test_data->contact_form->email;
# Access your properties YAML:
warn $res->properties->contact_form->email->is_missing;
# Access the application config:
warn $api->config->system->settings->foo;
=head1 DESCRIPTION
C<ASP4::API> is B<very useful for unit tests> - specifically when writing tests
lib/ASP4/API.pm view on Meta::CPAN
Returns the current instance of L<ASP4::HTTPContext> in use.
=head2 config
Returns the L<ASP4::Config> object for the web application.
=head2 properties
Returns an object representing your C</etc/properties.yaml> file.
=head2 data
Returns an object representing your C</etc/test_fixtures.yaml> file.
=head1 BUGS
It's possible that some bugs have found their way into this release.
Use RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=ASP4> to submit bug reports.
=head1 HOMEPAGE
lib/ASP4/Config.pm view on Meta::CPAN
{
$s->{web}->{"$key\_root"} =~ s/\@ServerRoot\@/$root/;
$s->{web}->{"$key\_root"} =~ s/\@ProjectRoot\@/$project_root/;
$s->{web}->{"$key\_root"} =~ s{\\\\}{\\}g;
}# end foreach()
$s->{web}->{project_root} = $project_root;
# Just in case we're dealing with a file-based db like SQLite:
foreach my $key (qw/ session main /)
{
$s->{data_connections}->{$key}->{dsn} =~ s/\@ServerRoot\@/$root/;
$s->{data_connections}->{$key}->{dsn} =~ s/\@ProjectRoot\@/$project_root/;
$s->{data_connections}->{$key}->{dsn} =~ s{\\\\}{\\}g;
}# end foreach()
# Make sure that $s->page_cache_root exists:
unless( $s->{web}{page_cache_root} )
{
if( $^O =~ m{win32}i )
{
my $temp_root = $ENV{TMP} || $ENV{TEMP};
$s->{web}{page_cache_root} = "$temp_root\\PAGE_CACHE";
}
lib/ASP4/Config.pm view on Meta::CPAN
# Web:
$Config->web->application_name;
$Config->web->application_root;
$Config->web->project_root;
$Config->web->www_root;
$Config->web->handler_root;
$Config->web->media_manager_upload_root;
$Config->web->page_cache_root;
# Data Connections:
foreach my $conn ( map { $Config->data_connections->$_ } qw/ session application main / )
{
my $dbh = DBI->connect(
$conn->dsn,
$conn->username,
$conn->password
);
}# end foreach()
=head1 JSON Config File
lib/ASP4/Config.pm view on Meta::CPAN
{
"uri_match": "^/handlers/dev\\.speed",
"disable_session": true
},
{
"uri_match": "^/index\\.asp",
"disable_session": true
}
]
},
"data_connections": {
"session": {
"manager": "ASP4::SessionStateManager",
"cookie_name": "session-id",
"cookie_domain": ".mysite.com",
"session_timeout": 30,
"dsn": "DBI:SQLite:dbname=/tmp/db_asp4",
"username": "",
"password": ""
},
"main": {
lib/ASP4/ConfigLoader.pm view on Meta::CPAN
#==============================================================================
sub load
{
my ($s) = @_;
my $path = ASP4::ConfigFinder->config_path;
my $file_time = (stat($path))[7];
if( exists($Configs->{$path}) && ( $file_time <= $Configs->{$path}->{timestamp} ) )
{
return $Configs->{$path}->{data};
}# end if()
open my $ifh, '<', $path
or die "Cannot open '$path' for reading: $!";
local $/;
my $doc = decode_json( scalar(<$ifh>) );
close($ifh);
(my $where = $path) =~ s/\/conf\/[^\/]+$//;
$Configs->{$path} = {
data => ASP4::ConfigParser->new->parse( $doc, $where ),
timestamp => $file_time,
};
return $Configs->{$path}->{data};
}# end parse()
1;# return true:
__END__
=pod
=head1 NAME
lib/ASP4/ConfigLoader.pm view on Meta::CPAN
my $Config = ASP4::ConfigLoader->load();
# $Config is a ASP4::Config object.
=head1 DESCRIPTION
This package solves the "How do I get my config?" problem most web applications
end up with at some point.
Config data is cached on a per-path basis. Paths are full - i.e. C</usr/local/projects/mysite.com/conf/asp4-config.json> -
so there should never be a clash between two different configurations on the
same web server, even if it is running multiple websites as VirtualHosts.
=head1 PUBLIC METHODS
=head2 load( )
Returns a L<ASP4::Config> object.
=head1 BUGS
lib/ASP4/Error.pm view on Meta::CPAN
{
$err_str = $@;
}# end if()
my $context = ASP4::HTTPContext->current;
my $Config = $context->config;
my $Response = $context->response;
my $Session = $context->session;
my $Form = $context->request->Form;
my %session_data = %$Session;
my $error;
if( $err_str )
{
my ($main, $message, $file, $line) = $err_str =~ m/^((.*?)\s(?:at|in)\s(.*?)\sline\s(\d+))/;
$error = {
message => $err_str,
file => $file,
line => $line,
stacktrace => $err_str,
lib/ASP4/Error.pm view on Meta::CPAN
my %info = (
# Defaults:
domain => eval { $Config->errors->domain } || $ENV{HTTP_HOST},
request_uri => $ENV{REQUEST_URI},
file => $error->{file},
line => $error->{line},
message => $error->{message},
stacktrace => $error->{stacktrace},
code => $code,
form_data => encode_json($Form) || "{}",
session_data => eval { encode_json(\%session_data) } || "{}",
http_referer => $ENV{HTTP_REFERER},
user_agent => $ENV{HTTP_USER_AGENT},
http_code => ($Response->Status =~ m{^(\d+)})[0],
remote_addr => $ENV{REMOTE_ADDR} || '127.0.0.1',
# Allow overrides:
%args
);
return bless \%info, $class;
}# end new()
sub domain { $_[0]->{domain} }
sub request_uri { $_[0]->{request_uri} }
sub file { $_[0]->{file} }
sub line { $_[0]->{line} }
sub message { $_[0]->{message} }
sub stacktrace { $_[0]->{stacktrace} }
sub code { $_[0]->{code} }
sub form_data { $_[0]->{form_data} }
sub session_data { $_[0]->{session_data} }
sub http_referer { $_[0]->{http_referer} }
sub user_agent { $_[0]->{user_agent} }
sub http_code { $_[0]->{http_code} }
sub remote_addr { $_[0]->{remote_addr} }
# Find the numbers within a given range, but not less than 1 and not greater than max.
sub _number_range
{
my ($s, $number, $max, $padding) = @_;
lib/ASP4/Error.pm view on Meta::CPAN
A string. Includes the 5 lines of code before and after the line of code where the error occurred.
=head2 message
Defaults to the first part of C<$@> unless otherwise specified.
=head2 stacktrace
A string - defaults to the value of C<$@>.
=head2 form_data
JSON-encoded C<$Form> object.
=head2 session_data
JSON-encoded C<$Session> object.
=head2 http_referer
Default value is C<$ENV{HTTP_REFERER}>
=head2 user_agent
Default value is C<$ENV{HTTP_USER_AGENT}>
lib/ASP4/ErrorHandler/Remote.pm view on Meta::CPAN
=head1 DESCRIPTION
This class provides a default error handler which does the following:
1) Makes a simple HTML page and prints it to the browser, telling the user
that an error has just occurred.
2) Sends an error notification to the web address specified in the config.
The data contained within the POST will match the public properties of L<ASP4::Error>, like this:
$VAR1 = {
'remote_addr' => '127.0.0.1',
'request_uri' => '/',
'user_agent' => 'test-useragent v2.0',
'file' => '/home/john/Projects/myapp/www/htdocs/index.asp',
'session_data' => '{}',
'message' => 'A fake error has occurred',
'http_code' => '500',
'stacktrace' => 'A fake error has occurred at /tmp/PAGE_CACHE/TSR_WWW/__index_asp.pm line 2.
',
'domain' => 'www.tsr.local',
'form_data' => '{}',
'http_referer' => '',
'code' => 'line 1: <h1>Hello, world!</h1>
line 2: <%
line 3: die "A fake error has occurred";
line 4: %>
',
'line' => '2'
};
=head1 PUBLIC METHODS
=head2 send_error( $error )
Sends the error data to the web address specified in C<<$Config->errors->post_errors_to>>.
The field names and values will correspond to the properties of an C<ASP4::Error> object.
=head1 BUGS
It's possible that some bugs have found their way into this release.
Use RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=ASP4> to submit bug reports.
=head1 HOMEPAGE
lib/ASP4/HTTPContext.pm view on Meta::CPAN
buffer => [ ASP4::OutBuffer->new ],
stash => { },
headers_out => HTTP::Headers->new(),
is_subrequest => $args{is_subrequest},
}, $class;
$s->config->_init_inc();
my $web = $s->config->web;
$s->config->load_class( $web->handler_resolver );
$s->config->load_class( $web->handler_runner );
$s->config->load_class( $s->config->data_connections->session->manager );
$s->config->load_class( $web->filter_resolver );
return $s->is_subrequest ? $s : $_instance = $s;
}# end new()
sub setup_request
{
my ($s, $r, $cgi) = @_;
lib/ASP4/HTTPContext.pm view on Meta::CPAN
$s->{request} ||= ASP4::Request->new();
$s->{response} ||= ASP4::Response->new();
$s->{server} ||= ASP4::Server->new();
if( $s->do_disable_session_state )
{
$s->{session} ||= ASP4::SessionStateManager::NonPersisted->new( $s->r );
}
else
{
$s->{session} ||= $s->config->data_connections->session->manager->new( $s->r );
}# end if()
return $_instance;
}# end setup_request()
# Intrinsics:
sub current { $_instance || shift->new }
sub request { shift->{request} }
sub response { shift->{response} }
lib/ASP4/HTTPContext.pm view on Meta::CPAN
}
sub rprint {
my ($s,$str) = @_;
$s->buffer->add( $str );
}
sub rflush {
my $s = shift;
$s->send_headers;
$s->r->print( $s->buffer->data );
$s->r->rflush;
$s->rclear;
}
sub rclear {
my $s = shift;
$s->buffer->clear;
}
sub send_headers
lib/ASP4/ModPerl.pm view on Meta::CPAN
{
my ($class, $r) = @_;
$ENV{DOCUMENT_ROOT} = $r->document_root;
$ENV{REMOTE_ADDR} = $r->connection->get_remote_host();
$ENV{HTTP_HOST} = $r->hostname;
my $context = ASP4::HTTPContext->new();
$r->pool->cleanup_register(sub { $context->DESTROY });
if( ($r->headers_in->{'content-type'}||'') =~ m/multipart\/form\-data/ )
{
$context->{r} = $r;
if( $@ )
{
warn $@;
$r->status( 500 );
return $r->status;
}# end if()
my $handler_class = eval {
lib/ASP4/OutBuffer.pm view on Meta::CPAN
package
ASP4::OutBuffer;
use strict;
use warnings 'all';
sub new
{
return bless { data => '' }, shift;
}# end new()
sub add
{
my ($s, $str) = @_;
return unless defined($str);
$s->{data} .= $str;
return;
}# end add()
sub data { shift->{data} }
sub clear { shift->{data} = '' }
sub DESTROY
{
my $s = shift;
delete($s->{data});
undef(%$s);
}# end DESTROY()
1;# return true:
lib/ASP4/Response.pm view on Meta::CPAN
{
my $s = shift;
$s->context->rprint( shift(@_) )
}# end Write()
sub SetCookie
{
my ($s, %args) = @_;
$args{domain} ||= eval { $s->context->config->data_connections->session->cookie_domain } || $ENV{HTTP_HOST};
$args{path} ||= '/';
my @parts = ( );
push @parts, $s->context->server->URLEncode($args{name}) . '=' . $s->context->server->URLEncode($args{value});
unless( $args{domain} eq '*' )
{
push @parts, 'domain=' . $s->context->server->URLEncode($args{domain});
}# end unless()
push @parts, 'path=' . $args{path};
if( $args{expires} )
{
lib/ASP4/Response.pm view on Meta::CPAN
expires => '30D' # A month
=back
=item * path
Defaults to "C</>" - you can restrict the "path" that the cookie will apply to.
=item * domain
Defaults to whatever you set your config->data_connections->session->cookie_domain to
in your asp4-config.json. Otherwise defaults to C<$ENV{HTTP_HOST}>.
You can override the defaults by passing in a domain, but the browser may not accept
other domains. See L<http://www.ietf.org/rfc/rfc2109.txt> for details.
=back
=head2 Redirect( $url )
Causes the following HTTP header to be sent:
lib/ASP4/SessionStateManager.pm view on Meta::CPAN
use Digest::MD5 'md5_hex';
use Storable qw( freeze thaw );
use Scalar::Util 'weaken';
use ASP4::ConfigLoader;
sub new
{
my ($class, $r) = @_;
my $s = bless { }, $class;
my $conn = context()->config->data_connections->session;
local $^W = 0;
$class->set_db('Session',
$conn->dsn,
$conn->username,
$conn->password
);
my $id = $s->parse_session_id();
unless( $id && $s->verify_session_id( $id, $conn->session_timeout ) )
lib/ASP4/SessionStateManager.pm view on Meta::CPAN
}
else
{
return $s->{____is_read_only};
}# end if()
}# end is_readonly()
sub parse_session_id
{
my $session_config = context()->config->data_connections->session;
my $cookie_name = $session_config->cookie_name;
my ($id) = ($ENV{HTTP_COOKIE}||'') =~ m/\b\Q$cookie_name\E\=([a-f0-9]{32,32})/s;
return $id;
}# end parse_session_id()
sub new_session_id { md5_hex( join ':', ( context()->config->web->www_root, $$, gettimeofday() ) ) }
sub write_session_cookie
{
my ($s, $r) = @_;
my $config = context()->config->data_connections->session;
my $domain = "";
unless( $config->cookie_domain eq '*' )
{
$domain = "domain=" . ( $config->cookie_domain || $ENV{HTTP_HOST} ) . ";";
}# end unless()
my $name = $config->cookie_name;
my @cookie = (
'Set-Cookie' => "$name=$s->{SessionID}; path=/; $domain"
);
lib/ASP4/SessionStateManager.pm view on Meta::CPAN
local $s->db_Session->{AutoCommit} = 1;
my $sth = $s->db_Session->prepare_cached(<<"");
delete from asp_sessions
where session_id = ?
$sth->execute( $id );
$sth = $s->db_Session->prepare_cached(<<"");
INSERT INTO asp_sessions (
session_id,
session_data,
created_on,
modified_on
)
VALUES (
?, ?, ?, ?
)
my $time = time();
my $now = time2iso($time);
$s->{__lastMod} = $time;
lib/ASP4/SessionStateManager.pm view on Meta::CPAN
return $s->retrieve( $id );
}# end create()
sub retrieve
{
my ($s, $id) = @_;
local $s->db_Session->{AutoCommit} = 1;
my $sth = $s->db_Session->prepare_cached(<<"");
SELECT session_data, modified_on
FROM asp_sessions
WHERE session_id = ?
my $now = time2iso();
$sth->execute( $id );
my ($data, $modified_on) = $sth->fetchrow;
$data = thaw($data) || { SessionID => $id };
$sth->finish();
$s->{$_} = $data->{$_} for keys %$data;
return $s;
}# end retrieve()
sub save
{
my ($s) = @_;
return unless $s->{SessionID};
no warnings 'uninitialized';
# $s->{__lastMod} = time();
$s->sign;
local $s->db_Session->{AutoCommit} = 1;
my $sth = $s->db_Session->prepare_cached(<<"");
UPDATE asp_sessions SET
session_data = ?,
modified_on = ?
WHERE session_id = ?
my %clone = %$s;
delete $clone{____is_read_only};
my $data = freeze( \%clone );
$sth->execute( $data, time2iso(), $s->{SessionID} );
$sth->finish();
1;
}# end save()
sub sign
{
my $s = shift;
lib/ASP4/SessionStateManager.pm view on Meta::CPAN
=head1 SYNOPSIS
You've seen this page <%= $Session->{counter}++ %> times before.
=head1 DESCRIPTION
Web applications require session state management - and the simpler, the better.
C<ASP4::SessionStateManager> is a simple blessed hash. When it goes out of scope,
it is saved to the database (or whatever).
If no changes were made to the session, it is not saved.
=head1 PUBLIC PROPERTIES
=head2 is_read_only( 1:0 )
Starting with version 1.044, setting this property to a true value will prevent
any changes made to the contents of the session during the current request from
being saved at the end of the request.
B<NOTE:> A side-effect is that calling C<< $Session->save() >> after calling C<< $Session->is_read_only(1) >>
will B<*NOT*> prevent changes from being saved B<ON PURPOSE>. Explicitly calling C<< $Session->save() >>
will still cause the session data to be stored. Setting C<< $Session->is_read_only(1) >> will only
prevent the default behavior of saving session state at the end of each successful request.
=head1 PUBLIC METHODS
=head2 save( )
Causes the session data to be saved. (Unless C<< $Session->is_read_only(1) >> is set.)
=head2 reset( )
Causes the session data to be emptied.
=head1 BUGS
It's possible that some bugs have found their way into this release.
Use RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=ASP4> to submit bug reports.
=head1 HOMEPAGE
Please visit the ASP4 homepage at L<http://0x31337.org/code/> to see examples
lib/ASP4/SessionStateManager/InMemory.pm view on Meta::CPAN
use base 'ASP4::SessionStateManager';
my $cache = {};
sub new
{
my ($class, $r) = @_;
my $id = $class->parse_session_id();
my $s = bless {SessionID => $id}, $class;
my $conn = ASP4::ConfigLoader->load->data_connections->session;
unless( $id && $s->verify_session_id( $id, $conn->session_timeout ) )
{
$s->{SessionID} = $s->new_session_id();
$s->write_session_cookie($r);
return $s->create( $s->{SessionID} );
}# end unless()
return $s->retrieve( $id );
}# end new()
lib/ASP4/SessionStateManager/Memcached.pm view on Meta::CPAN
use base 'ASP4::SessionStateManager';
use Cache::Memcached;
use JSON::XS;
my $memd;
sub new
{
my ($class, $r) = @_;
my $s = bless { }, $class;
my $conn = ASP4::ConfigLoader->load->data_connections->session;
$memd = Cache::Memcached->new({
servers => [ $conn->dsn ]
});
my $id = $s->parse_session_id();
unless( $id && $s->verify_session_id( $id, $conn->session_timeout ) )
{
$s->{__ttl} = $conn->session_timeout;
$s->{SessionID} = $s->new_session_id();
$s->write_session_cookie($r);
lib/ASP4/SimpleCGI.pm view on Meta::CPAN
use strict;
use warnings 'all';
use HTTP::Body;
sub new
{
my ($s, %args) = @_;
my %params = ();
my %upload_data = ();
no warnings 'uninitialized';
if( length($args{querystring}) )
{
foreach my $part ( split /&/, $args{querystring} )
{
my ($k,$v) = map { $s->unescape($_) } split /\=/, $part;
if( exists($params{$k}) )
{
if( ref($params{$k}) )
lib/ASP4/SimpleCGI.pm view on Meta::CPAN
# Parse form values:
my $form_info = $body->param || { };
if( keys(%$form_info) )
{
foreach( keys(%$form_info) )
{
$params{$_} = $form_info->{$_};
}# end foreach()
}# end if()
# Parse uploaded data:
if( my $uploads = $body->upload )
{
foreach my $name ( keys(%$uploads) )
{
open my $ifh, '<', $uploads->{$name}->{tempname}
or die "Cannot open '$uploads->{$name}->{tempname}' for reading: $!";
$upload_data{$name} = {
%{$uploads->{$name}},
'filehandle' => $ifh,
tempname => $uploads->{$name}->{tempname},
};
$params{$name} = $ifh;
}# end foreach()
}# end if()
}# end if()
my $cookies = { };
lib/ASP4/SimpleCGI.pm view on Meta::CPAN
{
foreach my $part ( split /;\s*/, $cookie_str )
{
my ($name,$val) = map { $s->unescape( $_ ) } split /\=/, $part;
$cookies->{$name} = $val;
}# end foreach()
}# end if()
return bless {
params => \%params,
uploads => \%upload_data,
cookies => $cookies,
%args
}, $s;
}# end new()
sub upload
{
my ($s, $key) = @_;
lib/ASP4/SimpleCGI.pm view on Meta::CPAN
=head1 NAME
ASP4::SimpleCGI - Basic CGI functionality
=head1 SYNOPSIS
use ASP4::SimpleCGI;
my $cgi = ASP4::SimpleCGI->new(
content_type => 'multipart/form-data',
content_length => 1200,
querystring => 'mode=create&uploadID=234234',
body => ...
);
my $val = $cgi->param('mode');
foreach my $key ( $cgi->param )
{
print $key . ' --> ' . $cgi->param( $key ) . "\n";
}# end foreach()
lib/ASP4/Test/Fixtures.pm view on Meta::CPAN
package
ASP4::Test::Fixtures;
use strict;
use warnings 'all';
use base 'Data::Properties::YAML';
sub as_hash
{
wantarray ? %{ $_[0]->{data} } : $_[0]->{data};
}# end as_hash()
1;# return true:
lib/ASP4/UserAgent.pm view on Meta::CPAN
}# end post()
sub upload
{
my ($s, $uri, $args) = @_;
chdir( $s->{cwd} );
$args ||= [ ];
my $req = POST $uri, Content_Type => 'form-data', Content => $args;
my $referer = $ENV{HTTP_REFERER};
%ENV = (
%{ $s->{env} },
HTTP_REFERER => $referer || '',
DOCUMENT_ROOT => $s->config->web->www_root,
REQUEST_METHOD => 'POST',
CONTENT_TYPE => 'multipart/form-data',
HTTP_COOKIE => $s->http_cookie,
REQUEST_URI => $uri,
);
my $cgi = $s->_setup_cgi( $req );
my ($uri_no_args, $querystring) = split /\?/, $uri;
my $r = ASP4::Mock::RequestRec->new( uri => $uri_no_args, args => $querystring );
$s->{context} = ASP4::HTTPContext->new( is_subrequest => $ASP4::HTTPContext::_instance ? 1 : 0 );
return do {
local $ASP4::HTTPContext::_instance = $s->context;
$s->context->setup_request( $r, $cgi );
lib/ASP4/UserAgent.pm view on Meta::CPAN
{
@cookies = @$v;
}
else
{
@cookies = ( $v );
}# end if()
foreach $v ( @cookies )
{
my ($data) = split /;/, $v;
my ($name,$val) = map { ASP4::SimpleCGI->unescape( $_ ) } split /\=/, $data;
$s->add_cookie( $name => $val );
}# end foreach()
}# end if()
}# end while()
}# end foreach()
$s->context->r->pool->call_cleanup_handlers();
# $s->context->DESTROY;
sbin/asphelper view on Meta::CPAN
"db=s" => \$dbName,
"user=s" => \$dbUser,
"host=s" => \$dbHost,
);
$appName && $domain && $email or die "Usage: $0 --app=AppName --domain=domain.com --email=you\@your-email.com [--host=dbhost --db=dbname --user=dbusername]\n";
$dbHost ||= "localhost";
if( $dbName && $dbUser )
{
print STDERR "Enter your database password: ";
ReadMode('noecho');
chomp($dbPass = <STDIN>);
ReadMode('restore');
print "\n";
}# end if()
my @DSN = (
"DBI:mysql:$dbName:$dbHost",
$dbUser,
$dbPass
sbin/asphelper view on Meta::CPAN
open my $ofh, '>', "common/sbin/ddl.sql"
or die "Cannot open 'common/sbin/ddl.sql' for writing: $!";
print $ofh <<"SQL";
set foreign_key_checks = 0;
drop table if exists asp_sessions;
set foreign_key_checks = 1;
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=innodb charset=utf8;
SQL
close($ofh);
open my $ifh, "common/sbin/ddl.sql"
or die "Cannot open 'common/sbin/ddl.sql' for reading: $!";
local $/ = ';';
while( my $cmd = <$ifh> )
sbin/asphelper view on Meta::CPAN
print $ofh <<"CODE";
@{[ 'package' ]} @{['']} $appFolder\::db::model;
use strict;
use warnings 'all';
use base 'Class::DBI::Lite::mysql';
use ASP4::ConfigLoader;
my \$Config = ASP4::ConfigLoader->load();
my \$conn = \$Config->data_connections->main;
__PACKAGE__->connection(
\$conn->dsn,
\$conn->username,
\$conn->password
);
1;# return true:
\=pod
sbin/asphelper view on Meta::CPAN
"handler_resolver": "ASP4::HandlerResolver",
"handler_runner": "ASP4::HandlerRunner",
"filter_resolver": "ASP4::FilterResolver",
"request_filters": [
],
"routes": [
],
"disable_persistence": [
]
},
"data_connections": {
EOF
if( $has_db )
{
$str .= <<'EOF';
"session": {
"manager": "ASP4::SessionStateManager",
"cookie_name": "session-id",
"cookie_domain": "*",
"session_timeout": "*",
sbin/asphelper view on Meta::CPAN
=pod
=head1 NAME
asphelper - Generate an ASP4 skeleton web application
=head1 USAGE
asphelper --app=AppName --domain=example.com --email=you@your-email.com [--host=dbhost --db=dbname --user=dbusername]
If you specify C<--dbname> and C<--dbuser> it will ask you for a database password - completely optional.
=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 and a simple unit test.
Use the resulting application as a starting-point for your own development.
t/010-basic/000-setup.t view on Meta::CPAN
$dbh->do(<<"SQL");
drop table if exists asp_sessions
SQL
my $ok = $dbh->do(<<"SQL");
create table asp_sessions (
session_id char(32) not null primary key,
modified_on timestamp not null default( datetime('now','localtime') ),
created_on datetime not null default( datetime('now','localtime') ),
session_data blob
)
SQL
ok($ok, "created table");
my $id = md5_hex( rand() );
$dbh->do(<<"SQL");
insert into asp_sessions (session_id, session_data) values ('$id','test')
SQL
my $sth = $dbh->prepare("SELECT * FROM asp_sessions WHERE session_id = ?");
$sth->execute( $id );
ok( my $rec = $sth->fetchrow_hashref, "fetched record" );
$sth->finish();
$dbh->disconnect();
t/010-basic/050-useragent.t view on Meta::CPAN
};
TEST7: {
my $res = $ua->get('/useragent/upload-form.asp');
my ($form) = HTML::Form->parse( $res->content, '/' );
ok( $form, 'found form' );
my $filename = ( $ENV{TEMP} || $ENV{TMP} || '/tmp' ) . '/' . rand() . '.txt';
open my $ofh, '>', $filename
or die "Cannot open '$filename' for writing: $!";
my $data = join "\n", map {
"$_: " . rand()
} 1..100;
print $ofh $data;
close($ofh);
open my $ifh, '<', $filename
or die "Cannot open '$filename' for reading: $!";
$form->find_input('filename')->value( $filename );
$res = $ua->submit_form( $form );
($form) = HTML::Form->parse( $res->content, '/' );
is(
$form->find_input('file_contents')->value => $data,
"File upload successful"
);
unlink($filename);
};
TEST8: {
my $filename = ( $ENV{TEMP} || $ENV{TMP} || '/tmp' ) . '/' . rand() . '.txt';
open my $ofh, '>', $filename
or die "Cannot open '$filename' for writing: $!";
my $data = join "\n", map {
"$_: " . rand()
} 1..100;
print $ofh $data;
close($ofh);
open my $ifh, '<', $filename
or die "Cannot open '$filename' for reading: $!";
my $res = $ua->upload('/useragent/upload-form.asp', [
filename => [$filename]
]);
my ($form) = HTML::Form->parse( $res->content, '/' );
is(
$form->find_input('file_contents')->value => $data,
"File upload successful"
);
unlink($filename);
};
TEST9: {
my $res = $ua->get('/masters/deep.asp');
my $expected = q(<html>
<head>
<title>
t/conf/asp4-config.json view on Meta::CPAN
{
"uri_match": "^/hello\\.asp",
"disable_session": true
},
{
"uri_match": "^/masters/deep.asp",
"disable_session": true
}
]
},
"data_connections": {
"session": {
"manager": "ASP4::SessionStateManager::InMemory",
"cookie_name": "session-id",
"cookie_domain": "*",
"session_timeout": "*",
"dsn": "DBI:SQLite:dbname=/tmp/db_asp4",
"username": "",
"password": ""
},
"main": {
t/htdocs/useragent/upload-form.asp view on Meta::CPAN
%>
<form name="form1">
<%= $file->FileName %> -- <%= $file->FileExtension %> -- <%= $file->FileSize %><br/>
<textarea name="file_contents"><%= $file->FileContents %></textarea>
</form>
<%
}
else
{
%>
<form name="form1" action="/useragent/upload-form.asp" method="post" enctype="multipart/form-data">
<input type="file" name="filename">
<br>
<input type="submit" value="Submit" >
</form>
<%
}# end if()
%>
</body>
</html>
( run in 0.596 second using v1.01-cache-2.11-cpan-8d75d55dd25 )