Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

Add tutorial files for perl. #13

Merged
merged 4 commits into from

4 participants

@Lanzaa

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

@majek

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?

@Lanzaa

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/

@majek

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?

@Lanzaa

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.

@Lanzaa 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
@Lanzaa

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 rabbitmq:master
@dumbbell dumbbell added this to the n/a milestone
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Jul 5, 2012
  1. @Lanzaa

    Add Perl tutorial files.

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

    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.
View
58 perl/README.md
@@ -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
View
34 perl/emit_log.pl
@@ -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();
View
35 perl/emit_log_direct.pl
@@ -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();
View
37 perl/emit_log_topic.pl
@@ -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();
+
View
36 perl/new_task.pl
@@ -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();
+
View
37 perl/receive.pl
@@ -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;
+
View
49 perl/receive_logs.pl
@@ -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;
View
55 perl/receive_logs_direct.pl
@@ -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;
View
55 perl/receive_logs_topic.pl
@@ -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;
+
View
57 perl/rpc_client.pl
@@ -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";
+
View
62 perl/rpc_server.pl
@@ -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;
View
29 perl/send.pl
@@ -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();
+
View
46 perl/worker.pl
@@ -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.