#!/usr/bin/perl -w ## This program is based on an example program for TQt. It ## may be used, distributed and modified without limitation. ## ## Copyright (C) 1992-2000 Trolltech AS. All rights reserved. # When a new client connects, the server constructs a TQt::Socket and all # communication with the client is done over this Socket object. TQt::Socket # works asynchronously - this means that all the communication is done # through the two slots readClient() and discardClient(). package HttpDaemon; use TQt; use TQt::isa qw(TQt::ServerSocket); use TQt::signals newConnect => [], endConnect => [], wroteToClient => []; use TQt::slots readClient => [], discardClient => []; use TQt::attributes qw( sockets ); sub NEW { shift->SUPER::NEW(8080, 1, $_[0]); if( !this->ok() ) { die "Failed to bind to port 8080\n"; } sockets = {}; } sub newConnection { my $s = TQt::Socket( this ); this->connect( $s, TQT_SIGNAL 'readyRead()', this, TQT_SLOT 'readClient()' ); this->connect( $s, TQT_SIGNAL 'delayedCloseFinished()', this, TQT_SLOT 'discardClient()' ); $s->setSocket( shift ); sockets->{ $s } = $s; emit newConnect(); } sub readClient { # This slot is called when the client sent data to the server. The # server looks if it was a get request and sends a very simple HTML # document back. my $s = sender(); if ( $s->canReadLine() ) { my @tokens = split( /\s\s*/, $s->readLine() ); if ( $tokens[0] eq "GET" ) { my $string = "HTTP/1.0 200 Ok\n\rContent-Type: text/html; charset=\"utf-8\"\n\r". "\n\r

Nothing to see here

\n"; $s->writeBlock($string, length($string)); $s->close(); emit wroteToClient(); } } } sub discardClient { my $s = sender(); sockets->{$s} = 0; emit endConnect(); } 1; # HttpInfo provides a simple graphical user interface to the server and shows # the actions of the server. package HttpInfo; use TQt; use TQt::isa qw(TQt::VBox); use TQt::slots newConnect => [], endConnect => [], wroteToClient => []; use TQt::attributes qw( httpd infoText ); use HttpDaemon; sub NEW { shift->SUPER::NEW(@_); httpd = HttpDaemon( this ); my $port = httpd->port(); my $itext = "This is a small httpd example.\n". "You can connect with your\n". "web browser to port $port\n"; my $lb = Label( $itext, this ); $lb->setAlignment( &AlignHCenter ); infoText = TextView( this ); my $quit = PushButton( "quit" , this ); this->connect( httpd, TQT_SIGNAL 'newConnect()', TQT_SLOT 'newConnect()' ); this->connect( httpd, TQT_SIGNAL 'endConnect()', TQT_SLOT 'endConnect()' ); this->connect( httpd, TQT_SIGNAL 'wroteToClient()', TQT_SLOT 'wroteToClient()' ); this->connect( $quit, TQT_SIGNAL 'pressed()', TQt::app(), TQT_SLOT 'quit()' ); } sub newConnect { infoText->append( "New connection" ); } sub endConnect { infoText->append( "Connection closed\n\n" ); } sub wroteToClient { infoText->append( "Wrote to client" ); } 1; package main; use TQt; use HttpInfo; my $app = TQt::Application(\@ARGV); my $info = HttpInfo; $app->setMainWidget($info); $info->show; exit $app->exec;