modules/override/YAML/Dumper/Base.pm

   1 package YAML::Dumper::Base;
   2 use strict; use warnings;
   3 use YAML::Base; use base 'YAML::Base';
   4 use YAML::Node;
   5
   6 # YAML Dumping options
   7 field spec_version => '1.0';
   8 field indent_width => 2;
   9 field use_header => 1;
  10 field use_version => 0;
  11 field sort_keys => 1;
  12 field anchor_prefix => '';
  13 field dump_code => 0;
  14 field use_block => 0;
  15 field use_fold => 0;
  16 field compress_series => 1;
  17 field inline_series => 0;
  18 field use_aliases => 1;
  19 field purity => 0;
  20 field stringify => 0;
  21
  22 # Properties
  23 field stream => '';
  24 field document => 0;
  25 field transferred => {};
  26 field id_refcnt => {};
  27 field id_anchor => {};
  28 field anchor => 1;
  29 field level => 0;
  30 field offset => [];
  31 field headless => 0;
  32 field blessed_map => {};
  33
  34 # Global Options are an idea taken from Data::Dumper. Really they are just
  35 # sugar on top of real OO properties. They make the simple Dump/Load API
  36 # easy to configure.
  37 sub set_global_options {
  38     my $self = shift;
  39     $self->spec_version($YAML::SpecVersion)
  40       if defined $YAML::SpecVersion;
  41     $self->indent_width($YAML::Indent)
  42       if defined $YAML::Indent;
  43     $self->use_header($YAML::UseHeader)
  44       if defined $YAML::UseHeader;
  45     $self->use_version($YAML::UseVersion)
  46       if defined $YAML::UseVersion;
  47     $self->sort_keys($YAML::SortKeys)
  48       if defined $YAML::SortKeys;
  49     $self->anchor_prefix($YAML::AnchorPrefix)
  50       if defined $YAML::AnchorPrefix;
  51     $self->dump_code($YAML::DumpCode || $YAML::UseCode)
  52       if defined $YAML::DumpCode or defined $YAML::UseCode;
  53     $self->use_block($YAML::UseBlock)
  54       if defined $YAML::UseBlock;
  55     $self->use_fold($YAML::UseFold)
  56       if defined $YAML::UseFold;
  57     $self->compress_series($YAML::CompressSeries)
  58       if defined $YAML::CompressSeries;
  59     $self->inline_series($YAML::InlineSeries)
  60       if defined $YAML::InlineSeries;
  61     $self->use_aliases($YAML::UseAliases)
  62       if defined $YAML::UseAliases;
  63     $self->purity($YAML::Purity)
  64       if defined $YAML::Purity;
  65     $self->stringify($YAML::Stringify)
  66       if defined $YAML::Stringify;
  67 }
  68
  69 sub dump {
  70     my $self = shift;
  71     $self->die('dump() not implemented in this class.');
  72 }
  73
  74 sub blessed {
  75     my $self = shift;
  76     my ($ref) = @_;
  77     $ref = \$_[0] unless ref $ref;
  78     my (undef, undef, $node_id) = YAML::Base->node_info($ref);
  79     $self->{blessed_map}->{$node_id};
  80 }
  81
  82 sub bless {
  83     my $self = shift;
  84     my ($ref, $blessing) = @_;
  85     my $ynode;
  86     $ref = \$_[0] unless ref $ref;
  87     my (undef, undef, $node_id) = YAML::Base->node_info($ref);
  88     if (not defined $blessing) {
  89         $ynode = YAML::Node->new($ref);
  90     }
  91     elsif (ref $blessing) {
  92         $self->die() unless ynode($blessing);
  93         $ynode = $blessing;
  94     }
  95     else {
  96         no strict 'refs';
  97         my $transfer = $blessing . "::yaml_dump";
  98         $self->die() unless defined &{$transfer};
  99         $ynode = &{$transfer}($ref);
 100         $self->die() unless ynode($ynode);
 101     }
 102     $self->{blessed_map}->{$node_id} = $ynode;
 103     my $object = ynode($ynode) or $self->die();
 104     return $object;
 105 }
 106
 107 1;
 108
 109 __END__
 110
 111 =head1 NAME
 112
 113 YAML::Dumper::Base - Base class for YAML Dumper classes
 114
 115 =head1 SYNOPSIS
 116
 117     package YAML::Dumper::Something;
 118     use YAML::Dumper::Base -base;
 119
 120 =head1 DESCRIPTION
 121
 122 YAML::Dumper::Base is a base class for creating YAML dumper classes.
 123
 124 =head1 AUTHOR
 125
 126 Ingy döt Net <ingy@cpan.org>
 127
 128 =head1 COPYRIGHT
 129
 130 Copyright (c) 2006. Ingy döt Net. All rights reserved.
 131
 132 This program is free software; you can redistribute it and/or modify it
 133 under the same terms as Perl itself.
 134
 135 See L<http://www.perl.com/perl/misc/Artistic.html>
 136
 137 =cut