summaryrefslogtreecommitdiff
path: root/lib/YAML.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/YAML.pm')
-rw-r--r--lib/YAML.pm100
1 files changed, 100 insertions, 0 deletions
diff --git a/lib/YAML.pm b/lib/YAML.pm
new file mode 100644
index 0000000..854bd76
--- /dev/null
+++ b/lib/YAML.pm
@@ -0,0 +1,100 @@
+package YAML;
+our $VERSION = '1.15';
+
+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
+
+# XXX This VALUE nonsense needs to go.
+use constant VALUE => "\x07YAML\x07VALUE\x07";
+
+# YAML Object Properties
+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")};
+
+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
+ or YAML::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT', $filename, $!);
+ }
+ binmode $OUT, ':utf8'; # if $Config{useperlio} eq 'define';
+ local $/ = "\n"; # reset special to "sane"
+ print $OUT Dump(@_);
+}
+
+sub LoadFile {
+ my $IN;
+ my $filename = shift;
+ if (ref $filename eq 'GLOB') {
+ $IN = $filename;
+ }
+ else {
+ open $IN, '<', $filename
+ or YAML::Mo::Object->die('YAML_LOAD_ERR_FILE_INPUT', $filename, $!);
+ }
+ binmode $IN, ':utf8'; # if $Config{useperlio} eq 'define';
+ 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;