view release on metacpan or  search on metacpan

lib/Module/Generic/Number/Format.pm  view on Meta::CPAN

    my $self       = CORE::shift( @_ );
    my $serialiser = CORE::shift( @_ ) // '';
    my $class      = CORE::ref( $self );

    # We keep a strict allow-list to avoid accidentally freezing DBI handles or other
    # process-local state.
    my @props = ( @{$self->{_fields}}, keys( %$map ) );

    my $hash = {};
    foreach my $prop ( @props )
    {
        if( CORE::exists( $self->{ $prop } ) &&
            defined( $self->{ $prop } ) &&
            CORE::ref( $self->{ $prop } ) ne 'CODE' )
        {
            $hash->{ $prop } = $self->{ $prop };
        }
    }

    # 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.
    if( $serialiser eq 'Sereal' )
    {
        require Sereal::Encoder;
        require version;

        if( version->parse( Sereal::Encoder->VERSION ) <= version->parse( '4.023' ) )
        {
            CORE::return( [$class, $hash] );
        }
    }

    # But Storable wants a list with the first element being the serialised element
    CORE::return( $class, $hash );
}

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 $ref = ( CORE::scalar( @args ) == 1 && CORE::ref( $args[0] ) eq 'ARRAY' ) ? CORE::shift( @args ) : \@args;
    my $class = ( CORE::defined( $ref ) && CORE::ref( $ref ) eq 'ARRAY' && CORE::scalar( @$ref ) > 1 ) ? CORE::shift( @$ref ) : ( CORE::ref( $self ) || $self );
    my $hash = CORE::ref( $ref ) eq 'ARRAY' ? CORE::shift( @$ref ) : {};
    my $new;
    # Storable pattern requires to modify the object it created rather than returning a new one
    if( CORE::ref( $self ) )
    {
        foreach( CORE::keys( %$hash ) )
        {
            $self->{ $_ } = CORE::delete( $hash->{ $_ } );
        }
        $new = $self;
    }
    else
    {
        $new = CORE::bless( $hash => $class );
    }
    CORE::return( $new );
}

sub TO_JSON { return( shift->as_number ); }


1;
# NOTE: POD
__END__

=encoding utf-8

=head1 NAME

Module::Generic::Number::Format - Locale-aware number formatting for Module::Generic::Number

=head1 SYNOPSIS

    use Module::Generic::Number::Format;

    # Direct instantiation
    my $fmt = Module::Generic::Number::Format->new( 1234567.89 ) ||
        die( Module::Generic::Number::Format->error );
    # or
    my $n = Module::Generic::Number::Format->new( 10, 
    {
        thousand => ',',
        decimal => '.',
        precision => 2,
        # Currency symbol
        symbol => '€',
        # Display currency symbol before or after the number
        precede => 1,
    });
    # Even accepts numbers in Japanese double bytes
    # Will be converted automatically to regular digits.
    my $n = Moule::Generic::Number::Format->new( "−１２３４５６７" ); # becomes -1234567
    # or, to get all the defaults based on language code
    my $n = Module::Generic::Number::Format->new( 1234567.89, 
    {
        lang => 'fr_FR',
        # or
        # locale => 'fr_FR',
    });
    # this would set the decimal separator to ',', the thousand separator to ' ', and precede to 0 (false).
    print( "Number is: $n\n" );
    # prints: 1 234 567,89

    my $n_neg = Module::Generic::Number::Format->new(-10);
    $n_neg->abs # 10
    $n->clone # Cloning the number object
    $n->currency # €
    $n->decimal # .
    $n->format # 1,000.00
    $n->format(0) # 1,000
    $n->format(
        precision => 0,
        # Boolean value
        decimal_fill => 0,