Changeset 24596

Timestamp:

11/22/08 12:37:01 (4 years ago)

Author:

daisuke

Message:

locale generator

Files:

• lang/perl/DateTime-Lite/trunk/tools/lib/DateTime/Lite/Tool/Locale/Generator.pm (modified) (6 diffs)

lang/perl/DateTime-Lite/trunk/tools/lib/DateTime/Lite/Tool/Locale/Generator.pm

@@ -5 +5 @@
 use Moose::Util::TypeConstraints;
 use MooseX::Types::Path::Class qw(Dir);
+use Data::Dumper;
 use DateTime::Lite::Tool::Locale::LDML;
 use File::chdir;
@@ -46 +47 @@
 no Moose::Util::TypeConstraints;
 
+my %DATA;
+
+sub get_ldml_from_id {
+    my ($self, $id) = @_;
+    return $DATA{$id};
+}
+
 sub run {
     my $self = shift;
@@ -55 +63 @@
     );
     
-    local $CWD = $self->dest->stringify;
-    system("unzip", "core.zip") and die $!;
-
-    my @files = $self->read_all_files($self->dest->subdir("main"));
+    my @files;
+    {
+        local $CWD = $self->dest->stringify;
+        system("unzip", "core.zip") and die $!;
+
+        @files = $self->read_all_files($self->dest->subdir("main"));
+    }
+
+    %DATA = map { ($_->id, $_) } @files;
+
     $self->generate_dat_files(@files);
 }
@@ -118 +132 @@
     }
 
-    open my $fh, '>:utf8', $dat_file
+    my $fh = $dat_file->openw()
         or die "Cannot write to $dat_file: $!";
-
-#    write_pm_header( $fh, $ldml );
-#    write_pm_inheritance( $fh, $ldml );
-#    write_pm_cldr_version( $fh );
-#    write_pm_subs( $fh, $ldml );
-#    write_pm_footer( $fh, $ldml );
-#}
-
-    print $fh <<EOF;
+    $fh->binmode(':utf8');
+
+    print $fh <<EOF or die "could not write to $dat_file: $!";
 ###########################################################################
 #
@@ -143 +151 @@
 ###########################################################################
 EOF
+
+    my $data = $self->generate_data($ldml->id);
+
+    print $fh Dumper($data);
+    close($fh);
+}
+
+sub generate_data {
+    my ($self, $ldml) = @_;
+
+    $ldml = $DATA{$ldml} if ! ref $ldml;
+    return unless $ldml;
+
     my %data = (
-        cldr_version => $self->version
+        cldr_version => $self->version,
     );
+
+    if (my $parent_id = $ldml->parent_id) {
+        print "fetching parent $parent_id\n";
+        my $parent_data = $self->generate_data($parent_id);
+        if ($parent_data) {
+            %data = (%data, %$parent_data);
+        }
+    }
+
+    $data{id} = $ldml->id;
 
     foreach my $attr ( sort { $a->name() cmp $b->name() }
@@ -153 +184 @@
             /^(?:day_|month_|quarter_|am_pm|era_|date_|time_|datetime_|first_day_)/;
 
-        next if make_alias( $fh, $ldml, $attr->name() );
-
+        next if $self->make_alias( $ldml, \%data, $attr->name() );
+
+        my $name  = $attr->name;
+        my $value = $ldml->$name;
         my $type = $attr->type_constraint();
 
-        if ( $type->is_a_type_of('ArrayRef') )
-        {
-            write_arrayref_sub( $fh, $ldml, $attr->name() );
+        my $ok = 0;
+        if (defined $value) {
+            if ($type->is_a_type_of('ArrayRef')) {
+                $ok = scalar @$value;
+            } elsif ($type->is_a_type_of('HashRef')) {
+                $ok = scalar keys %$value;
+            } elsif ($type->is_a_type_of('Str') || $type->is_a_type_of('Int')) {
+                $ok = length $value;
+            } else {
+                die "Cannot handle type: $name";
+            }
+        
+            $data{ $name } = $value if $ok;
         }
-        elsif ( $type->is_a_type_of('HashRef') )
-        {
-            write_hashref_sub( $fh, $ldml, $attr->name() );
-        }
-        elsif ( $type->is_a_type_of('Str') )
-        {
-            write_string_sub( $fh, $ldml, $attr->name() );
-        }
-        elsif ( $type->is_a_type_of('Int') )
-        {
-            write_int_sub( $fh, $ldml, $attr->name() );
-        }
-        else
-        {
-            die "Cannot handle type: " . $type->name();
-        }
-    }
-
-}
+    }
+    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} = $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;