line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Protocol::WebSocket::Cookie; |
2
|
|
|
|
|
|
|
|
3
|
21
|
|
|
21
|
|
634
|
use strict; |
|
21
|
|
|
|
|
38
|
|
|
21
|
|
|
|
|
661
|
|
4
|
21
|
|
|
21
|
|
108
|
use warnings; |
|
21
|
|
|
|
|
37
|
|
|
21
|
|
|
|
|
9224
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
sub new { |
7
|
58
|
|
|
58
|
1
|
1159
|
my $class = shift; |
8
|
58
|
50
|
|
|
|
151
|
$class = ref $class if ref $class; |
9
|
|
|
|
|
|
|
|
10
|
58
|
|
|
|
|
121
|
my $self = {@_}; |
11
|
58
|
|
|
|
|
103
|
bless $self, $class; |
12
|
|
|
|
|
|
|
|
13
|
58
|
|
|
|
|
165
|
return $self; |
14
|
|
|
|
|
|
|
} |
15
|
|
|
|
|
|
|
|
16
|
75
|
100
|
|
75
|
1
|
255
|
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
|
50
|
my $self = shift; |
25
|
26
|
|
|
|
|
46
|
my $string = shift; |
26
|
|
|
|
|
|
|
|
27
|
26
|
|
|
|
|
101
|
$self->{pairs} = []; |
28
|
|
|
|
|
|
|
|
29
|
26
|
100
|
100
|
|
|
137
|
return unless defined $string && $string ne ''; |
30
|
|
|
|
|
|
|
|
31
|
24
|
|
|
|
|
1073
|
while ($string =~ m/\s*($NAME)\s*(?:=\s*($VALUE))?;?/g) { |
32
|
52
|
|
|
|
|
188
|
my ($attr, $value) = ($1, $2); |
33
|
52
|
100
|
|
|
|
113
|
if (defined $value) { |
34
|
51
|
|
|
|
|
85
|
$value =~ s/^"//; |
35
|
51
|
|
|
|
|
80
|
$value =~ s/"$//; |
36
|
51
|
|
|
|
|
85
|
$value =~ s/\\"/"/g; |
37
|
|
|
|
|
|
|
} |
38
|
52
|
|
|
|
|
61
|
push @{$self->{pairs}}, [$attr, $value]; |
|
52
|
|
|
|
|
347
|
|
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
24
|
|
|
|
|
103
|
return $self; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub to_string { |
45
|
36
|
|
|
36
|
1
|
68
|
my $self = shift; |
46
|
|
|
|
|
|
|
|
47
|
36
|
|
|
|
|
58
|
my $string = ''; |
48
|
|
|
|
|
|
|
|
49
|
36
|
|
|
|
|
51
|
my @pairs; |
50
|
36
|
|
|
|
|
51
|
foreach my $pair (@{$self->pairs}) { |
|
36
|
|
|
|
|
74
|
|
51
|
91
|
|
|
|
|
132
|
my $string = ''; |
52
|
91
|
|
|
|
|
141
|
$string .= $pair->[0]; |
53
|
|
|
|
|
|
|
|
54
|
91
|
100
|
|
|
|
167
|
if (defined $pair->[1]) { |
55
|
89
|
|
|
|
|
124
|
$string .= '='; |
56
|
89
|
100
|
|
|
|
1207
|
$string |
57
|
|
|
|
|
|
|
.= $pair->[1] !~ m/^$VALUE$/ ? "\"$pair->[1]\"" : $pair->[1]; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
91
|
|
|
|
|
231
|
push @pairs, $string; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
36
|
|
|
|
|
200
|
return join '; ' => @pairs; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
1; |
67
|
|
|
|
|
|
|
__END__ |