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