| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Net::WebSocket::Streamer; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | =encoding utf-8 | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | =head1 NAME | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | Net::WebSocket::Streamer - Stream a WebSocket message easily | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | Here’s the gist of it: | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | #Use the ::Client or ::Server subclass as needed. | 
| 14 |  |  |  |  |  |  | my $streamer = Net::WebSocket::Streamer::Client->new('binary'); | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | my $frame = $streamer->create_chunk($buf); | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | my $last_frame = $streamer->create_final($buf); | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | … but a more complete example might be this: streaming a file | 
| 21 |  |  |  |  |  |  | of arbitrary size in 64-KiB chunks: | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | my $size = -s $rfh; | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  | while ( read $rfh, my $buf, 65536 ) { | 
| 26 |  |  |  |  |  |  | my $frame; | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | if (tell($rfh) == $size) { | 
| 29 |  |  |  |  |  |  | $frame = $streamer->create_final($buf); | 
| 30 |  |  |  |  |  |  | } | 
| 31 |  |  |  |  |  |  | else { | 
| 32 |  |  |  |  |  |  | $frame = $streamer->create_chunk($buf); | 
| 33 |  |  |  |  |  |  | } | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | syswrite $wfh, $frame->to_bytes(); | 
| 36 |  |  |  |  |  |  | } | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | You can, of course, create/send an empty final frame for cases where you’re | 
| 39 |  |  |  |  |  |  | not sure how much data will actually be sent. | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | Note that the receiving application won’t necessarily have access to the | 
| 42 |  |  |  |  |  |  | individual message fragments (i.e., frames) that you send. Web browsers, | 
| 43 |  |  |  |  |  |  | for example, only expose messages, not frames. You may thus be better off | 
| 44 |  |  |  |  |  |  | sending full messages rather than frames. | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | =head1 EXTENSION SUPPORT | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | To stream custom frame types (or overridden classes), you can pass in | 
| 49 |  |  |  |  |  |  | a full package name to C rather than merely C or C. | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | =cut | 
| 52 |  |  |  |  |  |  |  | 
| 53 | 1 |  |  | 1 |  | 344 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 23 |  | 
| 54 | 1 |  |  | 1 |  | 4 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 19 |  | 
| 55 |  |  |  |  |  |  |  | 
| 56 | 1 |  |  | 1 |  | 4 | use Module::Load (); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 21 |  | 
| 57 |  |  |  |  |  |  |  | 
| 58 | 1 |  |  | 1 |  | 383 | use Net::WebSocket::Frame::continuation (); | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 19 |  | 
| 59 | 1 |  |  | 1 |  | 4 | use Net::WebSocket::X (); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 25 |  | 
| 60 |  |  |  |  |  |  |  | 
| 61 |  |  |  |  |  |  | use constant { | 
| 62 |  |  |  |  |  |  |  | 
| 63 |  |  |  |  |  |  | #The old way of doing this. No longer documented, | 
| 64 |  |  |  |  |  |  | #but still supported. | 
| 65 | 1 |  |  |  |  | 351 | frame_class_text => 'Net::WebSocket::Frame::text', | 
| 66 |  |  |  |  |  |  | frame_class_binary => 'Net::WebSocket::Frame::binary', | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | FINISHED_INDICATOR => __PACKAGE__ . '::__ALREADY_SENT_FINAL', | 
| 69 | 1 |  |  | 1 |  | 4 | }; | 
|  | 1 |  |  |  |  | 2 |  | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | sub new { | 
| 72 | 18 |  |  | 18 | 0 | 1388 | my ($class, $type) = @_; | 
| 73 |  |  |  |  |  |  |  | 
| 74 | 18 |  |  |  |  | 33 | my $frame_class = $class->_load_frame_class($type); | 
| 75 |  |  |  |  |  |  |  | 
| 76 | 18 |  |  |  |  | 56 | return bless { class => $frame_class, pid => $$ }, $class; | 
| 77 |  |  |  |  |  |  | } | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | sub create_chunk { | 
| 80 | 35 |  |  | 35 | 0 | 206 | my $self = shift; | 
| 81 |  |  |  |  |  |  |  | 
| 82 | 35 |  |  |  |  | 74 | my $frame = $self->{'class'}->new( | 
| 83 |  |  |  |  |  |  | fin => 0, | 
| 84 |  |  |  |  |  |  | $self->FRAME_MASK_ARGS(), | 
| 85 |  |  |  |  |  |  | payload => \$_[0], | 
| 86 |  |  |  |  |  |  | ); | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  | #The first $frame we create needs to be typed (e.g., text or binary), | 
| 89 |  |  |  |  |  |  | #but all subsequent ones must be continuation. | 
| 90 | 35 | 100 |  |  |  | 75 | if ($self->{'class'} ne 'Net::WebSocket::Frame::continuation') { | 
| 91 | 18 |  |  |  |  | 21 | $self->{'class'} = 'Net::WebSocket::Frame::continuation'; | 
| 92 |  |  |  |  |  |  | } | 
| 93 |  |  |  |  |  |  |  | 
| 94 | 35 |  |  |  |  | 73 | return $frame; | 
| 95 |  |  |  |  |  |  | } | 
| 96 |  |  |  |  |  |  |  | 
| 97 |  |  |  |  |  |  | sub create_final { | 
| 98 | 18 |  |  | 18 | 0 | 91 | my $self = shift; | 
| 99 |  |  |  |  |  |  |  | 
| 100 | 18 |  |  |  |  | 41 | my $frame = $self->{'class'}->new( | 
| 101 |  |  |  |  |  |  | fin => 1, | 
| 102 |  |  |  |  |  |  | $self->FRAME_MASK_ARGS(), | 
| 103 |  |  |  |  |  |  | payload => \$_[0], | 
| 104 |  |  |  |  |  |  | ); | 
| 105 |  |  |  |  |  |  |  | 
| 106 | 18 |  |  |  |  | 37 | $self->{'finished'} = 1; | 
| 107 |  |  |  |  |  |  |  | 
| 108 | 18 |  |  |  |  | 36 | return $frame; | 
| 109 |  |  |  |  |  |  | } | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | sub _load_frame_class { | 
| 112 | 18 |  |  | 18 |  | 25 | my ($class, $type) = @_; | 
| 113 |  |  |  |  |  |  |  | 
| 114 |  |  |  |  |  |  | #The old, legacy way of doing this. No longer documented, | 
| 115 |  |  |  |  |  |  | #but it shipped in production so we’ll keep supporting it. | 
| 116 | 18 |  |  |  |  | 71 | my $frame_class = $class->can("frame_class_$type"); | 
| 117 |  |  |  |  |  |  |  | 
| 118 | 18 | 50 |  |  |  | 36 | if ($frame_class) { | 
| 119 | 18 |  |  |  |  | 29 | $frame_class = $frame_class->(); | 
| 120 |  |  |  |  |  |  | } | 
| 121 |  |  |  |  |  |  | else { | 
| 122 | 0 |  |  |  |  | 0 | require Net::WebSocket::FrameTypeName; | 
| 123 | 0 |  |  |  |  | 0 | $frame_class = Net::WebSocket::FrameTypeName::get_module($type); | 
| 124 |  |  |  |  |  |  | } | 
| 125 |  |  |  |  |  |  |  | 
| 126 | 18 | 100 |  |  |  | 65 | Module::Load::load($frame_class) if !$frame_class->can('new'); | 
| 127 |  |  |  |  |  |  |  | 
| 128 | 18 |  |  |  |  | 37 | return $frame_class; | 
| 129 |  |  |  |  |  |  | } | 
| 130 |  |  |  |  |  |  |  | 
| 131 |  |  |  |  |  |  | sub DESTROY { | 
| 132 | 18 |  |  | 18 |  | 41 | my ($self) = @_; | 
| 133 |  |  |  |  |  |  |  | 
| 134 | 18 | 50 | 33 |  |  | 75 | if (($self->{'pid'} == $$) && !$self->{'finished'}) { | 
| 135 | 0 |  |  |  |  | 0 | die Net::WebSocket::X->create('UnfinishedStream', $self); | 
| 136 |  |  |  |  |  |  | } | 
| 137 |  |  |  |  |  |  |  | 
| 138 | 18 |  |  |  |  | 74 | return; | 
| 139 |  |  |  |  |  |  | } | 
| 140 |  |  |  |  |  |  |  | 
| 141 |  |  |  |  |  |  | 1; |