ASP4
view release on metacpan or search on metacpan
use ASP4::API;
use MyApp::Foo;
my $api = ASP4::API->new;
- Also no need for BEGIN { ASP4::API->init }
- Added requirement Data::Properties::JSON.
- JSON is a better format for test fixtures.
- YAML can still be used.
2011-10-31 1.058
- Added experimental deployment tools `asp4-prep` and `asp4-deploy`.
* asp4-prep does an `svn export` and then gzips the folder and prints the *.tar.gz filename.
* asp4-deploy decompresses the *.tar.gz, creates a symbolic link 'deploying'
to the new folder, copies the existing config files from latest/*/conf/*
(if it exists) or copies conf/*.template config files and renames them without
the *.template suffix. If a 'latest/*' folder was found, asp4-deploy will
run any unit tests found. If all tests pass, then 'deploying' is removed
and 'latest' is changed to point to the new folder.
- TODO: Add POD for asp4-prep and asp4-deploy. This is delayed until it's proven
that this is the correct way for onesie-twosie deployments.
2011-10-04 1.057
README.markdown view on Meta::CPAN
## $Response
An instance of [ASP4::Response](http://search.cpan.org/perldoc?ASP4::Response), the `$Response` object gives shortcuts for dealing
with the outgoing reply from the server back to the client.
Examples:
### $Response->Write( $string )
The following example prints the string `Hello, World!` to the browser:
$Response->Write("Hello, World!");
Or, within an ASP script, `<%= "Hello, World" %>`
### $Response->Redirect( $url )
$Response->Redirect( "/new/url/?foo=bar" );
### $Response->SetCookie( %args )
inc/Module/Install.pm view on Meta::CPAN
local *FH;
open FH, "< $_[0]" or die "open($_[0]): $!";
my $str = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $str;
}
sub _write {
local *FH;
open FH, "> $_[0]" or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
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;
inc/Module/Install/Fetch.pm view on Meta::CPAN
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
$args{url} = $args{ftp_url}
or (warn("LWP support unavailable!\n"), return);
($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
}
$|++;
print "Fetching '$file' from $host... ";
unless (eval { require Socket; Socket::inet_aton($host) }) {
warn "'$host' resolve failed!\n";
return;
}
return unless $scheme eq 'ftp' or $scheme eq 'http';
require Cwd;
my $dir = Cwd::getcwd();
inc/Module/Install/Fetch.pm view on Meta::CPAN
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
}
unless (-f $file) {
warn "Fetching failed: $@\n";
chdir $dir; return;
}
return if exists $args{size} and -s $file != $args{size};
system($args{run}) if exists $args{run};
unlink($file) if $args{remove};
print(((!exists $args{check_for} or -e $args{check_for})
? "done!" : "failed! ($!)"), "\n");
chdir $dir; return !$?;
}
1;
inc/Module/Install/Makefile.pm view on Meta::CPAN
$makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
#$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
# Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
$makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
# XXX - This is currently unused; not sure if it breaks other MM-users
# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
print MAKEFILE "$preamble$makefile$postamble" or die $!;
close MAKEFILE or die $!;
1;
}
sub preamble {
my ($self, $text) = @_;
$self->{preamble} = $text . $self->{preamble} if defined $text;
$self->{preamble};
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
# Set the bugtracker
bugtracker( $links[0] );
return 1;
}
# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
# numbers (eg, 5.006001 or 5.008009).
# Also, convert double-part versions (eg, 5.8)
sub _perl_version {
my $v = $_[-1];
$v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
$v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
$v =~ s/(\.\d\d\d)000$/$1/;
$v =~ s/_.+$//;
if ( ref($v) ) {
$v = $v + 0; # Numify
}
return $v;
}
inc/Module/Install/Win32.pm view on Meta::CPAN
$self->load('get_file');
require Config;
return unless (
$^O eq 'MSWin32' and
$Config::Config{make} and
$Config::Config{make} =~ /^nmake\b/i and
! $self->can_run('nmake')
);
print "The required 'nmake' executable not found, fetching it...\n";
require File::Basename;
my $rv = $self->get_file(
url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
local_dir => File::Basename::dirname($^X),
size => 51928,
run => 'Nmake15.exe /o > nul',
check_for => 'Nmake.exe',
remove => 1,
lib/ASP4.pm view on Meta::CPAN
=head2 $Response
An instance of L<ASP4::Response>, 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<Hello, World!> 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 )
lib/ASP4/API.pm view on Meta::CPAN
use app::user;
use app::product;
use app::order;
# 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;
lib/ASP4/ErrorHandler.pm view on Meta::CPAN
use vars __PACKAGE__->VARS;
use MIME::Base64;
use Data::Dumper;
sub run
{
my ($s, $context) = @_;
my $error = $Stash->{error};
$s->print_error( $error );
$s->send_error( $error );
}# end run()
sub print_error
{
my ($s, $error) = @_;
$Response->ContentType('text/html');
if( $ENV{HTTP_HOST} eq 'localhost' )
{
$Response->Write( Dumper(\%$error) );
}
else
{
$Response->Write( $s->error_html( $error ) );
}# end if()
$Response->Flush;
}# end print_error()
sub send_error
{
my ($s, $error) = @_;
$Server->Mail(
To => $Config->errors->mail_errors_to,
From => $Config->errors->mail_errors_from,
Subject => "ASP4: Error in @{[ $ENV{HTTP_HOST} ]}@{[ $ENV{REQUEST_URI} ]}",
lib/ASP4/ErrorHandler.pm view on Meta::CPAN
"mail_errors_to": "you@server.com",
"mail_errors_from": "root@localhost",
"smtp_server": "localhost"
},
...
=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 that same HTML to the email address specified in the config, using the
SMTP server also specified in the config. The email subject will look something like:
ASP4: Error in your-site.com/index.asp
=head1 SUBCLASSING
To subclass C<ASP4::ErrorHandler> you must do the following:
lib/ASP4/ErrorHandler.pm view on Meta::CPAN
use vars __PACKAGE__->VARS;
sub run {
my ($s, $context) = @_;
my $error = $Stash->{error};
# $error is an ASP4::Error object.
# Do something here about the error.
$s->print_error( $error );
$s->send_error( $error );
}
1;# return true:
=head1 METHODS
=head2 error_html( $error )
Returns a string of html suitable for printing to the browser or emailing.
=head2 print_error( $error )
Prints the error html to the browser.
=head2 send_error( $error )
Sends the error html to the email address specified in the config, using C<<$Server->Mail(...)>>
and the smtp server specified in the config.
=head1 BUGS
lib/ASP4/ErrorHandler/Remote.pm view on Meta::CPAN
require ASP4;
our $ua;
sub run
{
my ($s, $context) = @_;
my $error = $Stash->{error};
$s->print_error( $error );
$s->send_error($error);
}# end run()
sub send_error
{
my ($s, $error) = @_;
$ua ||= LWP::UserAgent->new();
$ua->agent( ref($s) . " $ASP4::VERSION" );
lib/ASP4/ErrorHandler/Remote.pm view on Meta::CPAN
"errors": {
"error_handler": "ASP4::ErrorHandler::Remote",
"post_errors_to": "http://errors.ohno.com/post/errors/here/"
},
...
=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',
lib/ASP4/FileUpload.pm view on Meta::CPAN
{
mkdir( $folder, 0777 );
}# end unless()
}# end for()
open my $ofh, '>', $path
or confess "Cannot open '$path' for writing: $!";
my $ifh = $s->FileHandle;
while( my $line = <$ifh> )
{
print $ofh $line;
}# end while()
close($ofh);
return 1;
}# end SaveAs()
sub DESTROY
{
my $s = shift;
lib/ASP4/HTTPContext.pm view on Meta::CPAN
sub handler { shift->{handler} }
sub headers_out { shift->{headers_out} }
sub content_type { my $s = shift; $s->r->content_type( @_ ) }
sub status { my $s = shift; $s->r->status( @_ ) }
sub did_send_headers { shift->{did_send_headers} }
sub did_end {
my $s = shift;
@_ ? $s->{did_end} = shift : $s->{did_end};
}
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/Mock/RequestRec.pm view on Meta::CPAN
sub pool { shift->{pool} }
sub connection { shift->{connection} }
sub headers_out { shift->{headers_out} }
sub headers_in { shift->{headers_in} }
sub err_headers_out { shift->{err_headers_out} }
sub buffer { shift->{buffer} } # Not documented:
# Public methods:
sub print { my ($s,$str) = @_; $s->{buffer} .= $str; }
sub content_type
{
my ($s, $type) = @_;
return $s->headers_out->{'content-type'} unless $type;
$s->headers_out->{'content-type'} = $type;
}# end content_type()
sub rflush { }
1;# return true:
lib/ASP4/Mock/RequestRec.pm view on Meta::CPAN
=head2 status( [$new_status] )
Sets or gets the status code for the response. 200 for "OK", 301 for "Moved" - 404 for "not found" etc.
=head2 content_type( [$new_content_type] )
Sets or gets the mime-header for the outgoing response. Default is C<text/plain>.
=head1 PUBLIC METHODS
=head2 print( $str )
Adds C<$str> to the outgoing response buffer.
=head2 rflush( )
Does nothing.
=head1 BUGS
It's possible that some bugs have found their way into this release.
lib/ASP4/PageParser.pm view on Meta::CPAN
}
else
{
# It's a "start" tag: <asp:ContentPlaceHolder id="...">
my ($id) = $tag =~ m{<asp:ContentPlaceHolder\s+id\="(.+?)">}is;
push @stack, {
ident => $ident,
id => $id,
depth => $depth++,
line => $s->_tag_line_number( $tag ),
start_tag => '______INP_' . sprintf('%03d',$ident) . '______',
end_tag => '______OUTP_' . sprintf('%03d',$ident) . '______'
};
$ident++;
my $repl = $stack[-1]->{start_tag};
$$ref =~ s{\Q$tag\E}{$repl}s;
}# end if()
}# end foreach()
};
foreach my $tag ( sort {$b->{depth} <=> $a->{depth} } @placeholder_tags )
{
lib/ASP4/PageParser.pm view on Meta::CPAN
}
else
{
# It's a "start" tag: <asp:Content PlaceHolderID="...">
my ($id) = $tag =~ m{<asp:Content\s+PlaceHolderID\="(.+?)"\s*>}is;
push @stack, {
ident => $ident,
id => $id,
depth => $depth++,
line => $s->_tag_line_number( $tag ),
start_tag => '______INC_' . sprintf('%03d',$ident) . '______',
end_tag => '______OUTC_' . sprintf('%03d',$ident) . '______'
};
$ident++;
my $repl = $stack[-1]->{start_tag};
$$ref =~ s{\Q$tag\E}{$repl}s;
unshift @content_tags, $stack[-1];
}# end if()
}# end foreach()
};
foreach my $tag ( sort {$b->{depth} <=> $a->{depth} } @content_tags )
lib/ASP4/PageParser.pm view on Meta::CPAN
$_->{contents}
}# end $_->{id}
SUB
}# end foreach()
$code .= "\n1;# return true:\n";
open my $ofh, '>', $s->{saved_to}
or die "Cannot open '$s->{saved_to}' for writing: $!";
print $ofh $code;
close($ofh);
chmod(0766, $s->{saved_to});
my $config = ASP4::ConfigLoader->load();
$config->load_class( $s->{package} );
return $s->{package}->new();
}# end parse()
sub _tag_line_number
lib/ASP4/Response.pm view on Meta::CPAN
sub IsClientConnected
{
! shift->context->r->connection->aborted();
}# end IsClientConnected()
sub Write
{
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 = ( );
lib/ASP4/SimpleCGI.pm view on Meta::CPAN
{
return %{ $s->{cookies} };
}# end if()
}# end cookies()
sub escape
{
my $toencode = $_[1];
no warnings 'uninitialized';
$toencode =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/esg;
$toencode;
}# end escape()
sub unescape
{
my ($s, $todecode) = @_;
return unless defined($todecode);
$todecode =~ tr/+/ /; # pluses become spaces
$todecode =~ s/%(?:([0-9a-fA-F]{2})|u([0-9a-fA-F]{4}))/
lib/ASP4/SimpleCGI.pm view on Meta::CPAN
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()
my $escaped = $cgi->escape( 'Hello world' );
my $unescaped = $cgi->unescape( 'Hello+world' );
my $upload = $cgi->upload('filename');
my $filehandle = $cgi->upload_info('filename', 'filehandle' );
=head1 DESCRIPTION
my $api; BEGIN { $api = ASP4::API->new }
my $url = shift(@ARGV) or die <<"USAGE";
Usage: $0 "<url>"
USAGE
my $res = $api->ua->get( $url );
if( $res->is_success )
{
print $res->as_string;
}
else
{
warn "ERROR - Response As Follows:\n" . ("="x80) . "\n\n" . $res->as_string;
}# end if()
=pod
=head1 NAME
Call with arguments:
asp4 "/some/page.asp?foo=bar&baz=bux"
B<NOTE:> because of the "?" and "&" characters, you have to "quote" requests like this.
=head1 DESCRIPTION
C<asp4> provides a command-line means of calling asp scripts without involving a webserver.
The entire http response is printed - using the C<as_string> method of L<HTTP::Response>.
=head1 SEE ALSO
L<ASP4::API>, L<ASP4::UserAgent>
=cut
sbin/asp4-prep view on Meta::CPAN
{
(my $export_root = time2iso()) =~ s{\s+}{_};
$export_root =~ s{:}{.}g;
chdir("/tmp");
my $root = $api->config->web->project_root;
system("svn ls $root") and die $!;
(my $appName = $api->config->web->application_name) =~ s{::}{_}g;
`svn export $root "$appName\_$export_root" && tar -cz "$appName\_$export_root" > "$appName\_$export_root.tar.gz" && mv "$appName\_$export_root.tar.gz" $root`;
print "$root/$appName\_$export_root.tar.gz";
}# end if()
=pod
=head1 NAME
asp4-prep - Prepare your ASP4 application for remote deployment.
=head1 USAGE
sbin/asp4-prep view on Meta::CPAN
C<asp4-prep> is a convenience tool which will prepare your ASP4 application for
remote deployment.
C<asp4-prep> simply makes an C<svn export> of your project folder and uses C<tar> to
compress the file.
B<This probably will not work very well on Windows.>
=head2 OUTPUT
After a successful run, the filename of the asp4 archive is printed to STDOUT.
=head2 WARNINGS
None.
=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.
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
);
my $drh = DBI->install_driver("mysql");
my $rc = $drh->func('createdb', $dbName, $dbHost, $dbUser, $dbPass, 'admin');
sbin/asphelper view on Meta::CPAN
make_path('www/handlers');
# Write the ddl.sql file:
unless( -f "common/sbin/ddl.sql" )
{
warn "common/sbin/ddl.sql\n";
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
sbin/asphelper view on Meta::CPAN
or die "Cannot open 'www/conf/asp4-config.json' for writing: $!";
my $json = generic_config( $dbName && $dbUser );
$json =~ s/\%CWD\%/$cwd/igs;
$json =~ s/\%domain\%/$domain/igs;
$json =~ s/\%appName\%/$appName/igs;
$json =~ s/\%dbName\%/$dbName/igs;
$json =~ s/\%dbHost\%/$dbHost/igs;
$json =~ s/\%dbUser\%/$dbUser/igs;
$json =~ s/\%dbPass\%/$dbPass/igs;
$json =~ s/\%email\%/$email/igs;
print $ofh $json;
close($ofh);
}# end unless()
unless( -f "www/conf/httpd.conf" )
{
warn "www/conf/httpd.conf\n";
open my $ofh, '>', "www/conf/httpd.conf"
or die "Cannot open 'www/conf/httpd.conf' for writing: $!";
my $conf = generic_httpconf();
$conf =~ s/\%CWD\%/$cwd/igs;
$conf =~ s/\%domain\%/$domain/igs;
$conf =~ s/\%appName\%/$appName/igs;
$conf =~ s/\%dbName\%/$dbName/igs;
$conf =~ s/\%dbHost\%/$dbHost/igs;
$conf =~ s/\%dbUser\%/$dbUser/igs;
$conf =~ s/\%dbPass\%/$dbPass/igs;
$conf =~ s/\%email\%/$email/igs;
print $ofh $conf;
close($ofh);
}# end unless()
# Test page:
make_path("www/htdocs");
unless( -f "www/htdocs/index.asp" )
{
warn "www/htdocs/index.asp\n";
open my $ofh, '>', "www/htdocs/index.asp"
or die "Cannot open 'www/htdocs/index.asp' for writing: $!";
print $ofh <<'ASP';
<html>
<body>
<h1>ASP4 Test Page</h1>
<p>
The date and time is <%= scalar(localtime()) %>.
</p>
<p>
You have visited this page <%= $Session->{count}++ %> time(s) recently.
</p>
</body>
sbin/asphelper view on Meta::CPAN
}# end unless()
(my $hPath = lc($appName)) =~ s/::/\//g;
my $hClass = lc($appName);
make_path("www/handlers/$hPath/www");
unless( -f "www/handlers/$hClass/www/echo.pm" )
{
open my $ofh, '>', "www/handlers/$hPath/www/echo.pm"
or die "Cannot open 'www/handlers/$hPath/www/echo.pm' for writing: $!";
print $ofh <<"CODE";
package $hClass\::www::echo;
use strict;
use warnings 'all';
use base 'ASP4::FormHandler';
use vars __PACKAGE__->VARS;
use Data::Dumper;
sub run
sbin/asphelper view on Meta::CPAN
require Class::DBI::Lite;
$CDBIL_Version = $Class::DBI::Lite::VERSION = $Class::DBI::Lite::VERSION;
};
if( $dbName && $Class::DBI::Lite::VERSION )
{
unless( -f "common/lib/$appFolder/db/model.pm" )
{
warn "common/lib/$appFolder/db/model.pm\n";
open my $ofh, '>', "common/lib/$appFolder/db/model.pm"
or die "Cannot open 'common/lib/$appFolder/db/model.pm' for writing: $!";
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;
sbin/asphelper view on Meta::CPAN
close($ofh);
}# end unless()
}# end if()
unless( -f "www/t/010-basic/010-compile.t" )
{
warn "www/t/010-basic/010-compile.t\n";
open my $ofh, '>', "www/t/010-basic/010-compile.t"
or die "Cannot open 'www/t/010-basic/010-compile.t' for writing: $!";
print $ofh <<"TEST";
#!/usr/bin/perl -w
use strict;
use warnings 'all';
use Test::More 'no_plan';
use ASP4::API;
my \$api = ASP4::API->new;
TEST
if( $CDBIL_Version )
{
print $ofh <<"MORE";
@{[ $dbName ? qq(use_ok('$appName\::db::model');) : '' ]}
MORE
}# end if()
print $ofh <<"TEST";
my \$res = \$api->ua->post("/handlers/$hClass.www.echo", {
hello => "world"
});
like \$res->content, qr('hello'\\s+\\=\>\\s+'world'), "/handlers/$hClass.www.echo?hello=world works";
ok( \$res = \$api->ua->get("/"), "Got '/'.");
ok( \$res->is_success, "GET / is successful.");
ok( \$res->content, "Got some content also.");
TEST
if( $dbName && $dbUser )
{
print $ofh <<"TEST";
for( 0..10 )
{
like \$res->content, qr(visited this page \$_ time), "Simple session counter: \$_ visits recorded.";
\$res = \$api->ua->get("/");
}# end for()
TEST
}# end if()
print $ofh <<"TEST";
# More tests can go here or in other files.
TEST
close($ofh);
}# end unless()
warn "="x60, "\n";
warn " Running Initial Test Suite...\n";
warn "="x60, "\n";
t/010-basic/000-setup.t view on Meta::CPAN
{
$temp_root = $ENV{TEMP} || $ENV{TMP};
}# end if()
my $dbfile = "$temp_root/db_asp4";
open my $ofh, '>', $dbfile
or die "Cannot open '$dbfile' for writing: $!";
binmode($ofh);
SCOPE: {
no warnings 'uninitialized';
print $ofh undef;
};
close($ofh);
my $dbh = DBI->connect("DBI:SQLite:dbname=$dbfile", "", "", {
RaiseError => 1,
});
$dbh->do(<<"SQL");
drop table if exists asp_sessions
SQL
t/010-basic/050-useragent.t view on Meta::CPAN
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"
t/010-basic/050-useragent.t view on Meta::CPAN
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(
( run in 0.797 second using v1.01-cache-2.11-cpan-de7293f3b23 )