view release on metacpan or  search on metacpan

script/_zodiac-of  view on Meta::CPAN

#
## XXX These classes and their APIs could still use some refactoring,
## but at least they work for now.
##-------------------------------------------------------------------------------
#package YAML::Old::Type::blessed;
#
#use YAML::Old::Mo; # XXX
#
#sub yaml_dump {
#    my $self = shift;
#    my ($value) = @_;
#    my ($class, $type) = YAML::Old::Mo::Object->node_info($value);
#    no strict 'refs';
#    my $kind = lc($type) . ':';
#    my $tag = ${$class . '::ClassTag'} ||
#              "!perl/$kind$class";
#    if ($type eq 'REF') {
#        YAML::Old::Node->new(
#            {(&YAML::Old::VALUE, ${$_[0]})}, $tag
#        );
#    }
#    elsif ($type eq 'SCALAR') {
#        $_[1] = $$value;
#        YAML::Old::Node->new($_[1], $tag);
#    }
#    elsif ($type eq 'GLOB') {
#        # blessed glob support is minimal, and will not round-trip
#        # initial aim: to not cause an error
#        return YAML::Old::Type::glob->yaml_dump($value, $tag);
#    } else {
#        YAML::Old::Node->new($value, $tag);
#    }
#}
#
##-------------------------------------------------------------------------------
#package YAML::Old::Type::undef;
#
#sub yaml_dump {
#    my $self = shift;
#}
#
#sub yaml_load {
#    my $self = shift;
#}
#
##-------------------------------------------------------------------------------
#package YAML::Old::Type::glob;
#
#sub yaml_dump {
#    my $self = shift;
#    # $_[0] remains as the glob
#    my $tag = pop @_ if 2==@_;
#
#    $tag = '!perl/glob:' unless defined $tag;
#    my $ynode = YAML::Old::Node->new({}, $tag);
#    for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
#        my $value = *{$_[0]}{$type};
#        $value = $$value if $type eq 'SCALAR';
#        if (defined $value) {
#            if ($type eq 'IO') {
#                my @stats = qw(device inode mode links uid gid rdev size
#                               atime mtime ctime blksize blocks);
#                undef $value;
#                $value->{stat} = YAML::Old::Node->new({});
#                if ($value->{fileno} = fileno(*{$_[0]})) {
#                    local $^W;
#                    map {$value->{stat}{shift @stats} = $_} stat(*{$_[0]});
#                    $value->{tell} = tell(*{$_[0]});
#                }
#            }
#            $ynode->{$type} = $value;
#        }
#    }
#    return $ynode;
#}
#
#sub yaml_load {
#    my $self = shift;
#    my ($node, $class, $loader) = @_;
#    my ($name, $package);
#    if (defined $node->{NAME}) {
#        $name = $node->{NAME};
#        delete $node->{NAME};
#    }
#    else {
#        $loader->warn('YAML_LOAD_WARN_GLOB_NAME');
#        return undef;
#    }
#    if (defined $node->{PACKAGE}) {
#        $package = $node->{PACKAGE};
#        delete $node->{PACKAGE};
#    }
#    else {
#        $package = 'main';
#    }
#    no strict 'refs';
#    if (exists $node->{SCALAR}) {
#        *{"${package}::$name"} = \$node->{SCALAR};
#        delete $node->{SCALAR};
#    }
#    for my $elem (qw(ARRAY HASH CODE IO)) {
#        if (exists $node->{$elem}) {
#            if ($elem eq 'IO') {
#                $loader->warn('YAML_LOAD_WARN_GLOB_IO');
#                delete $node->{IO};
#                next;
#            }
#            *{"${package}::$name"} = $node->{$elem};
#            delete $node->{$elem};
#        }
#    }
#    for my $elem (sort keys %$node) {
#        $loader->warn('YAML_LOAD_WARN_BAD_GLOB_ELEM', $elem);
#    }
#    return *{"${package}::$name"};
#}
#
##-------------------------------------------------------------------------------
#package YAML::Old::Type::code;
#
#my $dummy_warned = 0;