Support for Net::Server and distinct input and output filehandles (pa…

…tch by Alexei Znamensky)

Changelog

@@ -1,3 +1,7 @@
+    - added support for Net::Server by allowing the usage of
+      distinct filehandles for input and output
+      (patch by Alexei Znamensky)
+
 version 0.42 (2009/10/01):
 
     - don't hangup when receiving abandonRequest in order to support

examples/MyDemoServer.pm

@@ -18,26 +18,25 @@ use constant RESULT_OK => {
 
 # constructor
 sub new {
-	my ($class, $sock) = @_;
-	my $self = $class->SUPER::new($sock);
-	printf "Accepted connection from: %s\n", $sock->peerhost();
+	my $class = shift;
+	my $self = $class->SUPER::new(@_);
 	return $self;
 }
 
 # the bind operation
 sub bind {
 	my $self = shift;
 	my $reqData = shift;
-	print Dumper($reqData);
+	print STDERR Dumper($reqData);
 	return RESULT_OK;
 }
 
 # the search operation
 sub search {
 	my $self = shift;
 	my $reqData = shift;
-	print "Searching...\n";
-	print Dumper($reqData);
+	print STDERR "Searching...\n";
+	print STDERR Dumper($reqData);
 	my $base = $reqData->{'baseObject'};
 
 	# plain die if dn contains 'dying'

examples/net-server.pl

@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+package Listener;
+use Net::Server;
+use base 'Net::Server::Fork';
+use MyDemoServer;
+#use Data::Dumper;
+#use Scalar::Util qw/openhandle/;
+
+sub process_request {
+	my $self = shift;
+
+    my $in = *STDIN{IO};
+    my $out = *STDOUT{IO};
+
+    my $sock = $self->{server}->{client};
+	#print STDERR "Accepted connection from: %s\n", Dumper($sock->connected() );
+	#printf STDERR "Accepted connection from: %s\n", join '.', unpack( 'C4', $sock->connected() );
+
+    #print STDERR 'in = ('.openhandle($in).') '.Dumper($in);
+    #print STDERR 'out = ('.openhandle($out).') '.Dumper($out);
+	my $handler = MyDemoServer->new($sock);
+	#my $handler = MyDemoServer->new($in,$out);
+	while (1) {
+		my $finished = $handler->handle;
+        return if $finished;
+	}
+}
+
+package main;
+Listener->run(port => 8080);
+
+1;

lib/Net/LDAP/Server.pm

@@ -17,9 +17,10 @@ use Convert::ASN1 qw(asn_read);
 use Net::LDAP::ASN qw(LDAPRequest LDAPResponse);
 use Net::LDAP::Constant qw(LDAP_OPERATIONS_ERROR LDAP_UNWILLING_TO_PERFORM);
 use Net::LDAP::Entry;
+use Data::Dumper;
 
 our $VERSION = '0.42';
-use fields qw(socket);
+use fields qw(in out);
 
 our %respTypes=(
 	'bindRequest' => 'bindResponse', 
@@ -48,18 +49,27 @@ our %functions=(
 our @reqTypes = keys %respTypes;
 
 sub new {
-    my ($proto, $sock) = @_;
+    my ($proto, $input, $output) = @_;
 	my $class = ref($proto) || $proto;
 	my $self = fields::new($class);
-	$self->{socket} = $sock;
+
+    #print STDERR Dumper($input);
+    #print STDERR Dumper($output);
+
+	$self->{in} = $input;
+	$self->{out} = $output || $input;
 	return $self;
 }
 
 sub handle {
 	my Net::LDAP::Server $self = shift;
-	my $socket = $self->{socket};
+	my $in = $self->{in};
+	my $out = $self->{out};
 
-	asn_read($socket, my $pdu);
+    #print STDERR Dumper($in);
+    #print STDERR Dumper($out);
+
+	asn_read($in, my $pdu);
 	#print '-' x 80,"\n";
 	#print "Received:\n";
 	#Convert::ASN1::asn_dump(\*STDOUT,$pdu);
@@ -68,7 +78,7 @@ sub handle {
 		or return 1;
 
 	#print "messageID: $mid\n";
-	#use Data::Dumper; print Dumper($request);
+	#print Dumper($request);
 
 	my $reqType;
 	foreach my $type (@reqTypes) {
@@ -117,7 +127,7 @@ sub handle {
 				}
 				my $pdu = $LDAPResponse->encode($response);
 				if ($pdu) {
-					print $socket $pdu;
+					print $out $pdu;
 				} else {
 					$result = undef;
 					last;
@@ -136,7 +146,7 @@ sub handle {
 	}
 
 	# and now send the result to the client
-	print $socket &_encode_result($mid, $respType, $result) if $respType;
+	print $out &_encode_result($mid, $respType, $result) if $respType;
 
 	return 0;
 }	
@@ -201,6 +211,11 @@ Net::LDAP::Server - LDAP server side protocol handling
   my $handler = MyServer->new($socket);
   $handler->handle;
 
+  # or with distinct input and output handles
+  package main;
+  my $handler = MyServer->new( $input_handle, $output_handle );
+  $handler->handle;
+
 =head1 ABSTRACT
 
 This class provides the protocol handling for an LDAP server. You can subclass
@@ -310,8 +325,13 @@ the request:
   my $handler = MyServer->new($socket);
   $handler->handle;
 
-See examples in I<examples/> directory for sample servers, using L<IO::Select> 
-or L<Net::Daemon>.
+Or, alternatively, you can pass two handles for input and output, respectively.
+
+  my $handler = MyServer->new(*STDIN{IO},*STDOUT{IO});
+  $handler->handle;
+
+See examples in I<examples/> directory for sample servers, using L<IO::Select>,
+L<Net::Daemon> or L<Net::Server>.
 
 =head1 DEPENDENCIES
 
@@ -324,7 +344,7 @@ or L<Net::Daemon>.
 
 =item L<Net::LDAP>
 
-=item Examples in I<examples> directory.
+=item Examples in C<examples> directory.
 
 =back