App-NDTools

 view release on metacpan or  search on metacpan

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

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
        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

75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
                }
            }
        } 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

124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
                }
            }
        } 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

149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
        ;
    } 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

199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
        $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

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
use warnings FATAL => 'all';
use parent 'https://metacpan.org/pod/Exporter">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