1 files changed, 140 insertions, 0 deletions
diff --git a/PerlTQt/examples/network/httpd/httpd.pl b/PerlTQt/examples/network/httpd/httpd.pl
new file mode 100644
index 0000000..a9aa0fd
--- /dev/null
+++ b/PerlTQt/examples/network/httpd/httpd.pl
@@ -0,0 +1,140 @@
+#!/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<h1>Nothing to see here</h1>\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;