http://qs321.pair.com?node_id=386013
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;
}

Back to Code Catacombs