File Coverage

blib/lib/PGObject/Util/PseudoCSV.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package PGObject::Util::PseudoCSV;
2              
3 1     1   24817 use 5.008;
  1         5  
  1         40  
4 1     1   5 use strict;
  1         2  
  1         35  
5 1     1   4 use warnings;
  1         13  
  1         30  
6 1     1   499 use PGObject;
  0            
  0            
7             use Carp;
8              
9             =head1 NAME
10              
11             PGObject::Util::PseudoCSV - Tuple/Array parsing and serialization for PGObject
12              
13             =head1 VERSION
14              
15             Version 1.1.1
16              
17             =cut
18              
19             our $VERSION = '1.1.1';
20              
21              
22             =head1 SYNOPSIS
23              
24             This is a parser and constructor for PostgreSQL text representations of tuples
25             and arrays.
26              
27             To parse:
28              
29             For a tuple, we'd typically:
30              
31             my @list = pseudocsv_parse($text_representation, @typelist);
32              
33             We can then arrange the hash as:
34              
35             my $hashref = pseudocsv_to_hash(\@list, \@col_list);
36              
37             Which we can combine as:
38              
39             my $hashref = pseudocsv_to_hash(
40             pseudocsv_parse($text_representation, @typelist),
41             \@col_list
42             );
43              
44             For an array we specify a single type to the parser:
45              
46             my @list = pseudocsv_parse($text_representation, $type);
47              
48             =head1 DESCRIPTION
49              
50             PostgreSQL can represent tuples and arrays in a text format that is almost like
51             CSV. Unfortunately this format has a number of gotchas which render existing
52             CSV-parsers useless. This module provides basic parsing functions to other
53             programs for db interface purposes. With this module you can both parse
54             pseudocsv representations of tuples and arrays and you can create them from a
55             list.
56              
57             The API's here assume you send one (and only one) pseudo-csv record to the API
58             at once. These may be nested, so a single tuple can contain arrays of tuples
59             which can contain arrays of tuples ad infinitum but the parsing only goes one
60             layer deep tuple-wise so that handlin classes have an opportunity to re-parse
61             with appropriate type information. Naturally this has performance implications,
62             so depth in SQL structures passed should be reasonably limited.
63              
64             =head1 EXPORT
65              
66             =over
67              
68             =item pseudocsv_to_hash
69              
70             =item pseudocsv_parse
71              
72             =item to_pseudocsv
73              
74             =back
75              
76             =cut
77              
78             use parent 'Exporter';
79              
80             our @EXPORT = qw(pseudocsv_to_hash pseudocsv_parse to_pseudocsv
81             hash2pcsv pcsv2hash);
82              
83             =head1 SUBROUTINES/METHODS
84              
85             =head2 pseudocsv_parse
86              
87             This does a one-level deep parse of the pseudo-csv, with additional levels in
88             arrays. When a tuple is encountered it is instantiated as its type but a
89             subarray is parsed for more entities.
90              
91             Only one pseudocsv record can be passed in at once, but embedded newlines are properly handled.
92              
93             =cut
94              
95             sub pseudocsv_parse {
96             my ($csv, $type, $registry) = @_;
97             if ($csv =~ /^\(/ ) { # tuple
98             $csv =~ s/^\((.*)\)$/$1/s;
99             } elsif ($csv =~ /^\{/ ) { # array
100             $csv =~ s/^\{(.*)\}$/$1/s;
101             }
102             $registry ||= 'default';
103             my @returnlist = ();
104             while (length($csv)) {
105             my $val = _parse(\$csv);
106             my $in_type = $type;
107             $in_type = shift @$type if ref $type eq ref [];
108             $val =~ s/""/"/g if defined $val;
109             push @returnlist, PGObject::process_type($val, $type, $registry);
110             }
111             return @returnlist if wantarray;
112             return \@returnlist;
113             }
114              
115             =head2 pcsv2hash($literal_string, @cols);
116              
117             Returns a hash from a tuple literal or array literal.
118              
119             =cut
120              
121             sub pcsv2hash {
122             my $string = shift;
123             $string = shift if $string eq __PACKAGE__;
124             my @colnames = @_;
125              
126             my @colvals = pseudocsv_parse($string, undef, undef);
127            
128             my $hash = { map{ $_ => shift @colvals } @colnames };
129             return %$hash if wantarray;
130             return $hash;
131             }
132              
133             =head2 hash2pcsv($hashref, @cols)
134              
135             Takes an ordered list of columns and a hashref and returns a tuple literal
136              
137             =cut
138              
139             sub hash2pcsv {
140             my $hashref = shift;
141             return to_pseudocsv([map { $hashref->{$_} } @_], 1)
142             }
143              
144              
145             # _parse is the private method which does the hard work of parsing.
146              
147             sub _parse {
148             my ($csvref) = @_;
149             my $retval;
150             if ($$csvref =~ /^"/){ # quoted string
151             $$csvref =~ s/^"(([^"]|"")*)",?//s;
152             $retval = $1;
153             $retval =~ s/""/"/g;
154             } else {
155             $$csvref =~ s/^([^,]*)(,|$)//s;
156             $retval = $1;
157             $retval = undef if $retval =~ /^null$/i;
158             }
159             if (defined $retval and $retval =~ s/^\{(.*)\}$/$1/){
160             my $listref = [];
161             push @$listref, _parse(\$retval) while $retval;
162             $retval = $listref;
163             }
164             return $retval;
165             }
166              
167             =head2 pseudocsv_tohash($coldata, $colnames) DEPRECATED
168              
169             Takes an arrayref of column data and an arrayref of column names and returns
170             a hash. This is mostly a helper function designed to help with tuple types.
171              
172             This interface is deprecated and will go away in 2.0. Use pcsv2hash instead.
173              
174             =cut
175              
176             sub pseudocsv_tohash {
177             my ($cols, $colnames) = @_;
178             my $hash = { map{ $_ => shift @$cols } @$colnames };
179             return %$hash if wantarray;
180             return $hash;
181             }
182              
183             =head2 to_pseudocsv($datalist, $is_tuple)
184              
185             Takes a list of data and an is_tuple argument and creates a pseudocsv.
186              
187             Note: this does not check for array sanity. If you are not careful you can
188             get arrays returned which are not valid SQL arrays. Remember that SQL arrays
189             have every item being the same size, and all SQL arrays are are regular in
190             size (so all 1 and 2d arrays follow the same form as mathematical matrices).
191              
192             =cut
193              
194             sub _val {
195             my ($val, $is_tuple) = @_;
196             return 'NULL' unless defined $val;
197              
198             $val = $val->to_db if eval { $val->can('to_db') };
199             $val = to_pseudocsv($_, 0) if ref $_ eq ref [];
200             return $val if ref $_ eq ref [] and !$is_tuple;
201              
202             $val =~ s/"/""/;
203             $val = qq("$val") if $val =~ /(^null$|[",{}])/i;
204             return $val;
205             }
206              
207             sub to_pseudocsv {
208             my ($list, $is_tuple) = @_;
209             Carp::croak 'First arg must be an arrayref' unless ref $list;
210             my $csv = join(',', map { _val($_, $is_tuple) } @$list);
211             return qq|($csv)| if $is_tuple;
212             return qq|{$csv}|;
213             }
214              
215             =head1 AUTHOR
216              
217             Chris Travers, C<< >>
218              
219             =head1 BUGS
220              
221             Please report any bugs or feature requests to C, or through
222             the web interface at L. I will be notified, and then you'll
223             automatically be notified of progress on your bug as I make changes.
224              
225              
226              
227              
228             =head1 SUPPORT
229              
230             You can find documentation for this module with the perldoc command.
231              
232             perldoc PGObject::Util::PseudoCSV
233              
234              
235             You can also look for information at:
236              
237             =over 4
238              
239             =item * RT: CPAN's request tracker (report bugs here)
240              
241             L
242              
243             =item * AnnoCPAN: Annotated CPAN documentation
244              
245             L
246              
247             =item * CPAN Ratings
248              
249             L
250              
251             =item * Search CPAN
252              
253             L
254              
255             =back
256              
257              
258             =head1 ACKNOWLEDGEMENTS
259              
260              
261             =head1 LICENSE AND COPYRIGHT
262              
263             Copyright 2014 Chris Travers.
264              
265             Redistribution and use in source and binary forms, with or without modification,
266             are permitted provided that the following conditions are met:
267              
268             * Redistributions of source code must retain the above copyright notice, this
269             list of conditions and the following disclaimer.
270              
271             * Redistributions in binary form must reproduce the above copyright notice, this
272             list of conditions and the following disclaimer in the documentation and/or
273             other materials provided with the distribution.
274              
275             THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
276             ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
277             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
278             DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
279             ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
280             (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
281             LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
282             ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
283             (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
284             SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
285              
286             =cut
287              
288             1; # End of PGObject::Util::PseudoCSV