#!/usr/local/bin/perl5.6.1 -w
# $Id: Cypher.pm,v 1.1 2003/10/21 15:42:03 jx1 Exp $

package Cypher;

use strict;
use warnings;
use Carp qw(croak cluck carp);
use Data::Dumper;

use IO::Socket::INET;

use constant PORT => 200;
use constant RESP_HEADR_SZ =>16;
use constant COMMAND => { status => 'status',
			  rackid => 'barcode',
			  tubeids => 'get',
			};  
use constant STATUS => { norack => 'Waiting',
			 newrack => 'Ready',
			 oldrack => 'Finished',
			 busy => 'Busy',
		       };

my $remote_host = "DummyHost";
my %connected; #{hostname=>port};


####    object tester    ####
unless( caller )
{
    use Cypher;
    
    my $bcReader = Cypher::new( host => 'ABgene38' );

    $bcReader -> getStatus();
    
    my $rackid;
    eval
    { 
	$rackid = $bcReader -> readRackId()
    };

    if( $@ )
    {
	print "I see. Will try again.\n";
    }

    if( $rackid =~ /No/ )
    {
	print "Rack on the scanner: $rackid\n";
	croak "No rack on the scanner or scanner has been switched off.\n";
    }

    eval
    {
	$bcReader -> readTubeIDs()	
    };

    if( $@ )
    {
	print "I see. Will try again.\n";
    }
}

sub new
{
     my $invocant = shift;
     my $class = ref($invocant) || $invocant;

     $remote_host = shift;
     my $self = {
                 host => $remote_host,
		 port => PORT,
		 @_,
	     };


     if( exists $connected{ $self->{host} } ) 
     {
	 die "$self->{host}:$self->{port} is busy.\n";
     }

     my $socket = IO::Socket::INET->new( PeerAddr => $self->{host},
					 PeerPort => $self->{port},
					 Proto    => "tcp",
					 Type     => SOCK_STREAM )
           or die "Couldn't connect to $self->{host}:$self->{port} : $@\n";


     # read initial response and 
     # check if the socket is already engaged
     my $response = Cypher::readResponse $socket;
     if( $response =~ /busy/ )
     {
	 close $socket;
	 chomp( $response );
	 $response =~ s/\r//;
	 croak "$response\n";
     }

     print "Socket created.\n";
     $connected{$self->{host}} = PORT;

     
     # check Cypher status
     my $status = Cypher::checkStatus $socket;
     

     # add socket and Cypher status to self hash
     $self->{socket} = $socket;
     $self->{status} = $status;


     bless $self;
     return $self;
}


sub getStatus
{
    my $self = shift;
 
    my $socket = $self->{socket}; 
    print $socket COMMAND->{status};

    my $response = Cypher::readResponse( $socket );
    $self->{status} = $response;

    #if( $^W )
    {
	print "ABgene Cypher status: $response\n";
    }
    return $self->{status};
}


sub readRackId
{
    my $self = shift;
    my $socket = $self->{socket};

    my $cstatus = $self->getStatus();
    if( $cstatus eq STATUS->{norack} )
    {
	croak "No rack on scanner.\n";
    }

    if( $cstatus eq STATUS->{busy} )
    {
	#if( $^W )
	{
	    print "Scanner seems busy decoding ...\n";
	}
	croak "Scanner software is busy. Try again later.\n";
    }
    
    print $socket COMMAND->{rackid};
    
    return Cypher::readResponse $socket;
}


sub readTubeIDs
{
    my $self = shift;
    my $socket = $self->{socket};

    my $status = Cypher::checkStatus $socket;

    if( $status eq STATUS->{norack} )
    {
	croak "No rack on the scanner.\n";
    }
#    elsif( $status eq STATUS->{oldrack} )
#    {
#	croak "Rack already been scanned.\n";
#    }

    print $socket COMMAND->{tubeids};
    Cypher::readResponse $socket;

    #sleep 3;
    return Cypher::readResponse $socket;
}


sub delete
{
    my $self = shift;
    my $socket = $self->{socket};
    close($socket);

    delete( $connected{$self->{host}} );
}


sub DESTROY
{
    my $self = shift;
    my $socket = $self->{socket};
    close($socket);

    delete( $connected{$self->{host}} );
}


## --- private procedures --- ##

sub readResponse
{
    my $resp_hdr;
    my $byte_read;
    my $response;

    my $socket = shift;

    $byte_read = read( $socket, $resp_hdr, RESP_HEADR_SZ);
    print "$resp_hdr\n";

    $byte_read = read( $socket, $response, $resp_hdr*1);
    #print "$response\n";
 
    return $response;
}


sub checkStatus
{
    my $socket = shift;
    print $socket COMMAND->{status};
    
    my $response = readResponse $socket;
    
    return $response;
}

1; # Keep perl happy
