init III

Perl OTRS/Kernel/cpan-lib/YAML/Dumper/Base.pm

@@ -0,0 +1,111 @@
+package YAML::Dumper::Base;
+
+use YAML::Mo;
+
+use YAML::Node;
+
+# YAML Dumping options
+has spec_version    => default => sub {'1.0'};
+has indent_width    => default => sub {2};
+has use_header      => default => sub {1};
+has use_version     => default => sub {0};
+has sort_keys       => default => sub {1};
+has anchor_prefix   => default => sub {''};
+has dump_code       => default => sub {0};
+has use_block       => default => sub {0};
+has use_fold        => default => sub {0};
+has compress_series => default => sub {1};
+has inline_series   => default => sub {0};
+has use_aliases     => default => sub {1};
+has purity          => default => sub {0};
+has stringify       => default => sub {0};
+has quote_numeric_strings => default => sub {0};
+
+# Properties
+has stream      => default => sub {''};
+has document    => default => sub {0};
+has transferred => default => sub {{}};
+has id_refcnt   => default => sub {{}};
+has id_anchor   => default => sub {{}};
+has anchor      => default => sub {1};
+has level       => default => sub {0};
+has offset      => default => sub {[]};
+has headless    => default => sub {0};
+has blessed_map => default => sub {{}};
+
+# Global Options are an idea taken from Data::Dumper. Really they are just
+# sugar on top of real OO properties. They make the simple Dump/Load API
+# easy to configure.
+sub set_global_options {
+    my $self = shift;
+    $self->spec_version($YAML::SpecVersion)
+      if defined $YAML::SpecVersion;
+    $self->indent_width($YAML::Indent)
+      if defined $YAML::Indent;
+    $self->use_header($YAML::UseHeader)
+      if defined $YAML::UseHeader;
+    $self->use_version($YAML::UseVersion)
+      if defined $YAML::UseVersion;
+    $self->sort_keys($YAML::SortKeys)
+      if defined $YAML::SortKeys;
+    $self->anchor_prefix($YAML::AnchorPrefix)
+      if defined $YAML::AnchorPrefix;
+    $self->dump_code($YAML::DumpCode || $YAML::UseCode)
+      if defined $YAML::DumpCode or defined $YAML::UseCode;
+    $self->use_block($YAML::UseBlock)
+      if defined $YAML::UseBlock;
+    $self->use_fold($YAML::UseFold)
+      if defined $YAML::UseFold;
+    $self->compress_series($YAML::CompressSeries)
+      if defined $YAML::CompressSeries;
+    $self->inline_series($YAML::InlineSeries)
+      if defined $YAML::InlineSeries;
+    $self->use_aliases($YAML::UseAliases)
+      if defined $YAML::UseAliases;
+    $self->purity($YAML::Purity)
+      if defined $YAML::Purity;
+    $self->stringify($YAML::Stringify)
+      if defined $YAML::Stringify;
+    $self->quote_numeric_strings($YAML::QuoteNumericStrings)
+      if defined $YAML::QuoteNumericStrings;
+}
+
+sub dump {
+    my $self = shift;
+    $self->die('dump() not implemented in this class.');
+}
+
+sub blessed {
+    my $self = shift;
+    my ($ref) = @_;
+    $ref = \$_[0] unless ref $ref;
+    my (undef, undef, $node_id) = YAML::Mo::Object->node_info($ref);
+    $self->{blessed_map}->{$node_id};
+}
+
+sub bless {
+    my $self = shift;
+    my ($ref, $blessing) = @_;
+    my $ynode;
+    $ref = \$_[0] unless ref $ref;
+    my (undef, undef, $node_id) = YAML::Mo::Object->node_info($ref);
+    if (not defined $blessing) {
+        $ynode = YAML::Node->new($ref);
+    }
+    elsif (ref $blessing) {
+        $self->die() unless ynode($blessing);
+        $ynode = $blessing;
+    }
+    else {
+        no strict 'refs';
+        my $transfer = $blessing . "::yaml_dump";
+        $self->die() unless defined &{$transfer};
+        $ynode = &{$transfer}($ref);
+        $self->die() unless ynode($ynode);
+    }
+    $self->{blessed_map}->{$node_id} = $ynode;
+    my $object = ynode($ynode) or $self->die();
+    return $object;
+}
+
+1;