Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add Perl tutorial files.

  • Loading branch information...
commit b5dd67717dc1e41818093f7b2f416d4a7414deb6 1 parent eefd0bf
@Lanzaa Lanzaa authored
View
49 perl/README.md
@@ -0,0 +1,49 @@
+# 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 intall Net::RabbitFoot
+
+For tutorial six UUID::Tiny needs to be installed.
+
+## 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
35 perl/emit_log.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Net::RabbitFoot;
+
+use Data::Dumper;
+
+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
34 perl/emit_log_direct.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 => '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
36 perl/emit_log_topic.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Net::RabbitFoot;
+use AnyEvent;
+
+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 => '/',
+ timeout => 1,
+);
+
+
+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
36 perl/receive.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Net::RabbitFoot;
+use AnyEvent;
+
+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] Recevied $body\n";
+}
+
+$ch->consume(
+ on_consume => \&callback,
+ no_ack => 1,
+);
+
+# Wait forever
+AnyEvent->condvar->recv;
+
View
48 perl/receive_logs.pl
@@ -0,0 +1,48 @@
+#!/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
54 perl/receive_logs_direct.pl
@@ -0,0 +1,54 @@
+#!/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
54 perl/receive_logs_topic.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Net::RabbitFoot;
+use AnyEvent;
+
+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
54 perl/rpc_client.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Net::RabbitFoot;
+use AnyEvent;
+use UUID::Tiny;
+
+use Data::Dumper;
+
+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 => 30,
+);
+
+print " [x] Requesting fib(30)\n";
+my $response = $cv->recv;
+print " [.] Got $response\n";
+
View
63 perl/rpc_server.pl
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Net::RabbitFoot;
+use AnyEvent;
+
+use Data::Dumper;
+
+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
32 perl/send.pl
@@ -0,0 +1,32 @@
+#!/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 => '/',
+ timeout => 1,
+);
+
+
+my $chan = $conn->open_channel();
+
+$chan->publish(
+ exchange => '',
+ routing_key => 'hello',
+ body => 'Hello World!',
+ on_return => sub {
+ print "hello World\n";
+ },
+);
+
+print " [x] Sent 'Hello World!'\n";
+
+$conn->close();
+
View
45 perl/worker.pl
@@ -0,0 +1,45 @@
+#!/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;
Please sign in to comment.
Something went wrong with that request. Please try again.