view release on metacpan or  search on metacpan

lib/Config/JSON/Enhanced.pm  view on Meta::CPAN

package Config::JSON::Enhanced;

use 5.010;
use strict;
use warnings;

our $VERSION = '0.10';

use strict;
use warnings;

# which loads JSON::XS with a purel-perl JSON fallback
use JSON;

use Data::Roundtrip qw/json2perl perl2dump no-unicode-escape-permanently/;

use Exporter; # we have our own import() don't import it
our @ISA = qw(Exporter);
our @EXPORT = qw/
	config2perl
/;

# Convert enhanced JSON string into a Perl data structure.
# The input parameters hashref:
#  * specify where is the content to be parsed via:
#    'filename',
#    'filehandle', or,
#    'string'
#  * optional 'commentstyle' is a string of comma separated
#    commentstyles (valid styles are C, CPP, shell)
#  * optional 'variable-substitutions' is a hashref with
#    keys as template variable names to be substutited
#    inside the content with their corresponding values.
#    For example {'xx' => 'hello'} will substitute
#      <% xx %> with hello
#  * optional 'remove-comments-in-strings' to remove comments from JSON strings
#    (both keys and values), default is to KEEP anything inside a string
#    even if it looks like comments we are supposed to remove (because string
#    can be a bash script, for example).
#  * optional 'debug' for setting verbosity, default is zero.
#
# It returns the created Perl data structure or undef on failure.
sub	config2perl {
	my $params = shift // {};

	my $contents;
	if( exists($params->{'filename'}) && defined(my $infile=$params->{'filename'}) ){
		my $fh;
		if( ! open $fh, '<:encoding(UTF-8)', $infile ){ warn __PACKAGE__.'::configfile2perl()'." (line ".__LINE__.") : error, failed to open file '$infile' for reading, $!"; return undef }
		{ local $/ = undef; $contents = <$fh> }; close $fh;
	} elsif( exists($params->{'filehandle'}) && defined(my $fh=$params->{'filehandle'}) ){
		{ local $/ = undef; $contents = <$fh> }
		# we are not closing the filehandle, it is caller-specified, so caller responsibility
	} elsif( exists($params->{'string'}) && defined($params->{'string'}) ){
		$contents = $params->{'string'};
	}
	if( ! defined $contents ){ warn __PACKAGE__.'::configfile2perl()'." (line ".__LINE__.") : error, one of 'filename', 'filehandle' or 'string' must be specified in the parameters hash as the source of the configuration contents."; return undef }

	my $debug = exists($params->{'debug'}) && defined($params->{'debug'})
		? $params->{'debug'} : 0
	;

	my $commentstyle = exists($params->{'commentstyle'}) && defined($params->{'commentstyle'})
		? $params->{'commentstyle'} : 'C'
	;

	my ($tvop, $tvcl);
	if( exists($params->{'tags'}) && defined($params->{'tags'}) ){
		if( ref($params->{'tags'}) ne 'ARRAY' ){ warn __PACKAGE__.'::configfile2perl()'." (line ".__LINE__.") : error, input parameter 'tags' must be an ARRAYref of exactly 2 items and not a '".ref($params->{'tags'})."'."; return undef }
		if( scalar(@{ $params->{'tags'} }) != 2 ){ warn __PACKAGE__.'::configfile2perl()'." (line ".__LINE__.") : error, input parameter 'tags' must be an ARRAYref of exactly 2 items and not ".scalar(@{ $params->{'tags'} })."."; return undef }
		($tvop, $tvcl) = @{ $params->{'tags'} };
	} else { $tvop = '<%'; $tvcl = '%>' }

	# check that the tags for verbatim sections is not the same as comments
	while( $commentstyle =~ /\bcustom\((.+?)\)\((.*?)\)/ig ){

lib/Config/JSON/Enhanced.pm  view on Meta::CPAN

		for($idx=scalar(@stringsubs);$idx-->0;){
			my $astring = $stringsubs[$idx];
			$contents =~ s/___my___EJSTRING\($idx\)___my___/"${astring}"/g
		}
	}

	# and now substitute the transformed verbatim sections back
	for($idx=scalar(@verbs);$idx-->0;){
		$contents =~ s/___my___verbatim-section-${idx}___my___/$verbs[$idx]/g;
	}

	if( $debug > 0 ){ warn $contents."\n\n".__PACKAGE__.'::config2perl()'." (line ".__LINE__.") : produced above standard JSON from enhanced JSON content." }

	# here $contents must contain standard JSON which we parse:
	my $inhash = json2perl($contents);
	if( ! defined $inhash ){ warn $contents."\n\n".__PACKAGE__.'::config2perl()'." (line ".__LINE__.") : error, call to ".'Data::Roundtrip::json2perl()'." has failed for above json string and comments style '${commentstyle}'."; return undef }
	return $inhash
}

=pod

=head1 NAME

Config::JSON::Enhanced - JSON-based config with C/Shell-style comments, verbatim sections and variable substitutions

=head1 VERSION

Version 0.10

=head1 SYNOPSIS

This module provides subroutine C<config2perl()> for parsing configuration content,
from files or strings,  based on, what I call, "enhanced JSON" (see section
L<ENHANCED JSON FORMAT> for more details). Briefly, it is standard JSON which allows:

=over 2

=item * C<C>-style, C<C++>-style, C<shell>-style or custom comments.

=item * Template-style variables (e.g. C<E<lt>% appdir %E<gt>>)
which are substituted with user-specified data during parsing.

=item * Verbatim sections which are a sort of here-doc for JSON,
allowing strings to span multiple
lines, to contain single and double quotes unescaped,
to contain template-style variables.

=back

This module was created because I needed to include
long shell scripts containing lots of quotes and newlines,
in a configuration file which started as JSON.

The process is simple: so-called "enhanced JSON" is parsed
by L<config2perl>. Comments are removed, variables are
substituted, verbatim sections become one line again
and standard JSON is created. This is parsed with
L<JSON> (via L<Data::Roundtrip::json2perl>) to
produce a Perl data structure which is returned.

It has been tested with unicode data
(see C<t/070-config2perl-complex-utf8.t>)
with success. But who knows ?!?!

Here is an example:

    use Config::JSON::Enhanced;

    # simple "enhanced" JSON with comments in 3 styles: C,shell,CPP
    my $configdata = <<'EOJ';
     {
        /* 'a' is ... */
        "a" : "abc",
        # b is ...
        "b" : [1,2,3],
        "c" : 12 // c is ...
     }
    EOJ
    my $perldata = config2perl({
        'string' => $configdata,
        'commentstyle' => "C,shell,CPP",
    });
    die "call to config2perl() has failed" unless defined $perldata;
    # the standard JSON:
    # {"a" : "abc","b" : [1,2,3], "c" : 12}


    # this "enhanced" JSON demonstrates the use of variables
    # which will be substituted during the transformation to
    # standard JSON with user-specified data.
    # Notice that the opening and closing tags enclosing variable
    # names can be customised using the 'tags' input parameter,
    # so as to avoid clashes with content in the JSON.
    my $configdata = <<'EOJ';
     {
       "d" : [1,2,<% tempvar0 %>],
       "configfile" : "<%SCRIPTDIR%>/config/myapp.conf",
       "username" : "<% username %>"
        }
     }
    EOJ
    my $perldata = config2perl({
        'string' => $configdata,
        'commentstyle' => "C,shell,CPP",
        # optionally customise the tags enclosing the variables
        # when you want to avoid clashes with other strings in JSON
        #'tags' => ['<%', '%>'], # <<< these are the default values
        # user-specified data to replace the variables in
        # the "enhanced" JSON above:
        'variable-substitutions' => {
            'tempvar0' => 42,
            'username' => getlogin(),
            'SCRIPTDIR' => $FindBin::Bin,
        },
    });
    die "call to config2perl() has failed" unless defined $perldata;
    # the standard JSON
    # (notice how all variables in <%...%> are now replaced):
    # {"d" : [1,2,42],
    #  "username" : "yossarian",
    #  "configfile" : "/home/yossarian/B52/config/myapp.conf"