Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

Add tutorial files for perl. #13

Merged
merged 4 commits into from

3 participants

Colin B. Marek emile
Colin B.

The 6 tutorials coded in perl with the Net::RabbitFoot library.

Marek

To run this code you need to intall Net::RabbitFoot
For tutorial six UUID::Tiny needs to be installed.

How do I do it? apt-get what?

Colin B.

I'm not sure how explicit to be for the install instructions. CPAN is the normal way of installing perl modules.

Should I include links that explain CPAN a bit better?
www.cpan.org/modules/INSTALL.html
http://www.thegeekstuff.com/2008/09/how-to-install-perl-modules-manually-and-using-cpan-command/

Marek

Assuming I'm on a fresh ubuntu, and I know nothing about perl. Assuming I have rabbitmq server running. What should I type to run your code?

Colin B.

Ubuntu made that a lot harder than I expected. Could you take a look at the instructions I added and let me know if they are acceptable?

emile

Hi Colin, Thanks for contributing Perl translations of the tutorials. Would you be able to respond to the following feedback on your merge request?

There are spelling errors that hamper interoperability testing.

The RabbitFoot library makes it look like default connection arguments can be
provided with a config.json. It would be ideal if only the host was specified,
like all the other languages do.

Only some connections have a "timeout" parameter, it is not clear why this is
required. The other languages do not specify this so it should be omitted if
not required.

send.pl (and possibly others) specify a return handler. No other languages
include this so it should be omitted if not required.

It would be more in keeping with the other implementations if the RPC client
had a method that accepted and argument to demonstrate RPC, rather than
publishing a messages with a fixed argument.

Colin B. Lanzaa Improve perl tutorial files.
Fixed a few spelling errors. Removed unnecessary timeout argument from
some connections. Removed on_return callback from send.pl. Modified
rpc_client to allow parameter passing. Added autoflush, $|++, to allow
for automated testing.
fc06c86
Colin B.

I found and fixed some spelling errors. If there are more could you point them out? I removed the timeout parameter, removed the on_return oddity, and modified rpc_client to allow passing an argument.

There is not much documentation on using a config.json to specify default parameters. It only seems to appear in the code for testing Net::RabbitFoot. As such, I have left in the connection arguments. The rpc client could be further improved to reuse one connection for multiple rpc calls, but I lack the time to fix it at the moment.

emile emile merged commit 7968a89 into from
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Jul 5, 2012
  1. Colin B.

    Add Perl tutorial files.

    Lanzaa authored
Commits on Jul 6, 2012
  1. Colin B.
Commits on Jul 7, 2012
  1. Colin B.
Commits on Jul 11, 2012
  1. Colin B.

    Improve perl tutorial files.

    Lanzaa authored
    Fixed a few spelling errors. Removed unnecessary timeout argument from
    some connections. Removed on_return callback from send.pl. Modified
    rpc_client to allow parameter passing. Added autoflush, $|++, to allow
    for automated testing.
This page is out of date. Refresh to see the latest.
58 perl/README.md
View
@@ -0,0 +1,58 @@
+# Perl code for RabbitMQ tutorials
+
+Here you can find Perl code examples from [RabbitMQ
+tutorials](http://www.rabbitmq.com/getstarted.html).
+
+To successfully use the examples you will need a running RabbitMQ server.
+
+## Requirements
+
+To run this code you need to install Net::RabbitFoot.
+
+ cpan -i Net::RabbitFoot
+
+For tutorial six UUID::Tiny needs to be installed.
+
+ cpan -i UUID::Tiny
+
+On Ubuntu:
+
+ sudo apt-get install make libclass-data-inheritable-perl libtest-deep-perl libmoosex-app-cmd-perl libcoro-perl libjson-xs-perl libxml-libxml-perl libconfig-any-perl libmoosex-attributehelpers-perl libmoosex-configfromfile-perl libtest-exception-perl libfile-sharedir-perl libreadonly-xs-perl libuuid-tiny-perl
+ sudo cpan -i Net::RabbitFoot
+
+## Code
+
+[Tutorial one: "Hello World!"](http://www.rabbitmq.com/tutorial-one-python.html):
+
+ perl send.pl
+ perl receive.pl
+
+
+[Tutorial two: Work Queues](http://www.rabbitmq.com/tutorial-two-python.html):
+
+ perl new_task.pl "A very hard task which takes two seconds.."
+ perl worker.pl
+
+
+[Tutorial three: Publish/Subscribe](http://www.rabbitmq.com/tutorial-three-python.html):
+
+ perl receive_logs.pl
+ perl emit_log.pl "info: This is the log message"
+
+
+[Tutorial four: Routing](http://www.rabbitmq.com/tutorial-four-python.html):
+
+ perl receive_logs_direct.pl info
+ perl emit_log_direct.pl info "The message"
+
+
+[Tutorial five: Topics](http://www.rabbitmq.com/tutorial-five-python.html):
+
+ perl receive_logs_topic.pl "*.rabbit"
+ perl emit_log_topic.pl red.rabbit Hello
+
+
+[Tutorial six: RPC](http://www.rabbitmq.com/tutorial-six-python.html):
+
+ perl rpc_server.pl
+ perl rpc_client.pl
34 perl/emit_log.pl
View
@@ -0,0 +1,34 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+$|++;
+use Net::RabbitFoot;
+
+my $conn = Net::RabbitFoot->new()->load_xml_spec()->connect(
+ host => 'localhost',
+ port => 5672,
+ user => 'guest',
+ pass => 'guest',
+ vhost => '/',
+);
+
+my $channel = $conn->open_channel();
+
+$channel->declare_exchange(
+ exchange => 'logs',
+ type => 'fanout',
+);
+
+my $msg = join(' ', @ARGV) || "info: Hello World!";
+
+$channel->publish(
+ exchange => 'logs',
+ routing_key => '',
+ body => $msg,
+);
+
+print " [x] Sent $msg\n";
+
+$conn->close();
35 perl/emit_log_direct.pl
View
@@ -0,0 +1,35 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+$|++;
+use Net::RabbitFoot;
+
+my $conn = Net::RabbitFoot->new()->load_xml_spec()->connect(
+ host => 'localhost',
+ port => 5672,
+ user => 'guest',
+ pass => 'guest',
+ vhost => '/',
+);
+
+my $channel = $conn->open_channel();
+
+$channel->declare_exchange(
+ exchange => 'direct_logs',
+ type => 'direct',
+);
+
+my $severity = delete $ARGV[0] || 'info';
+my $msg = join(' ', @ARGV[1..$#ARGV]) || 'Hello World!';
+
+$channel->publish(
+ exchange => 'direct_logs',
+ routing_key => $severity,
+ body => $msg,
+);
+
+print " [x] Send $severity: $msg\n";
+
+$conn->close();
37 perl/emit_log_topic.pl
View
@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+$|++;
+use AnyEvent;
+use Net::RabbitFoot;
+
+my $conn = Net::RabbitFoot->new()->load_xml_spec()->connect(
+ host => 'localhost',
+ port => 5672,
+ user => 'guest',
+ pass => 'guest',
+ vhost => '/',
+);
+
+my $channel = $conn->open_channel();
+
+$channel->declare_exchange(
+ exchange => 'topic_logs',
+ type => 'topic',
+);
+
+my $routing_key = $ARGV[0] || 'anonymous.info';
+my $msg = join(' ', @ARGV[1..$#ARGV]) || 'Hello World!';
+
+$channel->publish(
+ exchange => 'topic_logs',
+ routing_key => $routing_key,
+ body => $msg,
+);
+
+print " [x] Sent $routing_key:$msg\n";
+
+$conn->close();
+
36 perl/new_task.pl
View
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+$|++;
+use Net::RabbitFoot;
+
+my $conn = Net::RabbitFoot->new()->load_xml_spec()->connect(
+ host => 'localhost',
+ port => 5672,
+ user => 'guest',
+ pass => 'guest',
+ vhost => '/',
+);
+
+
+my $chan = $conn->open_channel();
+
+$chan->declare_queue(
+ queue => 'task_queue',
+ durable => 1,
+);
+
+my $msg = join(' ', @ARGV) || "Hello World!";
+
+$chan->publish(
+ exchange => '',
+ routing_key => 'task_queue',
+ body => $msg,
+);
+
+print " [x] Sent '$msg'\n";
+
+$conn->close();
+
37 perl/receive.pl
View
@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+$|++;
+use AnyEvent;
+use Net::RabbitFoot;
+
+my $conn = Net::RabbitFoot->new()->load_xml_spec()->connect(
+ host => 'localhost',
+ port => 5672,
+ user => 'guest',
+ pass => 'guest',
+ vhost => '/',
+);
+
+my $ch = $conn->open_channel();
+
+$ch->declare_queue(queue => 'hello');
+
+print " [*] Waiting for messages. To exit press CTRL-C\n";
+
+sub callback {
+ my $var = shift;
+ my $body = $var->{body}->{payload};
+ print " [x] Received $body\n";
+}
+
+$ch->consume(
+ on_consume => \&callback,
+ no_ack => 1,
+);
+
+# Wait forever
+AnyEvent->condvar->recv;
+
49 perl/receive_logs.pl
View
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+$|++;
+use AnyEvent;
+use Net::RabbitFoot;
+
+my $conn = Net::RabbitFoot->new()->load_xml_spec()->connect(
+ host => 'localhost',
+ port => 5672,
+ user => 'guest',
+ pass => 'guest',
+ vhost => '/',
+);
+
+my $channel = $conn->open_channel();
+
+$channel->declare_exchange(
+ exchange => 'logs',
+ type => 'fanout',
+);
+
+my $result = $channel->declare_queue( exclusive => 1, );
+
+my $queue_name = $result->{method_frame}->{queue};
+
+$channel->bind_queue(
+ exchange => 'logs',
+ queue => $queue_name,
+);
+
+print " [*] Waiting for logs. To exit press CTRL-C\n";
+
+sub callback {
+ my $var = shift;
+ my $body = $var->{body}->{payload};
+
+ print " [x] $body\n";
+}
+
+$channel->consume(
+ on_consume => \&callback,
+ queue => $queue_name,
+ no_ack => 1,
+);
+
+AnyEvent->condvar->recv;
55 perl/receive_logs_direct.pl
View
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+$|++;
+use AnyEvent;
+use Net::RabbitFoot;
+
+my $conn = Net::RabbitFoot->new()->load_xml_spec()->connect(
+ host => 'localhost',
+ port => 5672,
+ user => 'guest',
+ pass => 'guest',
+ vhost => '/',
+);
+
+my $channel = $conn->open_channel();
+
+$channel->declare_exchange(
+ exchange => 'direct_logs',
+ type => 'direct',
+);
+
+my $result = $channel->declare_queue(
+ exclusive => 1,
+);
+
+my $queue_name = $result->{method_frame}->{queue};
+
+my @severities = @ARGV or die "Usage: $0 [info] [warning] [error]\n";
+foreach my $severity (@severities) {
+ $channel->bind_queue(
+ exchange => 'direct_logs',
+ queue => $queue_name,
+ routing_key => $severity,
+ );
+}
+
+print " [*] Waiting for logs. To exit press CTRL-C\n";
+
+sub callback {
+ my $var = shift;
+ my $body = $var->{body}->{payload};
+ my $routing_key = $var->{deliver}->{method_frame}->{routing_key};
+ print " [x] $routing_key: $body\n";
+}
+
+$channel->consume(
+ on_consume => \&callback,
+ no_ack => 1,
+);
+
+# Wait forever
+AnyEvent->condvar->recv;
55 perl/receive_logs_topic.pl
View
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+$|++;
+use AnyEvent;
+use Net::RabbitFoot;
+
+my $conn = Net::RabbitFoot->new()->load_xml_spec()->connect(
+ host => 'localhost',
+ port => 5672,
+ user => 'guest',
+ pass => 'guest',
+ vhost => '/',
+);
+
+my $channel = $conn->open_channel();
+
+$channel->declare_exchange(
+ exchange => 'topic_logs',
+ type => 'topic',
+);
+
+my $result = $channel->declare_queue(exclusive => 1);
+
+my $queue_name = $result->{method_frame}->{queue};
+
+my @binding_keys = @ARGV or die "Usage: $0 [binding_key]...\n";
+
+for my $key (@binding_keys) {
+ $channel->bind_queue(
+ exchange => 'topic_logs',
+ queue => $queue_name,
+ routing_key => $key,
+ );
+}
+
+print " [*] Waiting for logs. To exit press CTRL-C\n";
+
+sub callback {
+ my $var = shift;
+ my $body = $var->{body}->{payload};
+ my $routing_key = $var->{deliver}->{method_frame}->{routing_key};
+ print " [x] $routing_key:$body\n";
+}
+
+$channel->consume(
+ on_consume => \&callback,
+ no_ack => 1,
+);
+
+# Wait forever
+AnyEvent->condvar->recv;
+
57 perl/rpc_client.pl
View
@@ -0,0 +1,57 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+$|++;
+use AnyEvent;
+use Net::RabbitFoot;
+use UUID::Tiny;
+
+sub fibonacci_rpc($) {
+ my $n = shift;
+ my $cv = AnyEvent->condvar;
+ my $corr_id = UUID::Tiny::create_UUID_as_string(UUID::Tiny::UUID_V4);
+
+ my $conn = Net::RabbitFoot->new()->load_xml_spec()->connect(
+ host => 'localhost',
+ port => 5672,
+ user => 'guest',
+ pass => 'guest',
+ vhost => '/',
+ );
+
+ my $channel = $conn->open_channel();
+
+ my $result = $channel->declare_queue(exclusive => 1);
+ my $callback_queue = $result->{method_frame}->{queue};
+
+ sub on_response {
+ my $var = shift;
+ my $body = $var->{body}->{payload};
+ if ($corr_id eq $var->{header}->{correlation_id}) {
+ $cv->send($body);
+ }
+ }
+
+ $channel->consume(
+ no_ack => 1,
+ on_consume => \&on_response,
+ );
+
+ $channel->publish(
+ exchange => '',
+ routing_key => 'rpc_queue',
+ header => {
+ reply_to => $callback_queue,
+ correlation_id => $corr_id,
+ },
+ body => $n,
+ );
+ return $cv->recv;
+}
+
+print " [x] Requesting fib(30)\n";
+my $response = fibonacci_rpc(30);
+print " [.] Got $response\n";
+
62 perl/rpc_server.pl
View
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+$|++;
+use AnyEvent;
+use Net::RabbitFoot;
+
+my $conn = Net::RabbitFoot->new()->load_xml_spec()->connect(
+ host => 'localhost',
+ port => 5672,
+ user => 'guest',
+ pass => 'guest',
+ vhost => '/',
+);
+
+my $channel = $conn->open_channel();
+
+$channel->declare_queue(queue => 'rpc_queue');
+
+sub fib {
+ my $n = shift;
+ if ($n == 0) {
+ return 0;
+ } elsif ($n == 1) {
+ return 1;
+ } else {
+ return fib($n-1) + fib($n-2);
+ }
+}
+
+sub on_request {
+ my $var = shift;
+ my $body = $var->{body}->{payload};
+ my $props = $var->{header};
+
+ my $n = $body;
+ print " [.] fib($n)\n";
+ my $response = fib($n);
+
+ $channel->publish(
+ exchange => '',
+ routing_key => $props->{reply_to},
+ header => {
+ correlation_id => $props->{correlation_id},
+ },
+ body => $response,
+ );
+
+ $channel->ack();
+}
+
+$channel->qos(prefetch_count => 1);
+$channel->consume(
+ on_consume => \&on_request,
+);
+
+print " [x] Awaiting RPC requests\n";
+
+# Wait forever
+AnyEvent->condvar->recv;
29 perl/send.pl
View
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+$|++;
+use Net::RabbitFoot;
+
+my $conn = Net::RabbitFoot->new()->load_xml_spec()->connect(
+ host => 'localhost',
+ port => 5672,
+ user => 'guest',
+ pass => 'guest',
+ vhost => '/',
+);
+
+
+my $chan = $conn->open_channel();
+
+$chan->publish(
+ exchange => '',
+ routing_key => 'hello',
+ body => 'Hello World!',
+);
+
+print " [x] Sent 'Hello World!'\n";
+
+$conn->close();
+
46 perl/worker.pl
View
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+$|++;
+use Net::RabbitFoot;
+
+my $conn = Net::RabbitFoot->new()->load_xml_spec()->connect(
+ host => 'localhost',
+ port => 5672,
+ user => 'guest',
+ pass => 'guest',
+ vhost => '/',
+);
+
+my $ch = $conn->open_channel();
+
+$ch->declare_queue(
+ queue => 'task_queue',
+ durable => 1,
+);
+
+print " [*] Waiting for messages. To exit press CTRL-C\n";
+
+sub callback {
+ my $var = shift;
+ my $body = $var->{body}->{payload};
+ print " [x] Received $body\n";
+
+ my @c = $body =~ /\./g;
+ sleep(scalar(@c));
+
+ print " [x] Done\n";
+ $ch->ack();
+}
+
+$ch->qos(prefetch_count => 1,);
+
+$ch->consume(
+ on_consume => \&callback,
+ no_ack => 0,
+);
+
+# Wait forever
+AnyEvent->condvar->recv;
Something went wrong with that request. Please try again.