modules/override/YAML/Dumper/Base.pm

   1 package YAML::Dumper::Base;
   2
   3 use YAML::Mo;
   4
   5 use YAML::Node;
   6
   7 # YAML Dumping options
   8 has spec_version    => default => sub {'1.0'};
   9 has indent_width    => default => sub {2};
  10 has use_header      => default => sub {1};
  11 has use_version     => default => sub {0};
  12 has sort_keys       => default => sub {1};
  13 has anchor_prefix   => default => sub {''};
  14 has dump_code       => default => sub {0};
  15 has use_block       => default => sub {0};
  16 has use_fold        => default => sub {0};
  17 has compress_series => default => sub {1};
  18 has inline_series   => default => sub {0};
  19 has use_aliases     => default => sub {1};
  20 has purity          => default => sub {0};
  21 has stringify       => default => sub {0};
  22 has quote_numeric_strings => default => sub {0};
  23
  24 # Properties
  25 has stream      => default => sub {''};
  26 has document    => default => sub {0};
  27 has transferred => default => sub {{}};
  28 has id_refcnt   => default => sub {{}};
  29 has id_anchor   => default => sub {{}};
  30 has anchor      => default => sub {1};
  31 has level       => default => sub {0};
  32 has offset      => default => sub {[]};
  33 has headless    => default => sub {0};
  34 has blessed_map => default => sub {{}};
  35
  36 # Global Options are an idea taken from Data::Dumper. Really they are just
  37 # sugar on top of real OO properties. They make the simple Dump/Load API
  38 # easy to configure.
  39 sub set_global_options {
  40     my $self = shift;
  41     $self->spec_version($YAML::SpecVersion)
  42       if defined $YAML::SpecVersion;
  43     $self->indent_width($YAML::Indent)
  44       if defined $YAML::Indent;
  45     $self->use_header($YAML::UseHeader)
  46       if defined $YAML::UseHeader;
  47     $self->use_version($YAML::UseVersion)
  48       if defined $YAML::UseVersion;
  49     $self->sort_keys($YAML::SortKeys)
  50       if defined $YAML::SortKeys;
  51     $self->anchor_prefix($YAML::AnchorPrefix)
  52       if defined $YAML::AnchorPrefix;
  53     $self->dump_code($YAML::DumpCode || $YAML::UseCode)
  54       if defined $YAML::DumpCode or defined $YAML::UseCode;
  55     $self->use_block($YAML::UseBlock)
  56       if defined $YAML::UseBlock;
  57     $self->use_fold($YAML::UseFold)
  58       if defined $YAML::UseFold;
  59     $self->compress_series($YAML::CompressSeries)
  60       if defined $YAML::CompressSeries;
  61     $self->inline_series($YAML::InlineSeries)
  62       if defined $YAML::InlineSeries;
  63     $self->use_aliases($YAML::UseAliases)
  64       if defined $YAML::UseAliases;
  65     $self->purity($YAML::Purity)
  66       if defined $YAML::Purity;
  67     $self->stringify($YAML::Stringify)
  68       if defined $YAML::Stringify;
  69     $self->quote_numeric_strings($YAML::QuoteNumericStrings)
  70       if defined $YAML::QuoteNumericStrings;
  71 }
  72
  73 sub dump {
  74     my $self = shift;
  75     $self->die('dump() not implemented in this class.');
  76 }
  77
  78 sub blessed {
  79     my $self = shift;
  80     my ($ref) = @_;
  81     $ref = \$_[0] unless ref $ref;
  82     my (undef, undef, $node_id) = YAML::Mo::Object->node_info($ref);
  83     $self->{blessed_map}->{$node_id};
  84 }
  85
  86 sub bless {
  87     my $self = shift;
  88     my ($ref, $blessing) = @_;
  89     my $ynode;
  90     $ref = \$_[0] unless ref $ref;
  91     my (undef, undef, $node_id) = YAML::Mo::Object->node_info($ref);
  92     if (not defined $blessing) {
  93         $ynode = YAML::Node->new($ref);
  94     }
  95     elsif (ref $blessing) {
  96         $self->die() unless ynode($blessing);
  97         $ynode = $blessing;
  98     }
  99     else {
 100         no strict 'refs';
 101         my $transfer = $blessing . "::yaml_dump";
 102         $self->die() unless defined &{$transfer};
 103         $ynode = &{$transfer}($ref);
 104         $self->die() unless ynode($ynode);
 105     }
 106     $self->{blessed_map}->{$node_id} = $ynode;
 107     my $object = ynode($ynode) or $self->die();
 108     return $object;
 109 }
 110
 111 1;