# $Id: /mirror/datetime/DateTime-Format-Japanese/trunk/lib/DateTime/Format/Japanese/Traditional.pm 69499 2008-08-24T16:17:57.045540Z lestrrat  $

package DateTime::Format::Japanese::Traditional;
use strict;
use warnings;
use utf8;
use DateTime::Calendar::Japanese;
use DateTime::Calendar::Japanese::Era;
use DateTime::Format::Japanese::Common qw(:constants);
use Exporter;
use Params::Validate qw(validate validate_pos SCALAR BOOLEAN);
use constant FORMAT_NUMERIC_MONTH => 'FORMAT_NUMERIC_MONTH';
use constant FORMAT_WAREKI_MONTH => 'FORMAT_WAREKI_MONTH';
use vars qw(@ISA %EXPORT_TAGS);
BEGIN
{
    @ISA         = qw(Exporter);
    %EXPORT_TAGS = (
        constants => [ qw(
            FORMAT_KANJI_WITH_UNIT FORMAT_KANJI FORMAT_ZENKAKU
            FORMAT_ROMAN FORMAT_NUMERIC_MONTH FORMAT_WAREKI_MONTH) ]
    );
    Exporter::export_ok_tags('constants');
}
# Got to call these after we define constants


use vars qw(
    @WAREKI_MONTHS @ZODIAC_HOURS %WAREKI2MONTH %ZODIAC2HOUR
    $HOUR_NO_QUARTER_MARKER
    $HOUR_WITH_QUARTER_MARKER
    $RE_WAREKI_MONTH
    $RE_HOUR_NO_QUARTER_MARKER
    $RE_HOUR_WITH_QUARTER_MARKER
    $RE_ZODIAC_HOUR
);

{
    @WAREKI_MONTHS = qw(睦月 如月 弥生 卯月 皐月 水無月 文月 葉月 長月 神無月 霜月 師走);
    %WAREKI2MONTH = map { ($WAREKI_MONTHS[$_] => $_ + 1) } 0 .. $#WAREKI_MONTHS;

    @ZODIAC_HOURS = qw(卯 辰 巳 午 未 申 酉 戌 亥 子 丑 寅);
    %ZODIAC2HOUR = map { ($ZODIAC_HOURS[$_] => $_ + 1) } 0 .. $#ZODIAC_HOURS;

    $HOUR_NO_QUARTER_MARKER = 'の刻';
    $HOUR_WITH_QUARTER_MARKER = 'つ刻';

    $RE_WAREKI_MONTH = DateTime::Format::Japanese::Common::_make_re(join( "|",
        map { DateTime::Format::Japanese::Common::_make_utf8_re_str($_) }
        @WAREKI_MONTHS ));
    $RE_HOUR_NO_QUARTER_MARKER =
        DateTime::Format::Japanese::Common::_make_utf8_re(
            $HOUR_NO_QUARTER_MARKER);
    $RE_HOUR_WITH_QUARTER_MARKER =
        DateTime::Format::Japanese::Common::_make_utf8_re(
            $HOUR_WITH_QUARTER_MARKER);
    $RE_ZODIAC_HOUR = DateTime::Format::Japanese::Common::_make_re( join( '|', map {
        DateTime::Format::Japanese::Common::_make_utf8_re_str($_) } @ZODIAC_HOURS) );
}

my %NewValidate = (
	output_encoding => { default => 'utf8' },
	input_encoding => { default => 'utf8' },
    number_format => { 
        type    => SCALAR,
        default => FORMAT_KANJI
    },
    month_format => {
        type => SCALAR,
        default => FORMAT_NUMERIC_MONTH
    },
    with_traditional_marker => {
        type => BOOLEAN,
        default => 1
    }
);

sub new
{
    my $class = shift;
    my %hash  = validate(@_, \%NewValidate);
    my $self  = bless \%hash, $class;
}

sub input_encoding
{
	my $self = shift;
	my $ret = $self->{input_encoding};
	if (@_) {
		$self->{input_encoding} = shift;
	}
	return $ret;
}

sub output_encoding
{
	my $self = shift;
	my $ret = $self->{output_encoding};
	if (@_) {
		$self->{output_encoding} = shift;
	}
	return $ret;
}

sub number_format
{
    my $self    = shift;
    my $current = $self->{number_format};
    if (@_) {
        my($val) = validate_pos(@_, {
            type => SCALAR,
            callbacks => {
                'is valid number_format' => \&DateTime::Format::Japanese::Common::_valid_number_format
            }
        });
        $self->{number_format} = $val;
    }
    return $current;
}

sub month_format
{
    my $self    = shift;
    my $current = $self->{month_format};
    if (@_) {
        my($val) = validate_pos(@_, {
            type => SCALAR,
            callbacks => {
                'is valid month_format' => sub {
                    $_[0] eq FORMAT_NUMERIC_MONTH ||
                    $_[0] eq FORMAT_WAREKI_MONTH
                }
            }
        });
        $self->{month_format} = $val;
    }
    return $current;
}

sub with_traditional_marker
{
    my $self    = shift;
    my $current = $self->{with_traditional_marker};
    if (@_) {
        my($val) = validate_pos(@_, { type => BOOLEAN });
        $self->{with_traditional_marker} = $val;
    }
    return $current;
}

my @FmtBasicValidate = (
    { isa => 'DateTime::Calendar::Japanese' },
);

sub format_datetime
{
    my $self = shift;
    my ($dt) = validate_pos(@_, @FmtBasicValidate);

    return $self->format_ymd($dt) .
        $self->format_time($dt);
}

sub format_year
{
    my $self = shift;
    my ($dt) = validate_pos(@_, @FmtBasicValidate);

    my $era_name = $dt->era->name;

    my $rv = '';
    if ($self->with_traditional_marker) {
        $rv .= $DateTime::Format::Japanese::Common::TRADITIONAL_MARKER;
    }
    $rv .= $era_name .
        DateTime::Format::Japanese::Common::_format_number(
            $dt->era_year, $self->number_format) . 
        $DateTime::Format::Japanese::Common::YEAR_MARKER;
    return Encode::encode($self->{output_encoding}, $rv);
}

sub format_month
{
    my $self = shift;
    my ($dt) = validate_pos(@_, @FmtBasicValidate);

	my $ret;
    if ($self->month_format eq FORMAT_WAREKI_MONTH) {
        $ret = $WAREKI_MONTHS[ $dt->month - 1 ];
    } else {
        $ret =
            DateTime::Format::Japanese::Common::_format_common_with_marker(
                $DateTime::Format::Japanese::Common::MONTH_MARKER,
                $dt->month,
                $self->number_format);
    }
	return Encode::encode($self->{output_encoding}, $ret);
}

sub format_day
{
    my $self = shift;
    my ($dt) = validate_pos(@_, @FmtBasicValidate);

    return Encode::encode($self->{output_encoding},
        DateTime::Format::Japanese::Common::_format_common_with_marker(
            $DateTime::Format::Japanese::Common::DAY_MARKER,
            $dt->day,
            $self->number_format));
}

sub format_ymd
{
    my $self = shift;
    my ($dt) = validate_pos(@_, @FmtBasicValidate);

    return $self->format_year($dt) .
        $self->format_month($dt) .
        $self->format_day($dt);

}

sub format_time
{
    my $self = shift;
    my ($dt) = validate_pos(@_, @FmtBasicValidate);

	my $ret;
    if ($dt->hour_quarter > 1) {
       $ret = $ZODIAC_HOURS[ $dt->hour - 1 ] .
            DateTime::Format::Japanese::Common::_format_number(
                $dt->hour_quarter, $self->number_format) .
            $HOUR_WITH_QUARTER_MARKER;
    } else {
        $ret = $ZODIAC_HOURS[ $dt->hour - 1 ] .
            $HOUR_NO_QUARTER_MARKER;
    }

	return Encode::encode($self->{output_encoding}, $ret);
}

sub _fix_era_name
{
    my %args = @_;
    my $era = 
        DateTime::Calendar::Japanese::Era->lookup_by_name(name => $args{parsed}->{era_name});

    if (!$era) {
        return 0;
    }

    $args{parsed}->{era_name} = $era->id;
}

sub _fix_wareki_month
{
    my %args = @_;
    my $w_m = delete $args{parsed}->{wareki_month};
    if (defined($w_m)) {
        return $args{parsed}->{month} = $WAREKI2MONTH{ $w_m };
    }
    1;
}
    

sub _fix_zodiac_hour
{
    my %args = @_;

    if (exists $args{parsed}->{zodiac_hour} ) {
        my $zh = delete $args{parsed}->{zodiac_hour};
        if (defined($zh)) {
            return $args{parsed}->{hour} = $ZODIAC2HOUR{ $zh };
        }
    }
    1;
}

sub _fix_hour_quarter
{
    my %args = @_;
    if (exists $args{parsed}->{hour_quarter} && $args{parsed}->{hour_quarter} !~ /^[0-9]$/) {
        my $h_q = delete $args{parsed}->{hour_quarter} ;
        return $args{parsed}->{hour_quarter} =
            $DateTime::Format::Japanese::Common::JP2ASCII{ $h_q };
    }

    1;
}

my $parse_standard = {
    regex => qr<
        ^
        $DateTime::Format::Japanese::Common::RE_TRADITIONAL_MARKER?
        ($DateTime::Format::Japanese::Common::RE_ERA_NAME)
        ($DateTime::Format::Japanese::Common::RE_ERA_YEAR)
        $DateTime::Format::Japanese::Common::RE_YEAR_MARKER
        (?:
            (?:
                ($DateTime::Format::Japanese::Common::RE_TWO_DIGITS)
                $DateTime::Format::Japanese::Common::RE_MONTH_MARKER
            )
            |
            ($RE_WAREKI_MONTH)
        )
        ($DateTime::Format::Japanese::Common::RE_TWO_DIGITS)
        $DateTime::Format::Japanese::Common::RE_DAY_MARKER
        (?:($RE_ZODIAC_HOUR)
        $RE_HOUR_NO_QUARTER_MARKER)?
        $
    >x,
    constructor => [ 'DateTime::Calendar::Japanese', 'new' ],
    params      => [ qw(era_name era_year month wareki_month day zodiac_hour) ],
    preprocess  => [
        \&DateTime::Format::Japanese::Common::_normalize_utf8, ],
    postprocess => [
        \&_fix_era_name,
        \&DateTime::Format::Japanese::Common::_fix_era_year,
        \&DateTime::Format::Japanese::Common::_normalize_numbers,
        \&_fix_wareki_month,
        \&_fix_zodiac_hour,
        ]
};

my $parse_standard_with_quarter = {
    regex => qr<
        ^
        $DateTime::Format::Japanese::Common::RE_TRADITIONAL_MARKER?
        ($DateTime::Format::Japanese::Common::RE_ERA_NAME)
        ($DateTime::Format::Japanese::Common::RE_ERA_YEAR)
        $DateTime::Format::Japanese::Common::RE_YEAR_MARKER
        (?:
            (?:
                ($DateTime::Format::Japanese::Common::RE_TWO_DIGITS)
                $DateTime::Format::Japanese::Common::RE_MONTH_MARKER
            )
            |
            ($RE_WAREKI_MONTH)
        )
        ($DateTime::Format::Japanese::Common::RE_TWO_DIGITS)
        $DateTime::Format::Japanese::Common::RE_DAY_MARKER
        (?:
            ($RE_ZODIAC_HOUR)
            ($DateTime::Format::Japanese::Common::RE_JP_OR_ASCII_NUM)
            $RE_HOUR_WITH_QUARTER_MARKER
        )?
        $
    >x,
    constructor => [ 'DateTime::Calendar::Japanese', 'new' ],
    params      => [ qw(era_name era_year month wareki_month day zodiac_hour hour_quarter) ],
    preprocess  => [
        \&DateTime::Format::Japanese::Common::_normalize_utf8, ],
    postprocess => [
        \&_fix_era_name,
        \&DateTime::Format::Japanese::Common::_fix_era_year,
        \&DateTime::Format::Japanese::Common::_normalize_numbers,
        \&_fix_wareki_month,
        \&_fix_zodiac_hour,
        \&_fix_hour_quarter,
        ]
};

require DateTime::Format::Builder;
DateTime::Format::Builder->create_class(
    parsers => {
        parse_datetime => [
            $parse_standard,
            $parse_standard_with_quarter
        ]
    }
);

1;

__END__

=head1 NAME

DateTime::Format::Japanese::Traditional - A Japanese DateTime Formatter For Traditional Japanese Calendar

=head1 SYNOPSIS

  use DateTime::Format::Japanese::Traditional;
  my $fmt = DateTime::Format::Japanese::Traditional->new();

  # or if you want to set options,
  my $fmt = DateTime::Format::Japanese::Traditional->new(
    number_format           => FORMAT_KANJI,
    month_format            => FORMAT_WAREKI_MONTH,
    with_traditional_marker => 1
  );

  my $str = $fmt->format_datetime($dt);
  my $dt  = $fmt->parse_datetime("大化三年弥生三日丑三つ刻");

=head1 DESCRIPTION

This module implements a DateTime::Format module that can read tradtional
Japanese date notations and create a DateTime::Calendar::Japanese object,
and vice versa.

  XXX WARNING WARNING WARNING XXX

  Currently DateTime::Format::Japanese only supports Perl 5.7 and up.
  This is because I'm ignorant in the ways of making robust regular
  expressions in Perls <= 5.6.x with Jcode. If anybody can contribute to
  this, I would much appreciate it

  XXX WARNING WARNING WARNING XXX

=head1 METHODS

=head2 new()

This constructor will create a DateTime::Format::Japanese object.
You may optionally pass any of the following parameters:

  number_format           - how to format numbers (default: FORMAT_KANJI)
  month_format            - how to format months (default: FORMAT_NUMERIC_MONTH)
  with_traditional_marker - use traditional calendar marker (default: 0)

Please note that all of the above parameters only take effect for
I<formatting>, and not I<parsing>. Parsing is done in a way such
that it accepts any of the known formats that this module can produce.

=head2 $fmt-E<gt>parse_datetime($string)

This function will parse a traditional Japanese date/time string and convert
it to a DateTime::Calendar::Japanese object. If the parsing is unsuccessful
it will croak.
Note that it will try to auto-detect whatever encoding you're using via
Encode::Guess, so you should be safe to pass any of UTF-8, euc-jp, 
shift-jis, and iso-2022-jp encoded strings.

This method can be called as a class function as well.

  my $dt = DateTime::Format::Japanese::Traditional->parse_datetime($string);
  # or
  my $fmt = DateTime::Format::Japanese::Traditional->new();
  my $fmt->parse_daettime($string);

=head1 FORMATTING METHODS

All of the following methods accept a single parameter, a
DateTime::Calendar::Japanese object, and return the appropriate string
representation.

  my $dt  = DateTime->now();
  my $fmt = DateTime::Format::Japanese::Traditional->new(...);
  my $str = $fmt->format_datetime($dt);

=head2 $fmt-E<gt>format_datetime($dt)

Create a complete string representation of a DateTime::Calendar::Japanese object in Japanese

=head2 $fmt-E<gt>format_ymd($dt)

Create a string representation of year, month, and date of a  DateTime
object in Japanese

=head2 $fmt-E<gt>format_year($dt)

Create a string representation of the year of a DateTime::Calendar::Japanese object in Japanese

=head2 $fmt-E<gt>format_month($dt)

Create a string representation of the month of a DateTime::Calendar::Japanese object in Japanese

=head2 $fmt-E<gt>format_day($dt)

Create a string representation of the day (day of month) of a DateTime::Calendar::Japanese object
in Japanese

=head2 $fmt-E<gt>format_time($dt)

Create a string representation of the time (hour, minute, second) of a DateTime::Calendar::Japanese object in Japanese

=head1 OPTIONS

=head2 input_encoding()

=head2 output_encoding()

Get/Set the encoding that this module should expect to use.

=head2 number_format()

Get/Set the number formatting option. Possible values are:

=over 4

=item FORMAT_ROMAN

Formats the numbers in plain ascii roman numerals.

=item FORMAT_KANJI

Formats numbers in kanji numerals without any unit specifiers.

=item FORMAT_ZENKAKU

Formats numbers in zenkaku numerals (double-byte equivalent of roman numerals)

=item FORMAT_KANJI_WITH_UNIT

Formats numbers in kanji numerals, with unit specifiers.

=back

=head2 month_format()

Get/Set the month formatting option. Possible values are:

=over 4

=item FORMAT_NUMERIC_MONTH

Formats the month using numerals.

=item FORMAT_WAREKI_MONTH

Formtas the month using traditional Japanese month names.

=back

=head2 with_traditional_marker()

Get/Set the option to include a marker that declares the date as
a traditional Japanese date.

=head1 AUTHOR

(c) 2004-2008 Daisuke Maki E<lt>daisuke@endeworks.jp<gt>.

=cut