Data-Dump-Streamer
6 results

 view release on metacpan or  search on metacpan

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

package Data::Dump::Streamer;
use strict;
use warnings;
use warnings::register;

use B              ();
use B::Deparse     ();
use B::Utils       ();
use Data::Dumper   ();
use DynaLoader     ();
use Exporter       ();
use IO::File       ();
use Symbol         ();
use Text::Abbrev   ();
use Text::Balanced ();
use overload       ();

use Data::Dump::Streamer::_::Printers;

# The style of this file is determined by:
#
# perltidy -w -ple -bbb -bbc -bbs -nolq -l=80 -noll -nola -nwls='=' \
#   -isbc -nolc -otr -kis -ci=4 -se -sot -sct -nsbl -pt=2 -fs  \
#   -fsb='#start-no-tidy' -fse='#end-no-tidy' -cpb -bfvt=2

# use overload qw("" printit); # does diabolical stuff.

use vars qw(
    $VERSION
    $XS_VERSION
    $AUTOLOAD
    @ISA
    @EXPORT @EXPORT_OK @EXPORT_FAIL %EXPORT_TAGS
    %Freeze
    %Thaw
    $DEBUG
    $HasPadWalker
);

$DEBUG= 0;
BEGIN { $HasPadWalker= eval "use PadWalker 0.99; 1"; }

BEGIN {
    $VERSION= '2.42';
    $XS_VERSION= $VERSION;
    $VERSION= eval $VERSION;    # used for beta stuff.
    @ISA= qw(Exporter DynaLoader);
    @EXPORT= qw(Dump DumpLex DumpVars);
    @EXPORT_OK= qw(
        Dump
        DumpLex
        DumpVars
        Stream
        alias_av
        alias_hv
        alias_ref
        push_alias
        dualvar

        alias_to

        blessed
        reftype
        refaddr
        refcount
        sv_refcount
        looks_like_number
        regex
        readonly
        make_ro
        _make_ro
        reftype_or_glob
        refaddr_or_glob
        globname
        is_numeric

        all_keys
        legal_keys
        hidden_keys
        lock_ref_keys
        lock_keys
        lock_ref_keys_plus
        lock_keys_plus
        SvREADONLY_ref
        SvREFCNT_ref
        isweak
        weaken
        weak_refcount

        readonly_set

        Dumper
        DDumper

        alias
        sqz
        usqz
    );

    %EXPORT_TAGS= (
        undump => [

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


When C<$pass> is 0 the C<$thaw> variable may be supplied as well as the
keyorder. If it is defined then it specifies what thaw action to perform
after dumping the hash. See L<C<$thaw>|/$thaw> in L<Controlling Object
Representation> for details as to how it works.  This allows an object
to define those keys needed to recreate itself properly, and a followup
hook to recreate the rest.

B<Note> that if a L<Freezer()|/Freezer> method is defined and returns
a L<C<$thaw>|/$thaw> then the L<C<$thaw>|/$thaw> returned by the sorter
will override it.

=head2 Controlling Array Presentation and Run Length Encoding

By default Data::Dump::Streamer will "run length encode" array values.
This means that when an array value is simple (ie, its not referenced and
does contain a reference) and is repeated multiple times the output will
be single a list multiplier statement, and not each item output
separately. Thus: L<C<Dump([0,0,0,0])>|/Dump> will be output something like

   $ARRAY1 = [ (0) x 4 ];

This is particularly useful when dealing with large arrays that are only
partly filled, and when accidentally the array has been made very large,
such as with the improper use of pseudo-hash notation.

To disable this feature you may set the L<Rle()|/Rle> property to FALSE, by
default it is enabled and set to TRUE.

=head2 Installing I<DDS> as a package alias

Its possible to have an alias to Data::Dump::Streamer created and
installed for easier usage in one liners and short scripts.
Data::Dump::Streamer is a bit long to type sometimes. However because this
technically means polluting the root level namespace, and having it listed
on CPAN, I have elected to have the installer not install it by default.
If you wish it to be installed you must explicitly state so when
Build.Pl is run:

  perl Build.Pl DDS [Other Module::Build options]

Then a normal './Build test, ./Build install' invocation will install DDS.

Using DDS is identical to Data::Dump::Streamer.

=head2 use-time package aliasing

You can also specify an alias at use-time, then use that alias in the rest
of your program, thus avoiding the permanent (but modest) namespace
pollution of the previous method.

  use Data::Dumper::Streamer as => 'DDS';

  # or if you prefer
  use Data::Dumper::Streamer;
  import Data::Dumper::Streamer as => 'DDS';

You can use any alias you like, but that doesn't mean you should.. Folks
doing as => 'DBI' will be mercilessly ridiculed.

=head2 PadWalker support

If PadWalker 1.0 is installed you can use DumpLex() to try to
automatically determine the names of the vars being dumped. As
long as the vars being dumped have my or our declarations in scope
the vars will be correctly named. Padwalker will also be used
instead of the B:: modules when dumping closures when it is available.

=head1 INTERFACE

=head2 Data::Dumper Compatibility

For drop in compatibility with the Dumper() usage of Data::Dumper, you may
request that the L<Dumper()|/Dumper> method is exported. It will not be exported by
default. In addition the standard Data::Dumper::Dumper() may be exported
on request as C<DDumper>. If you provide the tag C<:Dumper> then both will
be exported.

=over 4

=item Dumper

=item Dumper LIST

A synonym for scalar Dump(LIST)->Out for usage compatibility with
L<Data::Dumper|Data::Dumper>

=item DDumper

=item DDumper LIST

A secondary export of the actual L<Data::Dumper::Dumper|Data::Dumper>
subroutine.

=back

=head2 Constructors

=over 4

=item new

Creates a new Data::Dump::Streamer object. Currently takes no
arguments and simply returns the new object with a default style
configuration.

See C<Dump()> for a better way to do things.

=cut

sub _compressor {
    return "use Data::Dump::Streamer qw(usqz);\n"
        if !@_;
    return sqz($_[0], "usqz('", "')");
}

sub new {
    my $class= shift;
    my $self= bless {
        style => {
            hashsep  => '=>',         # use this to separate key vals
            arysep   => ',',
            pairsep  => ',',

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

  print Dump($x,$y);

but it will not affect the behaviour of

  print scalar Dump($x,$y);

B<Note> As of 1.11 Dump also works as a method, with identical properties
as when called as a subroutine, with the exception that when called with
no arguments it is a synonym for C<Out()>. Thus

  $obj->Dump($foo)->Names('foo')->Out();

will work fine, as will the odd looking:

  $obj->Dump($foo)->Names('foo')->Dump();

which are both the same as

  $obj->Names('foo')->Data($foo)->Out();

Hopefully this should make method use more or less DWIM.

=cut

my %args_insideout;

sub DESTROY {
    my $self= shift;
    delete $args_insideout{ Data::Dump::Streamer::refaddr $self} if $self;
}

sub Dump {
    my $obj;
    if (blessed($_[0]) and blessed($_[0]) eq __PACKAGE__) {
        $obj= shift;
    }
    if (@_) {
        if (defined wantarray and !wantarray) {
            $obj ||= __PACKAGE__->new();
            $obj->_make_args(@_);
            return $obj;
        }
        else {
            $obj ||= __PACKAGE__;
            return $obj->Data(@_)->Out();
        }
    }
    else {
        if ($obj) {
            return $obj->Out();
        }
        else {
            return __PACKAGE__->new();
        }
    }
}

=item DumpLex VALUES

DumpLex is similar to Dump except it will try to automatically determine
the names to use for the variables being dumped by using PadWalker to
have a poke around the calling lexical scope to see what is declared. If
a name for a var can't be found then it will be named according to the
normal scheme. When PadWalker isn't installed this is just a wrapper for
L<Dump()|/Dump>.

Thanks to Ovid for the idea of this. See L<Data::Dumper::Simple> for a
similar wrapper around L<Data::Dumper>.

=cut

sub DumpLex {
    if (!$HasPadWalker) {

        #warn( "Can't use DumpLex without ".
        #    "PadWalker v1.0 or later installed.");
        goto &Dump;
    }
    my $obj;
    if (blessed($_[0]) and blessed($_[0]) eq __PACKAGE__) {
        $obj= shift;
    }
    my @names;

    # = map {
    #        PadWalker::var_name(1,\$_)
    #        || PadWalker::var_name(1,\$_)
    #        (ref $_ && PadWalker::var_name(1,$_));
    #                $str
    #          } @_;
    #if ( !@names && @_ ) {

    my %pad_vars;
    foreach my $pad (PadWalker::peek_my(1), PadWalker::peek_our(1)) {
        while (my ($var, $ref)= each %$pad) {
            $pad_vars{ refaddr $ref } ||= $var;
        }
    }
    foreach (@_) {
        my $name;
        INNER: foreach (\$_, $_) {
            $name= $pad_vars{ refaddr $_}
                and last INNER;
        }
        push @names, $name;
    }
    if (defined wantarray and !wantarray) {
        $obj ||= __PACKAGE__->new();
        $obj->_make_args(@_);
        $obj->Names(@names);
        return $obj;
    }
    else {
        $obj ||= __PACKAGE__;
        return $obj->Names(@names)->Data(@_)->Out();
    }
}

=item DumpVars PAIRS

This is wrapper around L<Dump()|/Dump> which expect to receive
a list of name=>value pairs instead of a list of values.
Otherwise behaves like L<Dump()|/Dump>. Note that names starting
with a '-' are treated the same as those starting with '*' when
passed to L<Names()|/Names>.

=cut

sub DumpVars {
    my $obj;
    if (blessed($_[0]) and blessed($_[0]) eq __PACKAGE__) {
        $obj= shift;
    }
    if (@_ % 2) {
        warnings::warnif "Odd number of arguments in DumpVars";
        pop @_;
    }
    my @names;
    my @args;
    for (0 .. $#_ / 2) {
        $names[$_]= $_[ $_ * 2 ];
        $args[$_]= $_ * 2 + 1;
    }

    #die "@_:@names|@args";
    if (defined wantarray and !wantarray) {
        $obj ||= __PACKAGE__->new();
        $obj->_make_args(@_[@args]);
        $obj->Names(@names);
        return $obj;
    }
    else {
        $obj ||= __PACKAGE__;
        return $obj->Data(@_[@args])->Names(@names)->Out();

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

    }
    if (my $postop= $self->{ref_postop}{ $raddr || $addr }) {
        if (ref $postop) {
            $postop->($_[1]);
        }
        else {
            $_[1]->$postop();
        }
    }
    $self->{do_nl}= 1;

    return;
}

=item Names

=item Names LIST

=item Names ARRAYREF

Takes a list of strings or a reference to an array of strings to use for
var names for the objects dumped. The names may be prefixed by a *
indicating the variable is to be dumped as its dereferenced type if it is
an array, hash or code ref. Otherwise the star is ignored. Other sigils
may be prefixed but they will be silently converted to *'s.

If no names are provided then names are generated automatically based on
the type of object being dumped, with abbreviations applied to compound
class names.

If called with arguments then returns the object itself, otherwise in list
context returns the list of names in use, or in scalar context a reference
or undef. In void context with no arguments the names are cleared.

B<NOTE:>
Must be called before C<Data()> is called.

If you wish to have no names, use L<Terse>.

=cut

sub Names {
    my $self= shift->_safe_self;
    if (@_) {
        my $v= (@_ == 1 and reftype $_[0] eq 'ARRAY') ? shift @_ : \@_;
        $self->{unames}= [
            map {
                (my $s= $_) =~ s/^[\@\%\&-]/*/;
                $s =~ s/^\$//;
                Carp::confess "Bad name '$_'"
                    if $s && $s !~ /^\*?\w+$/;
                $s
            } grep { defined } @$v
        ];
        return $self;
    }
    elsif (!defined wantarray) {
        $self->{unames}= [];
    }

    #elsif ( eval { require PadWalker; 1 } ) {
    #    print DDumper(PadWalker::peek_my(1));
    #    return $self;
    #}

    return wantarray ? @{ $self->{unames} || [] } : $self->{unames};
}

=item Terse

=item Terse BOOL

When true, no variable names will be created.  Data will be dumped as
anonymous references or values.

    Dump([])->Out;              # $ARRAY1 = []
    Dump([])->Terse(1)->Out;    # []

=cut

sub Terse {
    my $self= shift->_safe_self;
    if (@_) {
        $self->{style}{terse}= shift;
        return $self;
    }
    else {
        return $self->{style}{terse};
    }
}

=for UEDIT
sub Purity {}

=item Purity

=item Purity BOOL

This option can be used to set the level of purity in the output. It
defaults to TRUE, which results in the module doing its best to ensure
that the resulting dump when eval()ed is precisely the same as the input.
However, at times such as debugging this can be tedious, resulting in
extremely long dumps with many "fix" statements involved.  By setting
Purity to FALSE the resulting output won't necessarily be legal Perl, but
it will be more legible. In this mode the output is broadly similar to
that of the default setting of Data::Dumper (Purity(0)). When set to TRUE
the behaviour is likewise similar to Data::Dumper in Purity(1) but more
accurate.

When Purity() is set to FALSE aliases will be output with a function call
wrapper of 'alias_to' whose argument will be the value the item is an
alias to. This wrapper does nothing, and is only there as a visual cue.
Likewise, 'make_ro' will be output when the value was readonly, and again
the effect is cosmetic only.

=item To

=item To STREAMER

Specifies the object to print to. Data::Dump::Streamer can stream its
output to any object supporting the print method. This is primarily meant
for streaming to a filehandle, however any object that supports the method

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

                die "Unknown sortkeys '$val', and "
                    . (ref($obj) || $obj)
                    . " doesn't know how to do it.\n"
                    if !$subref;
                $self->{style}{sortkeys_string}{$name}= $val;
                $val= $subref;
            }
            elsif (reftype($val) eq 'ARRAY') {
                my $aryref= $val;
                $val= sub { return $aryref; };
            }
            elsif (reftype($val) ne 'CODE') {
                Carp::confess("Can't use '$val' as KeyOrder() value");
            }
            $self->{style}{sortkeys}{$name}= $val;
        }
    }
    return $self;
}
*Keyorder= *KeyOrder;

sub SortKeys {
    my $self= shift;
    $self->KeyOrder("", @_);
}
*Sortkeys= *SortKeys;
*HashKeys= *Hashkeys= *KeyOrder;

my %scalar_meth= map { $_ => lc($_) } qw(Declare Indent IndentCols IndentKeys
    Verbose DumpGlob Deparse DeparseGlob DeparseFormat CodeStub
    FormatStub Rle RLE Purity DualVars Dualvars EclipseName
    Compress Compressor OptSpace);

sub AUTOLOAD {
    (my $meth= $AUTOLOAD) =~ s/^((?:\w+::)+)//;
    my $name;
    if (defined($name= $scalar_meth{$meth})) {
        $DEBUG and print "AUTLOADING scalar meth $meth ($name)\n";
        eval '
        sub ' . $meth . ' {
            my $self=shift->_safe_self();
            if (@_) {
                $self->{style}{' . $name . '}=shift;
                return $self
            } else {
                return $self->{style}{' . $name . '}
            }
        }
        ';
        $@ and die "$meth:$@\n";
        goto &$meth;
    }
    elsif ($meth =~ /[^A-Z]/) {
        Carp::confess "Unhandled method/subroutine call $AUTOLOAD";
    }
}

sub _get_lexicals {
    my $cv= shift;

    if ($HasPadWalker) {
        my ($names, $targs)= PadWalker::closed_over($cv);
        if ($PadWalker::VERSION < 1) {
            $names->{$_}= $names->{ $targs->{$_} } for keys %$targs;
        }
        else {
            %$names= (%$names, %$targs);
        }
        return $names;
    }

    my $svo= B::svref_2object($cv);
    my @pl_array= eval { $svo->PADLIST->ARRAY };
    my @name_obj= eval { $pl_array[0]->ARRAY };

    my %named;
    for my $i (0 .. $#name_obj) {
        if (ref($name_obj[$i]) !~ /SPECIAL/) {
            $named{$i}= $name_obj[$i]->PV;
        }
    }

    my %inited;
    my %used;
    B::Utils::walkoptree_filtered(
        $svo->ROOT,
        sub { B::Utils::opgrep { name => [qw[ padsv padav padhv ]] }, @_ },
        sub {
            my ($op, @items)= @_;
            my $targ= $op->targ;
            my $name= $named{$targ}
                or return;

            $inited{$name}++
                if $op->private & 128;

            if (!$inited{$name}) {
                $used{$name}= $pl_array[1]->ARRAYelt($targ)->object_2svref;
                $used{$targ}= $used{$name};
                $inited{$name}++;
            }
        });
    return \%used;
}

package Data::Dump::Streamer::Deparser;
use B::Deparse;
our @ISA= qw(B::Deparse);
my %cache;

our $VERSION= '2.42';
$VERSION= eval $VERSION;
if ($VERSION ne $Data::Dump::Streamer::VERSION) {
    die
        "Incompatible Data::Dump::Streamer::Deparser v$VERSION vs Data::Dump::Streamer v$Data::Dump::Streamer::VERSION";
}

sub dds_usenames {
    my $self= shift;
    my $names= shift;
    $cache{ Data::Dump::Streamer::refaddr $self}= $names;
}



( run in 0.663 second using v1.01-cache-2.11-cpan-39bf76dae61 )