File Coverage

blib/lib/Crypt/OpenToken/Serializer.pm
Criterion Covered Total %
statement 35 35 100.0
branch 11 12 91.6
condition n/a
subroutine 4 4 100.0
pod 2 2 100.0
total 52 53 98.1


line stmt bran cond sub pod time code
1             package Crypt::OpenToken::Serializer;
2              
3 7     7   252198 use strict;
  7         30  
  7         242  
4 7     7   56 use warnings;
  7         19  
  7         3718  
5              
6             our $WS = qr/[\t ]/; # WS, as per OpenToken spec (just tab and space)
7             our $CRLF = qr/[\r\n]/; # CRLF, as per OpenToken spec
8              
9             sub thaw {
10 16     16 1 8414 my $str = shift;
11 16         34 my %data;
12              
13 16         52 while ($str) {
14 45         125 my ($key, $val);
15 45         0 my ($quote, $remainder);
16              
17 45         590 ($key, $remainder) = ($str =~ /^$WS*(\S+)$WS*=$WS*(.*)$/s);
18              
19 45 100       178 if ($remainder =~ /^['"]/) {
20 15         215 ($quote, $val, $remainder)
21             = ($remainder =~ /^(['"])(.*?)(?<!\\)\1$WS*?$CRLF+(.*)/s);
22 15         49 $val =~ s/\\(['"])/$1/g;
23             }
24             else {
25 30         204 ($val, $remainder) = split /$CRLF+/, $remainder, 2;
26             }
27 45         97 $str = $remainder;
28              
29 45 100       107 if (exists $data{$key}) {
30             $data{$key} = [
31 2 100       12 (ref($data{$key}) ? @{ $data{$key} } : $data{$key}),
  1         5  
32             $val,
33             ];
34             }
35             else {
36 43         140 $data{$key} = $val;
37             }
38             }
39 18         120 return %data;
40             }
41              
42             sub freeze {
43 11     11 1 4288 my (%data) = @_;
44 11         26 my $str;
45              
46 11         62 foreach my $key (sort keys %data) {
47 27         55 my $val = $data{$key};
48 27 100       86 my @vals = ref($val) eq 'ARRAY' ? @{$val} : ($val);
  1         3  
49 27         53 foreach my $v (@vals) {
50 29 50       79 $v = '' unless (defined $v);
51 29 100       99 if ($v =~ /\W/) {
52 15         49 $v =~ s/(['"])/\\$1/g;
53 15         44 $v = "'" . $v . "'";
54             }
55 29         95 $str .= "$key = $v\n";
56             }
57             }
58              
59 11         50 return $str;
60             }
61              
62             1;
63              
64             =for stopwords OpenTokens
65              
66             =head1 NAME
67              
68             Crypt::OpenToken::Serializer - Serialize payloads for OpenTokens
69              
70             =head1 SYNOPSIS
71              
72             use Crypt::OpenToken::Serializer;
73              
74             # data to serialize
75             my $data = {
76             foo => 'bar',
77             bar => 'baz',
78             };
79              
80             # freeze/serialize the data
81             my $payload = Crypt::OpenToken::Serializer::freeze(%{$data});
82              
83             # thaw/deserialize the data
84             my %thawed = Crypt::OpenToken::Serializer::thaw($payload);
85              
86             =head1 DESCRIPTION
87              
88             This module implements the serialization routine described in the OpenToken
89             specification for generating the payload format.
90              
91             Highlights:
92              
93             =over
94              
95             =item *
96              
97             A line-based format in the form of "key = value".
98              
99             =item *
100              
101             Within quoted-strings, B<both> double and single quotes must be escaped by a
102             preceding backslash.
103              
104             =item *
105              
106             Encoded with UTF-8 and is guaranteed to support the transport of multi-byte
107             characters.
108              
109             =item *
110              
111             Key names might not be unique. OpenToken supports multiple values for a key
112             name by simply adding another key-value pair.
113              
114             =item *
115              
116             Key names are case-sensitive. It is RECOMMENDED that all key names be
117             lowercase and use hyphens to separate "words".
118              
119             =back
120              
121             =head1 METHODS
122              
123             =over
124              
125             =item Crypt::OpenToken::Serializer::thaw($string)
126              
127             Thaws the given serialized data, returning a hash of data back to the caller.
128              
129             If the data contained any repeating keys, those are represented in the hash as
130             having an ARRAYREF as a value.
131              
132             =item Crypt::OpenToken::Serializer::freeze(%data)
133              
134             Freezes the given data, returning a serialized string back to the caller.
135              
136             =back
137              
138             =head1 AUTHOR
139              
140             Graham TerMarsch (cpan@howlingfrog.com)
141              
142             =head1 COPYRIGHT & LICENSE
143              
144             C<Crypt::OpenToken> is Copyright (C) 2010, Socialtext, and is released under
145             the Artistic-2.0 license.
146              
147             =cut