File Coverage

blib/lib/Parse/HTTP/UserAgent/Base/Dumper.pm

Criterion	Covered	Total	%
statement	45	64	70.3
branch	14	22	63.6
condition	3	7	42.8
subroutine	6	10	60.0
pod	1	1	100.0
total	69	104	66.3

package Parse::HTTP::UserAgent::Base::Dumper;
$Parse::HTTP::UserAgent::Base::Dumper::VERSION = '0.42';
use strict;
use warnings;
use Carp qw( croak );
use Parse::HTTP::UserAgent::Constants qw(:all);

sub dumper {
    my($self, @args) = @_;
    my %opt = @args % 2 ? () : (
        type      => 'dumper',
        format    => 'none',
        interpret => 0,
        @args
    );
    my $meth = '_dumper_' . lc $opt{type};
    croak "Don't know how to dump with $opt{type}" if ! $self->can( $meth );
    my $buf = $self->$meth( \%opt );
    return $buf if defined wantarray;
    my $pok = print $buf ."\n";
    return;
}

sub _dump_to_struct {
    my %struct    = shift->as_hash;
    $struct{$_} ||= [] for qw( dotnet mozilla extras tk );
    $struct{$_} ||= 0  for qw( unknown );
    return \%struct;
}

sub _dumper_json {
    my $self = shift;
    my $opt  = shift;
    require JSON;
    return  JSON::to_json(
                $self->_dump_to_struct,
                { pretty => $opt->{format} eq 'pretty' }
            );
}

sub _dumper_xml {
    my $self = shift;
    my $opt  = shift;
    require XML::Simple;
    return  XML::Simple::XMLout(
                $self->_dump_to_struct,
                RootName => 'ua',
                NoIndent => $opt->{format} ne 'pretty',
            );
}

sub _dumper_yaml {
    my $self = shift;
    my $opt  = shift;
    require YAML;
    return  YAML::Dump( $self->_dump_to_struct );
}

sub _dumper_dumper {
    # yeah, I know. Fugly code here
    my $self = shift;
    my $opt  = shift;
    my @ids  = $opt->{args} ?  @{ $opt->{args} } : $self->_object_ids;
    my $args = $opt->{args} ?                  1 : 0;
    my $max  = 0;
    map { $max = length $_ if length $_ > $max; } @ids;
    my @titles = qw( FIELD VALUE );
    my $buf    = sprintf "%s%s%s\n%s%s%s\n",
                        $titles[0],
                        (q{ } x (2 + $max - length $titles[0])),
                        $titles[1],
                        q{-} x $max, q{ } x 2, q{-} x ($max*2);
    require Data::Dumper;
    my @buf;
    foreach my $id ( @ids ) {
        my $name = $args ? $id->{name} : $id;
        my $val  = $args ? $id->{value} : $self->[ $self->$id() ];
        if ( $val && ref $val ) {
            my $d = Data::Dumper->new([$val]);
            $d->Indent(0);
            my $rv = $d->Dump;
            $rv =~ s{ \$VAR1 \s+ = \s+ }{}xms;
            $rv =~ s{ ; }{}xms;
            $val = $rv eq '[]' ? q{} : $rv;
        }
        push @buf, [
            $name,
            (q{ } x (2 + $max - length $name)),
            defined $val ? $val : q{}
        ];
    }
    foreach my $row ( sort { lc $a->[0] cmp lc $b->[0] } @buf ) {
        $buf .= sprintf "%s%s%s\n", @{ $row };
    }
    return $buf;
}

1;

__END__