#!/usr/bin/perl
use strict;
use warnings;
use YAML::PP;
use YAML::PP::Dumper;
use YAML::PP::Common qw/ PRESERVE_ORDER PRESERVE_SCALAR_STYLE PRESERVE_FLOW_STYLE /;
use Encode;
use Getopt::Long;
GetOptions(
'help|h' => \my $help,
'indent=i' => \my $indent,
'width=i' => \my $width,
'header!' => \my $header,
'footer!' => \my $footer,
'boolean=s' => \my $boolean,
'merge' => \my $merge,
'perl' => \my $perl,
'preserve=s' => \my $preserve,
'module|M=s' => \my $module,
'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;
my @yaml_versions = split m/,/, $yaml_version;
my @schema = ('+');
if ($merge) {
push @schema, 'Merge';
}
if ($perl) {
push @schema, 'Perl';
}
if (defined $preserve) {
my @split = split m/,/, $preserve;
$preserve = 0;
for my $split (@split) {
$preserve |= PRESERVE_ORDER if $split eq 'order';
$preserve |= PRESERVE_SCALAR_STYLE if $split eq 'scalar';
$preserve |= PRESERVE_FLOW_STYLE if $split eq 'flow';
}
}
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 $/; <STDIN> };
}
$yaml = decode_utf8($yaml) if $decode;
my %codes = (
'YAML::PP' => \&yamlpp,
'YAML::PP::LibYAML' => \&yamlpplibyaml,
'YAML::XS' => \&yamlxs,
'YAML::Tiny' => \&yamltiny,
'YAML::Syck' => \&yamlsyck,
'YAML' => \&yaml,
);
my $code = $codes{ $module } or die "Module '$module' not supported";
my $out_yaml = $code->($yaml);
sub _yamlpp {
my ($class, $yaml) = @_;
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,
);
my @docs = $ypp->load_string($yaml);
return $ypp->dump_string(@docs);
}
sub yamlpp {
_yamlpp('YAML::PP' => $_[0]);
}
sub yamlpplibyaml {
eval { require YAML::PP::LibYAML };
_yamlpp('YAML::PP::LibYAML' => $_[0]);
}
sub yamlxs {
eval { require YAML::XS };
my ($yaml) = @_;
no warnings 'once';
local $YAML::XS::LoadBlessed = $perl;
local $YAML::XS::Indent = $indent;
my $data = YAML::XS::Load($yaml);
return YAML::XS::Dump($data);
}
sub yamlsyck {
eval { require YAML::Syck };
my ($yaml) = @_;
no warnings 'once';
local $YAML::Syck::Headless = 1 unless $header;
local $YAML::Syck::LoadBlessed = $perl;
local $YAML::Syck::ImplicitTyping = 1;
local $YAML::Syck::ImplicitUnicode = 1;
my $data = YAML::Syck::Load($yaml);
return YAML::Syck::Dump($data);
}
sub yaml {
eval { require YAML };
no warnings 'once';
local $YAML::LoadBlessed = $perl;
local $YAML::UseHeader = $header ? 1 : 0;
local $YAML::Indent = $indent;
my ($yaml) = @_;
my $data = YAML::Load($yaml);
return YAML::Dump($data);
}
sub yamltiny {
eval { require YAML::Tiny };
my ($yaml) = @_;
my $data = YAML::Tiny::Load($yaml);
return YAML::Tiny::Dump($data);
}
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'
--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 Comma separated: 'order', 'scalar', 'flow'. By
default all things are preserved
--module -M YAML::PP (default), YAML, YAML::PP::LibYAML,
YAML::Syck, YAML::Tiny, YAML::XS
--yaml-version= '1.2' (default), '1.1', '1.2,1.1', '1.1,1.2'
--version-directive Print '%YAML <version>'
EOM
exit $rc;
}