view release on metacpan or  search on metacpan

ext/yaml-test-schema/etc/generate-schema-html.pl  view on Meta::CPAN

#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;

use Data::Dumper;
use FindBin '$Bin';
use lib "$Bin/../lib";
use YAML::PP;
use URI::Escape qw/ uri_escape /;

my $file = "$Bin/../yaml-schema.yaml";
my $htmlfile = "$Bin/../gh-pages/data.html";

my $data = YAML::PP::LoadFile($file);

my %examples;

for my $input (sort keys %$data) {
    my $schemas = $data->{ $input };
    my @keys = keys %$schemas;
    for my $key (@keys) {
        my $def = $schemas->{ $key };
        my @schemas = split m/ *, */, $key;
        for my $schema (@schemas) {
            $examples{ $input }->{ $schema } = $def;
        }
    }
}
my @keys = qw/ failsafe json core yaml11 /;
for my $input (sort keys %examples) {
    my $schemas = $examples{ $input };
    my $str = 0;
    for my $schema (@keys) {
        my $example = $schemas->{ $schema };
        unless ($example) {
            $example = $schemas->{ $schema } = [ 'todo', '', '', '' ];
        }
        if ($example->[0] eq 'str' or $example->[0] eq 'todo') {
            $str++;
        }
    }
}

my %type_index = (
    null => 0,
    bool => 1,
    float => 2,
    inf => 3,
    nan => 4,
    int => 5,
    str => 6,
    todo => 7,
);
my $table = schema_table(\%examples);
my $html = generate_html($table);

open my $fh, '>', $htmlfile or die $!;
print $fh $html;
close $fh;

sub sort_rows {
    my ($x, $y, $a, $b) = @_;
           $type_index{ $x->{yaml11}->[0] } <=> $type_index{ $y->{yaml11}->[0] }
        || $type_index{ $x->{core}->[0] } <=> $type_index{ $y->{core}->[0] }
        || $type_index{ $x->{json}->[0] } <=> $type_index{ $y->{json}->[0] }
        || lc $a cmp lc $b
        || $a cmp $b
}
sub schema_table {
    my ($examples) = @_;
    my $html = '<table class="schema">';
    my @sorted = sort {
        sort_rows($examples->{ $a }, $examples->{ $b }, $a, $b)
    } grep { not m/^!!\w/ } keys %$examples;
    my @sorted_explicit = sort {
        sort_rows($examples->{ $a }, $examples->{ $b }, $a, $b)
    } grep { m/^!!\w/ } keys %$examples;
    my @all = (@sorted, @sorted_explicit);
    $html .= qq{<tr><th></th><th colspan="6">YAML 1.2</th><th colspan="2">YAML 1.1</th></tr>\n};
    my $header;
    $header .= qq{<tr><th>Input YAML</th>};
    $header .= join '', map {
        my $m = $_ eq 'YAML' ? 'YAML.pm' : $_;