Robotics/lib/Robotics.pm
package Robotics;
use warnings;
use strict;
use Carp;
use Moose;
use MooseX::StrictConstructor;
#use Module::Pluggable::Object; # maybe in future
use IO::Socket;
use YAML::XS;
our @Devices = (
"Robotics::Tecan",
"Robotics::Fialab"
);
has 'alias' => ( is => 'rw' );
has 'device' => ( is => 'rw' );
has 'devices' => (
traits => ['Hash'],
is => 'rw',
isa => 'HashRef[Str]',
default => sub { {} },
);
=head1 NAME
Robotics - Robotics hardware control and abstraction
=head1 VERSION
Version 0.23
=cut
our $VERSION = '0.23';
=head1 SYNOPSIS
Provides local communication to robotics hardware devices, related
peripherals, or network communication to these devices. Also
provides a high-level, object oriented software interface to
abstract the low level robotics commands or low level robotics
hardware. Environmental configuration is provided with a
configuration file in YAML format. Allows other hardware device
drivers to be plugged into this module.
Simple examples are provided in the examples/ directory of the
distribution.
Nominclature note: The name "Robotics" is used in full, rather than
"Robot", to distinguish mechanical robots from the many
internet-spidering software modules or software user agents commonly
(and erroneously) referred to as "robots". Robotics has motors;
both the internet & software do not!
=cut
# Application should always perform device probing as first thing,
# so this is done as 'new'
sub BUILD {
my ($self, $params) = @_;
if ($self->device()) {
print STDOUT "Setting up ". $self->device(). "\n";
}
else {
$self->probe();
}
}
sub probe {
my ($self, $params) = @_;
print STDOUT "Searching for locally connected robotics devices\n";
# Find Tecan Gemini, EVO, Genesis, ...
my $this = shift;
my %device_tree;
$self->devices( \%device_tree );
for my $class ( @Robotics::Devices ) {
warn "Loading $class\n";
if ( _try_load($class) ) {
my $result = $class->probe();
if (defined($result)) {
$self->devices->{$class} = $result;
#$list{$class} = $result;
}
}
else {
die "should not get here; could not load ".
"Robotics::Device subclass $class\n\n\n$@";
}
}
# Add other robotics systems here
# TODO Perhaps scan serial ports using Hardware::PortScanner
}
sub printDevices {
my ($self, $params) = @_;
my $yamlstring;
if ($self->devices() ) {
$yamlstring = "\n".YAML::XS::Dump( $self->devices() );
}
return $yamlstring;
}
sub findDevice {
my ($self, %params) = @_;
my $root;
my $want = $params{"product"} || return "";
$root = $params{root};
if (!$root) {
$root = $self->devices();
}
for my $key (keys %{$root}) {
if ($key =~ /$want/) {
return $root->{$key};
}
else {
my $val;
eval {
if (keys %{$root->{$key}}) {
$val = $self->findDevice(
root => $root->{$key},
%params);
if (defined($val)) {
return $val;
}
}
};
if ($val) {
return $val;
}
}
}
return undef;
}
=secret
# see example from File::ChangeNotify
my $finder =
Module::Pluggable::Object->new( search_path => 'Robotics::Device' );
=cut
sub _try_load
{
my $class = shift;
eval { Class::MOP::load_class($class) };
my $e = $@;
die $e if $e && $e !~ /Can\'t locate/;
return $e ? 0 : 1;
}
sub configure {
my $self = shift;
my $infile = shift || croak "cant open configuration file";
open(IN, $infile) || return 1;
my $s = do { local $/ = <IN> };
$self->{CONFIG} = YAML::XS::Load($s) || return 2;
warn "Configuring from $infile\n";
my $root;
my $model;
for $root (keys %{$self->{CONFIG}}) {
if ($root =~ m/tecan/i) {
warn "Configuring $root\n";
for $model (keys %{$self->{CONFIG}->{$root}}) {
warn "Configuring $model\n";
if ($model =~ m/genesis/i) {
Robotics::Tecan::Genesis::configure(
$self, $self->{CONFIG}->{$root}->{$model});
}
}
}
elsif ($root =~ m/objects/i) {
die "Configuring $root\n";
#Robotics::Objects::configure($self, $self->{CONFIG}->{$root});
}
}
return 0;
}
# Convert well string to well number
# Returns:
# >0 well number if success
# 0 if error
#
sub convertWellStringToNumber {
my $s = $_[0]; # string
my $size = $_[1] || 96; # size of plate
my $orient = $_[2] || "L"; # orientation of plate
my $row = substr($s, 0, 1);
my $col = substr($s, 1);
$row = ord($row) - 64;
if ($row < 0 || $row > 16) {
warn "not a well string, '$s'";
return $s;
}
if ($col > 12 && $size == 96) {
warn "bad well string $s";
return 0;
}
if ($col > 24 && $size == 384) {
warn "bad well string $s";
return 0;
}
if ($size == 96) {
if ($orient eq "L") {
return ($col - 1) * 8 + $row;
}
elsif ($orient eq "P") {
return ($row - 1) * 12 + $col;
}
else {
warn "bad well string $s\n";
return 0;
}
}
if ($size == 384) {
if ($orient eq "L") {
return ($col - 1) * 16 + $row;
}
elsif ($orient eq "P") {
return ($row - 1) * 24 + $col;
}
else {
warn "bad well string $s\n";
return 0;
}
}
}
# Convert well number to well (x,y) number
# Returns:
# well array (x,y) if success
# 0 if error
#
sub convertWellNumberToXY {
return convertWellStringToXY(
convertWellNumberToString(@_));
}
# Convert well string to well (x,y) number
# Returns:
# well array (x,y) if success
# 0 if error
#
sub convertWellStringToXY {
my $s = $_[0]; # string
my $size = $_[1] || 96; # size of plate
my $orient = $_[2] || "L"; # orientation of plate
my $row = substr($s, 0, 1);
my $col = substr($s, 1);
$row = ord($row) - 64;
if ($row < 0 || $row > 16) {
warn "not a well string, '$s'";
return $s;
}
if ($col > 12 && $size == 96) {
warn "bad well string $s";
return 0;
}
if ($col > 24 && $size == 384) {
warn "bad well string $s";
return 0;
}
if ($size == 96) {
if ($orient eq "L") {
return ($col, $row);
}
elsif ($orient eq "P") {
return ($row, $col);
}
else {
warn "bad well string $s\n";
return 0;
}
}
if ($size == 384) {
if ($orient eq "L") {
return ($col, $row);
}
elsif ($orient eq "P") {
return ($row, $col);
}
else {
warn "bad well string $s\n";
return 0;
}
}
}
# Convert well number to well string
# Returns:
# string if success
# "" if error
#
sub convertWellNumberToString {
my $n = $_[0]; # number
my $size = $_[1] || 96; # size of plate
my $orient = $_[2] || "L"; # Landscape or Portrait orientation
my $col;
my $row;
my $s;
if ($n < 1) {
warn "not a well number '$n'";
return $n;
}
elsif ($n <= 96 && $size == 96) {
if ($orient eq "P") {
$row = int(($n - 1) / 12) + 1;
$col = ($n - (($col - 1) * 12));
}
elsif ($orient eq "L") {
$col = int(($n-1) / 8) + 1;
$row = ($n - (($col - 1) * 8));
}
if ($row == 0) { $row = 8; }
$s = chr(64+$row); # I bet no one has EBCDIC anymore
}
elsif ($n <= 384 && $size == 384) {
if ($orient eq "P") {
$row = int(($n-1) / 24) + 1;
$col = ($n - (($col - 1) * 24));
}
elsif ($orient eq "L") {
$col = int(($n-1) / 16) + 1;
$row = ($n - (($col - 1) * 16));
}
if ($row == 0) { $row = 16; }
$s = chr(64+$row);
}
else {
warn "bad well number '$n'\n";
}
$s .= $col;
return $s;
}
=head1 EXPORT
No exported functions
=head1 FUNCTIONS
=head2 new
Probes the local machine for connected hardware and returns the
device tree.
=head2 configure
Loads configuration data into memory.
=item pathname of configuration file in YAML format
Returns:
0 if success,
1 if file error,
2 if configuration error.
=head2 convertWellStringToNumber
Helper function.
Converts a microtiter plate well string (such as "B7")
to a well number (such as 39), depending on
plate size and plate orientation. Well #1 is defined
as "A1".
Arguments:
=item Well String. Should be in the range: "A1" .. [total size of plate]
=item Size of plate (number of wells). Example: 96 or 384.
Default is 96.
=item Orientation of plate, either "L" for landscape
or "P" for portrait (default "L"). Landscape means, when
looking at the plate on a table, the coordinates are defined
for the long side running left-to-right, and the beginning
row is the furthest away.
Returns:
=item Number > 0 (such as 43), if success.
=item 0, if error.
=head2 convertWellNumberToString
Helper function.
Converts a microtiter plate well number (such as 54)
to a co-ordinate string (such as "D5"), depending on
plate size and plate orientation. Well #1 is defined
as "A1".
Arguments:
=item Well number. Should be in the range: 1 .. [total size]
=item Size of plate (number of wells). Example: 96 or 384.
Default is 96.
=item Orientation of plate, either "L" for landscape
or "P" for portrait (default "L"). Landscape means, when
looking at the plate on a table, the coordinates are defined
for the long side running left-to-right.
Returns:
=item String (such as "A1"), if success.
=item Null string, if error.
=head2 convertWellStringToXY
Converts a microtiter plate well string (such as "E8") to an
(x,y) coordinate array (such as (5,6)).
Arguments:
=item Well coordinate string. The top left well is
defined as A1.
=item Size of plate (number of wells). Example: 96 or 384.
Default is 96.
=item Orientation of plate, either "L" for landscape
or "P" for portrait (default "L"). Landscape means, when
looking at the plate on a table, the coordinates are defined
for the long side running left-to-right, and the beginning
row is the furthest away.
Returns:
=item Array (such as (8,8)), if success.
=item 0, if error.
=head2 convertWellNumberToXY
Uses the other convertWell functions to convert a
well number (1 .. (total size)) into (x,y) coordinates.
See previous functions for args and return values.
=head1 AUTHOR
Jonathan Cline, C<< <jcline at ieee.org> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-robotics at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Robotics>. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Robotics
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Robotics>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Robotics>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/Robotics>
=item * Search CPAN
L<http://search.cpan.org/dist/Robotics/>
=back
=head1 ACKNOWLEDGEMENTS
=head1 COPYRIGHT & LICENSE
Copyright 2009 Jonathan Cline.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
no Moose;
__PACKAGE__->meta->make_immutable;
1; # End of Robotics
__END__