modules/override/YAML.pm

   1 package YAML;
   2 our $VERSION = '1.14';
   3
   4 use YAML::Mo;
   5
   6 use Exporter;
   7 push @YAML::ISA, 'Exporter';
   8 our @EXPORT = qw{ Dump Load };
   9 our @EXPORT_OK = qw{ freeze thaw DumpFile LoadFile Bless Blessed };
  10
  11 use YAML::Node; # XXX This is a temp fix for Module::Build
  12
  13 # XXX This VALUE nonsense needs to go.
  14 use constant VALUE => "\x07YAML\x07VALUE\x07";
  15
  16 # YAML Object Properties
  17 has dumper_class => default => sub {'YAML::Dumper'};
  18 has loader_class => default => sub {'YAML::Loader'};
  19 has dumper_object => default => sub {$_[0]->init_action_object("dumper")};
  20 has loader_object => default => sub {$_[0]->init_action_object("loader")};
  21
  22 sub Dump {
  23     my $yaml = YAML->new;
  24     $yaml->dumper_class($YAML::DumperClass)
  25         if $YAML::DumperClass;
  26     return $yaml->dumper_object->dump(@_);
  27 }
  28
  29 sub Load {
  30     my $yaml = YAML->new;
  31     $yaml->loader_class($YAML::LoaderClass)
  32         if $YAML::LoaderClass;
  33     return $yaml->loader_object->load(@_);
  34 }
  35
  36 {
  37     no warnings 'once';
  38     # freeze/thaw is the API for Storable string serialization. Some
  39     # modules make use of serializing packages on if they use freeze/thaw.
  40     *freeze = \ &Dump;
  41     *thaw   = \ &Load;
  42 }
  43
  44 sub DumpFile {
  45     my $OUT;
  46     my $filename = shift;
  47     if (ref $filename eq 'GLOB') {
  48         $OUT = $filename;
  49     }
  50     else {
  51         my $mode = '>';
  52         if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
  53             ($mode, $filename) = ($1, $2);
  54         }
  55         open $OUT, $mode, $filename
  56           or YAML::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT', $filename, $!);
  57     }
  58     binmode $OUT, ':utf8';  # if $Config{useperlio} eq 'define';
  59     local $/ = "\n"; # reset special to "sane"
  60     print $OUT Dump(@_);
  61 }
  62
  63 sub LoadFile {
  64     my $IN;
  65     my $filename = shift;
  66     if (ref $filename eq 'GLOB') {
  67         $IN = $filename;
  68     }
  69     else {
  70         open $IN, '<', $filename
  71           or YAML::Mo::Object->die('YAML_LOAD_ERR_FILE_INPUT', $filename, $!);
  72     }
  73     binmode $IN, ':utf8';  # if $Config{useperlio} eq 'define';
  74     return Load(do { local $/; <$IN> });
  75 }
  76
  77 sub init_action_object {
  78     my $self = shift;
  79     my $object_class = (shift) . '_class';
  80     my $module_name = $self->$object_class;
  81     eval "require $module_name";
  82     $self->die("Error in require $module_name - $@")
  83         if $@ and "$@" !~ /Can't locate/;
  84     my $object = $self->$object_class->new;
  85     $object->set_global_options;
  86     return $object;
  87 }
  88
  89 my $global = {};
  90 sub Bless {
  91     require YAML::Dumper::Base;
  92     YAML::Dumper::Base::bless($global, @_)
  93 }
  94 sub Blessed {
  95     require YAML::Dumper::Base;
  96     YAML::Dumper::Base::blessed($global, @_)
  97 }
  98 sub global_object { $global }
  99
 100 1;