Quancom.pm
changeset 4 6f1e9c4bee3c
parent 3 200d69222aed
child 5 1aa41c487e44
--- a/Quancom.pm	Tue Dec 09 15:58:11 2008 +0100
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,121 +0,0 @@
-package Quancom;
-
-use strict;
-use warnings;
-use IO::Socket::INET;
-use Quancom::Result;
-
-my $DEFAULT_PORT = 1001;
-
-sub new {
-    my $class = ref $_[0] ? ref shift : shift;
-    my $self = bless {} => $class;
-
-    $self->{peer} = shift;
-    $self->{peer} .= ":$DEFAULT_PORT"
-      unless $self->{peer} =~ /:\d+$/;
-
-    $self->{socket} = new IO::Socket::INET(
-        Proto    => "tcp",
-        PeerAddr => $self->{peer}
-    );
-
-    $self->{job} = 0;
-    $self->{ok} = undef;
-
-    return $self;
-}
-
-sub last_result { $_[0]->{last_result} }
-
-sub cmd {
-    my $self = shift;
-    my $cmd  = shift;
-
-    $self->_tx($cmd);
-    $self->_rx($cmd);
-
-    return $self->{last_result};
-}
-
-sub _tx {
-    my $self = shift;
-    my $cmd  = shift;
-
-    $self->{job} = ++$self->{job} % 255;    # cap the job id on 255;
-    $cmd = "\x02" . sprintf("%02x", $self->{job}) . $cmd;   # add STX and job id
-    $cmd .= sprintf("%02x", unpack("%8C*", $cmd));          # add checksum
-
-    warn "sending $cmd | " . unpack("H*", $cmd) . "\n";
-    $self->{socket}->print($cmd . "\r");
-}
-
-sub _rx {
-    my $self = shift;
-
-    local $/ = "\r";    # CR is the delimiter
-    my $r = $self->{socket}->getline;    # now it's a line
-    chomp($r);                           # we do not need the delimiter
-
-    $self->{last_result} = new Quancom::Result;
-
-    # decode the status
-    if (($self->{last_result}{error_code}) = $r =~ /^E(.)/) {
-        $self->{last_result}{ok} = 0;
-    }
-    elsif (my ($jobid, $data, $csum) = $r =~ /^[DO](..)(.*)(..)$/) {
-        $self->{last_result}{ok} = 1;
-	$self->{last_result}{result} = defined $data ? $data : "";
-    }
-    else {
-        die "unknown response $r";
-    }
-
-    return $r;
-}
-
-
-1;
-
-__END__
-
-=head1 NAME
-
-Quancom - perl module to access the usb opto quancom device
-
-=head1 SYNOPSIS
-
-    use Quancom;
-
-    my $q = new Quancom 172.16.0.22;
-    my $r = $q->cmd("xxxxxx") 
-	or die $r->error_message;
-
-=head1 METHODS
-
-=over
-
-=item constructor B<new>( I<ip> )
-
-This method returns a new Quancom object if the connection was
-successfully established.
-
-=item B<send>( I<string> )
-
-Send a Quancom string to the device. The string here should be
-B<without> the leading STX and Jobid as well without the trailing CR.
-
-It returns TRUE on success, FALSE otherwise.
-
-=item B<last_result>( )
-
-This returns an object containing the last result.
-
-=back
-
-=head1 AUTHOR
-
-    Maik Schueller
-    Heiko Schlittermann
-
-=cut