Merge branch 'b-3.6.1' of ../kivitendo-erp_20220811

[kivitendo-erp.git] / modules / override / YAML / Node.pm

diff --git a/modules/override/YAML/Node.pm b/modules/override/YAML/Node.pm
deleted file mode 100644 (file)
index 81c2727..0000000
--- a/modules/override/YAML/Node.pm
+++ /dev/null
@@ -1,218 +0,0 @@
-use strict; use warnings;
-package YAML::Node;
-
-use YAML::Tag;
-require YAML::Mo;
-
-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]});
-    }
-    elsif (ref($_[0]) eq 'ARRAY') {
-        $self = tied(@{$_[0]});
-    }
-    elsif (ref(\$_[0]) eq 'GLOB') {
-        $self = tied(*{$_[0]});
-    }
-    else {
-        $self = tied($_[0]);
-    }
-    return (ref($self) =~ /^yaml_/) ? $self : undef;
-}
-
-sub new {
-    my ($class, $node, $tag) = @_;
-    my $self;
-    $self->{NODE} = $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'");
-    tag($self, ($tag || ''));
-    if ($self->{KIND} eq 'scalar') {
-        yaml_scalar->new($self, $_[1]);
-        return \ $_[1];
-    }
-    my $package = "yaml_" . $self->{KIND};
-    $package->new($self)
-}
-
-sub node { $_->{NODE} }
-sub kind { $_->{KIND} }
-sub tag {
-    my ($self, $value) = @_;
-    if (defined $value) {
-               $self->{TAG} = YAML::Tag->new($value);
-        return $self;
-    }
-    else {
-       return $self->{TAG};
-    }
-}
-sub keys {
-    my ($self, $value) = @_;
-    if (defined $value) {
-               $self->{KEYS} = $value;
-        return $self;
-    }
-    else {
-       return $self->{KEYS};
-    }
-}
-
-#==============================================================================
-package yaml_scalar;
-
-@yaml_scalar::ISA = qw(YAML::Node);
-
-sub new {
-    my ($class, $self) = @_;
-    tie $_[2], $class, $self;
-}
-
-sub TIESCALAR {
-    my ($class, $self) = @_;
-    bless $self, $class;
-    $self
-}
-
-sub FETCH {
-    my ($self) = @_;
-    $self->{NODE}
-}
-
-sub STORE {
-    my ($self, $value) = @_;
-    $self->{NODE} = $value
-}
-
-#==============================================================================
-package yaml_sequence;
-
-@yaml_sequence::ISA = qw(YAML::Node);
-
-sub new {
-    my ($class, $self) = @_;
-    my $new;
-    tie @$new, $class, $self;
-    $new
-}
-
-sub TIEARRAY {
-    my ($class, $self) = @_;
-    bless $self, $class
-}
-
-sub FETCHSIZE {
-    my ($self) = @_;
-    scalar @{$self->{NODE}};
-}
-
-sub FETCH {
-    my ($self, $index) = @_;
-    $self->{NODE}[$index]
-}
-
-sub STORE {
-    my ($self, $index, $value) = @_;
-    $self->{NODE}[$index] = $value
-}
-
-sub undone {
-    die "Not implemented yet"; # XXX
-}
-
-*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}};
-    my $new;
-    tie %$new, $class, $self;
-    $new
-}
-
-sub TIEHASH {
-    my ($class, $self) = @_;
-    bless $self, $class
-}
-
-sub FETCH {
-    my ($self, $key) = @_;
-    if (exists $self->{NODE}{$key}) {
-        return (grep {$_ eq $key} @{$self->{KEYS}})
-               ? $self->{NODE}{$key} : undef;
-    }
-    return $self->{HASH}{$key};
-}
-
-sub STORE {
-    my ($self, $key, $value) = @_;
-    if (exists $self->{NODE}{$key}) {
-        $self->{NODE}{$key} = $value;
-    }
-    elsif (exists $self->{HASH}{$key}) {
-        $self->{HASH}{$key} = $value;
-    }
-    else {
-        if (not grep {$_ eq $key} @{$self->{KEYS}}) {
-            push(@{$self->{KEYS}}, $key);
-        }
-        $self->{HASH}{$key} = $value;
-    }
-    $value
-}
-
-sub DELETE {
-    my ($self, $key) = @_;
-    my $return;
-    if (exists $self->{NODE}{$key}) {
-        $return = $self->{NODE}{$key};
-    }
-    elsif (exists $self->{HASH}{$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);
-        }
-    }
-    return $return;
-}
-
-sub CLEAR {
-    my ($self) = @_;
-    @{$self->{KEYS}} = ();
-    %{$self->{HASH}} = ();
-}
-
-sub FIRSTKEY {
-    my ($self) = @_;
-    $self->{ITER} = 0;
-    $self->{KEYS}[0]
-}
-
-sub NEXTKEY {
-    my ($self) = @_;
-    $self->{KEYS}[++$self->{ITER}]
-}
-
-sub EXISTS {
-    my ($self, $key) = @_;
-    exists $self->{NODE}{$key}
-}
-
-1;