root/Date-Japanese-Era/trunk/lib/Date/Japanese/Era.pm

Revision 352 (checked in by miyagawa, 19 years ago)

0.02

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1 package Date::Japanese::Era;
2
3 use strict;
4 use vars qw($VERSION);
5 $VERSION = '0.02';
6
7 use Carp;
8 use constant END_OF_LUNAR => 1872;
9
10 use vars qw(@ISA @EXPORT %ERA_TABLE %ERA_JA2ASCII %ERA_ASCII2JA);
11
12 use vars qw($Have_Jcode);
13 BEGIN {
14     $Have_Jcode = 0;
15     eval { require Jcode; $Have_Jcode++; };
16 }
17
18 {
19     my $codeset = 'euc';
20     sub codeset {
21         my $proto = shift;
22         if (@_) {
23             carp "Jcode is required to modify codeset. Ignored."
24                 unless $Have_Jcode;
25             $codeset = shift;
26         }
27         $codeset;
28     }
29 }
30
31 sub import {
32     my $self = shift;
33     if (@_) {
34         my $table = shift;
35         eval qq{use Date::Japanese::Era::Table::$table};
36         die $@ if $@;
37     }
38     else {
39         require Date::Japanese::Era::Table;
40         import Date::Japanese::Era::Table;
41     }
42 }
43
44 sub new {
45     my($class, @args) = @_;
46     my $self = bless {
47         name => undef,
48         year => undef,
49         gregorian_year => undef,
50     }, $class;
51
52     if (@args == 3) {
53         $self->_from_ymd(@args);
54     }
55     elsif (@args == 2) {
56         $self->_from_era(@args);
57     }
58     else {
59         croak "odd number of arguments: @args";
60     }
61     return $self;
62 }
63
64 sub _from_ymd {
65     my($self, @ymd) = @_;
66
67     if ($ymd[0] <= END_OF_LUNAR) {
68         Carp::carp("In $ymd[0] they didn't use gregorious date.");
69     }
70
71     require Date::Calc;         # not 'use'
72     *Delta_Days = \&Date::Calc::Delta_Days;
73
74     # XXX can be more efficient
75     for my $era (keys %ERA_TABLE) {
76         my $data = $ERA_TABLE{$era};
77         if (Delta_Days(@{$data}[1..3], @ymd) >= 0 &&
78             Delta_Days(@ymd, @{$data}[4..6]) >= 0) {
79             $self->{name} = $era;
80             $self->{year} = $ymd[0] - $data->[1] + 1;
81             $self->{gregorian_year} = $ymd[0];
82             return;
83         }
84     }
85
86     croak "Unsupported date: ", join('-', @ymd);
87 }
88
89 sub _from_era {
90     my($self, $era, $year) = @_;
91     if ($era =~ /^\w+$/) {
92         $era = $self->_ascii2ja($era);
93     }
94     elsif ($Have_Jcode) {
95         $era = Jcode->new($era, $self->codeset)->euc;
96     }
97
98     unless (exists $ERA_TABLE{$era}) {
99         croak "Unknown era name: $era";
100     }
101     my $data = $ERA_TABLE{$era};
102     my $g_year = $data->[1] + $year - 1;
103     if ($g_year > $data->[4]) {
104         croak "Invalid combination of era and year: $era-$year";
105     }
106
107     $self->{name} = $era;
108     $self->{year} = $year;
109     $self->{gregorian_year} = $g_year;
110 }
111
112 sub _ascii2ja {
113     my($self, $ascii) = @_;
114     return $ERA_ASCII2JA{$ascii} || croak "Unknown era name: $ascii";
115 }
116
117 sub _ja2ascii {
118     my($self, $ja) = @_;
119     return $ERA_JA2ASCII{$ja} || croak "Unknown era name: $ja";
120 }
121
122 sub name {
123     my $self = shift;
124     if ($Have_Jcode) {
125         my $encoding = $self->codeset;
126         return Jcode->new($self->{name}, 'euc')->$encoding();
127     }
128     return $self->{name};
129 }
130
131 *gengou = \&name;
132
133 sub name_ascii {
134     my $self = shift;
135     return $self->_ja2ascii($self->name);
136 }
137
138 sub year {
139     my $self = shift;
140     return $self->{year};
141 }
142
143 sub gregorian_year {
144     my $self = shift;
145     return $self->{gregorian_year};
146 }
147
148 1;
149 __END__
150
151 =head1 NAME
152
153 Date::Japanese::Era - Conversion between Japanese Era / Gregorian calendar
154
155 =head1 SYNOPSIS
156
157   use Date::Japanese::Era;
158
159   # from Gregorian (month + day required)
160   $era = Date::Japanese::Era->new(1970, 1, 1);
161
162   # from Japanese Era
163   $era = Date::Japanese::Era->new('ŸŒÏÂ', 52);
164
165   $name      = $era->name;         # 'ŸŒÏÂ' in EUC-jp (default)
166   $gengou    = $era->gengou;       # same
167
168   $year      = $era->year;         # 52
169   $gregorian = $era->gregorian_year;       # 1977
170
171   # use JIS X0301 table for conversion
172   use Date::Japanese::Era 'JIS_X0301';
173
174
175 =head1 DESCRIPTION
176
177 Date::Japanese::Era handles conversion between Japanese Era and
178 Gregorian calendar.
179
180 =head1 METHODS
181
182 =over 4
183
184 =item codeset
185
186   $codeset = Date::Japanese::Era->codeset;
187   Date::Japanese::Era->codeset($encoding);
188
189 sets / gets external encoding of Japanese era names. For example with
190 the following code, input and output of era names are encoded in UTF-8.
191
192   Date::Japanese::Era->codeset('utf8');
193   $era = Date::Japanese::Era->new($name, $year); # $name is UTF-8
194   print $era->name;                              # also UTF-8
195
196 You need Jcode module installed to make use of this
197 feature. Otherwise, calls to codeset() are simply ignored (with
198 warning).
199
200 =item new
201
202   $era = Date::Japanese::Era->new($year, $month, $day);
203   $era = Date::Japanese::Era->new($era_name, $year);
204
205 Constructs new Date::Japanese::Era instance. When constructed from
206 Gregorian date, month and day is required. You need Date::Calc to
207 construct from Gregorian.
208
209 Name of era can be either of Japanese / ASCII. Input encodings can be
210 specified via codeset(), suppose you have Jcode module
211 installed. Default is EUC-JP.
212
213 Exceptions are thrown when inputs are invalid (e.g: non-existent
214 era name and year combination, unknwon era-name, etc.).
215
216 =item name
217
218   $name = $era->name;
219
220 returns era name in Japanese. Encoding can be specified via codeset()
221 class method. Default is EUC-JP.
222
223 =item gengou
224
225 alias for name().
226
227 =item name_ascii
228
229   $name_ascii = $era->name_ascii;
230
231 returns era name in US-ASCII.
232
233 =item year
234
235   $year = $era->year;
236
237 returns year as Japanese era.
238
239 =item gregorian_year
240
241   $year = $era->gregorian_year;
242
243 returns year as Gregorian.
244
245 =back
246
247 =head1 EXAMPLES
248
249   use Date::Japanese::Era;
250
251   # 2001 is H-13
252   my $era = Date::Japanese::Era->new(2001, 8, 31);
253   printf "%s-%s", uc(substr($era->name_ascii, 0, 1)), $era->year;
254
255   # to Gregorian
256   my $era = Date::Japanese::Era->new('Ê¿À®', 13);
257   print $era->gregorian_year;   # 2001
258
259 =head1 CAVEATS
260
261 =over 4
262
263 =item *
264
265 Currently supported era is up to 'meiji'. And before Meiji 05.12.02,
266 gregorius calendar was not used there, but lunar calendar was. This
267 module does not support lunar calendar, but gives warnings in such
268 cases ("In %d they didn't use gregorius calendar").
269
270 =item *
271
272 There should be discussion how we handle the exact day the era has
273 changed (former one or latter one?). This module default handles the
274 day as newer one, but you can change so that it sticks to JIS table
275 (older one) by saying:
276
277   use Date::Japanese::Era 'JIS_X0301';
278
279 For example, 1912-07-30 is handled as:
280
281   default       Taishou 1 07-30
282   JIS_X0301     Meiji 45 07-30
283
284 =item *
285
286 If someday current era (heisei) is changed, Date::Japanese::Era::Table
287 should be upgraded.
288
289 =back
290
291 =head1 TODO
292
293 =over 4
294
295 =item *
296
297 Date parameters can be in various format. I should replace
298 Date::Simple or whatever for that.
299
300 =item *
301
302 Support earlier eras and lunar calendar.
303
304 =back
305
306 =head1 AUTHOR
307
308 Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
309
310 This library is free software; you can redistribute it and/or
311 modify it under the same terms as Perl itself.
312
313 =head1 SEE ALSO
314
315 L<Date::Calc>, L<Jcode>, L<Date::Simple>
316
317 =cut
Note: See TracBrowser for help on using the browser.