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