File Coverage

blib/lib/Data/Record/Serialize/Role/Default.pm

Criterion	Covered	Total	%
statement	23	23	100.0
branch	1	2	50.0
condition			n/a
subroutine	12	12	100.0
pod	1	4	25.0
total	37	41	90.2

package Data::Record::Serialize::Role::Default;

# ABSTRACT:  Default methods for Data::Record::Serialize

use v5.12;
use Moo::Role;

our $VERSION = '2.02';

use Hash::Util qw[ hv_store ];
use Ref::Util  qw[ is_coderef ];

use Data::Record::Serialize::Error { errors => ['fields'] }, -all;

use namespace::clean;





















## no critic( Subroutines::ProhibitBuiltinHomonyms )

# provide default if not already defined
sub send {
    my $self = shift;

    $self->_needs_eol
      ? $self->say( $self->encode( @_ ) )
      : $self->print( $self->encode( @_ ) );
}

# just in case they're not defined in preceding roles
sub setup      { }
sub finalize   { }
sub _map_types { }
sub _needs_eol { 1 }

around 'setup' => sub {
    my ( $orig, $self, $data ) = @_;

    $self->setup_from_record( $data );

    $orig->( $self );

    $self->_set__run_setup( 0 );
};

before 'close' => sub {
    my ( $self, @args ) = @_;
    $self->finalize( @args );
};

before 'send' => sub {
    my ( $self, $data ) = @_;

    # can't do format or numify until we have types, which might need to
    # be done from the data, which will be done in setup.

    $self->setup( $data )
      if $self->_run_setup;

    # remove fields that won't be output
    delete @{$data}{ grep { !exists $self->_fieldh->{$_} } keys %{$data} };

    # nullify fields (set to undef) those that are zero length

    if ( defined( my $fields = $self->_nullified ) ) {
        $data->{$_} = undef for grep { defined $data->{$_} && !length $data->{$_} } @$fields;
    }

    if ( defined( my $fields = $self->_numified ) ) {
        $data->{$_} = ( $data->{$_} || 0 ) +0 for grep { defined $data->{$_} } @{$fields};
    }

    if ( defined( my $fields = $self->_stringified ) ) {
        $data->{$_} = "@{[ $data->{$_}]}" for grep { defined $data->{$_} } @{$fields};
    }

    if ( my $format = $self->_format ) {
        $data->{$_}
          = is_coderef( $format->{$_} )
          ? $format->{$_}( $data->{$_} )
          : sprintf( $format->{$_}, $data->{$_} )
          foreach grep { defined $data->{$_} && length $data->{$_} }
          keys %{$format};
    }


    # handle boolean
    if ( $self->_boolify ) {
        my @fields = grep { exists $data->{$_} } @{ $self->boolean_fields };

        if ( $self->_can_bool ) {
            $data->{$_} = $self->to_bool( $data->{$_} ) for @fields;
        }

        # the encoder doesn't have native boolean, must convert a
        # truthy value to 0/1;
        else {
            $data->{$_} = $data->{$_} ? 1 : 0 foreach @fields;
        }
    }

    if ( my $rename = $self->rename_fields ) {
        for my $from ( @{ $self->fields } ) {
            my $to = $rename->{$from}
              or next;

            hv_store( %$data, $to, $data->{$from} );
            delete $data->{$from};
        }
    }
};

sub DEMOLISH {
    my ( $self, $in_global_destruction ) = @_;

    # we can't make the decision about whether to pay attention during
    # Global Destruction. the objects have to do that
    $self->close( $in_global_destruction );
    return;
}

1;

#
# This file is part of Data-Record-Serialize
#
# This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory.
#
# This is free software, licensed under:
#
#   The GNU General Public License, Version 3, June 2007
#

__END__