local-lib5/lib/perl5/YAML/Dumper/Base.pm

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