ASP4
view release on metacpan or search on metacpan
README.markdown view on Meta::CPAN
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.
README.markdown view on Meta::CPAN
<asp:Content PlaceHolderID="meta_title">Register</asp:Content>
<asp:Content PlaceHolderID="headline">Register</asp:Content>
<asp:Content PlaceHolderID="main_content">
<%
# 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;
%><span class="field_error"><%= $Server->HTMLEncode( $error ) %></span><%
};
README.markdown view on Meta::CPAN
<label>Message:</label><br/>
<textarea name="body"></textarea>
</p>
<p>
<input type="submit" value="Send Message" />
</p>
</form>
</div>
</asp:Content>
The form submits to `/handlers/app.send` which maps to `handlers/app/send.pm`
File: `handlers/app/send.pm`
package app::send;
use strict;
use warnings 'all';
use base 'ASP4::FormHandler';
use vars __PACKAGE__->VARS;
inc/Module/Install.pm view on Meta::CPAN
close FH or die "close($_[0]): $!";
}
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version ($) {
my $s = shift || 0;
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
(
defined $_[0]
and
! ref $_[0]
inc/Module/Install/Makefile.pm view on Meta::CPAN
if ( $self->tests ) {
die "tests_recursive will not work if tests are already defined";
}
my $dir = shift || 't';
unless ( -d $dir ) {
die "tests_recursive dir '$dir' does not exist";
}
%test_dir = ();
require File::Find;
File::Find::find( \&_wanted_t, $dir );
$self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
}
sub write {
my $self = shift;
die "&Makefile->write() takes no arguments\n" if @_;
# Make sure we have a new enough
require ExtUtils::MakeMaker;
# MakeMaker can complain about module versions that include
inc/Module/Install/Makefile.pm view on Meta::CPAN
if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
$args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
# merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
map { @$_ }
map { @$_ }
grep $_,
($self->configure_requires, $self->build_requires, $self->requires)
);
# Remove any reference to perl, PREREQ_PM doesn't support it
delete $args->{PREREQ_PM}->{perl};
# merge both kinds of requires into prereq_pm
my $subdirs = ($args->{DIR} ||= []);
if ($self->bundles) {
inc/Module/Install/Makefile.pm view on Meta::CPAN
}
if ( my $perl_version = $self->perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
}
$args->{INSTALLDIRS} = $self->installdirs;
my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
my $user_preop = delete $args{dist}->{PREOP};
if (my $preop = $self->admin->preop($user_preop)) {
foreach my $key ( keys %$preop ) {
$args{dist}->{$key} = $preop->{$key};
}
}
my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
$self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
inc/Module/Install/Metadata.pm view on Meta::CPAN
$self->{values}{$key} = shift;
return $self;
};
}
foreach my $key ( @resource_keys ) {
*$key = sub {
my $self = shift;
unless ( @_ ) {
return () unless $self->{values}{resources};
return map { $_->[1] }
grep { $_->[0] eq $key }
@{ $self->{values}{resources} };
}
return $self->{values}{resources}{$key} unless @_;
my $uri = shift or die(
"Did not provide a value to $key()"
);
$self->resources( $key => $uri );
return 1;
};
inc/Module/Install/Metadata.pm view on Meta::CPAN
my $self = shift;
while ( @_ ) {
my $module = shift or last;
my $version = shift || 0;
push @{ $self->{values}{bundles} }, [ $module, $version ];
}
$self->{values}{bundles};
}
# Resource handling
my %lc_resource = map { $_ => 1 } qw{
homepage
license
bugtracker
repository
};
sub resources {
my $self = shift;
while ( @_ ) {
my $name = shift or last;
inc/Module/Install/Metadata.pm view on Meta::CPAN
# The user used ->feature like ->features by passing in the second
# argument as a reference. Accomodate for that.
$mods = $_[0];
} else {
$mods = \@_;
}
my $count = 0;
push @$features, (
$name => [
map {
ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
} @$mods
]
);
return @$features;
}
sub features {
my $self = shift;
inc/Module/Install/Metadata.pm view on Meta::CPAN
# Load the advisory META.yml file
require YAML::Tiny;
my @yaml = YAML::Tiny::LoadFile('META.yml');
my $meta = $yaml[0];
# Overwrite the non-configure dependency hashs
delete $meta->{requires};
delete $meta->{build_requires};
delete $meta->{recommends};
if ( exists $val->{requires} ) {
$meta->{requires} = { map { @$_ } @{ $val->{requires} } };
}
if ( exists $val->{build_requires} ) {
$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
}
# Save as the MYMETA.yml file
YAML::Tiny::DumpFile('MYMETA.yml', $meta);
}
1;
lib/ASP4.pm view on Meta::CPAN
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.
lib/ASP4.pm view on Meta::CPAN
<%@ Page UseMasterPage="/masters/global.asp" %>
<asp:Content PlaceHolderID="meta_title">Register</asp:Content>
<asp:Content PlaceHolderID="headline">Register</asp:Content>
<asp:Content PlaceHolderID="main_content">
<%
# 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;
%><span class="field_error"><%= $Server->HTMLEncode( $error ) %></span><%
};
%>
lib/ASP4.pm view on Meta::CPAN
<label>Message:</label><br/>
<textarea name="body"></textarea>
</p>
<p>
<input type="submit" value="Send Message" />
</p>
</form>
</div>
</asp:Content>
The form submits to C</handlers/app.send> which maps to C<handlers/app/send.pm>
File: C<handlers/app/send.pm>
package app::send;
use strict;
use warnings 'all';
use base 'ASP4::FormHandler';
use vars __PACKAGE__->VARS;
use App::db::user;
lib/ASP4/Config.pm view on Meta::CPAN
$s->init_server_root( $root );
$s->_init_inc();
my $vars = $s->system->env_vars;
foreach my $var ( keys %$vars )
{
$ENV{$var} = $vars->{$var};
}# end foreach()
map { $s->load_class( $_ ) } $s->system->load_modules;
return $s;
}# end new()
sub _init_inc
{
my $s = shift;
my %saw = map { $_ => 1 } @INC;
my $web = $s->web;
push @INC, grep { ! $saw{$_}++ } ( $s->system->libs, $web->handler_root, $web->page_cache_root );
}# end _init_inc()
sub init_server_root
{
my ($s, $root) = @_;
my $project_root = (sub{
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/ConfigNode/Web.pm view on Meta::CPAN
sub new
{
my $class = shift;
my $s = $class->SUPER::new( @_ );
$s->{handler_resolver} ||= 'ASP4::HTTPContext::HandlerResolver';
$s->{handler_runner} ||= 'ASP4::HTTPContext::HandlerRunner';
$s->{filter_resolver} ||= 'ASP4::HTTPContext::FilterResolver';
map {
$_->{uri_match} = undef unless defined($_->{uri_match});
$_->{uri_equals} = undef unless defined($_->{uri_equals});
$_ = $class->SUPER::new( $_ );
} $s->request_filters;
map {
$_->{uri_match} = undef unless defined($_->{uri_match});
$_->{uri_equals} = undef unless defined($_->{uri_equals});
$_->{disable_session} ||= 0;
$_->{disable_application} ||= 0;
$_ = $class->SUPER::new( $_ );
} $s->disable_persistence;
# Do we have "routes"?:
eval { require Router::Generic };
$s->{__has_router} = ! $@;
lib/ASP4/ConfigNode/Web.pm view on Meta::CPAN
$s->{routes};
}# end routes()
sub _parse_routes
{
my $s = shift;
my @original = @{ $s->{routes} };
my $app_root = $s->application_root;
@{ $s->{routes} } = map {
$_->{include_routes} ? do {
my $item = $_;
$item->{include_routes} =~ s/\@ServerRoot\@/$app_root/sg;
$item->{include_routes} =~ s{\\\\}{\\}g;
open my $ifh, '<', $item->{include_routes}
or die "Cannot open '$item->{include_routes}' for reading: $!";
local $/;
my $json = eval { decode_json( scalar(<$ifh>) ) }
or confess "Error parsing '$item->{include_routes}': $@";
ref($json) eq 'ARRAY'
or confess "File '$item->{include_routes}' should be an arrayref but it's a '@{[ ref($json) ]}' instead.";
@$json;
} : $_
} @original;
my $router = Router::Generic->new();
map { $router->add_route( %$_ ) } @{ $s->{routes} };
$s->{router} = $router;
}# end _parse_routes()
1;# return true:
=pod
=head1 NAME
ASP4::ConfigNode::Web - The $Config->web object.
lib/ASP4/HTTPHandler.pm view on Meta::CPAN
$Session = $context->session;
$Server = $context->server;
$Form = $context->request->Form;
$Config = $context->config;
$Stash = $context->stash;
my $class = ref($s) ? ref($s) : $s;
my @classes = $s->_parents( $class );
no strict 'refs';
my %saw = ( );
map {
${"$_\::Request"} = $Request;
${"$_\::Response"} = $Response;
${"$_\::Session"} = $Session;
${"$_\::Server"} = $Server;
${"$_\::Form"} = $Form;
${"$_\::Config"} = $Config;
${"$_\::Stash"} = $Stash;
} grep { ! $saw{$_}++ } @classes;
return 1;
lib/ASP4/HTTPHandler.pm view on Meta::CPAN
my ($s, $file) = @_;
$file ||= $Config->web->application_root . '/etc/properties.yaml';
return Data::Properties::YAML->new( properties_file => $file );
}# end properties()
sub trim_form
{
no warnings 'uninitialized';
map {
$Form->{$_} =~ s/^\s+//;
$Form->{$_} =~ s/\s+$//;
} keys %$Form;
}# end trim_form()
sub _parents
{
my ($s, $class ) = @_;
lib/ASP4/HTTPHandler.pm view on Meta::CPAN
my $diff = time() - ${"$class\::__PARENTS_TIME"};
my $max_age = 5;
if( @{"$class\::__PARENTS"} && $diff < $max_age )
{
return @{"$class\::__PARENTS"};
}# end if()
my @classes = ( $class );
my $pkg = __PACKAGE__;
my %saw = ( );
push @classes, map { $s->_parents( $_ ) }
grep { ( ! $saw{$_}++ ) && $_->isa($pkg) }
@{"$class\::ISA"};
${"$class\::__PARENTS_TIME"} = time();
return @{"$class\::__PARENTS"} = @classes;
}# end _parents()
sub DESTROY
{
lib/ASP4/Mock/Pool.pm view on Meta::CPAN
package ASP4::Mock::Pool;
use strict;
use warnings 'all';
sub new { return bless { cleanup_handlers => [ ] }, shift }
sub call_cleanup_handlers {
my $s = shift;
map { $_->( ) } @{ $s->{cleanup_handlers} }
}
sub cleanup_register {
my ($s, $handler, $args) = @_;
push @{ $s->{cleanup_handlers} }, sub { $handler->( $args ) };
}
sub DESTROY
{
my $s = shift;
lib/ASP4/ModPerl.pm view on Meta::CPAN
{
warn $@;
$r->status( 500 );
return $r->status;
}# end if()
return 404 unless $handler_class;
eval {
my $cgi = CGI->new( $r );
my %args = map { my ($k,$v) = split /\=/, $_; ( $k => $v ) } split /&/, $ENV{QUERY_STRING};
map { $cgi->param($_ => $args{$_}) } keys %args;
$context->setup_request( $r, $cgi);
$context->execute;
};
if( $@ )
{
if( $@ =~ m/Software\scaused\sconnection\sabort/ )
{
return 0;
}# end if()
warn $@;
lib/ASP4/Request.pm view on Meta::CPAN
sub new
{
my ($class, %args) = @_;
my $cgi = $class->context->cgi;
my $s = bless {
%args,
form => {
(
map {
# CGI->Vars joins multi-value params with a null byte. Which sucks.
# To avoid that behavior, we do this instead:
my @val = map { $cgi->unescape( $_ ) } ( $cgi->param($_) );
$cgi->unescape($_) => scalar(@val) > 1 ? \@val : shift(@val)
} $cgi->param
),
(
map {
# CGI->Vars joins multi-value params with a null byte. Which sucks.
# To avoid that behavior, we do this instead:
my @val = map { $cgi->unescape( $_ ) } ( $cgi->url_param($_) );
$cgi->unescape($_) => scalar(@val) > 1 ? \@val : shift(@val)
} $cgi->url_param
),
},
}, $class;
return $s;
}# end new()
lib/ASP4/Request.pm view on Meta::CPAN
my ($uri, $querystring) = split /\?/, $where;
$querystring ||= "";
$s->context->r->uri( $uri );
my $args = $s->context->r->args;
$args .= $args ? "&$querystring" : $querystring;
$s->context->r->args( $args );
$ENV{QUERY_STRING} = $args;
my $cgi = $s->context->cgi;
my $Form = $s->context->request->Form;
map {
my ($k,$v) = split /\=/, $_;
$Form->{ $cgi->unescape($k) } = $cgi->unescape( $v );
} split /&/, $querystring;
( my $path = $s->context->server->MapPath( $uri ) ) =~ s{/+$}{};
$path .= "/index.asp" if -f "$path/index.asp";
$ENV{SCRIPT_FILENAME} = $path;
$ENV{SCRIPT_NAME} = $path;
return $s->context->response->Declined;
}# end Reroute()
lib/ASP4/Response.pm view on Meta::CPAN
$s->context->headers_out->header( $name => $value );
}# end AddHeader()
sub Headers
{
my $s = shift;
my $out = $s->context->headers_out;
map {{
$_ => $out->{$_}
}} keys %$out;
}# end Headers()
sub Redirect
{
my ($s, $url) = @_;
$s->Clear;
lib/ASP4/SessionStateManager.pm view on Meta::CPAN
}# end sign()
sub _hash
{
my $s = shift;
no warnings 'uninitialized';
md5_hex(
join ":",
map { "$_:$s->{$_}" }
grep { $_ ne '__signature' && $_ ne '____is_read_only' } sort keys(%$s)
);
}# end _hash()
sub is_changed
{
my $s = shift;
no warnings 'uninitialized';
lib/ASP4/SessionStateManager/InMemory.pm view on Meta::CPAN
my ($s) = @_;
1;
}# end save()
sub reset
{
my $s = shift;
map { delete($s->{$_}) } grep { $_ ne 'SessionID' } keys %$s;
$s->save;
return;
}# end reset()
1;# return true:
lib/ASP4/SessionStateManager/Memcached.pm view on Meta::CPAN
my %clone = %$s;
my $json = encode_json(\%clone);
$memd->set( $s->{SessionID}, $json, $s->{__ttl} );
}# end save()
sub reset
{
my $s = shift;
map { delete($s->{$_}) } grep { $_ !~ m{^(SessionID|__ttl)$} } keys %$s;
$s->save;
return;
}# end reset()
1;# return true:
lib/ASP4/SimpleCGI.pm view on Meta::CPAN
{
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}) )
{
push @{$params{$k}}, $v;
}
else
{
$params{$k} = [ $params{$k}, $v ];
lib/ASP4/SimpleCGI.pm view on Meta::CPAN
$params{$name} = $ifh;
}# end foreach()
}# end if()
}# end if()
my $cookies = { };
if( my $cookie_str = $ENV{HTTP_COOKIE} )
{
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;
lib/ASP4/SimpleCGI.pm view on Meta::CPAN
$todecode =~ s/%(?:([0-9a-fA-F]{2})|u([0-9a-fA-F]{4}))/
defined($1)? chr hex($1) : utf8_chr(hex($2))/ge;
return $todecode;
}# end unescape()
sub DESTROY
{
my $s = shift;
map {
close($s->{uploads}->{$_}->{filehandle});
unlink($s->{uploads}->{$_}->{tempname});
} keys(%{$s->{uploads}});
undef(%$s);
}# end DESTROY()
1;# return true:
=pod
lib/ASP4/UserAgent.pm view on Meta::CPAN
delete( $s->{cookies}->{$name} );
}# end remove_cookie()
sub http_cookie
{
my $s = shift;
join '; ',
map { ASP4::SimpleCGI->escape($_) . '=' . ASP4::SimpleCGI->escape($s->{cookies}->{$_}) }
keys %{$s->{cookies}};
}# end http_cookie()
sub _setup_response
{
my ($s, $response_code) = @_;
$response_code = 200 if ($response_code || 0) eq '0';
my $response = HTTP::Response->new( $response_code );
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/asp4-deploy view on Meta::CPAN
foreach my $file ( @files )
{
if( (stat("latest/$folder/conf/$file.template"))[7] )
{
`cp latest/$folder/conf/$file.template latest/$folder/conf/$file`;
push @to_update, "latest/$folder/conf/$file";
}# end if()
}# end foreach()
}# end foreach()
warn "\n\n***You must update the following configuration files:***\n";
warn join( "\n", map {"\t* $_"} @to_update), "\n\n";
}# end if()
=pod
=head1 NAME
asp4-deploy - Deploy your prepared ASP4 application.
=head1 USAGE
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, '/' );
t/010-basic/050-useragent.t view on Meta::CPAN
$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]
]);
t/999-finish/000-cleanup.t view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use warnings 'all';
use Test::More 'no_plan';
my $temp_root = $ENV{TEMP} || $ENV{TMP} || '/tmp';
my $filename = "$temp_root/db_asp4";
ok( unlink($filename), "unlink('$filename')" );
map {
ok(
unlink($_),
"unlink('$_')"
);
} <$temp_root/PAGE_CACHE/DefaultApp/*.pm>;
t/htdocs/index.asp view on Meta::CPAN
</ul>
<div class="clear"></div>
</div>
<div id="contents">
<h2>ASP4 Is Running on this Server</h2>
<p>
For more information about ASP4, please used the links provided on the left.
</p>
<p>
<b>Loaded ASP4 Modules:</b>
<pre><%= join "\n", map { $_ =~ s{/}{::}g; $_ =~ s/\.pm$//; $_ } sort grep { m{^ASP4/} } keys %INC %></pre>
</p>
</div>
</div>
</body>
</html>
( run in 0.485 second using v1.01-cache-2.11-cpan-a9ef4e587e4 )