THRIFT-3402: add unix socket support to perl

Client: Perl
Patch: James E. King, III

This closes #670

3 files changed, 152 insertions, 3 deletions

diff --git a/lib/perl/lib/Thrift/ServerSocket.pm b/lib/perl/lib/Thrift/ServerSocket.pm
index a41b319e7..89664f699 100644
--- a/lib/perl/lib/Thrift/ServerSocket.pm
+++ b/lib/perl/lib/Thrift/ServerSocket.pm
@@ -52,9 +52,6 @@ sub new
         $self = { port => $args };
     }
 
-    if (not defined $self->{port}) {
-        die("port number not specified");
-    }
     if (not defined $self->{queue}) {
         $self->{queue} = 128;
     }
diff --git a/lib/perl/lib/Thrift/UnixServerSocket.pm b/lib/perl/lib/Thrift/UnixServerSocket.pm
new file mode 100644
index 000000000..3251a00ec
--- /dev/null
+++ b/lib/perl/lib/Thrift/UnixServerSocket.pm
@@ -0,0 +1,84 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+#   http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+require 5.6.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::UnixSocket;
+
+use IO::Socket::UNIX;
+use IO::Select;
+
+package Thrift::UnixServerSocket;
+
+use base qw( Thrift::ServerSocket );
+
+#
+# Constructor.
+# If a single argument is given that is not a hash, that is the unix domain socket path.
+# If a single argument is given that is a hash:
+# @param[in]  path   unix domain socket file name
+# @param[in]  queue  the listen queue size (default is not specified is supplied by ServerSocket)
+# @example    my $serversock = new Thrift::UnixServerSocket($path);
+# @example    my $serversock = new Thrift::UnixServerSocket(path => "somepath", queue => 64);
+#
+sub new
+{
+    my $classname = shift;
+    my $args      = shift;
+    my $self;
+
+    if (ref($args) eq 'HASH') {
+        $self = $classname->SUPER::new($args);
+    } else {
+        $self = $classname->SUPER::new();
+        $self->{path} = $args;
+    }
+
+    return bless($self, $classname);
+}
+
+sub __client
+{
+	return new Thrift::UnixSocket();
+}
+
+sub __listen
+{
+    my $self = shift;
+
+    my $sock = IO::Socket::UNIX->new(
+        Type      => IO::Socket::SOCK_STREAM,
+        Local     => $self->{path},
+        Listen    => $self->{queue})
+    || do {
+        my $error = 'UnixServerSocket: Could not bind to ' .
+                    $self->{path} . ' (' . $! . ')';
+        if ($self->{debug}) {
+            $self->{debugHandler}->($error);
+        }
+        die new Thrift::TException($error);
+    };
+
+    return $sock;
+}
+
+1;
diff --git a/lib/perl/lib/Thrift/UnixSocket.pm b/lib/perl/lib/Thrift/UnixSocket.pm
new file mode 100644
index 000000000..e8317b624
--- /dev/null
+++ b/lib/perl/lib/Thrift/UnixSocket.pm
@@ -0,0 +1,68 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+#   http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+require 5.6.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::Transport;
+
+use IO::Socket::UNIX;
+use IO::Select;
+
+package Thrift::UnixSocket;
+
+use base qw( Thrift::Socket );
+
+#
+# Constructor.
+# Takes a unix domain socket filename.
+# See Thirft::Socket for base class parameters.
+# @param[in]  path   path to unix socket file
+# @example    my $sock = new Thrift::UnixSocket($path);
+#
+sub new
+{
+    my $classname = shift;
+    my $self      = $classname->SUPER::new();
+    $self->{path} = shift;     
+    return bless($self, $classname);
+}
+
+sub __open
+{
+    my $self = shift;
+
+    my $sock = IO::Socket::UNIX->new(
+        Type      => IO::Socket::SOCK_STREAM,
+        Peer      => $self->{path})
+    || do {
+        my $error = 'UnixSocket: Could not connect to ' .
+            $self->{path} . ' (' . $! . ')';
+        if ($self->{debug}) {
+            $self->{debugHandler}->($error);
+        }
+        die new Thrift::TException($error);
+    };
+
+    return $sock;
+}
+
+1;