]>
Commit | Line | Data |
---|---|---|
1 | package Data::Dump::Sexp; | |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | use parent qw/Exporter/; | |
7 | ||
8 | our @EXPORT = qw/dump_sexp/; | |
9 | our @EXPORT_OK = @EXPORT; | |
10 | ||
11 | our $VERSION = '0.002'; | |
12 | ||
13 | use Carp qw/croak/; | |
14 | use Data::SExpression; | |
15 | use Scalar::Util qw/reftype looks_like_number/; | |
16 | ||
17 | sub dump_sexp; | |
18 | ||
19 | sub dump_scalar { | |
20 | my ($expr) = @_; | |
21 | if (!defined $expr) { | |
22 | "()" | |
23 | } elsif (looks_like_number $expr) { | |
24 | "$expr" | |
25 | } else { | |
26 | my $escaped = $expr; | |
27 | $escaped =~ s,\\,\\\\,g; | |
28 | $escaped =~ s,",\\",g; | |
29 | qq,"$escaped", | |
30 | } | |
31 | } | |
32 | ||
33 | sub dump_cons { | |
34 | my ($expr) = @_; | |
35 | my $cdr = $expr->cdr; | |
36 | my $car = $expr->car; | |
37 | my $acc = '(' . dump_sexp($car); | |
38 | while (eval { $cdr->isa('Data::SExpression::Cons') }) { | |
39 | $car = $cdr->car; | |
40 | $cdr = $cdr->cdr; | |
41 | $acc .= ' ' . dump_sexp($car); | |
42 | } | |
43 | if (defined $cdr) { | |
44 | $acc .= ' . ' . dump_sexp($cdr); | |
45 | } | |
46 | $acc . ')' | |
47 | } | |
48 | ||
49 | sub dump_array { | |
50 | my ($expr) = @_; | |
51 | '(' . join (' ', map { dump_sexp($_) } @$expr). ')' | |
52 | } | |
53 | ||
54 | sub dump_hash { | |
55 | my ($expr) = @_; | |
56 | my @alist = map { Data::SExpression::cons $_, $expr->{$_} } sort keys %$expr; | |
57 | dump_array \@alist | |
58 | } | |
59 | ||
60 | ||
61 | sub dump_sexp { | |
62 | my ($expr) = @_; | |
63 | my $type = reftype $expr; | |
64 | if (eval { $expr->can('to_sexp') }) { | |
65 | dump_sexp $expr->to_sexp | |
66 | } elsif (eval { $expr->isa('Data::SExpression::Symbol') }) { | |
67 | "$expr" | |
68 | } elsif (eval { $expr->isa('Data::SExpression::Cons') }) { | |
69 | dump_cons $expr | |
70 | } elsif (!defined $type) { | |
71 | dump_scalar $expr | |
72 | } elsif ($type eq 'ARRAY') { | |
73 | dump_array $expr | |
74 | } elsif ($type eq 'HASH') { | |
75 | dump_hash $expr | |
76 | } elsif ($type eq 'SCALAR' || $type eq 'REF' || $type eq 'LVALUE') { | |
77 | dump_sexp $$expr | |
78 | } else { | |
79 | croak "Cannot dump value of type $type as sexp" | |
80 | } | |
81 | } | |
82 | ||
83 | 1; | |
84 | __END__ | |
85 | ||
86 | =encoding utf-8 | |
87 | ||
88 | =head1 NAME | |
89 | ||
90 | Data::Dump::Sexp - convert arbitrary scalars to s-expressions | |
91 | ||
92 | =head1 SYNOPSIS | |
93 | ||
94 | use Data::Dump::Sexp; | |
95 | use Data::SExpression qw/cons/; | |
96 | say dump_sexp 5; # 5 | |
97 | say dump_sexp "yes"; # "yes" | |
98 | say dump_sexp [1, "yes", 2]; # (1 "yes" 2) | |
99 | say dump_sexp { b => 5, a => "yes"} # (("a" . "yes") ("b" . 5)) | |
100 | ||
101 | =head1 DESCRIPTION | |
102 | ||
103 | B<This module is not well-tested, proceed with caution>. | |
104 | ||
105 | Data::Dump::Sexp converts Perl structures to S-expressions. | |
106 | ||
107 | The conversion rules are as follows: | |
108 | ||
109 | =over | |
110 | ||
111 | =item 1 | |
112 | ||
113 | A blessed object with a B<to_sexp> method is replaced with the result | |
114 | of calling the method, and this procedure is restarted. | |
115 | ||
116 | =item 2 | |
117 | ||
118 | An instance of L<Data::SExpression::Symbol> is converted to a symbol. | |
119 | ||
120 | =item 3 | |
121 | ||
122 | An instance of L<Data::SExpression::Cons> is converted to a cons cell | |
123 | (like C<(A . B)>), a proper list (like C<(A B C)>) or an improper list | |
124 | (like C<(A B . C)>), where A, B, C are S-expressions. | |
125 | ||
126 | =item 4 | |
127 | ||
128 | undef is converted to the empty list. | |
129 | ||
130 | =item 5 | |
131 | ||
132 | A defined scalar that looks like a number is left as-is. | |
133 | ||
134 | =item 6 | |
135 | ||
136 | A defined scalar that does not look like a number is surrounded by | |
137 | double quotes after any backslashes and double quote characters are | |
138 | escaped with a backslash. | |
139 | ||
140 | =item 7 | |
141 | ||
142 | An arrayref is converted to a proper list. | |
143 | ||
144 | =item 8 | |
145 | ||
146 | A hashref is converted to an alist, which is a proper list of cons | |
147 | cells (like C<((A . B) (C . D) (E . F))>). | |
148 | ||
149 | =item 9 | |
150 | ||
151 | A scalarref or a reference to another ref is dereferenced and this | |
152 | procedure is restarted. | |
153 | ||
154 | =item 10 | |
155 | ||
156 | Anything else (coderef, regexp, filehandle, format, globref, version | |
157 | string) causes an exception to be raised. | |
158 | ||
159 | =back | |
160 | ||
161 | A single function is exported by default: | |
162 | ||
163 | =over | |
164 | ||
165 | =item B<dump_sexp> I<$expr> | |
166 | ||
167 | Given any Perl scalar, convert it to a S-expression and return the | |
168 | sexp as a string. | |
169 | ||
170 | =back | |
171 | ||
172 | =head1 AUTHOR | |
173 | ||
174 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
175 | ||
176 | =head1 COPYRIGHT AND LICENSE | |
177 | ||
178 | Copyright (C) 2018 by Marius Gavrilescu | |
179 | ||
180 | This library is free software; you can redistribute it and/or modify | |
181 | it under the same terms as Perl itself, either Perl version 5.24.1 or, | |
182 | at your option, any later version of Perl 5 you may have available. | |
183 | ||
184 | ||
185 | =cut |