UConv.pm 49 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905
  1. ###############################################################################
  2. # $Id: UConv.pm 17589 2018-10-22 13:37:00Z loredo $
  3. package main;
  4. sub UConv_Initialize() { }
  5. package UConv;
  6. use Scalar::Util qw(looks_like_number);
  7. use POSIX qw(strftime);
  8. use Data::Dumper;
  9. ####################
  10. # Translations
  11. our %compasspointss = (
  12. en => [
  13. 'N', 'NNE', 'NE', 'ENE', 'E', 'ESE', 'SE', 'SSE',
  14. 'S', 'SSW', 'SW', 'WSW', 'W', 'WNW', 'NW', 'NNW'
  15. ],
  16. de => [
  17. 'N', 'NNO', 'NO', 'ONO', 'O', 'OSO', 'SO', 'SSO',
  18. 'S', 'SSW', 'SW', 'WSW', 'W', 'WNW', 'NW', 'NNW'
  19. ],
  20. nl => [
  21. 'N', 'NNO', 'NO', 'ONO', 'O', 'OZO', 'ZO', 'ZZO',
  22. 'Z', 'ZZW', 'ZW', 'WZW', 'W', 'WNW', 'NW', 'NNW'
  23. ],
  24. fr => [
  25. 'N', 'NNE', 'NE', 'ENE', 'E', 'ESE', 'SE', 'SSE',
  26. 'S', 'SSO', 'SO', 'OSO', 'O', 'ONO', 'NO', 'NNO'
  27. ],
  28. pl => [
  29. 'N', 'NNE', 'NE', 'ENE', 'E', 'ESE', 'SE', 'SSE',
  30. 'S', 'SSW', 'SW', 'WSW', 'W', 'WNW', 'NW', 'NNW'
  31. ],
  32. );
  33. our %hr_formats = (
  34. # 1 234 567.89
  35. std => {
  36. delim => "\x{2009}",
  37. sep => ".",
  38. },
  39. # 1 234 567,89
  40. 'std-fr' => {
  41. delim => "\x{2009}",
  42. sep => ",",
  43. },
  44. # 1,234,567.89
  45. 'old-english' => {
  46. delim => ",",
  47. sep => ".",
  48. },
  49. # 1.234.567,89
  50. 'old-european' => {
  51. delim => ".",
  52. sep => ",",
  53. },
  54. # 1'234'567.89
  55. ch => {
  56. delim => "'",
  57. sep => ".",
  58. },
  59. ### lang ref ###
  60. #
  61. en => {
  62. ref => "std",
  63. },
  64. de => {
  65. ref => "std-fr",
  66. },
  67. de_at => {
  68. ref => "std-fr",
  69. min => 4,
  70. },
  71. de_ch => {
  72. ref => "std",
  73. },
  74. nl => {
  75. ref => "std-fr",
  76. },
  77. fr => {
  78. ref => "std-fr",
  79. },
  80. pl => {
  81. ref => "std-fr",
  82. },
  83. ### number ref ###
  84. #
  85. 0 => {
  86. ref => "std",
  87. },
  88. 1 => {
  89. ref => "std-fr",
  90. },
  91. 2 => {
  92. ref => "old-english",
  93. },
  94. 3 => {
  95. ref => "old-european",
  96. },
  97. 4 => {
  98. ref => "ch",
  99. },
  100. 5 => {
  101. ref => "std-fr",
  102. min => 4,
  103. },
  104. );
  105. our %daytimes = (
  106. en => [
  107. "morning", "midmorning", "noon", "afternoon",
  108. "evening", "midevening", "night",
  109. ],
  110. de => [
  111. "Morgen", "Vormittag", "Mittag", "Nachmittag",
  112. "Vorabend", "Abend", "Nacht",
  113. ],
  114. icons => [
  115. "weather_sunrise", "scene_day",
  116. "weather_sun", "weather_summer",
  117. "weather_sunset", "scene_night",
  118. "weather_moon_phases_8",
  119. ],
  120. );
  121. our %sdt2daytimes = (
  122. # User overwrite format:
  123. # <SeasonSrc><SeasonIndex><DST><daytimeStage>:<daytime>
  124. # M000:0
  125. # M001:0
  126. # M002:0
  127. # M003:1
  128. # M004:1
  129. # M005:2
  130. # M006:2
  131. # M007:3
  132. # M008:3
  133. # M009:3
  134. # M0010:3
  135. # M0011:4
  136. # M0012:5
  137. #
  138. # M010:0
  139. # M011:0
  140. # M012:0
  141. # M013:1
  142. # M014:1
  143. # M015:2
  144. # M016:2
  145. # M017:3
  146. # M018:3
  147. # M019:3
  148. # M0110:3
  149. # M0111:4
  150. # M0112:5
  151. # SPRING SEASON
  152. 0 => {
  153. # DST = no
  154. 0 => {
  155. 1 => 0,
  156. 4 => 1,
  157. 6 => 2,
  158. 8 => 3,
  159. 12 => 4,
  160. },
  161. # DST = yes
  162. 1 => {
  163. 1 => 0,
  164. 4 => 1,
  165. 6 => 2,
  166. 8 => 3,
  167. 12 => 4,
  168. },
  169. },
  170. # SUMMER SEASON
  171. 1 => {
  172. # DST = yes
  173. 1 => {
  174. 1 => 0,
  175. 4 => 1,
  176. 6 => 2,
  177. 7 => 3,
  178. 10 => 4,
  179. 12 => 5,
  180. }
  181. },
  182. # AUTUMN SEASON
  183. 2 => {
  184. # DST = no
  185. 0 => {
  186. 1 => 0,
  187. 4 => 1,
  188. 6 => 2,
  189. 7 => 3,
  190. 11 => 4,
  191. },
  192. # DST = yes
  193. 1 => {
  194. 1 => 0,
  195. 4 => 1,
  196. 6 => 2,
  197. 7 => 3,
  198. 11 => 4,
  199. },
  200. },
  201. # WINTER SEASON
  202. 3 => {
  203. # DST = no
  204. 0 => {
  205. 1 => 0,
  206. 3 => 1,
  207. 6 => 2,
  208. 8 => 3,
  209. # 12 => 4,
  210. },
  211. },
  212. );
  213. our %seasons = (
  214. en => [ "Spring", "Summer", "Autumn", "Winter", ],
  215. de => [ "Frühling", "Sommer", "Herbst", "Winter", ],
  216. pheno => [ 2, 4, 7, 9 ],
  217. );
  218. our %seasonsPheno = (
  219. en => [
  220. "Early Spring",
  221. "First Spring",
  222. "Spring",
  223. "Early Summer",
  224. "Summer",
  225. "Late Summer",
  226. "Early Autumn",
  227. "Autumn",
  228. "Late Autumn",
  229. "Winter",
  230. ],
  231. de => [
  232. "Vorfrühling", "Erstfrühling", "Vollfrühling", "Frühsommer",
  233. "Hochsommer", "Spätsommer", "Frühherbst", "Vollherbst",
  234. "Spätherbst", "Winter",
  235. ],
  236. );
  237. our %dst = (
  238. en => [ "standard", "daylight" ],
  239. de => [ "Normalzeit", "Sommerzeit" ],
  240. );
  241. our %daystages = (
  242. en => [ "weekday", "weekend", "holiday", "vacation", ],
  243. de => [ "Wochentag", "Wochenende", "Feiertag", "Urlaubstag", ],
  244. );
  245. our %reldays = (
  246. en => [ "yesterday", "today", "tomorrow" ],
  247. de => [ "Gestern", "Heute", "Morgen" ],
  248. );
  249. our %monthss = (
  250. en => [
  251. "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug",
  252. "Sep", "Oct", "Nov", "Dec", "Jan"
  253. ],
  254. de => [
  255. "Jan", "Feb", "Mar", "Apr", "Mai", "Jun", "Jul", "Aug",
  256. "Sep", "Okt", "Nov", "Dez", "Jan"
  257. ],
  258. );
  259. our %months = (
  260. en => [
  261. "January", "Febuary", "March", "April",
  262. "May", "June", "July", "August",
  263. "September", "October", "November", "December",
  264. "January"
  265. ],
  266. de => [
  267. "Januar", "Februar", "März", "April",
  268. "Mai", "Juni", "Juli", "August",
  269. "September", "Oktober", "November", "Dezember",
  270. "Januar"
  271. ],
  272. );
  273. our %dayss = (
  274. en => [ "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun" ],
  275. de => [ "So", "Mo", "Di", "Mi", "Do", "Fr", "Sa", "So" ],
  276. );
  277. our %days = (
  278. en => [
  279. "Sunday", "Monday", "Tuesday", "Wednesday",
  280. "Thursday", "Friday", "Saturday", "Sunday"
  281. ],
  282. de => [
  283. "Sonntag", "Montag", "Dienstag", "Mittwoch",
  284. "Donnerstag", "Freitag", "Samstag", "Sonntag"
  285. ],
  286. );
  287. our %dateformats = (
  288. en => '%wday_long%, %mon_long% %mday%',
  289. de => '%wday_long%, %mday%. %mon_long%',
  290. );
  291. our %dateformatss = (
  292. en => '%mon_long% %mday%',
  293. de => '%mday%. %mon_long%',
  294. );
  295. #################################
  296. ### Inner metric conversions
  297. ###
  298. # Temperature: convert Celsius to Kelvin
  299. sub c2k($;$) {
  300. my ( $data, $rnd ) = @_;
  301. return _round( $data + 273.15, $rnd );
  302. }
  303. # Temperature: convert Kelvin to Celsius
  304. sub k2c($;$) {
  305. my ( $data, $rnd ) = @_;
  306. return _round( $data - 273.15, $rnd );
  307. }
  308. # Speed: convert km/h (kilometer per hour) to m/s (meter per second)
  309. sub kph2mps($;$) {
  310. my ( $data, $rnd ) = @_;
  311. return _round( $data / 3.6, $rnd );
  312. }
  313. # Speed: convert m/s (meter per second) to km/h (kilometer per hour)
  314. sub mps2kph($;$) {
  315. my ( $data, $rnd ) = @_;
  316. return _round( $data * 3.6, $rnd );
  317. }
  318. # Pressure: convert hPa (hecto Pascal) to mmHg (milimeter of Mercury)
  319. sub hpa2mmhg($;$) {
  320. my ( $data, $rnd ) = @_;
  321. return _round( $data * 0.00750061561303, $rnd );
  322. }
  323. #################################
  324. ### Metric to angloamerican conversions
  325. ###
  326. # Temperature: convert Celsius to Fahrenheit
  327. sub c2f($;$) {
  328. my ( $data, $rnd ) = @_;
  329. return _round( $data * 1.8 + 32, $rnd );
  330. }
  331. # Temperature: convert Kelvin to Fahrenheit
  332. sub k2f($;$) {
  333. my ( $data, $rnd ) = @_;
  334. return _round( ( $data - 273.15 ) * 1.8 + 32, $rnd );
  335. }
  336. # Pressure: convert hPa (hecto Pascal) to in (inches of Mercury)
  337. sub hpa2inhg($;$) {
  338. my ( $data, $rnd ) = @_;
  339. return _round( $data * 0.02952998751, $rnd );
  340. }
  341. # Pressure: convert hPa (hecto Pascal) to PSI (Pound force per square inch)
  342. sub hpa2psi($;$) {
  343. my ( $data, $rnd ) = @_;
  344. return _round( $data * 100.00014504, $rnd );
  345. }
  346. # Speed: convert km/h (kilometer per hour) to mph (miles per hour)
  347. sub kph2mph($;$) {
  348. return km2mi(@_);
  349. }
  350. # Speed: convert m/s (meter per seconds) to mph (miles per hour)
  351. sub mps2mph($;$) {
  352. my ( $data, $rnd ) = @_;
  353. return _round( kph2mph( mps2kph( $data, 9 ), 9 ), $rnd );
  354. }
  355. # Length: convert mm (milimeter) to in (inch)
  356. sub mm2in($;$) {
  357. my ( $data, $rnd ) = @_;
  358. return _round( $data * 0.039370, $rnd );
  359. }
  360. # Length: convert cm (centimeter) to in (inch)
  361. sub cm2in($;$) {
  362. my ( $data, $rnd ) = @_;
  363. return _round( $data * 0.39370, $rnd );
  364. }
  365. # Length: convert m (meter) to ft (feet)
  366. sub m2ft($;$) {
  367. my ( $data, $rnd ) = @_;
  368. return _round( $data * 3.2808, $rnd );
  369. }
  370. # Length: convert km (kilometer) to miles (mi)
  371. sub km2mi($;$) {
  372. my ( $data, $rnd ) = @_;
  373. return _round( $data * 0.621371192, $rnd );
  374. }
  375. #################################
  376. ### Inner Angloamerican conversions
  377. ###
  378. # Speed: convert mph (miles per hour) to ft/s (feet per second)
  379. sub mph2fts($;$) {
  380. my ( $data, $rnd ) = @_;
  381. return _round( $data * 1.467, $rnd );
  382. }
  383. # Speed: convert ft/s (feet per second) to mph (miles per hour)
  384. sub fts2mph($;$) {
  385. my ( $data, $rnd ) = @_;
  386. return _round( $data / 1.467, $rnd );
  387. }
  388. #################################
  389. ### Angloamerican to Metric conversions
  390. ###
  391. # Temperature: convert Fahrenheit to Celsius
  392. sub f2c($;$) {
  393. my ( $data, $rnd ) = @_;
  394. return _round( ( $data - 32 ) * 0.5556, $rnd );
  395. }
  396. # Temperature: convert Fahrenheit to Kelvin
  397. sub f2k($;$) {
  398. my ( $data, $rnd ) = @_;
  399. return _round( ( $data - 32 ) / 1.8 + 273.15, $rnd );
  400. }
  401. # Pressure: convert in (inches of Mercury) to hPa (hecto Pascal)
  402. sub inhg2hpa($;$) {
  403. my ( $data, $rnd ) = @_;
  404. return _round( $data * 33.8638816, $rnd );
  405. }
  406. # Pressure: convert PSI (Pound force per square inch) to hPa (hecto Pascal)
  407. sub psi2hpa($;$) {
  408. my ( $data, $rnd ) = @_;
  409. return _round( $data / 100.00014504, $rnd );
  410. }
  411. # Speed: convert mph (miles per hour) to km/h (kilometer per hour)
  412. sub mph2kph($;$) {
  413. return mi2km(@_);
  414. }
  415. # Speed: convert mph (miles per hour) to m/s (meter per seconds)
  416. sub mph2mps($;$) {
  417. my ( $data, $rnd ) = @_;
  418. return _round( kph2mps( mph2kph( $data, 9 ), 9 ), $rnd );
  419. }
  420. # Length: convert in (inch) to mm (milimeter)
  421. sub in2mm($;$) {
  422. my ( $data, $rnd ) = @_;
  423. return _round( $data * 25.4, $rnd );
  424. }
  425. # Length: convert in (inch) to cm (centimeter)
  426. sub in2cm($;$) {
  427. my ( $data, $rnd ) = @_;
  428. return _round( $data / 0.39370, $rnd );
  429. }
  430. # Length: convert ft (feet) to m (meter)
  431. sub ft2m($;$) {
  432. my ( $data, $rnd ) = @_;
  433. return _round( $data / 3.2808, $rnd );
  434. }
  435. # Length: convert mi (miles) to km (kilometer)
  436. sub mi2km($;$) {
  437. my ( $data, $rnd ) = @_;
  438. return _round( $data * 1.609344, $rnd );
  439. }
  440. #################################
  441. ### Angular conversions
  442. ###
  443. # convert direction in degree to point of the compass
  444. sub direction2compasspoint($;$) {
  445. my ( $azimuth, $lang ) = @_;
  446. my $directions_txt_i18n;
  447. $lang = $main::attr{global}{language} ? $main::attr{global}{language} : "EN"
  448. unless ($lang);
  449. if ( $lang && defined( $compasspointss{ lc($lang) } ) ) {
  450. $directions_txt_i18n = $compasspointss{ lc($lang) };
  451. }
  452. else {
  453. $directions_txt_i18n = $compasspointss{en};
  454. }
  455. return @$directions_txt_i18n[
  456. int( ( ( $azimuth + 11.25 ) % 360 ) / 22.5 )
  457. ];
  458. }
  459. #################################
  460. ### Solar conversions
  461. ###
  462. # Power: convert uW/cm2 (micro watt per square centimeter) to UV-Index
  463. sub uwpscm2uvi($;$) {
  464. my ( $data, $rnd ) = @_;
  465. return 0 unless ($data);
  466. # Forum topic,44403.msg501704.html#msg501704
  467. return int( ( $data - 100 ) / 450 + 1 ) unless ( defined($rnd) );
  468. $rnd = 0 unless ( defined($rnd) );
  469. return _round( ( ( $data - 100 ) / 450 + 1 ), $rnd );
  470. }
  471. # Power: convert UV-Index to uW/cm2 (micro watt per square centimeter)
  472. sub uvi2uwpscm($) {
  473. my ($data) = @_;
  474. return 0 unless ($data);
  475. return ( $data * ( 450 + 1 ) ) + 100;
  476. }
  477. # Power: convert lux to W/m2 (watt per square meter)
  478. sub lux2wpsm($;$) {
  479. my ( $data, $rnd ) = @_;
  480. # Forum topic,44403.msg501704.html#msg501704
  481. return _round( $data / 126.7, $rnd );
  482. }
  483. # Power: convert W/m2 to lux
  484. sub wpsm2lux($;$) {
  485. my ( $data, $rnd ) = @_;
  486. # Forum topic,44403.msg501704.html#msg501704
  487. return _round( $data * 126.7, $rnd );
  488. }
  489. #################################
  490. ### Nautic unit conversions
  491. ###
  492. # Speed: convert smi (statute miles) to nmi (nautical miles)
  493. sub smi2nmi($;$) {
  494. my ( $data, $rnd ) = @_;
  495. return _round( $data * 0.8684, $rnd );
  496. }
  497. # Speed: convert km (kilometer) to nmi (nautical miles)
  498. sub km2nmi($;$) {
  499. my ( $data, $rnd ) = @_;
  500. return _round( smi2nmi( km2mi( $data, 9 ), 9 ), $rnd );
  501. }
  502. # Speed: convert km/h to knots
  503. sub kph2kn($;$) {
  504. my ( $data, $rnd ) = @_;
  505. return _round( $data * 0.539956803456, $rnd );
  506. }
  507. # Speed: convert km/h to Beaufort wind force scale
  508. sub kph2bft($) {
  509. my ($data) = @_;
  510. my $val = "0";
  511. if ( $data >= 118 ) {
  512. $val = "12";
  513. }
  514. elsif ( $data >= 103 ) {
  515. $val = "11";
  516. }
  517. elsif ( $data >= 89 ) {
  518. $val = "10";
  519. }
  520. elsif ( $data >= 75 ) {
  521. $val = "9";
  522. }
  523. elsif ( $data >= 62 ) {
  524. $val = "8";
  525. }
  526. elsif ( $data >= 50 ) {
  527. $val = "7";
  528. }
  529. elsif ( $data >= 39 ) {
  530. $val = "6";
  531. }
  532. elsif ( $data >= 29 ) {
  533. $val = "5";
  534. }
  535. elsif ( $data >= 20 ) {
  536. $val = "4";
  537. }
  538. elsif ( $data >= 12 ) {
  539. $val = "3";
  540. }
  541. elsif ( $data >= 6 ) {
  542. $val = "2";
  543. }
  544. elsif ( $data >= 1 ) {
  545. $val = "1";
  546. }
  547. if (wantarray) {
  548. my ( $cond, $rgb, $warn ) = bft2condition($val);
  549. return ( $val, $rgb, $cond, $warn );
  550. }
  551. return $val;
  552. }
  553. # Speed: convert mph (miles per hour) to Beaufort wind force scale
  554. sub mph2bft($) {
  555. my ($data) = @_;
  556. my $val = "0";
  557. if ( $data >= 73 ) {
  558. $val = "12";
  559. }
  560. elsif ( $data >= 64 ) {
  561. $val = "11";
  562. }
  563. elsif ( $data >= 55 ) {
  564. $val = "10";
  565. }
  566. elsif ( $data >= 47 ) {
  567. $val = "9";
  568. }
  569. elsif ( $data >= 39 ) {
  570. $val = "8";
  571. }
  572. elsif ( $data >= 32 ) {
  573. $val = "7";
  574. }
  575. elsif ( $data >= 25 ) {
  576. $val = "6";
  577. }
  578. elsif ( $data >= 19 ) {
  579. $val = "5";
  580. }
  581. elsif ( $data >= 13 ) {
  582. $val = "4";
  583. }
  584. elsif ( $data >= 8 ) {
  585. $val = "3";
  586. }
  587. elsif ( $data >= 4 ) {
  588. $val = "2";
  589. }
  590. elsif ( $data >= 1 ) {
  591. $val = "1";
  592. }
  593. if (wantarray) {
  594. my ( $cond, $rgb, $warn ) = bft2condition($val);
  595. return ( $val, $rgb, $cond, $warn );
  596. }
  597. return $val;
  598. }
  599. #################################
  600. ### Differential conversions
  601. ###
  602. sub distance($$$$;$$) {
  603. my ( $lat1, $lng1, $lat2, $lng2, $rnd, $unit ) = @_;
  604. return _round( "0.000000000", $rnd )
  605. if ( $lat1 eq $lat2 && $lng1 eq $lng2 );
  606. use constant M_PI => 4 * atan2( 1, 1 );
  607. my $pi80 = M_PI / 180;
  608. $lat1 *= $pi80;
  609. $lng1 *= $pi80;
  610. $lat2 *= $pi80;
  611. $lng2 *= $pi80;
  612. my $r = 6372.797; # mean radius of Earth in km
  613. my $dlat = $lat2 - $lat1;
  614. my $dlng = $lng2 - $lng1;
  615. my $a =
  616. sin( $dlat / 2 ) * sin( $dlat / 2 ) +
  617. cos($lat1) * cos($lat2) * sin( $dlng / 2 ) * sin( $dlng / 2 );
  618. my $c = 2 * atan2( sqrt($a), sqrt( 1 - $a ) );
  619. my $km = $r * $c;
  620. return _round(
  621. ( $unit eq "nmi" ? km2nmi($km) : ( $unit ? km2mi($km) : $km ) ), $rnd );
  622. }
  623. sub duration ($$;$) {
  624. my ( $datetimeNow, $datetimeOld, $format ) = @_;
  625. if ( $datetimeNow eq "" || $datetimeOld eq "" ) {
  626. $datetimeNow = "1970-01-01 00:00:00";
  627. $datetimeOld = "1970-01-01 00:00:00";
  628. }
  629. my $timestampNow = main::time_str2num($datetimeNow);
  630. my $timestampOld = main::time_str2num($datetimeOld);
  631. my $timeDiff = $timestampNow - $timestampOld;
  632. # return seconds
  633. return _round( $timeDiff, 0 )
  634. if ( defined($format) && $format eq "sec" );
  635. # return minutes
  636. return _round( $timeDiff / 60, 0 )
  637. if ( defined($format) && $format eq "min" );
  638. # return human readable format
  639. return s2hms( _round( $timeDiff, 0 ) );
  640. }
  641. #################################
  642. ### Textual unit conversions
  643. ###
  644. ######## humanReadable #########################################
  645. # What : Formats a number or text string to be more readable for humans
  646. # Syntax: { humanReadable( <value>, [ <format> ] ) }
  647. # Call : { humanReadable(102345.6789) }
  648. # { humanReadable(102345.6789, 3) }
  649. # { humanReadable(102345.6789, "DE") }
  650. # { humanReadable(102345.6789, "si-fr") }
  651. # { humanReadable(102345.6789, {
  652. # group=>3, delim=>".", sep=>"," } ) }
  653. # { humanReadable("DE44500105175407324931", {
  654. # group=>4, rev=>0 } ) }
  655. # Source: https://en.wikipedia.org/wiki/Decimal_mark
  656. # https://de.wikipedia.org/wiki/Schreibweise_von_Zahlen
  657. # https://de.wikipedia.org/wiki/Dezimaltrennzeichen
  658. # https://de.wikipedia.org/wiki/Zifferngruppierung
  659. sub humanReadable($;$) {
  660. my ( $v, $f ) = @_;
  661. my $l =
  662. $main::attr{global}{humanReadable} ? $main::attr{global}{humanReadable}
  663. : (
  664. $main::attr{global}{language} ? $main::attr{global}{language}
  665. : "EN"
  666. );
  667. my $h =
  668. !$f || ref($f) || !$hr_formats{$f} ? $f
  669. : (
  670. $hr_formats{$f}{ref} ? $hr_formats{ $hr_formats{$f}{ref} }
  671. : $hr_formats{$f}
  672. );
  673. my $min =
  674. ref($h)
  675. && defined( $h->{min} )
  676. ? $h->{min}
  677. : ( !ref($f) && $hr_formats{$f}{min} ? $hr_formats{$f}{min} : 5 );
  678. my $group =
  679. ref($h)
  680. && defined( $h->{group} )
  681. ? $h->{group}
  682. : ( !ref($f) && $hr_formats{$f}{group} ? $hr_formats{$f}{group} : 3 );
  683. my $delim =
  684. ref($h)
  685. && $h->{delim}
  686. ? $h->{delim}
  687. : $hr_formats{ ( $l =~ /^de|nl|fr|pl/i ? "std-fr" : "std" ) }{delim};
  688. my $sep =
  689. ref($h)
  690. && $h->{sep}
  691. ? $h->{sep}
  692. : $hr_formats{ ( $l =~ /^de|nl|fr|pl/i ? "std-fr" : "std" ) }{sep};
  693. my $reverse = ref($h) && defined( $h->{rev} ) ? $h->{rev} : 1;
  694. my @p = split( /\./, $v, 2 );
  695. if ( length( $p[0] ) < $min && length( $p[1] ) < $min ) {
  696. $v =~ s/\./$sep/g;
  697. return $v;
  698. }
  699. $v =~ s/\./\*/g;
  700. # digits after thousands separator
  701. if ( ( $delim eq "\x{202F}" || $delim eq " " )
  702. && length( $p[1] ) >= $min )
  703. {
  704. $v =~ s/(\w{$group})(?=\w)(?!\w*\*)/$1$delim/g;
  705. }
  706. # digits before thousands separator
  707. if ( length( $p[0] ) >= $min ) {
  708. $v = reverse $v if ($reverse);
  709. $v =~ s/(\w{$group})(?=\w)(?!\w*\*)/$1$delim/g;
  710. if ($reverse) {
  711. $v =~ s/\*/$sep/g;
  712. return scalar reverse $v;
  713. }
  714. }
  715. $v =~ s/\*/$sep/g;
  716. return $v;
  717. }
  718. # ######## machineReadable #########################################
  719. # # What : find the first matching number in a string and make it
  720. # # machine readable.
  721. # # Syntax: { machineReadable( <value>, [ <global>, [ <format> ]] ) }
  722. # # Call : { machineReadable("102 345,6789") }
  723. # sub machineReadable($;$) {
  724. # my ( $v, $g ) = @_;
  725. #
  726. # sub mrVal($$) {
  727. # my ( $n, $n2 ) = @_;
  728. # $n .= "." . $n2 if ($n2);
  729. # $n =~ s/[^\d\.]//g;
  730. # return $n;
  731. # }
  732. #
  733. #
  734. # foreach ( "std", "std-fr" ) {
  735. # my $delim = '\\' . $hr_formats{$_}{delim};
  736. # $delim .= ' ' if ($_ =~ /^std/);
  737. #
  738. # if ( $g
  739. # && $v =~
  740. # s/((-?)((?:\d+(?:[$delim]\d)*)+)([\.\,])((?:\d+(?:[$delim]\d)*)+)?)/$2.mrVal($3, $5)/eg
  741. # )
  742. # {
  743. # last;
  744. # }
  745. # elsif ( $v =~
  746. # m/^((\-?)((?:\d(?:[$delim]\d)*)+)(?:([\.\,])((?:\d(?:[$delim]\d)*)+))?)/ )
  747. # {
  748. # $v = $2 . mrVal( $3, $5 );
  749. # last;
  750. # }
  751. # }
  752. #
  753. # return $v;
  754. # }
  755. # Condition: convert temperature (Celsius) to temperature condition
  756. sub c2condition($;$) {
  757. my ( $data, $indoor ) = @_;
  758. my $val = "freeze";
  759. my $rgb = "0055BB";
  760. if ($indoor) {
  761. $data -= 5 if ( $data < 22.5 );
  762. $data += 5 if ( $data > 25 );
  763. }
  764. if ( $data >= 35 ) {
  765. $val = "hot";
  766. $rgb = "C72A23";
  767. }
  768. elsif ( $data >= 30 ) {
  769. $val = "high";
  770. $rgb = "E7652B";
  771. }
  772. elsif ( $data >= 14 ) {
  773. $val = "ideal";
  774. $rgb = "4C9329";
  775. }
  776. elsif ( $data >= 5 ) {
  777. $val = "low";
  778. $rgb = "009999";
  779. }
  780. elsif ( $data >= 2.5 || $indoor ) {
  781. $val = "cold";
  782. $rgb = "0066CC";
  783. }
  784. return ( $val, $rgb ) if (wantarray);
  785. return $val;
  786. }
  787. # Condition: convert humidity (percent) to humidity condition
  788. sub humidity2condition($;$) {
  789. my ( $data, $indoor ) = @_;
  790. my $val = "dry";
  791. my $rgb = "C72A23";
  792. if ( $data >= 80 ) {
  793. $val = "wet";
  794. $rgb = "0066CC";
  795. }
  796. elsif ( $data >= 70 ) {
  797. $val = "high";
  798. $rgb = "009999";
  799. }
  800. elsif ( $data >= 50 ) {
  801. $val = "ideal";
  802. $rgb = "4C9329";
  803. }
  804. elsif ( $data >= 40 ) {
  805. $val = "low";
  806. $rgb = "E7652B";
  807. }
  808. return ( $val, $rgb ) if (wantarray);
  809. return $val;
  810. }
  811. # Condition: convert UV-Index to UV condition
  812. sub uvi2condition($) {
  813. my ($data) = @_;
  814. my $val = "low";
  815. my $rgb = "4C9329";
  816. if ( $data > 11 ) {
  817. $val = "extreme";
  818. $rgb = "674BC4";
  819. }
  820. elsif ( $data > 8 ) {
  821. $val = "veryhigh";
  822. $rgb = "C72A23";
  823. }
  824. elsif ( $data > 6 ) {
  825. $val = "high";
  826. $rgb = "E7652B";
  827. }
  828. elsif ( $data > 3 ) {
  829. $val = "moderate";
  830. $rgb = "F4E54C";
  831. }
  832. return ( $val, $rgb ) if (wantarray);
  833. return $val;
  834. }
  835. # Condition: convert Beaufort to wind condition
  836. sub bft2condition($) {
  837. my ($data) = @_;
  838. my $rgb = "FEFEFE";
  839. my $cond = "calm";
  840. my $warn = " ";
  841. if ( $data == 12 ) {
  842. $rgb = "E93323";
  843. $cond = "hurricane_force";
  844. $warn = "hurricane_force";
  845. }
  846. elsif ( $data == 11 ) {
  847. $rgb = "EB4826";
  848. $cond = "violent_storm";
  849. $warn = "storm_force";
  850. }
  851. elsif ( $data == 10 ) {
  852. $rgb = "E96E2C";
  853. $cond = "storm";
  854. $warn = "storm_force";
  855. }
  856. elsif ( $data == 9 ) {
  857. $rgb = "F19E38";
  858. $cond = "strong_gale";
  859. $warn = "gale_force";
  860. }
  861. elsif ( $data == 8 ) {
  862. $rgb = "F7CE46";
  863. $cond = "gale";
  864. $warn = "gale_force";
  865. }
  866. elsif ( $data == 7 ) {
  867. $rgb = "FFFF54";
  868. $cond = "near_gale";
  869. $warn = "high_winds";
  870. }
  871. elsif ( $data == 6 ) {
  872. $rgb = "D6FD51";
  873. $cond = "strong_breeze";
  874. $warn = "high_winds";
  875. }
  876. elsif ( $data == 5 ) {
  877. $rgb = "B1FC4F";
  878. $cond = "fresh_breeze";
  879. }
  880. elsif ( $data == 4 ) {
  881. $rgb = "B1FC7B";
  882. $cond = "moderate_breeze";
  883. }
  884. elsif ( $data == 3 ) {
  885. $rgb = "B1FCA3";
  886. $cond = "gentle_breeze";
  887. }
  888. elsif ( $data == 2 ) {
  889. $rgb = "B1FCD0";
  890. $cond = "light_breeze";
  891. }
  892. elsif ( $data == 1 ) {
  893. $rgb = "D6FEFE";
  894. $cond = "light_air";
  895. }
  896. return ( $cond, $rgb, $warn ) if (wantarray);
  897. return $cond;
  898. }
  899. sub values2weathercondition($$$$$) {
  900. my ( $temp, $hum, $light, $isday, $israining ) = @_;
  901. my $val = "clear";
  902. if ($israining) {
  903. $val = "rain";
  904. }
  905. elsif ( $light > 40000 ) {
  906. $val = "sunny";
  907. }
  908. elsif ($isday) {
  909. $val = "cloudy";
  910. }
  911. $val = "nt_" . $val unless ($isday);
  912. return $val;
  913. }
  914. #################################
  915. ### Chronological conversions
  916. ###
  917. sub hms2s($) {
  918. my $in = shift;
  919. my @a = split( ":", $in );
  920. return 0 if ( scalar @a < 2 || $in !~ m/^[\d:]*$/ );
  921. return $a[0] * 3600 + $a[1] * 60 + ( $a[2] ? $a[2] : 0 );
  922. }
  923. sub hms2m($) {
  924. return hms2s(@_) / 60;
  925. }
  926. sub hms2h($) {
  927. return hms2m(@_) / 60;
  928. }
  929. sub s2hms($) {
  930. my ($in) = @_;
  931. my ( $h, $m, $s );
  932. $h = int( $in / 3600 );
  933. $m = int( ( $in - $h * 3600 ) / 60 );
  934. $s = int( $in - $h * 3600 - $m * 60 );
  935. return ( $h, $m, $s ) if (wantarray);
  936. return sprintf( "%02d:%02d:%02d", $h, $m, $s );
  937. }
  938. sub m2hms($) {
  939. my ($in) = @_;
  940. my ( $h, $m, $s );
  941. $h = int( $in / 60 );
  942. $m = int( $in - $h * 60 );
  943. $s = int( 60 * ( $in - $h * 60 - $m ) );
  944. return ( $h, $m, $s ) if (wantarray);
  945. return sprintf( "%02d:%02d:%02d", $h, $m, $s );
  946. }
  947. sub h2hms($) {
  948. my ($in) = @_;
  949. my ( $h, $m, $s );
  950. $h = int($in);
  951. $m = int( 60 * ( $in - $h ) );
  952. $s = int( 3600 * ( $in - $h ) - 60 * $m );
  953. return ( $h, $m, $s ) if (wantarray);
  954. return sprintf( "%02d:%02d:%02d", $h, $m, $s );
  955. }
  956. sub IsLeapYear (;$) {
  957. # Either the value 0 or the value 1 is returned.
  958. # If 0, it is not a leap year. If 1, it is a
  959. # leap year. (Works for Julian calendar,
  960. # established in 1582)
  961. my $y = shift;
  962. return undef
  963. unless ( !$y || $y =~ /^\d{10}(?:\.\d+)?$/ || $y =~ /^[1-2]\d{3}$/ );
  964. if ( !$y || $y !~ /^[1-2]\d{3}$/ ) {
  965. my $today = _time($y);
  966. $y = $today->{year};
  967. }
  968. # If $year is not evenly divisible by 4, it is
  969. # not a leap year; therefore, we return the
  970. # value 0 and do no further calculations in
  971. # this subroutine. ("$year % 4" provides the
  972. # remainder when $year is divided by 4.
  973. # If there is a remainder then $year is
  974. # not evenly divisible by 4.)
  975. return 0 if $y % 4;
  976. # At this point, we know $year is evenly divisible
  977. # by 4. Therefore, if it is not evenly
  978. # divisible by 100, it is a leap year --
  979. # we return the value 1 and do no further
  980. # calculations in this subroutine.
  981. return 1 if $y % 100;
  982. # At this point, we know $year is evenly divisible
  983. # by 4 and also evenly divisible by 100. Therefore,
  984. # if it is not also evenly divisible by 400, it is
  985. # not leap year -- we return the value 0 and do no
  986. # further calculations in this subroutine.
  987. return 0 if $y % 400;
  988. # Now we know $year is evenly divisible by 4, evenly
  989. # divisible by 100, and evenly divisible by 400.
  990. # We return the value 1 because it is a leap year.
  991. return 1;
  992. }
  993. sub IsDst(;$) {
  994. my ($time) = @_;
  995. my $ret = _time($time);
  996. return $ret->{isdst};
  997. }
  998. sub IsWeekend(;$) {
  999. my ($time) = @_;
  1000. my $ret = _time($time);
  1001. return $ret->{iswe};
  1002. }
  1003. sub IsHoliday(;$) {
  1004. my ($time) = @_;
  1005. my $ret = _time($time);
  1006. return $ret->{isholiday};
  1007. }
  1008. # Get current stage of the daytime based on temporal hours
  1009. # https://de.wikipedia.org/wiki/Temporale_Stunden
  1010. sub GetDaytime(;$$$$) {
  1011. my ( $time, $totalTemporalHours, $lang, $params ) = @_;
  1012. $lang = (
  1013. $main::attr{global}{language}
  1014. ? $main::attr{global}{language}
  1015. : "EN"
  1016. ) unless ($lang);
  1017. my $ret = ref($time) eq "HASH" ? $time : _time( $time, $lang, 1, $params );
  1018. return undef unless ( ref($ret) eq "HASH" );
  1019. $ret->{daytimeStages} = $totalTemporalHours
  1020. && $totalTemporalHours =~ m/^\d+$/ ? $totalTemporalHours : 12;
  1021. # TODO: consider srParams
  1022. $ret->{sunrise} = main::sunrise_abs_dat( $ret->{time_t} );
  1023. $ret->{sunrise_s} = hms2s( $ret->{sunrise} );
  1024. $ret->{sunrise_t} = $ret->{midnight_t} + $ret->{sunrise_s};
  1025. $ret->{sunset} = main::sunset_abs_dat( $ret->{time_t} );
  1026. $ret->{sunset_s} = hms2s( $ret->{sunset} );
  1027. $ret->{sunset_t} = $ret->{midnight_t} + $ret->{sunset_s};
  1028. $ret->{isday} = $ret->{time_t} >= $ret->{sunrise_t}
  1029. && $ret->{time_t} < $ret->{sunset_t} ? 1 : 0;
  1030. $ret->{daytimeRel_s} =
  1031. hms2s("$ret->{hour}:$ret->{min}:$ret->{sec}") - $ret->{sunrise_s};
  1032. $ret->{daytimeRel} = s2hms( $ret->{daytimeRel_s} );
  1033. $ret->{daytimeT_s} = $ret->{sunset_s} - $ret->{sunrise_s};
  1034. $ret->{daytimeT} = s2hms( $ret->{daytimeT_s} );
  1035. $ret->{daytimeStageLn_s} =
  1036. $ret->{daytimeT_s} / $ret->{daytimeStages};
  1037. $ret->{daytimeStageLn} = s2hms( $ret->{daytimeStageLn_s} );
  1038. $ret->{daytimeStage_float} =
  1039. $ret->{daytimeRel_s} / $ret->{daytimeStageLn_s};
  1040. $ret->{daytimeStage} =
  1041. int( ( ( $ret->{daytimeRel_s} + 1 ) / $ret->{daytimeStageLn_s} ) + 1 );
  1042. $ret->{daytimeStage} = 0
  1043. if ( $ret->{daytimeStage} < 1
  1044. || $ret->{daytimeStage} > $ret->{daytimeStages} );
  1045. # include season data
  1046. $ret = GetSeason( $ret, $lang );
  1047. #$ret = GetSeasonPheno( $ret, $lang );
  1048. #$ret = GetSeasonSocial( $ret, $lang ); #TODO https://de.wikipedia.org/wiki/F%C3%BCnfte_Jahreszeit
  1049. # change midnight event when season changes
  1050. $ret->{events}{ $ret->{midnight_t} }{VALUE} = 1
  1051. if ( $ret->{seasonMeteoChng} && $ret->{seasonMeteoChng} == 1 );
  1052. $ret->{events}{ $ret->{midnight_t} }{DESC} .=
  1053. ", Begin meteorological $ret->{seasonMeteo_long} season"
  1054. if ( $ret->{seasonMeteoChng} && $ret->{seasonMeteoChng} == 1 );
  1055. $ret->{events}{ $ret->{midnight_t} }{VALUE} = 2
  1056. if ( $ret->{seasonAstroChng} && $ret->{seasonAstroChng} == 1 );
  1057. $ret->{events}{ $ret->{midnight_t} }{DESC} .=
  1058. ", Begin astronomical $ret->{seasonAstro_long} season"
  1059. if ( $ret->{seasonAstroChng} && $ret->{seasonAstroChng} == 1 );
  1060. # calculate daytime from daytimeStage, season and DST
  1061. my $ds = $ret->{daytimeStage};
  1062. while ( !defined( $ret->{daytime} ) ) {
  1063. #TODO let user define %sdt2daytimes through attribute
  1064. $ret->{daytime} =
  1065. $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }{$ds}
  1066. if (
  1067. $sdt2daytimes{ $ret->{seasonMeteo} }
  1068. && $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }
  1069. && defined(
  1070. $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }{$ds}
  1071. )
  1072. );
  1073. $ds--;
  1074. # when no relation was found
  1075. unless ( defined( $ret->{daytime} ) || $ds > -1 ) {
  1076. # assume midevening after sunset
  1077. if ( $ret->{time_s} >= $ret->{sunset_s} ) {
  1078. $ret->{daytime} = 5;
  1079. }
  1080. # assume night before sunrise
  1081. else {
  1082. $ret->{daytime} = 6;
  1083. }
  1084. }
  1085. }
  1086. # daytime during evening and night
  1087. unless ( $ret->{daytimeStage} ) {
  1088. $ret->{daytime} = 4 unless ( $ret->{daytime} > 4 );
  1089. $ret->{daytime} = 5 unless ( $ret->{daytime} > 5 || $ret->{isday} );
  1090. $ret->{daytime} = 6 if ( $ret->{time_s} < $ret->{sunrise_s} );
  1091. }
  1092. $ret->{daytime_long} = $daytimes{en}[ $ret->{daytime} ];
  1093. my @langs = ('EN');
  1094. push @langs, $lang unless ( $lang =~ /^EN/i );
  1095. foreach (@langs) {
  1096. my $l = lc($_);
  1097. $l =~ s/^([a-z]+).*/$1/g;
  1098. next unless ( $daytimes{$l} );
  1099. my $h = $l eq "en" ? $ret : \%{ $ret->{$_} };
  1100. $h->{daytime_long} = $daytimes{$l}[ $ret->{daytime} ];
  1101. }
  1102. # calculate daily schedule
  1103. #
  1104. # Midnight
  1105. $ret->{events}{ $ret->{midnight_t} }{TYPE} = "dayshift";
  1106. $ret->{events}{ $ret->{midnight_t} }{TIME} =
  1107. main::FmtDateTime( $ret->{midnight_t} );
  1108. $ret->{events}{ $ret->{midnight_t} }{DESC} =
  1109. "Begin of night time and new calendar day";
  1110. $ret->{events}{ $ret->{1}{midnight_t} }{TYPE} = "dayshift";
  1111. $ret->{events}{ $ret->{1}{midnight_t} }{TIME} = $ret->{date} . " 24:00:00";
  1112. $ret->{events}{ $ret->{1}{midnight_t} }{DESC} =
  1113. "End of calendar day and begin night time";
  1114. # Holidays
  1115. $ret->{events}{ $ret->{midnight_t} }{DESC} .=
  1116. ", $daystages{en}[2]: $ret->{day_desc}"
  1117. if ( $ret->{isholiday} );
  1118. $ret->{events}{ $ret->{1}{midnight_t} }{DESC} .=
  1119. ", $daystages{en}[2]: $ret->{1}{day_desc}"
  1120. if ( $ret->{1}{isholiday} );
  1121. # DST change
  1122. #FIXME TODO
  1123. if ( $ret->{dstchange} && $ret->{dstchange} == 1 ) {
  1124. my $t = $ret->{midnight_t} + 2 * 60 * 60;
  1125. $ret->{events}{$t}{TYPE} = "dstshift";
  1126. $ret->{events}{$t}{VALUE} = $ret->{isdst};
  1127. $ret->{events}{$t}{TIME} = main::FmtDateTime($t);
  1128. $ret->{events}{$t}{DESC} = "Begin of standard time (-1h)"
  1129. unless ( $ret->{isdst} );
  1130. $ret->{events}{$t}{DESC} = "Begin of daylight saving time (+1h)"
  1131. if ( $ret->{isdst} );
  1132. }
  1133. # daytime stage event forecast for today
  1134. my $i = 1;
  1135. my $b = $ret->{sunrise_t};
  1136. while ( $i <= $ret->{daytimeStages} + 1 ) {
  1137. # find daytime
  1138. my $daytime;
  1139. $daytime = $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }{$i}
  1140. if (
  1141. $sdt2daytimes{ $ret->{seasonMeteo} }
  1142. && $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }
  1143. && defined(
  1144. $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }{$i}
  1145. )
  1146. );
  1147. # create event
  1148. my $t = int( $b + 0.5 );
  1149. $ret->{events}{$t}{TIME} = main::FmtDateTime($t);
  1150. if ( $i == $ret->{daytimeStages} + 1 ) {
  1151. $ret->{events}{$t}{TYPE} = "daytime";
  1152. $ret->{events}{$t}{VALUE} = "midevening";
  1153. $ret->{events}{$t}{DESC} =
  1154. "End of daytime";
  1155. }
  1156. else {
  1157. $ret->{events}{$t}{TYPE} = "daytimeStage";
  1158. $ret->{events}{$t}{VALUE} = $i;
  1159. $ret->{events}{$t}{DESC} = "Begin of daytime stage $i"
  1160. unless ($daytime);
  1161. if ( defined($daytime) ) {
  1162. $ret->{events}{$t}{TYPE} = "daytime";
  1163. $ret->{events}{$t}{VALUE} = $daytimes{en}[$daytime];
  1164. $ret->{events}{$t}{DESC} =
  1165. "Begin of $daytimes{en}[$daytime] time and daytime stage $i";
  1166. }
  1167. }
  1168. $i++;
  1169. $b += $ret->{daytimeStageLn_s};
  1170. }
  1171. return $ret;
  1172. }
  1173. sub GetSeason (;$$$);
  1174. sub GetSeason (;$$$) {
  1175. my ( $time, $lang, $meteo ) = @_;
  1176. $lang = (
  1177. $main::attr{global}{language}
  1178. ? $main::attr{global}{language}
  1179. : "EN"
  1180. ) unless ($lang);
  1181. my $ret;
  1182. my $wanthash = 0;
  1183. if ( !$time ) {
  1184. $time = time;
  1185. }
  1186. elsif ( ref($time) eq "HASH" ) {
  1187. $ret = $time;
  1188. $wanthash = 1;
  1189. }
  1190. elsif ( $time =~ /^(?:0|1|2|3)$/ ) {
  1191. return $seasons{ lc($lang) }
  1192. ? $seasons{ lc($lang) }[$time]
  1193. : $seasons{en}[$time];
  1194. }
  1195. elsif ( $time =~ /[A-Za-z]/ ) {
  1196. my $index =
  1197. $seasons{ lc($lang) }
  1198. ? _GetIndexFromArray( $time, $seasons{ lc($lang) } )
  1199. : undef;
  1200. return $index;
  1201. }
  1202. elsif ( $time !~ /^\d{10}(?:\.\d+)?$/ ) {
  1203. return undef;
  1204. }
  1205. else {
  1206. $ret = _time($time);
  1207. }
  1208. my $index = 0;
  1209. $index = 3 if ( $ret->{mon} <= 1 );
  1210. $index++ if ( $ret->{mon} >= 5 );
  1211. $index++ if ( $ret->{mon} >= 8 );
  1212. $index++ if ( $ret->{mon} == 11 );
  1213. $ret->{seasonMeteo} = $index;
  1214. $index = 0;
  1215. $index = 3 if ( $ret->{yday} < ( 80 + $ret->{isly} ) );
  1216. $index++ if ( $ret->{yday} >= ( 173 + $ret->{isly} ) );
  1217. $index++ if ( $ret->{yday} >= ( 265 + $ret->{isly} ) );
  1218. $index++ if ( $ret->{yday} >= ( 356 + $ret->{isly} ) );
  1219. $ret->{seasonAstro} = $index;
  1220. unless (wantarray) {
  1221. ( $ret->{'-1'}{seasonMeteo}, $ret->{'-1'}{seasonAstro} ) =
  1222. GetSeason( $ret->{'-1'}{time_t}, $lang );
  1223. ( $ret->{1}{seasonMeteo}, $ret->{1}{seasonAstro} ) =
  1224. GetSeason( $ret->{1}{time_t}, $lang );
  1225. }
  1226. # text strings
  1227. my @langs = ('EN');
  1228. push @langs, $lang unless ( $lang =~ /^EN/i );
  1229. foreach (@langs) {
  1230. my $l = lc($_);
  1231. $l =~ s/^([a-z]+).*/$1/g;
  1232. next unless ( $seasons{$l} );
  1233. my $h = $l eq "en" ? $ret : \%{ $ret->{$_} };
  1234. $h->{seasonMeteo_long} = $seasons{$l}[ $ret->{seasonMeteo} ];
  1235. $h->{seasonAstro_long} = $seasons{$l}[ $ret->{seasonAstro} ];
  1236. }
  1237. if ( $ret->{seasonMeteo} ne $ret->{1}{seasonMeteo} ) {
  1238. $ret->{seasonMeteoChng} = 2;
  1239. }
  1240. if ( $ret->{'-1'}
  1241. && defined( $ret->{'-1'}{seasonMeteo} )
  1242. && defined( $ret->{'-1'}{seasonAstro} )
  1243. && $ret->{1}
  1244. && defined( $ret->{1}{seasonMeteo} )
  1245. && defined( $ret->{1}{seasonAstro} ) )
  1246. {
  1247. $ret->{'-1'}{seasonMeteoChng} = 0;
  1248. $ret->{seasonMeteoChng} = 0;
  1249. $ret->{1}{seasonMeteoChng} = 0;
  1250. if ( $ret->{seasonMeteo} ne $ret->{1}{seasonMeteo} ) {
  1251. $ret->{seasonMeteoChng} = 2;
  1252. $ret->{1}{seasonMeteoChng} = 1;
  1253. }
  1254. elsif ( $ret->{seasonMeteo} ne $ret->{'-1'}{seasonMeteo} ) {
  1255. $ret->{'-1'}{seasonMeteoChng} = 2;
  1256. $ret->{seasonMeteoChng} = 1;
  1257. }
  1258. $ret->{'-1'}{seasonAstroChng} = 0;
  1259. $ret->{seasonAstroChng} = 0;
  1260. $ret->{1}{seasonAstroChng} = 0;
  1261. if ( $ret->{seasonAstro} ne $ret->{1}{seasonAstro} ) {
  1262. $ret->{seasonAstroChng} = 2;
  1263. $ret->{1}{seasonAstroChng} = 1;
  1264. }
  1265. elsif ( $ret->{seasonAstro} ne $ret->{'-1'}{seasonAstro} ) {
  1266. $ret->{'-1'}{seasonAstroChng} = 2;
  1267. $ret->{seasonAstroChng} = 1;
  1268. }
  1269. }
  1270. return $ret if ($wanthash);
  1271. return ( $ret->{seasonMeteo}, $ret->{seasonAstro} ) if (wantarray);
  1272. return $ret->{$lang}{seasonMeteo_long}
  1273. ? $ret->{$lang}{seasonMeteo_long}
  1274. : $ret->{seasonMeteo_long}
  1275. if ($meteo);
  1276. return $ret->{$lang}{seasonAstro_long}
  1277. ? $ret->{$lang}{seasonAstro_long}
  1278. : $ret->{seasonAstro_long};
  1279. }
  1280. # Estimate phenologic season from astro and meteo season
  1281. # https://de.wikipedia.org/wiki/Ph%C3%A4nologie#Ph.C3.A4nologischer_Kalender
  1282. sub GetSeasonPheno (;$$) {
  1283. $lang = (
  1284. $main::attr{global}{language}
  1285. ? $main::attr{global}{language}
  1286. : "EN"
  1287. ) unless ($lang);
  1288. if ( !$time ) {
  1289. $time = time;
  1290. }
  1291. elsif ( $time =~ /^(?:0|1|2|3|4|5|6|7|8|9|10|11)$/ ) {
  1292. return $seasonsPheno{ lc($lang) }
  1293. ? $seasonsPheno{ lc($lang) }[$time]
  1294. : $seasonsPheno{en}[$time];
  1295. }
  1296. elsif ( $time =~ /[A-Za-z]/ ) {
  1297. my $index =
  1298. $seasonsPheno{ lc($lang) }
  1299. ? _GetIndexFromArray( $time, $seasonsPheno{ lc($lang) } )
  1300. : undef;
  1301. return $index;
  1302. }
  1303. elsif ( $time !~ /^\d{10}(?:\.\d+)?$/ ) {
  1304. return undef;
  1305. }
  1306. my (
  1307. $sec, $min, $hour,
  1308. $mday, $mdayrem, $month,
  1309. $monthISO, $year, $week,
  1310. $weekISO, $wday, $wdayISO,
  1311. $yday, $ydayrem, $isdst,
  1312. $isLeapYear, $iswe, $isHolidayYesterday,
  1313. $isHolidayToday, $isHolidayTomorrow
  1314. ) = GetDaySchedule($time);
  1315. my ( $seasonAstro, $seasonAstroIndex, $seasonAstroChng ) = GetSeason($time);
  1316. my ( $seasonMeteo, $seasonMeteoIndex, $seasonMeteoChng ) =
  1317. GetSeason( $time, "en", 1 );
  1318. # stick to astro season first
  1319. my $index = $seasons{pheno}[$seasonAstro];
  1320. # meteos say it's spring time
  1321. if ( $seasonMeteo == 0 ) {
  1322. $index = 0;
  1323. }
  1324. # meteos say it's summer time
  1325. elsif ( $seasonMeteo == 1 ) {
  1326. $index = 3;
  1327. }
  1328. # meteos say it's autumn time
  1329. elsif ( $seasonMeteo == 2 ) {
  1330. $index = 6;
  1331. }
  1332. # meteos say it's winter time
  1333. elsif ( $seasonMeteo == 3 ) {
  1334. $index = 9;
  1335. }
  1336. # if we know our position and spring is ahead
  1337. if ( ( $index == 0 || $index == 1 )
  1338. && $main::attr{global}{latitude}
  1339. && $main::attr{global}{longitude} )
  1340. {
  1341. # it starts in south-west Portugal
  1342. my $dist = distance(
  1343. $main::attr{global}{latitude},
  1344. $main::attr{global}{longitude},
  1345. 37.136633, -8.817837
  1346. );
  1347. # TODO: let begin of early spring be set by user
  1348. my $earlySpringBegin = main::time_str2num("$year-02-28 00:00:00");
  1349. my $days = ( $time - $earlySpringBegin ) / ( 60 * 60 * 24 );
  1350. # comes with 40km per day
  1351. my $currDist = $dist - ( $days * 40 );
  1352. # when season reached location
  1353. if ( $currDist <= 0 ) {
  1354. $index = 2;
  1355. }
  1356. # when season made 60% of it's way
  1357. elsif ( $currDist <= $dist * 0.4 ) {
  1358. $index = 1;
  1359. }
  1360. }
  1361. # assume spring progress from calendar
  1362. elsif ( ( $index == 0 || $index == 1 ) ) {
  1363. $index = 1 if ( $monthISO == 4 );
  1364. $index = 2 if ( $monthISO == 5 );
  1365. }
  1366. # assume summer progress from calendar
  1367. elsif ( $index == 3 ) {
  1368. $index = 4 if ( $monthISO == 7 );
  1369. $index = 5 if ( $monthISO == 8 );
  1370. }
  1371. # if we know our position and autumn is ahead
  1372. elsif (( $index == 6 || $index == 7 )
  1373. && $main::attr{global}{latitude}
  1374. && $main::attr{global}{longitude} )
  1375. {
  1376. # it starts in Helsinki
  1377. my $dist = distance(
  1378. $main::attr{global}{latitude},
  1379. $main::attr{global}{longitude},
  1380. 60.161880, 24.937267
  1381. );
  1382. # TODO: let begin of early autumn be set by user
  1383. my $earlySpringBegin = main::time_str2num("$year-09-01 00:00:00");
  1384. my $days = ( $time - $earlySpringBegin ) / ( 60 * 60 * 24 );
  1385. # comes with 40km per day
  1386. my $currDist = $dist - ( $days * 40 );
  1387. # when season reached location
  1388. if ( $currDist <= 0 ) {
  1389. $index = 8;
  1390. }
  1391. # when season made 60% of it's way
  1392. elsif ( $currDist <= $dist * 0.4 ) {
  1393. $index = 7;
  1394. }
  1395. }
  1396. # assume autumn progress from calendar
  1397. elsif ( ( $index == 6 || $index == 7 ) ) {
  1398. $index = 7 if ( $monthISO == 10 );
  1399. $index = 8 if ( $monthISO == 11 );
  1400. }
  1401. my $seasonPheno =
  1402. defined($index)
  1403. && $index{ lc($lang) }
  1404. ? $seasonsPheno{ lc($lang) }[$index]
  1405. : $seasonsPheno{en}[$index];
  1406. return ( $seasonPheno, $index ) if (wantarray);
  1407. return ($seasonPheno);
  1408. }
  1409. ####################
  1410. # HELPER FUNCTIONS
  1411. sub decimal_mark ($$) {
  1412. my ( $val, $f ) = @_;
  1413. return $val unless ( looks_like_number($val) && $f );
  1414. my $text = reverse $val;
  1415. if ( $f eq "2" ) {
  1416. $text =~ s:\.:,:g;
  1417. $text =~ s/(\d\d\d)(?=\d)(?!\d*,)/$1./g;
  1418. }
  1419. else {
  1420. $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
  1421. }
  1422. return scalar reverse $text;
  1423. }
  1424. sub _round($;$) {
  1425. my ( $val, $n ) = @_;
  1426. $n = 1 unless ( defined($n) );
  1427. return sprintf( "%.${n}f", $val );
  1428. }
  1429. sub _time(;$$$$);
  1430. sub _time(;$$$$) {
  1431. my ( $time, $lang, $dayOffset, $params ) = @_;
  1432. $dayOffset = 1 if ( !defined($dayOffset) || $dayOffset !~ /^-?\d+$/ );
  1433. $lang = (
  1434. $main::attr{global}{language}
  1435. ? $main::attr{global}{language}
  1436. : "EN"
  1437. ) unless ($lang);
  1438. return undef
  1439. unless ( !$time || $time =~ /^\d{10}(?:\.\d+)?$/ );
  1440. my %ret;
  1441. $ret{time_t} = $time if ($time);
  1442. $ret{time_t} = time unless ($time);
  1443. $ret{params} = $params if ($params);
  1444. my @t = localtime( $ret{time_t} );
  1445. (
  1446. $ret{sec}, $ret{min}, $ret{hour}, $ret{mday}, $ret{mon},
  1447. $ret{year}, $ret{wday}, $ret{yday}, $ret{isdst}
  1448. ) = @t;
  1449. $ret{monISO} = $ret{mon} + 1;
  1450. $ret{year} += 1900;
  1451. $ret{date} =
  1452. sprintf( "%04d-%02d-%02d", $ret{year}, $ret{monISO}, $ret{mday} );
  1453. $ret{time} = sprintf( "%02d:%02d", $ret{hour}, $ret{min} );
  1454. $ret{time_hms} =
  1455. sprintf( "%02d:%02d:%02d", $ret{hour}, $ret{min}, $ret{sec} );
  1456. $ret{time_s} = hms2s( $ret{time_hms} ); #FIXME for DST change
  1457. $ret{datetime} = $ret{date} . " " . $ret{time_hms};
  1458. $ret{midnight_t} = $ret{time_t} - $ret{time_s}; #FIXME for DST change
  1459. # get leap year status
  1460. $ret{isly} = IsLeapYear( $ret{year} );
  1461. # remaining monthdays
  1462. $ret{mdayrem} = 0;
  1463. $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 1 );
  1464. $ret{mdayrem} = 28 + $ret{isly} - $ret{mday}
  1465. if ( $ret{monISO} == 2 );
  1466. $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 3 );
  1467. $ret{mdayrem} = 30 - $ret{mday} if ( $ret{monISO} == 4 );
  1468. $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 5 );
  1469. $ret{mdayrem} = 30 - $ret{mday} if ( $ret{monISO} == 6 );
  1470. $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 7 );
  1471. $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 8 );
  1472. $ret{mdayrem} = 30 - $ret{mday} if ( $ret{monISO} == 9 );
  1473. $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 10 );
  1474. $ret{mdayrem} = 30 - $ret{mday} if ( $ret{monISO} == 11 );
  1475. $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 12 );
  1476. # remaining yeardays
  1477. $ret{ydayrem} = 365 + $ret{isly} - $ret{yday};
  1478. # ISO 8601 weekday as number with Monday as 1 (1-7)
  1479. $ret{wdaynISO} = strftime( '%u', @t );
  1480. # Week number with the first Sunday as the first day of week one (00-53)
  1481. $ret{week} = strftime( '%U', @t );
  1482. # ISO 8601 week number (00-53)
  1483. $ret{weekISO} = strftime( '%V', @t );
  1484. # weekend
  1485. $ret{iswe} = ( $ret{wday} == 0 || $ret{wday} == 6 ) ? 1 : 0;
  1486. # text strings
  1487. my @langs = ('EN');
  1488. push @langs, $lang unless ( $lang =~ /^EN/i );
  1489. foreach (@langs) {
  1490. my $l = lc($_);
  1491. $l =~ s/^([a-z]+).*/$1/g;
  1492. next unless ( $months{$l} );
  1493. my $h = $l eq "en" ? \%ret : \%{ $ret{$_} };
  1494. $h->{dst_long} = $dst{$l}[ $ret{isdst} ];
  1495. $h->{rday_long} = $reldays{$l}[1];
  1496. $h->{day_desc} = $daystages{$l}[ $ret{iswe} ];
  1497. $h->{wday_long} = $days{$l}[ $ret{wday} ];
  1498. $h->{wday_short} = $dayss{$l}[ $ret{wday} ];
  1499. $h->{mon_long} = $months{$l}[ $ret{mon} ];
  1500. $h->{mon_short} = $monthss{$l}[ $ret{mon} ];
  1501. $h->{date_long} =
  1502. _ReplaceStringByHashKey( \%ret, $dateformats{$l}, $_ );
  1503. $h->{date_short} =
  1504. _ReplaceStringByHashKey( \%ret, $dateformatss{$l}, $_ );
  1505. }
  1506. # holiday
  1507. if ($dayOffset) {
  1508. $ret{'-1'}{isholiday} = 0;
  1509. $ret{1}{isholiday} = 0;
  1510. }
  1511. $ret{isholiday} = 0;
  1512. my $holidayDev =
  1513. $main::attr{global}{holiday2we}
  1514. && main::IsDevice( $main::attr{global}{holiday2we}, "holiday" )
  1515. ? $main::attr{global}{holiday2we}
  1516. : undef;
  1517. if ($holidayDev) {
  1518. my $date = sprintf( "%02d-%02d", $ret{monISO}, $ret{mday} );
  1519. $tod = main::holiday_refresh( $holidayDev, $date );
  1520. if ($dayOffset) {
  1521. $date =
  1522. sprintf( "%02d-%02d", $ret{'-1'}{monISO}, $ret{'-1'}{mday} );
  1523. $ytd = main::holiday_refresh( $holidayDev, $date );
  1524. $date = sprintf( "%02d-%02d", $ret{1}{monISO}, $ret{1}{mday} );
  1525. $tom = main::holiday_refresh( $holidayDev, $date );
  1526. }
  1527. if ( $tod ne "none" ) {
  1528. $ret{iswe} += 2;
  1529. $ret{isholiday} = 1;
  1530. $ret{day_desc} = $tod;
  1531. foreach (@langs) {
  1532. my $l = lc($_);
  1533. $l =~ s/^([a-z]+).*/$1/g;
  1534. next unless ( $months{$l} );
  1535. my $h = $l eq "en" ? \%ret : \%{ $ret{$_} };
  1536. $h->{day_desc} = $tod;
  1537. }
  1538. }
  1539. if ($dayOffset) {
  1540. if ( $ytd ne "none" && $ret{'-1'} ) {
  1541. $ret{'-1'}{isholiday} = 1;
  1542. $ret{'-1'}{day_desc} = $ytd;
  1543. foreach (@langs) {
  1544. my $l = lc($_);
  1545. $l =~ s/^([a-z]+).*/$1/g;
  1546. next unless ( $months{$l} );
  1547. my $h = $l eq "en" ? $ret{'-1'} : \%{ $ret{'-1'}{$_} };
  1548. $h->{day_desc} = $ytd;
  1549. }
  1550. }
  1551. if ( $tom ne "none" && $ret{1} ) {
  1552. $ret{1}{isholiday} = 1;
  1553. $ret{1}{day_desc} = $tom;
  1554. foreach (@langs) {
  1555. my $l = lc($_);
  1556. $l =~ s/^([a-z]+).*/$1/g;
  1557. next unless ( $months{$l} );
  1558. my $h = $l eq "en" ? $ret{1} : \%{ $ret{1}{$_} };
  1559. $h->{day_desc} = $tom;
  1560. }
  1561. }
  1562. }
  1563. }
  1564. if (wantarray) {
  1565. my @a;
  1566. foreach (
  1567. 'sec', 'min', 'hour', 'mday', 'mon',
  1568. 'year', 'wday', 'wdayn', 'yday', 'isdst',
  1569. 'mdayrem', 'monISO', 'week', 'weekISO', 'wdayISO',
  1570. 'wdaynISO', 'ydayrem', 'time_t', 'datetime', 'date',
  1571. 'time_hms', 'time', 'isly',
  1572. )
  1573. {
  1574. push @a, $ret{$_};
  1575. }
  1576. return @a;
  1577. }
  1578. elsif ($dayOffset) {
  1579. my $i = $dayOffset * -1;
  1580. while ( $i < $dayOffset + 1 ) {
  1581. $ret{$i} = _time( $ret{time_t} + ( 24 * 60 * 60 * $i ), $lang, 0 )
  1582. unless ( $i == 0 );
  1583. foreach (@langs) {
  1584. my $l = $_;
  1585. $l =~ s/^([A-Z-a-z]+).*/$1/g;
  1586. $l = lc($l);
  1587. next if ( $i == 0 || !$reldays{$l} );
  1588. my $h = $l eq "en" ? \%{ $ret{$i} } : \%{ $ret{$i}{$l} };
  1589. if ( $i == -1 || $i == 1 ) {
  1590. $h->{rday_long} = $reldays{$l}[ $i + 1 ];
  1591. }
  1592. else {
  1593. delete $h->{rday_long};
  1594. }
  1595. }
  1596. $i++;
  1597. }
  1598. # DST change
  1599. $ret{'-1'}{dstchange} = 0;
  1600. $ret{dstchange} = 0;
  1601. $ret{1}{dstchange} = 0;
  1602. if ( $ret{isdst} ne $ret{1}{isdst} ) {
  1603. $ret{dstchange} = 2;
  1604. $ret{1}{dstchange} = 1;
  1605. }
  1606. elsif ( $ret{isdst} ne $ret{'-1'}{isdst} ) {
  1607. $ret{'-1'}{dstchange} = 2;
  1608. $ret{dstchange} = 1;
  1609. }
  1610. }
  1611. return \%ret;
  1612. }
  1613. sub _GetIndexFromArray($$) {
  1614. my ( $string, $array ) = @_;
  1615. return undef unless ( ref($array) eq "ARRAY" );
  1616. my ($index) = grep { $array->[$_] =~ /^$string$/i } ( 0 .. @$array - 1 );
  1617. return defined $index ? $index : undef;
  1618. }
  1619. sub _ReplaceStringByHashKey($$;$) {
  1620. my ( $hash, $string, $sublvl ) = @_;
  1621. return $string unless ( $hash && ref($hash) eq "HASH" );
  1622. $string = _ReplaceStringByHashKey( $hash->{$sublvl}, $string )
  1623. if ( $sublvl && $hash->{$sublvl} );
  1624. foreach my $key ( keys %{$hash} ) {
  1625. next if ( ref( $hash->{$key} ) );
  1626. my $val = $hash->{$key};
  1627. $string =~ s/%$key%/$val/gi;
  1628. $string =~ s/\$$key/$val/g;
  1629. }
  1630. return $string;
  1631. }
  1632. 1;