ASP
view release on metacpan or search on metacpan
#####################################################################
require 5.005;
use strict;
my ($APACHE, $WIN32);
$APACHE = $Apache::ASP::VERSION;
$WIN32 = $^O =~ /win/i;
package ASP::IO;
sub TIEHANDLE { shift->new(@_) }
sub PRINT { shift->print(@_) }
sub PRINTF { shift->print(sprintf(@_)) }
sub new { bless {}, shift; }
sub print {
my $self = shift;
ASP::Print(@_);
1;
}
1;
package ASP;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $ASPOUT);
for (Win32::OLE::in $Request->ServerVariables) {
$ENV{$_} = $Request->ServerVariables($_)->Item;
}
}
}
$VERSION='1.07';
$ASPOUT = tie *RESPONSE_FH, 'ASP::IO';
select RESPONSE_FH unless $APACHE;
$SIG{__WARN__} = sub { ASP::Print(@_) };
sub _END { &$_() for @DeathHooks; @DeathHooks = (); 1; }
=head1 NAME
ASP - a Module for ASP (PerlScript) Programming
=head1 SYNOPSIS
use strict;
use ASP qw(:strict);
FYI: When implemented, this tweak led to the removal of the prototypes
Matt placed on his subs.
=head2 Warn LIST
C<Warn> is an alias for the ASP::Print method described below. The
overloading of C<warn> as described above does not currently work
in Apache::ASP, so this is provided.
=cut
sub Warn { ASP::Print(@_); }
=head2 print LIST
C<print> is overloaded to write to the browser by default. The inherent
behavior of print has not been altered and you can still use an alternate
filehandle as you normally would. This allows you to use print just
as you would in CGI scripts. The following statement would need no
modification between CGI and ASP PerlScript:
print param('URL'), " was requested by ", $ENV{REMOTE_HOST}, "\n";
=head2 Print LIST
Prints a string or comma separated list of strings to the browser. Use
as if you were using C<print> in a CGI application. Print gets around ASP's
limitations of 128k in a single $Response->Write() call.
NB: C<print> calls Print, so you could use either, but
print more closely resembles perl.
=cut
sub Print {
for (@_) {
if ( length($_) > 128000 ) {
ASP::Print( unpack('a128000a*', $_) );
} else {
$main::Response->Write($_);
}
}
}
=head2 DebugPrint LIST
Output is displayed between HTML comments so the output doesn't
interfere with page aesthetics.
=cut
sub DebugPrint { ASP::Print("<!--\n", @_, "\n-->"); }
=head2 HTMLPrint LIST
The same as C<Print> except the output is HTML-encoded so that
any HTML tags appear as sent, i.e. E<lt> becomes <, E<gt> becomes > etc.
=cut
sub HTMLPrint { map { ASP::Print($main::Server->HTMLEncode($_)) } @_ ; }
=head2 die LIST
Prints the contents of LIST to the browser and then exits. die
automatically calls $Response->End for you, it also executes any
cleanup code you have added with C<AddDeathHook>.
=cut
sub die {
ASP::Print(@_, "</BODY></HTML>");
_END;
$main::Response->End();
CORE::die();
}
=head2 exit
Exits the current script. $Response->End is called automatically for you.
Any cleanup code added with C<AddDeathHook> is also called.
=cut
sub exit {
_END;
$main::Response->End();
CORE::exit();
}
=head2 escape LIST
Escapes (URL-encodes) a list. Uses ASP object method
$Server->URLEncode().
=cut
sub escape { map { $main::Server->URLEncode($_) } @_; }
=head2 unescape LIST
Unescapes a URL-encoded list. Algorithms ripped from CGI.pm
method of the same name.
=cut
sub unescape {
map {
tr/+/ /;
s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
} @_;
}
=head2 escapeHTML LIST
Escapes a list of HTML. Uses ASP object method $Server->HTMLEncode().
If passed an array reference, escapeHTML will return a reference
to the escaped array.
=cut
sub escapeHTML {
my ($flag, @args) = (0, @_);
@args = @{$args[0]} and $flag++ if ref $args[0] eq "ARRAY";
$_ = $main::Server->HTMLEncode($_) for @args;
$flag ? \@args : @args;
}
=head2 unescapeHTML LIST
Unescapes an HTML-encoded list.
If passed an array reference, unescapeHTML will return a reference
to the un-escaped array.
=cut
sub unescapeHTML {
my ($flag, @args) = (0, @_);
@args = @{$args[0]} and $flag++ if ref $args[0] eq "ARRAY";
map {
s/&/&/gi;
s/"/"/gi;
s/ / /gi;
s/>/>/gi;
s/</</gi;
s/&#(\d+);/chr($1)/ge;
s/&#x([0-9a-f]+);/chr(hex($1))/gi;
param('y') returns 'c'
param('x') returns ('a', 'b')
param('x',1) returns 'a'
param('x',2) returns 'b'
NOTE: Under Apache::ASP, param() simply passes the arguments
to CGI::param() because Apache::ASP doesn't support the $obj->{Count}
property used in this function.
=cut
sub param {
if ($APACHE) {
return (wantarray) ? (CGI::param(@_)) : scalar(CGI::param(@_));
}
unless (@_) {
my @keys;
push( @keys, $_ ) for ( Win32::OLE::in $main::Request->QueryString );
push( @keys, $_ ) for ( Win32::OLE::in $main::Request->Form );
return @keys;
}
$_[1] = 1 unless defined $_[1];
returns 2.
NOTE: Under Apache::ASP, param_count() performs some manipulation
using CGI::param() because Apache::ASP doesn't support the
$obj->{Count} property used in this function.
=cut
sub param_count {
if ($APACHE) {
return scalar( @{[ CGI::param($_[0]) ]} );
}
if ($main::Request->ServerVariables('REQUEST_METHOD')->Item eq 'GET') {
return $main::Request->QueryString($_[0])->{Count};
} else {
return $main::Request->Form($_[0])->{Count};
}
}
=head2 AddDeathHook LIST
Allows cleanup code to be executed when you C<die> or C<exit>.
Useful for closing database connections in the event of a
fatal error.
<%
my $conn = Win32::OLE-new('ADODB.Connection');
$conn->Open("MyDSN");
$conn->BeginTrans();
ASP::AddDeathHook( sub { $Conn->Close if $Conn; } );
%>
Death hooks are not executed except by explicitly calling the die() or exit()
methods provided by ASP.pm.
AddDeathHook is not exported.
=cut
sub AddDeathHook { push @DeathHooks, @_; }
# These two functions are ripped from CGI.pm
sub expire_calc {
my($time) = @_;
my(%mult) = ('s'=>1,
'm'=>60,
'h'=>60*60,
'd'=>60*60*24,
'M'=>60*60*24*30,
'y'=>60*60*24*365);
# format for time can be in any of the forms...
# "now" -- expire immediately
# "+180s" -- in 180 seconds
AddDeathHook LIST
Allows cleanup code to be executed when you `die' or `exit'.
Useful for closing database connections in the event of a fatal
error.
<%
my $conn = Win32::OLE-new('ADODB.Connection');
$conn->Open("MyDSN");
$conn->BeginTrans();
ASP::AddDeathHook( sub { $Conn->Close if $Conn; } );
%>
Death hooks are not executed except by explicitly calling the
die() or exit() methods provided by ASP.pm.
AddDeathHook is not exported.
AUTHOR
Tim Hammerquist <tim@dichosoft.com>
( run in 0.231 second using v1.01-cache-2.11-cpan-4d50c553e7e )