view release on metacpan or  search on metacpan

tools/lib/DateTimeX/Lite/Tool/Locale/Generator.pm  view on Meta::CPAN

    }

    my $formats = $ldml->available_formats;
    foreach my $format (sort keys %$formats) {
        $data{ "_format_for_$format" } = $formats->{$format}
            if defined $formats->{$format};
    }

    foreach my $k qw( en_language en_script en_territory en_variant native_language native_script native_territory native_variant) {
        my $v = $ldml->$k();
        if (defined $v) {
            $data{$k} = $v;
        }
    }

    return \%data;
}


sub make_alias {
    my $self = shift;
    my $ldml = shift;
    my $data = shift;
    my $name = shift;

    if ( $name =~ /stand_alone/ )
    {
        return $self->make_stand_alone_alias( $ldml, $data, $name );
    }
    elsif ( $name =~ /(?:abbreviated|narrow)/ )
    {
        return $self->make_length_alias( $ldml, $data, $name );
    }

}

sub make_stand_alone_alias
{
    my $self = shift;
    my $ldml = shift;
    my $data = shift;
    my $name = shift;

    ( my $format = $name ) =~ s/stand_alone/format/;

    return $self->maybe_make_alias( $ldml, $data, $name, $format );
}

sub make_length_alias
{
    my $self = shift;
    my $ldml = shift;
    my $data = shift;
    my $name = shift;
    # This isn't well documented (or really documented at all) in the
    # LDML spec, but the example seem to suggest that for the narrow
    # form, the format type should "inherit" from the stand-alone
    # type if possible, rather than the abbreviated type.
    #
    # See
    # http://www.unicode.org/cldr/data/charts/by_type/calendar-gregorian.day.html
    # for examples of the expected output. Note that the format narrow
    # days for English are inherited from its stand-alone narrow form,
    # not the root locale.
    if ( $name =~ /format_narrow/ )
    {
        ( my $to_name = $name ) =~ s/format/stand_alone/;
        return 1
            if $self->maybe_make_alias( $ldml, $data, $name, $to_name );
    }

    # It seems like the quarters should just inherit up the (Perl)
    # inheritance chain, rather than from the next biggest size. See
    # http://www.unicode.org/cldr/data/charts/by_type/calendar-gregorian.quarter.html
    # for an example. Note that the English format narrow quarter is
    # "1", not "Q1".
    if ( $name =~ /quarter_(\w+)_narrow/ )
    {
        return;
    }

    ( my $to_name = $name );
    $to_name =~ s/abbreviated/wide/;
    $to_name =~ s/narrow/abbreviated/;

    return $self->maybe_make_alias( $ldml, $data, $name, $to_name );
}

sub maybe_make_alias
{
    my $self = shift;
    my $ldml = shift;
    my $data = shift;
    my $from = shift;
    my $to   = shift;

    my $val = $ldml->$from();

    return if @{ $val };

    return unless $ldml->can($to);

    my $to_val = $ldml->$to();

    return unless @{ $to_val };

    $data->{$from} = "alias:$to";

    return 1;
}

sub write_arrayref_sub
{
    my $self = shift;
    my $ldml = shift;
    my $data = shift;
    my $name = shift;

    my $arr = $ldml->$name();

    return unless @{ $arr };

    $data->{$name} = $arr;
}


1;