File Coverage

blib/lib/Net/WebSocket/Message.pm
Criterion Covered Total %
statement 28 35 80.0
branch 5 8 62.5
condition n/a
subroutine 7 9 77.7
pod 0 4 0.0
total 40 56 71.4


line stmt bran cond sub pod time code
1             package Net::WebSocket::Message;
2              
3 1     1   7 use strict;
  1         2  
  1         41  
4 1     1   83 use warnings;
  1         3  
  1         31  
5              
6 1     1   6 use Call::Context ();
  1         3  
  1         20  
7              
8 1     1   6 use Net::WebSocket::Constants ();
  1         2  
  1         423  
9              
10             our $AUTOLOAD;
11             sub AUTOLOAD {
12 9     9   9476 my ($self) = shift;
13              
14 9 100       97 return if substr( $AUTOLOAD, -8 ) eq ':DESTROY';
15              
16 4         15 my $last_colon_idx = rindex( $AUTOLOAD, ':' );
17 4         14 my $method = substr( $AUTOLOAD, 1 + $last_colon_idx );
18              
19             #Figure out what type this is, and re-bless.
20 4 50       18 if (ref($self) eq __PACKAGE__) {
21 4         23 my $type = $self->[0]->get_type();
22              
23 4         17 my $class = __PACKAGE__ . "::$type";
24 4 50       48 if (!$class->can('new')) {
25 4         24 Module::Load::load($class);
26             }
27              
28 4         257 bless $self, $class;
29              
30 4 50       44 if ($self->can($method)) {
31 4         20 return $self->$method(@_);
32             }
33             }
34              
35 0         0 die( "$self has no method “$method”!" );
36             }
37              
38             #----------------------------------------------------------------------
39              
40             sub create_from_frames {
41 5     5 0 38 return bless \@_, __PACKAGE__;
42             }
43              
44             sub get_frames {
45 0     0 0 0 my ($self) = @_;
46              
47 0         0 Call::Context::must_be_list();
48              
49 0         0 return @$self;
50             }
51              
52             sub get_payload {
53 4     4 0 181 my ($self) = @_;
54              
55 4         21 return join( q<>, map { $_->get_payload() } @$self );
  6         41  
56             }
57              
58             sub to_bytes {
59 0     0 0   my ($self) = @_;
60              
61 0           return join( q<>, map { $_->to_bytes() } @$self );
  0            
62             }
63              
64             1;