DateTime-Format-Intl

 view release on metacpan or  search on metacpan

lib/DateTime/Format/Intl.pm  view on Meta::CPAN

## Copyright(c) 2025 DEGUEST Pte. Ltd.
## Author: Jacques Deguest <jack@deguest.jp>
## Created 2024/09/16
## Modified 2025/01/05
## All rights reserved
## 
## 
## This program is free software; you can redistribute  it  and/or  modify  it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
package DateTime::Format::Intl;
BEGIN
{
    use v5.10.1;
    use strict;
    use warnings;
    use warnings::register;
    use vars qw(
        $VERSION $DEBUG $ERROR $FATAL_EXCEPTIONS
        $CACHE $LAST_CACHE_CLEAR $MAX_CACHE_SIZE $BROWSER_DEFAULTS
    );
    use DateTime;
    use DateTime::Locale::FromCLDR;
    use DateTime::Format::Unicode;
    use Locale::Intl;
    use Locale::Unicode::Data;
    use Scalar::Util ();
    use Want;
    our $VERSION = 'v0.1.8';
    our $CACHE = {};
    our $LAST_CACHE_CLEAR = time();
    our $MAX_CACHE_SIZE = 30;
};

use strict;
use warnings;

sub new
{
    my $that = shift( @_ );
    my $self = bless( {} => ( ref( $that ) || $that ) );
    my $this = shift( @_ );
    my $opts = $self->_get_args_as_hash( @_ );
    $opts = {%$opts};
    $self->{debug} = delete( $opts->{debug} ) if( exists( $opts->{debug} ) );
    $self->{fatal} = ( delete( $opts->{fatal} ) // $FATAL_EXCEPTIONS // 0 );
    return( $self->error( "No locale was provided." ) ) if( !defined( $this ) || !length( $this ) );
    my $cldr = $self->{_cldr} = Locale::Unicode::Data->new ||
        return( $self->pass_error( Locale::Unicode::Data->error ) );
    my $test_locales = ( Scalar::Util::reftype( $this ) // '' ) eq 'ARRAY' ? $this : [$this];
    my $locale;
    # Test for the locale data availability
    LOCALE_AVAILABILITY: foreach my $loc ( @$test_locales )
    {
        my $tree = $cldr->make_inheritance_tree( $loc ) ||
            return( $self->pass_error( $cldr->error ) );
        # We remove the last 'und' special fallback locale
        pop( @$tree );
        foreach my $l ( @$tree )
        {
            my $ref = $cldr->calendar_formats_l10n(
                locale => $l,
                calendar => 'gregorian',
            );
            return( $self->pass_error( $cldr->error ) ) if( !defined( $ref ) && $cldr->error );
            if( $ref )
            {
                if( Scalar::Util::blessed( $loc ) && ref( $loc ) eq 'Locale::Intl' )
                {
                    $locale = $loc;
                }
                else
                {
                    $locale = Locale::Intl->new( $loc ) ||
                        return( $self->pass_error( Locale::Intl->error ) );
                }
                last LOCALE_AVAILABILITY;
            }
        }
    }
    # Choice of locales provided do not have a supported match, so we fall back to the default 'en'
    $locale = Locale::Intl->new( 'en' ) if( !defined( $locale ) );
    my $unicode = $self->{_unicode} = DateTime::Locale::FromCLDR->new( $locale ) ||
        return( $self->pass_error( DateTime::Locale::FromCLDR->error ) );
    $self->{locale} = $locale;

    my @component_options = qw( weekday era year month day dayPeriod hour minute second fractionalSecondDigits timeZoneName timeStyle dateStyle );
    my @core_options = grep{ exists( $opts->{ $_ } ) } @component_options;
    my $check = {};
    @$check{ @core_options } = (1) x scalar( @core_options );

    # Default values if no options was provided.
    if( !scalar( keys( %$check ) ) )
    {
        # The Mozilla documentation states that "The default value for each date-time component option is undefined, but if all component properties are undefined, then year, month, and day default to "numeric"."
        # However, in reality, this is more nuanced.
        my $defaults = $self->_get_default_options_for_locale ||
            return( $self->pass_error );
        @core_options = qw( day month year );
        @$opts{ @core_options } = @$defaults{ @core_options };
        undef( $defaults );
    }
    else
    {
        # RangeError: invalid value "plop" for option month
        my %valid_options = 
        (
            localeMatcher           => ['lookup', 'best fit'],
            # calendar is processed separately
            # numberingSystem is processed separately
            calendar                => qr/[a-zA-Z][a-zA-Z0-9]+(?:\-[a-zA-Z][a-zA-Z0-9]+)*/,
            numberingSystem         => qr/[a-zA-Z][a-zA-Z0-9]+/,
            timeZone                => qr/[a-zA-Z0-9\/\_\-\+]+/,
            year                    => [qw( numeric 2-digit )],
            month                   => [qw( numeric 2-digit long short narrow )],
            day                     => [qw( numeric 2-digit )],
            hour                    => [qw( numeric 2-digit )],
            minute                  => [qw( numeric 2-digit )],
            second                  => [qw( numeric 2-digit )],
            hour12                  => [qw( 1 0 ), undef],
            # short: 12/20/2012, GMT+9
            #        12/19/2012, PST
            # long: 12/20/2012, Japan Standard Time
            #       12/19/2012, Pacific Standard Time
            # shortOffset: 12/20/2012, GMT+9
            #              12/19/2012, GMT-8
            # longOffset: 12/20/2012, GMT+09:00
            #             12/19/2012, GMT-08:00
            # shortGeneric: 12/20/2012, Japan Time
            #               12/19/2012, PT
            # longGeneric: 12/20/2012, Japan Standard Time
            #              12/19/2012, Pacific Time
            timeZoneName            => [qw( short long shortOffset longOffset shortGeneric longGeneric )],
            era                     => [qw( narrow short long )],
            weekday                 => [qw( narrow short long )],
            hourCycle               => [qw( h11 h12 h23 h24)],
            # timeZone is processed separately
            dayPeriod               => [qw( narrow short long )],
            fractionalSecondDigits  => [0..3], # 0, 1, 2, or 3 digits
            dateStyle               => [qw( full long medium short )],
            timeStyle               => [qw( full long medium short )],
        );
        
        foreach my $key ( keys( %$opts ) )
        {
            unless( exists( $valid_options{ $key } ) )
            {
                return( $self->error({
                    type => 'RangeError',
                    message => "Invalid option \"${key}\"",
                }) );
            }
            my $value = $opts->{ $key };
            if( ref( $valid_options{ $key} ) eq 'ARRAY' )
            {
                if( !scalar( grep { ( $_ // '' ) eq ( $value // '' ) } @{$valid_options{ $key }} ) )
                {
                    if( $key eq 'fractionalSecondDigits' )
                    {
                        return( $self->error({
                            type => 'RangeError',
                            message => "Invalid value \"${value}\" for option ${key}. Expected an integer between 0 and 3.",
                        }) );
                    }
                    else
                    {
                        return( $self->error({
                            type => 'RangeError',
                            message => "Invalid value \"${value}\" for option ${key}. Expected one of: " . @{$valid_options{ $key }},
                        }) );
                    }
                }
            }
            elsif( ref( $valid_options{ $key} ) eq 'Regexp' )
            {
                if( $value !~ /^$valid_options{ $key}$/ )
                {
                    return( $self->error({
                        type => 'RangeError',
                        message => "Invalid value \"${value}\" for option ${key}.",
                    }) );
                }
            }
        }
    }

    my $has_style = ( $opts->{dateStyle} || $opts->{timeStyle} );
    # my $other_options = scalar( grep{ $opts->{ $_ } } grep{ !/^(date|time)Style$/ } @component_options );
    if( $has_style && (
        $opts->{weekday} ||
        $opts->{era} ||
        $opts->{year} ||
        $opts->{month} ||
        $opts->{day} ||
        $opts->{hour} ||
        $opts->{minute} ||
        $opts->{second} ||
        $opts->{fractionalSecondDigits} ||
        $opts->{timeZoneName}
        ) )
    {
        return( $self->error( "You cannot specify any date-time option while using either dateStyle or timeStyle" ) );
    }

    my $resolved = 
    {
        locale => $locale,
    };
    @$resolved{ @core_options } = @$opts{ @core_options };
    my $calendar = $opts->{calendar};
    my $tz = $opts->{timeZone};
    my $tzNameOpt = $opts->{timeZoneName};
    my $date_style = $opts->{dateStyle};
    my $time_style = $opts->{timeStyle};

    my $hc = $opts->{hourCycle};
    my $h12 = $opts->{hour12};
    my $pattern;

    my $num_sys = $opts->{numberingSystem};

    if( !$calendar )
    {
        if( $calendar = $locale->calendar )
        {
            $opts->{calendar} = $calendar;
        }
        else
        {
            $opts->{calendar} = $calendar = 'gregorian';
        }
    }
    $calendar = 'gregorian' if( $calendar eq 'gregory' );
    if( lc( $calendar ) ne 'gregory' &&
        lc( $calendar ) ne 'gregorian' )
    {
        warn( "The local provided has the calendar attribute set to \"${calendar}\", but this API only supports \"gregory\" or \"gregorian\"." ) if( warnings::enabled() );
        $calendar = 'gregorian';
    }
    $resolved->{calendar} = $calendar;

    # NOTE: timeStyle or hour is define, we do some check and processing for interdependency
    if( length( $time_style // '' ) || $opts->{hour} )
    {
        # Surprisingly, the 'hour12' option takes precedence over the 'hourCycle' even though the latter is more specific.
        # I tried it in browser console:
        # const date = new Date(Date.UTC(2012, 11, 20, 3, 0, 0));
        # hour12: true, hour: "numeric", hourCycle: "h24"
        # console.log( new Intl.DateTimeFormat('en-US', { hour12: true, hour: "numeric", hourCycle: "h24" }).resolvedOptions() );
        # results in the following resolvedOptions:
        # {
        #     calendar: "gregory",
        #     hour: "2-digit",
        #     hour12: false,
        #     hourCycle: "h23",
        #     locale: "en-US",
        #     numberingSystem: "latn",
        #     timeZone: "Asia/Tokyo
        # }
        # "When true, this option sets hourCycle to either "h11" or "h12", depending on the locale. When false, it sets hourCycle to "h23". hour12 overrides both the hc locale extension tag and the hourCycle option, should either or both of those be ...
        if( defined( $h12 ) )
        {
            # There are 156 occurrences of 'H', and 115 occurrences of 'h', so we default to 'H'
            my $pref_hour_cycle = $unicode->time_format_preferred || 'H';
            $resolved->{hour12} = $h12;
            # Our implementation is more locale sensitive than the browsers' one where the browser would simply revert to h23 if h12 is false, and h12 if hour12 is true
            $resolved->{hourCycle} = $h12
                ? ( ( $pref_hour_cycle eq 'H' || $pref_hour_cycle eq 'K' ) ? 'h11' : 'h12' )
                : ( ( $pref_hour_cycle eq 'h' || $pref_hour_cycle eq 'k' ) ? 'h24' : 'h23' );
        }
        # "The hour cycle to use. Possible values are "h11", "h12", "h23", and "h24". This option can also be set through the hc Unicode extension key; if both are provided, this options property takes precedence." (Mozilla documentation)
        elsif( $hc )
        {
            $resolved->{hourCycle} = $hc;
            $resolved->{hour12} = ( $hc eq 'h12' || $hc eq 'h11' ) ? 1 : 0;
        }
        elsif( $hc = $locale->hc )
        {
            $resolved->{hourCycle} = $hc;
            $resolved->{hour12} = ( $hc eq 'h12' || $hc eq 'h11' ) ? 1 : 0;
        }
        else
        {
            my $pref_hour_cycle = $unicode->time_format_preferred || 'H';
            if( $pref_hour_cycle eq 'h' )
            {
                $resolved->{hourCycle} = 'h12';
                $resolved->{hour12} = 1;
            }
            elsif( $pref_hour_cycle eq 'H' )
            {
                $resolved->{hourCycle} = 'h23';
                $resolved->{hour12} = 0;
            }
            # Although in the Unicode CLDR data for preferred time format, the 'k', or 'K' value is never used, we put it just in case in the future it might be.
            elsif( $pref_hour_cycle eq 'k' )
            {
                $resolved->{hourCycle} = 'h24';
                $resolved->{hour12} = 0;
            }
            elsif( $pref_hour_cycle eq 'K' )
            {
                $resolved->{hourCycle} = 'h11';
                $resolved->{hour12} = 1;
            }
        }
        # 2-digit is more specific than 'numeric', and if it is specified, we do not override it. However, if it is 'numeric', we may override it.
        if( $opts->{hour} && $opts->{hour} ne '2-digit' )
        {
            $resolved->{hour} = ( $resolved->{hourCycle} eq 'h23' || $resolved->{hourCycle} eq 'h24' ) ? '2-digit' : 'numeric';
        }
    }

lib/DateTime/Format/Intl.pm  view on Meta::CPAN

#         {
#             $tz = $actual;
#         }
    }
    elsif( my $bcp47_tz = $locale->timezone )
    {
        my $all = $cldr->timezones( tz_bcpid => $bcp47_tz );
        return( $self->pass_error( $cldr->error ) ) if( !defined( $all ) && $cldr->error );
        if( $all && 
            scalar( @$all ) && 
            $all->[0]->{timezone} )
        {
            $tz = $all->[0]->{timezone};
        }
        else
        {
            warn( "No time zone could be found for the locale's time zone extension value '${bcp47_tz}'" );
        }
    }
    # If we still have not a time zone defined, as a last resort
    if( !length( $tz // '' ) )
    {
        # Calling DateTime time_zone with 'local' might die if not found on the system, so we catch it with eval
        my $dt = eval
        {
            DateTime->now( time_zone => 'local' );
        };
        if( $@ )
        {
            $tz = 'UTC';
        }
        else
        {
            $tz = $dt->time_zone->name;
        }
    }
    $resolved->{timeZone} = $tz;

    # NOTE: time zone name
    if( length( $tzNameOpt // '' ) )
    {
        $resolved->{timeZoneName} = $tzNameOpt;
    }

    # NOTE: era
    # long, short, narrow
    if( my $era = $opts->{era} )
    {
        # Only supported values are: long, short and narrow
        my $width_map =
        {
            'abbreviated' => 'short',
            'wide' => 'long',
        };
        my $tree = $cldr->make_inheritance_tree( $locale ) ||
            return( $self->pass_error( $cldr->error ) );
        my $width;
        my $supported = {};
        LOCALE: foreach my $loc ( @$tree )
        {
            my $all = $cldr->calendar_eras_l10n(
                locale => $loc,
                calendar => $calendar,
            );
            return( $self->pass_error( $cldr->error ) ) if( !defined( $all ) && $cldr->error );
            if( $all )
            {
                foreach my $this ( @$all )
                {
                    $supported->{ ( $width_map->{ $this->{era_width} } // $this->{era_width} ) }++;
                }

                if( exists( $supported->{ $era } ) )
                {
                    $width = $era;
                }
                elsif( $era eq 'short' && exists( $supported->{abbreviated} ) )
                {
                    $width = 'abbreviated';
                }
                last LOCALE;
            }
        }
        unless( defined( $width ) )
        {
            $width = exists( $supported->{long} )
                ? 'long'
                : exists( $supported->{short} )
                    ? 'short'
                    : undef;
        }
        $resolved->{era} = $width;
    }

    # NOTE month, weekday check
    my $values_to_check =
    {
        # CLDR data type => [option value, resolvedOption property]
        month => [$opts->{month}, 'month'],
        day => [$opts->{weekday}, 'weekday'],
    };
    foreach my $prop ( keys( %$values_to_check ) )
    {
        # long, short, narrow
        my $val = $values_to_check->{ $prop }->[0];
        next if( !length( $val // '' ) );
        # This is already ok
        next if( $prop eq 'month' && ( $val eq '2-digit' || $val eq 'numeric' ) );
        # Only supported values are: long, short and narrow
        my $width_map =
        {
            'abbreviated' => 'short',
            'wide' => 'long',
        };
        my $tree = $cldr->make_inheritance_tree( $locale ) ||
            return( $self->pass_error( $cldr->error ) );
        my $width;
        my $supported = {};
        LOCALE: foreach my $loc ( @$tree )
        {
            my $all = $cldr->calendar_terms(
                locale => $loc,
                calendar => $calendar,
                term_type => $prop,
                term_context => 'format',
            );
            return( $self->pass_error( $cldr->error ) ) if( !defined( $all ) && $cldr->error );
            if( $all && scalar( @$all ) )
            {
                foreach my $this ( @$all )
                {
                    $supported->{ ( $width_map->{ $this->{term_width} } // $this->{term_width} ) }++;
                }

                if( exists( $supported->{ $val } ) )
                {
                    $width = $val;
                }
                elsif( $val eq 'short' && exists( $supported->{abbreviated} ) )
                {
                    $width = 'abbreviated';
                }
                last LOCALE;
            }
        }
        unless( defined( $width ) )
        {
            $width = exists( $supported->{long} )
                ? 'long'
                : exists( $supported->{short} )
                    ? 'short'
                    : undef;
        }
        $resolved->{ $values_to_check->{ $prop }->[1] } = $width;
    }

    # NOTE: minute check; minute always end up being 2-digit, even if the user explicitly set it to numeric
    if( $opts->{minute} )
    {
        $resolved->{minute} = '2-digit';
    }
    # NOTE: second; same as minute
    if( $opts->{second} )
    {
        $resolved->{second} = '2-digit';
    }
    $self->{resolvedOptions} = $resolved;

    # NOTE: Getting pattern
    my $cache_key = join( '|', map{ $_ . ';' . $resolved->{ $_ } } sort( keys( %$resolved ) ) );
    $pattern = $self->_get_cached_pattern( $locale, $cache_key );
    unless( $pattern )
    {
        # Now, get the most suitable pattern and cache it.
        my $dateStyle = $resolved->{dateStyle};
        my $timeStyle = $resolved->{timeStyle};
        my $mode2number =
        {
            full    => 4,
            medium  => 3,
            long    => 2,
            short   => 1,
        };

lib/DateTime/Format/Intl.pm  view on Meta::CPAN

    }
    $locales = ( Scalar::Util::reftype( $locales ) // '' ) eq 'ARRAY' ? $locales : [$locales];
    my $cldr = $self->_cldr || return( $self->pass_error );
    LOCALE: for( my $i = 0; $i < scalar( @$locales ); $i++ )
    {
        my $locale = Locale::Intl->new( $locales->[$i] ) ||
            return( $self->pass_error( Locale::Intl->error ) );
        my $tree = $cldr->make_inheritance_tree( $locale->core ) ||
            return( $self->pass_error( $cldr->error ) );
        # Remove the last one, which is 'und', a.k.a 'root'
        pop( @$tree );
        foreach my $loc ( @$tree )
        {
            my $ref = $cldr->locale( locale => $loc );
            if( $ref && ref( $ref ) eq 'HASH' && scalar( keys( %$ref ) ) )
            {
                push( @$res, $loc );
                next LOCALE;
            }
        }
    }
    return( $res );
}

# Adjust pattern to match the specified format for each component:
# "Once a best match is found between requested skeleton and dateFormatItem id, the corresponding dateFormatItem pattern is used, but with adjustments primarily to make the pattern field lengths match the skeleton field lengths."
# <https://www.unicode.org/reports/tr35/tr35-dates.html#Matching_Skeletons>
sub _adjust_pattern
{
    my $self = shift( @_ );
    my $args = $self->_get_args_as_hash( @_ );
    my $pattern = $args->{pattern} || die( "No pattern was provided." );
    my $opts = $args->{options} || die( "No resolved options hash was provided." );
    if( ref( $pattern ) && !overload::Method( $pattern => '""' ) )
    {
        return( $self->error( "Pattern provided (", overload::StrVal( $pattern ), ") is a reference, but does not stringify." ) );
    }
    elsif( ref( $opts ) ne 'HASH' )
    {
        return( $self->error( "Resolved options provided (", overload::StrVal( $opts // 'undef' ), ") is not an hash reference." ) );
    }
    my $request_object = $args->{request_object} || die( "Missing the request object." );
    # Might not be provided.
    my $pattern_object = $args->{pattern_object};
    if( !ref( $request_object ) || ( ref( $request_object ) && !$request_object->isa( 'DateTime::Format::Intl::Skeleton' ) ) )
    {
        return( $self->error( "The request object provided (", overload::StrVal( $request_object // 'undef' ), ") is not a DateTime::Format::Intl::Skeleton object." ) );
    }
    elsif( defined( $pattern_object ) &&
           ( !ref( $pattern_object ) || ( ref( $pattern_object ) && !$pattern_object->isa( 'DateTime::Format::Intl::Skeleton' ) ) ) )
    {
        return( $self->error( "The pattern object provided (", overload::StrVal( $pattern_object // 'undef' ), ") is not a DateTime::Format::Intl::Skeleton object." ) );
    }
    my $unicode = $self->{_unicode} || die( "The DateTime::Locale::FromCLDR object is gone." );
    my $component_precision = {};
    my $options_map = $self->_get_options_map;

    my $component_to_match =
    {
        # Those are not related to pattern, but because they are in our options we add them here to avoid an error, but discard them later
        calendar => undef,
        numberingSystem => undef,
        # This option is used as an ancillary value to hourCycle option
        hour12 => undef,
        # hourCycle itself is only present if the option 'hour' is set
        hourCycle => undef,
        locale => undef,
        timeZone => undef,
        era => sub
            {
                return( ['G' => 'G' x $options_map->{type_to_length}->{ $opts->{era} } ] );
            },
        year => 'y',
        # Possible values: numeric, 2-digit, long, short, narrow
        month => sub
            {
                # We respect the locale's choice for month display, whether it is 'L' or 'M'
                return({
                    'L' => ( 'L' x $options_map->{month}->{ $opts->{month} } ),
                    'M' => ( 'M' x $options_map->{month}->{ $opts->{month} } ),
                });
            },
        day => 'd',
        # Possible values are 'narrow', 'short' and 'long'
        dayPeriod => sub
            {
                return({
                    'a' => ( 'a' x $options_map->{type_to_length}->{ $opts->{dayPeriod} } ),
                    'b' => ( 'b' x $options_map->{type_to_length}->{ $opts->{dayPeriod} } ),
                    'B' => ( 'B' x $options_map->{type_to_length}->{ $opts->{dayPeriod} } ),
                });
            },
        # For hours, whatever the pattern, be it 'h', 'H', 'k', or 'K', it is overriden by the user's explicit preference
        hour => sub
            {
                if( !exists( $opts->{hourCycle} ) || !defined( $opts->{hourCycle} ) )
                {
                    my $pref = $unicode->time_format_preferred;
                    if( $pref eq 'h' )
                    {
                        $opts->{hourCycle} = 'h11';
                    }
                    elsif( $pref eq 'H' )
                    {
                        $opts->{hourCycle} = 'h23';
                    }
                    elsif( $pref eq 'k' )
                    {
                        $opts->{hourCycle} = 'h23';
                    }
                }
                if( $opts->{hourCycle} eq 'h11' )
                {
                    return( [ [qw( h H k K )] => $opts->{hour} eq '2-digit' ? 'KK' : 'K' ] );
                }
                elsif( $opts->{hourCycle} eq 'h12' || $opts->{hour12} )
                {
                    return( [ [qw( h H k K )] => $opts->{hour} eq '2-digit' ? 'hh' : 'h' ] );
                }
                elsif( $opts->{hourCycle} eq 'h23' )
                {

lib/DateTime/Format/Intl.pm  view on Meta::CPAN

                }
                elsif( exists( $pattern_len->{ $component } ) &&
                       exists( $request_len->{ $component } ) &&
                       $pattern_len->{ $component } == $request_len->{ $component } )
                {
                    $token;
                }
                elsif( ref( $this ) eq 'CODE' )
                {
                    my $rv = $this->( $component, length( $token ) );
                    # If the result is undefined, we leave the original untouched
                    defined( $rv ) ? $rv : $token;
                }
                elsif( ref( $this ) )
                {
                    die( "The value returned for token \"${token}\" is a reference, but I do not know what to do with it: '", overload::StrVal( $this ), "'" );
                }
                else
                {
                    $this;
                }
            }
            # we leave it untouched
            else
            {
                $token;
            }
        }
        elsif( defined( $4 ) )
        {
            $4;
        }
        # Should not get here
        else
        {
            undef;
        }
    }sgex;

    return( $pattern );
}

sub _append_components
{
    my $self = shift( @_ );
    my $args = $self->_get_args_as_hash( @_ );
    my $pattern = $args->{pattern} || die( "No format pattern was provided." );
    my $missing = $args->{missing} || die( "No array reference of missing components was provided." );
    # Possible values: wide (Monday), abbreviated (Mon), short (Mo) and narrow (M)
    # my $width = $args->{width} || die( "No width value provided." );
    if( ref( $pattern ) && !overload::Method( $pattern => '""' ) )
    {
        die( "The pattern value provided (", overload::StrVal( $pattern ), ") is a reference (", ref( $pattern ), "), but it does not stringify." );
    }
    elsif( ref( $missing ) ne 'ARRAY' )
    {
        die( "The value provided for missing components (", overload::StrVal( $missing ), ") is not an array reference." );
    }
    my $cldr = $self->{_cldr} || die( "The Locale::Unicode::Data object is gone." );
    my $locale = $self->{locale} || die( "The locale value is gone!" );
    my $calendar = $self->{calendar} || 'gregorian';
    my $alias =
    {
        'c' => 'E',
        'e' => 'E',
        'H' => 'h',
        'k' => 'h',
        'K' => 'h',
        'L' => 'M',
        'v' => 'Z',
    };
    my $missing_hash = +{ map{ ( $alias->{ $_ } // $_ ) => $_ } @$missing };

    # my @ordered_options = qw( era year month weekday day dayPeriod hour minute second timeZoneName );
    # becomes:
    my @ordered_options = qw( G y M E d B h m s Z );
    # Possible components found in skeleton in CLDR data: [qw( B E G H M Q W Z c d h m s v w y )]
    # All possible format ID known in the CLDR calendar_append_formats table
    my $map =
    {
        # 'B' has no correspondence in table calendar_append_formats, but has in table date_terms
        'c' => ['Day-Of-Week' => 'weekday'],
        'd' => ['Day' => 'day'],
        'e' => ['Day-Of-Week' => 'weekday'],
        'E' => ['Day-Of-Week' => 'weekday'],
        'G' => ['Era' => 'era'],
        'h' => ['Hour' => 'hour'],
        'H' => ['Hour' => 'hour'],
        'k' => ['Hour' => 'hour'],
        'K' => ['Hour' => 'hour'],
        'L' => ['Month' => 'month'],
        'm' => ['Minute' => 'minute'],
        'M' => ['Month' => 'month'],
        # We put it here, but it is actually not used
        'Q' => ['Quarter' => 'quarter'],
        's' => ['Second' => 'second'],
        'v' => ['Timezone' => 'zone'],
        # We put it here, but it is actually not used
        'w' => ['Week' => 'week'],
        'W' => ['Week' => 'week'],
        'y' => ['Year' => 'year'],
        'Z' => ['Timezone' => 'zone'],
    };
    my $tree = $cldr->make_inheritance_tree( $locale ) ||
        return( $self->pass_error( $cldr->error ) );
    my $get_append_pattern = sub
    {
        my $elem = shift( @_ );
        # e.g.: {0} {1}
        # or: {0} ({2}: {1})
        my $pat;
        foreach my $loc ( @$tree )
        {
            my $ref = $cldr->calendar_append_format(
                format_id => $elem,
                locale => $loc,
                calendar => $calendar,
            );
            return( $self->pass_error( $cldr->error ) ) if( !defined( $ref ) && $cldr->error );
            if( $ref )
            {
                $pat = $ref->{format_pattern};
                last;
            }
        }
        return( $pat // '' );
    };
# day
# dayperiod
# month
# quarter
    my $get_term = sub
    {
        my $elem = shift( @_ );
        my $str;
        foreach my $loc ( @$tree )
        {
            my $ref = $cldr->date_term(
                locale => $loc,
                term_type => $elem,
                # Possible choices are 'standard' and 'narrow', but 'narrow' is relatively rare (11.70%).
                term_length => 'standard',
            );
            return( $self->pass_error( $cldr->error ) ) if( !defined( $ref ) && $cldr->error );
            if( $ref )
            {
                $str = $ref->{display_name};
                last;
            }
        }
        return( $str // '' );
    };

    local $" = ', ';
    foreach my $comp ( @ordered_options )
    {
        next unless( exists( $missing_hash->{ $comp } ) );
        if( !exists( $map->{ $comp } ) )
        {
            warn( "Unsupported component (${comp}) requested." );
        }
        my $def = $map->{ $comp };
        my $format = $get_append_pattern->( $def->[0] );
        if( !defined( $format ) )
        {
            return( $self->pass_error );
        }
        elsif( !length( $format ) )
        {
            return( $self->error( "Unable to find an append format pattern for component '${comp}' corresponding to append item '", $def->[0], "' for the locale tree @$tree" ) );
        }
        $format =~ s/\{0\}/$pattern/;
        $format =~ s/\{1\}/$missing_hash->{ $comp }/;
        if( index( $format, '{2}' ) != -1 )
        {
            my $term = $get_term->( $def->[1] );
            if( !defined( $term ) )

lib/DateTime/Format/Intl.pm  view on Meta::CPAN

                (([a-zA-Z])\3*)  # could be a pattern
                |
                (.)                 # anything else
            )
        }
        {
            if( defined( $1 ) )
            {
                push( @$parts, { value => $unescape->( $1 ), type => 'literal' });
                $1;
            }
            elsif( defined( $2 ) )
            {
                push( @$parts, $cldr_pattern->( $2 ) );
                $2;
            }
            elsif( defined( $4 ) )
            {
                push( @$parts, { value => $unescape->( $4 ), type => 'literal' });
                $4;
            }
            else
            {
                undef;
            }
        }sgex;
    };
    if( $@ )
    {
        return( $self->error( "Error formatting CLDR pattern for locale $locale: $@" ) );
    }
    return( $parts );
}

sub _get_args_as_hash
{
    my $self = shift( @_ );
    my $ref = {};
    if( scalar( @_ ) == 1 &&
        defined( $_[0] ) &&
        ( ref( $_[0] ) || '' ) eq 'HASH' )
    {
        $ref = shift( @_ );
    }
    elsif( !( scalar( @_ ) % 2 ) )
    {
        $ref = { @_ };
    }
    else
    {
        die( "Uneven number of parameters provided." );
    }
    return( $ref );
}

sub _get_available_format_patterns
{
    my $self = shift( @_ );
    my $cldr = $self->{_cldr} || die( "The Locale::Unicode::Data object is gone." );
    my $locale = $self->{locale} || die( "The locale value is gone!" );
    my $calendar = $self->{calendar} || 'gregorian';
    # "The dateFormatItems inherit from their parent locale, so the inherited items need to be considered when processing."
    # <https://www.unicode.org/reports/tr35/tr35-dates.html#Mapping_Requested_Time_Skeletons_To_Patterns>
    my $tree = $cldr->make_inheritance_tree( $locale ) ||
        return( $self->pass_error( $cldr->error ) );
    # Keep track of the format skeleton already found, so we do not replace them while going up the tree
    my $patterns = {};
    local $" = ', ';
    foreach my $loc ( @$tree )
    {
        my $all = $cldr->calendar_available_formats(
            locale      => $loc,
            calendar    => $calendar,
            alt         => undef,
            # count might contain some value
        );
        return( $self->pass_error ) if( !defined( $all ) && $cldr->error );
        if( $all && scalar( @$all ) )
        {
            for( @$all )
            {
                next if( exists( $patterns->{ $_->{format_id} } ) );
                $patterns->{ $_->{format_id} } = $_->{format_pattern};
            }
            # We do not stop here even though we may have a match, because we want to collect all the possible pattern throughout the locale's tree.
        }
    }
    return( $patterns );
}

sub _get_available_interval_patterns
{
    my $self = shift( @_ );
    my $diff = shift( @_ ) || die( "No greatest difference component was provided." );
    my $cldr = $self->{_cldr} || die( "The Locale::Unicode::Data object is gone." );
    my $locale = $self->{locale} || die( "The locale value is gone!" );
    my $calendar = $self->{calendar} || 'gregorian';
    # Get all the interval patterns for the given greatest difference
    # "The dateFormatItems inherit from their parent locale, so the inherited items need to be considered when processing."
    # <https://www.unicode.org/reports/tr35/tr35-dates.html#Mapping_Requested_Time_Skeletons_To_Patterns>
    my $tree = $cldr->make_inheritance_tree( $locale ) ||
        return( $self->pass_error( $cldr->error ) );
    my $patterns = {};
    local $" = ', ';
    foreach my $loc ( @$tree )
    {
        my $all = $cldr->calendar_interval_formats(
            locale => $loc,
            calendar => $calendar,
            greatest_diff_id => $diff,
        );
        if( $all && scalar( @$all ) )
        {
            for( @$all )
            {
                next if( exists( $patterns->{ $_->{format_id} } ) );
                $patterns->{ $_->{format_id} } = $_;
            }
            # We do not stop here even though we may have a match, because we want to collect all the possible pattern throughout the locale's tree.
        }
    }
    return( $patterns );
}

sub _get_cached_pattern
{
    my $self = shift( @_ );
    my( $locale, $key ) = @_;
    $self->_clear_cache;
    if( exists( $CACHE->{ $locale } ) && 
        ref( $CACHE->{ $locale } ) eq 'HASH' &&
        exists( $CACHE->{ $locale }->{ $key } ) )
    {
        return( $CACHE->{ $locale }->{ $key } );
    }
    return;
}

sub _get_datetime_format
{
    my $self = shift( @_ );
    my $opts = $self->_get_args_as_hash( @_ );
    my $width = $opts->{width} || die( "No datetime format width was provided." );
    my $type = $opts->{type} || 'atTime';
    die( "Bad datetime format '${type}'" ) if( $type ne 'atTime' && $type ne 'standard' );
    my $cldr = $self->{_cldr} || die( "The Locale::Unicode::Data object is gone." );
    my $locale = $self->{locale} || die( "Our Locale::Unicode object is gone!" );
    my $locales = $cldr->make_inheritance_tree( $locale ) ||
        return( $self->pass_error( $cldr->error ) );
    my $calendar = $self->{calendar} || 'gregorian';
    my $pattern;
    foreach my $loc ( @$locales )
    {
        my $ref = $cldr->calendar_datetime_format(
            locale          => $loc,
            calendar        => $calendar,
            format_type     => $type,
            format_length   => $width,
        );
        return( $self->pass_error ) if( !defined( $ref ) && $cldr->error );
        if( $ref && $ref->{format_pattern} )
        {
            $pattern = $ref->{format_pattern};
            last;
        }
    }
    return( $pattern // '' );
}

sub _get_default_options_for_locale
{
    my $self = shift( @_ );
    my $locale = shift( @_ ) || $self->{locale} ||
        return( $self->error( "No locale was provided to get default options." ) );
    # We want to know basically if the day, and month should be either numeric (i.e. 1 digit), or 2-digit
    # For this, we use the short date locale format and we check for d or d{2} and M and M{2} or L and L{2}
    my $cldr = $self->{_cldr} || die( "The Locale::Unicode::Data object is gone!" );
    # my $unicode = $self->{_unicode} || die( "The DateTime::Locale::FromCLDR object is gone!" );
    my $tree = $cldr->make_inheritance_tree( $locale ) ||
        return( $self->pass_error( $cldr->error ) );
    my $opts =
    {
        day => 'numeric',
        month => 'numeric',
        year => 'numeric',
        hour => 'numeric',
        minute => 'numeric',
        second => 'numeric',
    };
    my $defaults;
    foreach my $loc ( @$tree )
    {
        if( exists( $BROWSER_DEFAULTS->{ $loc } ) )
        {
            $defaults = $BROWSER_DEFAULTS->{ $loc };
            last;
        }
    }
    $defaults = $BROWSER_DEFAULTS->{en} if( !defined( $defaults ) );
    my @keys = keys( %$defaults );
    @$opts{ @keys } = @$defaults{ @keys };
    # $opts->{numberingSystem} = $unicode->number_system;
    return( $opts );
}

# Function to get locale-specific preferences for scoring
sub _get_locale_preferences
{
    my $self = shift( @_ );
    my $locale = $self->{locale} || die( "Locale::Intl object is gone!" );
    my $cldr = $self->_cldr || return( $self->pass_error );
    
    # Define common preference groups
    my $eastern_europe =
    {
        dayPeriod => 3,

lib/DateTime/Format/Intl.pm  view on Meta::CPAN

    # Ensure a fixed order of components when building the skeleton
    # "The canonical order is from top to bottom in that table; that is, "yM" not "My"."
    # <https://www.unicode.org/reports/tr35/tr35-dates.html#availableFormats_appendItems>
    my @ordered_options = qw( era year month weekday day dayPeriod hour minute second timeZoneName );

    my $options_map = $self->_get_options_map;
    # Map of option keys to skeleton components
    # Possible components found in skeleton in CLDR data: [qw( B E G H M Q W Z c d h m s v w y )]
    # "It is not necessary to supply dateFormatItems with skeletons for every field length; fields in the skeleton and pattern are expected to be adjusted in parallel to handle a request."
    # <https://www.unicode.org/reports/tr35/tr35-dates.html#Matching_Skeletons>
    my $option_to_skeleton = 
    {
        year            => sub
        {
            return( 'y' x ( exists( $opts->{year} ) ? ( $opts->{year} eq '2-digit' ? 2 : 1 ) : 1 ) );
        },
        month           => sub
        {
            return( 'M' x ( exists( $opts->{month} ) ? $options_map->{month}->{ $opts->{month} } : 1 ) );
        },
        day             => sub
        {
            return( 'd' x ( exists( $opts->{day} ) ? ( $opts->{day} eq '2-digit' ? 2 : 1 ) : 1 ) );
        },
        # There are 1 instance in the CLDR data where the skeleton uses 'c' (locale 'fi' with skeleton 'yMMMMccccd')
        weekday         => sub
        {
            return( 'E' x ( exists( $opts->{weekday} ) ? $options_map->{weekday}->{ $opts->{weekday} } : 1 ) );
        },
        # Can switch to 'H' for 24-hour time
        # hour            => 'h',
        hour            => sub
        {
            my $comp = ( exists( $opts->{hourCycle} ) && defined( $opts->{hourCycle} ) && ( $opts->{hourCycle} eq 'h23' || $opts->{hourCycle} eq 'h24' ) ) ? 'H' : 'h';
            return( $comp x ( exists( $opts->{hour} ) ? ( $opts->{hour} eq '2-digit' ? 2 : 1 ) : 1 ) );
        },
        minute          => sub
        {
            return( 'm' x ( exists( $opts->{minute} ) ? ( $opts->{minute} eq '2-digit' ? 2 : 1 ) : 1 ) );
        },
        second          => sub
        {
            return( 's' x ( exists( $opts->{second} ) ? ( $opts->{second} eq '2-digit' ? 2 : 1 ) : 1 ) );
        },
        era             => sub
        {
            return( 'G' x ( exists( $opts->{era} ) ? $options_map->{type_to_length}->{ $opts->{era} } : 1 ) );
        },
        dayPeriod       => sub
        {
            return( 'B' x ( exists( $opts->{dayPeriod} ) ? $options_map->{type_to_length}->{ $opts->{dayPeriod} } : 1 ) );
        },
        # There is 1 instance in the CLDR data where the skeleton uses 'Z' (locale 'fa' with skeleton 'HHmmZ')
        timeZoneName    => sub
        {
            return( exists( $opts->{timeZoneName} ) ? $options_map->{timezone}->{ $opts->{timeZoneName} } : 'v' );
        },
        # 'w' (week of year) and 'W' (week of month) are also found in the skeletons. 309 and 322 times respectively.
        # 'Q' (quarter) is also found 419 times in the skeletons, amazingly enough.
    };
    # SELECT DISTINCT(format_id) FROM calendar_available_formats WHERE format_id regexp('G') ORDER BY LENGTH(format_id), format_id;
#     my $singletons =
#     {
#         # Bh, Bhm, Bhms, EBhm, EBhms
#         'B' => 1,
#         # 'c' can have multiple occurrence
#         # 'd' can have multiple occurrence
#         # E can have multiple occurrence
#         # Gy, GyM, GyMd, GyMMM, GyMMMM, GyMMMd, GyMMMEd, GyMMMMd, GyMEEEEd, GyMMMMEd, GyMMMEEEEd
#         'G' => 1,
#         # H, h, K, k can have multiple occurrence
#         # M, L can have multiple occurrence, although L never appears in skeletons
#         # m can have multiple occurrence
#         # s can have multiple occurrence
#         # Q can have multiple occurrence
#         # v can have multiple occurrence
#         # w can have multiple occurrence
#         # W probably can have multiple occurrence, although it never appears in skeletons
#         # y can have multiple occurrence
#         'Z' => 1,
#     };

    my $date_elements =
    {
        era => 1,
        year => 1,
        month => 1,
        weekday => 1,
        day => 1,
    };
    my $time_elements =
    {
        dayPeriod => 1,
        hour => 1,
        minute => 1,
        second => 1,
        timeZoneName => 1,
    };
    my $components = [];
    my $tokens = [];
    my $date_components = [];
    my $time_components = [];
    foreach my $option ( @ordered_options )
    {
        my $value = ( ref( $option_to_skeleton->{ $option } ) ? $option_to_skeleton->{ $option }->() : $option_to_skeleton->{ $option } );
        if( ( exists( $opts->{ $option } ) && length( $opts->{ $option } // '' ) ) ||
            ( defined( $diff ) && $value eq $diff ) )
        {
            $skeleton .= $value;
            push( @$tokens, {
                component => substr( $value, 0, 1 ),
                token => $value,
                len => length( $value ),
            });
            push( @$components, substr( $value, 0, 1 ) );
            if( exists( $date_elements->{ $option } ) )
            {
                push( @$date_components, substr( $value, 0, 1 ) );
            }
            elsif( exists( $time_elements->{ $option } ) )
            {

lib/DateTime/Format/Intl.pm  view on Meta::CPAN

        ) || return( $self->pass_error );
        my $score = $score_object->score;
        
        
        # If the score is higher, update the best pattern
        if( $score > $best_score )
        {
            $best_pattern = $pattern;
            $best_score = $score;
            $best_skeleton = $skeleton;
            $best_score_object = $score_object;
        }


        # If the pattern score is equal or higher than the perfect component score, we got a perfect match and we stop checking.
        if( $score > $perfect_component_score )
        {
            # Actually, we keep going, because we could find another perfect match
            # last;
        }
    }

    # No perfect match, and this is a singleton, most likely something that has no equivalent among the available patterns.
    # If so, the requested skeleton in itself is our perfect match
    my $request_tokens = $request_object->tokens || die( "No request tokens array reference set!" );
    if( $best_score < $perfect_component_score &&
        scalar( @$request_tokens ) == 1 &&
        !exists( $available_patterns->{ $request_tokens->[0]->{token} } ) &&
        !exists( $available_patterns->{ $request_tokens->[0]->{component} } ) )
    {
        $best_score += $perfect_component_score;
        $best_skeleton = $best_pattern = ( $request_tokens->[0]->{component} x ( ref( $components_len->{ $request_tokens->[0]->{component} } ) eq 'ARRAY' ? $components_len->{ $request_tokens->[0]->{component} }->[0] : $components_len->{ $request_toke...
        $request_object->pattern( $best_pattern );
        $request_object->skeleton( $best_skeleton );
        $best_score_object = $self->_new_score_result(
            pattern_object => $request_object,
            request_object => $request_object,
            score => $best_score,
        ) || return( $self->pass_error );
        return( $best_score_object );
    }
    # Quoting from the LDML specifications:
    # "If a client-requested set of fields includes both date and time fields, and if the availableFormats data does not include a dateFormatItem whose skeleton matches the same set of fields, then the request should be handled as follows:
    #     1. Divide the request into a date fields part and a time fields part.
    #     2. For each part, find the matching dateFormatItem, and expand the pattern as above.
    #     3. Combine the patterns for the two dateFormatItems using the appropriate dateTimeFormat pattern, determined as follows from the requested date fields:
    #         * If the requested date fields include wide month (MMMM, LLLL) and weekday name of any length (e.g. E, EEEE, c, cccc), use <dateTimeFormatLength type="full">
    #         * Otherwise, if the requested date fields include wide month, use <dateTimeFormatLength type="long">
    #         * Otherwise, if the requested date fields include abbreviated month (MMM, LLL), use <dateTimeFormatLength type="medium">
    #         * Otherwise use <dateTimeFormatLength type="short">"
    # <https://www.unicode.org/reports/tr35/tr35-dates.html#Missing_Skeleton_Fields>
    elsif( (
               ( $best_score >= 0 && scalar( @{$best_score_object->missing // []} ) ) ||
               $best_score < 0
           ) &&
           scalar( @{$request_object->date_components // []} ) &&
           scalar( @{$request_object->time_components // []} ) &&
           !$diff &&
           !$args->{subprocess} )
    {
        my @core_options = qw( calendar hour12 hourCycle locale numberingSystem timeZone );
        my @date_options = ( qw( era year month weekday day ), @core_options );
        my @time_options = ( qw( hour minute second timeZoneName  ), @core_options );
        # "1. Divide the request into a date fields part and a time fields part."
        my $date_opts = +{ map{ $_ => $opts->{ $_ } } grep( exists( $opts->{ $_ } ), @date_options ) };
        my $time_opts = +{ map{ $_ => $opts->{ $_ } } grep( exists( $opts->{ $_ } ), @time_options ) };
        # "2. For each part, find the matching dateFormatItem, and expand the pattern as above."
        my $date_score_object = $self->_select_best_pattern(
            options => $date_opts,
            patterns => $available_patterns,
            # To avoid risk of recurring calls, we tag it
            subprocess => 1,
        );
        my $date_pat = $date_score_object->pattern_object->pattern;
        my $date_skel = $date_score_object->pattern_object->skeleton;
        my $has_missing_date_components = scalar( @{$date_score_object->missing // []} );
# 
#         # If the result has some missing components, we need to add them
#         if( $has_missing_date_components )
#         {
#             $date_pat = $self->_append_components(
#                 pattern => $date_pat,
#                 missing => $date_score_object->missing,
#             );
#         }

        my $time_score_object = $self->_select_best_pattern(
            options => $time_opts,
            patterns => $available_patterns,
            # To avoid risk of recurring calls, we tag it
            subprocess => 1,
        );
        my $time_pat = $time_score_object->pattern_object->pattern;
        my $time_skel = $time_score_object->pattern_object->skeleton;
        my $has_missing_time_components = scalar( @{$time_score_object->missing // []} );
        #     3. Combine the patterns for the two dateFormatItems using the appropriate dateTimeFormat pattern, determined as follows from the requested date fields:
        #         * If the requested date fields include wide month (MMMM, LLLL) and weekday name of any length (e.g. E, EEEE, c, cccc), use <dateTimeFormatLength type="full">
        #         * Otherwise, if the requested date fields include wide month, use <dateTimeFormatLength type="long">
        #         * Otherwise, if the requested date fields include abbreviated month (MMM, LLL), use <dateTimeFormatLength type="medium">
        #         * Otherwise use <dateTimeFormatLength type="short">"
        my $datetime_format_width;
        if( exists( $components_len->{'M'} ) &&
            # wide
            $components_len->{'M'} == 4 && 
            # any length, so we do not have to check the length
            exists( $components_len->{'E'} ) )
        {
            $datetime_format_width = 'full';
        }
        elsif( exists( $components_len->{'M'} ) &&
               # wide
               $components_len->{'M'} == 4 )
        {
            $datetime_format_width = 'long';
        }
        elsif( exists( $components_len->{'M'} ) &&
               # abbreviated
               $components_len->{'M'} == 3 )
        {
            $datetime_format_width = 'medium';
        }

lib/DateTime/Format/Intl.pm  view on Meta::CPAN

            'm' => 1,
            'O' => 1,
            's' => 1,
            'S' => 1,
            'v' => 1,
            'V' => 1,
            'x' => 1,
            'X' => 1,
            'z' => 1,
            'Z' => 1,
        };
        my $date_components = [];
        my $time_components = [];
        foreach my $component ( split( //, $skel ) )
        {
            if( scalar( @$tokens ) &&
                $tokens->[-1]->{component} eq $component )
            {
                $tokens->[-1]->{token} .= $component;
            }
            else
            {
                if( exists( $time_elements->{ $component } ) )
                {
                    push( @$time_components, $component );
                }
                elsif( exists( $date_elements->{ $component } ) )
                {
                    push( @$date_components, $component );
                }
                push( @$components, $component );
                $tokens->[-1]->{len} = length( $tokens->[-1]->{token} ) if( scalar( @$tokens ) );
                push( @$tokens, { component => $component, token => $component });
            }
        }
        $tokens->[-1]->{len} = length( $tokens->[-1]->{token} ) if( scalar( @$tokens ) );
        return( $tokens, $components, $date_components, $time_components );
    }
}

1;
# NOTE: POD
__END__

=encoding utf-8

=head1 NAME

DateTime::Format::Intl - A Web Intl.DateTimeFormat Class Implementation

=head1 SYNOPSIS

    use DateTime;
    use DateTime::Format::Intl;
    my $dt = DateTime->now;
    my $fmt = DateTime::Format::Intl->new(
        # You can use ja-JP (Unicode / web-style) or ja_JP (system-style), it does not matter.
        'ja_JP', {
            localeMatcher => 'best fit',
            # The only one supported. You can use 'gregory' or 'gregorian' indifferently
            calendar => 'gregorian',
            # see getNumberingSystems() in Locale::Intl for the supported number systems
            numberingSystem => 'latn',
            formatMatcher => 'best fit',
            dateStyle => 'long',
            timeStyle => 'long',
        },
    ) || die( DateTime::Format::Intl->error );
    say $fmt->format( $dt );

    my $fmt = DateTime::Format::Intl->new(
        # You can also use ja-JP (Unicode / web-style) or ja_JP (system-style), it does not matter.
        'ja_JP', {
            localeMatcher => 'best fit',
            # The only one supported
            calendar => 'gregorian',
            numberingSystem => 'latn',
            hour12 => 0,
            timeZone => 'Asia/Tokyo',
            weekday => 'long',
            era => 'short',
            year => 'numeric',
            month => '2-digit',
            day => '2-digit',
            dayPeriod => 'long',
            hour => '2-digit',
            minute => '2-digit',
            second => '2-digit',
            fractionalSecondDigits => 3,
            timeZoneName => 'long',
            formatMatcher => 'best fit',
        },
    ) || die( DateTime::Format::Intl->error );
    say $fmt->format( $dt );

In basic use without specifying a locale, C<DateTime::Format::Intl> uses the default locale and default options:

    use DateTime;
    my $date = DateTime->new(
        year    => 2012,
        month   => 11,
        day     => 20,
        hour    => 3,
        minute  => 0,
        second  => 0,
        # Default
        time_zone => 'UTC',
    );
    # toLocaleString without arguments depends on the implementation,
    # the default locale, and the default time zone
    say DateTime::Format::Intl->new->format( $date );
    # "12/19/2012" if run with en-US locale (language) and time zone America/Los_Angeles (UTC-0800)

Using C<timeStyle> and C<dateStyle>:

Possible values are: C<full>, C<long>, C<medium> and C<short>

    my $now = DateTime->new(
        year => 2024,
        month => 9,
        day => 13,
        hour => 14,
        minute => 12,
        second => 10,
        time_zone => 'Europe/Paris',
    );
    my $shortTime = DateTime::Format::Intl->new('en', {
        timeStyle => 'short',
    });
    say $shortTime->format( $now ); # "2:12 PM"
    
    my $shortDate = DateTime::Format::Intl->new('en', {
        dateStyle => 'short',
    });
    say $shortDate->format( $now ); # "09/13/24"
    

lib/DateTime/Format/Intl.pm  view on Meta::CPAN

    {
        say "Oops: ", $e->message;
    }

Or, you could set the global variable C<$FATAL_EXCEPTIONS> instead:

    use v5.34;
    use experimental 'try';
    no warnings 'experimental';
    local $DateTime::Format::Intl::FATAL_EXCEPTIONS = 1;
    try
    {
        my $fmt = DateTime::Format::Intl->new( 'x' );
        # More code
    }
    catch( $e )
    {
        say "Oops: ", $e->message;
    }

=head1 VERSION

    v0.1.8

=head1 DESCRIPTION

This module provides the equivalent of the JavaScript implementation of L<Intl.DateTimeFormat|https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Intl/DateTimeFormat>

It relies on L<DateTime::Format::Unicode>, L<DateTime::Locale::FromCLDR>, L<Locale::Unicode::Data>, which provides access to all the L<Unicode CLDR (Common Locale Data Repository)|https://cldr.unicode.org/>, and L<Locale::Intl> to achieve similar res...

It is very elaborate and the algorithm provides the same result you would get with a web browser. The algorithm itself is quite complex and took me several months to implement, given all the dependencies with the modules aforementioned it relies on, ...

I hope they will benefit you as they benefit me.

Because, just like its JavaScript equivalent, C<DateTime::Format::Intl> does quite a bit of look-ups and sensible guessing upon object instantiation, you want to create an object for a specific format, cache it and re-use it rather than creating a ne...

C<DateTime::Format::Intl> uses a set of culturally sensible default values derived directly from the web browsers own default. Upon object instantiation, it uses a culturally sensitive scoring to find the best matching format pattern available in the...

=head1 CONSTRUCTOR

=head2 new

This takes a C<locale> (a.k.a. language C<code> compliant with L<ISO 15924|https://en.wikipedia.org/wiki/ISO_15924> as defined by L<IETF|https://en.wikipedia.org/wiki/IETF_language_tag#Syntax_of_language_tags>) and an hash or hash reference of option...

Each option can also be accessed or changed using their corresponding method of the same name.

See the L<CLDR (Unicode Common Locale Data Repository) page|https://cldr.unicode.org/translation/date-time/date-time-patterns> for more on the format patterns used.

Supported options are:

=head3 Locale options

=over 4

=item * C<localeMatcher>

The locale matching algorithm to use. Possible values are C<lookup> and C<best fit>; the default is C<best fit>. For information about this option, see L<Locale identification and negotiation|https://developer.mozilla.org/en-US/docs/Web/JavaScript/Re...

Whatever value you provide, does not actually have any influence on the algorithm used. C<best fit> will always be the one used.

=item * C<calendar>

The calendar to use, such as C<chinese>, C<gregorian> (or C<gregory>), C<persian>, and so on. For a list of calendar types, see L<Intl.Locale.prototype.getCalendars()|https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/In...

For example, a Japanese locale with the C<japanese> calendar extension set:

    my $fmt = DateTime::Format::Intl->new( 'ja-Kana-JP-u-ca-japanese' );

The only value calendar type supported by this module is C<gregorian>. Any other value will return an error.

=item * C<numberingSystem>

The numbering system to use for number formatting, such as C<fullwide>, C<hant>, C<mathsans>, and so on. For a list of supported numbering system types, see L<getNumberingSystems()|Locale::Intl/getNumberingSystems>. This option can also be set throug...

For example, a Japanese locale with the C<latn> number system extension set and with the C<jptyo> time zone:

    my $fmt = DateTime::Format::Intl->new( 'ja-u-nu-latn-tz-jptyo' );

However, note that you can only provide a number system that is supported by the C<locale>, and whose type is C<numeric>, i.e. not C<algorithmic>. For instance, you cannot specify a C<locale> C<ar-SA> (arab as spoken in Saudi Arabia) with a number sy...

    my $fmt = DateTime::Format::Intl->new( 'ar-SA', { numberingSystem => 'japn' } );
    say $fmt->resolvedOptions->{numberingSystem}; # arab

It would reject it, and issue a warning, if warnings are enabled, and fallback to the C<locale>'s default number system, which is, in this case, C<arab>

Additionally, even though the number system C<jpanfin> is supported by the locale C<ja>, it would not be acceptable, because it is not suitable for datetime formatting, since it is not of type C<numeric>, or at least this is how it is treated by web ...

    my $fmt = DateTime::Format::Intl->new( 'ja-u-nu-jpanfin-tz-jptyo' );
    say $fmt->resolvedOptions->{numberingSystem}; # latn

See L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Intl/Locale/getNumberingSystems>, and also the perl module L<Locale::Intl>

=item * C<hour12>

Whether to use 12-hour time (as opposed to 24-hour time). Possible values are C<true> (C<1>) and C<false> (C<0>); the default is locale dependent. When C<true>, this option sets C<hourCycle> to either C<h11> or C<h12>, depending on the locale. When C...

=item * C<hourCycle>

The hour cycle to use. Possible values are C<h11>, C<h12>, C<h23>, and C<h24>. This option can also be set through the C<hc> Unicode extension key; if both are provided, this options property takes precedence.

See L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Intl/DateTimeFormat/DateTimeFormat#hourcycle>

=item * C<timeZone>

The time zone to use. Time zone names correspond to the Zone and Link names of the L<IANA Time Zone Database|https://www.iana.org/time-zones>, such as C<UTC>, C<Asia/Tokyo>, C<Asia/Kolkata>, and C<America/New_York>. Additionally, time zones can be gi...

See L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Intl/DateTimeFormat/DateTimeFormat#timezone>

=back

=head3 Date-time component options

=over 4

=item * C<weekday>

The representation of the weekday. Possible values are:

=over 8

=item * C<long>

For example: C<Thursday>

=item * C<short>

For example: C<Thu>

=item * C<narrow>

lib/DateTime/Format/Intl.pm  view on Meta::CPAN

        month   => 'long',
        day     => 'numeric',
    });
    say $fmt->format( $d ); # mercredi 10 janvier à 19:00
    my $ref = $fmt->formatToParts( $d );

This would return an array containing the following hash references:

    { type => 'weekday', value => 'mercredi' },
    { type => 'literal', value => ' ' },
    { type => 'day',     value => '10' },
    { type => 'literal', value => ' ' },
    { type => 'month',   value => 'janvier' },
    { type => 'literal', value => ' à ' },
    { type => 'hour',    value => '19' },
    { type => 'literal', value => ':' },
    { type => 'minute',  value => '00' }

The C<formatToParts()> method takes an optional L<DateTime> object, and returns an array of locale-specific tokens representing each part of the formatted date produced by this L<DateTime::Format::Intl> object. It is useful for custom formatting of d...

If no L<DateTime> object is provided, it will default to the current date and time.

The properties of the hash references returned are as follows:

=over 4

=item * C<day>

The string used for the day, for example C<17>.

=item * C<dayPeriod>

The string used for the day period, for example, C<AM>, C<PM>, C<in the morning>, or C<noon>

=item * C<era>

The string used for the era, for example C<BC> or C<AD>.

=item * C<fractionalSecond>

The string used for the fractional seconds, for example C<0> or C<00> or C<000>.

=item * C<hour>

The string used for the hour, for example C<3> or C<03>.

=item * C<literal>

The string used for separating date and time values, for example C</>, C<,>, C<o'clock>, C<de>, etc.

=item * C<minute>

The string used for the minute, for example C<00>.

=item * C<month>

The string used for the month, for example C<12>.

=item * C<relatedYear>

The string used for the related 4-digit Gregorian year, in the event that the calendar's representation would be a yearName instead of a year, for example C<2019>.

=item * C<second>

The string used for the second, for example C<07> or C<42>.

=item * C<timeZoneName>

The string used for the name of the time zone, for example C<UTC>. Default is the timezone of the current environment.

=item * C<weekday>

The string used for the weekday, for example C<M>, C<Monday>, or C<Montag>.

=item * C<year>

The string used for the year, for example C<2012> or C<96>.

=item * C<yearName>

The string used for the yearName in relevant contexts, for example C<geng-zi>

=back

=head2 resolvedOptions

The C<resolvedOptions()> method returns an hash reference with the following properties reflecting the C<locale> and date and time formatting C<options> computed during the object instantiation.

=over 4

=item * C<locale>

The BCP 47 language tag for the locale actually used. If any Unicode extension values were requested in the input BCP 47 language tag that led to this locale, the key-value pairs that were requested and are supported for this locale are included in l...

=item * C<calendar>

E.g. C<gregory>

=item * C<numberingSystem>

The values requested using the Unicode extension keys C<ca> and C<nu> or filled in as default values.

=item * C<timeZone>

The value provided for this property in the options argument; defaults to the runtime's default time zone. Should never be undefined.

=item * C<hour12>

The value provided for this property in the options argument or filled in as a default.

=item * C<weekday>, C<era>, C<year>, C<month>, C<day>, C<hour>, C<minute>, C<second>, C<timeZoneName>

The values resulting from format matching between the corresponding properties in the options argument and the available combinations and representations for date-time formatting in the selected locale. Some of these properties may not be present, in...

=back

=head1 OTHER NON-CORE METHODS

=head2 error

Sets or gets an L<exception object|DateTime::Format::Intl::Exception>

When called with parameters, this will instantiate a new L<DateTime::Format::Intl::Exception> object, passing it all the parameters received.

When called in accessor mode, this will return the latest L<exception object|DateTime::Format::Intl::Exception> set, if any.

=head2 fatal

    $fmt->fatal(1); # Enable fatal exceptions
    $fmt->fatal(0); # Disable fatal exceptions
    my $bool = $fmt->fatal;

Sets or get the boolean value, whether to die upon exception, or not. If set to true, then instead of setting an L<exception object|DateTime::Format::Intl::Exception>, this module will die with an L<exception object|DateTime::Format::Intl::Exception>...

    use v.5.34; # to be able to use try-catch blocks in perl
    use experimental 'try';
    no warnings 'experimental';
    try
    {
        my $fmt = DateTime::Format::Intl->new( 'x', fatal => 1 );
    }
    catch( $e )
    {
        say "Error occurred: ", $e->message;
        # Error occurred: Invalid locale value "x" provided.
    }

=head2 greatest_diff

    my $fmt = DateTime::Format::Intl->new( 'fr-FR' );
    say $fmt->formatRange( $d1 => $d2 ); # 10/05/2024 - 11/05/2024
    # Found that day ('d') is the greatest difference between the two datetimes
    my $component = $fmt->greatest_diff; # d

Read-only method.



( run in 0.600 second using v1.01-cache-2.11-cpan-39bf76dae61 )