svn commit: r1524422 - in /qpid/proton/trunk: examples/messenger/perl/client.pl examples/messenger/perl/send.pl examples/messenger/perl/server.pl proton-c/bindings/perl/ChangeLog

[mc...@apache.org]

Author: mcpierce
Date: Wed Sep 18 14:15:28 2013
New Revision: 1524422

URL: http://svn.apache.org/r1524422
Log:
PROTON-386: Provide a Perl mail server example application

Created the server.pl and client.pl applications.

Added:
    qpid/proton/trunk/examples/messenger/perl/client.pl   (with props)
    qpid/proton/trunk/examples/messenger/perl/server.pl   (with props)
Modified:
    qpid/proton/trunk/examples/messenger/perl/send.pl
    qpid/proton/trunk/proton-c/bindings/perl/ChangeLog

Added: qpid/proton/trunk/examples/messenger/perl/client.pl
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/examples/messenger/perl/client.pl?rev=1524422&view=auto
==============================================================================
--- qpid/proton/trunk/examples/messenger/perl/client.pl (added)
+++ qpid/proton/trunk/examples/messenger/perl/client.pl Wed Sep 18 14:15:28 2013
@@ -0,0 +1,105 @@
+#!/usr/bin/env 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 Getopt::Long;
+use Pod::Usage;
+
+use qpid_proton;
+
+my $reply_to = "~/replies";
+my $help = 0;
+my $man = 0;
+
+GetOptions(
+    "reply_to=s", \$reply_to,
+    man => \$man,
+    "help|?" => \$help
+    ) or pod2usage(2);
+pod2usage(1) if $help;
+pod2usage(-exitval => 0, -verbose => 2) if $man;
+
+# get the address to use and show help if it's missing
+my $address = $ARGV[0];
+pod2usage(1) if !$address;
+
+my $messenger = new qpid::proton::Messenger();
+$messenger->start;
+
+my $message = new qpid::proton::Message();
+$message->set_address($address);
+$message->set_reply_to($reply_to);
+$message->set_subject("Subject");
+$message->set_content("Yo!");
+
+print "Sending to: $address\n";
+
+$messenger->put($message);
+$messenger->send;
+
+if($reply_to =~ /^~\//) {
+    print "Waiting on returned message.\n";
+    $messenger->receive(1);
+
+    $messenger->get($message);
+    print $message->get_address . " " . $message->get_subject . "\n";
+}
+
+$messenger->stop;
+
+__END__
+
+=head1 NAME
+
+client - Proton example application for Perl.
+
+=head1 SYNOPSIS
+
+client.pl [OPTIONS] <address> <subject>
+
+ Options:
+   --reply_to - The reply to address to be used. (default: ~/replies)
+   --help     - This help message.
+   --man      - Show the full docementation.
+
+=over 8
+
+=item B<--reply_to>
+
+Specifies the reply address to be used for responses from the server.
+
+=item B<--help>
+
+Prints a brief help message and exits.
+
+=item B<--man>
+
+Prints the man page and exits.
+
+=back
+
+=head2 ADDRESS
+
+The form an address takes is:
+
+[amqp://]<domain>[/name]
+
+=cut

Propchange: qpid/proton/trunk/examples/messenger/perl/client.pl
------------------------------------------------------------------------------
    svn:executable = *

Modified: qpid/proton/trunk/examples/messenger/perl/send.pl
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/examples/messenger/perl/send.pl?rev=1524422&r1=1524421&r2=1524422&view=diff
==============================================================================
--- qpid/proton/trunk/examples/messenger/perl/send.pl (original)
+++ qpid/proton/trunk/examples/messenger/perl/send.pl Wed Sep 18 14:15:28 2013
@@ -24,17 +24,25 @@ use Getopt::Std;
 
 use qpid_proton;
 
-sub usage {
-    exit(0);
+$Getopt::Std::STANDARD_HELP_VERSION = 1;
+
+sub VERSION_MESSAGE() {
 }
 
-my $address = "0.0.0.0";
+sub HELP_MESSAGE() {
+    print "Usage: send.pl [OPTIONS] -a <ADDRESS>\n";
+    print "Options:\n";
+    print "\t-s        - the message subject\n";
+    print "\t-C        - the message content\n";
+    print "\t<ADDRESS> - amqp://<domain>[/<name>]";
+}
 
 my %options = ();
-getopts("ha:", \%options) or usage();
-usage if $options{h};
+getopts("a:C:s:", \%options) or usage();
 
-$address = $options{a} if defined $options{a};
+my $address = $options{a} || "amqp://0.0.0.0";
+my $subject = $options{s} || localtime(time);
+my $content = $options{C} || "";
 
 my $msg  = new qpid::proton::Message();
 my $messenger = new qpid::proton::Messenger();
@@ -47,7 +55,8 @@ my @messages = @ARGV;
 foreach (@messages)
 {
     $msg->set_address($address);
-    $msg->set_content($_);
+    $msg->set_subject($subject);
+    $msg->set_content($content);
     # try a few different body types
     my $body_type = int(rand(4));
     $msg->set_property("sent", "" . localtime(time));

Added: qpid/proton/trunk/examples/messenger/perl/server.pl
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/examples/messenger/perl/server.pl?rev=1524422&view=auto
==============================================================================
--- qpid/proton/trunk/examples/messenger/perl/server.pl (added)
+++ qpid/proton/trunk/examples/messenger/perl/server.pl Wed Sep 18 14:15:28 2013
@@ -0,0 +1,121 @@
+#!/usr/bin/env 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 Getopt::Long;
+use Pod::Usage;
+
+use qpid_proton;
+
+my $help = 0;
+my $man = 0;
+
+GetOptions(
+    man => \$man,
+    "help|?" => \$help
+    ) or pod2usage(2);
+
+pod2usage(1) if $help;
+pod2usage(-exitval => 0, -verbose => 2) if $man;
+
+pod2usage(2) unless scalar(@ARGV);
+
+# create a messenger for receiving and holding
+# incoming messages
+our $messenger = new qpid::proton::Messenger;
+$messenger->start;
+
+# subscribe the messenger to all addresses specified sources
+foreach (@ARGV) {
+    $messenger->subscribe($_);
+}
+
+sub dispatch {
+    my $request = $_[0];
+    my $reply   = $_[1];
+
+    if ($request->get_subject) {
+        $reply->set_subject("Re: " . $request->get_subject);
+    }
+
+    $reply->set_properties($request->get_properties);
+    print "Dispatched " . $request->get_subject . "\n";
+    foreach (keys $request->get_properties) {
+        print "\t$_:" . $request->get_properties->{$_} . "\n";
+    }
+}
+
+our $message = new qpid::proton::Message;
+our $reply   = new qpid::proton::Message;
+
+while(1) {
+    $messenger->receive(1) if $messenger->incoming < 10;
+
+    if ($messenger->incoming > 0) {
+        $messenger->get($message);
+
+        if ($message->get_reply_to) {
+            print $message->get_reply_to . "\n";
+            $reply->set_address($message->get_reply_to);
+            $reply->set_correlation_id($message->get_correlation_id);
+            $reply->set_body($message->get_body);
+        }
+        dispatch($message, $reply);
+        $messenger->put($reply);
+        $messenger->send;
+    }
+}
+
+$message->stop;
+
+__END__
+
+=head1 NAME
+
+server - Proton example server application for Perl.
+
+=head1 SYNOPSIS
+
+server.pl [OPTIONS] <addr1> ... <addrn>
+
+ Options:
+   --help - This help message.
+   --man  - Show the full documentation.
+
+=over 8
+
+=item B<--help>
+
+Prints a brief help message and exits.
+
+=item B<--man>
+
+Prints the man page and exits.
+
+=back
+
+=head2 ADDRESS
+
+The form an address takes is:
+
+[amqp://]<domain>[/name]
+
+=cut

Propchange: qpid/proton/trunk/examples/messenger/perl/server.pl
------------------------------------------------------------------------------
    svn:executable = *

Modified: qpid/proton/trunk/proton-c/bindings/perl/ChangeLog
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/proton-c/bindings/perl/ChangeLog?rev=1524422&r1=1524421&r2=1524422&view=diff
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/ChangeLog (original)
+++ qpid/proton/trunk/proton-c/bindings/perl/ChangeLog Wed Sep 18 14:15:28 2013
@@ -5,6 +5,7 @@ version 0.6:
 	* qpid::proton::Message exposes the properties property.
 	* qpid::proton::Message exports the annotations property.
 	* qpid::proton::Message exposes the instructions property.
+	* Mailserver and client example apps.
 
 version 0.5:
 	* Added the qpid::proton::Data type.



---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@qpid.apache.org
For additional commands, e-mail: commits-help@qpid.apache.org