AnyEvent-MQTT
view release on metacpan or search on metacpan
bin/anyevent-mqtt-monitor view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use warnings;
# ABSTRACT: Perl script for subscribing to an MQTT topic
# PODNAME: anyevent-mqtt-sub
use Gtk2 -init;
use Gtk2::SimpleList;
use Net::MQTT::Constants;
use AnyEvent::MQTT;
use POSIX qw/strftime/;
use Getopt::Long;
use Pod::Usage;
my $timefmt = "%Y-%m-%d %H:%M:%S";
my $xpl;
my $help;
my $man;
my $verbose = 0;
my $retain = 1;
my $history_size = 20;
my $host = '127.0.0.1';
my $port = 1883;
my $qos = MQTT_QOS_AT_MOST_ONCE;
my $keep_alive_timer = 120;
GetOptions('help|?' => \$help,
'man' => \$man,
'verbose+' => \$verbose,
'retain!' => \$retain,
'history-size=i' => \$history_size,
'host=s' => \$host,
'port=i' => \$port,
'qos=i' => \$qos,
'keepalive=i' => \$keep_alive_timer) or pod2usage(2);
pod2usage(1) if ($help);
pod2usage(-exitstatus => 0, -verbose => 2) if $man;
my $mqtt =
AnyEvent::MQTT->new(host => $host, port => $port,
keep_alive_timer => $keep_alive_timer,
on_error => sub {
my ($fatal, $message) = @_;
if ($fatal) {
die $message, "\n";
} else {
warn $message, "\n";
}
});
foreach my $topic (scalar @ARGV ? @ARGV : '#') {
$mqtt->subscribe(topic => $topic, callback => \&log, qos => $qos);
}
my %d;
my $win = Gtk2::Window->new('toplevel');
$win->set_title('MQTT Monitor');
$win->set_default_size(400, 400);
my $vbox = Gtk2::VBox->new(0,0);
$win->add($vbox);
my $slist = Gtk2::SimpleList->new('Topic' => 'text',
'Message' => 'text',
'Time' => 'text');
$slist->signal_connect(button_press_event => \&button_press);
$slist->set_rules_hint(1);
$slist->get_selection->set_mode('single');
$slist->get_selection->unselect_all;
@{$slist->{data}} = ();
my $scrolled = Gtk2::ScrolledWindow->new;
$scrolled->set_policy('automatic', 'automatic');
$scrolled->add($slist);
$vbox->add($scrolled);
foreach (['Quit' => sub { Gtk2->main_quit }]) {
my $button = Gtk2::Button->new($_->[0]);
$button->signal_connect(clicked => $_->[1]);
$vbox->pack_start($button, 0, 0, 0);
}
my $menu = Gtk2::Menu->new();
$menu->set_name('client menu');
my $tearoff = Gtk2::TearoffMenuItem->new();
$menu->append($tearoff);
$tearoff->show;
foreach (['History' => \&history_callback]) {
my ($title, $cb) = @$_;
my $item = Gtk2::MenuItem->new($title);
$item->signal_connect('activate', $cb);
$menu->append($item);
$item->show;
}
$win->show_all;
my $dialog = Gtk2::Window->new();
$dialog->signal_connect("destroy", sub { $dialog->hide(); 1; });
$dialog->set_role('dialog');
$dialog->realize();
my $hist_list = Gtk2::SimpleList->new('Time' => 'text',
'Summary' => 'text');
$hist_list->set_rules_hint(1);
$hist_list->signal_connect(button_press_event => \&hist_button_press);
my $dialog_vbox = Gtk2::VBox->new(0,0);
bin/anyevent-mqtt-monitor view on Meta::CPAN
}
sub dump_callback {
print $d{hist_selected}->[0]->string, "\n";
}
__END__
=pod
=encoding UTF-8
=head1 NAME
anyevent-mqtt-sub - Perl script for subscribing to an MQTT topic
=head1 VERSION
version 1.212810
=head1 SYNOPSIS
anyevent-mqtt-sub [options] topic1 [topic2] [topic3] ...
=head1 DESCRIPTION
This script subscribes to one or more MQTT topics and prints any
messages that it receives to stdout.
=head1 OPTIONS
=over
=item B<-help>
Print a brief help message.
=item B<-man>
Print the manual page.
=item B<-host A.B.C.D>
The host running the MQTT service. The default is C<127.0.0.1>.
=item B<-port NNNNN>
The port of the running MQTT service. The default is 1883.
=item B<-qos N>
The QoS level for the published message. The default is
0 (C<MQTT_QOS_AT_MOST_ONCE>).
=item B<-verbose>
Include more verbose output.
=item B<-keepalive NNN>
The keep alive timer value. Defaults to 120 seconds. For simplicity,
it is also currently used as the connection/subscription timeout.
=item B<--history-size NNN>
Number of messages to keep for each topic. Defaults to keeping 20 messages.
=item B<--no-retain>
Ignore retained messages. That is, wait for new messages rather than
processing existing retained messages.
=back
=head1 SEE ALSO
AnyEvent::MQTT(3)
=head1 AUTHOR
Mark Hindess <soft-cpan@temporalanomaly.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2014 by Mark Hindess.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
( run in 1.354 second using v1.01-cache-2.11-cpan-364913b4093 )