The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

##----------------------------------------------------------------------------
## Module Generic - ~/lib/Module/Generic/Boolean.pm
## Version v1.1.1
## Copyright(c) 2022 DEGUEST Pte. Ltd.
## Author: Jacques Deguest <jack@deguest.jp>
## Created 2021/03/20
## Modified 2022/08/05
## All rights reserved
##
## This program is free software; you can redistribute it and/or modify it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
BEGIN
{
use vars qw( $true $false );
"0+" => sub{ ${$_[0]} },
"++" => sub{ $_[0] = ${$_[0]} + 1 },
"--" => sub{ $_[0] = ${$_[0]} - 1 },
fallback => 1;
$true = do{ bless( \( my $dummy = 1 ) => 'Module::Generic::Boolean' ) };
$false = do{ bless( \( my $dummy = 0 ) => 'Module::Generic::Boolean' ) };
our( $VERSION ) = 'v1.1.1';
};
use strict;
# require Module::Generic::Array;
# require Module::Generic::Number;
# require Module::Generic::Scalar;
sub new { return( $_[1] ? $true : $false ); }
# sub as_array { return( Module::Generic::Array->new( [ ${$_[0]} ] ) ); }
sub as_array
{
return( Module::Generic::Array->new( [ ${$_[0]} ] ) );
}
# sub as_number { return( Module::Generic::Number->new( ${$_[0]} ) ); }
sub as_number
{
return( Module::Generic::Number->new( ${$_[0]} ) );
}
# sub as_scalar { return( Module::Generic::Scalar->new( ${$_[0]} ) ); }
sub as_scalar
{
return( Module::Generic::Scalar->new( ${$_[0]} ) );
}
sub defined { return(1); }
sub true () { $true }
sub false () { $false }
sub is_bool ($) { UNIVERSAL::isa( $_[0], 'Module::Generic::Boolean' ) }
sub is_true ($) { $_[0] && UNIVERSAL::isa( $_[0], 'Module::Generic::Boolean' ) }
sub is_false ($) { !$_[0] && UNIVERSAL::isa( $_[0], 'Module::Generic::Boolean' ) }
sub FREEZE
{
my $self = CORE::shift( @_ );
my $serialiser = CORE::shift( @_ ) // '';
my $class = CORE::ref( $self );
# Return an array reference rather than a list so this works with Sereal and CBOR
# On or before Sereal version 4.023, Sereal did not support multiple values returned
CORE::return( [$class, $$self] ) if( $serialiser eq 'Sereal' && Sereal::Encoder->VERSION <= version->parse( '4.023' ) );
# But Storable want a list with the first element being the serialised element
CORE::return( $$self );
}
sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); }
sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); }
# NOTE: CBOR will call the THAW method with the stored classname as first argument, the constant string CBOR as second argument, and all values returned by FREEZE as remaining arguments.
# NOTE: Storable calls it with a blessed object it created followed with $cloning and any other arguments initially provided by STORABLE_freeze
sub THAW
{
my( $self, undef, @args ) = @_;
my( $class, $str );
if( CORE::scalar( @args ) == 1 && CORE::ref( $args[0] ) eq 'ARRAY' )
{
( $class, $str ) = @{$args[0]};
}
else
{
$class = CORE::ref( $self ) || $self;
$str = CORE::shift( @args );
}
# Storable pattern requires to modify the object it created rather than returning a new one
if( CORE::ref( $self ) )
{
$$self = $str;
CORE::return( $self );
}
else
{
CORE::return( $class->new( $str ) );
}
}
sub TO_JSON
{
# JSON does not check that the value is a proper true or false. It stupidly assumes this is a string
# The only way to make it understand is to return a scalar ref of 1 or 0
# return( $_[0] ? 'true' : 'false' );
return( $_[0] ? \1 : \0 );
}
1;
__END__