ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Handle.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.60 by root, Thu Jun 5 18:30:08 2008 UTC vs.
Revision 1.61 by root, Fri Jun 6 10:23:50 2008 UTC

105C<croak>. 105C<croak>.
106 106
107=item on_read => $cb->($handle) 107=item on_read => $cb->($handle)
108 108
109This sets the default read callback, which is called when data arrives 109This sets the default read callback, which is called when data arrives
110and no read request is in the queue. 110and no read request is in the queue (unlike read queue callbacks, this
111callback will only be called when at least one octet of data is in the
112read buffer).
111 113
112To access (and remove data from) the read buffer, use the C<< ->rbuf >> 114To access (and remove data from) the read buffer, use the C<< ->rbuf >>
113method or access the C<$handle->{rbuf}> member directly. 115method or access the C<$handle->{rbuf}> member directly.
114 116
115When an EOF condition is detected then AnyEvent::Handle will first try to 117When an EOF condition is detected then AnyEvent::Handle will first try to
228 230
229 $self->{_activity} = AnyEvent->now; 231 $self->{_activity} = AnyEvent->now;
230 $self->_timeout; 232 $self->_timeout;
231 233
232 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 234 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
233 $self->on_read (delete $self->{on_read} ) if $self->{on_read};
234 235
235 $self 236 $self
236} 237}
237 238
238sub _shutdown { 239sub _shutdown {
476 my ($self, $string) = @_; 477 my ($self, $string) = @_;
477 478
478 sprintf "%d:%s,", (length $string), $string 479 sprintf "%d:%s,", (length $string), $string
479}; 480};
480 481
482=item packstring => $format, $data
483
484An octet string prefixed with an encoded length. The encoding C<$format>
485uses the same format as a Perl C<pack> format, but must specify a single
486integer only (only one of C<cCsSlLqQiInNvVjJw> is allowed, plus an
487optional C<!>, C<< < >> or C<< > >> modifier).
488
489=cut
490
491register_write_type packstring => sub {
492 my ($self, $format, $string) = @_;
493
494 pack "$format/a", $string
495};
496
481=item json => $array_or_hashref 497=item json => $array_or_hashref
482 498
483Encodes the given hash or array reference into a JSON object. Unless you 499Encodes the given hash or array reference into a JSON object. Unless you
484provide your own JSON object, this means it will be encoded to JSON text 500provide your own JSON object, this means it will be encoded to JSON text
485in UTF-8. 501in UTF-8.
553enough is there) from the read buffer (C<< $handle->rbuf >>) if you want 569enough is there) from the read buffer (C<< $handle->rbuf >>) if you want
554or not. 570or not.
555 571
556In the more complex case, you want to queue multiple callbacks. In this 572In the more complex case, you want to queue multiple callbacks. In this
557case, AnyEvent::Handle will call the first queued callback each time new 573case, AnyEvent::Handle will call the first queued callback each time new
558data arrives and removes it when it has done its job (see C<push_read>, 574data arrives (also the first time it is queued) and removes it when it has
559below). 575done its job (see C<push_read>, below).
560 576
561This way you can, for example, push three line-reads, followed by reading 577This way you can, for example, push three line-reads, followed by reading
562a chunk of data, and AnyEvent::Handle will execute them in order. 578a chunk of data, and AnyEvent::Handle will execute them in order.
563 579
564Example 1: EPP protocol parser. EPP sends 4 byte length info, followed by 580Example 1: EPP protocol parser. EPP sends 4 byte length info, followed by
634 650
635 if (my $cb = shift @{ $self->{_queue} }) { 651 if (my $cb = shift @{ $self->{_queue} }) {
636 unless ($cb->($self)) { 652 unless ($cb->($self)) {
637 if ($self->{_eof}) { 653 if ($self->{_eof}) {
638 # no progress can be made (not enough data and no data forthcoming) 654 # no progress can be made (not enough data and no data forthcoming)
639 return $self->_error (&Errno::EPIPE, 1); 655 $self->_error (&Errno::EPIPE, 1), last;
640 } 656 }
641 657
642 unshift @{ $self->{_queue} }, $cb; 658 unshift @{ $self->{_queue} }, $cb;
643 last; 659 last;
644 } 660 }
645 } elsif ($self->{on_read}) { 661 } elsif ($self->{on_read}) {
662 last unless $len;
663
646 $self->{on_read}($self); 664 $self->{on_read}($self);
647 665
648 if ( 666 if (
649 $len == length $self->{rbuf} # if no data has been consumed 667 $len == length $self->{rbuf} # if no data has been consumed
650 && !@{ $self->{_queue} } # and the queue is still empty 668 && !@{ $self->{_queue} } # and the queue is still empty
651 && $self->{on_read} # but we still have on_read 669 && $self->{on_read} # but we still have on_read
652 ) { 670 ) {
653 # no further data will arrive 671 # no further data will arrive
654 # so no progress can be made 672 # so no progress can be made
655 return $self->_error (&Errno::EPIPE, 1) 673 $self->_error (&Errno::EPIPE, 1), last
656 if $self->{_eof}; 674 if $self->{_eof};
657 675
658 last; # more data might arrive 676 last; # more data might arrive
659 } 677 }
660 } else { 678 } else {
854 872
855sub unshift_read_line { 873sub unshift_read_line {
856 my $self = shift; 874 my $self = shift;
857 $self->unshift_read (line => @_); 875 $self->unshift_read (line => @_);
858} 876}
859
860=item netstring => $cb->($handle, $string)
861
862A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
863
864Throws an error with C<$!> set to EBADMSG on format violations.
865
866=cut
867
868register_read_type netstring => sub {
869 my ($self, $cb) = @_;
870
871 sub {
872 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
873 if ($_[0]{rbuf} =~ /[^0-9]/) {
874 $self->_error (&Errno::EBADMSG);
875 }
876 return;
877 }
878
879 my $len = $1;
880
881 $self->unshift_read (chunk => $len, sub {
882 my $string = $_[1];
883 $_[0]->unshift_read (chunk => 1, sub {
884 if ($_[1] eq ",") {
885 $cb->($_[0], $string);
886 } else {
887 $self->_error (&Errno::EBADMSG);
888 }
889 });
890 });
891
892 1
893 }
894};
895 877
896=item regex => $accept[, $reject[, $skip], $cb->($handle, $data) 878=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
897 879
898Makes a regex match against the regex object C<$accept> and returns 880Makes a regex match against the regex object C<$accept> and returns
899everything up to and including the match. 881everything up to and including the match.
961 943
962 () 944 ()
963 } 945 }
964}; 946};
965 947
948=item netstring => $cb->($handle, $string)
949
950A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
951
952Throws an error with C<$!> set to EBADMSG on format violations.
953
954=cut
955
956register_read_type netstring => sub {
957 my ($self, $cb) = @_;
958
959 sub {
960 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
961 if ($_[0]{rbuf} =~ /[^0-9]/) {
962 $self->_error (&Errno::EBADMSG);
963 }
964 return;
965 }
966
967 my $len = $1;
968
969 $self->unshift_read (chunk => $len, sub {
970 my $string = $_[1];
971 $_[0]->unshift_read (chunk => 1, sub {
972 if ($_[1] eq ",") {
973 $cb->($_[0], $string);
974 } else {
975 $self->_error (&Errno::EBADMSG);
976 }
977 });
978 });
979
980 1
981 }
982};
983
984=item packstring => $format, $cb->($handle, $string)
985
986An octet string prefixed with an encoded length. The encoding C<$format>
987uses the same format as a Perl C<pack> format, but must specify a single
988integer only (only one of C<cCsSlLqQiInNvVjJw> is allowed, plus an
989optional C<!>, C<< < >> or C<< > >> modifier).
990
991DNS over TCP uses a prefix of C<n>, EPP uses a prefix of C<N>.
992
993Example: read a block of data prefixed by its length in BER-encoded
994format (very efficient).
995
996 $handle->push_read (packstring => "w", sub {
997 my ($handle, $data) = @_;
998 });
999
1000=cut
1001
1002register_read_type packstring => sub {
1003 my ($self, $cb, $format) = @_;
1004
1005 sub {
1006 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
1007 defined (my $len = eval { unpack $format, $_[0]->{rbuf} })
1008 or return;
1009
1010 # remove prefix
1011 substr $_[0]->{rbuf}, 0, (length pack $format, $len), "";
1012
1013 # read rest
1014 $_[0]->unshift_read (chunk => $len, $cb);
1015
1016 1
1017 }
1018};
1019
966=item json => $cb->($handle, $hash_or_arrayref) 1020=item json => $cb->($handle, $hash_or_arrayref)
967 1021
968Reads a JSON object or array, decodes it and passes it to the callback. 1022Reads a JSON object or array, decodes it and passes it to the callback.
969 1023
970If a C<json> object was passed to the constructor, then that will be used 1024If a C<json> object was passed to the constructor, then that will be used

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines