Copy the KDE 3.5 branch to branches/trinity for new KDE 3.5 features.

BUG:215923


git-svn-id: svn://anonsvn.kde.org/home/kde/branches/trinity/kdenetwork@1054174 283d02a7-25f6-0310-bc7c-ecb5cbfe19da

1 files changed, 225 insertions, 0 deletions

diff --git a/ksirc/puke/puke.pl b/ksirc/puke/puke.pl
new file mode 100644
index 00000000..f0d2c7fd
--- /dev/null
+++ b/ksirc/puke/puke.pl
@@ -0,0 +1,225 @@
+use Socket;
+use Fcntl;
+
+#
+# Clean up if this is the second load.
+#
+# Don't close anything so we can be loaded twice.
+#
+#if($PUKEFd != undef){
+#  &remsel($PUKEFd);
+#  close($PUKEFd);
+#  sleep(1);
+#  $PUKEFd = undef;
+#}
+
+#
+# Puke timeout waiting for messages
+$PUKE_TIMEOUT = 10;
+
+#
+# Setup flag fo syncronous operation
+# 1 for sync
+# 0 for async/fly by the seat of your pants
+#
+$SYNC = 0;
+
+#
+# Setup debugging logger, comment out for production use
+#
+$DEBUG = 0;
+if($DEBUG){
+  open(LOG, ">msg-log") || warn "Failed to open log file: $!\n";
+  select(LOG); $| = 1; select(STDOUT);
+  print LOG "Start time: ". `date`;
+}
+
+
+
+# 
+# Multi operation level handler, winId Based.
+# 
+# PUKE_HANDLER{Cmd}{winId} = sub();
+
+%PUKE_HANDLER = ();
+
+# 
+# Default handler is called if no handler defined
+# Default handlers defined in commands-handler.pl
+# Single level PUKE_DEF_HANDLER{$cmd};
+#
+
+#%PUKE_DEF_HANDLER = ();
+
+#require 'commands-perl.pl';
+&docommand("/load commands-perl.pl");
+#require 'commands-handler.pl';
+&docommand("/load commands-handler.pl");
+
+$PukeHeader = 42; # Alternating 1010 for 32 bits
+$PukePacking = "Iiiiia*";  # 4 ints, followed by any number of of characters
+$PukeMSize = length(pack($PukePacking, $PukeHeader, 0, 0, 0, 0, ""));
+
+if(!$ENV{'PUKE_SOCKET'}) {
+    $sock = $ENV{'HOME'} . "/.ksirc.socket";
+}
+else {
+    $sock = $ENV{'PUKE_SOCKET'};
+}
+
+if($PUKEFd == undef){
+    $PUKEFd = &newfh;
+    $proto = getprotobyname('tcp');
+    socket($PUKEFd, PF_UNIX, SOCK_STREAM, 0) || print "PUKE: Sock failed: $!\n";
+    $sun = sockaddr_un($sock);
+    print "*P* PUKE: Connecting to $sock\n";
+    connect($PUKEFd,$sun) || (die "Puke: Connect failed: $!\n",$PUKEFailed=1);
+    select($PUKEFd); $| = 1; select(STDOUT);
+    #fcntl($PUKEFd, F_SETFL, O_NONBLOCK);
+}
+
+# Arg1: Command
+# Arg2: WinId
+# Arg3: iArg
+# Arg4: cArg
+sub PukeSendMessage {
+  my($cmd, $winid, $iarg, $carg, $handler, $waitfor) = @_;
+  #  print("PUKE: cArg message too long $cArg\n") if(length($carg) > 50);
+  $PUKE_HANDLER{$cmd}{$winid} = $handler if $handler != undef;
+  my $msg = pack($PukePacking, $PukeHeader, $cmd, $winid, $iarg, length($carg), $carg);
+  syswrite($PUKEFd, $msg, length($msg));
+  #  print STDERR "*** " . $msg . "\n";
+  print LOG kgettimeofday() . " SEND message: CMD: $PUKE_NUM2NAME{$cmd} WIN: $winid IARG: $iarg LEN: " . length($carg) . " CARG: $carg\n" if $DEBUG;
+  if($SYNC == 1 || $waitfor == 1){
+    return &sel_PukeRecvMessage(1, $winid, -$cmd, $carg);
+  }
+  return ();
+}
+
+sub sel_PukeRecvMessage {
+  ($wait, $wait_winid, $wait_cmd, $wait_carg) = @_;
+  my($m);
+  my($cmd, $winid, $iarg, $carg, $junk);
+
+  while(1){
+    my $old_a = $SIG{'alarm'};
+    $SIG{'alarm'} = sub { die "alarm\n"; };
+    my $old_time = alarm($PUKE_TIMEOUT);
+    eval {
+      $len = sysread($PUKEFd, $m, $PukeMSize);
+    };
+    if($@){
+       print "*E* Timeout waiting for data for first sysread\n";
+       $SIG{ALRM} = $old_a;
+       alarm($old_time);
+       return;
+    }
+    $SIG{ALRM} = $old_a;
+    alarm($old_time);
+
+    if($len== 0){
+      &remsel($PUKEFd);
+      close($PUKEFd);
+      return;
+    }
+    #  print "Length: $len " . length($m) . "\n";
+    ($header, $cmd, $winid, $iarg, $length, $carg) = unpack($PukePacking, $m);
+    if($header != $PukeHeader){
+      print("*E* Invalid message received! Discarding! Got: $header wanted: $PukeHeader\n");
+      #      return;
+    }
+    if($length > 0){
+      my $old_a = $SIG{'alarm'};
+      $SIG{'alarm'} = sub { die "alarm\n"; };
+      my $old_time = alarm($PUKE_TIMEOUT);
+      eval {
+	$clen = sysread($PUKEFd, $m2, $length);
+      };
+      if($@){
+         print "*E* Timeout waiting for cArg data\n";
+      }
+      $SIG{ALRM} = $old_a;
+      alarm($old_time);
+      
+      if($length != $clen){
+        print "\n*E* Warning: wanted to read: $length got $clen\n";
+      }
+      $m .= $m2;
+      ($header, $cmd, $winid, $iarg, $length, $carg) = unpack($PukePacking, $m);
+    }
+               #    print("PUKE: Got => $PUKE_NUM2NAME{$cmd}/$cmd\n");
+               #    print("PUKE: Got: $cmd, $winid, $iarg, $length, $carg\n");
+               #    print("\n");
+    if($winid == undef){ $winid = 0; }
+    $blah = $carg;
+    $blah =~ s/\000//g;
+    print LOG kgettimeofday() . " GOT  message: CMD: $PUKE_NUM2NAME{$cmd} WIN: $winid IARG: $iarg LEN: $length CARG: $blah\n" if $DEBUG;
+    #
+    # Check both $cmd and the correct reply -$cmd
+    #
+    my(%ARG) = ('iCommand' => $cmd,
+                'iWinId' => $winid,
+                'iArg' => $iarg,
+                'cArg' => $carg);
+
+    #  print "*I* Def handler: $PUKE_DEF_HANDLER{$cmd}\n";
+
+    if($wait == 1 && $winid == $wait_winid && $wait_cmd == $cmd){
+      print LOG kgettimeofday() . " WAIT message: CMD: $PUKE_NUM2NAME{$cmd} WIN: $winid IARG: $iarg LEN: $length CARG: $blah\n" if $DEBUG;
+      ($wait, $wait_winid, $wait_cmd, $wait_carg) = ();
+      return %ARG;
+    }
+
+    if($PUKE_HANDLER{-$cmd}{$winid}){ # one shot/command handler
+      &{$PUKE_HANDLER{-$cmd}{$winid}}(\%ARG);
+    } elsif ($PUKE_HANDLER{$cmd}{$winid}){
+      &{$PUKE_HANDLER{$cmd}{$winid}}(\%ARG);
+    } elsif ($PUKE_W_HANDLER{$cmd}{$winid}) { # widget specific handler
+      &{$PUKE_W_HANDLER{$cmd}{$winid}}(\%ARG);
+    } elsif ($PUKE_DEF_HANDLER{"$cmd"}) {# catch all
+      &{$PUKE_DEF_HANDLER{"$cmd"}}(\%ARG);
+    }
+    else {
+      #
+      # If there was no handler this is a widget creation falling throuhg
+      #
+
+      if($wait == 1 && (substr($wait_carg,0,7) eq substr($carg,0,7))){
+	print LOG kgettimeofday() . " WAI2 message: CMD: $PUKE_NUM2NAME{$cmd} WIN: $winid IARG: $iarg LEN: $length CARG: $blah\n" if $DEBUG;
+	($wait, $wait_winid, $wait_cmd, $wait_carg) = ();
+        return %ARG;
+      }
+      # No handler at all, unkown reply
+      print("*E* PUKE: Got unkown command: $cmd/$PUKE_NUM2NAME{$cmd}\n");
+      #    print("PUKE: Got: $cmd, $winid, $iarg, $carg\n");
+    }
+
+    #
+    # If we're not waiting for a message, return
+    #
+    if(!$wait){
+      ($wait, $wait_winid, $wait_cmd, $wait_carg) = ();
+      return ();
+    }
+    
+    my($rin, $rout) =('', '');
+    vec($rin,fileno($PUKEFd),1) = 1;
+    $nfound = select($rout=$rin, undef, undef, 1);
+    if($nfound < 1){
+      print "*E* PUKE: Timed out waiting for reply, returning null\n";
+      print LOG kgettimeofday() . " FAIL message: CMD: $PUKE_NUM2NAME{$wait_cmd} WIN: $wait_winid IARG: ### LEN: $length CARG: $wait_carg\n" if $DEBUG;
+      return ();
+    }
+  }
+}
+
+&addsel($PUKEFd, "PukeRecvMessage", 0);
+
+# Basics are up and running, now init Puke/Ksirc Interface.
+
+my(%ARG) = &PukeSendMessage($PUKE_SETUP, $::PUKE_CONTROLLER, 0, $server, undef, 1);
+
+$PukeMSize = $ARG{'iArg'};
+print "*P* Puke: Initial Setup complete\n";
+print "*P* Puke: Communications operational\n";
+