# Timing.pm: Class Used for Managing Time Based Operations

package RDA::Object::Timing;

# $Id: Timing.pm,v 1.24 2015/11/13 15:51:30 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Object/Timing.pm,v 1.24 2015/11/13 15:51:30 RDA Exp $
#
# Change History
# 20151113  MSC  Add the resume and suspend methods.

=head1 NAME

RDA::Object::Timing - Class Used for Managing Time Based Operations

=head1 SYNOPSIS

 require RDA::Object::Timing;

=head1 DESCRIPTION

The objects of the C<RDA::Object::Timing> class are used to manage time based
operations. It is a subclass of L<RDA::Object|RDA::Object>.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use Time::Local qw(timegm timelocal);
  use RDA::Text qw(debug get_string);
  use RDA::Object;
}

# Define the global public variables
use vars qw($DUMP $STRINGS $VERSION @DUMP @EXPORT_OK @ISA %SDCL
            @TB_MON %TB_MER %TB_MON %TB_ZON);
$DUMP      = 0;
$VERSION   = sprintf('%d.%02d', q$Revision: 1.24 $ =~ /(\d+)\.(\d+)/);
@DUMP      = (
  str => {_bkp => 0},
  );
@EXPORT_OK = qw(@TB_MON %TB_MER %TB_MON %TB_ZON);
@ISA       = qw(RDA::Object Exporter);
%SDCL      = (
  als => {
    ## no critic (Interpolation)
    'clearTiming'      => ['$[TIM]', 'clear_timing'],
    'getBeginTime'     => ['$[TIM]', 'get_text', 'beg'],
    'getEndTime'       => ['$[TIM]', 'get_text', 'end'],
    'getMonth'         => ['$[TIM]', 'get_month'],
    'getReferenceTime' => ['$[TIM]', 'get_text', 'ref'],
    'hasPeriod'        => ['$[TIM]', 'has_period'],
    'hasReference'     => ['$[TIM]', 'has_reference'],
    'resumeTiming'     => ['$[TIM]', 'resume'],
    'setInterval'      => ['$[TIM]', 'set_interval'],
    'setPeriod'        => ['$[TIM]', 'set_period'],
    'setReference'     => ['$[TIM]', 'set_reference'],
    'suspendTiming'    => ['$[TIM]', 'suspend'],
    },
  beg => \&_begin_control,
  end => \&_end_control,
  inc => [qw(RDA::Object)],
  flg => 1,
  met => {
    'check_adr'       => {ret => 0},
    'check_db'        => {ret => 0},
    'check_local'     => {ret => 0},
    'check_odl'       => {ret => 0},
    'check_time'      => {ret => 0},
    'check_wls'       => {ret => 0},
    'clear_period'    => {ret => 0},
    'clear_reference' => {ret => 0},
    'clear_timing'    => {ret => 0},
    'compare_adr'     => {ret => 0},
    'compare_db'      => {ret => 0},
    'compare_local'   => {ret => 0},
    'compare_odl'     => {ret => 0},
    'compare_time'    => {ret => 0},
    'compare_wls'     => {ret => 0},
    'convert_adr'     => {ret => 0},
    'convert_db'      => {ret => 0},
    'convert_local'   => {ret => 0},
    'convert_odl'     => {ret => 0},
    'convert_time'    => {ret => 0},
    'convert_wls'     => {ret => 0},
    'from_adr'        => {ret => 1},
    'from_db'         => {ret => 1},
    'from_local'      => {ret => 1},
    'from_odl'        => {ret => 1},
    'from_time'       => {ret => 1},
    'from_wls'        => {ret => 1},
    'get_month'       => {ret => 0},
    'get_text'        => {ret => 0},
    'get_time'        => {ret => 0},
    'has_period'      => {ret => 0},
    'has_reference'   => {ret => 0},
    'resume'          => {ret => 0},
    'set_interval'    => {ret => 0},
    'set_period'      => {ret => 0},
    'set_reference'   => {ret => 0},
    'set_zone'        => {ret => 0},
    'suspend'         => {ret => 0},
    },
  top => 'TIM',
  );

# Define the global private constants
my $A = q{[A-Z]{3}};
my $C = q{[-+][0-1]\d:?[0-5]\d};
my $D = q{\d\d};
my $N = q{\d\d?};
my $Y = q{\d{4}};
my $Z = q{[A-Z]{1,5}};

my $COR = qr{^([-+])([0-1]\d):?($D)$};
my $ODL = qr{^($Y-$D-${D}T$D:$D:$D)(?:\.\d*)?($C)$};
my $TIM = qr{^(\d{7,})$};
my $WMS = qr{^(\d{7,})\d{3}$};

my $FMT = q{%04d-%02d-%02dT%02d:%02d:%02d};

# Define the global private variables
my @tb_day = (
  31, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31,
  31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31,
  );

# Define the delta units
my %tb_dlt = (
  d => q{:00:00:00},
  h => q{:00:00},
  m => q{:00},
  s => q{},
  );

# Define the meridian indicators (en,zh)
%TB_MER = (
  (map {$_ =>  0} 'am',
                  "\311\317\316\347",           # zh:GB2312/GBK - C9CF CEE7
                  "\344\270\212\345\215\210"),  # zh:UTF-8 CJK  - 4E0A 5348
  (map {$_ => 12} 'pm',
                  "\317\302\316\347",           # zh:GB2312/GBK - CFC2 CEE7
                  "\344\270\213\345\215\210"),  # zh:UTF-8 CJK  - 4E0B 5348
  );

# Define the month definitions (de,en,es,fr,it,nl,pt,zh)
@TB_MON = qw(- Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
%TB_MON = (
  (map {$_ =>  1}
       'jan', 'ene', 'gen', 'janv.',
       "\116\000\147\010",                     # zh:GB2312/GBK - 4E00 6708
       "\344\270\200\346\234\210",             # zh:UTF-8 CJK  - D2BB D4C2
  ),
  (map {$_ =>  2}
       'feb', 'fev',
       "f\351vr.",                             # fr:ISO 8859-P1
       "f\303\251vr.",                         # fr:UTF-8
       "\116\214\147\010",                     # zh:GB2312/GBK - 4E8C 6708
       "\344\272\214\346\234\210",             # zh:UTF-8 CJK  - B6FE D4C2
  ),
  (map {$_ =>  3}
       'mar', 'mars', 'mrt', 'mrz',
       "\116\011\147\010",                     # zh:GB2312/GBK - 4E09 6708
       "\344\270\211\346\234\210",             # zh:UTF-8 CJK  - C8FD D4C2
  ),
  (map {$_ =>  4}
       'apr', 'abr', 'avr.',
       "\126\333\147\010",                     # zh:GB2312/GBK - 56DB 6708
       "\345\233\233\346\234\210",             # zh:UTF-8 CJK  - CBC4 D4C2
  ),
  (map {$_ =>  5}
       'may', 'mag', 'mai', 'mei',
       "\116\224\147\010",                     # zh:GB2312/GBK - 4E94 6708
       "\344\272\224\346\234\210",             # zh:UTF-8 CJK  - CEE5 D4C2
  ),
  (map {$_ =>  6}
       'jun', 'giu', 'juin',
       "\121\155\147\010",                     # zh:GB2312/GBK - 516D 6708
       "\345\205\255\346\234\210",             # zh:UTF-8 CJK  - C1F9 D4C2
  ),
  (map {$_ =>  7}
       'jul', 'juil.', 'lug',
       "\116\003\147\010",                     # zh:GB2312/GBK - 4E03 6708
       "\344\270\203\346\234\210",             # zh:UTF-8 CJK  - C6DF D4C2
  ),
  (map {$_ =>  8}
       'aug', 'ago',
       "ao\373t",                              # fr:ISO 8859-P1
       "ao\303\271t",                          # fr:UTF-8
       "\121\153\147\010",                     # zh:GB2312/GBK - 516B 6708
       "\345\205\253\346\234\210",             # zh:UTF-8 CJK  - B0CB D4C2
  ),
  (map {$_ =>  9}
       'sep', 'sept.', 'set',
       "\116\135\147\010",                     # zh:GB2312/GBK - 4E5D 6708
       "\344\271\235\346\234\210",             # zh:UTF-8 CJK  - BEC5 D4C2
  ),
  (map {$_ => 10}
       'oct', 'oct.', 'okt', 'ott', 'out',
       "\123\101\147\010",                     # zh:GB2312/GBK - 5341 6708
       "\345\215\201\346\234\210",             # zh:UTF-8 CJK  - CAAE D4C2
  ),
  (map {$_ => 11}
       'nov', 'nov.',
       "\123\101\116\000\147\010",             # zh:GB2312/GBK - 5341 4E00 6708
       "\345\215\201\344\270\200\346\234\210", # zh:UTF-8 CJK  - CAAE D2BB D4C2
  ),
  (map {$_ => 12} 'dec', 'dez', 'dic',
       "d\351c.",                              # fr:ISO 8859-P1
       "d\303\251c.",                          # fr:UTF-8
       "\123\101\116\214\147\010",             # zh:GB2312/GBK - 5341 4E8C 6708
       "\345\215\201\344\272\214\346\234\210", # zh:UTF-8 CJK  - CAAE B6FE D4C2
  ),
  );

# Zone definitions (ambiguities resolved by picking first entry)
%TB_ZON = (
  A     =>  '+01:00',  # Alpha Zone
  ACDT  =>  '+10:30',  # Australian Central Daylight Time
  ACST  =>  '+09:30',  # Australian Central Standard Time
  ACT   => ['-05:00',  # Acre Time (Brazil)
            '+08:00'], # ASEAN Common Time
  ACWT  =>  '+08:45',  # Australian Central Western Time
  ADT   => ['-03:00',  # Atlantic Daylight Time (Caribbean, North America)
            '+03:00'], # Arabia Daylight Time
  AEDT  =>  '+11:00',  # Australian Eastern Daylight Time
  AEST  =>  '+10:00',  # Australian Eastern Standard Time
  AFT   =>  '+04:30',  # Afghanistan Time
  AKDT  =>  '-08:00',  # Alaska Daylight Time
  AKST  =>  '-09:00',  # Alaska Standard Time
  ALMT  =>  '+06:00',  # Alma-Ata Time
  AMST  => ['+05:00',  # Armenia Summer Time
            '-03:00'], # Amazon Summer Time
  AMT   => ['+04:00',  # Armenia Time
            '-04:00'], # Amazon Time
  ANAST =>  '+12:00',  # Anadyr Summer Time (Russia)
  ANAT  =>  '+12:00',  # Anadyr Time (Russia)
  AQTT  =>  '+05:00',  # Aqtobe Time (Kazakhstan)
  ART   =>  '-03:00',  # Argentina Time
  AST   => ['-04:00',  # Atlantic Standard Time (Caribbean, North America)
            '+03:00'], # Arabia Standard Time
  AWDT  =>  '+09:00',  # Australian Western Daylight Time
  AWST  =>  '+08:00',  # Australian Western Standard Time
  AZOST =>  '+00:00',  # Azores Summer Time
  AZOT  =>  '-01:00',  # Azores Time
  AZST  =>  '+05:00',  # Azerbaijan Summer Time
  AZT   =>  '+04:00',  # Azerbaijan Time
  B     =>  '+02:00',  # Bravo Zone
  BDT   =>  '+06:00',  # Bangladesh Time (Also See BST)
  BIOT  =>  '+06:00',  # British Indian Ocean Time
  BIT   =>  '-12:00',  # Baker Island Time
  BNT   =>  '+08:00',  # Brunei Time
  BOT   =>  '-04:00',  # Bolivia Time
  BRST  =>  '-02:00',  # Brasilia Summer Time
  BRT   =>  '-03:00',  # Brasilia Time
  BST   => ['+01:00',  # British Summer Time
            '+06:00',  # Bangladesh Standard Time (Also See BDT)
            '+11:00'], # Bougainville Standard Time
  BTT   =>  '+06:00',  # Bhutan Time
  C     =>  '+03:00',  # Charlie Zone
  CAST  =>  '+08:00',  # Casey Time (Antarctica)
  CAT   =>  '+02:00',  # Central Africa Time
  CCT   =>  '+06:30',  # Cocos Islands Time
  CDT   => ['-05:00',  # Central Daylight Time (North America & Caribbean)
            '+10:30',  # Central Daylight Time (Australia)
            '-04:00'], # Cuba Daylight Time
  CEDT  =>  '+02:00',  # Central European Daylight Time
  CEST  =>  '+02:00',  # Central European Summer Time
  CET   =>  '+01:00',  # Central European Time (Standard Time)
  CHADT =>  '+13:45',  # Chatham Island Daylight Time
  CHAST =>  '+12:45',  # Chatham Island Standard Time
  CHOST =>  '+09:00',  # Choibalsan Summer Time (Mongolia)
  CHOT  =>  '+08:00',  # Choibalsan Time (Mongolia)
  CHST  =>  '+10:00',  # Chamorro Standard Time
  CHUT  =>  '+10:00',  # Chuuk Time
  CIST  =>  '-08:00',  # Clipperton Island Standard Time
  CIT   =>  '+08:00',  # Central Indonesian Time
  CKT   =>  '-10:00',  # Cook Island Time
  CLST  =>  '-03:00',  # Chile Summer Time
  CLT   =>  '-04:00',  # Chile Standard Time
  COST  =>  '-04:00',  # Colombia Summer Time
  COT   =>  '-05:00',  # Colombia Time
  CST   => ['-06:00',  # Central Standard Time (North & Central America)
            '+08:00',  # China Standard Time
            '+09:30',  # Central Standard Time (Australia)
            '-05:00'], # Cuba Standard Time
  CT    =>  '+08:00',  # China time
  CVT   =>  '-01:00',  # Cape Verde Time
  CWST  =>  '+08:45',  # Central Western Australia Time (Eucla)
  CXT   =>  '+07:00',  # Christmas Island Time
  D     =>  '+04:00',  # Delta Zone
  DAVT  =>  '+07:00',  # Davis Time (Antarctica)
  DDUT  =>  '+10:00',  # Dumont D 'Urville Time
  DFT   =>  '+01:00',  # Equivalent of Central European Time
  E     =>  '+05:00',  # Echo Zone
  EASST =>  '-05:00',  # Eastern Island Summer Time
  EAST  =>  '-06:00',  # Eastern Island Standard Time
  EAT   =>  '+03:00',  # East Africa Time
  ECT   => ['-04:00',  # Eastern Caribbean Time
            '-05:00'], # Ecuador Time
  EDT   => ['-04:00',  # Eastern Daylight Time (North America And Caribbean)
            '+11:00'], # Eastern Daylight Time (Australia And Pacific)
  EEDT  =>  '+03:00',  # Eastern European Daylight Time
  EEST  =>  '+03:00',  # Eastern European Summer Time
  EET   =>  '+02:00',  # Eastern European Time
  EGST  =>  '+00:00',  # Eastern Greenland Summer Time
  EGT   =>  '-01:00',  # Eastern Greenland Time
  EIT   =>  '+09:00',  # Eastern Indonesian Time (See Wit)
  EST   => ['-05:00',  # Eastern Standard Time (North America And Caribbean)
            '+10:00'], # Eastern Standard Time (Australia And Pacific)
  F     =>  '+06:00',  # Foxtrot Zone
  FET   =>  '+03:00',  # Further-Eastern European Time
  FJST  =>  '+13:00',  # Fiji Summer Time
  FJT   =>  '+12:00',  # Fiji Time
  FKST  =>  '-03:00',  # Falkland Islands Summer Time
  FKT   =>  '-04:00',  # Falkland Islands Time
  FNT   =>  '-02:00',  # Fernando De Noronha Time
  G     =>  '+07:00',  # Golf Zone
  GALT  =>  '-06:00',  # Galapagos Time
  GAMT  =>  '-09:00',  # Gambier Time
  GET   =>  '+04:00',  # Georgia Standard Time
  GFT   =>  '-03:00',  # French Guiana Time
  GILT  =>  '+12:00',  # Gilbert Island Time
  GIT   =>  '-09:00',  # Gambier Island Time
  GMT   =>  '+00:00',  # Greenwich Mean Time
  GST   => ['+04:00',  # Gulf Standard Time
            '-02:00'], # South Georgia Time (And South Sandwich Islands)
  GYT   =>  '-04:00',  # Guyana Time
  H     =>  '+08:00',  # Hotel Zone
  HADT  =>  '-09:00',  # Hawaii-Aleutian Daylight Time
  HAEC  =>  '+02:00',  # Heure Avancee d'Europe Centrale
  HAST  =>  '-10:00',  # Hawaii-Aleutian Standard Time
  HKT   =>  '+08:00',  # Hong Kong Time
  HOVST =>  '+08:00',  # Hovd Summer Time (Mongolia)
  HOVT  =>  '+07:00',  # Hovd Time (Mongolia)
  HST   =>  '-10:00',  # Hawaii Standard Time
  I     =>  '+09:00',  # India Zone
  ICT   =>  '+07:00',  # Indochina Time
  IDT   =>  '+03:00',  # Israel Daylight Time
  IOT   =>  '+06:00',  # Indian Chagos Time (British Indian Ocean Territory)
  IRDT  =>  '+04:30',  # Iran Daylight Time
  IRKST =>  '+09:00',  # Irkutsk Summer Time
  IRKT  =>  '+08:00',  # Irkutsk Time
  IRST  =>  '+03:30',  # Iran Standard Time
  IST   => ['+05:30',  # Indian Standard Time
            '+01:00',  # Irish Summer Time
            '+02:00'], # Israel Standard Time
  JST   =>  '+09:00',  # Japan Standard Time
  K     =>  '+10:00',  # Kilo Zone
  KGT   =>  '+06:00',  # Kyrgyzstan Time
  KOST  =>  '+11:00',  # Kosrae Time (Micronesia)
  KRAST =>  '+08:00',  # Krasnoyarsk Summer Time
  KRAT  =>  '+07:00',  # Krasnoyarsk Time
  KST   =>  '+09:00',  # Korea Standard Time
  KUYT  =>  '+04:00',  # Kuybyshev Time (Samara Time As of 1991)
  L     =>  '+11:00',  # Lima Zone
  LHDT  =>  '+11:00',  # Lord Howe Daylight Time
  LHST  =>  '+10:30',  # Lord Howe Standard Time
  LINT  =>  '+14:00',  # Line Islands Time
  M     =>  '+12:00',  # Mike Zone
  MAGST =>  '+12:00',  # Magadan Summer Time
  MAGT  =>  '+10:00',  # Magadan Time
  MART  =>  '-09:30',  # Marquesas Time
  MAWT  =>  '+05:00',  # Mawson Station Time (Antarctic)
  MDT   =>  '-06:00',  # Mountain Daylight Time (North America)
  MEST  => ['+02:00',  # Middle European Saving Time
            '-08:00'], # Metlakatla Time(Alaska Indian Community)
  MET   =>  '+01:00',  # Middle European Time
  MHT   =>  '+12:00',  # Marshall Islands Time
  MIST  =>  '+11:00',  # Macquarie Island Station Time
  MMT   =>  '+06:30',  # Myanmar Time
  MSD   =>  '+04:00',  # Moscow Summer Time
  MSK   =>  '+03:00',  # Moscow Standard Time
  MST   => ['-07:00',  # Mountain Standard Time (North America)
            '+06:30',  # Myanmar Standard Time
            '+08:00'], # Malaysia Standard Time
  MUT   =>  '+04:00',  # Mauritius Time
  MVT   =>  '+05:00',  # Maldives Time
  MYT   =>  '+08:00',  # Malaysia Time
  N     =>  '-01:00',  # November Zone
  NCT   =>  '+11:00',  # New Caledonia Time
  NDT   =>  '-02:30',  # Newfoundland Daylight Time
  NFT   =>  '+11:30',  # Norfolk Time
  NOVST =>  '+07:00',  # Novosibirsk Summer Time
  NOVT  =>  '+06:00',  # Novosibirsk Time
  NPT   =>  '+05:45',  # Nepal Time
  NRT   =>  '+12:00',  # Nauru Time
  NST   =>  '-03:30',  # Newfoundland Standard Time
  NT    =>  '-03:30',  # Newfoundland Time
  NUT   =>  '-11:00',  # Niue Time
  NZDT  =>  '+13:00',  # New Zealand Daylight Time
  NZST  =>  '+12:00',  # New Zealand Standard Time
  O     =>  '-02:00',  # Oscar Zone
  OMSST =>  '+07:00',  # Omsk Summer Time
  OMST  =>  '+06:00',  # Omsk Standard Time
  ORAT  =>  '+05:00',  # Oral Time
  P     =>  '-03:00',  # Papa Zone
  PDT   =>  '-07:00',  # Pacific Daylight Time (North America)
  PET   =>  '-05:00',  # Peru Time
  PETST =>  '+12:00',  # Kamchatka Summer Time
  PETT  =>  '+12:00',  # Kamchatka Time
  PGT   =>  '+10:00',  # Papua New Guinea Time
  PHOT  =>  '+13:00',  # Phoenix Island Time
  PHT   =>  '+08:00',  # Philippine Time
  PKT   =>  '+05:00',  # Pakistan Standard Time
  PMDT  =>  '-02:00',  # Pierre & Miquelon Daylight Time
  PMST  =>  '-03:00',  # Pierre & Miquelon Standard Time
  PONT  =>  '+11:00',  # Pohnpei Time (Formerly Ponape)
  PST   =>  '-08:00',  # Pacific Standard Time (North America) / Pitcairn Time
  PWT   =>  '+09:00',  # Palau Time
  PYST  =>  '-03:00',  # Paraguay Summer Time
  PYT   =>  '-04:00',  # Paraguay Time
  Q     =>  '-04:00',  # Quebec Zone
  QYZT  =>  '+06:00',  # Qyzylorda Time (Kazakhstan)
  R     =>  '-05:00',  # Romeo Zone
  RET   =>  '+04:00',  # Reunion Time
  ROTT  =>  '-03:00',  # Rothera (Research Station) Time (Antarctica)
  S     =>  '-06:00',  # Sierra Zone
  SAKST =>  '+12:00',  # Sakhalin Summer Time
  SAKT  =>  '+10:00',  # Sakhalin Time
  SAMT  =>  '+04:00',  # Samara Time
  SAST  =>  '+02:00',  # South Africa Standard Time
  SBT   =>  '+11:00',  # Solomon Islands Time
  SCT   =>  '+04:00',  # Seychelles Time
  SGT   =>  '+08:00',  # Singapore Time
  SLST  =>  '+05:30',  # Sri Lanka Time
  SLT   =>  '+05:30',  # Sri Lanka Time
  SRET  =>  '+11:00',  # Srednekolymsk Time
  SRT   =>  '-03:00',  # Suriname Time
  SST   => ['-11:00',  # Samoa Standard Time (American Samoa)
            '+08:00'], # Singapore Standard Time
  SYOT  =>  '+03:00',  # Syowa (Research Station) Time (Antarctica)
  T     =>  '-07:00',  # Tango Zone
  TAHT  =>  '-10:00',  # Tahiti Time
  TFT   =>  '+05:00',  # French Southern And Antarctic Territories Time
  TJT   =>  '+05:00',  # Tajikistan Time
  TKT   =>  '+13:00',  # Tokelau Time
  TLT   =>  '+09:00',  # East Timor Time (Timor-Leste Time)
  TMT   =>  '+05:00',  # Turkmenistan Time
  TOT   =>  '+13:00',  # Tonga Time
  TRUT  =>  '+10:00',  # Truk Time (Micronesia)
  TVT   =>  '+12:00',  # Tuvalu Time
  U     =>  '-08:00',  # Uniform Zone
  UCT   =>  '+00:00',  # Coordinated Universal Time
  ULAST =>  '+09:00',  # Ulaanbaatar Summer Time
  ULAT  =>  '+08:00',  # Ulaanbaatar Time
  UTC   =>  '+00:00',  # Coordinated Universal Time
  UYST  =>  '-02:00',  # Uruguay Summer Time
  UYT   =>  '-03:00',  # Uruguay Standard Time
  UZT   =>  '+05:00',  # Uzbekistan Time
  V     =>  '-09:00',  # Victor Zone
  VET   =>  '-04:30',  # Venezuelan Standard Time
  VLAST =>  '+11:00',  # Vladivostok Summer Time
  VLAT  =>  '+10:00',  # Vladivostok Time
  VOLT  =>  '+04:00',  # Volgograd Time
  VOST  =>  '+06:00',  # Vostok Station Time
  VUT   =>  '+11:00',  # Vanuatu Time
  W     =>  '-10:00',  # Whiskey Zone
  WAKT  =>  '+12:00',  # Wake Island Time
  WART  =>  '-04:00',  # West Argentina Time
  WAST  =>  '+02:00',  # West Africa Summer Time
  WAT   =>  '+01:00',  # West Africa Time
  WDT   =>  '+09:00',  # Western Daylight Time (Australia)
  WEDT  =>  '+01:00',  # Western European Daylight Time
  WEST  =>  '+01:00',  # Western European Summer Time
  WET   =>  '+00:00',  # Western European Time
  WFT   =>  '+12:00',  # Wallis And Futuna Time
  WGST  =>  '-02:00',  # Western Greenland Summer Time
  WGT   =>  '-03:00',  # Western Greenland Time
  WIB   =>  '+07:00',  # Western Indonesian Time
  WIT   =>  '+09:00',  # Eastern Indonesian Time
  WITA  =>  '+08:00',  # Central Indonesian Time
  WST   => ['+01:00',  # Western Sahara Summer Time
            '+08:00',  # Western Standard Time (Australia)
            '+13:00',  # Western Samoa Time (Standard Time)
            '+14:00'], # Western Samoa Time (Also for Daylight Saving Time)
  WT    =>  '+00:00',  # Western Sahara Standard Time
  X     =>  '-11:00',  # X-ray Zone
  Y     =>  '-12:00',  # Yankee Zone
  YAKST =>  '+10:00',  # Yakutsk Summer Time
  YAKT  =>  '+09:00',  # Yakutsk Time
  YAP   =>  '+10:00',  # Yap Time (Micronesia)
  YEKST =>  '+06:00',  # Yekaterinburg Summer Time
  YEKT  =>  '+05:00',  # Yekaterinburg Time
  Z     =>  '+00:00',  # Zulu Zone
  );

# Report the package version
sub Version
{ return $VERSION;
}

=head2 S<$h = RDA::Object::Timing-E<gt>new>

The timing control object constructor.

It is represented by a blessed hash reference. The following special keys are
used:

=over 12

=item S<    B<'beg' > > Begin time hash

=item S<    B<'end' > > End time hash

=item S<    B<'oid' > > Object identifier

=item S<    B<'ref' > > Reference time hash

=item S<    B<'_bkp'> > Backup information for suspend/resume

=item S<    B<'_chk'> > Check disable indicator

=item S<    B<'_cmp'> > Compare disable indicator

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($cls) = @_;

  # Set the time zone
  eval {
    require POSIX;
    POSIX::tzset();  ## no critic (Call)
    };

  # Create the control object and return its reference
  return bless {
    oid  => 'TIM',
    _chk => 1,
    _cmp => 1,
  }, ref($cls) || $cls;
}

=head2 S<$h-E<gt>resume>

This method restores the original timing definitions. It returns the object
reference.

=cut

sub resume
{ my ($slf) = @_;
  my ($bkp);

  die get_string('NO_BACKUP') unless exists($slf->{'_bkp'});
  return _switch($slf, {}, $slf->{'_bkp'});
}

sub _switch
{ my ($slf, $bkp, $rec) = @_;

  foreach my $key (keys(%{$rec}))
  { $slf->{$key} = $bkp->{$key} if exists($bkp->{$key});
    if (defined($rec->{$key}))
    { ($slf->{$key}, $bkp->{$key}) = ($rec->{$key}, $slf->{$key});
    }
    else
    { $bkp->{$key} = delete($slf->{$key});
    }
  }
  return $slf;
}

=head2 S<$h-E<gt>suspend([$flg])>

This method suspends the timing definitions. When the flag is set, it clears
any previous definition. It returns the object reference.

=cut

sub suspend
{ my ($slf, $flg) = @_;
  my ($bkp);

  $bkp = {};
  return _switch($slf, $bkp, $flg
    ? { beg  => undef,
        end  => undef,
        ref  => undef,
        _bkp => $bkp,
        _chk => 1,
        _cmp => 1,
      }
    : { beg  => exists($slf->{'beg'}) ? {%{$slf->{'beg'}}} : undef,
        end  => exists($slf->{'end'}) ? {%{$slf->{'end'}}} : undef,
        ref  => exists($slf->{'ref'}) ? {%{$slf->{'ref'}}} : undef,
        _bkp => $bkp,
        _chk => $slf->{'_chk'},
        _cmp => $slf->{'_cmp'},
      });
}

=head1 CONVERSION METHODS

=head2 S<$h-E<gt>convert_adr($str)>

This method converts an ADR time stamp in a standard time stamp. It returns
an undefined value when it cannot decode the original time stamp.

=cut

sub convert_adr
{ my ($slf, $str) = @_;
  my ($cor, $tim);

  ($tim, $cor) = _convert_adr($str);
  return unless defined($cor);
  return ($tim, $cor) if wantarray;
  return $tim.$cor;
}
*from_adr = \&convert_adr;

=head2 S<$h-E<gt>convert_db($str)>

This method converts a database time stamp in a standard time stamp. It
returns an undefined value when it cannot decode the original time stamp.

=cut

sub convert_db
{ my ($slf, $str, $flg) = @_;
  my ($cor, $tim);

  $tim = _convert_db($str);
  return $tim if $flg;
  ($tim, $cor) = _convert_epoch($tim);
  return ($tim, $cor) if wantarray;
  return $tim.$cor;
}
*from_db = \&convert_db;

=head2 S<$h-E<gt>convert_local($str)>

This method converts a local time stamp in a standard time stamp. It returns
an undefined value when it cannot decode the original time stamp.

=cut

sub convert_local
{ my ($slf, $str, $flg) = @_;
  my ($cor, $tim);

  $tim = _convert_loc($str);
  return $tim if $flg;
  ($tim, $cor) = _convert_epoch($tim);
  return ($tim, $cor) if wantarray;
  return $tim.$cor;
}
*from_local = \&convert_local;

=head2 S<$h-E<gt>convert_odl($str)>

This method converts a ODL time stamp in a standard time stamp. It returns
an undefined value when it cannot decode the original time stamp.

=cut

sub convert_odl
{ my ($slf, $str) = @_;

  return unless defined($str) && $str =~ $ODL;
  return ($1, $2) if wantarray;
  return $1.$2;
}
*from_odl = \&convert_odl;

=head2 S<$h-E<gt>convert_time($str)>

This method converts the number of non-leap seconds since whatever time the
system considers to be the epoch in a standard time stamp. It returns an
undefined value for an invalid time.

=cut

sub convert_time
{ my ($slf, $val) = @_;
  my ($cor, $tim);

  return unless defined($val) && $val =~ $TIM;
  ($tim, $cor) = _convert_epoch($val);
  return ($tim, $cor) if wantarray;
  return $tim.$cor;
}
*from_time = \&convert_time;

=head2 S<$h-E<gt>convert_wls($str)>

This method converts a WLS time stamp in a standard time stamp. It returns
an undefined value when it cannot decode the original time stamp.

=cut

sub convert_wls
{ my ($slf, $str) = @_;
  my ($cor, $tim);

  ($tim, $cor) = _convert_wls($str);
  return unless defined($cor);
  return ($tim, $cor) if wantarray;
  return $tim.$cor;
}
*from_wls = \&convert_wls;

=head1 COMPARISON METHODS

=head2 S<$h-E<gt>check_adr($str[,$dft])>

This method indicates whether an ADR time stamp is within a time
interval. It returns the default value for invalid time stamps.

=cut

sub check_adr
{ my ($slf, $str, $dft) = @_;
  my ($cor, $tim);

  return 0 if $slf->{'_chk'};
  ($tim, $cor) = _convert_adr($str);
  return $dft unless defined($cor);
  debug("TIM> Convert $str to $tim$cor") if $DUMP;
  return ($tim lt _get_time($slf, 'beg', $cor)) ? -1 :
         ($tim gt _get_time($slf, 'end', $cor)) ?  1 :
                                                   0;
}

=head2 S<$h-E<gt>check_db($str[,$dft])>

This method indicates whether a database time stamp is within a time
interval. It returns the default value for invalid time stamps.

=cut

sub check_db
{ my ($slf, $str, $dft) = @_;
  my ($tim);

  return $slf->{'_chk'}                       ?  0 :
         (!defined($tim = _convert_db($str))) ? $dft :
         ($tim < _get_epoch($slf, 'beg'))     ? -1 :
         ($tim > _get_epoch($slf, 'end'))     ?  1 :
                                                 0;
}

=head2 S<$h-E<gt>check_local($str[,$dft])>

This method indicates whether a local time stamp is within a time
interval. It returns the default value for invalid time stamps.

=cut

sub check_local
{ my ($slf, $str, $dft) = @_;
  my ($tim);

  return $slf->{'_chk'}                        ?  0 :
         (!defined($tim = _convert_loc($str))) ? $dft :
         ($tim < _get_epoch($slf, 'beg'))      ? -1 :
         ($tim > _get_epoch($slf, 'end'))      ?  1 :
                                                  0;
}

=head2 S<$h-E<gt>check_odl($str[,$dft])>

This method indicates whether an ODL time stamp is within a time
interval. It returns the default value for invalid time stamps.

=cut

sub check_odl
{ my ($slf, $str, $dft) = @_;

  return $slf->{'_chk'}                     ?  0 :
         (!defined($str) || $str !~ $ODL)   ? $dft :
         ($1 lt _get_time($slf, 'beg', $2)) ? -1 :
         ($1 gt _get_time($slf, 'end', $2)) ?  1 :
                                               0;
}

=head2 S<$h-E<gt>check_time($str[,$dft])>

This method indicates whether the number of non-leap seconds since whatever
time the system considers to be the epoch is within a time interval. It returns
the default value for invalid times.

=cut

sub check_time
{ my ($slf, $val, $dft) = @_;

  return $slf->{'_chk'}                   ?  0 :
         (!defined($val) || $val !~ $TIM) ? $dft :
         ($1 < _get_epoch($slf, 'beg'))   ? -1 :
         ($1 > _get_epoch($slf, 'end'))   ?  1 :
                                             0;
}

=head2 S<$h-E<gt>check_wls($str[,$num[,$dft]])>

This method indicates whether a WLS time stamp is within a time
interval. It returns the default value for invalid time stamps.

=cut

sub check_wls
{ my ($slf, $str, $num, $dft) = @_;
  my ($cor, $tim);

  return 0 if $slf->{'_chk'};

  # Use the Epoch field
  return ($1 < _get_epoch($slf, 'beg')) ? -1 :
         ($1 > _get_epoch($slf, 'end')) ?  1 :
                                            0
    if defined($num) && $num =~ $WMS;

  # Use the time stamp field
  ($tim, $cor) = _convert_wls($str);
  return $dft unless defined($cor);
  debug("TIM> Convert $str to $tim$cor") if $DUMP;
  return ($tim lt _get_time($slf, 'beg', $cor)) ? -1 :
         ($tim gt _get_time($slf, 'end', $cor)) ?  1 :
                                                   0;
}

=head2 S<$h-E<gt>clear_period>

This method clears any previously defined period.

=cut

sub clear_period
{ return shift->{'_chk'} = 1;
}

=head2 S<$h-E<gt>clear_reference>

This method clears any previously defined reference time.

=cut

sub clear_reference
{ return shift->{'_cmp'} = 1;
}

=head2 S<$h-E<gt>clear_timing>

This method clears any previously defined period and reference time.

=cut

sub clear_timing
{ my ($slf) = @_;

  return $slf->{'_chk'} = $slf->{'_cmp'} = 1;
}

=head2 S<$h-E<gt>compare_adr($str[,$dft])>

This method compares an ADR time stamp with a reference time. It returns the
default value for invalid time stamps.

=cut

sub compare_adr
{ my ($slf, $str, $dft) = @_;
  my ($cor, $tim);

  return 0 if $slf->{'_cmp'};
  ($tim, $cor) = _convert_adr($str);
  return $dft unless defined($cor);
  debug("TIM> Convert $str to $tim$cor") if $DUMP;
  return $tim cmp _get_time($slf, 'ref', $cor);
}

=head2 S<$h-E<gt>compare_db($str[,$dft])>

This method compares a database time stamp with a reference time. It returns
the default value for invalid time stamps.

=cut

sub compare_db
{ my ($slf, $str, $dft) = @_;
  my ($tim);

  return
    $slf->{'_cmp'}                       ? 0 :
    (!defined($tim = _convert_db($str))) ? $dft :
                                           ($tim <=> _get_epoch($slf, 'ref'));
}

=head2 S<$h-E<gt>compare_local($str[,$dft])>

This method compares a local time stamp with a reference time. It returns
the default value for invalid time stamps.

=cut

sub compare_local
{ my ($slf, $str, $dft) = @_;
  my ($tim);

  return
    $slf->{'_cmp'}                        ? 0 :
    (!defined($tim = _convert_loc($str))) ? $dft :
                                            ($tim <=> _get_epoch($slf, 'ref'));
}

=head2 S<$h-E<gt>compare_odl($str[,$dft])>

This method compares an ODL time stamp with a reference time. It returns the
default value for invalid time stamps.

=cut

sub compare_odl
{ my ($slf, $tim, $dft) = @_;

  return
    $slf->{'_cmp'}                   ? 0 :
    (!defined($tim) || $tim !~ $ODL) ? $dft :
                                       ($1 cmp _get_time($slf, 'ref', $2));
}

=head2 S<$h-E<gt>compare_time($str[,$dft])>

This method compares whether the number of non-leap seconds since whatever
time the system considers to be the epoch corresponds to a reference time. It
returns the default value for invalid times.

=cut

sub compare_time
{ my ($slf, $val, $dft) = @_;

  return
    $slf->{'_cmp'}                   ? 0 :
    (!defined($val) || $val !~ $TIM) ? $dft :
                                       ($1 <=> _get_epoch($slf, 'ref'));
}

=head2 S<$h-E<gt>compare_wls($str[,$num[,$dft]])>

This method compares a WLS time stamp with a reference time. It returns the
default value for invalid time stamps.

=cut

sub compare_wls
{ my ($slf, $str, $num, $dft) = @_;
  my ($cor, $tim);

  return 0 if $slf->{'_cmp'};

  # Use the Epoch field
  return $1 <=> _get_epoch($slf, 'ref')
    if defined($num) && $num =~ $WMS;

  # Use the time stamp field
  ($tim, $cor) = _convert_wls($str);
  return $dft unless defined($cor);
  debug("TIM> Convert $str to $tim$cor") if $DUMP;
  return $tim cmp _get_time($slf, 'ref', $cor);
}

=head2 S<$h-E<gt>get_month($str[,$dft])>

This method returns the month contribution.

=cut

sub get_month
{ my ($slf, $str, $dft) = @_;

  return _get_month($str, $dft);
}

=head2 S<$h-E<gt>get_text($typ[,$flg])>

This method returns the specified time in UTC zone and as text format. When the
flag is set, it returns the specified time in the local time zone.

=cut

sub get_text
{ my ($slf, $typ, $flg, $fmt) = @_;
  my (@tim);

  return unless exists($slf->{$typ});
  if ($flg)
  { @tim = localtime(_get_epoch($slf, $typ));
    return sprintf('%02d-%s-%04d %02d:%02d:%02d',
      $tim[3], $TB_MON[1 + $tim[4]], 1900 + $tim[5], $tim[2], $tim[1], $tim[0])
      unless defined($fmt);
    return sprintf('%02d-%s-%04d_%02d:%02d',
      $tim[3], $TB_MON[1 + $tim[4]], 1900 + $tim[5], $tim[2], $tim[1]);
  }
  return (_get_time($slf, $typ, '+00:00') =~ m/^($Y)-($N)-($N)T(.*)$/)
    ? "$3-".$TB_MON[$2]."-$1 $4 UTC"
    : undef;
}

=head2 S<$h-E<gt>get_time($typ[,$cor])>

This method returns the specified time, with an optional time zone correction.

=cut

sub get_time
{ my ($slf, $typ, $cor) = @_;

  return exists($slf->{$typ})
    ? _get_time($slf, $typ, defined($cor) ? $cor : '+00:00')
    : undef;
}

=head2 S<$h-E<gt>has_period>

This method indicates whether a period is defined.

=cut

sub has_period
{ return shift->{'_chk'} ? 0 : 1;
}

=head2 S<$h-E<gt>has_reference>

This method indicates whether a reference time is defined.

=cut

sub has_reference
{ return shift->{'_cmp'} ? 0 : 1;
}

=head2 S<$h-E<gt>set_interval($tim[,$bef,$aft[,$ref[,$flg]])>

This method sets the time reference and defines a time period around the
specified event time. By default, it considers one hour before and an half hour
after the specified time. Unless the flag is set, it preserves any previous
definition.

=cut

sub set_interval
{ my ($slf, $tim, $bef, $aft, $ref, $flg) = @_;
  my ($ret, %tmp);

  $bef = '1:00:00' unless defined($bef);
  $aft = '0:30:00' unless defined($aft);
  $ref =       '1' unless defined($ref);

  # Validate the arguments
  return 1          unless $flg || $slf->{'_chk'};
  return 100 - $ret if ($ret = _validate_time(\%tmp, 'evt', $tim));
  return 200 - $ret if ($ret = _sub_time(\%tmp, 'beg', $bef));
  return 300 - $ret if ($ret = _add_time(\%tmp, 'end', $aft));
  return 400 - $ret if ($ret = _add_time(\%tmp, 'ref', $ref));

  # Accept the period
  _set_time($slf, 'beg', $tmp{'beg'}, $tmp{'-beg'});
  _set_time($slf, 'end', $tmp{'end'}, $tmp{'-end'});
  _set_time($slf, 'ref', $tmp{'ref'}, $tmp{'-ref'});
  return $slf->{'_chk'} = $slf->{'_cmp'} = 0;
}

=head2 S<$h-E<gt>set_period($beg,$end[,$flg])>

This method defines the period. Unless the flag is set, it preserves any
previous period.

=cut

sub set_period
{ my ($slf, $beg, $end, $flg) = @_;
  my ($ret, %bkp, %tmp);

  # Validate the arguments
  return 1          unless $flg || $slf->{'_chk'};
  return 100 - $ret if ($ret = _validate_time(\%tmp, 'beg', $beg));
  return 200 - $ret if ($ret = _validate_time(\%tmp, 'end', $end));

  # Ensure that the end time is more recent than the begin time
  $bkp{'beg'} = _set_time($slf, 'beg', $tmp{'beg'}, $tmp{'-beg'});
  $bkp{'end'} = _set_time($slf, 'end', $tmp{'end'}, $tmp{'-end'});
  return _restore_time($slf, \%bkp, 2)
    if _get_time($slf, 'beg', '+00:00') gt _get_time($slf, 'end', '+00:00');

  # Accept the period
  return $slf->{'_chk'} = 0;
}

=head2 S<$h-E<gt>set_reference($tim[,$flg])>

This method defines the reference time. Unless the flag is set, it preserves
any previous reference time.

=cut

sub set_reference
{ my ($slf, $tim, $flg) = @_;
  my ($ret, %tmp);

  # Validate the arguments
  return 1          unless $flg || $slf->{'_cmp'};
  return 100 - $ret if ($ret = _validate_time(\%tmp, 'ref', $tim));

  # Accept the reference time
  _set_time($slf, 'ref', $tmp{'ref'}, $tmp{'-ref'});
  return $slf->{'_cmp'} = 0;
}

=head2 S<$h-E<gt>set_zone($def)>

This method defines which time correction is associated to a zone. The
definition format is C<[A-Z]{1,5}=[-+][1-2]\d:\d{2}>.

=cut

sub set_zone
{ my ($slf, $def) = @_;

  $def = [$def] unless ref($def) eq 'ARRAY';
  foreach my $itm (@{$def})
  { $TB_ZON{uc($1)} = $2 if defined($itm) && $itm =~ m{^($Z)=($C)$}i;
  }
  return;
}

# --- Internal routines -------------------------------------------------------

# Add a delta to the reference time
sub _add_time
{ my ($tmp, $typ, $dlt) = @_;
  my ($off, $tim, $val, @dlt);

  $dlt .= $tb_dlt{$1} if $dlt =~ s/([dhms])$//;
  return -1 unless $dlt =~ m/^(\d{1,2}:){0,4}\d{1,2}$/;
  @dlt = split(/:/, $dlt);
  $tmp->{$typ} = $tim = [@{$tmp->{'evt'}}];
  $tim->[5] += ($val = pop(@dlt));
  while ($tim->[5] > 59)
  { $tim->[5] -= 60;
    $tim->[4]++;
  }
  $tim->[4] += $val if defined($val = pop(@dlt));
  while ($tim->[4] > 59)
  { $tim->[4] -= 60;
    $tim->[3]++;
  }
  $tim->[3] += $val if defined($val = pop(@dlt));
  while ($tim->[3] > 23)
  { $tim->[3] -= 24;
    $tim->[2]++;
  }
  $off = ($tim->[0] % 4) ? $tim->[1] + 13 : $tim->[1];
  $tim->[2] += $val if defined($val = pop(@dlt));
  while ($tim->[2] > $tb_day[$off])
  { $tim->[2] -= $tb_day[$off];
    if (++$tim->[1] > 12)
    { $tim->[1] -= 12;
      $tim->[0]++;
    }
    $off = ($tim->[0] % 4) ? $tim->[1] + 13 : $tim->[1];
  }
  return 0 unless defined($val = pop(@dlt));
  $tim->[1] += $val;
  while ($tim->[1] > 12)
  { $tim->[1] -= 12;
    $tim->[0]++;
  }
  $off = ($tim->[0] % 4) ? $tim->[1] + 13 : $tim->[1];
  if ($tim->[2] > $tb_day[$off])
  { $tim->[2] -= $tb_day[$off];
    if (++$tim->[1] > 12)
    { $tim->[1] -= 12;
      $tim->[0]++;
    }
  }
  return 0;
}

# Adjust the time
sub _adjust_time
{ my ($tim) = @_;
  my ($off);

  $off = ($tim->[0] % 4) ? $tim->[1] + 13 : $tim->[1];
  if ($tim->[4] < 0)
  { $tim->[4] += 60;
    $tim->[3]--;
  }
  elsif ($tim->[4] > 59)
  { $tim->[4] -= 60;
    $tim->[3]++;
  }
  if ($tim->[3] < 0)
  { $tim->[3] += 24;
    $tim->[2]--;
  }
  elsif ($tim->[3] > 23)
  { $tim->[3] -= 24;
    $tim->[2]++;
  }
  if ($tim->[2] < 1)
  { $tim->[2] += $tb_day[$off - 1];
    $tim->[1]--;
  }
  elsif ($tim->[2] > $tb_day[$off])
  { $tim->[2] -= $tb_day[$off];
    $tim->[1]++;
  }
  if ($tim->[1] < 1)
  { $tim->[1] += 12;
    $tim->[0]--;
  }
  elsif ($tim->[1] > 12)
  { $tim->[1] -= 12;
    $tim->[0]++;
  }
  return;
}

# Convert an ADR time stamp
sub _convert_adr
{ my ($str) = @_;
  my ($mon);

  return () unless defined($str);
  if ($str =~ m{^$A\s($A)\s($D)\s($D):($D):($D)\s($Z)\s($Y)$}io)
  { return () unless defined($mon = _get_month($1));
    return (sprintf($FMT, $7, $mon, $2, $3, $4, $5),
            _get_correction($6))
  }
  if ($str =~ m{^($Y-$N-$N)\s+($D:$D:$D)(?:\.\d*)?\s*($C)$}io)
  { return ($1.'T'.$2, $3);
  }
  debug("TIM> Unknown ADR time stamp format '$str'") if $DUMP;;
  return ();
}

# Convert a database time stamp (as epoch)
sub _convert_db
{ my ($str) = @_;
  my ($mon);

  if ($str =~ m{^$A\s($A)\s($N)\s($N):($N):($N)\s[^\d]*($Y)$}io)
  { # Convert a Unix or Windows format
    return defined($mon = _get_month($1))
      ? timelocal($5, $4, $3, $2, $mon - 1, $6 - 1900)
      : undef;
  }
  if ($str =~ m{^($N)-($A)-($Y)\s($N):($N):($N)}io)
  { # Convert a VMS format
    return defined($mon = _get_month($2))
      ? timelocal($6, $5, $4, $1, $mon - 1, $3 - 1900)
      : undef;
  }
  debug("TIM> Unknown database time stamp format '$str'") if $DUMP;;
  return;
}

# Convert a local time stamp (as epoch)
sub _convert_loc
{ my ($str) = @_;

  if ($str =~ m{^($Y)-($N)-($N)\s($N):($N):($N)}io)
  { return timelocal($6, $5, $4, $3, $2 - 1, $1 - 1900);
  }
  debug("TIM> Unknown local time stamp format '$str'") if $DUMP;;
  return;
}

# Convert an epoch time (in UTC)
sub _convert_epoch
{ my ($tim) = @_;
  my (@tbl);

  @tbl = gmtime($tim);
  return(sprintf($FMT, $tbl[5] + 1900, $tbl[4] + 1, $tbl[3],
                       $tbl[2], $tbl[1], $tbl[0]),
         '+00:00');
}

# Convert a WLS time stamp
sub _convert_wls
{ my ($str) = @_;
  my ($dlt, $mon);

  return () unless defined($str);
  if ($str =~ m{^($A)\s($N),\s($Y)\s($N):($N):($N)\s([AP]M)?\s?($Z)$}io)
  { return () unless defined($mon = _get_month($1)) &&
                     defined($dlt = _get_delta($7));
    return (sprintf($FMT,
            $3, $mon, $2, $dlt + $4, $5, $6),
            _get_correction($8));
  }
  if ($str =~ m{^($Y)-($N)-($N)\s*([\200-\377]+)($D)\D*($D)\D*($D)\D*\sCS?T$}io)
  { $dlt = _get_delta($4, 0);
    return (sprintf($FMT, $1, $2, $3, $dlt + $5, $6, $7),
            '+08:00')
  }
  if ($str =~ m{^($Y)-($N)-($N)\s*(\D+)($D)\D*($D)\D*($D)\D*\s($Z)$}io)
  { $dlt = _get_delta($4, 0);
    return (sprintf($FMT, $1, $2, $3, $dlt + $5, $6, $7),
            _get_correction($7))
  }
  debug("TIM> Unknown WLS time stamp format '$str'") if $DUMP;;
  return ();
}

# Get the time correction
sub _get_correction
{ my ($nam) = @_;
  my ($cor);

  unless (exists($TB_ZON{$nam = uc($nam)}))
  { debug("TIM> Unknown time zone name '$nam'") if $DUMP;;
    return;
  }
  return $cor unless ref($cor = $TB_ZON{$nam});
  debug("TIM> Ambiguous time zone name '$nam'") if $DUMP;;
  return $cor->[0];
}

# Get the epoch time
sub _get_epoch
{ my ($slf, $typ) = @_;

  unless (exists($slf->{$typ}->{q{}}))
  { my ($gmt);

    $gmt = _get_time($slf, $typ, '+00:00');
    $slf->{$typ}->{q{}} = timegm(substr($gmt, 17, 2),
                                 substr($gmt, 14, 2),
                                 substr($gmt, 11, 2),
                                 substr($gmt,  8, 2),
                                 substr($gmt,  5, 2) - 1,
                                 substr($gmt,  0, 4) - 1900);
    debug("TIM> Set $typ time for Epoch: ".$slf->{$typ}->{q{}}) if $DUMP;
  }
  return $slf->{$typ}->{q{}};
}

# Get the hour shift
sub _get_delta
{ my ($str, $dft) = @_;

  return $TB_MER{$str}
    if exists($TB_MER{$str}) || exists($TB_MER{$str = lc($str)});
  debug("TIM> Unknown meridian indicator '$str'") if $DUMP;
  return $dft;
}

# Get the month contribution
sub _get_month
{ my ($str, $dft) = @_;

  return $TB_MON{$str}
    if exists($TB_MON{$str}) || exists($TB_MON{$str = lc($str)});
  debug("TIM> Unknown month '$str'") if $DUMP;
  return $dft;
}

# Get the time corresponding to a time zone offset
sub _get_time
{ my ($slf, $typ, $cor) = @_;

  unless (exists($slf->{$typ}->{$cor}))
  { my (@cor, @tim);

    @cor = ($cor =~ $COR);
    @tim = @{$slf->{$typ}->{q{.}}};
    if ($cor[0] eq q{-})
    { $tim[3] -= $cor[1];
      $tim[4] -= $cor[2];
    }
    else
    { $tim[3] += $cor[1];
      $tim[4] += $cor[2];
    }
    _adjust_time(\@tim);
    $slf->{$typ}->{$cor} = sprintf($FMT,
      $tim[0], $tim[1], $tim[2], $tim[3], $tim[4], $tim[5]);
    debug("TIM> Set $typ time for $cor: ".$slf->{$typ}->{$cor}) if $DUMP;
  }
  return $slf->{$typ}->{$cor};
}

# Restore time
sub _restore_time
{ my ($slf, $bkp, $ret) = @_;

  foreach my $key (keys(%{$bkp}))
  { if (defined($bkp->{$key}))
    { $slf->{$key} = $bkp->{$key};
    }
    else
    { delete($slf->{$key});
    }
  }
  return $ret;
}

# Store a time
sub _set_time
{ my ($slf, $typ, $tbl, $alt) = @_;
  my ($cor, $def, $old, $tim);

  $old = $slf->{$typ};
  $tim = sprintf($FMT,
    $tbl->[0], $tbl->[1], $tbl->[2], $tbl->[3], $tbl->[4], $tbl->[5]);
  $cor = sprintf(q{%s%02d:%02d}, $tbl->[8], $tbl->[7], $tbl->[6]);
  $slf->{$typ} = $def = {q{.} => $tbl, $cor => $tim};
  debug("TIM> Set $typ time for $cor: $tim") if $DUMP;
  if (pop(@{$tbl}) eq q{-})
  { $tbl->[3] += pop(@{$tbl});
    $tbl->[4] += pop(@{$tbl});
  }
  else
  { $tbl->[3] -= pop(@{$tbl});
    $tbl->[4] -= pop(@{$tbl});
  }
  _adjust_time($tbl);
  $def->{q{}} = $alt if defined($alt);
  return $old;
}

# Substract a delta to the reference time
sub _sub_time
{ my ($tmp, $typ, $dlt) = @_;
  my ($off, $tim, $val, @dlt);

  $dlt .= $tb_dlt{$1} if $dlt =~ s/([dhms])$//;
  return -1 unless $dlt =~ m/^(\d{1,2}:){0,4}\d{1,2}$/;
  @dlt = split(/:/, $dlt);
  $tmp->{$typ} = $tim = [@{$tmp->{'evt'}}];
  $tim->[5] -= ($val = pop(@dlt));
  while ($tim->[5] < 0)
  { $tim->[5] += 60;
    $tim->[4]--;
  }
  $tim->[4] -= $val if defined($val = pop(@dlt));
  while ($tim->[4] < 0)
  { $tim->[4] += 60;
    $tim->[3]--;
  }
  $tim->[3] -= $val if defined($val = pop(@dlt));
  while ($tim->[3] < 0)
  { $tim->[3] += 24;
    $tim->[2]--;
  }
  $tim->[2] -= $val if defined($val = pop(@dlt));
  while ($tim->[2] < 1)
  { $off = ($tim->[0] % 4) ? $tim->[1] + 12 : $tim->[1] - 1;
    $tim->[2] += $tb_day[$off];
    if (--$tim->[1] < 1)
    { $tim->[1] += 12;
      $tim->[0]--;
    }
  }
  return 0 unless defined($val = pop(@dlt));
  $tim->[1] -= $val;
  while ($tim->[1] < 1)
  { $tim->[1] += 12;
    $tim->[0]--;
  }
  $off = ($tim->[0] % 4) ? $tim->[1] + 13 : $tim->[1];
  if ($tim->[2] > $tb_day[$off])
  { $tim->[2] -= $tb_day[$off];
    if (++$tim->[1] > 12)
    { $tim->[1] -= 12;
      $tim->[0]++;
    }
  }
  return 0;
}

# Validate the time
sub _validate_time
{ my ($tmp, $typ, $tim, @tbl) = @_;

  return -1 unless defined($tim) &&
    $tim =~ m{^(\d+)-(\d+)-(\d+)T(\d+):(\d+):(\d+)(([\-\+])(\d+):(\d+))?$};
  return -2 if $1 < 2000 || $1 > 2199;
  return -3 if $2 < 1 || $2 > 12;
  return -4 if $3 < 1 || $3 > $tb_day[($1 % 4) ? $2 + 13 : $2];
  return -5 if $4 > 23;
  return -6 if $5 > 59;
  return -7 if $6 > 60;
  if ($7)
  { return -8 if $9 < -23 || $9 > 23;
    return -9 if $10 > 59;
    $tmp->{$typ} = [$1, $2, $3, $4, $5, $6, $10, $9, $8];
  }
  else
  { @tbl = gmtime($tmp->{"-$typ"} =
      timelocal($6, $5, $4, $3, $2 - 1, $1 - 1900));
    $tmp->{$typ} = [$tbl[5] + 1900, $tbl[4] + 1, $tbl[3],
                    $tbl[2], $tbl[1], $tbl[0], 0, 0, q{+}];
  }
  return 0;
}

# --- SDCL extensions ---------------------------------------------------------

# Attach the timing control object
sub _begin_control
{ my ($pkg) = @_;

  $pkg->set_top('TIM', $pkg->get_collector->get_timing);
  return;
}

# Detach the timing control object
sub _end_control
{ my ($pkg) = @_;

  $pkg->set_top('TIM');
  return;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Object|RDA::Object>,
L<RDA::Text|RDA::Text>

=head1 COPYRIGHT NOTICE

Copyright (c) 2002, 2016, Oracle and/or its affiliates. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle and Java are registered trademarks of Oracle and/or its
affiliates. Other names may be trademarks of their respective owners.

=cut