File Coverage

blib/lib/Data/Undump/PPI.pm

Criterion	Covered	Total	%
statement	70	72	97.2
branch	32	46	69.5
condition	7	11	63.6
subroutine	8	8	100.0
pod	2	2	100.0
total	119	139	85.6

#!perl
package Data::Undump::PPI;
use warnings;
use strict;

our $VERSION = '0.06';

=head1 Name

Data::Undump::PPI - Perl extension for limited undumping of data structures
(via PPI, not eval)

=head1 Synopsis

=for comment
Remember to test this by copy/pasting to/from 91_author_pod.t

 use Data::Dumper;
 use Data::Undump::PPI;             # "Undump()" is exported by default
 $Data::Dumper::Purity=1;           # should always be turned on for Undump

 my @input = ( {foo=>"bar"}, ["Hello","World"], "undumping!" );
 my $str = Dumper(@input);          # dump the data structure to a string
 my @parsed = Undump($str);         # parse the data structure back out
 # @parsed now looks identical to @input (is a deep copy)

 use Data::Undump::PPI qw/Dump Undump/;      # additionally import "Dump()"
 Dump(\@input, file=>'/tmp/test.conf');      # Data::Dumper to file
 my @conf = Undump(file=>'/tmp/test.conf');  # Undump directly from file

=head1 Description

This module allows for I undumping and round-tripping of data
structures from strings generated by L
(and possibly other dumper modules, but that's currently not explicitly supported).
It is a thin wrapper around L, so please
see L for more details, including the limitations.

When using L, make sure to always turn on its
C option and turn off its C option, as otherwise
L may produce code that may not evaluate
back to the same data structure, sometimes even though it's valid,
parseable Perl! See also L for a helper function.

=head2 C

 my @out = Undump($string);
 my @out = Undump(file => $filename);
 my @out = Undump(fh => $filehandle);

Accepts either a string, a filename or a filehandle, parses it and
attempts to return the data as it would have been passed to
L's C. This means that the C<$VAR1>,
C<$VAR2> etc. variable names generated by C will be removed and the
argument list passed to C is returned, and if the string ends
on a true value, that will be ignored so that parsing files which end on
e.g. C<1;>, like those generated by the L helper function, will work.

In list context, this function returns the list of values as they would
have been passed as the arguments to C. If you know that the
data contains only one value, you may call C in scalar context to
get that value.
If you call C in scalar context but the data contains more than
one value, currently the I value is returned and a warning is issued
(in the "Config::Perl" warnings category).

If the string doesn't look like the output of L,
this function will throw an exception, and any errors from
L's C will also be passed through.

If you used L's ability to give the dumped
variables user-specified names, you will need to use
L to parse that, since C only supports
the C<$VAR...> style output of C.

This function is exported by default.

=head2 C

 my $str = Dump(\@data);
 Dump(\@data, file => $filename);
 Dump(\@data, fh => $filehandle);
 Dump(\@data, ..., %dumper_options);  # e.g.:
 Dump(\@data, file => $filename, Deepcopy=>1);

This function is a simple helper for L which
sets some default options and always returns a string, optionally writing
that string to a file or filehandle.

The L options that can be set are:
C (default: off),  C (default: on),
C (default: off), C (default: on), and
C (default is L's default).
Note that C is always off and C is always on.

When writing to a file, the output is prefixed with C<#!perl> and
ended with C<1;>, this is I the case when writing to a filehandle.

=head2 More Details

This module aims to support most of L's features
except code references and (currently) Ced objects.
If you find a L data structure that this module
does not yet support, please feel free to send in your data structure, as
it can help extend L's features and help fix bugs.
Currently, using modules other than L may not work,
for example, L sometimes generates code with the C<..>
range operator, which is currently not supported by L.
In the future, this module's features may be extended to more fully support
dumper modules like L as well.

Although L now supports self-referential data
structures, you can also use L's C
option to get rid of references within data structures,
if the loss of references and copying of data is acceptable for your application.

This module is part of the L distribution,
but was named separately in an attempt to make its purpose more clear
and its name a little easier to remember.

This document describes version 0.06 of the module.
Although this module has a fair number of tests, it still lacks some
features (see L) and there may be bugs lurking.
Contributions are welcome!

=head1 Author, Copyright, and License

Copyright (c) 2015 Hauke Daempfling ([e-mail]).

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl 5 itself.

For more information see the L,
which should have been distributed with your copy of Perl.
Try the command "C" or see
L.

=cut

use Carp;
use Exporter 'import';

our @EXPORT = qw/Undump/;  ## no critic (ProhibitAutomaticExportation)
our @EXPORT_OK = qw/Undump Dump/;
our %EXPORT_TAGS = ( ':all' => [qw/Undump Dump/] );

use Config::Perl;
use Data::Dumper ();

sub Undump {  ## no critic (RequireArgUnpacking)
	my ($in);
	if (@_==1)
		{ $in = \( shift ) }
	elsif (@_==2) {
		my ($k,$v) = @_;
		if ($k eq 'file')
			{ $in = $v }
		elsif ($k eq 'fh') {
			local $/ = undef;
			$in = \( scalar <$v> );
		}
		else
			{ croak "Undump: unknown option \"$k\"" }
	}
	else
		{ croak "bad number of arguments to Undump" }
	croak "Undump was passed an undef value"
		unless defined $in;

	my $parsed = Config::Perl->new->parse_or_die($in);
	my $data_dumper=1; # does this look like Data::Dumper output?
	/^(?:\$VAR\d+|_)$/ or $data_dumper=0 for keys %$parsed;
	if (exists $$parsed{_}) {
		$data_dumper=0 unless @{ $$parsed{_} }==1 && $$parsed{_}[0];
		delete $$parsed{_};
	}
	croak "input doesn't look like Data::Dumper output"
		unless $data_dumper;
	# sort the $VAR\d+ variables correctly
	my @out =
		map { $$parsed{ $$_[0] } }
		sort { $$a[1] <=> $$b[1] }
		map { [$_, /^\$VAR(\d+)$/] }
		keys %$parsed;
	if (wantarray)
		{ return @out }
	else {
		warnings::warnif('Config::Perl','Undump was called in scalar context '
			.'but data contained more than one value') if @out>1;
		return $out[-1]; # behave like comma operator in scalar context
	}
}

sub Dump {  ## no critic (RequireArgUnpacking)
	my $data = shift;
	croak "first argument to Dump must be an arrayref"
		unless ref $data eq 'ARRAY';
	my %opts = @_;
	my %KNOWN_OPTS = map {$_=>1} qw/ fh file Deepcopy Useqq Quotekeys Sortkeys Indent /;
	exists $KNOWN_OPTS{$_} or croak "Dump: unknown option \"$_\""
		for keys %opts;
	croak "Dump: options fh and file may not be used together"
		if defined $opts{fh} && defined $opts{file};

	my $dd = Data::Dumper->new($data);
	$dd->Deepcopy (defined $opts{Deepcopy}  ? $opts{Deepcopy}  : 0);
	$dd->Useqq    (defined $opts{Useqq}     ? $opts{Useqq}     : 1);
	$dd->Quotekeys(defined $opts{Quotekeys} ? $opts{Quotekeys} : 0);
	$dd->Sortkeys (defined $opts{Sortkeys}  ? $opts{Sortkeys}  : 1);
	$dd->Indent($opts{Indent}) if defined $opts{Indent};
	$dd->Purity(1)->Terse(0);
	my $str = $dd->Dump;
	# I think Data::Dumper always ends on a semicolon, but just to be paranoid...
	$str .= ";" unless $str=~/;\s*$/;

	my $fh = $opts{fh};
	if (defined $opts{file}) {
		open $fh, '>', $opts{file}  ## no critic (RequireBriefOpen)
			or croak "Dump couldn't open \"$opts{file}\" for writing: $!";
		print $fh "#!perl\n";
	}
	if (defined $fh) {
		print $fh $str;
		# I think Data::Dumper always ends on a newline, but just to be paranoid...
		print $fh "\n" unless $str=~/\n\z/;
	}
	if (defined $opts{file}) {
		print $fh "1;\n";
		close $fh;
	}

	return $str;
}


1;