view release on metacpan or  search on metacpan

lib/ChordPro/lib/JSON/Relaxed/Parser.pm  view on Meta::CPAN

    my @keys = split(/\./, $key, -1 );
    my $c = \$rv;
    for ( @keys ) {
	if ( /^[+-]?\d+$/ ) {
	    $c = \( $$c->[$_] );
	}
	else {
	    $c = \( $$c->{$_} );
	}
    }
    $$c = $value;
}

method build_array() {

    my $rv = [];

    # Build array. Work through tokens until closing brace.
    while ( @tokens ) {
	my $this = shift(@tokens);

	my $t = $this->token;
	# Closing brace: we're done building this array.
	return $rv if $t eq ']';

	# Comma: if we get to a comma at this point, and we have
	# content, do nothing with it in strict mode. Ignore otherwise.
	if ( $t eq ',' && (!$strict || @$rv) ) {
	}

	# Opening brace of hash or array.
	elsif ( $this->is_list_opener ) {
	    unshift( @tokens, $this );
	    my $object = $self->structure;
	    defined($object) or return undef;
	    push( @$rv, $object );
	}

	# if string, add it to the array
	elsif ( $this->is_string ) {
	    # add the string to the array
	    push( @$rv, $this->as_perl );

	    # Check following token.
	    if ( @tokens ) {
		my $next = $tokens[0] || '';
		# Spec say: Commas are optional between objects pairs
		# and array items.
		# The next element must be a comma or the closing brace,
		# or a string or list.
		# Anything else is an error.
		unless ( $next->token =~ /^[,\]]$/
			 || $next->is_string
			 || $next->is_list_opener ) {
		    return $self->error( 'missing_comma-between-array-elements',
					 $next );
		}
	    }
	}

	# Else unkown object or character, so throw error.
	else {
	    return $self->error( 'unknown-array-token', $this );
	}
    }

    # If we get this far then unclosed brace.
    return $self->error('unclosed-array-brace');
}

method is_comment_opener( $pretok ) {
    $pretok eq '//' || $pretok eq '/*';
}

use List::Util qw( min max uniqstr );

method encode(%opts) {
    my $schema  = $opts{schema};
    my $level   = $opts{level}              // 0;
    my $rv      = $opts{data};			# allow undef
    my $indent  = $opts{indent}             // 2;
    my $impoh   = $opts{implied_outer_hash} // $implied_outer_hash;
    my $ckeys   = $opts{combined_keys}      // $combined_keys;
    my $prpmode = $opts{prp}                // $prp;
    my $pretty  = $opts{pretty}             // $pretty;
    my $strict  = $opts{strict}             // $strict;
    my $nouesc  = $opts{nounicodeescapes}   // 0;

    if ( $strict ) {
	$ckeys = $prpmode = $impoh = 0;
    }

    $schema = resolve( $schema, $schema ) if $schema;

    my $s = "";
    my $i = 0;
    my $props = $schema->{properties};
    #warn("L$level - ", join(" ", sort keys(%$props)),"\n");

    # Add comments from schema, if any.
    my $comments = sub( $p ) {
	my $s = "";
	my $did = 0;#$level;
	for my $topic ( qw( title description ) ) {
	    next unless $p->{$topic};
	    $s .= "\n" unless $did++;
	    $s .= (" " x $i) . "// $_\n"
	      for split( /\s*<br\/?>|\\n|\n/, $p->{$topic} );
	}
	return $s;
    };

    if ( !$level ) {
	$s .= $comments->($schema);
    }

    # Format a string value.
    my $pr_string = sub ( $str, $force = 0 ) {

	# Reserved strings.
	if ( !defined($str) ) {