view release on metacpan or  search on metacpan

lib/Astro/App/Satpass2/Format/Dump.pm  view on Meta::CPAN

package Astro::App::Satpass2::Format::Dump;

use strict;
use warnings;

use parent qw{ Astro::App::Satpass2::Format };

use Astro::App::Satpass2::Utils qw{
    load_package
    CODE_REF
    @CARP_NOT
};

our $VERSION = '0.057';

my %dumper_hash = (
    'YAML' => 'Dump',
    'Data::Dumper' => 'Dumper',
    'JSON' => 'to_json',
);

{

    my $dumper_default;

    sub new {
	my ( $class, @args ) = @_;
	my $self = $class->SUPER::new( @args );
	if ( ! $self->dumper() ) {
	    if ( $dumper_default ) {
		$self->dumper( $dumper_default );
	    } else {
		$self->dumper(
		    'YAML,Data::Dumper'
		);
		$dumper_default = $self->dumper();
	    }
	}
	return $self;
    }

}

sub dumper {
    my ( $self, @args ) = @_;
    @args or return $self->{+__PACKAGE__}{dumper};
    my $val = shift @args;
    my $ref = ref $val;
    if ( ! $ref ) {
	foreach my $possible ( split qr{ , }smx, $val ) {
	    my $code = $dumper_hash{$possible} or next;
	    load_package( $possible ) or next;
	    $code = $possible->can( $code ) or next;
	    $val = $code;
	    last;
	}
	ref $val
	    or $self->wail(
	    "Unknown or unavailable dumper class '$val'" );
    } elsif ( CODE_REF ne $ref ) {
	$self->wail(
	    'Dumper must be a code ref or the name of a known class' );
    }
    $self->{+__PACKAGE__}{dumper} = $val;
    return $self;
}

sub _dump {
    my ( $self, $object ) = @_;
    if ( defined $object ) {
	return $self->dumper()->( $object );
    } else {
	return '';
    }
}

sub format : method {	## no critic (ProhibitBuiltInHomonyms)
    my ( $self, %data ) = @_;
    return $self->_dump( \%data );
}

1;

__END__

=head1 NAME

Astro::App::Satpass2::Format::Dump - Format Astro::App::Satpass2 output as dump.