398 |
sub writechunk |
sub writechunk |
399 |
{ |
{ |
400 |
my $str=shift; |
my $str=shift; |
|
warn "DEBUG: ", as_hex($str); |
|
401 |
my $count = $port->write($str); |
my $count = $port->write($str); |
402 |
my $len = length($str); |
my $len = length($str); |
403 |
die "wrong write length $count != $len in ",as_hex( $str ) if $count != $len; |
die "wrong write length $count != $len in ",as_hex( $str ) if $count != $len; |
439 |
sub assert { |
sub assert { |
440 |
my ( $from, $to ) = @_; |
my ( $from, $to ) = @_; |
441 |
|
|
442 |
|
return unless $assert->{expect}; |
443 |
|
|
444 |
$from ||= 0; |
$from ||= 0; |
445 |
$to = length( $assert->{expect} ) if ! defined $to; |
$to = length( $assert->{expect} ) if ! defined $to; |
446 |
|
|
518 |
} sort { length($a) <=> length($b) } keys %$dispatch; |
} sort { length($a) <=> length($b) } keys %$dispatch; |
519 |
warn "?? payload dispatch to ",dump( $payload, $dispatch, $to ) if $debug; |
warn "?? payload dispatch to ",dump( $payload, $dispatch, $to ) if $debug; |
520 |
|
|
521 |
if ( defined $to ) { |
if ( defined $to && $payload ) { |
522 |
my $rest = substr( $payload, length($to) ); |
my $rest = substr( $payload, length($to) ); |
523 |
warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug; |
warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug; |
524 |
$dispatch->{ $to }->( $rest ); |
$dispatch->{ $to }->( $rest ); |