line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Protocol::WebSocket::Cookie; |
2
|
|
|
|
|
|
|
|
3
|
21
|
|
|
21
|
|
730
|
use strict; |
|
21
|
|
|
|
|
41
|
|
|
21
|
|
|
|
|
552
|
|
4
|
21
|
|
|
21
|
|
97
|
use warnings; |
|
21
|
|
|
|
|
42
|
|
|
21
|
|
|
|
|
9995
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
sub new { |
7
|
58
|
|
|
58
|
1
|
1049
|
my $class = shift; |
8
|
58
|
50
|
|
|
|
130
|
$class = ref $class if ref $class; |
9
|
|
|
|
|
|
|
|
10
|
58
|
|
|
|
|
191
|
my $self = {@_}; |
11
|
58
|
|
|
|
|
114
|
bless $self, $class; |
12
|
|
|
|
|
|
|
|
13
|
58
|
|
|
|
|
161
|
return $self; |
14
|
|
|
|
|
|
|
} |
15
|
|
|
|
|
|
|
|
16
|
75
|
100
|
|
75
|
1
|
260
|
sub pairs { @_ > 1 ? $_[0]->{pairs} = $_[1] : $_[0]->{pairs} } |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
my $TOKEN = qr/[^;,\s"]+/; |
19
|
|
|
|
|
|
|
my $NAME = qr/[^;,\s"=]+/; |
20
|
|
|
|
|
|
|
my $QUOTED_STRING = qr/"(?:\\"|[^"])+"/; |
21
|
|
|
|
|
|
|
my $VALUE = qr/(?:$TOKEN|$QUOTED_STRING)/; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub parse { |
24
|
26
|
|
|
26
|
1
|
56
|
my $self = shift; |
25
|
26
|
|
|
|
|
49
|
my $string = shift; |
26
|
|
|
|
|
|
|
|
27
|
26
|
|
|
|
|
98
|
$self->{pairs} = []; |
28
|
|
|
|
|
|
|
|
29
|
26
|
100
|
100
|
|
|
171
|
return unless defined $string && $string ne ''; |
30
|
|
|
|
|
|
|
|
31
|
24
|
|
|
|
|
978
|
while ($string =~ m/\s*($NAME)\s*(?:=\s*($VALUE))?;?/g) { |
32
|
52
|
|
|
|
|
194
|
my ($attr, $value) = ($1, $2); |
33
|
52
|
100
|
|
|
|
114
|
if (defined $value) { |
34
|
51
|
|
|
|
|
92
|
$value =~ s/^"//; |
35
|
51
|
|
|
|
|
80
|
$value =~ s/"$//; |
36
|
51
|
|
|
|
|
74
|
$value =~ s/\\"/"/g; |
37
|
|
|
|
|
|
|
} |
38
|
52
|
|
|
|
|
71
|
push @{$self->{pairs}}, [$attr, $value]; |
|
52
|
|
|
|
|
340
|
|
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
24
|
|
|
|
|
97
|
return $self; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub to_string { |
45
|
36
|
|
|
36
|
1
|
72
|
my $self = shift; |
46
|
|
|
|
|
|
|
|
47
|
36
|
|
|
|
|
53
|
my $string = ''; |
48
|
|
|
|
|
|
|
|
49
|
36
|
|
|
|
|
60
|
my @pairs; |
50
|
36
|
|
|
|
|
56
|
foreach my $pair (@{$self->pairs}) { |
|
36
|
|
|
|
|
82
|
|
51
|
91
|
|
|
|
|
142
|
my $string = ''; |
52
|
91
|
|
|
|
|
143
|
$string .= $pair->[0]; |
53
|
|
|
|
|
|
|
|
54
|
91
|
100
|
|
|
|
181
|
if (defined $pair->[1]) { |
55
|
89
|
|
|
|
|
134
|
$string .= '='; |
56
|
89
|
100
|
|
|
|
981
|
$string |
57
|
|
|
|
|
|
|
.= $pair->[1] !~ m/^$VALUE$/ ? "\"$pair->[1]\"" : $pair->[1]; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
91
|
|
|
|
|
254
|
push @pairs, $string; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
36
|
|
|
|
|
177
|
return join '; ' => @pairs; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
1; |
67
|
|
|
|
|
|
|
__END__ |