view release on metacpan or  search on metacpan

lib/Data/Smile/PP.pm  view on Meta::CPAN

use 5.008008;
use strict;
use warnings;

package Data::Smile::PP;

use Scalar::Util qw( blessed dualvar looks_like_number );
use constant HEADER              => "\x3A\x29\x0A\x03";
use constant MAX_SAFE_INT_DOUBLE => 9_007_199_254_740_992;
use constant MIN_SIGNED_64BIT    => -9_223_372_036_854_775_808;
use constant MAX_UNSIGNED_64BIT  => 18_446_744_073_709_551_615;

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

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

BEGIN {
	my @HELPERS = (
		_is_arrayref => [
			[ 'Ref::Util::XS', 'is_plain_arrayref' ],
			[ 'Type::Tiny::XS', 'ArrayRef' ],
			q{
				my ( $v ) = @_;
				ref( $v ) eq 'ARRAY';
			},
		],
		_is_hashref => [
			[ 'Ref::Util::XS', 'is_plain_hashref' ],
			[ 'Type::Tiny::XS', 'HashRef' ],
			q{
				my ( $v ) = @_;
				ref( $v ) eq 'HASH';
			},
		],
		_is_dual => [
			[ 'Scalar::Util', 'isdual' ],
			q{
				use B ();
				my $f = B::svref_2object(\$_[0])->FLAGS;
				my $SVp_POK = eval { B::SVp_POK() } || 0;
				my $SVp_IOK = eval { B::SVp_IOK() } || 0;
				my $SVp_NOK = eval { B::SVp_NOK() } || 0;
				my $pok  = $f & ( B::SVf_POK | $SVp_POK );
				my $niok = $f & ( B::SVf_IOK | B::SVf_NOK | $SVp_IOK | $SVp_NOK );
				!!( $pok and $niok );
			},
		],
		_is_bool => [
			[ 'builtin', 'is_bool' ],
			q{
				my $value = shift;
				return !!0 unless defined $value;
				return !!0 if ref $value;
				return !!0 unless _is_dual( $value );
				return !!1 if  $value and "$value" eq '1' and $value + 0 == 1;
				return !!1 if not $value and "$value" eq q'' and $value + 0 == 0;
				return !!0;
			},
		],
		_created_as_number => [
			[ 'builtin', 'created_as_number' ],
			q{
				use B ();
				my $value = shift;
				return !!0 unless defined $value;
				return !!0 if ref $value;
				return !!0 if utf8::is_utf8( $value );
				my $b_obj = B::svref_2object(\$value);
				my $flags = $b_obj->FLAGS;
				return !!1 if $flags & ( B::SVp_IOK() | B::SVp_NOK() ) and not( $flags & B::SVp_POK() );
				return !!0;
			},
		],
		_created_as_string => [
			[ 'builtin', 'created_as_string' ],
			q{
				my $value = shift;
				defined $value
					and not ref $value
					and not _is_bool( $value )
					and not _created_as_number( $value );
			},
		],
	);

	HELPER: while ( @HELPERS ) {
		my ( $name, $implementation_list ) = splice @HELPERS, 0, 2;
		IMPLEMENTATION: for my $i ( @$implementation_list ) {