view release on metacpan or  search on metacpan

lib/Data/Dump/Streamer.pm  view on Meta::CPAN

            }
            $keep;
        } @{ $self->{fix} };
        foreach my $glob (@globs) {
            my ($type, $lhs, $rhs, $depth, $name)= @$glob;
            print "Symbol: $name\n" if $DEBUG and $name;
            local @_;
            $name= $name ? '*' . $name : $rhs;
            my $overloaded= undef;
            my $isoverloaded= 0;
            if (defined(blessed $lhs )
                and overload::Overloaded($lhs))
            {
                $overloaded= blessed $lhs;
                disable_overloading($lhs);
                $isoverloaded= 1;
            }
            foreach my $t ($self->_glob_slots('')) {
                my $v= *$lhs{$t};

                if (not(defined $v)
                    or ($t eq 'SCALAR' and !defined($$v)))
                {
                    next;
                }

                my $dumped= 0;

                my $gaddr= refaddr(*$lhs{$t});
                my $gidx= $self->{ref}{$gaddr};
                unless ($gidx) {
                    next;
                }
                elsif ($self->{refd}[$gidx] < $depth + 1) {
                    $self->_add_fix('ref', $name, $gidx, blessed(*$lhs{$t}));
                    next;
                }

                $self->{fh}->print("$name = ") unless $self->{style}{terse};
                my $ret= $self->_dump_sv(*$lhs{$t}, $depth, \$dumped, $name,
                    length($name) + 3);
                Carp::confess
                    "\nUnhandled alias value '$ret' returned to _dump_apply_fix()!"
                    if $ret;
                $self->{fh}->print(";\n");
                $dumped= 1;
            }

            if (
                   $self->{style}{deparse}
                && $self->{style}{deparseglob}

                #and defined *$lhs{FORMAT}
            ) {
                # from link from [ysth]: http://groups.google.com/groups?selm=laUs8gzkgOlT092yn%40efn.org
                # translate arg (or reference to it) into a B::* object

                # To work-around perl commit
                # 2acc3314e31a9342e325f35c5b592967c9850c9b, keep the
                # value \*$lhs alive while we inspect it as a B object
                # or else it'll be reaped while we're using it.
                my $lhs_glob= \*$lhs;
                my $Bobj= B::svref_2object($lhs_glob);

                # if passed a glob or globref, get the format
                $Bobj= B::GV::FORM($Bobj) if ref $Bobj eq 'B::GV';

                if (ref $Bobj eq 'B::FM') {
                    (my $cleaned= $name) =~ s/^\*(::)?//;
                    $self->{fh}->print("format $cleaned =\n");
                    my $deparser= Data::Dump::Streamer::Deparser->new();
                    $self->{fh}->print(
                        $deparser->indent($deparser->deparse_format($Bobj)));
                    $self->{fh}->print("\n");
                }
            }
            if ($isoverloaded) {
                restore_overloading($lhs, $overloaded);
            }

        }
        redo GLOB if @globs;
    }
}

=item Out

=item Out VALUES

Prints out a set of values to the appropriate location. If provided a list
of values then the values are first scanned with C<Data()> and then
printed, if called with no values then whatever was scanned last with
C<Data()> or C<Dump()> is printed.

If the C<To()> attribute was provided then will dump to whatever object
was specified there (any object, including filehandles that accept the
print() method), and will always return $self.

If the C<To()> attribute was not provided then will use an internal
printing object, returning either a list or scalar or printing to STDOUT
in void context.

This routine is virtually always called without arguments as the last
method in the method chain.

 Dump->Arguments(1)->Out(@vars);
 $obj->Data(@vars)->Out();
 Dump(@vars)->Out;
 Data::Dump::Streamer->Out(@vars);

All should DWIM.

=cut

#
# Out is just a wrapper. The overall dumping process works like this:
#
# Out
#   foreach root value
#     _dump_sv