File Coverage

blib/lib/File/Serialize.pm

Criterion	Covered	Total	%
statement	90	98	91.8
branch	29	48	60.4
condition	27	43	62.7
subroutine	20	21	95.2
pod			n/a
total	166	210	79.0

package File::Serialize;
our $AUTHORITY = 'cpan:YANICK';
# ABSTRACT: DWIM file serialization/deserialization
$File::Serialize::VERSION = '1.5.1';
use v5.16.0;

use feature 'current_sub';

use strict;
use warnings;

use Class::Load qw/ load_class /;
use List::AllUtils qw/ uniq /;
use List::Util 1.41 qw/ pairgrep first none any pairmap /;
use Path::Tiny;

use Module::Pluggable
   require => 1,
   sub_name => '_all_serializers',
   search_path => __PACKAGE__ . '::Serializer'
;

use parent 'Exporter::Tiny';

our @EXPORT = qw/ serialize_file deserialize_file transerialize_file /;

our $implicit_transform;

sub _generate_serialize_file {
    my( undef, undef, undef, $global )= @_;

    return sub {
        my( $file, $content, $options ) = @_;

        $options = { format => $options } if $options and not ref $options;

        $options = { %$global, %{ $options||{} } } if $global;
        # default to utf8 => 1
        $options->{utf8} //= 1;
        $options->{allow_nonref} //= 1;
        $options->{pretty} //= 1;
        $options->{canonical} //= 1;

        $file = path($file) unless $file =~ /^-/ or ref $file eq 'SCALAR';

        my $serializer = _serializer($file, $options);

        $file = path( join '.', $file, $serializer->extension )
            if $options->{add_extension} and $file ne '-'
                and ref $file ne 'SCALAR';

        my $method = $options->{utf8} ? 'spew_utf8' : 'spew';

        my $serialized = $serializer->serialize($content,$options);

        return print $serialized if $file eq '-';

        if( ref $file eq 'SCALAR' ) {
            $$file = $serialized;
        }
        else {
            $file->$method($serialized);
        }
    }
}

sub _generate_deserialize_file {
    my( undef, undef, undef, $global ) = @_;

    return sub {
        my( $file, $options ) = @_;

        $file = path($file) unless $file eq '-' or ref $file eq 'SCALAR';

        $options = { %$global, %{ $options||{} } } if $global;
        $options->{utf8} //= 1;
        $options->{allow_nonref} //= 1;

        my $method = 'slurp' . ( '_utf8' ) x !! $options->{utf8};

        my $serializer = _serializer($file, $options);

        $file = path( join '.', $file, $serializer->extension )
            if $options->{add_extension} and $file ne '-' and ref $file ne 'SCALAR';

        return $serializer->deserialize(
            $file =~ /^-/ ? do { local $/ =  }
          : ref $file eq 'SCALAR' ? $$file
          : $file->$method,
            $options
        );
    }
}

sub _generate_transerialize_file {

    my $serialize_file = _generate_serialize_file(@_);
    my $deserialize_file = _generate_deserialize_file(@_);


    return sub {
        my( $in, @chain ) = @_;
        my $data = ref($in) ? $in : $deserialize_file->($in);

        while( my $step = shift @chain) {
            if ( ref $step eq 'CODE' ) {
                local $_ = $data;
                if( $implicit_transform  ) {
                    $step->($data);
                    $data = $_;
                }
                else {
                $data = $step->($data);
            }}
            elsif ( ref $step eq 'ARRAY' ) {
                die "subranch step can only be the last step of the chain"
                    if @chain;
                for my $branch( @$step ) {
                    __SUB__->($data,@$branch);
                }
            }
            elsif ( not ref $step or ref($step) =~ /Path::Tiny/ ) {
                die "filename '$step' not at the end of the chain"
                    unless @chain <= 1;

                $serialize_file->(  $step, $data, shift @chain );
            }
            elsif ( ref $step eq 'HASH' ) {
                while( my ($f,$o) = each %$step ) {
                    $serialize_file->($f,$data,$o);
                }
            }
            elsif ( ref $step eq 'SCALAR' ) {
                $$step = $data;
            }
            else {
                die "wrong chain argument";
            }
        }

    }
}

sub _all_operative_formats {
    my $self = shift;
    return uniq map { $_->extension } $self->_all_operative_formats;
}

sub _all_operative_serializers {
    sort {
        $b->precedence <=> $a->precedence
            or
        $a cmp $b
    }
    grep { $_->is_operative }
    grep { $_->precedence }
    __PACKAGE__->_all_serializers;
}

sub _serializer {
    my( $self, $options ) = @_;

    no warnings qw/ uninitialized /;

    my $serializers = $options->{serializers} || [ __PACKAGE__->_all_operative_serializers ];
    s/^\+/File::Serialize::Serializer::/ for @$serializers;

    my $format = $options->{format} || ( ( ref $self ? $self->basename : $self ) =~ /\.(\w+)$/ )[0];

    return( first { $_->does_extension($format) } @$serializers
            or die "no serializer found for $format"
    );
}

1;

__END__