Quancom.pm
changeset 2 a19ea3b8c48d
parent 0 a900786f2174
child 3 200d69222aed
equal deleted inserted replaced
1:1caa457b59d0 2:a19ea3b8c48d
    18         Proto    => "tcp",
    18         Proto    => "tcp",
    19         PeerAddr => $self->{peer}
    19         PeerAddr => $self->{peer}
    20     );
    20     );
    21 
    21 
    22     $self->{job} = 0;
    22     $self->{job} = 0;
       
    23     $self->{ok} = undef;
    23 
    24 
    24     return $self;
    25     return $self;
    25 }
    26 }
    26 
    27 
    27 sub cmd {
    28 sub cmd {
    28     my $self = shift;
    29     my $self = shift;
    29     my $cmd  = shift;
    30     my $cmd  = shift;
    30 
    31 
    31     $self->_tx($cmd);
    32     $self->_tx($cmd);
    32     $self->_rx($cmd);
    33     $self->_rx($cmd);
       
    34 
       
    35     return $self->{ok};
       
    36 }
       
    37 
       
    38 
       
    39 sub status {
       
    40     my $self = shift;
       
    41     return $self->{ok};
       
    42 }
       
    43 
       
    44 sub result {
       
    45     my $self = shift;
       
    46     return undef if not $self->{ok};
       
    47     return $self->{result};
       
    48 }
       
    49 
       
    50 sub error {
       
    51     my $self = shift;
       
    52     return undef if $self->{ok};
       
    53     return $self->{error_code};
       
    54 }
       
    55 
       
    56 sub error_message {
       
    57     my $self = shift;
       
    58 
       
    59     return undef if !@_ and $self->{ok};
       
    60 
       
    61     return ("checksum error", "character error", "invalid command",
       
    62         "invalid width")[ @_ ? $_[0] : $self->{error_code} ];
    33 }
    63 }
    34 
    64 
    35 sub _tx {
    65 sub _tx {
    36     my $self = shift;
    66     my $self = shift;
    37     my $cmd  = shift;
    67     my $cmd  = shift;
    44     $self->{socket}->print($cmd . "\r");
    74     $self->{socket}->print($cmd . "\r");
    45 }
    75 }
    46 
    76 
    47 sub _rx {
    77 sub _rx {
    48     my $self = shift;
    78     my $self = shift;
    49     local $/ = "\r";
    79 
    50     my $r = $self->{socket}->getline;
    80     local $/ = "\r";    # CR is the delimiter
    51     chomp($r);
    81     my $r = $self->{socket}->getline;    # now it's a line
       
    82     chomp($r);                           # we do not need the delimiter
       
    83 
       
    84     # decode the status
       
    85     if (($self->{error_code}) = $r =~ /^E(.)/) {
       
    86         $self->{ok} = 0;
       
    87     }
       
    88     elsif (my ($jobid, $data, $csum) = $r =~ /^[DO](..)(.*)(..)$/) {
       
    89         $self->{ok} = 1;
       
    90 	$self->{result} = defined $data ? $data : "";
       
    91     }
       
    92     else {
       
    93         die "unknown response $r";
       
    94     }
       
    95 
    52     return $r;
    96     return $r;
    53 }
    97 }
       
    98 
       
    99 1;
       
   100 
       
   101 __END__
       
   102 
       
   103 =head1 NAME
       
   104 
       
   105 Quancom - perl module to access the usb opto quancom device
       
   106 
       
   107 =head1 SYNOPSIS
       
   108 
       
   109     use Quancom;
       
   110 
       
   111     my $q = new Quancom 172.16.0.22;
       
   112     $q->cmd("xxxxxx") 
       
   113 	or die $q->error_message;
       
   114 
       
   115 =head1 METHODS
       
   116 
       
   117 =over
       
   118 
       
   119 =item constructor B<new>( I<ip> )
       
   120 
       
   121 This method returns a new Quancom object if the connection was
       
   122 successfully established.
       
   123 
       
   124 =item B<send>( I<string> )
       
   125 
       
   126 Send a Quancom string to the device. The string here should be
       
   127 B<without> the leading STX and Jobid as well without the trailing CR.
       
   128 
       
   129 It returns TRUE on success, FALSE otherwise.
       
   130 
       
   131 =item B<status> ( )
       
   132 
       
   133 Use this method to query the last operations status.
       
   134 
       
   135 =item B<result> ( )
       
   136 
       
   137 Returns the last result. This is valid only if the last status is ok,
       
   138 otherwise you'll get "undef".
       
   139 
       
   140 =item B<error_message> ( [I<error code>] )
       
   141 
       
   142 Returns a message describing the last error. Of if you pass an error
       
   143 code it will the return the associated message.
       
   144 
       
   145 =item B<error> ( )
       
   146 
       
   147 Returns the last error code (numerical).
       
   148 
       
   149 =back
       
   150 
       
   151 =head1 AUTHOR
       
   152 
       
   153     Maik Schueller
       
   154     Heiko Schlittermann
       
   155 
       
   156 =cut