view release on metacpan or  search on metacpan

lib/Convert/Pheno/IO/FileIO.pm  view on Meta::CPAN

package Convert::Pheno::IO::FileIO;

use strict;
use warnings;
use autodie;
use feature qw(say);
use Path::Tiny;
use File::Basename;
use List::Util qw(any);
use YAML::XS qw(Load Dump);
$YAML::XS::Boolean = 'JSON::PP';    # use JSON::PP::Boolean objects
use JSON::XS;
use IO::Compress::Gzip     qw($GzipError);
use IO::Uncompress::Gunzip qw($GunzipError);
use Sort::Naturally qw(nsort);
use Data::Leaf::Walker;
use Exporter 'import';
our @EXPORT = qw(read_json read_yaml io_yaml_or_json write_json write_yaml);

#########################
#########################
#  SUBROUTINES FOR I/O  #
#########################
#########################

sub _slurp_text {
    my ($file) = @_;

    if ( $file =~ /\.gz$/ ) {
        # Gzipped text has to be decoded explicitly because Path::Tiny only
        # covers plain files. Keep this logic isolated so plain-file semantics
        # stay unchanged elsewhere.
        my $fh = IO::Uncompress::Gunzip->new( $file, MultiStream => 1 )
          or die "Cannot gunzip <$file>: $GunzipError";
        binmode( $fh, ':encoding(UTF-8)' );
        return do { local $/; <$fh> };
    }

    return path($file)->slurp_utf8;
}

sub _slurp_raw {
    my ($file) = @_;

    if ( $file =~ /\.gz$/ ) {
        # JSON::XS and YAML::XS do not want the same thing:
        # JSON decoding expects UTF-8 bytes, while some YAML paths are safer
        # when delegated to YAML::XS file APIs. This helper is only for cases
        # where raw bytes are the correct boundary.
        my $fh = IO::Uncompress::Gunzip->new( $file, MultiStream => 1 )
          or die "Cannot gunzip <$file>: $GunzipError";
        return do { local $/; <$fh> };
    }

    return path($file)->slurp_raw;
}

sub _spew_text {
    my ( $file, $text ) = @_;

    if ( $file =~ /\.gz$/ ) {
        # JSON strings produced without ->utf8 are Perl text and should be
        # encoded exactly once at the filehandle boundary.
        my $fh = IO::Compress::Gzip->new($file)
          or die "Cannot gzip <$file>: $GzipError";
        binmode( $fh, ':encoding(UTF-8)' );
        print {$fh} $text;
        close $fh;
        return 1;
    }

    path($file)->spew_utf8($text);
    return 1;
}