comment on

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;
}
[download]

In reply to Webserver-in-a-Webpage by dragonchild

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Perl Monk, Perl Meditation
	PerlMonks