File Coverage

blib/lib/Data/Smile/XS.pm

Criterion	Covered	Total	%
statement	58	66	87.8
branch	32	50	64.0
condition	8	21	38.1
subroutine	9	9	100.0
pod	2	2	100.0
total	109	148	73.6

use 5.008008;
use strict;
use warnings;

package Data::Smile::XS;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.001000';

require XSLoader;
XSLoader::load( __PACKAGE__, $VERSION );

use Exporter::Tiny;
our @ISA       = qw( Exporter::Tiny );
our @EXPORT_OK = qw( encode_smile decode_smile dump_smile load_smile );

sub _is_pathish_filename {
	my ( $x ) = @_;
	return 0 if not ref $x;
	return 1 if eval { $x->isa( 'Path::Tiny' ) } or eval { $x->isa( 'Path::Class::File' ) };
	return 0;
}

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

	if ( _is_pathish_filename( $file ) ) {
		$file = "$file";
	}

	if ( not ref $file ) {
		open my $fh, '<:raw', $file or die "open($file) for read: $!";
		return ( $fh, 1 );
	}

	if ( eval { $file->can( 'read' ) } or eval { $file->can( 'getline' ) } or ref( $file ) eq 'GLOB' ) {
		binmode( $file, ':raw' );
		return ( $file, 0 );
	}

	die "Unsupported file argument for read";
}

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

	if ( _is_pathish_filename( $file ) ) {
		$file = "$file";
	}

	if ( not ref $file ) {
		open my $fh, '>:raw', $file or die "open($file) for write: $!";
		return ( $fh, 1 );
	}

	if ( eval { $file->can( 'print' ) } or eval { $file->can( 'write' ) } or ref( $file ) eq 'GLOB' ) {
		binmode( $file, ':raw' );
		return ( $file, 0 );
	}

	die "Unsupported file argument for write";
}

sub dump_smile {
	my ( $file, $data, $opts ) = @_;
	die 'dump_smile expects at most 3 arguments' if @_ > 3;

	if ( @_ >= 3 and defined $opts ) {
		die 'Options must be a hash reference' if ref( $opts ) ne 'HASH';
	}

	my ( $fh, $close ) = _open_for_write( $file );

	my $bytes = encode_smile( $data, $opts );
	my $ok = eval {
		print {$fh} $bytes or die "write: $!";
		1;
	} ? 1 : 0;

	if ( $close ) {
		close $fh or $ok = 0;
	}

	return $ok ? 1 : 0;
}

sub load_smile {
	my ( $file, $opts ) = @_;
	die 'load_smile expects at most 2 arguments' if @_ > 2;

	if ( @_ >= 2 and defined $opts ) {
		die 'Options must be a hash reference' if ref( $opts ) ne 'HASH';
	}

	my ( $fh, $close ) = _open_for_read( $file );

	my $buf = do { local $/; <$fh> };
	die "read failed" if not defined $buf;

	if ( $close ) {
		close $fh or die "close: $!";
	}

	return defined $opts
		? decode_smile( $buf, $opts )
		: decode_smile( $buf );
}

__END__