File Coverage

blib/lib/Shell/Perl/Dumper.pm

Criterion	Covered	Total	%
statement	17	70	24.2
branch	0	8	0.0
condition			n/a
subroutine	6	21	28.5
pod			n/a
total	23	99	23.2

package Shell::Perl::Dumper;

use strict;
use warnings;

our $VERSION = '0.004';

use base qw(Class::Accessor); # to get a new() for free

package Shell::Perl::Dumper::Plain;

our @ISA = qw(Shell::Perl::Dumper); # to get a new() for free

sub is_available {
    return 1; # always available - no dependency but Perl
}

sub dump_scalar {
    shift;
    return "$_[0]" . "\n";
}

sub dump_list {
    shift;
    local $" = "\t";
    return "@_" . "\n";
}

package Shell::Perl::Data::Dump;

our @ISA = qw(Shell::Perl::Dumper); # to get a new() for free

# XXX make a Data::Dump object an instance variable

sub _dump_code_filter {
    my ($ctx, $object_ref) = @_;
    return undef unless $ctx->is_code;

    require B::Deparse;
    my $code = 'sub ' . (B::Deparse->new)->coderef2text($object_ref);
    return { dump => $code };
}

sub is_available {
    return eval { require Data::Dump::Filtered; 1 };
}

sub dump_scalar {
    shift;
    require Data::Dump::Filtered;
    return Data::Dump::Filtered::dump_filtered(shift, \&_dump_code_filter) . "\n";
}

sub dump_list {
    shift;
    require Data::Dump::Filtered;
    return Data::Dump::Filtered::dump_filtered(@_, \&_dump_code_filter) . "\n";
}

package Shell::Perl::Data::Dumper;

our @ISA = qw(Shell::Perl::Dumper);

# XXX make a Data::Dumper object an instance variable
#     but OO Data::Dumper is very annoying

sub is_available {
    return eval { require Data::Dumper; 1 };
}

sub dump_scalar {
    shift;
    require Data::Dumper;
    local $Data::Dumper::Deparse = 1;
    return Data::Dumper->Dump([shift], [qw($var)]);
}

sub dump_list {
    #goto &dump_scalar if @_==2; # fallback to dump_scalar if only one
    shift;
    require Data::Dumper;
    local $Data::Dumper::Deparse = 1;
    return Data::Dumper->Dump([[@_]], [qw(*var)]);
}

package Shell::Perl::Dumper::YAML;

our @ISA = qw(Shell::Perl::Dumper);

sub _require_one_of {
    my @modules = @_;
    for (@modules) {
        my $ret = eval "require $_; 1";
        warn "pirl: $_ loaded ok\n" if $ret; # XXX
        return $_ if $ret;
    }
    return undef
}

our $YAML_PACKAGE;

sub is_available {
    #return eval { require YAML; 1 };
    $YAML_PACKAGE = _require_one_of(qw(YAML::Syck YAML));
    if ($YAML_PACKAGE) {
        $YAML_PACKAGE->import(qw(Dump));
        do { no strict 'refs'; ${ $YAML_PACKAGE . '::DumpCode' } = 1 };
        return 1
    } else {
        return undef;
    }

}

sub dump_scalar {
    shift;
    #require YAML; # done by &is_available
    return Dump(shift);
}

sub dump_list { # XXX
    shift;
    #require YAML; # done by &is_available
    return Dump(@_);
}

package Shell::Perl::Data::Dump::Streamer;

our @ISA = qw(Shell::Perl::Dumper);

sub is_available {
    return eval { require Data::Dump::Streamer; 1 };
}

sub dump_scalar {
    shift;
    require Data::Dump::Streamer;
    return Data::Dump::Streamer::Dump(shift)->Names('$var')->Out;
}

sub dump_list {
    #goto &dump_scalar if @_==2; # fallback to dump_scalar if only one
    shift;
    require Data::Dump::Streamer;
    return Data::Dump::Streamer::Dump([@_])->Names('*var')->Out;
}

1;

__END__