X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=modules%2Foverride%2FYAML%2FNode.pm;h=81c272715688101680c7b2dcdfb8cd1bb07bde3a;hb=e811dffe90fb1fcdfee55d1ac1a26b7d2399cf44;hp=69affcf67c3f1a768c500b1ca09e7755fb06dd5f;hpb=b179b8df8426376f1592c7fdc3e693ed564c2fc3;p=kivitendo-erp.git diff --git a/modules/override/YAML/Node.pm b/modules/override/YAML/Node.pm index 69affcf67..81c272715 100644 --- a/modules/override/YAML/Node.pm +++ b/modules/override/YAML/Node.pm @@ -1,20 +1,26 @@ -package YAML::Node; use strict; use warnings; -use YAML::Base; use base 'YAML::Base'; +package YAML::Node; + use YAML::Tag; +require YAML::Mo; -our @EXPORT = qw(ynode); +use Exporter; +our @ISA = qw(Exporter YAML::Mo::Object); +our @EXPORT = qw(ynode); sub ynode { my $self; if (ref($_[0]) eq 'HASH') { - $self = tied(%{$_[0]}); + $self = tied(%{$_[0]}); } elsif (ref($_[0]) eq 'ARRAY') { - $self = tied(@{$_[0]}); + $self = tied(@{$_[0]}); + } + elsif (ref(\$_[0]) eq 'GLOB') { + $self = tied(*{$_[0]}); } else { - $self = tied($_[0]); + $self = tied($_[0]); } return (ref($self) =~ /^yaml_/) ? $self : undef; } @@ -23,17 +29,17 @@ sub new { my ($class, $node, $tag) = @_; my $self; $self->{NODE} = $node; - my (undef, $type) = $class->node_info($node); + my (undef, $type) = YAML::Mo::Object->node_info($node); $self->{KIND} = (not defined $type) ? 'scalar' : ($type eq 'ARRAY') ? 'sequence' : - ($type eq 'HASH') ? 'mapping' : - $class->die("Can't create YAML::Node from '$type'"); + ($type eq 'HASH') ? 'mapping' : + $class->die("Can't create YAML::Node from '$type'"); tag($self, ($tag || '')); if ($self->{KIND} eq 'scalar') { - yaml_scalar->new($self, $_[1]); - return \ $_[1]; + yaml_scalar->new($self, $_[1]); + return \ $_[1]; } - my $package = "yaml_" . $self->{KIND}; + my $package = "yaml_" . $self->{KIND}; $package->new($self) } @@ -42,8 +48,8 @@ sub kind { $_->{KIND} } sub tag { my ($self, $value) = @_; if (defined $value) { - $self->{TAG} = YAML::Tag->new($value); - return $self; + $self->{TAG} = YAML::Tag->new($value); + return $self; } else { return $self->{TAG}; @@ -52,8 +58,8 @@ sub tag { sub keys { my ($self, $value) = @_; if (defined $value) { - $self->{KEYS} = $value; - return $self; + $self->{KEYS} = $value; + return $self; } else { return $self->{KEYS}; @@ -62,6 +68,7 @@ sub keys { #============================================================================== package yaml_scalar; + @yaml_scalar::ISA = qw(YAML::Node); sub new { @@ -87,6 +94,7 @@ sub STORE { #============================================================================== package yaml_sequence; + @yaml_sequence::ISA = qw(YAML::Node); sub new { @@ -120,17 +128,18 @@ sub undone { die "Not implemented yet"; # XXX } -*STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS = -*STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS = +*STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS = +*STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS = *undone; # XXX Must implement before release #============================================================================== package yaml_mapping; + @yaml_mapping::ISA = qw(YAML::Node); sub new { my ($class, $self) = @_; - @{$self->{KEYS}} = sort keys %{$self->{NODE}}; + @{$self->{KEYS}} = sort keys %{$self->{NODE}}; my $new; tie %$new, $class, $self; $new @@ -144,8 +153,8 @@ sub TIEHASH { sub FETCH { my ($self, $key) = @_; if (exists $self->{NODE}{$key}) { - return (grep {$_ eq $key} @{$self->{KEYS}}) - ? $self->{NODE}{$key} : undef; + return (grep {$_ eq $key} @{$self->{KEYS}}) + ? $self->{NODE}{$key} : undef; } return $self->{HASH}{$key}; } @@ -153,16 +162,16 @@ sub FETCH { sub STORE { my ($self, $key, $value) = @_; if (exists $self->{NODE}{$key}) { - $self->{NODE}{$key} = $value; + $self->{NODE}{$key} = $value; } elsif (exists $self->{HASH}{$key}) { - $self->{HASH}{$key} = $value; + $self->{HASH}{$key} = $value; } else { - if (not grep {$_ eq $key} @{$self->{KEYS}}) { - push(@{$self->{KEYS}}, $key); - } - $self->{HASH}{$key} = $value; + if (not grep {$_ eq $key} @{$self->{KEYS}}) { + push(@{$self->{KEYS}}, $key); + } + $self->{HASH}{$key} = $value; } $value } @@ -171,15 +180,15 @@ sub DELETE { my ($self, $key) = @_; my $return; if (exists $self->{NODE}{$key}) { - $return = $self->{NODE}{$key}; + $return = $self->{NODE}{$key}; } elsif (exists $self->{HASH}{$key}) { - $return = delete $self->{NODE}{$key}; + $return = delete $self->{NODE}{$key}; } for (my $i = 0; $i < @{$self->{KEYS}}; $i++) { - if ($self->{KEYS}[$i] eq $key) { - splice(@{$self->{KEYS}}, $i, 1); - } + if ($self->{KEYS}[$i] eq $key) { + splice(@{$self->{KEYS}}, $i, 1); + } } return $return; } @@ -207,90 +216,3 @@ sub EXISTS { } 1; - -__END__ - -=head1 NAME - -YAML::Node - A generic data node that encapsulates YAML information - -=head1 SYNOPSIS - - use YAML; - use YAML::Node; - - my $ynode = YAML::Node->new({}, 'ingerson.com/fruit'); - %$ynode = qw(orange orange apple red grape green); - print Dump $ynode; - -yields: - - --- !ingerson.com/fruit - orange: orange - apple: red - grape: green - -=head1 DESCRIPTION - -A generic node in YAML is similar to a plain hash, array, or scalar node -in Perl except that it must also keep track of its type. The type is a -URI called the YAML type tag. - -YAML::Node is a class for generating and manipulating these containers. -A YAML node (or ynode) is a tied hash, array or scalar. In most ways it -behaves just like the plain thing. But you can assign and retrieve and -YAML type tag URI to it. For the hash flavor, you can also assign the -order that the keys will be retrieved in. By default a ynode will offer -its keys in the same order that they were assigned. - -YAML::Node has a class method call new() that will return a ynode. You -pass it a regular node and an optional type tag. After that you can -use it like a normal Perl node, but when you YAML::Dump it, the magical -properties will be honored. - -This is how you can control the sort order of hash keys during a YAML -serialization. By default, YAML sorts keys alphabetically. But notice -in the above example that the keys were Dumped in the same order they -were assigned. - -YAML::Node exports a function called ynode(). This function returns the tied object so that you can call special methods on it like ->keys(). - -keys() works like this: - - use YAML; - use YAML::Node; - - %$node = qw(orange orange apple red grape green); - $ynode = YAML::Node->new($node); - ynode($ynode)->keys(['grape', 'apple']); - print Dump $ynode; - -produces: - - --- - grape: green - apple: red - -It tells the ynode which keys and what order to use. - -ynodes will play a very important role in how programs use YAML. They -are the foundation of how a Perl class can marshall the Loading and -Dumping of its objects. - -The upcoming versions of YAML.pm will have much more information on this. - -=head1 AUTHOR - -Ingy döt Net - -=head1 COPYRIGHT - -Copyright (c) 2006. Ingy döt Net. All rights reserved. -Copyright (c) 2002. Brian Ingerson. All rights reserved. - -This program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. - -See L - -=cut