1#!/usr/bin/env perl
2use strict;
3use warnings;
4use 5.010;
5
6use Data::Dumper;
7use FindBin '$Bin';
8use lib "$Bin/../lib";
9use YAML::PP;
10use JSON::PP;
11$YAML::XS::Boolean = 'JSON::PP';
12use YAML::XS ();
13$YAML::Syck::ImplicitTyping = 1;
14use YAML::Syck ();
15$YAML::Numify = 1;
16use YAML ();
17use B;
18my $int_flags = B::SVp_IOK;
19my $float_flags = B::SVp_NOK;
20
21#my $yp = YAML::PP->new( schema =>
22my $file = "$Bin/../examples/yaml-schema.yaml";
23my $outputfile = "$Bin/../examples/yaml-schema-modules.yaml";
24
25my $data = YAML::PP::LoadFile($file);
26
27my %examples;
28my %output;
29my %special = (
30    (0+'nan').'' => 'nan',
31    (0+'inf').'' => 'inf',
32    (0-'inf').'' => 'inf'
33);
34
35for my $key (sort keys %$data) {
36    my @schemas = split m/ *, */, $key;
37    my $examples = $data->{ $key };
38    for my $example (@$examples) {
39        my ($type, $in) = @$example;
40        for my $mod (qw/ YAML YAML::XS YAML::Syck /) {
41            my $out = $output{ $in }->{ $mod } ||= {};
42            my $output;
43            my $load = $mod->can("Load");
44            my $dump = $mod->can("Dump");
45            my $data = eval { $load->("--- $in") };
46            if ($@) {
47                $out->{error} = 1;
48                $out->{type} = 'error';
49            }
50            else {
51                $out->{type} = get_type($data);
52                $output = $dump->($data);
53                chomp $output;
54                $output =~ s/^--- //;
55                $out->{dump} = $output;
56            }
57        }
58    }
59}
60
61YAML::PP::DumpFile($outputfile, \%output);
62
63sub get_type {
64    my ($value) = @_;
65    return 'null' unless defined $value;
66    if (ref $value) {
67        if (ref $value eq 'JSON::PP::Boolean') {
68            return 'bool';
69        }
70        return 'unknown';
71    }
72    my $flags = B::svref_2object(\$value)->FLAGS;
73    if ($flags & $float_flags) {
74        if (exists $special{ $value }) {
75            return $special{ $value };
76        }
77        return 'float';
78    }
79    if ($flags & $int_flags) {
80        return 'int';
81    }
82    return 'str';
83}
84