lib/Data/Dump/Sexp.pm

   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.001';
  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