Category: |
CGI Programming |
Author/Contact Info |
Rob Kinyon (rkinyon@columbus.rr.com) |
Description: |
ActivePerl has a version of Perl called PerlScript, which behaves like JavaScript does under IE. (Something to do with ActiveX registration or whatnot.) So, you now have the full power of Perl as a client-side programming language, usable wherever you could use JavaScript.
Now, this isn't that useful for standard CGI programming, because every person that visits your site would have to have a specific minimum version of ActivePerl installed. But, it could be useful as a client-side only development environment.
Microsoft has also created an extension called .hta, or HTml Application. Doubleclicking on this will tell Windows to call IE with a number of standard things (like toolbars) intially disabled. (You can re-enable them with a few right-clicks, but most people don't know that.)
The example I've given uses CGI::Application as the method for generating pages. It's certainly not the only way, but I like it. |
yourapp.hta
-----------
<html><head><title>Your App</title>
<HTA:APPLICATION BORDER="thick" ICON="info.ico">
<script language='PerlScript' src='C:\location\of\server.pl'></script>
<script language='PerlScript'>
use vars qw(
$window
$listener
);
# Don't change above this line!
use strict;
use warnings;
use lib qw(
C:\your\libraries\here
);
use Your::Application;
sub main
{
my $app = Your::Application->new();
$app->header_type( 'none' );
$app->param(
href_base => "http://localhost:".$listener->sockport(),
window => $window,
);
$app->run;
}
# Don't change below this line!
</script>
<frameset border=0 rows='100'>
<frame src='javascript: parent.main();' application='yes'>
</frameset>
------------
server.pl
------------
#
# An simple way to give a perl script a windows interface.
# The application is scripted in html using "PerlScript"
# inside an HTML document. If the document is saved with
# a ".hta" extension it becomes an "HTML application".
#
# Requirements:
# ActivePerl from http://www.activestate.com
# Internet Explorer version 5 or later.
#
# This code is distriubuted under the "Artistic" license
# a copy of which is distributed with Perl.
#
# Copyright John Holdsworth <coldwave@thunder.it> (c) 2001
# http://www.openpsp.org/source/util/du.hta.gz
#
# Minor changes made by Rob Kinyon <rkinyon@columbus.rr.com>, 2004
#
# See also:
# http://www.openpsp.org/source/util/perltoc.pl # searchable perl doc
+s
# http://www.openpsp.org/source/util/search.html.gz # search any docs
#
#
# use CGI with "non parsed headers" as
# script talks directly to browser
#
use CGI qw( -nph );
use IO::Socket;
use strict;
use warnings;
use vars qw(
$window
$listener
);
# required for open to work
close STDIN;
close STDOUT;
# server runs on any available port
# a zero second timeout is not possible using IO::Socket
$listener = IO::Socket::INET->new(
Listen => 5,
LocalAddr => "127.0.0.1",
Timeout => 0.000001,
) or warn "Could not open Socket";
#
# start polling for connections
#
poll();
#
# This function is called periodically
# to poll for incomming HTTP requests
#
sub poll
{
my $connection = $listener->accept();
# process connection if did not timeout
$connection
? ( accepted( $connection ) )
: ( $@ = '' );
# poll again in 100ms using timeout
$window->setTimeout( "poll();", 100 );
}
# A connection has been made, simulate CGI interface...
sub accepted
{
my ($connection) = @_;
# connect STDIN, STDOUT to browser socket using dup().
my $fd = fileno $connection;
open STDIN, "<& $fd";
open STDOUT, ">& $fd";
select STDOUT; $| = 1;
# parse initial request line of header
@ENV{qw(REQUEST_METHOD REQUEST_URI REMOTE_PROTOCOL)} = split /\s/,
+ <STDIN>;
# remove any parameters from a form of method "GET"
@ENV{qw(PATH_INFO QUERY_STRING)} = $ENV{REQUEST_URI} =~ /^([^?]*)\
+??(.*)/;
# unescape any path_info in request
$ENV{PATH_INFO} =~ s/%([0-9a-fA-F]{2})/chr hex($1)/ge;
# parse the rest of the "name: value\n" pairs
# in the header until there is a blank line.
while ( my ( $name, $value ) = <STDIN> =~ /^([^:]*):? ([^\r\n]*)/
+)
{
$name =~ tr/-a-z/_A-Z/;
$name =~ s/^(?!CONTENT_)/HTTP_/;
$ENV{$name} = $value;
}
# run application
main();
# CGI needs to be reset
CGI->_reset_globals();
CGI->nph( 1 );
# close out files from dup()
# to disconnect from browser
# and complete request.
flush STDOUT;
close STDOUT;
close STDIN;
}
|
|
|