UConv.pm 48 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864
  1. ###############################################################################
  2. # $Id: UConv.pm 14398 2017-05-28 09:40:42Z 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 km/h to knots
  493. sub kph2kn($;$) {
  494. my ( $data, $rnd ) = @_;
  495. return _round( $data * 0.539956803456, $rnd );
  496. }
  497. # Speed: convert km/h to Beaufort wind force scale
  498. sub kph2bft($) {
  499. my ($data) = @_;
  500. my $val = "0";
  501. if ( $data >= 118 ) {
  502. $val = "12";
  503. }
  504. elsif ( $data >= 103 ) {
  505. $val = "11";
  506. }
  507. elsif ( $data >= 89 ) {
  508. $val = "10";
  509. }
  510. elsif ( $data >= 75 ) {
  511. $val = "9";
  512. }
  513. elsif ( $data >= 62 ) {
  514. $val = "8";
  515. }
  516. elsif ( $data >= 50 ) {
  517. $val = "7";
  518. }
  519. elsif ( $data >= 39 ) {
  520. $val = "6";
  521. }
  522. elsif ( $data >= 29 ) {
  523. $val = "5";
  524. }
  525. elsif ( $data >= 20 ) {
  526. $val = "4";
  527. }
  528. elsif ( $data >= 12 ) {
  529. $val = "3";
  530. }
  531. elsif ( $data >= 6 ) {
  532. $val = "2";
  533. }
  534. elsif ( $data >= 1 ) {
  535. $val = "1";
  536. }
  537. if (wantarray) {
  538. my ( $cond, $rgb, $warn ) = bft2condition($val);
  539. return ( $val, $rgb, $cond, $warn );
  540. }
  541. return $val;
  542. }
  543. # Speed: convert mph (miles per hour) to Beaufort wind force scale
  544. sub mph2bft($) {
  545. my ($data) = @_;
  546. my $val = "0";
  547. if ( $data >= 73 ) {
  548. $val = "12";
  549. }
  550. elsif ( $data >= 64 ) {
  551. $val = "11";
  552. }
  553. elsif ( $data >= 55 ) {
  554. $val = "10";
  555. }
  556. elsif ( $data >= 47 ) {
  557. $val = "9";
  558. }
  559. elsif ( $data >= 39 ) {
  560. $val = "8";
  561. }
  562. elsif ( $data >= 32 ) {
  563. $val = "7";
  564. }
  565. elsif ( $data >= 25 ) {
  566. $val = "6";
  567. }
  568. elsif ( $data >= 19 ) {
  569. $val = "5";
  570. }
  571. elsif ( $data >= 13 ) {
  572. $val = "4";
  573. }
  574. elsif ( $data >= 8 ) {
  575. $val = "3";
  576. }
  577. elsif ( $data >= 4 ) {
  578. $val = "2";
  579. }
  580. elsif ( $data >= 1 ) {
  581. $val = "1";
  582. }
  583. if (wantarray) {
  584. my ( $cond, $rgb, $warn ) = bft2condition($val);
  585. return ( $val, $rgb, $cond, $warn );
  586. }
  587. return $val;
  588. }
  589. #################################
  590. ### Differential conversions
  591. ###
  592. sub distance($$$$;$) {
  593. my ( $lat1, $lng1, $lat2, $lng2, $miles ) = @_;
  594. use constant M_PI => 4 * atan2( 1, 1 );
  595. my $pi80 = M_PI / 180;
  596. $lat1 *= $pi80;
  597. $lng1 *= $pi80;
  598. $lat2 *= $pi80;
  599. $lng2 *= $pi80;
  600. my $r = 6372.797; # mean radius of Earth in km
  601. my $dlat = $lat2 - $lat1;
  602. my $dlng = $lng2 - $lng1;
  603. my $a =
  604. sin( $dlat / 2 ) * sin( $dlat / 2 ) +
  605. cos($lat1) * cos($lat2) * sin( $dlng / 2 ) * sin( $dlng / 2 );
  606. my $c = 2 * atan2( sqrt($a), sqrt( 1 - $a ) );
  607. my $km = $r * $c;
  608. return ( $miles ? km2mi($km) : $km );
  609. }
  610. #################################
  611. ### Textual unit conversions
  612. ###
  613. ######## humanReadable #########################################
  614. # What : Formats a number or text string to be more readable for humans
  615. # Syntax: { humanReadable( <value>, [ <format> ] ) }
  616. # Call : { humanReadable(102345.6789) }
  617. # { humanReadable(102345.6789, 3) }
  618. # { humanReadable(102345.6789, "DE") }
  619. # { humanReadable(102345.6789, "si-fr") }
  620. # { humanReadable(102345.6789, {
  621. # group=>3, delim=>".", sep=>"," } ) }
  622. # { humanReadable("DE44500105175407324931", {
  623. # group=>4, rev=>0 } ) }
  624. # Source: https://en.wikipedia.org/wiki/Decimal_mark
  625. # https://de.wikipedia.org/wiki/Schreibweise_von_Zahlen
  626. # https://de.wikipedia.org/wiki/Dezimaltrennzeichen
  627. # https://de.wikipedia.org/wiki/Zifferngruppierung
  628. sub humanReadable($;$) {
  629. my ( $v, $f ) = @_;
  630. my $l =
  631. $main::attr{global}{humanReadable} ? $main::attr{global}{humanReadable}
  632. : (
  633. $main::attr{global}{language} ? $main::attr{global}{language}
  634. : "EN"
  635. );
  636. my $h =
  637. !$f || ref($f) || !$hr_formats{$f} ? $f
  638. : (
  639. $hr_formats{$f}{ref} ? $hr_formats{ $hr_formats{$f}{ref} }
  640. : $hr_formats{$f}
  641. );
  642. my $min =
  643. ref($h)
  644. && defined( $h->{min} )
  645. ? $h->{min}
  646. : ( !ref($f) && $hr_formats{$f}{min} ? $hr_formats{$f}{min} : 5 );
  647. my $group =
  648. ref($h)
  649. && defined( $h->{group} )
  650. ? $h->{group}
  651. : ( !ref($f) && $hr_formats{$f}{group} ? $hr_formats{$f}{group} : 3 );
  652. my $delim =
  653. ref($h)
  654. && $h->{delim}
  655. ? $h->{delim}
  656. : $hr_formats{ ( $l =~ /^de|nl|fr|pl/i ? "std-fr" : "std" ) }{delim};
  657. my $sep =
  658. ref($h)
  659. && $h->{sep}
  660. ? $h->{sep}
  661. : $hr_formats{ ( $l =~ /^de|nl|fr|pl/i ? "std-fr" : "std" ) }{sep};
  662. my $reverse = ref($h) && defined( $h->{rev} ) ? $h->{rev} : 1;
  663. my @p = split( /\./, $v, 2 );
  664. if ( length( $p[0] ) < $min && length( $p[1] ) < $min ) {
  665. $v =~ s/\./$sep/g;
  666. return $v;
  667. }
  668. $v =~ s/\./\*/g;
  669. # digits after thousands separator
  670. if ( ( $delim eq "\x{202F}" || $delim eq " " )
  671. && length( $p[1] ) >= $min )
  672. {
  673. $v =~ s/(\w{$group})(?=\w)(?!\w*\*)/$1$delim/g;
  674. }
  675. # digits before thousands separator
  676. if ( length( $p[0] ) >= $min ) {
  677. $v = reverse $v if ($reverse);
  678. $v =~ s/(\w{$group})(?=\w)(?!\w*\*)/$1$delim/g;
  679. if ($reverse) {
  680. $v =~ s/\*/$sep/g;
  681. return scalar reverse $v;
  682. }
  683. }
  684. $v =~ s/\*/$sep/g;
  685. return $v;
  686. }
  687. # ######## machineReadable #########################################
  688. # # What : find the first matching number in a string and make it
  689. # # machine readable.
  690. # # Syntax: { machineReadable( <value>, [ <global>, [ <format> ]] ) }
  691. # # Call : { machineReadable("102 345,6789") }
  692. # sub machineReadable($;$) {
  693. # my ( $v, $g ) = @_;
  694. #
  695. # sub mrVal($$) {
  696. # my ( $n, $n2 ) = @_;
  697. # $n .= "." . $n2 if ($n2);
  698. # $n =~ s/[^\d\.]//g;
  699. # return $n;
  700. # }
  701. #
  702. #
  703. # foreach ( "std", "std-fr" ) {
  704. # my $delim = '\\' . $hr_formats{$_}{delim};
  705. # $delim .= ' ' if ($_ =~ /^std/);
  706. #
  707. # if ( $g
  708. # && $v =~
  709. # s/((-?)((?:\d+(?:[$delim]\d)*)+)([\.\,])((?:\d+(?:[$delim]\d)*)+)?)/$2.mrVal($3, $5)/eg
  710. # )
  711. # {
  712. # last;
  713. # }
  714. # elsif ( $v =~
  715. # m/^((\-?)((?:\d(?:[$delim]\d)*)+)(?:([\.\,])((?:\d(?:[$delim]\d)*)+))?)/ )
  716. # {
  717. # $v = $2 . mrVal( $3, $5 );
  718. # last;
  719. # }
  720. # }
  721. #
  722. # return $v;
  723. # }
  724. # Condition: convert temperature (Celsius) to temperature condition
  725. sub c2condition($;$) {
  726. my ( $data, $indoor ) = @_;
  727. my $val = "freeze";
  728. my $rgb = "0055BB";
  729. if ($indoor) {
  730. $data -= 5 if ( $data < 22.5 );
  731. $data += 5 if ( $data > 25 );
  732. }
  733. if ( $data >= 35 ) {
  734. $val = "hot";
  735. $rgb = "C72A23";
  736. }
  737. elsif ( $data >= 30 ) {
  738. $val = "high";
  739. $rgb = "E7652B";
  740. }
  741. elsif ( $data >= 14 ) {
  742. $val = "ideal";
  743. $rgb = "4C9329";
  744. }
  745. elsif ( $data >= 5 ) {
  746. $val = "low";
  747. $rgb = "009999";
  748. }
  749. elsif ( $data >= 2.5 || $indoor ) {
  750. $val = "cold";
  751. $rgb = "0066CC";
  752. }
  753. return ( $val, $rgb ) if (wantarray);
  754. return $val;
  755. }
  756. # Condition: convert humidity (percent) to humidity condition
  757. sub humidity2condition($;$) {
  758. my ( $data, $indoor ) = @_;
  759. my $val = "dry";
  760. my $rgb = "C72A23";
  761. if ( $data >= 80 ) {
  762. $val = "wet";
  763. $rgb = "0066CC";
  764. }
  765. elsif ( $data >= 70 ) {
  766. $val = "high";
  767. $rgb = "009999";
  768. }
  769. elsif ( $data >= 50 ) {
  770. $val = "ideal";
  771. $rgb = "4C9329";
  772. }
  773. elsif ( $data >= 40 ) {
  774. $val = "low";
  775. $rgb = "E7652B";
  776. }
  777. return ( $val, $rgb ) if (wantarray);
  778. return $val;
  779. }
  780. # Condition: convert UV-Index to UV condition
  781. sub uvi2condition($) {
  782. my ($data) = @_;
  783. my $val = "low";
  784. my $rgb = "4C9329";
  785. if ( $data > 11 ) {
  786. $val = "extreme";
  787. $rgb = "674BC4";
  788. }
  789. elsif ( $data > 8 ) {
  790. $val = "veryhigh";
  791. $rgb = "C72A23";
  792. }
  793. elsif ( $data > 6 ) {
  794. $val = "high";
  795. $rgb = "E7652B";
  796. }
  797. elsif ( $data > 3 ) {
  798. $val = "moderate";
  799. $rgb = "F4E54C";
  800. }
  801. return ( $val, $rgb ) if (wantarray);
  802. return $val;
  803. }
  804. # Condition: convert Beaufort to wind condition
  805. sub bft2condition($) {
  806. my ($data) = @_;
  807. my $rgb = "FEFEFE";
  808. my $cond = "calm";
  809. my $warn = " ";
  810. if ( $data == 12 ) {
  811. $rgb = "E93323";
  812. $cond = "hurricane_force";
  813. $warn = "hurricane_force";
  814. }
  815. elsif ( $data == 11 ) {
  816. $rgb = "EB4826";
  817. $cond = "violent_storm";
  818. $warn = "storm_force";
  819. }
  820. elsif ( $data == 10 ) {
  821. $rgb = "E96E2C";
  822. $cond = "storm";
  823. $warn = "storm_force";
  824. }
  825. elsif ( $data == 9 ) {
  826. $rgb = "F19E38";
  827. $cond = "strong_gale";
  828. $warn = "gale_force";
  829. }
  830. elsif ( $data == 8 ) {
  831. $rgb = "F7CE46";
  832. $cond = "gale";
  833. $warn = "gale_force";
  834. }
  835. elsif ( $data == 7 ) {
  836. $rgb = "FFFF54";
  837. $cond = "near_gale";
  838. $warn = "high_winds";
  839. }
  840. elsif ( $data == 6 ) {
  841. $rgb = "D6FD51";
  842. $cond = "strong_breeze";
  843. $warn = "high_winds";
  844. }
  845. elsif ( $data == 5 ) {
  846. $rgb = "B1FC4F";
  847. $cond = "fresh_breeze";
  848. }
  849. elsif ( $data == 4 ) {
  850. $rgb = "B1FC7B";
  851. $cond = "moderate_breeze";
  852. }
  853. elsif ( $data == 3 ) {
  854. $rgb = "B1FCA3";
  855. $cond = "gentle_breeze";
  856. }
  857. elsif ( $data == 2 ) {
  858. $rgb = "B1FCD0";
  859. $cond = "light_breeze";
  860. }
  861. elsif ( $data == 1 ) {
  862. $rgb = "D6FEFE";
  863. $cond = "light_air";
  864. }
  865. return ( $cond, $rgb, $warn ) if (wantarray);
  866. return $cond;
  867. }
  868. sub values2weathercondition($$$$$) {
  869. my ( $temp, $hum, $light, $isday, $israining ) = @_;
  870. my $val = "clear";
  871. if ($israining) {
  872. $val = "rain";
  873. }
  874. elsif ( $light > 40000 ) {
  875. $val = "sunny";
  876. }
  877. elsif ($isday) {
  878. $val = "cloudy";
  879. }
  880. $val = "nt_" . $val unless ($isday);
  881. return $val;
  882. }
  883. #################################
  884. ### Chronological conversions
  885. ###
  886. sub hms2s($) {
  887. my $in = shift;
  888. my @a = split( ":", $in );
  889. return 0 if ( scalar @a < 2 || $in !~ m/^[\d:]*$/ );
  890. return $a[0] * 3600 + $a[1] * 60 + ( $a[2] ? $a[2] : 0 );
  891. }
  892. sub hms2m($) {
  893. return hms2s(@_) / 60;
  894. }
  895. sub hms2h($) {
  896. return hms2m(@_) / 60;
  897. }
  898. sub s2hms($) {
  899. my ($in) = @_;
  900. my ( $h, $m, $s );
  901. $h = int( $in / 3600 );
  902. $m = int( ( $in - $h * 3600 ) / 60 );
  903. $s = int( $in - $h * 3600 - $m * 60 );
  904. return ( $h, $m, $s ) if (wantarray);
  905. return sprintf( "%02d:%02d:%02d", $h, $m, $s );
  906. }
  907. sub m2hms($) {
  908. my ($in) = @_;
  909. my ( $h, $m, $s );
  910. $h = int( $in / 60 );
  911. $m = int( $in - $h * 60 );
  912. $s = int( 60 * ( $in - $h * 60 - $m ) );
  913. return ( $h, $m, $s ) if (wantarray);
  914. return sprintf( "%02d:%02d:%02d", $h, $m, $s );
  915. }
  916. sub h2hms($) {
  917. my ($in) = @_;
  918. my ( $h, $m, $s );
  919. $h = int($in);
  920. $m = int( 60 * ( $in - $h ) );
  921. $s = int( 3600 * ( $in - $h ) - 60 * $m );
  922. return ( $h, $m, $s ) if (wantarray);
  923. return sprintf( "%02d:%02d:%02d", $h, $m, $s );
  924. }
  925. sub IsLeapYear (;$) {
  926. # Either the value 0 or the value 1 is returned.
  927. # If 0, it is not a leap year. If 1, it is a
  928. # leap year. (Works for Julian calendar,
  929. # established in 1582)
  930. my $y = shift;
  931. return undef
  932. unless ( !$y || $y =~ /^\d{10}(?:\.\d+)?$/ || $y =~ /^[1-2]\d{3}$/ );
  933. if ( !$y || $y !~ /^[1-2]\d{3}$/ ) {
  934. my $today = _time($y);
  935. $y = $today->{year};
  936. }
  937. # If $year is not evenly divisible by 4, it is
  938. # not a leap year; therefore, we return the
  939. # value 0 and do no further calculations in
  940. # this subroutine. ("$year % 4" provides the
  941. # remainder when $year is divided by 4.
  942. # If there is a remainder then $year is
  943. # not evenly divisible by 4.)
  944. return 0 if $y % 4;
  945. # At this point, we know $year is evenly divisible
  946. # by 4. Therefore, if it is not evenly
  947. # divisible by 100, it is a leap year --
  948. # we return the value 1 and do no further
  949. # calculations in this subroutine.
  950. return 1 if $y % 100;
  951. # At this point, we know $year is evenly divisible
  952. # by 4 and also evenly divisible by 100. Therefore,
  953. # if it is not also evenly divisible by 400, it is
  954. # not leap year -- we return the value 0 and do no
  955. # further calculations in this subroutine.
  956. return 0 if $y % 400;
  957. # Now we know $year is evenly divisible by 4, evenly
  958. # divisible by 100, and evenly divisible by 400.
  959. # We return the value 1 because it is a leap year.
  960. return 1;
  961. }
  962. sub IsDst(;$) {
  963. my ($time) = @_;
  964. my $ret = _time($time);
  965. return $ret->{isdst};
  966. }
  967. sub IsWeekend(;$) {
  968. my ($time) = @_;
  969. my $ret = _time($time);
  970. return $ret->{iswe};
  971. }
  972. sub IsHoliday(;$) {
  973. my ($time) = @_;
  974. my $ret = _time($time);
  975. return $ret->{isholiday};
  976. }
  977. # Get current stage of the daytime based on temporal hours
  978. # https://de.wikipedia.org/wiki/Temporale_Stunden
  979. sub GetDaytime(;$$$$) {
  980. my ( $time, $totalTemporalHours, $lang, $params ) = @_;
  981. $lang = (
  982. $main::attr{global}{language}
  983. ? $main::attr{global}{language}
  984. : "EN"
  985. ) unless ($lang);
  986. my $ret = ref($time) eq "HASH" ? $time : _time( $time, $lang, 1, $params );
  987. return undef unless ( ref($ret) eq "HASH" );
  988. $ret->{daytimeStages} = $totalTemporalHours
  989. && $totalTemporalHours =~ m/^\d+$/ ? $totalTemporalHours : 12;
  990. # TODO: consider srParams
  991. $ret->{sunrise} = main::sunrise_abs_dat( $ret->{time_t} );
  992. $ret->{sunrise_s} = hms2s( $ret->{sunrise} );
  993. $ret->{sunrise_t} = $ret->{midnight_t} + $ret->{sunrise_s};
  994. $ret->{sunset} = main::sunset_abs_dat( $ret->{time_t} );
  995. $ret->{sunset_s} = hms2s( $ret->{sunset} );
  996. $ret->{sunset_t} = $ret->{midnight_t} + $ret->{sunset_s};
  997. $ret->{isday} = $ret->{time_t} >= $ret->{sunrise_t}
  998. && $ret->{time_t} < $ret->{sunset_t} ? 1 : 0;
  999. $ret->{daytimeRel_s} =
  1000. hms2s("$ret->{hour}:$ret->{min}:$ret->{sec}") - $ret->{sunrise_s};
  1001. $ret->{daytimeRel} = s2hms( $ret->{daytimeRel_s} );
  1002. $ret->{daytimeT_s} = $ret->{sunset_s} - $ret->{sunrise_s};
  1003. $ret->{daytimeT} = s2hms( $ret->{daytimeT_s} );
  1004. $ret->{daytimeStageLn_s} =
  1005. $ret->{daytimeT_s} / $ret->{daytimeStages};
  1006. $ret->{daytimeStageLn} = s2hms( $ret->{daytimeStageLn_s} );
  1007. $ret->{daytimeStage_float} =
  1008. $ret->{daytimeRel_s} / $ret->{daytimeStageLn_s};
  1009. $ret->{daytimeStage} =
  1010. int( ( ( $ret->{daytimeRel_s} + 1 ) / $ret->{daytimeStageLn_s} ) + 1 );
  1011. $ret->{daytimeStage} = 0
  1012. if ( $ret->{daytimeStage} < 1
  1013. || $ret->{daytimeStage} > $ret->{daytimeStages} );
  1014. # include season data
  1015. $ret = GetSeason( $ret, $lang );
  1016. #$ret = GetSeasonPheno( $ret, $lang );
  1017. #$ret = GetSeasonSocial( $ret, $lang ); #TODO https://de.wikipedia.org/wiki/F%C3%BCnfte_Jahreszeit
  1018. # change midnight event when season changes
  1019. $ret->{events}{ $ret->{midnight_t} }{VALUE} = 1
  1020. if ( $ret->{seasonMeteoChng} && $ret->{seasonMeteoChng} == 1 );
  1021. $ret->{events}{ $ret->{midnight_t} }{DESC} .=
  1022. ", Begin meteorological $ret->{seasonMeteo_long} season"
  1023. if ( $ret->{seasonMeteoChng} && $ret->{seasonMeteoChng} == 1 );
  1024. $ret->{events}{ $ret->{midnight_t} }{VALUE} = 2
  1025. if ( $ret->{seasonAstroChng} && $ret->{seasonAstroChng} == 1 );
  1026. $ret->{events}{ $ret->{midnight_t} }{DESC} .=
  1027. ", Begin astronomical $ret->{seasonAstro_long} season"
  1028. if ( $ret->{seasonAstroChng} && $ret->{seasonAstroChng} == 1 );
  1029. # calculate daytime from daytimeStage, season and DST
  1030. my $ds = $ret->{daytimeStage};
  1031. while ( !defined( $ret->{daytime} ) ) {
  1032. #TODO let user define %sdt2daytimes through attribute
  1033. $ret->{daytime} =
  1034. $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }{$ds}
  1035. if (
  1036. $sdt2daytimes{ $ret->{seasonMeteo} }
  1037. && $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }
  1038. && defined(
  1039. $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }{$ds}
  1040. )
  1041. );
  1042. $ds--;
  1043. # when no relation was found
  1044. unless ( defined( $ret->{daytime} ) || $ds > -1 ) {
  1045. # assume midevening after sunset
  1046. if ( $ret->{time_s} >= $ret->{sunset_s} ) {
  1047. $ret->{daytime} = 5;
  1048. }
  1049. # assume night before sunrise
  1050. else {
  1051. $ret->{daytime} = 6;
  1052. }
  1053. }
  1054. }
  1055. # daytime during evening and night
  1056. unless ( $ret->{daytimeStage} ) {
  1057. $ret->{daytime} = 4 unless ( $ret->{daytime} > 4 );
  1058. $ret->{daytime} = 5 unless ( $ret->{daytime} > 5 || $ret->{isday} );
  1059. $ret->{daytime} = 6 if ( $ret->{time_s} < $ret->{sunrise_s} );
  1060. }
  1061. $ret->{daytime_long} = $daytimes{en}[ $ret->{daytime} ];
  1062. my @langs = ('EN');
  1063. push @langs, $lang unless ( $lang =~ /^EN/i );
  1064. foreach (@langs) {
  1065. my $l = lc($_);
  1066. $l =~ s/^([a-z]+).*/$1/g;
  1067. next unless ( $daytimes{$l} );
  1068. my $h = $l eq "en" ? $ret : \%{ $ret->{$_} };
  1069. $h->{daytime_long} = $daytimes{$l}[ $ret->{daytime} ];
  1070. }
  1071. # calculate daily schedule
  1072. #
  1073. # Midnight
  1074. $ret->{events}{ $ret->{midnight_t} }{TYPE} = "dayshift";
  1075. $ret->{events}{ $ret->{midnight_t} }{TIME} =
  1076. main::FmtDateTime( $ret->{midnight_t} );
  1077. $ret->{events}{ $ret->{midnight_t} }{DESC} =
  1078. "Begin of night time and new calendar day";
  1079. $ret->{events}{ $ret->{1}{midnight_t} }{TYPE} = "dayshift";
  1080. $ret->{events}{ $ret->{1}{midnight_t} }{TIME} = $ret->{date} . " 24:00:00";
  1081. $ret->{events}{ $ret->{1}{midnight_t} }{DESC} =
  1082. "End of calendar day and begin night time";
  1083. # Holidays
  1084. $ret->{events}{ $ret->{midnight_t} }{DESC} .=
  1085. ", $daystages{en}[2]: $ret->{day_desc}"
  1086. if ( $ret->{isholiday} );
  1087. $ret->{events}{ $ret->{1}{midnight_t} }{DESC} .=
  1088. ", $daystages{en}[2]: $ret->{1}{day_desc}"
  1089. if ( $ret->{1}{isholiday} );
  1090. # DST change
  1091. #FIXME TODO
  1092. if ( $ret->{dstchange} && $ret->{dstchange} == 1 ) {
  1093. my $t = $ret->{midnight_t} + 2 * 60 * 60;
  1094. $ret->{events}{$t}{TYPE} = "dstshift";
  1095. $ret->{events}{$t}{VALUE} = $ret->{isdst};
  1096. $ret->{events}{$t}{TIME} = main::FmtDateTime($t);
  1097. $ret->{events}{$t}{DESC} = "Begin of standard time (-1h)"
  1098. unless ( $ret->{isdst} );
  1099. $ret->{events}{$t}{DESC} = "Begin of daylight saving time (+1h)"
  1100. if ( $ret->{isdst} );
  1101. }
  1102. # daytime stage event forecast for today
  1103. my $i = 1;
  1104. my $b = $ret->{sunrise_t};
  1105. while ( $i <= $ret->{daytimeStages} + 1 ) {
  1106. # find daytime
  1107. my $daytime;
  1108. $daytime = $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }{$i}
  1109. if (
  1110. $sdt2daytimes{ $ret->{seasonMeteo} }
  1111. && $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }
  1112. && defined(
  1113. $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }{$i}
  1114. )
  1115. );
  1116. # create event
  1117. my $t = int( $b + 0.5 );
  1118. $ret->{events}{$t}{TIME} = main::FmtDateTime($t);
  1119. if ( $i == $ret->{daytimeStages} + 1 ) {
  1120. $ret->{events}{$t}{TYPE} = "daytime";
  1121. $ret->{events}{$t}{VALUE} = "midevening";
  1122. $ret->{events}{$t}{DESC} =
  1123. "End of daytime";
  1124. }
  1125. else {
  1126. $ret->{events}{$t}{TYPE} = "daytimeStage";
  1127. $ret->{events}{$t}{VALUE} = $i;
  1128. $ret->{events}{$t}{DESC} = "Begin of daytime stage $i"
  1129. unless ($daytime);
  1130. if ( defined($daytime) ) {
  1131. $ret->{events}{$t}{TYPE} = "daytime";
  1132. $ret->{events}{$t}{VALUE} = $daytimes{en}[$daytime];
  1133. $ret->{events}{$t}{DESC} =
  1134. "Begin of $daytimes{en}[$daytime] time and daytime stage $i";
  1135. }
  1136. }
  1137. $i++;
  1138. $b += $ret->{daytimeStageLn_s};
  1139. }
  1140. return $ret;
  1141. }
  1142. sub GetSeason (;$$$);
  1143. sub GetSeason (;$$$) {
  1144. my ( $time, $lang, $meteo ) = @_;
  1145. $lang = (
  1146. $main::attr{global}{language}
  1147. ? $main::attr{global}{language}
  1148. : "EN"
  1149. ) unless ($lang);
  1150. my $ret;
  1151. my $wanthash = 0;
  1152. if ( !$time ) {
  1153. $time = time;
  1154. }
  1155. elsif ( ref($time) eq "HASH" ) {
  1156. $ret = $time;
  1157. $wanthash = 1;
  1158. }
  1159. elsif ( $time =~ /^(?:0|1|2|3)$/ ) {
  1160. return $seasons{ lc($lang) }
  1161. ? $seasons{ lc($lang) }[$time]
  1162. : $seasons{en}[$time];
  1163. }
  1164. elsif ( $time =~ /[A-Za-z]/ ) {
  1165. my $index =
  1166. $seasons{ lc($lang) }
  1167. ? _GetIndexFromArray( $time, $seasons{ lc($lang) } )
  1168. : undef;
  1169. return $index;
  1170. }
  1171. elsif ( $time !~ /^\d{10}(?:\.\d+)?$/ ) {
  1172. return undef;
  1173. }
  1174. else {
  1175. $ret = _time($time);
  1176. }
  1177. my $index = 0;
  1178. $index = 3 if ( $ret->{mon} <= 1 );
  1179. $index++ if ( $ret->{mon} >= 5 );
  1180. $index++ if ( $ret->{mon} >= 8 );
  1181. $index++ if ( $ret->{mon} == 11 );
  1182. $ret->{seasonMeteo} = $index;
  1183. $index = 0;
  1184. $index = 3 if ( $ret->{yday} < ( 80 + $ret->{isly} ) );
  1185. $index++ if ( $ret->{yday} >= ( 173 + $ret->{isly} ) );
  1186. $index++ if ( $ret->{yday} >= ( 265 + $ret->{isly} ) );
  1187. $index++ if ( $ret->{yday} >= ( 356 + $ret->{isly} ) );
  1188. $ret->{seasonAstro} = $index;
  1189. unless (wantarray) {
  1190. ( $ret->{'-1'}{seasonMeteo}, $ret->{'-1'}{seasonAstro} ) =
  1191. GetSeason( $ret->{'-1'}{time_t}, $lang );
  1192. ( $ret->{1}{seasonMeteo}, $ret->{1}{seasonAstro} ) =
  1193. GetSeason( $ret->{1}{time_t}, $lang );
  1194. }
  1195. # text strings
  1196. my @langs = ('EN');
  1197. push @langs, $lang unless ( $lang =~ /^EN/i );
  1198. foreach (@langs) {
  1199. my $l = lc($_);
  1200. $l =~ s/^([a-z]+).*/$1/g;
  1201. next unless ( $seasons{$l} );
  1202. my $h = $l eq "en" ? $ret : \%{ $ret->{$_} };
  1203. $h->{seasonMeteo_long} = $seasons{$l}[ $ret->{seasonMeteo} ];
  1204. $h->{seasonAstro_long} = $seasons{$l}[ $ret->{seasonAstro} ];
  1205. }
  1206. if ( $ret->{seasonMeteo} ne $ret->{1}{seasonMeteo} ) {
  1207. $ret->{seasonMeteoChng} = 2;
  1208. }
  1209. if ( $ret->{'-1'}
  1210. && defined( $ret->{'-1'}{seasonMeteo} )
  1211. && defined( $ret->{'-1'}{seasonAstro} )
  1212. && $ret->{1}
  1213. && defined( $ret->{1}{seasonMeteo} )
  1214. && defined( $ret->{1}{seasonAstro} ) )
  1215. {
  1216. $ret->{'-1'}{seasonMeteoChng} = 0;
  1217. $ret->{seasonMeteoChng} = 0;
  1218. $ret->{1}{seasonMeteoChng} = 0;
  1219. if ( $ret->{seasonMeteo} ne $ret->{1}{seasonMeteo} ) {
  1220. $ret->{seasonMeteoChng} = 2;
  1221. $ret->{1}{seasonMeteoChng} = 1;
  1222. }
  1223. elsif ( $ret->{seasonMeteo} ne $ret->{'-1'}{seasonMeteo} ) {
  1224. $ret->{'-1'}{seasonMeteoChng} = 2;
  1225. $ret->{seasonMeteoChng} = 1;
  1226. }
  1227. $ret->{'-1'}{seasonAstroChng} = 0;
  1228. $ret->{seasonAstroChng} = 0;
  1229. $ret->{1}{seasonAstroChng} = 0;
  1230. if ( $ret->{seasonAstro} ne $ret->{1}{seasonAstro} ) {
  1231. $ret->{seasonAstroChng} = 2;
  1232. $ret->{1}{seasonAstroChng} = 1;
  1233. }
  1234. elsif ( $ret->{seasonAstro} ne $ret->{'-1'}{seasonAstro} ) {
  1235. $ret->{'-1'}{seasonAstroChng} = 2;
  1236. $ret->{seasonAstroChng} = 1;
  1237. }
  1238. }
  1239. return $ret if ($wanthash);
  1240. return ( $ret->{seasonMeteo}, $ret->{seasonAstro} ) if (wantarray);
  1241. return $ret->{$lang}{seasonMeteo_long}
  1242. ? $ret->{$lang}{seasonMeteo_long}
  1243. : $ret->{seasonMeteo_long}
  1244. if ($meteo);
  1245. return $ret->{$lang}{seasonAstro_long}
  1246. ? $ret->{$lang}{seasonAstro_long}
  1247. : $ret->{seasonAstro_long};
  1248. }
  1249. # Estimate phenologic season from astro and meteo season
  1250. # https://de.wikipedia.org/wiki/Ph%C3%A4nologie#Ph.C3.A4nologischer_Kalender
  1251. sub GetSeasonPheno (;$$) {
  1252. $lang = (
  1253. $main::attr{global}{language}
  1254. ? $main::attr{global}{language}
  1255. : "EN"
  1256. ) unless ($lang);
  1257. if ( !$time ) {
  1258. $time = time;
  1259. }
  1260. elsif ( $time =~ /^(?:0|1|2|3|4|5|6|7|8|9|10|11)$/ ) {
  1261. return $seasonsPheno{ lc($lang) }
  1262. ? $seasonsPheno{ lc($lang) }[$time]
  1263. : $seasonsPheno{en}[$time];
  1264. }
  1265. elsif ( $time =~ /[A-Za-z]/ ) {
  1266. my $index =
  1267. $seasonsPheno{ lc($lang) }
  1268. ? _GetIndexFromArray( $time, $seasonsPheno{ lc($lang) } )
  1269. : undef;
  1270. return $index;
  1271. }
  1272. elsif ( $time !~ /^\d{10}(?:\.\d+)?$/ ) {
  1273. return undef;
  1274. }
  1275. my (
  1276. $sec, $min, $hour,
  1277. $mday, $mdayrem, $month,
  1278. $monthISO, $year, $week,
  1279. $weekISO, $wday, $wdayISO,
  1280. $yday, $ydayrem, $isdst,
  1281. $isLeapYear, $iswe, $isHolidayYesterday,
  1282. $isHolidayToday, $isHolidayTomorrow
  1283. ) = GetDaySchedule($time);
  1284. my ( $seasonAstro, $seasonAstroIndex, $seasonAstroChng ) = GetSeason($time);
  1285. my ( $seasonMeteo, $seasonMeteoIndex, $seasonMeteoChng ) =
  1286. GetSeason( $time, "en", 1 );
  1287. # stick to astro season first
  1288. my $index = $seasons{pheno}[$seasonAstro];
  1289. # meteos say it's spring time
  1290. if ( $seasonMeteo == 0 ) {
  1291. $index = 0;
  1292. }
  1293. # meteos say it's summer time
  1294. elsif ( $seasonMeteo == 1 ) {
  1295. $index = 3;
  1296. }
  1297. # meteos say it's autumn time
  1298. elsif ( $seasonMeteo == 2 ) {
  1299. $index = 6;
  1300. }
  1301. # meteos say it's winter time
  1302. elsif ( $seasonMeteo == 3 ) {
  1303. $index = 9;
  1304. }
  1305. # if we know our position and spring is ahead
  1306. if ( ( $index == 0 || $index == 1 )
  1307. && $main::attr{global}{latitude}
  1308. && $main::attr{global}{longitude} )
  1309. {
  1310. # it starts in south-west Portugal
  1311. my $dist = distance(
  1312. $main::attr{global}{latitude},
  1313. $main::attr{global}{longitude},
  1314. 37.136633, -8.817837
  1315. );
  1316. # TODO: let begin of early spring be set by user
  1317. my $earlySpringBegin = main::time_str2num("$year-02-28 00:00:00");
  1318. my $days = ( $time - $earlySpringBegin ) / ( 60 * 60 * 24 );
  1319. # comes with 40km per day
  1320. my $currDist = $dist - ( $days * 40 );
  1321. # when season reached location
  1322. if ( $currDist <= 0 ) {
  1323. $index = 2;
  1324. }
  1325. # when season made 60% of it's way
  1326. elsif ( $currDist <= $dist * 0.4 ) {
  1327. $index = 1;
  1328. }
  1329. }
  1330. # assume spring progress from calendar
  1331. elsif ( ( $index == 0 || $index == 1 ) ) {
  1332. $index = 1 if ( $monthISO == 4 );
  1333. $index = 2 if ( $monthISO == 5 );
  1334. }
  1335. # assume summer progress from calendar
  1336. elsif ( $index == 3 ) {
  1337. $index = 4 if ( $monthISO == 7 );
  1338. $index = 5 if ( $monthISO == 8 );
  1339. }
  1340. # if we know our position and autumn is ahead
  1341. elsif (( $index == 6 || $index == 7 )
  1342. && $main::attr{global}{latitude}
  1343. && $main::attr{global}{longitude} )
  1344. {
  1345. # it starts in Helsinki
  1346. my $dist = distance(
  1347. $main::attr{global}{latitude},
  1348. $main::attr{global}{longitude},
  1349. 60.161880, 24.937267
  1350. );
  1351. # TODO: let begin of early autumn be set by user
  1352. my $earlySpringBegin = main::time_str2num("$year-09-01 00:00:00");
  1353. my $days = ( $time - $earlySpringBegin ) / ( 60 * 60 * 24 );
  1354. # comes with 40km per day
  1355. my $currDist = $dist - ( $days * 40 );
  1356. # when season reached location
  1357. if ( $currDist <= 0 ) {
  1358. $index = 8;
  1359. }
  1360. # when season made 60% of it's way
  1361. elsif ( $currDist <= $dist * 0.4 ) {
  1362. $index = 7;
  1363. }
  1364. }
  1365. # assume autumn progress from calendar
  1366. elsif ( ( $index == 6 || $index == 7 ) ) {
  1367. $index = 7 if ( $monthISO == 10 );
  1368. $index = 8 if ( $monthISO == 11 );
  1369. }
  1370. my $seasonPheno =
  1371. defined($index)
  1372. && $index{ lc($lang) }
  1373. ? $seasonsPheno{ lc($lang) }[$index]
  1374. : $seasonsPheno{en}[$index];
  1375. return ( $seasonPheno, $index ) if (wantarray);
  1376. return ($seasonPheno);
  1377. }
  1378. ####################
  1379. # HELPER FUNCTIONS
  1380. sub decimal_mark ($$) {
  1381. my ( $val, $f ) = @_;
  1382. return $val unless ( looks_like_number($val) && $f );
  1383. my $text = reverse $val;
  1384. if ( $f eq "2" ) {
  1385. $text =~ s:\.:,:g;
  1386. $text =~ s/(\d\d\d)(?=\d)(?!\d*,)/$1./g;
  1387. }
  1388. else {
  1389. $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
  1390. }
  1391. return scalar reverse $text;
  1392. }
  1393. sub _round($;$) {
  1394. my ( $val, $n ) = @_;
  1395. $n = 1 unless ( defined($n) );
  1396. return sprintf( "%.${n}f", $val );
  1397. }
  1398. sub _time(;$$$$);
  1399. sub _time(;$$$$) {
  1400. my ( $time, $lang, $dayOffset, $params ) = @_;
  1401. $dayOffset = 1 if ( !defined($dayOffset) || $dayOffset !~ /^-?\d+$/ );
  1402. $lang = (
  1403. $main::attr{global}{language}
  1404. ? $main::attr{global}{language}
  1405. : "EN"
  1406. ) unless ($lang);
  1407. return undef
  1408. unless ( !$time || $time =~ /^\d{10}(?:\.\d+)?$/ );
  1409. my %ret;
  1410. $ret{time_t} = $time if ($time);
  1411. $ret{time_t} = time unless ($time);
  1412. $ret{params} = $params if ($params);
  1413. my @t = localtime( $ret{time_t} );
  1414. (
  1415. $ret{sec}, $ret{min}, $ret{hour}, $ret{mday}, $ret{mon},
  1416. $ret{year}, $ret{wday}, $ret{yday}, $ret{isdst}
  1417. ) = @t;
  1418. $ret{monISO} = $ret{mon} + 1;
  1419. $ret{year} += 1900;
  1420. $ret{date} =
  1421. sprintf( "%04d-%02d-%02d", $ret{year}, $ret{monISO}, $ret{mday} );
  1422. $ret{time} = sprintf( "%02d:%02d", $ret{hour}, $ret{min} );
  1423. $ret{time_hms} =
  1424. sprintf( "%02d:%02d:%02d", $ret{hour}, $ret{min}, $ret{sec} );
  1425. $ret{time_s} = hms2s( $ret{time_hms} ); #FIXME for DST change
  1426. $ret{datetime} = $ret{date} . " " . $ret{time_hms};
  1427. $ret{midnight_t} = $ret{time_t} - $ret{time_s}; #FIXME for DST change
  1428. # get leap year status
  1429. $ret{isly} = IsLeapYear( $ret{year} );
  1430. # remaining monthdays
  1431. $ret{mdayrem} = 0;
  1432. $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 1 );
  1433. $ret{mdayrem} = 28 + $ret{isly} - $ret{mday}
  1434. if ( $ret{monISO} == 2 );
  1435. $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 3 );
  1436. $ret{mdayrem} = 30 - $ret{mday} if ( $ret{monISO} == 4 );
  1437. $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 5 );
  1438. $ret{mdayrem} = 30 - $ret{mday} if ( $ret{monISO} == 6 );
  1439. $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 7 );
  1440. $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 8 );
  1441. $ret{mdayrem} = 30 - $ret{mday} if ( $ret{monISO} == 9 );
  1442. $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 10 );
  1443. $ret{mdayrem} = 30 - $ret{mday} if ( $ret{monISO} == 11 );
  1444. $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 12 );
  1445. # remaining yeardays
  1446. $ret{ydayrem} = 365 + $ret{isly} - $ret{yday};
  1447. # ISO 8601 weekday as number with Monday as 1 (1-7)
  1448. $ret{wdaynISO} = strftime( '%u', @t );
  1449. # Week number with the first Sunday as the first day of week one (00-53)
  1450. $ret{week} = strftime( '%U', @t );
  1451. # ISO 8601 week number (00-53)
  1452. $ret{weekISO} = strftime( '%V', @t );
  1453. # weekend
  1454. $ret{iswe} = ( $ret{wday} == 0 || $ret{wday} == 6 ) ? 1 : 0;
  1455. # text strings
  1456. my @langs = ('EN');
  1457. push @langs, $lang unless ( $lang =~ /^EN/i );
  1458. foreach (@langs) {
  1459. my $l = lc($_);
  1460. $l =~ s/^([a-z]+).*/$1/g;
  1461. next unless ( $months{$l} );
  1462. my $h = $l eq "en" ? \%ret : \%{ $ret{$_} };
  1463. $h->{dst_long} = $dst{$l}[ $ret{isdst} ];
  1464. $h->{rday_long} = $reldays{$l}[1];
  1465. $h->{day_desc} = $daystages{$l}[ $ret{iswe} ];
  1466. $h->{wday_long} = $days{$l}[ $ret{wday} ];
  1467. $h->{wday_short} = $dayss{$l}[ $ret{wday} ];
  1468. $h->{mon_long} = $months{$l}[ $ret{mon} ];
  1469. $h->{mon_short} = $monthss{$l}[ $ret{mon} ];
  1470. $h->{date_long} =
  1471. _ReplaceStringByHashKey( \%ret, $dateformats{$l}, $_ );
  1472. $h->{date_short} =
  1473. _ReplaceStringByHashKey( \%ret, $dateformatss{$l}, $_ );
  1474. }
  1475. # holiday
  1476. if ($dayOffset) {
  1477. $ret{'-1'}{isholiday} = 0;
  1478. $ret{1}{isholiday} = 0;
  1479. }
  1480. $ret{isholiday} = 0;
  1481. my $holidayDev =
  1482. $main::attr{global}{holiday2we}
  1483. && main::IsDevice( $main::attr{global}{holiday2we}, "holiday" )
  1484. ? $main::attr{global}{holiday2we}
  1485. : undef;
  1486. if ($holidayDev) {
  1487. my $date = sprintf( "%02d-%02d", $ret{monISO}, $ret{mday} );
  1488. $tod = main::holiday_refresh( $holidayDev, $date );
  1489. if ($dayOffset) {
  1490. $date =
  1491. sprintf( "%02d-%02d", $ret{'-1'}{monISO}, $ret{'-1'}{mday} );
  1492. $ytd = main::holiday_refresh( $holidayDev, $date );
  1493. $date = sprintf( "%02d-%02d", $ret{1}{monISO}, $ret{1}{mday} );
  1494. $tom = main::holiday_refresh( $holidayDev, $date );
  1495. }
  1496. if ( $tod ne "none" ) {
  1497. $ret{iswe} += 2;
  1498. $ret{isholiday} = 1;
  1499. $ret{day_desc} = $tod;
  1500. foreach (@langs) {
  1501. my $l = lc($_);
  1502. $l =~ s/^([a-z]+).*/$1/g;
  1503. next unless ( $months{$l} );
  1504. my $h = $l eq "en" ? \%ret : \%{ $ret{$_} };
  1505. $h->{day_desc} = $tod;
  1506. }
  1507. }
  1508. if ($dayOffset) {
  1509. if ( $ytd ne "none" && $ret{'-1'} ) {
  1510. $ret{'-1'}{isholiday} = 1;
  1511. $ret{'-1'}{day_desc} = $ytd;
  1512. foreach (@langs) {
  1513. my $l = lc($_);
  1514. $l =~ s/^([a-z]+).*/$1/g;
  1515. next unless ( $months{$l} );
  1516. my $h = $l eq "en" ? $ret{'-1'} : \%{ $ret{'-1'}{$_} };
  1517. $h->{day_desc} = $ytd;
  1518. }
  1519. }
  1520. if ( $tom ne "none" && $ret{1} ) {
  1521. $ret{1}{isholiday} = 1;
  1522. $ret{1}{day_desc} = $tom;
  1523. foreach (@langs) {
  1524. my $l = lc($_);
  1525. $l =~ s/^([a-z]+).*/$1/g;
  1526. next unless ( $months{$l} );
  1527. my $h = $l eq "en" ? $ret{1} : \%{ $ret{1}{$_} };
  1528. $h->{day_desc} = $tom;
  1529. }
  1530. }
  1531. }
  1532. }
  1533. if (wantarray) {
  1534. my @a;
  1535. foreach (
  1536. 'sec', 'min', 'hour', 'mday', 'mon',
  1537. 'year', 'wday', 'wdayn', 'yday', 'isdst',
  1538. 'mdayrem', 'monISO', 'week', 'weekISO', 'wdayISO',
  1539. 'wdaynISO', 'ydayrem', 'time_t', 'datetime', 'date',
  1540. 'time_hms', 'time', 'isly',
  1541. )
  1542. {
  1543. push @a, $ret{$_};
  1544. }
  1545. return @a;
  1546. }
  1547. elsif ($dayOffset) {
  1548. my $i = $dayOffset * -1;
  1549. while ( $i < $dayOffset + 1 ) {
  1550. $ret{$i} = _time( $ret{time_t} + ( 24 * 60 * 60 * $i ), $lang, 0 )
  1551. unless ( $i == 0 );
  1552. foreach (@langs) {
  1553. my $l = $_;
  1554. $l =~ s/^([A-Z-a-z]+).*/$1/g;
  1555. $l = lc($l);
  1556. next if ( $i == 0 || !$reldays{$l} );
  1557. my $h = $l eq "en" ? \%{ $ret{$i} } : \%{ $ret{$i}{$l} };
  1558. if ( $i == -1 || $i == 1 ) {
  1559. $h->{rday_long} = $reldays{$l}[ $i + 1 ];
  1560. }
  1561. else {
  1562. delete $h->{rday_long};
  1563. }
  1564. }
  1565. $i++;
  1566. }
  1567. # DST change
  1568. $ret{'-1'}{dstchange} = 0;
  1569. $ret{dstchange} = 0;
  1570. $ret{1}{dstchange} = 0;
  1571. if ( $ret{isdst} ne $ret{1}{isdst} ) {
  1572. $ret{dstchange} = 2;
  1573. $ret{1}{dstchange} = 1;
  1574. }
  1575. elsif ( $ret{isdst} ne $ret{'-1'}{isdst} ) {
  1576. $ret{'-1'}{dstchange} = 2;
  1577. $ret{dstchange} = 1;
  1578. }
  1579. }
  1580. return \%ret;
  1581. }
  1582. sub _GetIndexFromArray($$) {
  1583. my ( $string, $array ) = @_;
  1584. return undef unless ( ref($array) eq "ARRAY" );
  1585. my ($index) = grep { $array->[$_] =~ /^$string$/i } ( 0 .. @$array - 1 );
  1586. return defined $index ? $index : undef;
  1587. }
  1588. sub _ReplaceStringByHashKey($$;$) {
  1589. my ( $hash, $string, $sublvl ) = @_;
  1590. return $string unless ( $hash && ref($hash) eq "HASH" );
  1591. $string = _ReplaceStringByHashKey( $hash->{$sublvl}, $string )
  1592. if ( $sublvl && $hash->{$sublvl} );
  1593. foreach my $key ( keys %{$hash} ) {
  1594. next if ( ref( $hash->{$key} ) );
  1595. my $val = $hash->{$key};
  1596. $string =~ s/%$key%/$val/gi;
  1597. $string =~ s/\$$key/$val/g;
  1598. }
  1599. return $string;
  1600. }
  1601. 1;