QPID-3009 - Perl binding to Qpid messaging

Applied patch contributed by Hao Chang Yu


git-svn-id: https://svn.apache.org/repos/asf/qpid/trunk/qpid@1064199 13f79535-47bb-0310-9956-ffa450edef68

14 files changed, 1040 insertions, 1 deletions

diff --git a/cpp/bindings/qpid/Makefile.am b/cpp/bindings/qpid/Makefile.am
index 13ec310a9e..07b51e6c64 100644
--- a/cpp/bindings/qpid/Makefile.am
+++ b/cpp/bindings/qpid/Makefile.am
@@ -30,4 +30,8 @@ if HAVE_PYTHON_DEVEL
 SUBDIRS += python
 endif
 
+if HAVE_PERL_DEVEL
+SUBDIRS += perl
+endif
+
 endif
diff --git a/cpp/bindings/qpid/examples/perl/README b/cpp/bindings/qpid/examples/perl/README
new file mode 100644
index 0000000000..1e113f1fa0
--- /dev/null
+++ b/cpp/bindings/qpid/examples/perl/README
@@ -0,0 +1,26 @@
+# 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.
+
+
+The examples in this directory are written against the raw Perl
+binding ("cqpid").  This binding is identical to the C++ messaging (in
+namespace qpid::messaging).
+
+It is desired that a layer will be written over this interface (called
+"qpid") that provides a more Perl-specific API.  When this occurs,
+these examples will be changed to use the new Perl API.
+
diff --git a/cpp/bindings/qpid/examples/perl/client.pl b/cpp/bindings/qpid/examples/perl/client.pl
new file mode 100644
index 0000000000..93eec88e07
--- /dev/null
+++ b/cpp/bindings/qpid/examples/perl/client.pl
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+#
+# 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.
+#
+use strict;
+use warnings;
+
+use cqpid;
+
+my $url = ( @ARGV == 1 ) ? $ARGV[0] : "amqp:tcp:127.0.0.1:5672";
+my $connectionOptions =  ( @ARGV > 1 ) ? $ARGV[1] : ""; 
+
+
+my $connection = new cqpid::Connection($url, $connectionOptions);
+
+eval {
+$connection->open();
+my $session = $connection->createSession();
+
+my $sender = $session->createSender("service_queue");
+
+#create temp queue & receiver...
+my $responseQueue = new cqpid::Address("#response-queue; {create:always, delete:always}");
+my $receiver = $session->createReceiver($responseQueue);
+
+#Now send some messages...
+
+my @s = (
+      "Twas brillig, and the slithy toves",
+      "Did gire and gymble in the wabe.",
+      "All mimsy were the borogroves,",
+      "And the mome raths outgrabe."
+     );
+
+my $request = new cqpid::Message();
+$request->setReplyTo($responseQueue);
+for (my $i=0; $i<4; $i++) {
+    $request->setContent($s[$i]);
+    $sender->send($request);
+    my $response = $receiver->fetch();
+    print $request->getContent() . " -> " . $response->getContent() . "\n";
+}
+
+$connection->close();
+};
+
+if ($@) {
+    die $@;
+}
+
+
diff --git a/cpp/bindings/qpid/examples/perl/drain.pl b/cpp/bindings/qpid/examples/perl/drain.pl
new file mode 100644
index 0000000000..8010b7c95b
--- /dev/null
+++ b/cpp/bindings/qpid/examples/perl/drain.pl
@@ -0,0 +1,98 @@
+#!/usr/bin/perl
+#
+# 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.
+#
+use strict;
+use warnings;
+
+use cqpid;
+use Getopt::Long;
+
+my $url = "127.0.0.1";
+my $timeout = 60;
+my $forever = 0;
+my $count   = 1;
+my $connectionOptions = "";
+my $address = "amq.direct";
+
+my $result = GetOptions(
+    "broker|b=s"           => \ $url,
+    "timeout|t=i"          => \ $timeout,
+    "forever|f"            => \ $forever,
+    "connection-options=s" => \ $connectionOptions,
+    "count|c=i"            => \ $count,
+);
+
+if (! $result) {
+    print "Usage: perl drain.pl [OPTIONS]\n";
+}
+
+if ($#ARGV ge 0) {
+    $address = $ARGV[0]
+}
+
+sub getTimeout {
+   return ($forever) ? $cqpid::Duration::FOREVER : new cqpid::Duration($timeout*1000);
+}
+
+
+my $connection = new cqpid::Connection($url, $connectionOptions);
+
+eval {
+    $connection->open();
+    my $session  = $connection->createSession();
+    my $receiver = $session->createReceiver($address);
+    my $timeout  = getTimeout();
+
+    my $message = new cqpid::Message();
+    my $i = 0;
+
+    while($receiver->fetch($message, $timeout)) {
+        print "Message(properties=" . $message->getProperties() . ",content='";
+        if ($message->getContentType() eq "amqp/map") {
+            my $content = cqpid::decodeMap($message);
+            map{ print "\n$_ => $content->{$_}"; } keys %{$content};
+        }
+        else {
+            print $message->getContent();
+        }
+        print "')\n";
+       
+        my $replyto = $message->getReplyTo();
+        if ($replyto->getName()) {
+            print "Replying to " . $message->getReplyTo()->str() . "...\n";
+            my $sender = $session->createSender($replyto);
+            my $response = new cqpid::Message("received by the server.");
+            $sender->send($response);
+        }
+        $session->acknowledge();
+
+        if ($count and (++$i ==$count)) {
+            last;
+        }
+    }
+    $receiver->close();
+    $session->close();
+    $connection->close();
+};
+
+if ($@) {
+  $connection->close();
+  die $@;
+}
+
diff --git a/cpp/bindings/qpid/examples/perl/hello_world.pl b/cpp/bindings/qpid/examples/perl/hello_world.pl
new file mode 100644
index 0000000000..cf2f05f8b7
--- /dev/null
+++ b/cpp/bindings/qpid/examples/perl/hello_world.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+#
+# 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.
+#
+use strict;
+use warnings;
+use Data::Dumper;
+
+use cqpid;
+
+my $broker            = ( @ARGV > 0 ) ? $ARGV[0] : "localhost:5672";
+my $address           = ( @ARGV > 1 ) ? $ARGV[0] : "amq.topic";
+my $connectionOptions = ( @ARGV > 2 ) ? $ARGV[1] : "";
+
+my $connection = new cqpid::Connection($broker, $connectionOptions);
+
+eval {
+    $connection->open();
+    my $session = $connection->createSession();
+
+    my $receiver = $session->createReceiver($address);
+    my $sender   = $session->createSender($address);
+
+    $sender->send(new cqpid::Message("Hello world!"));
+
+    #my $duration = new cqpid::Duration(1000);
+    #print ">>>" . $duration->getMilliseconds() . "\n";
+
+    my $message = $receiver->fetch($cqpid::Duration::SECOND);
+
+    #$message->setDurable(1);
+    #print "Durable: " . $message->getDurable() . "\n";
+    #print Dumper($message->getProperties());
+
+    print $message->getContent() . "\n";
+    $session->acknowledge();
+
+    $connection->close();
+};
+
+die $@ if ($@);
diff --git a/cpp/bindings/qpid/examples/perl/hello_xml.pl b/cpp/bindings/qpid/examples/perl/hello_xml.pl
new file mode 100644
index 0000000000..c48a5225c2
--- /dev/null
+++ b/cpp/bindings/qpid/examples/perl/hello_xml.pl
@@ -0,0 +1,76 @@
+#!/usr/bin/perl
+#
+# 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.
+#
+use strict;
+use warnings;
+
+use cqpid;
+
+my $broker            = ( @ARGV > 0 ) ? $ARGV[0] : "localhost:5672";
+my $connectionOptions = ( @ARGV > 1 ) ? $ARGV[1] : "";
+
+my $query = <<END;
+    let \$w := ./weather
+    return \$w/station = 'Raleigh-Durham International Airport (KRDU)'
+    and \$w/temperature_f > 50
+    and \$w/temperature_f - \$w/dewpoint > 5
+    and \$w/wind_speed_mph > 7
+    and \$w/wind_speed_mph < 20
+END
+
+my $address = <<END;
+xml-exchange; {
+create: always,      
+node: { type: topic, x-declare: { type: xml } },
+link: {
+x-bindings: [{ exchange: xml-exchange, key: weather, arguments: { xquery:" $query" } }]
+}}
+END
+
+
+my $connection = new cqpid::Connection($broker, $connectionOptions);
+
+eval {
+    $connection->open();
+    my $session = $connection->createSession();
+
+    my $receiver = $session->createReceiver($address);
+    
+    my $message = new cqpid::Message();
+
+    my $content = <<END;
+    <weather>
+    <station>Raleigh-Durham International Airport (KRDU)</station>
+    <wind_speed_mph>16</wind_speed_mph>
+    <temperature_f>70</temperature_f>
+    <dewpoint>35</dewpoint>
+    </weather>
+END
+    
+    $message->setContent($content);
+    my $sender = $session->createSender('xml-exchange/weather');
+    $sender->send($message);
+    
+    my $response = $receiver->fetch();
+    print $response->getContent() . "\n";
+
+    $connection->close();
+};
+
+die $@ if ($@);
diff --git a/cpp/bindings/qpid/examples/perl/map_receiver.pl b/cpp/bindings/qpid/examples/perl/map_receiver.pl
new file mode 100644
index 0000000000..e3e8a201dd
--- /dev/null
+++ b/cpp/bindings/qpid/examples/perl/map_receiver.pl
@@ -0,0 +1,47 @@
+#! /usr/bin/perl5
+#
+# 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.
+#
+use strict;
+use warnings;
+use Data::Dumper;
+
+use cqpid;
+
+my $url               = ( @ARGV > 0 ) ? $ARGV[0] : "amqp:tcp:127.0.0.1:5672";
+my $address           = ( @ARGV > 1 ) ? $ARGV[0] : "message_queue; {create: always}";
+my $connectionOptions = ( @ARGV > 2 ) ? $ARGV[1] : "";
+
+my $connection = new cqpid::Connection($url, $connectionOptions);
+
+eval {
+    $connection->open();
+    my $session  = $connection->createSession();
+    my $receiver = $session->createReceiver($address);
+
+    my $content = cqpid::decodeMap($receiver->fetch());
+    #my $content = cqpid::decodeList($receiver->fetch());
+   
+    print Dumper($content);
+
+    $session->acknowledge();
+    $receiver->close();
+    $connection->close();
+};
+
+die $@ if ($@);
diff --git a/cpp/bindings/qpid/examples/perl/map_sender.pl b/cpp/bindings/qpid/examples/perl/map_sender.pl
new file mode 100644
index 0000000000..095acce0ab
--- /dev/null
+++ b/cpp/bindings/qpid/examples/perl/map_sender.pl
@@ -0,0 +1,50 @@
+#! /usr/bin/perl5
+#
+# 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.
+#
+use strict;
+use warnings;
+use Data::Dumper;
+
+use cqpid;
+
+my $url               = ( @ARGV > 0 ) ? $ARGV[0] : "amqp:tcp:127.0.0.1:5672";
+my $address           = ( @ARGV > 1 ) ? $ARGV[1] : "message_queue; {create: always}";
+my $connectionOptions = ( @ARGV > 2 ) ? $ARGV[2] : "";
+
+my $connection = new cqpid::Connection($url, $connectionOptions);
+
+eval {
+    $connection->open();
+
+    my $session = $connection->createSession();
+    my $sender  = $session->createSender($address);
+
+    my $message = new cqpid::Message();
+    my $content = { id   => 987654321, 
+                    name => "Widget", 
+                    percent => sprintf("%.2f", 0.99), 
+                    colours => [ qw (red green white) ], 
+                   };
+    cqpid::encode($content, $message);
+    $sender->send($message, 1);
+
+    $connection->close();
+};
+
+die $@ if ($@);
diff --git a/cpp/bindings/qpid/examples/perl/server.pl b/cpp/bindings/qpid/examples/perl/server.pl
new file mode 100644
index 0000000000..0c64f15c66
--- /dev/null
+++ b/cpp/bindings/qpid/examples/perl/server.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+#
+# 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.
+#
+use strict;
+use warnings;
+
+use cqpid;
+
+my $url = ( @ARGV == 1 ) ? $ARGV[0] : "amqp:tcp:127.0.0.1:5672";
+my $connectionOptions =  ( @ARGV > 1 ) ? $ARGV[1] : ""; 
+
+
+my $connection = new cqpid::Connection($url, $connectionOptions);
+
+eval {
+    $connection->open();
+    my $session = $connection->createSession();
+
+    my $receiver = $session->createReceiver("service_queue; {create: always}");
+
+    while (1) {
+        my $request = $receiver->fetch();
+        my $address = $request->getReplyTo();
+        if ($address) {
+            my $sender = $session->createSender($address);
+            my $s = $request->getContent();
+            $s = uc($s);
+            my $response = new cqpid::Message($s);
+            $sender->send($response);
+            print "Processed request: " . $request->getContent() . " -> " . $response->getContent() . "\n";
+            $session->acknowledge();
+        }
+        else {
+            print "Error: no reply address specified for request: " . $request->getContent() . "\n";
+            $session->reject($request);
+        }
+    }
+
+$connection->close();
+};
+
+if ($@) {
+    die $@;
+}
+
+
diff --git a/cpp/bindings/qpid/examples/perl/spout.pl b/cpp/bindings/qpid/examples/perl/spout.pl
new file mode 100644
index 0000000000..50773a4fe2
--- /dev/null
+++ b/cpp/bindings/qpid/examples/perl/spout.pl
@@ -0,0 +1,136 @@
+#!/usr/bin/perl
+#
+# 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.
+#
+use strict;
+use warnings;
+
+use cqpid;
+use Getopt::Long;
+use Time::Local;
+
+my $url = "127.0.0.1";
+my $timeout = 0;
+my $count   = 1;
+my $id      = "";
+my $replyto = "";
+my @properties;
+my @entries;
+my $content = "";
+my $connectionOptions = "";
+my $address = "amq.direct";
+
+my $result = GetOptions(
+    "broker|b=s"           => \ $url,
+    "timeout|t=i"          => \ $timeout,
+    "count|c=i"            => \ $count,
+    "id|i=s"               => \ $id,
+    "replyto=s"            => \ $replyto,
+    "property|p=s@"        => \ @properties,
+    "map|m=s@"             => \ @entries,
+    "content=s"            => \ $content,
+    "connection-options=s" => \ $connectionOptions,   
+);
+
+
+if (! $result) {
+    print "Usage: perl drain.pl [OPTIONS]\n";
+}
+
+
+if ($#ARGV ge 0) {
+    $address = $ARGV[0]
+}
+
+
+sub setEntries {
+    my ($content) = @_;
+
+    foreach (@entries) {
+        my ($name, $value) = split("=", $_);
+        $content->{$name} = $value;
+    }
+}
+
+
+sub setProperties {
+    my ($message) = @_;
+
+    foreach (@properties) {
+        my ($name, $value) = split("=", $_);
+        $message->getProperties()->{$name} = $value;
+    }
+}
+
+my $connection = new cqpid::Connection($url, $connectionOptions);
+
+eval {
+    $connection->open();
+    my $session  = $connection->createSession();
+    my $sender = $session->createSender($address);
+
+    my $message = new cqpid::Message();
+    setProperties($message) if (@properties);
+    if (@entries) {
+        my $content = {};
+        setEntries($content);
+        cqpid::encode($content, $message);
+    }
+    elsif ($content) {
+        $message->setContent($content);
+        $message->setContentType("text/plain");
+    }
+
+    my $receiver;
+    if ($replyto) {
+        my $responseQueue = new cqpid::Address($replyto);
+        $receiver = $session->createReceiver($responseQueue);
+        $message->setReplyTo($responseQueue);
+    }
+
+    my $start = localtime;
+    my @s = split(/[:\s]/, $start);
+    my $s = "$s[3]$s[4]$s[5]";
+    my $n = $s;
+
+    for (my $i = 0; 
+        ($i < $count || $count == 0) and
+        ($timeout == 0 || abs($n - $s) < $timeout); 
+        $i++) {
+
+        $sender->send($message);
+
+        if ($receiver) {
+            my $response = $receiver->fetch();
+            print "$i -> " . $response->getContent() . "\n";
+        }
+
+        my $now = localtime;
+        my @n = split(/[:\s]/, $now);
+        my $n = "$n[3]$n[4]$n[5]";
+    }
+    $session->sync();
+    $connection->close();
+};
+
+if ($@) {
+  $connection->close();
+  die $@;
+}
+
+
diff --git a/cpp/bindings/qpid/perl/Makefile.am b/cpp/bindings/qpid/perl/Makefile.am
new file mode 100644
index 0000000000..566c8256d2
--- /dev/null
+++ b/cpp/bindings/qpid/perl/Makefile.am
@@ -0,0 +1,42 @@
+#
+# 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.
+#
+
+if HAVE_PERL_DEVEL
+
+INCLUDES = -I$(top_srcdir)/include -I$(top_builddir)/include -I$(top_srcdir)/src -I$(top_builddir)/src
+
+EXTRA_DIST = perl.i
+BUILT_SOURCES = cqpid.cpp
+SWIG_FLAGS = -w362,401
+
+cqpid.cpp: $(srcdir)/perl.i $(srcdir)/../qpid.i $(srcdir)/../../swig_perl_typemaps.i
+	$(SWIG) -perl -c++ $(SWIG_FLAGS) $(INCLUDES) $(QPID_CXXFLAGS) -I/usr/include -o cqpid.cpp $(srcdir)/perl.i
+
+lib_LTLIBRARIES = cqpid.la
+cqpid_PERL = cqpid.pm
+
+cqpid_la_LDFLAGS = -avoid-version -module -shared
+cqpid_la_LIBADD = -L$(top_builddir)/src/.libs -lqpidmessaging -lqpidtypes \
+	$(top_builddir)/src/libqpidmessaging.la $(top_builddir)/src/libqpidtypes.la
+cqpid_la_CXXFLAGS = $(INCLUDES) $(PERL_INC)
+nodist_cqpid_la_SOURCES = cqpid.cpp
+
+CLEANFILES = cqpid.cpp cqpid.pm
+
+endif # HAVE_PERL_DEVEL
diff --git a/cpp/bindings/qpid/perl/perl.i b/cpp/bindings/qpid/perl/perl.i
new file mode 100644
index 0000000000..b7ae0568b6
--- /dev/null
+++ b/cpp/bindings/qpid/perl/perl.i
@@ -0,0 +1,35 @@
+/*
+ * 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.
+ */
+
+%module cqpid
+%include "std_string.i"
+%include "../../swig_perl_typemaps.i"
+
+/* Define the general-purpose exception handling */
+%exception {
+    try {
+        $action
+    }
+    catch (qpid::messaging::MessagingException& mex) {
+        Perl_croak(aTHX_ mex.what());
+    }
+}
+
+%include "../qpid.i"
+
diff --git a/cpp/bindings/swig_perl_typemaps.i b/cpp/bindings/swig_perl_typemaps.i
new file mode 100644
index 0000000000..831576a7d4
--- /dev/null
+++ b/cpp/bindings/swig_perl_typemaps.i
@@ -0,0 +1,330 @@
+/*
+ * 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.
+ */
+
+%wrapper %{
+
+#include <stdarg.h>
+
+    SV* MapToPerl(const qpid::types::Variant::Map*);
+    SV* ListToPerl(const qpid::types::Variant::List*);
+    void PerlToMap(SV*, qpid::types::Variant::Map*);
+    void PerlToList(SV*, qpid::types::Variant::List*);
+
+    qpid::types::Variant PerlToVariant(SV* value) {
+        if (SvROK(value)) {
+            if (SvTYPE(SvRV(value)) == SVt_PVHV) {
+                qpid::types::Variant::Map map;
+                PerlToMap(value, &map);
+                return qpid::types::Variant(map);
+            }
+            else if (SvTYPE(SvRV(value)) == SVt_PVAV) {
+                qpid::types::Variant::List list;
+                PerlToList(value, &list);
+                return qpid::types::Variant(list);
+            }
+        }
+        else {
+            if (SvIOK(value)) {
+                return qpid::types::Variant((int64_t) SvIV(value));
+             }
+            else if (SvNOK(value)) {
+                return qpid::types::Variant((float)SvNV(value));
+            }
+            else if (SvPOK(value)) {
+                return qpid::types::Variant(std::string(SvPV_nolen(value)));
+            }
+        }
+        return qpid::types::Variant();
+    }
+
+    SV* VariantToPerl(const qpid::types::Variant* v) {
+        SV* result = newSV(0);
+        try {
+            switch (v->getType()) {
+            case qpid::types::VAR_VOID: {
+                sv_setiv(result, (IV)0);
+                break;
+            }
+            case qpid::types::VAR_BOOL : {
+                result = boolSV(v->asBool());
+                break;
+            }
+            case qpid::types::VAR_UINT8 :
+            case qpid::types::VAR_UINT16 :
+            case qpid::types::VAR_UINT32 : {
+                sv_setuv(result, (UV)v->asUint32());
+                break;
+            }
+            case qpid::types::VAR_UINT64 : {
+                sv_setuv(result, (UV)v->asUint64());
+                break;
+            }
+            case qpid::types::VAR_INT8 : 
+            case qpid::types::VAR_INT16 :
+            case qpid::types::VAR_INT32 : {
+                sv_setiv(result, (IV)v->asInt32());
+                break;
+            }
+            case qpid::types::VAR_INT64 : {
+                sv_setiv(result, (IV)v->asInt64());
+                break;
+            }
+            case qpid::types::VAR_FLOAT : {
+                sv_setnv(result, (double)v->asFloat());
+                break;
+            }
+            case qpid::types::VAR_DOUBLE : {
+                sv_setnv(result, (double)v->asDouble());
+                break;
+            }
+            case qpid::types::VAR_STRING : {
+                const std::string val(v->asString());
+                result = newSVpvn(val.c_str(), val.size());
+                break;
+            }
+            case qpid::types::VAR_MAP : {
+                result = MapToPerl(&(v->asMap()));
+                break;
+            }
+            case qpid::types::VAR_LIST : {
+                result = ListToPerl(&(v->asList()));
+                break;
+            }
+            case qpid::types::VAR_UUID : {
+            }
+            }
+        } catch (qpid::types::Exception& ex) {
+            Perl_croak(aTHX_ ex.what());
+        }
+
+        return result;
+    }
+
+    SV* MapToPerl(const qpid::types::Variant::Map* map) {
+        SV *result = newSV(0);
+        HV *hv = (HV *)sv_2mortal((SV *)newHV());
+        qpid::types::Variant::Map::const_iterator iter;
+        for (iter = map->begin(); iter != map->end(); iter++) {
+            const std::string key(iter->first);
+            SV* perlval = VariantToPerl(&(iter->second));
+            hv_store(hv, key.c_str(), key.size(), perlval, 0);
+        }
+        SvSetSV(result, newRV_noinc((SV *)hv));
+        return result;
+    }
+
+    SV* ListToPerl(const qpid::types::Variant::List* list) {
+        SV* result = newSV(0);
+        AV* av  = (AV *)sv_2mortal((SV *)newAV());
+        qpid::types::Variant::List::const_iterator iter;
+        for (iter = list->begin(); iter != list->end(); iter++) {
+            SV* perlval = VariantToPerl(&(*iter));
+            av_push(av, perlval);
+        }
+        SvSetSV(result, newRV_noinc((SV *)av));
+        return result;
+    }
+
+    void PerlToMap(SV* hash, qpid::types::Variant::Map* map) {
+        map->clear();
+        HV* hv = (HV *)SvRV(hash);
+        HE* he;
+        while((he = hv_iternext(hv)) != NULL) {
+            SV* svkey = HeSVKEY_force(he);
+            SV* svval = HeVAL(he);
+            (*map)[std::string(SvPV_nolen(svkey))] = PerlToVariant(svval);
+        }
+    }
+
+    void PerlToList(SV* ary, qpid::types::Variant::List* list) {
+        list->clear();
+        AV * av = (AV *)SvRV(ary);
+        I32 len = av_len(av) + 1;
+        if (len > 0) {
+            for (I32 i = 0; i < len; i++) {
+                list->push_back(PerlToVariant(*av_fetch(av, i, 0)));
+            }
+        }
+    }
+%}
+
+%typemap (in) void * {
+    $1 = (void *)SvIV($input);
+}
+
+%typemap (out) void * {
+    sv_setiv($result, (IV)$1);
+    argvi++;
+}
+
+%typemap (in) uint16_t, uint32_t, uint64_t {
+    if (SvIOK($input)) {
+        $1 = ($1_ltype)SvUV($input);
+    }
+    else {
+        SWIG_exception_fail(SWIG_ValueError, "not an integer");
+    }
+}
+
+%typemap (out) uint16_t, uint32_t, uint64_t {
+    sv_setuv($result, (UV)$1);
+    argvi++;
+}
+
+%typemap (in) int32_t, int64_t {
+    if (SvIOK($input)) {
+        $1 = ($1_ltype)SvIV($input);
+    }
+    else {
+        SWIG_exception_fail(SWIG_ValueError, "not an integer");
+    }
+}
+
+%typemap (out) int32_t, int64_t {
+    sv_setiv($result, (IV)$1);
+    argvi++;
+}
+
+%typemap(in) bool {
+    $1 = (bool)SvTRUE($input);
+}
+
+%typemap (out) bool {
+    $result = boolSV($1);
+    argvi++;
+}
+
+
+%typemap (typecheck, precedence=SWIG_TYPECHECK_UINT64) uint64_t {
+    $1 = SvIOK($input) ? 1 : 0;
+}
+
+%typemap (typecheck, precedence=SWIG_TYPECHECK_UINT32) uint32_t {
+    $1 = SvIOK($input) ? 1 : 0;
+}
+
+
+/*
+ * Variant types: C++ --> Perl
+ */
+%typemap(out) qpid::types::Variant::Map {
+    $result = MapToPerl(&$1);
+    argvi++;
+}
+
+%typemap(out) qpid::types::Variant::Map& {
+    $result = MapToPerl($1);
+    argvi++;
+}
+
+%typemap(out) qpid::types::Variant::List {
+    $result = ListToPerl(&$1);
+    argvi++;
+}
+
+%typemap(out) qpid::types::Variant::List& {
+    $result = ListToPerl($1);
+    argvi++;
+}
+
+%typemap(out) qpid::types::Variant& {
+    $result = VariantToPerl($1);
+    argvi++;
+}
+
+
+/*
+ * Variant types: Perl --> C++
+ */
+%typemap(in) qpid::types::Variant& {
+    $1 = new qpid::types::Variant(PerlToVariant($input));
+}
+
+%typemap(in) qpid::types::Variant::Map& {
+    $1 = new qpid::types::Variant::Map();
+    PerlToMap($input, $1);
+
+}
+
+%typemap(in) qpid::types::Variant::List& {
+    $1 = new qpid::types::Variant::List();
+    PerlToList($input, $1);
+
+}
+
+%typemap(in) const qpid::types::Variant::Map const & {
+    $1 = new qpid::types::Variant::Map();
+    PerlToMap($input, $1);
+}
+
+%typemap(in) const qpid::types::Variant::List const & {
+    $1 = new qpid::types::Variant::List();
+    PerlToList($input, $1);
+}
+
+%typemap(freearg) qpid::types::Variant& {
+    delete $1;
+}
+
+%typemap(freearg) qpid::types::Variant::Map& {
+    delete $1;
+}
+
+%typemap(freearg) qpid::types::Variant::List& {
+    delete $1;
+}
+
+
+/*
+ * Variant types: typecheck maps
+ */
+%typemap(typecheck) qpid::types::Variant::Map& {
+    $1 = (SvTYPE(SvRV($input)) == SVt_PVHV) ? 1 : 0;
+}
+
+%typemap(typecheck) qpid::types::Variant::List& {
+    $1 = (SvTYPE(SvRV($input)) == SVt_PVAV) ? 1 : 0;
+}
+
+%typemap(typecheck) qpid::types::Variant& {
+    $1 = (SvIOK($input) ||
+          SvNOK($input) ||
+          SvPOK($input) ) ? 1 : 0;
+}
+
+%typemap(typecheck) const qpid::types::Variant::Map const & {
+    $1 = (SvTYPE(SvRV($input)) == SVt_PVHV) ? 1 : 0;
+}
+
+%typemap(typecheck) const qpid::types::Variant::List const & {
+    $1 = (SvTYPE(SvRV($input)) == SVt_PVAV) ? 1 : 0;
+}
+
+%typemap(typecheck) const qpid::types::Variant const & {
+    $1 = (SvIOK($input) ||
+          SvNOK($input) ||
+          SvPOK($input) ) ? 1 : 0;
+}
+
+/* No boolean type for perl. 
+   Boolean is simply and integer in perl
+*/
+%typecheck(SWIG_TYPECHECK_BOOL) bool {
+    $1 = (SvIOK($input)) ? 1 : 0;
+}
diff --git a/cpp/configure.ac b/cpp/configure.ac
index 546dd0d280..dc92cd0b44 100644
--- a/cpp/configure.ac
+++ b/cpp/configure.ac
@@ -198,7 +198,7 @@ if test -n "$RUBY" ; then
 fi
 AM_CONDITIONAL([HAVE_RUBY_DEVEL], [test -f $RUBY_INC/ruby.h && test -n "$SWIG"])
 
-# Python bindings: To build python wrappers, the ruby-devel files must be present.
+# Python bindings: To build python wrappers, the python-devel files must be present.
 
 AM_PATH_PYTHON()
 if test -n "$PYTHON" ; then
@@ -228,6 +228,16 @@ if test -n "$PYTHON" ; then
 fi
 AM_CONDITIONAL([HAVE_PYTHON_DEVEL], [test -f $PYTHON_INC/Python.h && test -n "$SWIG"])
 
+
+# Perl bindings:
+
+AC_CHECK_PROG([H2XS], [h2xs], [h2xs])
+if test -n "$H2XS" ; then
+   AC_CHECK_FILE("$libdir/perl5/CORE/perl.h", [AC_SUBST([PERL_INC], "-I$libdir/perl5/CORE")])
+fi
+AM_CONDITIONAL([HAVE_PERL_DEVEL], [test -n "$H2XS" && test -n "$SWIG"])
+
+
 specdir=`pwd`/$srcdir/../specs
 AMQP_FINAL_XML=$specdir/amqp.0-10-qpid-errata.xml
 AC_SUBST(AMQP_FINAL_XML)
@@ -526,6 +536,7 @@ AC_CONFIG_FILES([
   bindings/qpid/Makefile
   bindings/qpid/ruby/Makefile
   bindings/qpid/python/Makefile
+  bindings/qpid/perl/Makefile
   bindings/qmf/Makefile
   bindings/qmf/ruby/Makefile
   bindings/qmf/python/Makefile