lib/Quancom.pm
changeset 7 9c3e112933ae
parent 4 6f1e9c4bee3c
child 8 c248fbd9b624
equal deleted inserted replaced
6:cfc898fd62f1 7:9c3e112933ae
     1 package Quancom;
     1 package Quancom;
     2 
     2 
     3 use strict;
     3 use strict;
     4 use warnings;
     4 use warnings;
       
     5 use Carp;
     5 use IO::Socket::INET;
     6 use IO::Socket::INET;
       
     7 
     6 use Quancom::Result;
     8 use Quancom::Result;
     7 use Carp;
       
     8 
     9 
     9 our $VERSION = 0.1;
    10 our $VERSION = 0.1;
    10 
    11 
    11 my $DEFAULT_PORT = 1001;
    12 my $DEFAULT_PORT = 1001;
    12 
    13 
    22         Proto    => "tcp",
    23         Proto    => "tcp",
    23         PeerAddr => $self->{peer}
    24         PeerAddr => $self->{peer}
    24     );
    25     );
    25 
    26 
    26     $self->{job} = 0;
    27     $self->{job} = 0;
    27     $self->{ok} = undef;
    28     $self->{ok}  = undef;
    28 
    29 
    29     return $self;
    30     return $self;
    30 }
    31 }
    31 
    32 
    32 sub last_result { $_[0]->{last_result} }
    33 sub last_result { $_[0]->{last_result} }
    55 
    56 
    56 sub _rx {
    57 sub _rx {
    57     my $self = shift;
    58     my $self = shift;
    58 
    59 
    59     local $/ = "\r";    # CR is the delimiter
    60     local $/ = "\r";    # CR is the delimiter
    60     my $r = $self->{socket}->getline;    # now it's a line
    61     $self->{last_result} = new Quancom::Result($self->{socket}->getline);
    61     chomp($r);                           # we do not need the delimiter
       
    62 
       
    63     $self->{last_result} = new Quancom::Result;
       
    64 
       
    65     # decode the status
       
    66     if (($self->{last_result}{error_code}) = $r =~ /^E(.)/) {
       
    67         $self->{last_result}{ok} = 0;
       
    68     }
       
    69     elsif (my ($jobid, $data, $csum) = $r =~ /^[DO](..)(.*)(..)$/) {
       
    70         $self->{last_result}{ok} = 1;
       
    71 	$self->{last_result}{result} = defined $data ? $data : "";
       
    72     }
       
    73     else {
       
    74         die "unknown response $r";
       
    75     }
       
    76 
       
    77     return $r;
       
    78 }
    62 }
    79 
       
    80 
    63 
    81 1;
    64 1;
    82 
    65 
    83 __END__
    66 __END__
    84 
    67 
    88 
    71 
    89 =head1 SYNOPSIS
    72 =head1 SYNOPSIS
    90 
    73 
    91     use Quancom;
    74     use Quancom;
    92 
    75 
    93     my $q = new Quancom 172.16.0.22;
    76     my $quancom = new Quancom 172.16.0.22;
    94     my $r = $q->cmd("xxxxxx") 
    77     my $result  = $q->cmd("xxxxxx");
    95 	or die $r->error_message;
    78     if ($result->error) { die $result->error_message } 
       
    79     else { print $result->data }
       
    80 
    96 
    81 
    97 =head1 METHODS
    82 =head1 METHODS
    98 
    83 
    99 =over
    84 =over
   100 
    85 
   101 =item constructor B<new>( I<ip> )
    86 =item constructor B<new>( I<ip> )
   102 
    87 
   103 This method returns a new Quancom object if the connection was
    88 This method returns a new Quancom object if the connection was
   104 successfully established.
    89 successfully established.
   105 
    90 
   106 =item B<send>( I<string> )
    91 =item B<cmd>( I<string> )
   107 
    92 
   108 Send a Quancom string to the device. The string here should be
    93 Send a Quancom string to the device. The string here should be
   109 B<without> the leading STX and Jobid as well without the trailing CR.
    94 B<without> the leading STX and Jobid as well without the trailing CR.
       
    95 It returns a L<Quancom::Result> object.
   110 
    96 
   111 It returns TRUE on success, FALSE otherwise.
    97 The only tested I<string> is currently "WB0101FF", which should set
       
    98 all bits on the first relais. Some other (untested) string for setting
       
    99 just the lowest bit on the first relais should be "WB010001".
   112 
   100 
   113 =item B<last_result>( )
   101 =item B<last_result>( )
   114 
   102 
   115 This returns an object containing the last result.
   103 This returns an object containing the last result.
       
   104 See L<Quancom::Result> for more information.
   116 
   105 
   117 =back
   106 =back
       
   107 
       
   108 =head1 MORE EXAMPLES
       
   109 
       
   110     use Quancom;
       
   111     my $quancom = new Quancom(172.20.20.1);
       
   112     die "Sorry" if $quancom->cmd("xxxx")->error;
       
   113 
       
   114 =head1 SEE ALSO
       
   115 
       
   116 L<Quancom::Result>
   118 
   117 
   119 =head1 AUTHOR
   118 =head1 AUTHOR
   120 
   119 
   121     Maik Schueller
   120     Maik Schueller
   122     Heiko Schlittermann
   121     Heiko Schlittermann