# HG changeset patch # User Heiko Schlittermann # Date 1229553099 -3600 # Node ID 9c3e112933ae9b2c2da20a475411b1dd20a93c15 # Parent cfc898fd62f10feae8990d514c953c1518b92cf1 Reviewed doc and example. Now the example show some more use case (but it's a wrong case anyway;) and the documentation for the Quancom::Result-Class is more specific. Needs testing. diff -r cfc898fd62f1 -r 9c3e112933ae .perltidyrc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.perltidyrc Wed Dec 17 23:31:39 2008 +0100 @@ -0,0 +1,1 @@ +--paren-tightness=2 diff -r cfc898fd62f1 -r 9c3e112933ae examples/.perltidyrc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/.perltidyrc Wed Dec 17 23:31:39 2008 +0100 @@ -0,0 +1,1 @@ +../.perltidyrc \ No newline at end of file diff -r cfc898fd62f1 -r 9c3e112933ae examples/example --- a/examples/example Tue Dec 16 16:08:43 2008 +0100 +++ b/examples/example Wed Dec 17 23:31:39 2008 +0100 @@ -4,18 +4,23 @@ use warnings; use Quancom; use Data::Dumper; - +# use blib; MAIN: { my $q = new Quancom $ARGV[0]; my $r; - # $r = $q->cmd("WB0101FF"); - $r = $q->cmd("WB010001"); # sollte(!) gehen - print $r->error_message, "\n" if $r->error; + + # switch on/off all lights on the first relais + $r = $q->cmd("WB0100FF"); + print $r->ok ? $r->data : $r->error, "\n"; - print $r->ok; - print $q->last_result->ok; + sleep 1; + $r = $q->cmd("WB010000"); + print $r->ok ? $r->data : $r->error, "\n"; + sleep 1; + $r = $q->cmd("WB010001"); # 1 bit setzen + print $r->ok ? $r->data : $r->error, "\n"; } diff -r cfc898fd62f1 -r 9c3e112933ae lib/.perltidyrc --- a/lib/.perltidyrc Tue Dec 16 16:08:43 2008 +0100 +++ b/lib/.perltidyrc Wed Dec 17 23:31:39 2008 +0100 @@ -1,1 +1,1 @@ ---paren-tightness=2 +../.perltidyrc \ No newline at end of file diff -r cfc898fd62f1 -r 9c3e112933ae lib/Quancom.pm --- a/lib/Quancom.pm Tue Dec 16 16:08:43 2008 +0100 +++ b/lib/Quancom.pm Wed Dec 17 23:31:39 2008 +0100 @@ -2,9 +2,10 @@ use strict; use warnings; +use Carp; use IO::Socket::INET; + use Quancom::Result; -use Carp; our $VERSION = 0.1; @@ -24,7 +25,7 @@ ); $self->{job} = 0; - $self->{ok} = undef; + $self->{ok} = undef; return $self; } @@ -57,27 +58,9 @@ 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; + $self->{last_result} = new Quancom::Result($self->{socket}->getline); } - 1; __END__ @@ -90,9 +73,11 @@ use Quancom; - my $q = new Quancom 172.16.0.22; - my $r = $q->cmd("xxxxxx") - or die $r->error_message; + my $quancom = new Quancom 172.16.0.22; + my $result = $q->cmd("xxxxxx"); + if ($result->error) { die $result->error_message } + else { print $result->data } + =head1 METHODS @@ -103,19 +88,33 @@ This method returns a new Quancom object if the connection was successfully established. -=item B( I ) +=item B( I ) Send a Quancom string to the device. The string here should be B the leading STX and Jobid as well without the trailing CR. +It returns a L object. -It returns TRUE on success, FALSE otherwise. +The only tested I is currently "WB0101FF", which should set +all bits on the first relais. Some other (untested) string for setting +just the lowest bit on the first relais should be "WB010001". =item B( ) This returns an object containing the last result. +See L for more information. =back +=head1 MORE EXAMPLES + + use Quancom; + my $quancom = new Quancom(172.20.20.1); + die "Sorry" if $quancom->cmd("xxxx")->error; + +=head1 SEE ALSO + +L + =head1 AUTHOR Maik Schueller diff -r cfc898fd62f1 -r 9c3e112933ae lib/Quancom/Result.pm --- a/lib/Quancom/Result.pm Tue Dec 16 16:08:43 2008 +0100 +++ b/lib/Quancom/Result.pm Wed Dec 17 23:31:39 2008 +0100 @@ -5,7 +5,23 @@ sub new { my $class = ref $_[0] ? ref shift : shift; - return bless {} => $class; + my $self = bless {} => $class; + my $r = shift; + $r = s/\s*$//; # should match any \r or \n too + + # decode the status + if (($self->{error_code}) = $r =~ /^E(.)/) { + $self->{ok} = 0; + } + elsif (my ($jobid, $data, $csum) = $r =~ /^[DO](..)(.*)(..)$/) { + $self->{ok} = 1; + $self->{data} = defined $data ? $data : ""; + } + else { + die "unknown response $r"; + } + + return $self; } sub ok { @@ -13,7 +29,7 @@ return $self->{ok}; } -sub result { +sub data { my $self = shift; return undef if not $self->{ok}; return $self->{result}; @@ -21,8 +37,7 @@ sub error { my $self = shift; - return undef if $self->{ok}; - return $self->{error_code}; + return $self->{ok} ? undef : $self->{error_code}; } sub error_message { @@ -46,34 +61,44 @@ use Quancom; - my $q = new Quancom 172.16.0.22; - my $r = $q->cmd("xxxxxx") - or die $r->error_message; + my $quancom = new Quancom 172.16.0.22; + my $result = $q->cmd("xxxxxx"); + + if ($result->error) { die $result->error_message } + else { print $result->data, "\n" } =head1 METHODS =over -=item B ( ) +=item constructor B ( ) -Use this method to query the last operations status. +Probably you'll never use this. -=item B ( ) +=item B ( ) Returns the last result. This is valid only if the last status is ok, otherwise you'll get "undef". +=item B ( ) + +Returns the error code - if any - or 'undef' if there was no error. + =item B ( [I] ) Returns a message describing the last error. Of if you pass an error code it will the return the associated message. -=item B ( ) +=item B ( ) -Returns the last error code (numerical). +Use this method to query the last operations status. =back +=head1 SEE ALSO + +L + =head1 AUTHOR Maik Schueller