App-NDTools

 view release on metacpan or  search on metacpan

lib/App/NDTools/Slurp.pm  view on Meta::CPAN

        relaxed => 1,
        space_before => 0,
    },
);

use constant {
    TRUE  => JSON::true,
    FALSE => JSON::false,
};

sub _decode_yaml($) {
    require YAML::XS;

    my $data = YAML::XS::Load($_[0]);

    # YAML::XS decode boolean vals as PL_sv_yes and PL_sv_no, both - read only
    # at least until https://github.com/ingydotnet/yaml-libyaml-pm/issues/25
    # second thing here: get rid of dualvars: YAML::XS load numbers as
    # dualvars, but JSON::XS dumps them as strings =(

    my @stack = (\$data);

lib/App/NDTools/Slurp.pm  view on Meta::CPAN

                }
            }
        } elsif (is_number ${$ref}) {
            ${$ref} += 0;
        }
    }

    return $data;
}

sub _encode_yaml($) {
    require YAML::XS;
    my $modern_yaml_xs = eval { YAML::XS->VERSION(0.67) };

    # replace booleans for YAML::XS (accepts only boolean and JSON::PP::Boolean
    # since 0.67 and PL_sv_yes/no in earlier versions). No roundtrip for
    # versions < 0.67: 1 and 0 used for booleans (there is no way to set
    # PL_sv_yes/no into arrays/hashes without XS code)

    my ($false, $true) = (0, 1);

lib/App/NDTools/Slurp.pm  view on Meta::CPAN

                }
            }
        } elsif (ref ${$ref} eq $bool_type) {
            ${$ref} = ${$ref} ? $true : $false;
        }
    }

    return YAML::XS::Dump($_[0]);
}

sub s_decode($$;$) {
    my ($data, $fmt, $opts) = @_;
    my $format = uc($fmt);

    if ($format eq 'JSON') {
        my $o = { %{$FORMATS{JSON}}, %{$opts || {}} };
        $data = eval {
            JSON->new(
                )->allow_nonref($o->{allow_nonref}
                )->relaxed($o->{relaxed}
            )->decode($data);

lib/App/NDTools/Slurp.pm  view on Meta::CPAN

        ;
    } else {
        die_fatal "Unable to decode '$fmt' (not supported)";
    }

    die_fatal "Failed to decode '$fmt': " . $@, 4 if $@;

    return $data;
}

sub s_dump(@) {
    my ($uri, $fmt, $opts) = splice @_, 0, 3;

    $uri = \*STDOUT if ($uri eq '-');

    $fmt = s_fmt_by_uri($uri) unless (defined $fmt);
    my $data = join('', map { s_encode($_, $fmt, $opts) } @_);

    if (ref $uri eq 'GLOB') {
        print $uri $data;
    } else {
        s_dump_file($uri, $data);
    }
}

sub s_dump_file($$) {
    my ($file, $data) = @_;

    open(my $fh, '>', $file) or die_fatal "Failed to open '$file' ($!)", 2;
    print $fh $data;
    close($fh);
}

sub s_encode($$;$) {
    my ($data, $fmt, $opts) = @_;
    my $format = uc($fmt);

    if ($format eq 'JSON' or $format eq 'RAW' and ref $data) {
        my $o = { %{$FORMATS{JSON}}, %{$opts || {}} };
        $data = eval {
            JSON->new(
                )->allow_nonref($o->{allow_nonref}
                )->canonical($o->{canonical}
                )->pretty($o->{pretty}

lib/App/NDTools/Slurp.pm  view on Meta::CPAN

        $data .= "\n";
    } else {
        die_fatal "Unable to encode to '$fmt' (not supported)";
    }

    die_fatal "Failed to encode structure to $fmt: " . $@, 4 if $@;

    return $data;
}

sub s_fmt_by_uri($) {
    my @names = split(/\./, basename(shift));
    if (@names and @names > 1) {
        my $ext = uc($names[-1]);
        return 'YAML' if ($ext eq 'YML' or $ext eq 'YAML');
    }

    return 'JSON'; # by default
}

sub s_load($$;@) {
    my ($uri, $fmt, %opts) = @_;

    $uri = \*STDIN if ($uri eq '-');
    my $data = s_load_uri($uri);
    $fmt = s_fmt_by_uri($uri) unless (defined $fmt);

    return s_decode($data, $fmt);
}

sub s_load_uri($) {
    my $uri = shift;
    my $data;

    if (ref $uri eq 'GLOB') {
        $data = do { local $/; <$uri> };
    } else {
        open(my $fh, '<', $uri) or
            die_fatal "Failed to open file '$uri' ($!)", 2;
        $data = do { local $/; <$fh> }; # load whole file
        close($fh);

lib/App/NDTools/Util.pm  view on Meta::CPAN

use warnings FATAL => 'all';
use parent 'Exporter';

use B qw(SVp_IOK SVp_NOK svref_2object);

our @EXPORT_OK = qw(
    chomp_evaled_error
    is_number
);

sub chomp_evaled_error($) {
    $_[0] =~ s/ at .+ line \d+\.*//;
    chomp $_[0];

    return $_[0];
}

sub is_number($) {
    return svref_2object(\$_[0])->FLAGS & (SVp_IOK | SVp_NOK);
}

1; # End of App::NDTools::Util