kivitendo/modules/override/YAML.pm @ f3087a89
| 99ed8abf | Moritz Bunkus | package YAML;
|
||
| c6bc1816 | Sven Schöling | our $VERSION = '1.14';
|
||
use YAML::Mo;
|
||||
use Exporter;
|
||||
push @YAML::ISA, 'Exporter';
|
||||
our @EXPORT = qw{ Dump Load };
|
||||
our @EXPORT_OK = qw{ freeze thaw DumpFile LoadFile Bless Blessed };
|
||||
use YAML::Node; # XXX This is a temp fix for Module::Build
|
||||
| 99ed8abf | Moritz Bunkus | |||
# XXX This VALUE nonsense needs to go.
|
||||
use constant VALUE => "\x07YAML\x07VALUE\x07";
|
||||
# YAML Object Properties
|
||||
| c6bc1816 | Sven Schöling | has dumper_class => default => sub {'YAML::Dumper'};
|
||
has loader_class => default => sub {'YAML::Loader'};
|
||||
has dumper_object => default => sub {$_[0]->init_action_object("dumper")};
|
||||
has loader_object => default => sub {$_[0]->init_action_object("loader")};
|
||||
| 99ed8abf | Moritz Bunkus | |||
sub Dump {
|
||||
my $yaml = YAML->new;
|
||||
$yaml->dumper_class($YAML::DumperClass)
|
||||
if $YAML::DumperClass;
|
||||
return $yaml->dumper_object->dump(@_);
|
||||
}
|
||||
sub Load {
|
||||
my $yaml = YAML->new;
|
||||
$yaml->loader_class($YAML::LoaderClass)
|
||||
if $YAML::LoaderClass;
|
||||
return $yaml->loader_object->load(@_);
|
||||
}
|
||||
{
|
||||
no warnings 'once';
|
||||
# freeze/thaw is the API for Storable string serialization. Some
|
||||
# modules make use of serializing packages on if they use freeze/thaw.
|
||||
*freeze = \ &Dump;
|
||||
*thaw = \ &Load;
|
||||
}
|
||||
sub DumpFile {
|
||||
my $OUT;
|
||||
my $filename = shift;
|
||||
if (ref $filename eq 'GLOB') {
|
||||
$OUT = $filename;
|
||||
}
|
||||
else {
|
||||
my $mode = '>';
|
||||
if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
|
||||
($mode, $filename) = ($1, $2);
|
||||
}
|
||||
open $OUT, $mode, $filename
|
||||
| c6bc1816 | Sven Schöling | or YAML::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT', $filename, $!);
|
||
}
|
||||
binmode $OUT, ':utf8'; # if $Config{useperlio} eq 'define';
|
||||
| 99ed8abf | Moritz Bunkus | local $/ = "\n"; # reset special to "sane"
|
||
print $OUT Dump(@_);
|
||||
}
|
||||
sub LoadFile {
|
||||
my $IN;
|
||||
my $filename = shift;
|
||||
if (ref $filename eq 'GLOB') {
|
||||
$IN = $filename;
|
||||
}
|
||||
else {
|
||||
| c6bc1816 | Sven Schöling | open $IN, '<', $filename
|
||
or YAML::Mo::Object->die('YAML_LOAD_ERR_FILE_INPUT', $filename, $!);
|
||||
| 99ed8abf | Moritz Bunkus | }
|
||
| c6bc1816 | Sven Schöling | binmode $IN, ':utf8'; # if $Config{useperlio} eq 'define';
|
||
| 99ed8abf | Moritz Bunkus | 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";
|
||||
$self->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 {
|
||||
require YAML::Dumper::Base;
|
||||
YAML::Dumper::Base::bless($global, @_)
|
||||
}
|
||||
sub Blessed {
|
||||
require YAML::Dumper::Base;
|
||||
YAML::Dumper::Base::blessed($global, @_)
|
||||
}
|
||||
sub global_object { $global }
|
||||
1;
|