UAV-Pilot
view release on metacpan or search on metacpan
Revision history for perl module UAV::Pilot
1.3 2015-08-27
- Add UAV::Pilot::Video::JPEGHandler
1.2 2015-08-22
- Install exec scripts under Dist::Zilla
1.1 2015-06-08
- Track down issues with version number
- Bump copyright year
1.0 2014-06-05
- Bump version number. Really, that's it.
1.0_1 2014-06-04
- Allow loading of other modules in Commands packages
1.0_0 2014-06-04
- No longer use share/ method of loading Command shell modules. Instead,
use a specific namespace with some @INC magic.
0.11 2014-05-29
- Port build to Dist::Zilla
- Actually fix regression bug of FileDump taking a filehandle
0.10 2014-04-27
- Fix regression bug of FileDump taking a filehandle
- UAV::Pilot::Command calls uav_module_quit() when it's about to exit
0.9 2014-02-16
- Breakoff parts into new dists
0.8 2013-12-28
- Unicast implemented for Parrot AR.Drone navdata
- WumpusRover implemented
- Decoupled interface in bin/uav and share/*.uav libaries to support more than
just the AR.Drone
- Decoupled SDL Joystick interface from AR.Drone
- UAV::Pilot::SDL::JoystickConverter deleted as unnecessary
- Change ARDrone::Control::Event interface to take an existing condvar rather
than creating and returning a new one
- Fixed a crash where the AR.Drone's navdata was sending NaN floats
0.7 2013-10-24
- Cleanup a bunch of bad tests and dependencies from 0.6
0.6 2013-10-15
[EventHandler Interface]
- UAV::Pilot::SDL::EventHandler moved to UAV::Pilot::EventHandler
- UAV::Pilot::Events based on previous UAV::Pilot::SDL::Events, except it
doesn't do anything for SDL
- UAV::Pilot::SDL::Events changed to an EventHandler
- All other EventHandler objects and bin/uav* scripts updated to reflect this
change
[Controller and Driver Interface]
- Rename UAV::Pilot::Driver::ARDrone to UAV::Pilot::ARDrone::Driver
- Rename UAV::Pilot::Control::ARDrone to UAV::Pilot::ARDrone::Control
- All the other modules under those namespaces were renamed accordingly
[Other Changes]
- In UAV::Pilot::Control, change the 'sender' param to 'driver'
- Stack handlers passed to UAV::Pilot::Video::H264Decoder. Note the API change
of 'display' to 'displays'
- Stack handlers passed to UAV::Pilot::Driver::ARDrone::Video. Note the API
change of 'handler' to 'handlers'
- 'uav' shell handles dumping video to file while displaying it at the same time
- Implement 'NavCollector' to receive nav packets as they're read from the driver
- SDLNavDisplay implemented as a NavCollector rather than an EventHandler
- When we get a bad PaVE header on the video stream, fast forward to the next
one. This helps recover the video stream gracefully. The video will be
messed up until the next keyframe, but at least it keeps going.
0.5 2013-07-31
- Real-time video implemented (this is the big one)
- VideoHandler and FileDump moved into UAV::Pilot::Video namespace. Handler
role now named "H264Handler".
- Joystick buttons can be mapped to actions
- Joystick module can take a path to a conf file
- bin/uav gets an --iface option for a network interface for binding
0.4 2013-07-04
- Dump video to file
- If using mplayer to show the file, set the FPS manually with
"mplayer -fps 30 /path/to/file.h264"
- Rename anything that starts an event loop to init_event_loop()
- Joystick to UAV control number conversion decoupled from ARDrone specifics
- Add methods to UAV::Pilot::Control::ARDrone for userbox nav data and picture
taking
0.3 2013-06-17
- Event-based interface
- Joystick control
0.2 2013-06-02
- Device renamed to Control
- Sender renamed to Driver
- Fetch demo navigation data
0.1 2013-05-09
- Piloting commands work
Copyright (c) 2015, Timm Murray
All rights reserved.
Redistribution and use in source and binary forms, with or without modification, are
permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this list of
conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice, this list of
conditions and the following disclaimer in the documentation and/or other materials
provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.037.
CHANGELOG
LICENSE
MANIFEST
MANIFEST.SKIP
META.json
Makefile.PL
README
RELEASE.HOWTO
ROADMAP
bin/uav
bin/uav_config
bin/uav_dump_config
bin/uav_emergency
bin/uav_joystick
bin/uav_network_settings
bin/uav_video_display
bin/uav_video_dump
bin/wumpusrover_client_example
dist.ini
lib/UAV/Pilot.pm
lib/UAV/Pilot/Commands.pm
lib/UAV/Pilot/Control.pm
lib/UAV/Pilot/ControlHelicopter.pm
lib/UAV/Pilot/ControlRover.pm
lib/UAV/Pilot/Driver.pm
lib/UAV/Pilot/EasyEvent.pm
lib/UAV/Pilot/EventHandler.pm
lib/UAV/Pilot/Events.pm
lib/UAV/Pilot/Exceptions.pm
lib/UAV/Pilot/Logger.pm
lib/UAV/Pilot/Mock/Commands.pm
lib/UAV/Pilot/MockInit/Commands.pm
lib/UAV/Pilot/NavCollector.pm
lib/UAV/Pilot/NavCollector/AckEvents.pm
lib/UAV/Pilot/Server.pm
lib/UAV/Pilot/Video/FileDump.pm
lib/UAV/Pilot/Video/H264Handler.pm
lib/UAV/Pilot/Video/JPEGHandler.pm
lib/UAV/Pilot/Video/Mock/RawHandler.pm
lib/UAV/Pilot/Video/RawHandler.pm
ppport.h
scripts/anyevent_example.pl
scripts/easy_event_example.pl
scripts/fake_nav.pl
scripts/fletcher8.pl
scripts/float_convert.pl
scripts/h264_to_wumpus_video_gstreamer.pl
scripts/nav_data_demo.pl
scripts/nav_data_dump.js
scripts/nav_data_dump.pl
scripts/start_wumpusrover_server.sh
scripts/video_dump.pl
scripts/wumpus_video_display.pl
scripts/wumpus_video_gstreamer.pl
scripts/wumpus_video_to_h264.pl
t/001_load.t
t/002_pod.t
t/010_video_file_dump.t
t/130_easy_event.t
t/140_events.t
t/200_commands.t
typemap
uav.h
MANIFEST.SKIP view on Meta::CPAN
#!start included /usr/lib64/perl5/vendor_perl/5.16.3/ExtUtils/MANIFEST.SKIP
# Avoid version control files.
\bRCS\b
\bCVS\b
\bSCCS\b
,v$
\B\.svn\b
\B\.git\b
\B\.gitignore\b
\b_darcs\b
\B\.cvsignore$
# Avoid VMS specific MakeMaker generated files
\bDescrip.MMS$
\bDESCRIP.MMS$
\bdescrip.mms$
# Avoid Makemaker generated and utility files.
\bMANIFEST\.bak
\bMakefile$
\bblib/
\bMakeMaker-\d
\bpm_to_blib\.ts$
\bpm_to_blib$
\bblibdirs\.ts$ # 6.18 through 6.25 generated this
# Avoid Module::Build generated and utility files.
\bBuild$
\b_build/
\bBuild.bat$
\bBuild.COM$
\bBUILD.COM$
\bbuild.com$
# Avoid temp and backup files.
~$
\.old$
\#$
\b\.#
\.bak$
\.tmp$
\.#
\.rej$
# Avoid OS-specific files/dirs
# Mac OSX metadata
\B\.DS_Store
# Mac OSX SMB mount metadata files
\B\._
# Avoid Devel::Cover and Devel::CoverX::Covered files.
\bcover_db\b
\bcovered\b
# Avoid MYMETA files
^MYMETA\.
#!end included /usr/lib64/perl5/vendor_perl/5.16.3/ExtUtils/MANIFEST.SKIP
# Avoid configuration metadata file
^MYMETA\.
# Avoid Module::Build generated and utility files.
\bBuild$
\bBuild.bat$
\b_build
\bBuild.COM$
\bBUILD.COM$
\bbuild.com$
^MANIFEST\.SKIP
# Avoid developer scripts
\bscripts/
# Avoid archives of this distribution
\bUAV-Pilot-[\d\.\_]+
# Leftover video stream files from testing
ardrone_video_stream.h264.*
# Developer script
test.sh
test_file.sh
install.sh
# Leftover C and compiler files
.*\.c
.*\.o
{
"abstract" : "Base library for controlling UAVs",
"author" : [
"Timm Murray <tmurray@wumpus-cave.net>"
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 5.037, CPAN::Meta::Converter version 2.150005",
"license" : [
"bsd"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "UAV-Pilot",
"prereqs" : {
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"recommends" : {
"Getopt::Long" : "0",
"UAV::Pilot::SDL" : "0",
"UAV::Pilot::Video::Ffmpeg" : "0"
},
"requires" : {
"AnyEvent" : "0",
"AnyEvent::ReadLine::Gnu" : "0",
"DateTime" : "0",
"File::HomeDir" : "0",
"File::ShareDir" : "0",
"File::Spec" : "0",
"File::Temp" : "0",
"IO::Socket::Multicast" : "0",
"Log::Log4perl" : "0",
"Math::Trig" : "0",
"Moose" : "0",
"MooseX::Event" : "0",
"String::CRC32" : "0",
"Test::More" : "0",
"Throwable" : "0",
"YAML" : "0",
"namespace::autoclean" : "0"
}
},
"test" : {
"requires" : {
"Test::Pod" : "0"
}
}
},
"release_status" : "stable",
"resources" : {
"homepage" : "http://www.wumpus-cave.net",
"repository" : {
"type" : "git",
"web" : "https://github.com/frezik/UAV-Pilot"
}
},
"version" : "1.3"
}
Makefile.PL view on Meta::CPAN
# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.037.
use strict;
use warnings;
use ExtUtils::MakeMaker;
my %WriteMakefileArgs = (
"ABSTRACT" => "Base library for controlling UAVs",
"AUTHOR" => "Timm Murray <tmurray\@wumpus-cave.net>",
"CONFIGURE_REQUIRES" => {
"ExtUtils::MakeMaker" => 0
},
"DISTNAME" => "UAV-Pilot",
"EXE_FILES" => [
"bin/wumpusrover_client_example",
"bin/uav_joystick",
"bin/uav_video_dump",
"bin/uav_network_settings",
"bin/uav_dump_config",
"bin/uav",
"bin/uav_video_display",
"bin/uav_emergency",
"bin/uav_config"
],
"LICENSE" => "bsd",
"NAME" => "UAV::Pilot",
"PREREQ_PM" => {
"AnyEvent" => 0,
"AnyEvent::ReadLine::Gnu" => 0,
"DateTime" => 0,
"File::HomeDir" => 0,
"File::ShareDir" => 0,
"File::Spec" => 0,
"File::Temp" => 0,
"IO::Socket::Multicast" => 0,
"Log::Log4perl" => 0,
"Math::Trig" => 0,
"Moose" => 0,
"MooseX::Event" => 0,
"String::CRC32" => 0,
"Test::More" => 0,
"Throwable" => 0,
"YAML" => 0,
"namespace::autoclean" => 0
},
"TEST_REQUIRES" => {
"Test::Pod" => 0
},
"VERSION" => "1.3",
"test" => {
"TESTS" => "t/*.t"
}
);
my %FallbackPrereqs = (
"AnyEvent" => 0,
"AnyEvent::ReadLine::Gnu" => 0,
"DateTime" => 0,
"ExtUtils::MakeMaker" => 0,
"File::HomeDir" => 0,
"File::ShareDir" => 0,
"File::Spec" => 0,
"File::Temp" => 0,
"IO::Socket::Multicast" => 0,
"Log::Log4perl" => 0,
"Math::Trig" => 0,
"Moose" => 0,
"MooseX::Event" => 0,
"String::CRC32" => 0,
"Test::More" => 0,
"Test::Pod" => 0,
"Throwable" => 0,
"YAML" => 0,
"namespace::autoclean" => 0
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
delete $WriteMakefileArgs{TEST_REQUIRES};
delete $WriteMakefileArgs{BUILD_REQUIRES};
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
Perl library for controlling UAVs, specifically ARDrone (maybe others in the future). See:
http://ardrone2.parrot.com
WARNING!
If your ARDrone crashes into your neighbor's house, invades Iranian airspace, or tries to
find Sarah Conner, don't blame me.
RECOMMENDED MODULES
===================
SDL is highly recommended on clients for displaying navigation data, video
streams, and joystick input.
The RaspberryPi HiPi modules are only needed for the WumpusRover server.
INSTALLATION
============
For full functionality, you will need the SDL Perl module and the ffmpeg C library.
Install with the standard Module::Build method:
perl ./Build.PL
./Build
./Build test
./Build install
RELEASE.HOWTO view on Meta::CPAN
Update CHANGELOG date
Run: dzil release
Version 0.10
-----------
* *::Control::Event modules should have their own role.
* Modify uav_joystick (and other bin/uav_*) to use share/ libraries
* For bin/uav;
* Different libraries will need to be loaded with a different host
* Use a factory pattern for init'ing the drivers and controllers
* Error message formatting
* Use a Factory object to create the Driver and Control objects
* Load a config file for loading modules by default
* Possibly use subref in @INC to load REPL modules. See require() perlfunc
docs in Perl 5.19.2. Note that feature was implemented in 5.10 according
to 5.19.2's perldelta.
* EasyEvent takes nav data into account ("vert_speed 1.0 until altitude ==
10000cm")
* Document:
* bin/uav_video_dump (all command line options)
Version ???
-----------
* Send multiconfig commands in order to set video display size and fps
* Joystick
* Support more than one joystick
* Map toggle buttons using config
#!/usr/bin/perl
# Copyright (c) 2014 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
use v5.14;
use AnyEvent::ReadLine::Gnu;
use UAV::Pilot;
use UAV::Pilot::EasyEvent;
use UAV::Pilot::Commands;
use Getopt::Long qw( :config no_ignore_case );
my $IP = '192.168.1.1';
my $PROMPT = 'uav> ';
my $MULTILINE_PROMPT = "\t";
my @LIB_PATHS = ();
my @LIBS = ();
my $IFACE = undef;
my $DO_MULTICAST = 0;
GetOptions(
'host=s' => \$IP,
'i|iface=s' => \$IFACE,
'l|load=s' => \@LIBS,
'L|library=s' => \@LIB_PATHS,
'm|multicast' => \$DO_MULTICAST,
);
sub run_cmd
{
my ($cmd, $repl) = @_;
my $return = 1;
if( $cmd =~ /\A(?: exit | quit | q ) \s*;\s*\z/x ) {
$return = 0;
$repl->quit;
}
else {
eval {
$repl->run_cmd( $cmd );
};
if( $@ ) {
if( ref($@) && $@->isa( 'UAV::Pilot::Exception' ) ) {
warn $@->to_string;
}
else {
warn $@;
}
}
}
return $return;
}
sub load_libraries
{
my ($repl, $lib_paths, $libs, $cv) = @_;
$repl->add_lib_dir( $_ ) for @$lib_paths;
$repl->add_lib_dir( UAV::Pilot->default_module_dir );
foreach my $lib (@$libs) {
print "Loading library '$lib' . . . ";
$repl->load_lib( $lib, {
condvar => $cv,
});
print "OK\n";
}
print "\n";
return 1;
}
sub make_ardrone_controller
{
my ($cmd, $cv, $easy_events) = @_;
eval "use UAV::Pilot::ARDrone::Driver"; die $@ if $@;
eval "use UAV::Pilot::ARDrone::Control::Event"; die $@ if $@;
my $driver = UAV::Pilot::ARDrone::Driver->new({
host => $IP,
(defined $IFACE ? (iface => $IFACE) : ()),
(defined $DO_MULTICAST ? (do_multicast_navdata => $DO_MULTICAST) : ()),
});
$driver->connect;
my $control = UAV::Pilot::ARDrone::Control::Event->new({
driver => $driver,
});
$control->init_event_loop( $cv, $easy_events );
return $control;
}
sub make_wumpusrover_controller
{
my ($cmd, $cv, $easy_events) = @_;
eval "use UAV::Pilot::WumpusRover::Driver"; die $@ if $@;
eval "use UAV::Pilot::WumpusRover::Control::Event"; die $@ if $@;
my $driver = UAV::Pilot::WumpusRover::Driver->new({
host => $IP,
});
$driver->connect;
my $control = UAV::Pilot::WumpusRover::Control::Event->new({
driver => $driver,
});
$control->init_event_loop( $cv, $easy_events );
return $control;
}
{
my @cmd = ();
sub add_cmd
{
my ($cmd) = @_;
push @cmd => $cmd;
return 1;
}
sub full_cmd
{
my $cmd = join( ' ', @cmd );
@cmd = ();
return $cmd;
}
}
{
my $continue = 1;
my $cv = AnyEvent->condvar;
my $repl = UAV::Pilot::Commands->new({
condvar => $cv,
controller_callback_ardrone => \&make_ardrone_controller,
controller_callback_wumpusrover => \&make_wumpusrover_controller,
});
load_libraries( $repl, \@LIB_PATHS, \@LIBS, $cv );
my $readline; $readline = AnyEvent::ReadLine::Gnu->new(
prompt => $PROMPT,
on_line => sub {
my ($line) = @_;
add_cmd( $line );
if( $line =~ /; \s* \z/x ) {
my $cmd = full_cmd;
$readline->hide;
my $do_continue = run_cmd( $cmd, $repl );
$readline->show;
$cv->send( $do_continue ) unless $do_continue;
}
},
);
$cv->recv;
}
__END__
=head1 SYNOPSIS
uav \
--host 192.168.1.1 \
-L /path/to/libraries
-l ARDrone
=head1 DESCRIPTION
Launches a shell for controlling a UAV. Perl statements may be typed at the prompt, ending
with a semi-colon. With the Parrot AR.Drone, try:
uav> takeoff;
uav> pitch -0.5;
uav> wave;
uav> land;
=head1 OPTIONS
=head2 --host
Host IP to connect to. Out of the box, the Parrot AR.Drone will be its own wireless
access point on IP 192.168.1.1 (which is the default here).
=head2 -L or --library
Path to library modules. May be specified multiple times. By default, this will be the
dist shared dir returned by L<File::ShareDir> for L<UAV::Pilot>.
=head2 -l or --load
Library to load. May be specified multiple times. It will need to be under one of the
directories specified by the C<--library> option (or the default library path).
=head2 -i or --iface
Specify interface name to be used with the drone. By default, iface is set to wlan0.
Mac useses different interface names and can be found using the ifconfig command.
More recent Linux setups with predictable interface names also use different
naming convention (unless your distro configures things using the old names).
This is only needed with the multicast option.
=head2 -m or --multicast
Use multicast addresses for UAV connections that support it. In particular,
the Parrot AR.Drone's nav data.
Multicast seems to be tricky to use on Mac OSX. Default is to use traditional
unicast.
=cut
bin/uav_config view on Meta::CPAN
#!/usr/bin/perl
# Copyright (c) 2014 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
use v5.14;
use warnings;
use UAV::Pilot::ARDrone::Driver;
use Getopt::Long;
my $HOST = '192.168.1.1';
my $PORT = UAV::Pilot::ARDrone::Driver->ARDRONE_PORT_COMMAND;
my $KEY = '';
my $VALUE = '';
GetOptions(
'host=s' => \$HOST,
'port=i' => \$PORT,
'k|key=s' => \$KEY,
'v|value=s' => \$VALUE,
);
die "Need a --key option\n" unless $KEY;
die "Need a --value option\n" unless $VALUE;
my $true_key = 'ARDRONE_CONFIG_' . uc($KEY);
my $ardrone = UAV::Pilot::ARDrone::Driver->new({
host => $HOST,
($PORT ? (port => $PORT) : ()),
});
die "Can't find config for '$KEY'\n"
unless $ardrone->can( $true_key );
$ardrone->connect;
$ardrone->at_config(
$ardrone->$true_key,
$VALUE,
);
__END__
=head1 SYNOPSIS
uav_config \
--host 192.168.1.1 \
--port 1234 \
--key video_codec_fps \
--value 30
=head1 DESCRIPTION
Set a config key on the UAV. A list of keys can be found in the section "Constants" ->
"Configuration" in the docs for C<UAV::Pilot::ARDrone::Driver>. To set a C<--key> option,
take off the C<ARDRONE_CONFIG_> at the start of the config key name. For instance, to
set C<ARDRONE_CONFIG_VIDEO_CODEC_FPS>, you would instead set C<video_codec_fps> (lowercase
is OK).
=cut
bin/uav_dump_config view on Meta::CPAN
#!/usr/bin/perl
# Copyright (c) 2014 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
use v5.14;
use warnings;
use UAV::Pilot::ARDrone::Driver;
my $HOST = shift || '192.168.1.1';
my $PORT = shift || UAV::Pilot::ARDrone::Driver->ARDRONE_PORT_CTRL;
my $SOCKET_TYPE = UAV::Pilot::ARDrone::Driver->ARDRONE_PORT_CTRL_TYPE;
# This all should work, but doesn't. Seems that the current AR drone is bugged. See:
#
# https://projects.ardrone.org/boards/1/topics/show/5216
# https://projects.ardrone.org/boards/1/topics/show/3453
#
local $| = 1; # Autoflush
my $in = IO::Socket::INET->new(
Proto => $SOCKET_TYPE,
LocalPort => $PORT,
Port => $PORT,
) or die "Could not open socket on port $PORT: $!\n";
print $in "AT*CTRL=0," . UAV::Pilot::ARDrone::Driver->ARDRONE_CTRL_GET_CONFIG . ",0\r";
while( <$in> ) {
print;
}
$in->close;
bin/uav_emergency view on Meta::CPAN
#!/usr/bin/perl
# Copyright (c) 2014 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
use v5.14;
use strict;
use warnings;
use AnyEvent;
use UAV::Pilot;
use UAV::Pilot::ARDrone::Driver;
use UAV::Pilot::ARDrone::Control;
use constant IP => '192.168.1.1';
my $ardrone = UAV::Pilot::ARDrone::Driver->new({
host => IP,
});
$ardrone->connect;
my $ar = UAV::Pilot::ARDrone::Control->new({
driver => $ardrone,
});
$ar->emergency;
bin/uav_joystick view on Meta::CPAN
#!/usr/bin/perl
# Copyright (c) 2014 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
use v5.14;
use warnings;
use AnyEvent;
use UAV::Pilot;
use UAV::Pilot::Commands;
use UAV::Pilot::ARDrone::Driver;
use UAV::Pilot::ARDrone::NavPacket;
use UAV::Pilot::ARDrone::Control::Event;
use UAV::Pilot::Events;
use UAV::Pilot::SDL::Events;
use UAV::Pilot::SDL::Joystick;
use Getopt::Long ();
use constant NAV_UPDATE_INTERVAL => 1 / 30;
my $IP = '192.168.1.1';
my $SHOW_NAV = 0;
my $CONF = undef;
Getopt::Long::GetOptions(
'host=s' => \$IP,
'show-nav' => \$SHOW_NAV,
'conf=s' => \$CONF,
);
sub show_nav
{
my ($driver, $cv, $events, $nav_feeder) = @_;
eval "use UAV::Pilot::ARDrone::SDLNavOutput";
die $@ if $@;
my $sdl_nav = UAV::Pilot::ARDrone::SDLNavOutput->new({
condvar => $cv,
driver => $driver,
feeder => $nav_feeder,
});
$events->register( $sdl_nav );
return 1;
}
{
my $ardrone = UAV::Pilot::ARDrone::Driver->new({
host => $IP,
});
$ardrone->connect;
my $dev = UAV::Pilot::ARDrone::Control::Event->new({
driver => $ardrone,
});
my $cv = $dev->init_event_loop;
my $events = UAV::Pilot::Events->new({
condvar => $cv,
});
my $sdl_events = UAV::Pilot::SDL::Events->new;
$events->register( $sdl_events );
my $joystick = UAV::Pilot::SDL::Joystick->new({
condvar => $cv,
controller => $dev,
conf_path => $CONF,
});
$events->register( $joystick );
show_nav( $ardrone, $cv, $events, $dev ) if $SHOW_NAV;
$events->init_event_loop;
say "Ready to fly";
$cv->recv;
$joystick->close;
}
=head1 SYNOPSIS
uav_joystick --show-nav
=head1 DESCRIPTION
Controls a Parrot AR.Drone with an SDL-compatible joystick.
C<--show-nav> displays the navigation output in an SDL window. Closing the window will end
the program.
The joystick parameters can be configured in a config file. See C<UAV::Pilot::SDL::Joystick>
for details.
=cut
bin/uav_network_settings view on Meta::CPAN
#!/usr/bin/perl
# Copyright (c) 2014 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
use v5.14;
use warnings;
use UAV::Pilot::Driver::ARDrone;
use Getopt::Long;
my $HOST = '192.168.1.1';
my $PORT = UAV::Pilot::ARDrone::Driver->ARDRONE_PORT_COMMAND;
my $SSID = undef;
my $MODE_AP = 0;
my $MODE_JOIN = 0;
my $MODE_STATION = 0;
my $OWNER_MAC = undef;
GetOptions(
'host=s' => \$HOST,
'port=i' => \$PORT,
'ssid=s' => \$SSID,
'join' => \$MODE_JOIN,
'ap' => \$MODE_AP,
'station' => \$MODE_STATION,
'owner-mac=s' => \$OWNER_MAC,
);
my $ardrone = UAV::Pilot::ARDrone::Driver->new({
host => $HOST,
($PORT ? (port => $PORT) : ()),
});
$ardrone->connect;
$ardrone->at_config(
$ardrone->ARDRONE_CONFIG_NETWORK_SSID_SINGLE_PLAYER,
$SSID,
) if defined $SSID;
my $mode_setting =
$MODE_JOIN ? $ardrone->ARDRONE_CONFIG_NETWORK_WIFI_MODE_JOIN :
$MODE_AP ? $ardrone->ARDRONE_CONFIG_NETWORK_WIFI_MODE_AP :
$MODE_STATION ? $ardrone->ARDRONE_CONFIG_NETWORK_WIFI_MODE_STATION :
undef;
$ardrone->at_config(
$ardrone->ARDRONE_CONFIG_NETWORK_WIFI_MODE,
$mode_setting,
) if defined $mode_setting;
$ardrone->at_config(
$ardrone->ARDRONE_CONFIG_NETWORK_OWNER_MAC,
$OWNER_MAC,
) if defined $OWNER_MAC;
__END__
=head1 SYNOPSIS
uav_set_ssid \
--ssid 'bane_of_cats'
--host 192.168.1.1 \
--port 5557 \
--join \ # Join a network in Ad-Hoc mode (default)
--ap \ # UAV is the access point
--station \ # Join the network as a station
--owner-mac <00:00:00:00:00:00>
=head1 DESCRIPTION
Configure the network settings for the AR Parrot UAV.
B<NOTE>: The AR Parrot must be restarted before the changes take effect.
If none of the settings C<--join>, C<--ap>, or C<--station> are set, the UAV is left
with its current setting.
You can set C<--owner-mac> to C<00:00:00:00:00:00> to unpair the UAV.
=cut
bin/uav_video_display view on Meta::CPAN
#!/usr/bin/perl
# Copyright (c) 2014 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
use v5.14;
use warnings;
use AnyEvent;
use UAV::Pilot;
use UAV::Pilot::EasyEvent;
use UAV::Pilot::ARDrone::Driver;
use UAV::Pilot::ARDrone::Driver::Mock;
use UAV::Pilot::ARDrone::NavPacket;
use UAV::Pilot::ARDrone::Video;
use UAV::Pilot::ARDrone::Video::Mock;
use UAV::Pilot::ARDrone::Control;
use UAV::Pilot::Events;
use UAV::Pilot::SDL::Events;
use UAV::Pilot::SDL::Video;
use UAV::Pilot::SDL::VideoOverlay::Reticle;
use UAV::Pilot::SDL::Window;
use UAV::Pilot::Video::FileDump;
use UAV::Pilot::Video::H264Decoder;
use String::CRC32 'crc32';
use Getopt::Long ();
use constant NAV_UPDATE_INTERVAL => 1 / 30;
use constant {
FRONT_CAMERA => 'front',
BOTTOM_CAMERA => 'bottom',
RESOLUTION_HD => 'hd',
RESOLUTION_SD => 'sd',
};
my $IP = '192.168.1.1';
my $FILE_IN = '';
my $FILE_OUT = '';
my $RETICLE = 0;
my $CAMERA = FRONT_CAMERA;
my $FORMAT = RESOLUTION_HD;
my $FPS = 30;
my $CONFIG_SESSION_ID = sprintf( '%x', crc32( int rand 2**16 ) );
my $CONFIG_USER_ID = sprintf( '%x', crc32( 'uav_pilot_user' ) );
my $CONFIG_APP_ID = sprintf( '%x', crc32( 'uav_pilot' ) );
Getopt::Long::GetOptions(
'host=s' => \$IP,
'in=s' => \$FILE_IN,
'out=s' => \$FILE_OUT,
'reticle' => \$RETICLE,
'camera=s' => \$CAMERA,
'format=s' => \$FORMAT,
'fps=i' => \$FPS,
);
sub set_reticle_overlay
{
my ($video, $window) = @_;
my $reticle = UAV::Pilot::SDL::VideoOverlay::Reticle->new;
$video->register_video_overlay( $reticle, $window );
return 1;
}
sub set_driver_config
{
my ($control, $driver, $easy_event) = @_;
$control->send_config(
$driver->ARDRONE_CONFIG_VIDEO_BITRATE_CONTROL_MODE,
$driver->ARDRONE_CONFIG_VIDEO_VBC_MODE_DYNAMIC,
);
my $camera_setting = ($CAMERA eq BOTTOM_CAMERA)
? $driver->ARDRONE_CONFIG_VIDEO_CHANNEL_ZAP_CHANNEL_VERT
: $driver->ARDRONE_CONFIG_VIDEO_CHANNEL_ZAP_CHANNEL_HORI;
$control->send_config(
$driver->ARDRONE_CONFIG_VIDEO_VIDEO_CHANNEL,
$camera_setting,
);
my $format_setting = ($FORMAT eq RESOLUTION_SD)
? $driver->ARDRONE_CONFIG_VIDEO_CODEC_H264_360P
: $driver->ARDRONE_CONFIG_VIDEO_CODEC_H264_720P;
say "Setting codec $format_setting";
$control->send_config(
$driver->ARDRONE_CONFIG_VIDEO_VIDEO_CODEC,
$format_setting,
);
my $bitrate_setting = ($FORMAT eq RESOLUTION_SD)
? 2000
: 4000;
$control->send_config(
$driver->ARDRONE_CONFIG_VIDEO_BITRATE,
$bitrate_setting,
);
my $fps = $FPS;
if( $fps > $driver->ARDRONE_CONFIG_VIDEO_MAX_FPS ) {
warn "*** Max FPS is " . $driver->ARDRONE_CONFIG_VIDEO_MAX_FPS . "\n";
$fps = $driver->ARDRONE_CONFIG_VIDEO_MAX_FPS;
}
elsif( $fps < $driver->ARDRONE_CONFIG_VIDEO_MIN_FPS ) {
warn "*** Min FPS is " . $driver->ARDRONE_CONFIG_VIDEO_MIN_FPS . "\n";
$fps = $driver->ARDRONE_CONFIG_VIDEO_MIN_FPS;
}
$control->send_config(
$driver->ARDRONE_CONFIG_VIDEO_CODEC_FPS,
$fps,
);
return 1;
}
sub set_comm_watchdog
{
my ($driver, $cv) = @_;
my $commwatch_timer; $commwatch_timer = AnyEvent->timer(
after => 1,
interval => 1.5,
cb => sub {
$driver->at_comwdg;
$commwatch_timer;
},
);
return 1;
}
{
my $cv = AnyEvent->condvar;
my $events = UAV::Pilot::Events->new({
condvar => $cv,
});
my $ardrone_class = $FILE_IN
? 'UAV::Pilot::ARDrone::Driver::Mock'
: 'UAV::Pilot::ARDrone::Driver';
my $ardrone = $ardrone_class->new({
host => $IP,
});
$ardrone->connect;
set_comm_watchdog( $ardrone, $cv );
my $easy_event = UAV::Pilot::EasyEvent->new({
condvar => $cv,
});
my $dev = UAV::Pilot::ARDrone::Control->new({
driver => $ardrone,
user_id => $CONFIG_USER_ID,
app_id => $CONFIG_APP_ID,
session_id => $CONFIG_SESSION_ID,
});
set_driver_config( $dev, $ardrone, $easy_event );
$dev->setup_read_nav_event( $easy_event ) unless $FILE_IN;
my $sdl_events = UAV::Pilot::SDL::Events->new;
$events->register( $sdl_events );
my $window = UAV::Pilot::SDL::Window->new;
my $vid_display = UAV::Pilot::SDL::Video->new;
my @displays = ($vid_display);
my @h264_handlers = (UAV::Pilot::Video::H264Decoder->new({
displays => \@displays,
}));
$vid_display->add_to_window( $window );
my $fh = undef;
if( $FILE_OUT ) {
open( $fh, '>', $FILE_OUT ) or die "Can't open file '$FILE_OUT': $!\n";
my $file_handler = UAV::Pilot::Video::FileDump->new({
fh => $fh,
});
push @h264_handlers, $file_handler;
}
$events->register( $window );
set_reticle_overlay( $displays[0], $window ) if $RETICLE;
my %video_args = (
handlers => \@h264_handlers,
condvar => $cv,
driver => $ardrone,
);
my $driver_video = $FILE_IN
? UAV::Pilot::ARDrone::Video::Mock->new({
%video_args,
file => $FILE_IN,
})
: UAV::Pilot::ARDrone::Video->new( \%video_args );
$dev->video( $driver_video );
say "Running . . .";
$_->init_event_loop for $driver_video, $events;
$cv->recv;
close $fh if defined $fh;
}
__END__
=head1 SYNOPSIS
uav_video_display \
--host 192.168.1.1 \
--in /path/to/file \
--reticle \
--camera=front \
--format=hd \
--fps=30
=head1 DESCRIPTION
Shows a video stream from the UAV in an SDL window. If the C<--in> option is specified
with a file, plays the stream from that file instead of connecting to the UAV.
=head1 OPTIONS
=head2 --reticle
Overlay a targeting reticle.
=head2 --camera
Set to C<front> or C<bottom> for the associated camera. (Default: front)
=head2 --format
Set to C<hd> (720p resolution) or C<sd> (360p resolution). (Default: hd)
=head2 --fps
Set to the desired framerate. Max fps on the Parrot AR.Drone is 30. (Default: 30)
=cut
bin/uav_video_dump view on Meta::CPAN
#!/usr/bin/perl
# Copyright (c) 2014 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
use v5.14;
use warnings;
use IO::Socket::INET;
use UAV::Pilot;
use UAV::Pilot::Video::FileDump;
use AnyEvent;
use Getopt::Long;
my %UAV_TYPES = (
'ARDrone' => \&init_ardrone,
'WumpusRover' => \&init_wumpus_rover,
);
my $HOST = '192.168.1.1';
my $FILE_OUT = '';
my $FILE_IN = '';
my $UAV_TYPE = 'ARDrone';
my $SINGLE_FRAMES = 0;
Getopt::Long::GetOptions(
'host=s' => \$HOST,
'out=s' => \$FILE_OUT,
'in=s' => \$FILE_IN,
'uav=s' => \$UAV_TYPE,
'single-frames' => \$SINGLE_FRAMES,
);
die "'$UAV_TYPE' is not a valid UAV. Valid types are: "
. join( ', ', sort keys %UAV_TYPES ) . "\n"
unless exists $UAV_TYPES{$UAV_TYPE};
my $init_sub = $UAV_TYPES{$UAV_TYPE};
$SIG{'INT'} = 'cleanup';
END { cleanup() }
my ($driver_video, $file_dump, $start_time);
sub init_ardrone
{
my ($cv, $file_dump) = @_;
eval '
use UAV::Pilot::ARDrone::Driver;
use UAV::Pilot::ARDrone::Driver::Mock;
use UAV::Pilot::ARDrone::Video;
use UAV::Pilot::ARDrone::Video::Mock;
'; die $@ if $@;
my $driver_class = $FILE_IN
? 'UAV::Pilot::ARDrone::Driver::Mock'
: 'UAV::Pilot::ARDrone::Driver';
my $ardrone = $driver_class->new({
host => $HOST,
});
my %video_args = (
handlers => [ $file_dump ],
condvar => $cv,
driver => $ardrone,
);
my $driver_video = $FILE_IN
? UAV::Pilot::ARDrone::Video::Mock->new({
%video_args,
file => $FILE_IN,
})
: UAV::Pilot::ARDrone::Video->new( \%video_args );
$driver_video->init_event_loop;
return $driver_video
}
sub init_wumpus_rover
{
my ($cv, $file_dump) = @_;
eval '
use UAV::Pilot::WumpusRover::Driver;
use UAV::Pilot::WumpusRover::Driver::Mock;
use UAV::Pilot::WumpusRover::Video;
use UAV::Pilot::WumpusRover::Video::Mock;
'; die $@ if $@;
my $driver_class = $FILE_IN
? 'UAV::Pilot::WumpusRover::Driver::Mock'
: 'UAV::Pilot::WumpusRover::Driver';
my $wumpus = $driver_class->new({
host => $HOST,
});
my %video_args = (
handlers => [ $file_dump ],
condvar => $cv,
driver => $wumpus,
);
my $driver_video = $FILE_IN
? UAV::Pilot::WumpusRover::Video::Mock->new({
%video_args,
file => $FILE_IN,
})
: UAV::Pilot::WumpusRover::Video->new( \%video_args );
$driver_video->init_event_loop;
return $driver_video
}
my $cleanup_done = 0;
sub cleanup
{
return if $cleanup_done;
my $end_time = time;
if( defined $driver_video ) {
my $num_frames = $driver_video->frames_processed;
warn "Frames processed: $num_frames \n";
my $duration = $end_time - $start_time;
my $fps = $num_frames / $duration;
warn "FPS: $fps\n";
}
$file_dump->close if defined $file_dump;
$cleanup_done = 1;
exit;
}
{
my $cv = AnyEvent->condvar;
$file_dump = UAV::Pilot::Video::FileDump->new({
file => $FILE_OUT,
single_frame => 1,
});
$driver_video = $init_sub->( $cv, $file_dump );
$start_time = time;
$cv->recv;
}
__END__
=head1 SYNOPSIS
uav_video_dump --out /path/to/out_video.h264
=head1 DESCRIPTION
Reads the video stream from the Parrot AR.Drone and puts it in a file.
If the C<--out> parameter is not specified, it will dump to C<STDOUT>. In theory, something
like the below should show the video stream in real time:
uav_video_dump | vlc -
But it hasn't worked for me yet. I'd be interested in comments/patches from anybody who
figures it out.
VLC seems to guess the FPS of the h264 stream correctly. Mplayer doesn't seem to, and will
show a streaky mess when it guesses wrong. The FPS setting will depend on your AR.Drone's
configuration. You can try 30. Set it in mplayer with:
mplayer -fps 30 /path/to/video.h264
If you want to know the exact value, you can telnet into your AR.Drone (after connecting
to it on wifi, of course) and cat the file C</data/config.ini>. The setting will be
under the C<[video]> section with the key C<codec_fps>.
=cut
bin/wumpusrover_client_example view on Meta::CPAN
#!/usr/bin/perl
# Copyright (c) 2014 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
use v5.14;
use warnings;
use AnyEvent;
use UAV::Pilot::EasyEvent;
use UAV::Pilot::WumpusRover;
use UAV::Pilot::WumpusRover::Driver;
use UAV::Pilot::WumpusRover::Control::Event;
use Getopt::Long ();
my $PORT = UAV::Pilot::WumpusRover;
my $HOST = '10.0.0.16';
Getopt::Long::GetOptions(
'port=i' => \$PORT,
'host=s' => \$HOST,
);
my $driver = UAV::Pilot::WumpusRover::Driver->new({
host => $HOST,
port => $PORT,
});
$driver->connect;
my $cv = AnyEvent->condvar;
my $event = UAV::Pilot::EasyEvent->new({
condvar => $cv,
});
my $control = UAV::Pilot::WumpusRover::Control::Event->new({
driver => $driver,
});
$control->init_event_loop( $cv, $event );
$control->throttle( 100 );
$control->turn( 10 );
$cv->recv;
name = UAV-Pilot
author = Timm Murray <tmurray@wumpus-cave.net>
license = BSD
copyright_holder = Timm Murray
version = 1.3
[PkgVersion]
[GatherDir]
[Manifest]
[MakeMaker]
[Prereqs]
namespace::autoclean = 0
AnyEvent = 0
AnyEvent::ReadLine::Gnu = 0
DateTime = 0
File::HomeDir = 0
File::ShareDir = 0
File::Spec = 0
File::Temp = 0
IO::Socket::Multicast = 0
Log::Log4perl = 0
Math::Trig = 0
Moose = 0
MooseX::Event = 0
String::CRC32 = 0
Test::More = 0
Throwable = 0
YAML = 0
[Prereqs / RuntimeRecommends]
Getopt::Long = 0
UAV::Pilot::SDL = 0
UAV::Pilot::Video::Ffmpeg = 0
[Prereqs / TestRequires]
Test::Pod = 0
[MetaResources]
homepage = http://www.wumpus-cave.net
repository.web = https://github.com/frezik/UAV-Pilot
repository.type = git
[ExecDir]
dir = bin
[MetaJSON]
[TestRelease]
[ConfirmRelease]
[UploadToCPAN]
lib/UAV/Pilot.pm view on Meta::CPAN
# Copyright (c) 2015 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
package UAV::Pilot;
$UAV::Pilot::VERSION = '1.3';
use v5.14;
use Moose;
use namespace::autoclean;
use File::Spec;
use File::ShareDir;
use File::HomeDir;
use Log::Log4perl;
use constant DIST_NAME => 'UAV-Pilot';
use constant LOG_CONF_FILE => 'log4perl.conf';
our $LOG_WAS_INITD = 0;
# ABSTRACT: Base library for controlling UAVs
sub default_module_dir
{
my ($class) = @_;
my $dir = File::ShareDir::dist_dir( $class->DIST_NAME );
return $dir;
}
sub default_config_dir
{
my ($class) = @_;
my $dir = File::HomeDir->my_dist_config( $class->DIST_NAME, {
create => 1,
});
return $dir,
}
sub init_log
{
my ($class) = @_;
return if $LOG_WAS_INITD;
my $conf_dir = $class->default_config_dir;
my $log_conf = File::Spec->catfile( $conf_dir, $class->LOG_CONF_FILE );
$class->_make_default_log_conf( $log_conf ) if ! -e $log_conf;
Log::Log4perl::init( $log_conf );
return 1;
}
sub checksum_fletcher8
{
my ($class, @bytes) = @_;
my $ck_a = 0;
my $ck_b = 0;
foreach (@bytes) {
$ck_a = ($ck_a + $_) & 0xFF;
$ck_b = ($ck_b + $ck_a) & 0xFF;
}
return ($ck_a, $ck_b);
}
sub convert_32bit_LE
{
my ($class, @bytes) = @_;
my $val = $bytes[0]
| ($bytes[1] << 8)
| ($bytes[2] << 16)
| ($bytes[3] << 24);
return $val;
}
sub convert_16bit_LE
{
my ($class, @bytes) = @_;
my $val = $bytes[0] | ($bytes[1] << 8);
return $val;
}
sub convert_32bit_BE
{
my ($class, @bytes) = @_;
my $val = ($bytes[0] << 24)
| ($bytes[1] << 16)
| ($bytes[2] << 8)
| $bytes[3];
return $val;
}
sub convert_16bit_BE
{
my ($class, @bytes) = @_;
my $val = ($bytes[0] << 8) | $bytes[1];
return $val;
}
sub _make_default_log_conf
{
my ($class, $out_file) = @_;
open( my $out, '>', $out_file )
or die "Can't open [$out_file] for writing: $!\n";
print $out "log4j.rootLogger=WARN, A1\n";
print $out "log4j.appender.A1=Log::Log4perl::Appender::Screen\n";
print $out "log4j.appender.A1.layout=org.apache.log4j.PatternLayout\n";
print $out "log4j.appender.A1.layout.ConversionPattern="
. '%-4r [%t] %-5p %c %t - %m%n' . "\n";
close $out;
return 1;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 NAME
UAV::Pilot - Base library for controlling UAVs
=head1 DESCRIPTION
This library does not support controlling any UAVs on its own. Rather, it
provides the basic support for implementing other UAV libraries, much the same
way DBI provides support for implementing different database drivers.
If you would like to control the Parrot AR.Drone, you should also install
C<UAV::Pilot::ARDrone>, and probably C<UAV::Pilot::SDL> and
C<UAV::Pilot::Video::Ffmpeg> as well.
=head1 LICENSE
Copyright (c) 2014 Timm Murray
All rights reserved.
Redistribution and use in source and binary forms, with or without modification, are
permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this list of
conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice, this list of
conditions and the following disclaimer in the documentation and/or other materials
provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
=cut
lib/UAV/Pilot/Commands.pm view on Meta::CPAN
# Copyright (c) 2015 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
package UAV::Pilot::Commands;
$UAV::Pilot::Commands::VERSION = '1.3';
use v5.14;
use Moose;
use namespace::autoclean;
use File::Spec;
use constant MOD_PREFIX => 'UAV::Pilot';
use constant MOD_SUFFIX => 'Commands';
has 'lib_dirs' => (
is => 'ro',
isa => 'ArrayRef[Str]',
traits => [ 'Array' ],
default => sub {[]},
handles => {
add_lib_dir => 'push',
},
);
has 'condvar' => (
is => 'ro',
isa => 'AnyEvent::CondVar',
);
has 'controller_callback_ardrone' => (
is => 'ro',
isa => 'CodeRef',
);
has 'controller_callback_wumpusrover' => (
is => 'ro',
isa => 'CodeRef',
);
has 'quit_subs' => (
traits => ['Array'],
is => 'ro',
isa => 'ArrayRef[CodeRef]',
default => sub {[]},
handles => {
'_push_quit_sub' => 'push',
},
);
our $s;
#
# Sole command that can run without loading other libraries
#
sub load ($;$)
{
my ($mod_name, $args) = @_;
$$args{condvar} = $s->condvar unless exists $$args{condvar};
$s->load_lib( $mod_name, $args );
}
sub run_cmd
{
my ($self, $cmd) = @_;
if( (! defined $self) && (! ref($self)) ) {
# Must be called with a $self, not directly via package
return 0;
}
return 1 unless defined $cmd;
$s = $self;
eval $cmd;
die $@ if $@;
return 1;
}
sub quit
{
my ($self) = @_;
$_->() for @{ $self->{quit_subs} };
return 1;
}
sub load_lib
{
my ($self, $mod_name, $args) = @_;
my $dest_namespace = delete $args->{namespace} // 'UAV::Pilot::Commands';
# This works via the hooks placed into @INC array, which is documented
# in perlfunc under the require() entry. In short, we can stick a
# subref in @INC and mess around with how Perl loads up the module.
# By choosing the starting text, we can control the exact namespace
# where the module will end up.
my @orig_inc = @INC;
local @INC = (
$self->_get_load_module_sub( $dest_namespace, \@orig_inc ),
@INC,
);
my $full_mod_name = $self->MOD_PREFIX
. '::' . $mod_name
. '::' . $self->MOD_SUFFIX;
eval "require $full_mod_name";
die "Could not load $mod_name: $@" if $@;
if( my $call = $dest_namespace->can( 'uav_module_init' ) ) {
$call->( $dest_namespace, $self, $args );
# Clear uav_module_init. Would prefer a solution without
# eval( STRING ), though a symbol table manipulation method may be
# considered just as evil.
my $del_str = 'delete $' . $dest_namespace . '::{uav_module_init}';
eval $del_str;
}
if( my $quit_call = $dest_namespace->can( 'uav_module_quit' ) ) {
$self->_push_quit_sub( $quit_call );
}
# If we want to reload the module, we need to delete its entry from the
# %INC cache
my @mod_name_components = split /::/, $full_mod_name;
my $mod_name_path = File::Spec->catfile( @mod_name_components ) . '.pm';
delete $INC{$mod_name_path};
return 1;
}
sub _get_load_module_sub
{
my ($self, $dest_namespace, $inc) = @_;
my $init_source = "package $dest_namespace;";
my $sub = sub {
my ($this_sub, $file) = @_;
my @return;
foreach (@$inc) {
my $full_path = File::Spec->catfile( $_, $file );
if( -e $full_path ) {
open( my $in, '<', $full_path )
or die "Can't open '$full_path': $!\n";
@return = (
\$init_source,
$in,
);
last;
}
}
return @return;
};
return $sub;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 NAME
UAV::Pilot::Commands
=head1 SYNOPSIS
my $device; # Some UAV::Pilot::Control instance, defined elsewhere
my $cmds = UAV::Pilot::Commands->new({
device => $device,
controller_callback_ardrone => \&make_ardrone_controller,
controller_callback_wumpusrover => \&make_wumpusrover_controller,
});
$cmds->load_lib( 'ARDrone' );
$cmds->run_cmd( 'takeoff;' );
$cmds->run_cmd( 'land;' );
=head1 DESCRIPTION
Provides an interface for loading UAV extensions and running them, particularly for
REPL shells.
=head1 METHODS
=head2 new
new({
condvar => $cv,
controller_callback_ardrone => sub { ... },
controller_callback_wumpusrover => sub { .. },
})
Constructor. The C<condvar> parameter is an C<AnyEvent::Condvar>.
The C<controller_callback_*> parameters take a sub ref. The subroutines take
a the parameters C<($cmd, $cv, $easy_event)>, where C<$cmd> is this
C<UAV::Pilot::Commands> instance, C<$cv> is the condvar passed above, and
C<$easy_event> is an C<UAV::Pilot::EasyEvent> instance. It should return a
C<UAV::Pilot::Control> object of the associated type (generally one of the
C<*::Event> types with C<init_event_loop()> called).
Note that this API is likely to change to a factory pattern in the near future.
=head2 load_lib
load_lib( 'ARDrone', {
pack => 'AR',
})
Loads an extension by name. The C<pack> paramter will load the library into a specific
namespace. If you don't specify it, you won't need to qualify commands with a namespace
prefix. Example:
load_lib( 'ARDrone', { pack => 'AR' } );
run_cmd( 'takeoff;' ); # Error: no subroutine named 'takeoff'
run_cmd( 'AR::takeoff;' ); # This works
load_lib( 'ARDrone' );
run_cmd( 'takeoff;' ); # Now this works, too
Any other parmaeters you pass will be passed to the module's C<uav_module_init()>
subroutine.
=head2 run_cmd
run_cmd( 'takeoff;' )
Executes a command. Note that this will execute arbitrary Perl statements.
=head1 COMMANDS
Commands provide an easy interface for writing simple UAV programms in a REPL shell.
They are usually thin interfaces over a L<UAV::Pilot::Control>. If you're writing a
complicated script, it's suggested that you skip this interface and write to the
L<UAV::Pilot::Control> directly.
=head2 load
load 'ARDrone', {
namespace => 'AR',
};
Direct call to C<load_lib>. The C<namespace> paramter will load the library
into a specific namespace. If you don't specify it, you won't need to qualify
commands with a namespace prefix. Example:
load 'ARDrone', { namespace => 'AR' };
takeoff; # Error: no subroutine named 'takeoff'
AR::takeoff; # This works
load ARDrone;
takeoff; # Now this works, too
Any other parmaeters you pass will be passed to the module's
C<uav_module_init()> subroutine.
=head1 WRITING YOUR OWN EXTENSIONS
When calling C<load_lib( 'Foo' )>, we look for C<UAV::Pilot::Foo::Commands>
in the current C<@INC>.
You write them much like any Perl module, but don't use a C<package>
statement--the package will be controlled by C<UAV::Pilot::Command> when
loaded. Like a Perl module, it should return true as its final statement
(put a C<1;> at the end).
Likewise, be careful not to make any assumptions about what package you're in.
Modules may or may not get loaded into different, arbitrary packages.
For ease of use, it's recommended to use function prototypes to reduce the need
for parens.
The method C<uav_module_init()> is called with the package name as the first
argument. Subsquent arguments will be the hashref passed to
C<load()/load_lib()>. After being called, this sub will be deleted from the
package.
The method C<uav_module_quit()> is called when the REPL is closing.
lib/UAV/Pilot/Control.pm view on Meta::CPAN
# Copyright (c) 2015 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
package UAV::Pilot::Control;
$UAV::Pilot::Control::VERSION = '1.3';
use v5.14;
use Moose::Role;
has 'driver' => (
is => 'ro',
does => 'UAV::Pilot::Driver',
);
1;
__END__
=head1 NAME
UAV::Pilot::Control
=head1 DESCRIPTION
Role for high-level interfaces to drones. External programs should usually write against a
module that does this role.
=head1 ATTRIBUTES
=head2 driver
Instantiated C<UAV::Pilot::Driver> object.
=cut
lib/UAV/Pilot/ControlHelicopter.pm view on Meta::CPAN
# Copyright (c) 2015 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
package UAV::Pilot::ControlHelicopter;
$UAV::Pilot::ControlHelicopter::VERSION = '1.3';
use v5.14;
use Moose::Role;
with 'UAV::Pilot::Control';
requires 'takeoff';
1;
__END__
=head1 NAME
UAV::Pilot::ControlHelicopter
=head1 DESCRIPTION
Role for any type of helicopter UAV. This may include traditional monoprops,
or more modern multipods.
Does the C<UAV::Pilot::Control> role.
Requires the method C<takeoff()>.
=cut
lib/UAV/Pilot/ControlRover.pm view on Meta::CPAN
# Copyright (c) 2015 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
package UAV::Pilot::ControlRover;
$UAV::Pilot::ControlRover::VERSION = '1.3';
use v5.14;
use Moose::Role;
with 'UAV::Pilot::Control';
requires 'throttle';
requires 'turn';
1;
__END__
=head1 NAME
UAV::Pilot::ControlRover
=head1 DESCRIPTION
Role for any kind of ground vehicle.
Does the C<UAV::Pilot::Control> role.
Requires the methods C<throttle( $throttle )> and C<turn( $turn )>.
=cut
lib/UAV/Pilot/Driver.pm view on Meta::CPAN
# Copyright (c) 2015 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
package UAV::Pilot::Driver;
$UAV::Pilot::Driver::VERSION = '1.3';
use v5.14;
use Moose::Role;
1;
__END__
=head1 NAME
UAV::Pilot::Driver
=head1 DESCRIPTION
This is a role for a low-level interface to a given UAV. These are primarily for those
developing the C<UAV::Pilot> API against a new UAV. Programmers seeking to use an existing
UAV should look at L<UAV::Pilot::Control>.
lib/UAV/Pilot/EasyEvent.pm view on Meta::CPAN
# Copyright (c) 2015 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
package UAV::Pilot::EasyEvent;
$UAV::Pilot::EasyEvent::VERSION = '1.3';
use v5.14;
use Moose;
use namespace::autoclean;
#with 'MooseX::Clone';
use constant {
UNITS_MILLISECOND => 0,
};
has 'condvar' => (
is => 'ro',
isa => 'AnyEvent::CondVar',
);
has '_timers' => (
traits => [ 'Array' ],
is => 'ro',
isa => 'ArrayRef[HashRef[Any]]',
default => sub { [] },
handles => {
_add_timer => 'push',
},
);
has '_events' => (
traits => [ 'Hash' ],
is => 'ro',
isa => 'HashRef[ArrayRef[HashRef[Item]]]',
default => sub { {} },
handles => {
'_set_event_callbacks' => 'set',
'_event_type_exists' => 'exists',
'_get_event_callbacks' => 'get',
},
);
sub add_timer
{
my ($self, $args) = @_;
my $duration = $$args{duration};
my $duration_units = $$args{duration_units};
my $callback = $$args{cb};
my $true_time = $self->_convert_time_units( $duration, $duration_units );
my $new_self = ref($self)->new({
condvar => $self->condvar,
});
$self->_add_timer({
time => $true_time,
cb => $callback,
child_events => $new_self,
});
return $new_self;
}
sub add_event
{
my ($self, $name, $callback, $is_oneoff) = @_;
$is_oneoff //= 0;
my @callbacks;
if( $self->_event_type_exists( $name ) ) {
@callbacks = @{ $self->_get_event_callbacks( $name ) };
}
else {
@callbacks = ();
}
push @callbacks, {
callback => $callback,
is_one_off => $is_oneoff,
};
$self->_set_event_callbacks( $name => \@callbacks );
return 1;
}
sub send_event
{
my ($self, $name, @args) = @_;
my $callbacks = $self->_get_event_callbacks( $name );
return 1 unless defined $callbacks;
my @callbacks = (@$callbacks);
my $is_callbacks_changed = 0;
foreach my $i (0 .. $#callbacks) {
# Always modify the *original* arrayref $callbacks here, not the
# copy @callbacks. If we splice out a one-off, @callbacks will be
# changed and the index will be off.
my $cb = $callbacks->[$i]{callback};
my $is_one_off = $callbacks->[$i]{is_one_off};
$cb->(@args);
if( $is_one_off ) {
splice @callbacks, $i, 1;
$is_callbacks_changed = 1;
}
}
$self->_set_event_callbacks( $name => \@callbacks) if $is_callbacks_changed;
return 1;
}
sub init_event_loop
{
my ($self) = @_;
foreach my $timer_def (@{ $self->_timers }) {
my $timer; $timer = AnyEvent->timer(
after => $timer_def->{time},
cb => sub {
$timer_def->{cb}->();
$timer_def->{child_events}->init_event_loop;
$timer;
},
);
}
return 1;
}
sub _convert_time_units
{
my ($self, $time, $unit) = @_;
if( $self->UNITS_MILLISECOND == $unit ) {
$time /= 1000;
}
return $time;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 NAME
UAV::Pilot::EasyEvent
=head1 SYNOPSIS
my $cv = AnyEvent->condvar;
my $event = UAV::Pilot::EasyEvent->new({
condvar => $cv,
});
my @events;
my $event2 = $event->add_timer({
duration => 100,
duration_units => $event->UNITS_MILLISECOND,
cb => sub {
push @events => 'First event',
},
})->add_timer({
duration => 10,
duration_units => $event->UNITS_MILLISECOND,
cb => sub {
push @events => 'Second event',
},
});
$event2->add_timer({
duration => 50,
duration_units => $event->UNITS_MILLISECOND,
cb => sub {
push @events => 'Fourth event',
$cv->send;
},
});
$event2->add_timer({
duration => 10,
duration_units => $event->UNITS_MILLISECOND,
cb => sub {
push @events => 'Third event',
},
});
$event->init_event_loop;
$cv->recv;
# After time passes, prints:
# First event
# Second event
# Third event
# Fourth event
#
say $_ for @events;
=head1 DESCRIPTION
C<AnyEvent> is the standard event framework used for C<UAV::Pilot>. However, its
interface isn't convenient for some of the typical things done for UAV piloting. For
instance, to put the code into plain English, we might want to say:
Takeoff, wait 5 seconds, then pitch forward for 2 seconds, then pitch backwards
for 2 seconds, then land
In the usual C<AnyEvent> interface, this requires building the timers inside the callbacks
of other timers, which leads to several levels of indentation. C<UAV::Pilot::EasyEvent>
simplifies the handling and syntax of this kind of event workflow.
=head1 METHODS
=head2 new
new({
condvar => $cv,
})
Constructor. The C<condvar> argument should be an C<AnyEvent::CondVar>.
=head2 add_timer
add_timer({
duration => 100,
duration_units => $event->UNITS_MILLISECOND,
cb => sub { ... },
})
Add a timer to run in the event loop. It will run after C<duration> units of time, with
the units specified by C<duration_units>. The C<cb> parameter is a reference to a
subroutine to use as a callback.
Returns a child C<EasyEvent> object. When the timer above has finished, any timers on
child objects will be setup for execution. This makes it easy to chain timers to run
after each other.
=head2 init_event_loop
This method must be called after running a series of C<add_timer()> calls. You only need
to call this on the root object, not the children.
You must call C<recv> on the C<condvar> yourself.
=head1 add_event
add_event( 'foo', sub {...}, 0 )
Add a subref that will be called when the named event is fired off. The
first parameter is the name of the event, and the second is the subref.
The third is optional, and specifies if the call will be a "one-off" or not.
If it's a one-off, then after the first call to the sub, it will be removed
from list of callbacks. Defaults to false.
The callback will receive the arguments that were passed to C<send_event()>
when the event is triggered.
=head1 send_event
send_event( 'foo', @args )
Trigger an event with the given name. The first arg is the name of the event.
All subsequent args will be passed to the callbacks attached to that event
name.
=cut
lib/UAV/Pilot/EventHandler.pm view on Meta::CPAN
# Copyright (c) 2015 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
package UAV::Pilot::EventHandler;
$UAV::Pilot::EventHandler::VERSION = '1.3';
use v5.14;
use Moose::Role;
requires 'process_events';
1;
__END__
=head1 NAME
UAV::Pilot::EventHandler
=head1 DESCRIPTION
Role for objects that will be passed into C<UAV::Pilot::Events>.
Requires the method C<process_events>, which will be called to handle the events for this
object.
=cut
lib/UAV/Pilot/Events.pm view on Meta::CPAN
# Copyright (c) 2015 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
package UAV::Pilot::Events;
$UAV::Pilot::Events::VERSION = '1.3';
use v5.14;
use Moose;
use namespace::autoclean;
use AnyEvent;
use UAV::Pilot::EventHandler;
use constant TIMER_INTERVAL => 1 / 60;
has 'condvar' => (
is => 'ro',
isa => 'AnyEvent::CondVar',
);
has '_handlers' => (
traits => ['Array'],
is => 'ro',
isa => 'ArrayRef[UAV::Pilot::EventHandler]',
default => sub {[]},
handles => {
register => 'push',
},
);
sub init_event_loop
{
my ($self) = @_;
my $timer; $timer = AnyEvent->timer(
after => 1,
interval => $self->TIMER_INTERVAL,
cb => sub {
$_->process_events for @{ $self->_handlers };
$timer;
},
);
return 1;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 NAME
UAV::Pilot::Events
=head1 SYNOPSIS
my $condvar = AnyEvent->condvar;
my $events = UAV::Pilot::Events->new({
condvar => $condvar,
});
$events->register( ... );
$events->init_event_loop;
$condvar->recv;
=head1 DESCRIPTION
Handles event loops on a regular timer.
=head1 METHODS
=head2 new
new({
condvar => $cv,
})
Constructor. The C<condvar> argument is an C<AnyEvent::Condvar>.
=head2 register
register( $event_handler )
Adds a object that does the C<UAV::Pilot::EventHandler> role to the list. The
C<process_events> method on that object will be called each time the event loop runs.
=head2 init_event_loop
Sets up the event loop. Note that you must still call C<recv> on the C<AnyEvent::Condvar>
to start the loop running.
=cut
lib/UAV/Pilot/Exceptions.pm view on Meta::CPAN
# Copyright (c) 2015 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
package UAV::Pilot::Exception;
$UAV::Pilot::Exception::VERSION = '1.3';
use v5.14;
use Moose;
use namespace::autoclean;
with 'Throwable';
has 'error' => (
is => 'rw',
isa => 'Str',
);
sub to_string
{
my ($self) = @_;
return $self->error;
}
no Moose;
__PACKAGE__->meta->make_immutable;
package UAV::Pilot::NumberOutOfRangeException;
$UAV::Pilot::NumberOutOfRangeException::VERSION = '1.3';
use v5.14;
use Moose;
use namespace::autoclean;
extends 'UAV::Pilot::Exception';
no Moose;
__PACKAGE__->meta->make_immutable;
package UAV::Pilot::IOException;
$UAV::Pilot::IOException::VERSION = '1.3';
use v5.14;
use Moose;
use namespace::autoclean;
extends 'UAV::Pilot::Exception';
no Moose;
__PACKAGE__->meta->make_immutable;
package UAV::Pilot::FileNotFoundException;
$UAV::Pilot::FileNotFoundException::VERSION = '1.3';
use v5.14;
use Moose;
use namespace::autoclean;
extends 'UAV::Pilot::IOException';
has 'file' => (
is => 'ro',
isa => 'Str',
);
no Moose;
__PACKAGE__->meta->make_immutable;
package UAV::Pilot::CommandNotFoundException;
$UAV::Pilot::CommandNotFoundException::VERSION = '1.3';
use v5.14;
use Moose;
use namespace::autoclean;
extends 'UAV::Pilot::IOException';
has 'cmd' => (
is => 'ro',
isa => 'Str',
);
no Moose;
__PACKAGE__->meta->make_immutable;
package UAV::Pilot::NavPacketException::BadHeader;
$UAV::Pilot::NavPacketException::BadHeader::VERSION = '1.3';
use v5.14;
use Moose;
use namespace::autoclean;
extends 'UAV::Pilot::Exception';
has 'got_header' => (
is => 'ro',
isa => 'Int',
);
no Moose;
__PACKAGE__->meta->make_immutable;
package UAV::Pilot::VideoException;
$UAV::Pilot::VideoException::VERSION = '1.3';
use v5.14;
use Moose;
use namespace::autoclean;
extends 'UAV::Pilot::Exception';
no Moose;
__PACKAGE__->meta->make_immutable;
package UAV::Pilot::ArdupilotPacketException::BadHeader;
$UAV::Pilot::ArdupilotPacketException::BadHeader::VERSION = '1.3';
use v5.14;
use Moose;
use namespace::autoclean;
extends 'UAV::Pilot::Exception';
has 'got_header' => (
is => 'ro',
isa => 'Int',
);
no Moose;
__PACKAGE__->meta->make_immutable;
package UAV::Pilot::ArdupilotPacketException::BadChecksum;
$UAV::Pilot::ArdupilotPacketException::BadChecksum::VERSION = '1.3';
use v5.14;
use Moose;
use namespace::autoclean;
extends 'UAV::Pilot::Exception';
has 'got_checksum1' => (
is => 'ro',
isa => 'Int',
);
has 'got_checksum2' => (
is => 'ro',
isa => 'Int',
);
has 'expected_checksum1' => (
is => 'ro',
isa => 'Int',
);
has 'expected_checksum2' => (
is => 'ro',
isa => 'Int',
);
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 NAME
UAV::Pilot::Exceptions
=head1 DESCRIPTION
Exceptions that could be thrown by C<UAV::Pilot> modules. All inherit from
C<UAV::Pilot::Exception>, which does the role C<Throwable>.
=head1 EXCEPTIONS
=head2 UAV::Pilot::NumberOutOfRangeException
=head2 UAV::Pilot::IOException
=head2 UAV::Pilot::CommandNotFoundException
=head2 UAV::Pilot::NavPacketException::BadHeader
=head2 UAV::Pilot::VideoException
=head2 UAV::Pilot::ArdupilotPacketException::BadHeader
=head2 UAV::Pilot::ArdupilotPacketException::BadChecksum
=cut
lib/UAV/Pilot/Logger.pm view on Meta::CPAN
# Copyright (c) 2015 Timm Murray
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
package UAV::Pilot::Logger;
$UAV::Pilot::Logger::VERSION = '1.3';
use v5.14;
use Moose::Role;
use UAV::Pilot;
use Log::Log4perl;
my $LOGGER = undef;
sub _logger
{
my ($class) = @_;
return $LOGGER if defined $LOGGER;
UAV::Pilot->init_log;
return Log::Log4perl->get_logger( $class->_logger_name );
}
sub _logger_name
{
my ($self) = @_;
return ref $self;
}
1;
__END__
=head1 NAME
UAV::Pilot::Logger
=head1 DESCRIPTION
A Moose role for C<UAV::Pilot> classes that want to log things.
Provides the attribute C<_logger>, which returns a C<Log::Log4perl::Logger> for
your object.
Also provides a method C<_logger_name> for fetching the logger name. This will
be your class's name by default. Override as you see fit.
=cut
( run in 0.959 second using v1.01-cache-2.11-cpan-283623ac599 )