112 lines
3.5 KiB
Perl
112 lines
3.5 KiB
Perl
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;
|