require
5.6.1;
our
$VERSION
=
'0.49_50'
;
our
@EXPORT
=
qw'Dump Load'
;
our
@EXPORT_OK
=
qw'freeze thaw DumpFile LoadFile Bless Blessed'
;
sub
can {
(
$_
[1] eq
'import'
and
caller
()->isa(
'autouse'
))
? \
&Exporter::import
:
$_
[0]->SUPER::can(
$_
[1])
}
use
constant
VALUE
=>
"\x07YAML\x07VALUE\x07"
;
our
$SpecVersion
=
'1.0'
;
our
$LoaderClass
=
''
;
our
$DumperClass
=
''
;
our
$Indent
= 2;
our
$UseHeader
= 1;
our
$UseVersion
= 0;
our
$SortKeys
= 1;
our
$AnchorPrefix
=
''
;
our
$UseCode
= 0;
our
$DumpCode
=
''
;
our
$LoadCode
=
''
;
our
$UseBlock
= 0;
our
$UseFold
= 0;
our
$CompressSeries
= 1;
our
$UseAliases
= 1;
field
dumper_class
=>
'YAML::Dumper'
;
field
loader_class
=>
'YAML::Loader'
;
field
dumper_object
=>
-init
=>
'$self->init_action_object("dumper")'
;
field
loader_object
=>
-init
=>
'$self->init_action_object("loader")'
;
sub
Dump {
my
$yaml
=
'YAML'
->new;
$yaml
->dumper_class(
$DumperClass
)
if
$DumperClass
;
return
$yaml
->dumper_object->
dump
(
@_
);
}
sub
Load {
my
$yaml
= YAML->new;
$yaml
->loader_class(
$LoaderClass
)
if
$LoaderClass
;
return
$yaml
->loader_object->load(
@_
);
}
sub
DumpFile {
my
$filename
=
shift
;
local
$/ =
"\n"
;
my
$mode
=
'>'
;
if
(
$filename
=~ /^\s*(>{1,2})\s*(.*)$/) {
(
$mode
,
$filename
) = ($1, $2);
}
open
my
$OUT
,
$mode
,
$filename
or
$self
->
die
(
"Can't open '$filename' for output:\n$!"
);
print
$OUT
Dump(
@_
);
}
{
no
warnings
'once'
;
*freeze
= \
&Dump
;
*thaw
= \
&Load
;
}
sub
LoadFile {
my
$filename
=
shift
;
open
my
$IN
,
$filename
or
$self
->
die
(
"Can't open '$filename' for input:\n$!"
);
return
Load(
do
{
local
$/; <
$IN
> });
}
sub
init_action_object {
my
$self
=
shift
;
my
$object_class
= (
shift
) .
'_class'
;
my
$module_name
=
$self
->
$object_class
;
eval
"require $module_name"
;
die
"Error in require $module_name - $@"
if
$@ and
"$@"
!~ /Can't locate/;
my
$object
=
$self
->
$object_class
->new;
$object
->set_global_options;
return
$object
;
}
my
$global
= {};
sub
Bless {
YAML::Dumper::Base::
bless
(
$global
,
@_
)
}
sub
Blessed {
YAML::Dumper::Base::blessed(
$global
,
@_
)
}
sub
global_blessings {
$global
}