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

# $Id$

package DateTime::Lite::Tool::Locale::Generator;
use Moose;
use Moose::Util::TypeConstraints;
use MooseX::Types::Path::Class qw(Dir);
use DateTime::Lite::Tool::Locale::LDML;
use File::chdir;
use File::Temp ();
use LWP::UserAgent;

use LWP::UserAgent;

with 'MooseX::Getopt';

subtype 'DateTime::Lite::Tool::Locale::Generator::Version'
    => as 'Str'
    => where {
        /^\d+\.\d+\.\d+$/
    }
;

has 'verbose' => (
    is => 'rw',
    isa => 'Bool',
    default => 1
);

has 'version' => (
    is => 'rw',
    isa => 'DateTime::Lite::Tool::Locale::Generator::Version',
    required => 1,
);

has 'dest' => (
    is => 'rw',
    isa => Dir,
    coerce => 1,
    default => sub { Path::Class::Dir->new(File::Temp::tempdir( CLEANUP => 1 )) }
);

__PACKAGE__->meta->make_immutable;

no Moose;
no Moose::Util::TypeConstraints;

sub run {
    my $self = shift;

    my $ua   = LWP::UserAgent->new();
    $ua->mirror(
        sprintf("http://unicode.org/Public/cldr/%s/core.zip", $self->version),
        $self->dest->file("core.zip")
    );
    
    local $CWD = $self->dest->stringify;
    system("unzip", "core.zip") and die $!;

    my @files = $self->read_all_files($self->dest->subdir("main"));
    $self->generate_dat_files(@files);
}

sub read_all_files {
    my $self = shift;
    my $dir = Path::Class::Dir->new($_[0]);

    my @ldml;
    while ( my $file = $dir->next() ) {
        next unless -f $file;
        next unless $file->basename() =~ /\.xml$/;
#        next if $opts{file} && $opts{file} ne $file->basename();

        print "Reading $file\n" if $self->verbose;

        my $ldml = DateTime::Lite::Tool::Locale::LDML->new_from_file($file);

        # Any locale without this cannot be registered by
        # DateTime::Locale.
        next unless defined $ldml->en_language();

        push @ldml, $ldml;
    }

    return sort { $a->id() cmp $b->id() } @ldml;
}

sub generate_dat_files {
    my ($self, @ldml) = @_;

    print "\nGenerating PM files\n" if $self->verbose;

    for my $ldml ( sort @ldml ) {
        if ( $self->verbose )
        {
            print sprintf( <<"EOF", $ldml->id(), $ldml->parent_id(), $ldml->version(), $ldml->generation_date() );
  %s
    parent_id:       %s
    version:         %s
    generation date: %s

EOF
        }

        $self->generate_dat_file($ldml);
    }
}

sub generate_dat_file {
    my $ldml = shift;

    my $dat_file = file( qw( misc locale ), $ldml->id() . q{.dat} );
#    write_to_manifest($dat_file);

    open my $fh, '>:utf8', $dat_file
        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 );
}

1;