From 9336e2966f0f43dcfe332246c4275bf673020282 Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Sat, 31 Mar 2018 22:38:24 +0300 Subject: [PATCH] Initial commit --- Changes | 4 + MANIFEST | 6 ++ Makefile.PL | 22 +++++ README | 59 ++++++++++++++ lib/Data/Dump/Sexp.pm | 185 ++++++++++++++++++++++++++++++++++++++++++ t/Data-Dump-Sexp.t | 26 ++++++ 6 files changed, 302 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 lib/Data/Dump/Sexp.pm create mode 100644 t/Data-Dump-Sexp.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..47bd13d --- /dev/null +++ b/Changes @@ -0,0 +1,4 @@ +Revision history for Perl extension Data::Dump::Sexp. + +0.001 2018-03-31T22:38+03:00 + - Initial release diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..6ffc16d --- /dev/null +++ b/MANIFEST @@ -0,0 +1,6 @@ +Changes +Makefile.PL +MANIFEST +README +t/Data-Dump-Sexp.t +lib/Data/Dump/Sexp.pm diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..83ebfa4 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,22 @@ +use strict; +use warnings; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Data::Dump::Sexp', + VERSION_FROM => 'lib/Data/Dump/Sexp.pm', + ABSTRACT_FROM => 'lib/Data/Dump/Sexp.pm', + AUTHOR => 'Marius Gavrilescu ', + MIN_PERL_VERSION => '5.14.0', + LICENSE => 'perl', + SIGN => 1, + PREREQ_PM => { + qw/Data::SExpression 0.41/, + }, + META_ADD => { + dynamic_config => 0, + resources => { + repository => 'https://git.ieval.ro/?p=data-dump-sexp.git', + }, + } +); diff --git a/README b/README new file mode 100644 index 0000000..d08dd76 --- /dev/null +++ b/README @@ -0,0 +1,59 @@ +Data-Dump-Sexp version 0.001 +============================ + +Data::Dump::Sexp converts Perl structures to S-expressions. + +The conversion rules are as follows: + +1. A blessed object with a to_sexp method is replaced with the result + of calling the method, and this procedure is restarted. + +2. An instance of Data::SExpression::Symbol is converted to a symbol. + +3. An instance of Data::SExpression::Cons is converted to a cons cell + (like (A . B)), a proper list (like (A B C)) or an improper list + (like (A B . C)), where A, B, C are S-expressions. + +4. undef is converted to the empty list. + +5. A defined scalar that looks like a number is left as-is. + +6. A defined scalar that does not look like a number is surrounded by + double quotes after any backslashes and double quote characters are + escaped with a backslash. + +7. An arrayref is converted to a proper list. + +8. A hashref is converted to an alist, which is a proper list of cons + cells (like ((A . B) (C . D) (E . F))). + +9. A scalarref or a reference to another ref is dereferenced and this + procedure is restarted. + +10. Anything else (regexp, filehandle, format, glob, version string) + causes an exception to be raised + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + +* Data::SExpression + +COPYRIGHT AND LICENCE + +Copyright (C) 2018 by Marius Gavrilescu + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.24.1 or, +at your option, any later version of Perl 5 you may have available. + + diff --git a/lib/Data/Dump/Sexp.pm b/lib/Data/Dump/Sexp.pm new file mode 100644 index 0000000..ad2045c --- /dev/null +++ b/lib/Data/Dump/Sexp.pm @@ -0,0 +1,185 @@ +package Data::Dump::Sexp; + +use 5.014000; +use strict; +use warnings; +use parent qw/Exporter/; + +our @EXPORT = qw/dump_sexp/; +our @EXPORT_OK = @EXPORT; + +our $VERSION = '0.001'; + +use Carp qw/croak/; +use Data::SExpression; +use Scalar::Util qw/reftype looks_like_number/; + +sub dump_sexp; + +sub dump_scalar { + my ($expr) = @_; + if (!defined $expr) { + "()" + } elsif (looks_like_number $expr) { + "$expr" + } else { + my $escaped = $expr; + $escaped =~ s,\\,\\\\,g; + $escaped =~ s,",\\",g; + qq,"$escaped", + } +} + +sub dump_cons { + my ($expr) = @_; + my $cdr = $expr->cdr; + my $car = $expr->car; + my $acc = '(' . dump_sexp($car); + while (eval { $cdr->isa('Data::SExpression::Cons') }) { + $car = $cdr->car; + $cdr = $cdr->cdr; + $acc .= ' ' . dump_sexp($car); + } + if (defined $cdr) { + $acc .= ' . ' . dump_sexp($cdr); + } + $acc . ')' +} + +sub dump_array { + my ($expr) = @_; + '(' . join (' ', map { dump_sexp($_) } @$expr). ')' +} + +sub dump_hash { + my ($expr) = @_; + my @alist = map { Data::SExpression::cons $_, $expr->{$_} } sort keys %$expr; + dump_array \@alist +} + + +sub dump_sexp { + my ($expr) = @_; + my $type = reftype $expr; + if (eval { $expr->can('to_sexp') }) { + dump_sexp $expr->to_sexp + } elsif (eval { $expr->isa('Data::SExpression::Symbol') }) { + "$expr" + } elsif (eval { $expr->isa('Data::SExpression::Cons') }) { + dump_cons $expr + } elsif (!defined $type) { + dump_scalar $expr + } elsif ($type eq 'ARRAY') { + dump_array $expr + } elsif ($type eq 'HASH') { + dump_hash $expr + } elsif ($type eq 'SCALAR' || $type eq 'REF' || $type eq 'LVALUE') { + dump_sexp $$expr + } else { + croak "Cannot dump value of type $type as sexp" + } +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Data::Dump::Sexp - convert arbitrary scalars to s-expressions + +=head1 SYNOPSIS + + use Data::Dump::Sexp; + use Data::SExpression qw/cons/; + say dump_sexp 5; # 5 + say dump_sexp "yes"; # "yes" + say dump_sexp [1, "yes", 2]; # (1 "yes" 2) + say dump_sexp { b => 5, a => "yes"} # (("a" . "yes") ("b" . 5)) + +=head1 DESCRIPTION + +B. + +Data::Dump::Sexp converts Perl structures to S-expressions. + +The conversion rules are as follows: + +=over + +=item 1 + +A blessed object with a B method is replaced with the result +of calling the method, and this procedure is restarted. + +=item 2 + +An instance of L is converted to a symbol. + +=item 3 + +An instance of L is converted to a cons cell +(like C<(A . B)>), a proper list (like C<(A B C)>) or an improper list +(like C<(A B . C)>), where A, B, C are S-expressions. + +=item 4 + +undef is converted to the empty list. + +=item 5 + +A defined scalar that looks like a number is left as-is. + +=item 6 + +A defined scalar that does not look like a number is surrounded by +double quotes after any backslashes and double quote characters are +escaped with a backslash. + +=item 7 + +An arrayref is converted to a proper list. + +=item 8 + +A hashref is converted to an alist, which is a proper list of cons +cells (like C<((A . B) (C . D) (E . F))>). + +=item 9 + +A scalarref or a reference to another ref is dereferenced and this +procedure is restarted. + +=item 10 + +Anything else (regexp, filehandle, format, glob, version string) +causes an exception to be raised + +=back + +A single function is exported by default: + +=over + +=item B I<$expr> + +Given any Perl scalar, convert it to a S-expression and return the +sexp as a string. + +=back + +=head1 AUTHOR + +Marius Gavrilescu, Emarius@ieval.roE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2018 by Marius Gavrilescu + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.24.1 or, +at your option, any later version of Perl 5 you may have available. + + +=cut diff --git a/t/Data-Dump-Sexp.t b/t/Data-Dump-Sexp.t new file mode 100644 index 0000000..50e1b84 --- /dev/null +++ b/t/Data-Dump-Sexp.t @@ -0,0 +1,26 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use Test::More tests => 10; +BEGIN { use_ok('Data::Dump::Sexp') }; + +use Data::SExpression; + +is dump_sexp(5), 5; +is dump_sexp('yes'), '"yes"'; +is dump_sexp('"ha\\ha\\ha"'), '"\\"ha\\\\ha\\\\ha\\""'; +is dump_sexp([1, "yes", 2]), '(1 "yes" 2)'; +is dump_sexp({b => 5, a => "yes"}), '(("a" . "yes") ("b" . 5))'; + +sub roundtrip_test { + my ($sexp) = @_; + my $ds = Data::SExpression->new({use_symbol_class => 1, fold_lists => 0}); + my $parsed = $ds->read($sexp); + is dump_sexp($parsed), $sexp +} + +roundtrip_test 'symbol'; +roundtrip_test '(HA-HA 111 "text")'; +roundtrip_test '(cons . cell)'; +roundtrip_test '(1 2 3 . 4)'; -- 2.39.2