view release on metacpan or  search on metacpan

lib/YAML/Active.pm  view on Meta::CPAN

              :                                 $node;
            return bless $activated, ref $node;

            #             if (UNIVERSAL::isa($node, 'ARRAY')) {
            #                 my $result = array_activate($node, $phase);
            #                 if (UNIVERSAL::isa($result, 'ARRAY')) {
            #                     # the blessing stays the same
            #                     @$node = @$result;
            #                     return $node;
            #                 } else {
            #                     return bless $result, ref $node;
            #                 }
            #             } elsif (UNIVERSAL::isa($node, 'HASH')) {
            #                 my $result = hash_activate($node, $phase);
            #                 if (UNIVERSAL::isa($result, 'HASH')) {
            #                     # the blessing stays the same
            #                     %$node = %$result;
            #                     return $node;
            #                 } else {
            #                     return bless $result, ref $node;
            #                 }
            #             }
            #
            #             return $node;
        }
    }
    return $node;
}

# pass through
sub Load_inactive {
    my $node = shift;
    YAML::XS::Load($node);
}

sub Load {
    my ($node, $phase) = @_;
    node_activate(YAML::XS::Load($node), $phase)

      #my $x = node_activate(Load_inactive($node), $phase);
      #use Data::Dumper; print Dumper $x;
      #if (ref $x->{setup} eq 'HASH') {
      #    printf "foo [%s]\n", $x->{setup}{foo};
      #    printf "bar [%s]\n", $x->{setup}{bar};
      #}
      #$x;
}

sub Reload {
    my ($node, $phase) = @_;
    Load(Dump($node), $phase);
}

sub LoadFile {
    my ($node, $phase) = @_;
    node_activate(YAML::XS::LoadFile($node), $phase);
}

sub assert_arrayref {
    return if UNIVERSAL::isa($_[0], 'ARRAY');
    die sprintf "%s expects an array ref", (caller)[0];
}

sub assert_hashref {
    return if UNIVERSAL::isa($_[0], 'HASH');
    die sprintf "%s expects a hash ref", (caller)[0];
}
sub yaml_NULL { bless {}, NULL }

# end of activation-related code
# start of dump-related code
sub Dump {
    my ($node, %args) = @_;
    local $YAML::XS::ForceBlock =
      exists $args{ForceBlock} ? $args{ForceBlock} : 1;
    my $dump = YAML::XS::Dump(node_dump($node));
    our %prepare_dump;
    $_->can('finish_dump') && $_->finish_dump for keys %prepare_dump;
    $dump;
}

sub node_dump ($) {
    my $node = shift;
    return array_dump($node) if ref $node eq 'ARRAY';
    return hash_dump($node)  if ref $node eq 'HASH';
    if (my $class = ref $node) {
        if (!$node->can('yaml_dump')) {
            eval "require $class";
            die $@ if $@;
        }
        if ($node->can('prepare_dump')) {
            our %prepare_dump;
            $prepare_dump{ ref $node } ||= $node->prepare_dump;
        }
        return $node->can('yaml_dump') ? $node->yaml_dump : $node;
    }
    return $node;
}

sub array_dump ($) {
    my $node = shift;
    [   grep { ref ne NULL }
        map { node_dump($_) } @$node
    ];
}

sub hash_dump ($) {
    my $node = shift;
    return {
        map {
            my $val = node_dump($node->{$_});
            ref $val eq NULL ? () : ($_ => $val)
          } keys %$node
    };
}

package YAML::Active::Concat;
our $VERSION = '1.100810';
YAML::Active->import(':all');

sub yaml_activate {
    my ($self, $phase) = @_;
    assert_arrayref($self);
    return join '' => @{ array_activate($self, $phase) };
}