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