#!/usr/bin/perl use strict; use warnings; use YAML::PP; use YAML::PP::Dumper; use YAML::PP::Common qw/ :PRESERVE /; use Encode; use Getopt::Long; Getopt::Long::Configure('bundling'); GetOptions( 'help|h' => \my $help, 'boolean=s' => \my $boolean, 'cyclic' => \my $cyclic, 'indent=i' => \my $indent, 'width=i' => \my $width, 'header!' => \my $header, 'footer!' => \my $footer, 'merge' => \my $merge, 'perl' => \my $perl, 'preserve|P=s' => \my $preserve, 'module|M=s' => \my $module, 'dump-module|D=s' => \my $dump_module, 'include' => \my $include, 'include-absolute' => \my $include_absolute, 'yaml-version=s' => \my $yaml_version, 'version-directive' => \my $version_directive, ) or usage(1); usage(0) if $help; $module ||= 'YAML::PP'; $boolean ||= 'JSON::PP'; $footer ||= 0; $indent ||= 2; $yaml_version ||= 1.2; $dump_module ||= $module; if ($dump_module eq 'YAML::PP::Ref') { $dump_module = 'YAML::PP'; } my @yaml_versions = split m/,/, $yaml_version; my @schema = ('+'); if ($merge) { push @schema, 'Merge'; } if ($perl) { push @schema, 'Perl'; } my $preserve_order = 1; if (defined $preserve) { $preserve_order = 0; my @split = split m/,/, $preserve; $preserve = 0; for my $split (@split) { $preserve |= PRESERVE_ORDER if $split eq 'order'; $preserve_order = 1 if $split eq 'order'; $preserve |= PRESERVE_SCALAR_STYLE if $split eq 'scalar'; $preserve |= PRESERVE_FLOW_STYLE if $split eq 'flow'; $preserve |= PRESERVE_ALIAS if $split eq 'alias'; } } elsif ($dump_module =~ m/JSON/) { $preserve = PRESERVE_ORDER; } else { $preserve = 1; } $header = 1 unless defined $header; my ($file) = @ARGV; my $yaml; my $decode = 1; if ($module eq 'YAML::XS') { $decode = 0; } if ($file) { open my $fh, '<', $file or die "Can not open '$file'"; $yaml = do { local $/; <$fh> }; close $fh; } else { $yaml = do { local $/; }; } $yaml = decode_utf8($yaml) if $decode; my %load_modules = ( 'YAML::PP' => \&yamlpp, 'YAML::PP::LibYAML' => \&yamlpplibyaml, 'YAML::PP::Ref' => \&yamlppref, 'YAML::XS' => \&yamlxs, 'YAML::Tiny' => \&yamltiny, 'YAML::Syck' => \&yamlsyck, 'YAML' => \&yaml, ); my %dump_modules = ( 'YAML::PP' => \&yamlpp_dump, 'YAML::PP::LibYAML' => \&yamlpplibyaml_dump, 'YAML::XS' => \&yamlxs_dump, 'YAML::Tiny' => \&yamltiny_dump, 'YAML::Syck' => \&yamlsyck_dump, 'YAML' => \&yaml_dump, 'Data::Dumper' => \&data_dumper, 'JSON::PP' => \&json_pp_dump, 'JSON::XS' => \&json_xs_dump, 'Cpanel::JSON::XS' => \&cpanel_json_xs_dump, ); my $code = $load_modules{ $module } or die "Module '$module' not supported for loading"; my $dump_code = $dump_modules{ $dump_module } or die "Module '$dump_module' not supported for dumping"; my $docs = $code->($yaml, $file); my $out_yaml = $dump_code->($docs); sub _yamlpp { my ($class, $yaml, $file) = @_; my %args; my $inc; if ($include) { require YAML::PP::Schema::Include; $inc = YAML::PP::Schema::Include->new( $include_absolute ? (allow_absolute => 1) : (), ); push @schema, $inc; } my $ypp = $class->new( schema => \@schema, boolean => $boolean, cyclic_refs => $cyclic ? 'allow' : 'fatal', preserve => $preserve, indent => $indent, width => $width, header => $header ? 1 : 0, footer => $footer ? 1 : 0, yaml_version => \@yaml_versions, version_directive => $version_directive || 0, ); if ($inc) { $inc->yp($ypp); } my @docs = $file ? $ypp->load_file($file) : $ypp->load_string($yaml); return \@docs; } sub yamlpp { _yamlpp('YAML::PP' => @_); } sub yamlpp_dump { _yamlpp_dump('YAML::PP' => @_); } sub yamlpplibyaml { eval { require YAML::PP::LibYAML }; _yamlpp('YAML::PP::LibYAML' => @_); } sub yamlppref { eval { require YAML::PP::Ref }; _yamlpp('YAML::PP::Ref' => @_); } sub yamlpplibyaml_dump { eval { require YAML::PP::LibYAML }; _yamlpp_dump('YAML::PP::LibYAML' => @_); } sub _yamlpp_dump { my ($class, $docs) = @_; my $ypp = $class->new( schema => \@schema, boolean => $boolean, preserve => $preserve, indent => $indent, width => $width, header => $header ? 1 : 0, footer => $footer ? 1 : 0, yaml_version => \@yaml_versions, version_directive => $version_directive || 0, ); return $ypp->dump_string(@$docs); } sub yamlxs { eval { require YAML::XS }; my ($yaml) = @_; no warnings 'once'; local $YAML::XS::LoadBlessed = $perl; my @docs = YAML::XS::Load($yaml); return \@docs; } sub yamlxs_dump { my ($docs) = @_; eval { require YAML::XS }; no warnings 'once'; local $YAML::XS::Indent = $indent; return YAML::XS::Dump(@$docs); } sub yamlsyck { eval { require YAML::Syck }; my ($yaml) = @_; no warnings 'once'; local $YAML::Syck::LoadBlessed = $perl; local $YAML::Syck::ImplicitTyping = 1; local $YAML::Syck::ImplicitUnicode = 1; my @docs = YAML::Syck::Load($yaml); return \@docs; } sub yamlsyck_dump { eval { require YAML::Syck }; my ($docs) = @_; no warnings 'once'; local $YAML::Syck::Headless = 1 unless $header; local $YAML::Syck::ImplicitTyping = 1; local $YAML::Syck::ImplicitUnicode = 1; return YAML::Syck::Dump(@$docs); } sub yaml { eval { require YAML }; no warnings 'once'; local $YAML::LoadBlessed = $perl; my ($yaml) = @_; my @docs = YAML::Load($yaml); return \@docs; } sub yaml_dump { my ($docs) = @_; eval { require YAML }; no warnings 'once'; local $YAML::UseHeader = $header ? 1 : 0; local $YAML::Indent = $indent; return YAML::Dump(@$docs); } sub yamltiny { eval { require YAML::Tiny }; my ($yaml) = @_; my @docs = YAML::Tiny::Load($yaml); return \@docs; } sub yamltiny_dump { eval { require YAML::Tiny }; my ($docs) = @_; return YAML::Tiny::Dump(@$docs); } sub data_dumper { my ($docs) = @_; local $Data::Dumper::Useqq = 1; local $Data::Dumper::Sortkeys = 1 unless $preserve_order; my $out = ''; $out .= Data::Dumper->Dump([$docs->[ $_ ]], ["doc$_"]) for 0 ..$#$docs; return $out; } sub json_pp_dump { require JSON::PP; _json_dump('JSON::PP', @_) } sub json_xs_dump { require JSON::XS; _json_dump('JSON::XS', @_) } sub cpanel_json_xs_dump { require Cpanel::JSON::XS; _json_dump('Cpanel::JSON::XS', @_) } sub _json_dump { my ($class, $docs) = @_; my $coder = $class->new->ascii->pretty->allow_nonref->space_before(0); $coder = $coder->indent_length($indent) if $coder->can('indent_length'); $coder = $coder->canonical unless $preserve_order; my $out = ''; $out .= $coder->encode($docs->[ $_ ]) for 0 ..$#$docs; return $out; } if ($decode) { print encode_utf8 $out_yaml; } else { print $out_yaml; } sub usage { my ($rc) = @_; print <<"EOM"; Usage: $0 [options] < file $0 [options] file Options: --boolean= 'perl', 'JSON::PP', 'boolean' --cyclic Allow cyclic references --indent= Number of spaces for indentation --width= Maximum column width (only used in flow style for now) --[no-]header Print '---' (default) --[no-]footer Print '...' --merge Enable loading merge keys '<<' --perl Enable loading perl types and objects (use only on trusted input!) --preserve, -P Comma separated: 'order', 'scalar', 'flow', 'alias'. Set to 0 to preserve nothing. By default all things are preserved --module -M YAML::PP (default), YAML, YAML::PP::LibYAML, YAML::Syck, YAML::Tiny, YAML::XS, YAML::PP::Ref --dump-module -D All of the above plus Data::Dumper, JSON::PP, JSON::XS, Cpanel::JSON::XS --yaml-version= '1.2' (default), '1.1', '1.2,1.1', '1.1,1.2' --version-directive Print '%YAML ' --include Enable Include Schema --include-absolute Allow absolute paths and ../../../ in includes (use only on trusted input!) EOM exit $rc; }