#!/usr/bin/perl
Getopt::Long::Configure(
'bundling'
);
GetOptions(
'help|h'
=> \
my
$help
,
'boolean=s'
=> \
my
$boolean
,
'cyclic'
=> \
my
$cyclic
,
'duplicate-keys'
=> \
my
$duplicate_keys
,
'merge'
=> \
my
$merge
,
'require-footer'
=> \
my
$require_footer
,
'perl'
=> \
my
$perl
,
'module|M=s'
=> \
my
$module
,
'yaml-version=s'
=> \
my
$yaml_version
,
) or usage(1);
usage(0)
if
$help
;
$module
||=
'YAML::PP'
;
$boolean
||=
'JSON::PP'
;
$yaml_version
||= 1.2;
my
@yaml_versions
=
split
m/,/,
$yaml_version
;
my
@schema
= (
'+'
);
if
(
$merge
) {
push
@schema
,
'Merge'
;
}
if
(
$perl
) {
push
@schema
,
'Perl'
;
}
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::PP::Ref'
=> \
&yamlppref
,
'YAML::XS'
=> \
&yamlxs
,
'YAML::Tiny'
=> \
&yamltiny
,
'YAML::Syck'
=> \
&yamlsyck
,
'YAML'
=> \
&yaml
,
);
my
$code
=
$codes
{
$module
} or
die
"Module '$module' not supported"
;
my
@docs
=
$code
->(
$yaml
);
sub
_yamlpp {
my
(
$class
,
$yaml
) =
@_
;
my
$ypp
=
$class
->new(
schema
=> \
@schema
,
boolean
=>
$boolean
,
cyclic_refs
=>
$cyclic
?
'allow'
:
'fatal'
,
duplicate_keys
=>
$duplicate_keys
? 1 : 0,
preserve
=> PRESERVE_ORDER,
yaml_version
=> \
@yaml_versions
,
require_footer
=>
$require_footer
,
);
my
@docs
=
$ypp
->load_string(
$yaml
);
return
@docs
;
}
sub
yamlpp {
_yamlpp(
'YAML::PP'
=>
$_
[0]);
}
sub
yamlpplibyaml {
_yamlpp(
'YAML::PP::LibYAML'
=>
$_
[0]);
}
sub
yamlppref {
_yamlpp(
'YAML::PP::Ref'
=>
$_
[0]);
}
sub
yamlxs {
my
(
$yaml
) =
@_
;
no
warnings
'once'
;
local
$YAML::XS::LoadBlessed
=
$perl
;
return
YAML::XS::Load(
$yaml
);
}
sub
yamlsyck {
my
(
$yaml
) =
@_
;
no
warnings
'once'
;
local
$YAML::Syck::LoadBlessed
=
$perl
;
local
$YAML::Syck::ImplicitTyping
= 1;
local
$YAML::Syck::ImplicitUnicode
= 1;
return
YAML::Syck::Load(
$yaml
);
}
sub
yaml {
my
(
$yaml
) =
@_
;
no
warnings
'once'
;
local
$YAML::LoadBlessed
=
$perl
;
return
YAML::Load(
$yaml
);
}
sub
yamltiny {
my
(
$yaml
) =
@_
;
return
YAML::Tiny::Load(
$yaml
);
}
local
$Data::Dumper::Useqq
= 1;
local
$Data::Dumper::Sortkeys
= 1;
print
Data::Dumper->Dump([
$docs
[
$_
]], [
"doc$_"
])
for
0 ..
$#docs
;
sub
usage {
my
(
$rc
) =
@_
;
print
<<"EOM";
Usage:
$0 [options] < file
$0 [options] file
Options:
--boolean= 'perl', 'JSON::PP', 'boolean'
--cyclic Allow cyclic references
--duplicate-keys Allow duplicate keys
--merge Enable loading merge keys '<<'
--require-footer Require '...' and the end of each document
--perl Enable loading perl types and objects (use only
on trusted input!)
--module -M YAML::PP (default), YAML, YAML::PP::LibYAML,
YAML::Syck, YAML::Tiny, YAML::XS, YAML::PP::Ref
--yaml-version= '1.2' (default), '1.1', '1.2,1.1', '1.1,1.2'
EOM
exit
$rc
;
}