home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / Date / Language.pm < prev    next >
Text File  |  1997-01-02  |  6KB  |  243 lines
  1.  
  2. package Date::Language;
  3.  
  4. use     strict;
  5. use     Time::Local;
  6. use     Carp;
  7. use     vars qw($VERSION @ISA);
  8. require Date::Format;
  9.  
  10. $VERSION = do { my @r=(q$Revision: 1.5 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
  11. @ISA     = qw(Date::Format::Generic);
  12.  
  13. sub new
  14. {
  15.  my $self = shift;
  16.  my $type = shift || $self;
  17.  
  18.  $type = "Date::Language::" . $type
  19.     unless $type =~ /::/o;
  20.  
  21.  bless [], $type;
  22. }
  23.  
  24. # Stop AUTOLOAD being called ;-)
  25. sub DESTROY {}
  26.  
  27. sub AUTOLOAD
  28. {
  29.  use vars qw($AUTOLOAD);
  30.  
  31.  if($AUTOLOAD =~ /::strptime\Z/o)
  32.   {
  33.    my $self = $_[0];
  34.    my $type = ref($self) || $self;
  35.    require Date::Parse;
  36.  
  37.    no strict 'refs';
  38.    *{"${type}::strptime"} = Date::Parse::gen_parser(
  39.     \%{"${type}::DoW"},
  40.     \%{"${type}::MoY"},
  41.     \@{"${type}::Dsuf"},
  42.     1);
  43.  
  44.    goto &{"${type}::strptime"};
  45.   }
  46.  
  47.  croak "Undefined method &$AUTOLOAD called";
  48. }
  49.  
  50. sub str2time
  51. {
  52.  my $me = shift;
  53.  my @t = $me->strptime(@_);
  54.  
  55.  return undef
  56.     unless @t;
  57.  
  58.  my($ss,$mm,$hh,$day,$month,$year,$zone) = @t;
  59.  my @lt  = localtime(time);
  60.  
  61.  $hh    ||= 0;
  62.  $mm    ||= 0;
  63.  $ss    ||= 0;
  64.  
  65.  $month = $lt[4]
  66.     unless(defined $month);
  67.  
  68.  $day  = $lt[3]
  69.     unless(defined $day);
  70.  
  71.  $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5]
  72.     unless(defined $year);
  73.  
  74.  return defined $zone ? timegm($ss,$mm,$hh,$day,$month,$year) - $zone
  75.                       : timelocal($ss,$mm,$hh,$day,$month,$year);
  76. }
  77.  
  78.  
  79. ##
  80. ## English tables
  81. ##
  82.  
  83. package Date::Language::English;
  84.  
  85. use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW);
  86. @ISA = qw(Date::Language);
  87.  
  88. @DoW = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
  89. @MoY = qw(January February March April May June
  90.       July August September October November December);
  91. @DoWs = map { substr($_,0,3) } @DoW;
  92. @MoYs = map { substr($_,0,3) } @MoY;
  93. @AMPM = qw(AM PM);
  94.  
  95. @Dsuf = (qw(th st nd rd th th th th th th)) x 3;
  96. @Dsuf[11,12,13] = qw(th th th);
  97. @Dsuf[30,31] = qw(th st);
  98.  
  99. @MoY{@MoY}  = (0 .. scalar(@MoY));
  100. @MoY{@MoYs} = (0 .. scalar(@MoYs));
  101. @DoW{@DoW}  = (0 .. scalar(@DoW));
  102. @DoW{@DoWs} = (0 .. scalar(@DoWs));
  103.  
  104. # Formatting routines
  105.  
  106. sub format_a { $DoWs[$_[0]->[6]] }
  107. sub format_A { $DoW[$_[0]->[6]] }
  108. sub format_b { $MoYs[$_[0]->[4]] }
  109. sub format_B { $MoY[$_[0]->[4]] }
  110. sub format_h { $MoYs[$_[0]->[4]] }
  111. sub format_p { $_[0]->[2] >= 12 ?  $AMPM[1] : $AMPM[0] }
  112.  
  113. ##
  114. ## German tables
  115. ##
  116.  
  117. package Date::Language::German;
  118.  
  119. use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW);
  120. @ISA = qw(Date::Language);
  121.  
  122. @MoY  = qw(Januar Februar MΣrz April Mai Juni
  123.        Juli August September Oktober November Dezember);
  124. @MoYs = qw(Jan Feb MΣr Apr Mai Jun Jul Aug Sep Oct Nov Dez);
  125. @DoW  = qw(Sonntag Montag Dienstag Mittwoch Donnerstag Freitag Samstag);
  126. @DoWs = qw(Son Mon Die Mit Don Fre Sam);
  127.  
  128. @AMPM =   @{Date::Language::English::AMPM};
  129. @Dsuf =   @{Date::Language::English::Dsuf};
  130.  
  131. @MoY{@MoY}  = (0 .. scalar(@MoY));
  132. @MoY{@MoYs} = (0 .. scalar(@MoYs));
  133. @DoW{@DoW}  = (0 .. scalar(@DoW));
  134. @DoW{@DoWs} = (0 .. scalar(@DoWs));
  135.  
  136. # Formatting routines
  137.  
  138. sub format_a { $DoWs[$_[0]->[6]] }
  139. sub format_A { $DoW[$_[0]->[6]] }
  140. sub format_b { $MoYs[$_[0]->[4]] }
  141. sub format_B { $MoY[$_[0]->[4]] }
  142. sub format_h { $MoYs[$_[0]->[4]] }
  143. sub format_p { $_[0]->[2] >= 12 ?  $AMPM[1] : $AMPM[0] }
  144.  
  145. ##
  146. ## Norwegian tables
  147. ##
  148.  
  149. package Date::Language::Norwegian;
  150.  
  151. use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW);
  152. @ISA = qw(Date::Language);
  153.  
  154. @MoY  = qw(Januar Februar Mars April Mai Juni
  155.        Juli August September Oktober November Desember);
  156. @MoYs = qw(Jan Feb Mar Apr Mai Jun Jul Aug Sep Okt Nov Des);
  157. @DoW  = qw(S°ndag Mandag Tirsdag Onsdag Torsdag Fredag L°rdag S°ndag);
  158. @DoWs = qw(S°n Man Tir Ons Tor Fre L°r S°n);
  159.  
  160. @AMPM =   @{Date::Language::English::AMPM};
  161. @Dsuf =   @{Date::Language::English::Dsuf};
  162.  
  163. @MoY{@MoY}  = (0 .. scalar(@MoY));
  164. @MoY{@MoYs} = (0 .. scalar(@MoYs));
  165. @DoW{@DoW}  = (0 .. scalar(@DoW));
  166. @DoW{@DoWs} = (0 .. scalar(@DoWs));
  167.  
  168. # Formatting routines
  169.  
  170. sub format_a { $DoWs[$_[0]->[6]] }
  171. sub format_A { $DoW[$_[0]->[6]] }
  172. sub format_b { $MoYs[$_[0]->[4]] }
  173. sub format_B { $MoY[$_[0]->[4]] }
  174. sub format_h { $MoYs[$_[0]->[4]] }
  175. sub format_p { $_[0]->[2] >= 12 ?  $AMPM[1] : $AMPM[0] }
  176.  
  177. ##
  178. ## Italian tables
  179. ##
  180.  
  181. package Date::Language::Italian;
  182.  
  183. use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW);
  184. @ISA = qw(Date::Language);
  185.  
  186. @MoY  = qw(Gennaio Febbraio Marzo Aprile Maggio Giugno
  187.        Luglio Agosto Settembre Ottobre Novembre Dicembre);
  188. @MoYs = qw(Gen Feb Mar Apr Mag Giu Lug Ago Set Ott Nov Dic);
  189. @DoW  = qw(Domenica Lunedi Martedi Mercoledi Giovedi Venerdi Sabato);
  190. @DoWs = qw(Dom Lun Mar Mer Gio Ven Sab);
  191.  
  192. @AMPM =   @{Date::Language::English::AMPM};
  193. @Dsuf =   @{Date::Language::English::Dsuf};
  194.  
  195. @MoY{@MoY}  = (0 .. scalar(@MoY));
  196. @MoY{@MoYs} = (0 .. scalar(@MoYs));
  197. @DoW{@DoW}  = (0 .. scalar(@DoW));
  198. @DoW{@DoWs} = (0 .. scalar(@DoWs));
  199.  
  200. # Formatting routines
  201.  
  202. sub format_a { $DoWs[$_[0]->[6]] }
  203. sub format_A { $DoW[$_[0]->[6]] }
  204. sub format_b { $MoYs[$_[0]->[4]] }
  205. sub format_B { $MoY[$_[0]->[4]] }
  206. sub format_h { $MoYs[$_[0]->[4]] }
  207. sub format_p { $_[0]->[2] >= 12 ?  $AMPM[1] : $AMPM[0] }
  208.  
  209. ##
  210. ## Austrian tables
  211. ##
  212.  
  213. package Date::Language::Austrian;
  214.  
  215. use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW);
  216. @ISA = qw(Date::Language);
  217.  
  218. @MoY  = qw(JΣnner Feber MΣrz April Mai Juni
  219.        Juli August September Oktober November Dezember);
  220. @MoYs = qw(JΣn Feb MΣr Apr Mai Jun Jul Aug Sep Oct Nov Dez);
  221. @DoW  = qw(Sonntag Montag Dienstag Mittwoch Donnerstag Freitag Samstag);
  222. @DoWs = qw(Son Mon Die Mit Don Fre Sam);
  223.  
  224. @AMPM = @{Date::Language::English::AMPM};
  225. @Dsuf = @{Date::Language::English::Dsuf};
  226.  
  227. @MoY{@MoY}  = (0 .. scalar(@MoY));
  228. @MoY{@MoYs} = (0 .. scalar(@MoYs));
  229. @DoW{@DoW}  = (0 .. scalar(@DoW));
  230. @DoW{@DoWs} = (0 .. scalar(@DoWs));
  231.  
  232. # Formatting routines
  233.  
  234. sub format_a { $DoWs[$_[0]->[6]] }
  235. sub format_A { $DoW[$_[0]->[6]] }
  236. sub format_b { $MoYs[$_[0]->[4]] }
  237. sub format_B { $MoY[$_[0]->[4]] }
  238. sub format_h { $MoYs[$_[0]->[4]] }
  239. sub format_p { $_[0]->[2] >= 12 ?  $AMPM[1] : $AMPM[0] }
  240.  
  241. 1;
  242.  
  243.