view release on metacpan or  search on metacpan

lib/ChordPro/Utils.pm  view on Meta::CPAN

    use Text::ParseWords qw(quotewords);
    my @words = quotewords( '\s+', 1, @lines );
    parse_kv( \@words );
}

push( @EXPORT, 'parse_kvm' );

# Odd/even.

sub is_odd( $arg ) {
    ( $arg % 2 ) != 0;
}
sub is_even( $arg ) {
    ( $arg % 2 ) == 0;
}

push( @EXPORT, qw( is_odd is_even ) );

# Map true/false etc to true / false.

sub is_true ( $arg ) {
    return 0 if !defined($arg) || $arg eq '';
    return 0 if $arg =~ /^(false|null|no|none|off|\s+|0)$/i;
    return !!$arg;
}

push( @EXPORT, 'is_true' );

# Stricter form of true.
sub is_ttrue ( $arg ) {
    return 0 if !defined($arg);
    $arg =~ /^(on|true|1)$/i;
}

push( @EXPORT, 'is_ttrue' );

# Fix apos -> quote.

sub fq ( $arg ) {
    $arg =~ s/'/\x{2019}/g;
    $arg;
}

push( @EXPORT, 'fq' );

# Quote a string if needed unless forced.

sub qquote ( $arg, $force = 0 ) {
    for ( $arg ) {
	s/([\\\"])/\\$1/g;
	s/([[:^print:]])/sprintf("\\u%04x", ord($1))/ge;
	return $_ unless /[\\\s]/ || $force;
	return qq("$_");
    }
}

push( @EXPORT, 'qquote' );

# Safely print values.

use Scalar::Util qw(looks_like_number);

# We want overload:
# sub pv( $val )
# sub pv( $label, $val )

sub pv {
    my $val   = pop;
    my $label = pop // "";

    my $suppressundef;
    if ( $label =~ /\?$/ ) {
	$suppressundef++;
	$label = $';
    }
    if ( defined $val ) {
	if ( looks_like_number($val) ) {
	    $val = sprintf("%.3f", $val);
	    $val =~ s/0+$//;
	    $val =~ s/\.$//;
	}
	else {
	    $val = qquote( $val, 1 );
	}
    }
    else {
	return "" if $suppressundef;
	$val = "<undef>"
    }
    defined wantarray ? $label.$val : warn($label.$val."\n");
}

push( @EXPORT, 'pv' );

# Processing JSON.

my $_json_xs;
my $_json_rr;
our $json_last;

sub json_load( $json, $source = "<builtin>" ) {

    # We have two JSON parsers: Relaxed and XS.
    # Relaxed accepts a lot of relaxing extensions, but XS is much
    # much faster. So fast, in fact, that trying XS first will be a
    # win in many cases, and a neglectable overhead in the other
    # cases.

    state $jx = JSON::XS->new;
    $jx->relaxed;

    # Glue lines, so we have at lease some relaxation.
    $json =~ s/"\s*\\\r?\n\s*"//g;

    my $data;
    $json_last = "xs";
    eval { $data = $jx->decode($json."\n"); $_json_xs++ };
    return $data if defined $data;

    require JSON::Relaxed;
    state $jr = JSON::Relaxed::Parser->new( croak_on_error => 0,
					    strict => 0,
					    prp => 1 );
    $_json_rr++;
    $json_last = "rr";
    $data = $jr->decode($json."\n");
    return $data unless $jr->is_error;
    $source .= ": " if $source;
    die("${source}JSON error: " . $jr->err_msg . "\n");
}

sub json_stats( $reset = 0 ) {
    my $res = { xs => $_json_xs//0, rr => $_json_rr//0 };
    if ( $reset ) {
	$_json_xs = $_json_rr = 0;
    }
    return $res;