| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905 |
- ###############################################################################
- # $Id: UConv.pm 17589 2018-10-22 13:37:00Z loredo $
- package main;
- sub UConv_Initialize() { }
- package UConv;
- use Scalar::Util qw(looks_like_number);
- use POSIX qw(strftime);
- use Data::Dumper;
- ####################
- # Translations
- our %compasspointss = (
- en => [
- 'N', 'NNE', 'NE', 'ENE', 'E', 'ESE', 'SE', 'SSE',
- 'S', 'SSW', 'SW', 'WSW', 'W', 'WNW', 'NW', 'NNW'
- ],
- de => [
- 'N', 'NNO', 'NO', 'ONO', 'O', 'OSO', 'SO', 'SSO',
- 'S', 'SSW', 'SW', 'WSW', 'W', 'WNW', 'NW', 'NNW'
- ],
- nl => [
- 'N', 'NNO', 'NO', 'ONO', 'O', 'OZO', 'ZO', 'ZZO',
- 'Z', 'ZZW', 'ZW', 'WZW', 'W', 'WNW', 'NW', 'NNW'
- ],
- fr => [
- 'N', 'NNE', 'NE', 'ENE', 'E', 'ESE', 'SE', 'SSE',
- 'S', 'SSO', 'SO', 'OSO', 'O', 'ONO', 'NO', 'NNO'
- ],
- pl => [
- 'N', 'NNE', 'NE', 'ENE', 'E', 'ESE', 'SE', 'SSE',
- 'S', 'SSW', 'SW', 'WSW', 'W', 'WNW', 'NW', 'NNW'
- ],
- );
- our %hr_formats = (
- # 1 234 567.89
- std => {
- delim => "\x{2009}",
- sep => ".",
- },
- # 1 234 567,89
- 'std-fr' => {
- delim => "\x{2009}",
- sep => ",",
- },
- # 1,234,567.89
- 'old-english' => {
- delim => ",",
- sep => ".",
- },
- # 1.234.567,89
- 'old-european' => {
- delim => ".",
- sep => ",",
- },
- # 1'234'567.89
- ch => {
- delim => "'",
- sep => ".",
- },
- ### lang ref ###
- #
- en => {
- ref => "std",
- },
- de => {
- ref => "std-fr",
- },
- de_at => {
- ref => "std-fr",
- min => 4,
- },
- de_ch => {
- ref => "std",
- },
- nl => {
- ref => "std-fr",
- },
- fr => {
- ref => "std-fr",
- },
- pl => {
- ref => "std-fr",
- },
- ### number ref ###
- #
- 0 => {
- ref => "std",
- },
- 1 => {
- ref => "std-fr",
- },
- 2 => {
- ref => "old-english",
- },
- 3 => {
- ref => "old-european",
- },
- 4 => {
- ref => "ch",
- },
- 5 => {
- ref => "std-fr",
- min => 4,
- },
- );
- our %daytimes = (
- en => [
- "morning", "midmorning", "noon", "afternoon",
- "evening", "midevening", "night",
- ],
- de => [
- "Morgen", "Vormittag", "Mittag", "Nachmittag",
- "Vorabend", "Abend", "Nacht",
- ],
- icons => [
- "weather_sunrise", "scene_day",
- "weather_sun", "weather_summer",
- "weather_sunset", "scene_night",
- "weather_moon_phases_8",
- ],
- );
- our %sdt2daytimes = (
- # User overwrite format:
- # <SeasonSrc><SeasonIndex><DST><daytimeStage>:<daytime>
- # M000:0
- # M001:0
- # M002:0
- # M003:1
- # M004:1
- # M005:2
- # M006:2
- # M007:3
- # M008:3
- # M009:3
- # M0010:3
- # M0011:4
- # M0012:5
- #
- # M010:0
- # M011:0
- # M012:0
- # M013:1
- # M014:1
- # M015:2
- # M016:2
- # M017:3
- # M018:3
- # M019:3
- # M0110:3
- # M0111:4
- # M0112:5
- # SPRING SEASON
- 0 => {
- # DST = no
- 0 => {
- 1 => 0,
- 4 => 1,
- 6 => 2,
- 8 => 3,
- 12 => 4,
- },
- # DST = yes
- 1 => {
- 1 => 0,
- 4 => 1,
- 6 => 2,
- 8 => 3,
- 12 => 4,
- },
- },
- # SUMMER SEASON
- 1 => {
- # DST = yes
- 1 => {
- 1 => 0,
- 4 => 1,
- 6 => 2,
- 7 => 3,
- 10 => 4,
- 12 => 5,
- }
- },
- # AUTUMN SEASON
- 2 => {
- # DST = no
- 0 => {
- 1 => 0,
- 4 => 1,
- 6 => 2,
- 7 => 3,
- 11 => 4,
- },
- # DST = yes
- 1 => {
- 1 => 0,
- 4 => 1,
- 6 => 2,
- 7 => 3,
- 11 => 4,
- },
- },
- # WINTER SEASON
- 3 => {
- # DST = no
- 0 => {
- 1 => 0,
- 3 => 1,
- 6 => 2,
- 8 => 3,
- # 12 => 4,
- },
- },
- );
- our %seasons = (
- en => [ "Spring", "Summer", "Autumn", "Winter", ],
- de => [ "Frühling", "Sommer", "Herbst", "Winter", ],
- pheno => [ 2, 4, 7, 9 ],
- );
- our %seasonsPheno = (
- en => [
- "Early Spring",
- "First Spring",
- "Spring",
- "Early Summer",
- "Summer",
- "Late Summer",
- "Early Autumn",
- "Autumn",
- "Late Autumn",
- "Winter",
- ],
- de => [
- "Vorfrühling", "Erstfrühling", "Vollfrühling", "Frühsommer",
- "Hochsommer", "Spätsommer", "Frühherbst", "Vollherbst",
- "Spätherbst", "Winter",
- ],
- );
- our %dst = (
- en => [ "standard", "daylight" ],
- de => [ "Normalzeit", "Sommerzeit" ],
- );
- our %daystages = (
- en => [ "weekday", "weekend", "holiday", "vacation", ],
- de => [ "Wochentag", "Wochenende", "Feiertag", "Urlaubstag", ],
- );
- our %reldays = (
- en => [ "yesterday", "today", "tomorrow" ],
- de => [ "Gestern", "Heute", "Morgen" ],
- );
- our %monthss = (
- en => [
- "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug",
- "Sep", "Oct", "Nov", "Dec", "Jan"
- ],
- de => [
- "Jan", "Feb", "Mar", "Apr", "Mai", "Jun", "Jul", "Aug",
- "Sep", "Okt", "Nov", "Dez", "Jan"
- ],
- );
- our %months = (
- en => [
- "January", "Febuary", "March", "April",
- "May", "June", "July", "August",
- "September", "October", "November", "December",
- "January"
- ],
- de => [
- "Januar", "Februar", "März", "April",
- "Mai", "Juni", "Juli", "August",
- "September", "Oktober", "November", "Dezember",
- "Januar"
- ],
- );
- our %dayss = (
- en => [ "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun" ],
- de => [ "So", "Mo", "Di", "Mi", "Do", "Fr", "Sa", "So" ],
- );
- our %days = (
- en => [
- "Sunday", "Monday", "Tuesday", "Wednesday",
- "Thursday", "Friday", "Saturday", "Sunday"
- ],
- de => [
- "Sonntag", "Montag", "Dienstag", "Mittwoch",
- "Donnerstag", "Freitag", "Samstag", "Sonntag"
- ],
- );
- our %dateformats = (
- en => '%wday_long%, %mon_long% %mday%',
- de => '%wday_long%, %mday%. %mon_long%',
- );
- our %dateformatss = (
- en => '%mon_long% %mday%',
- de => '%mday%. %mon_long%',
- );
- #################################
- ### Inner metric conversions
- ###
- # Temperature: convert Celsius to Kelvin
- sub c2k($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data + 273.15, $rnd );
- }
- # Temperature: convert Kelvin to Celsius
- sub k2c($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data - 273.15, $rnd );
- }
- # Speed: convert km/h (kilometer per hour) to m/s (meter per second)
- sub kph2mps($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data / 3.6, $rnd );
- }
- # Speed: convert m/s (meter per second) to km/h (kilometer per hour)
- sub mps2kph($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data * 3.6, $rnd );
- }
- # Pressure: convert hPa (hecto Pascal) to mmHg (milimeter of Mercury)
- sub hpa2mmhg($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data * 0.00750061561303, $rnd );
- }
- #################################
- ### Metric to angloamerican conversions
- ###
- # Temperature: convert Celsius to Fahrenheit
- sub c2f($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data * 1.8 + 32, $rnd );
- }
- # Temperature: convert Kelvin to Fahrenheit
- sub k2f($;$) {
- my ( $data, $rnd ) = @_;
- return _round( ( $data - 273.15 ) * 1.8 + 32, $rnd );
- }
- # Pressure: convert hPa (hecto Pascal) to in (inches of Mercury)
- sub hpa2inhg($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data * 0.02952998751, $rnd );
- }
- # Pressure: convert hPa (hecto Pascal) to PSI (Pound force per square inch)
- sub hpa2psi($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data * 100.00014504, $rnd );
- }
- # Speed: convert km/h (kilometer per hour) to mph (miles per hour)
- sub kph2mph($;$) {
- return km2mi(@_);
- }
- # Speed: convert m/s (meter per seconds) to mph (miles per hour)
- sub mps2mph($;$) {
- my ( $data, $rnd ) = @_;
- return _round( kph2mph( mps2kph( $data, 9 ), 9 ), $rnd );
- }
- # Length: convert mm (milimeter) to in (inch)
- sub mm2in($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data * 0.039370, $rnd );
- }
- # Length: convert cm (centimeter) to in (inch)
- sub cm2in($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data * 0.39370, $rnd );
- }
- # Length: convert m (meter) to ft (feet)
- sub m2ft($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data * 3.2808, $rnd );
- }
- # Length: convert km (kilometer) to miles (mi)
- sub km2mi($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data * 0.621371192, $rnd );
- }
- #################################
- ### Inner Angloamerican conversions
- ###
- # Speed: convert mph (miles per hour) to ft/s (feet per second)
- sub mph2fts($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data * 1.467, $rnd );
- }
- # Speed: convert ft/s (feet per second) to mph (miles per hour)
- sub fts2mph($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data / 1.467, $rnd );
- }
- #################################
- ### Angloamerican to Metric conversions
- ###
- # Temperature: convert Fahrenheit to Celsius
- sub f2c($;$) {
- my ( $data, $rnd ) = @_;
- return _round( ( $data - 32 ) * 0.5556, $rnd );
- }
- # Temperature: convert Fahrenheit to Kelvin
- sub f2k($;$) {
- my ( $data, $rnd ) = @_;
- return _round( ( $data - 32 ) / 1.8 + 273.15, $rnd );
- }
- # Pressure: convert in (inches of Mercury) to hPa (hecto Pascal)
- sub inhg2hpa($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data * 33.8638816, $rnd );
- }
- # Pressure: convert PSI (Pound force per square inch) to hPa (hecto Pascal)
- sub psi2hpa($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data / 100.00014504, $rnd );
- }
- # Speed: convert mph (miles per hour) to km/h (kilometer per hour)
- sub mph2kph($;$) {
- return mi2km(@_);
- }
- # Speed: convert mph (miles per hour) to m/s (meter per seconds)
- sub mph2mps($;$) {
- my ( $data, $rnd ) = @_;
- return _round( kph2mps( mph2kph( $data, 9 ), 9 ), $rnd );
- }
- # Length: convert in (inch) to mm (milimeter)
- sub in2mm($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data * 25.4, $rnd );
- }
- # Length: convert in (inch) to cm (centimeter)
- sub in2cm($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data / 0.39370, $rnd );
- }
- # Length: convert ft (feet) to m (meter)
- sub ft2m($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data / 3.2808, $rnd );
- }
- # Length: convert mi (miles) to km (kilometer)
- sub mi2km($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data * 1.609344, $rnd );
- }
- #################################
- ### Angular conversions
- ###
- # convert direction in degree to point of the compass
- sub direction2compasspoint($;$) {
- my ( $azimuth, $lang ) = @_;
- my $directions_txt_i18n;
- $lang = $main::attr{global}{language} ? $main::attr{global}{language} : "EN"
- unless ($lang);
- if ( $lang && defined( $compasspointss{ lc($lang) } ) ) {
- $directions_txt_i18n = $compasspointss{ lc($lang) };
- }
- else {
- $directions_txt_i18n = $compasspointss{en};
- }
- return @$directions_txt_i18n[
- int( ( ( $azimuth + 11.25 ) % 360 ) / 22.5 )
- ];
- }
- #################################
- ### Solar conversions
- ###
- # Power: convert uW/cm2 (micro watt per square centimeter) to UV-Index
- sub uwpscm2uvi($;$) {
- my ( $data, $rnd ) = @_;
- return 0 unless ($data);
- # Forum topic,44403.msg501704.html#msg501704
- return int( ( $data - 100 ) / 450 + 1 ) unless ( defined($rnd) );
- $rnd = 0 unless ( defined($rnd) );
- return _round( ( ( $data - 100 ) / 450 + 1 ), $rnd );
- }
- # Power: convert UV-Index to uW/cm2 (micro watt per square centimeter)
- sub uvi2uwpscm($) {
- my ($data) = @_;
- return 0 unless ($data);
- return ( $data * ( 450 + 1 ) ) + 100;
- }
- # Power: convert lux to W/m2 (watt per square meter)
- sub lux2wpsm($;$) {
- my ( $data, $rnd ) = @_;
- # Forum topic,44403.msg501704.html#msg501704
- return _round( $data / 126.7, $rnd );
- }
- # Power: convert W/m2 to lux
- sub wpsm2lux($;$) {
- my ( $data, $rnd ) = @_;
- # Forum topic,44403.msg501704.html#msg501704
- return _round( $data * 126.7, $rnd );
- }
- #################################
- ### Nautic unit conversions
- ###
- # Speed: convert smi (statute miles) to nmi (nautical miles)
- sub smi2nmi($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data * 0.8684, $rnd );
- }
- # Speed: convert km (kilometer) to nmi (nautical miles)
- sub km2nmi($;$) {
- my ( $data, $rnd ) = @_;
- return _round( smi2nmi( km2mi( $data, 9 ), 9 ), $rnd );
- }
- # Speed: convert km/h to knots
- sub kph2kn($;$) {
- my ( $data, $rnd ) = @_;
- return _round( $data * 0.539956803456, $rnd );
- }
- # Speed: convert km/h to Beaufort wind force scale
- sub kph2bft($) {
- my ($data) = @_;
- my $val = "0";
- if ( $data >= 118 ) {
- $val = "12";
- }
- elsif ( $data >= 103 ) {
- $val = "11";
- }
- elsif ( $data >= 89 ) {
- $val = "10";
- }
- elsif ( $data >= 75 ) {
- $val = "9";
- }
- elsif ( $data >= 62 ) {
- $val = "8";
- }
- elsif ( $data >= 50 ) {
- $val = "7";
- }
- elsif ( $data >= 39 ) {
- $val = "6";
- }
- elsif ( $data >= 29 ) {
- $val = "5";
- }
- elsif ( $data >= 20 ) {
- $val = "4";
- }
- elsif ( $data >= 12 ) {
- $val = "3";
- }
- elsif ( $data >= 6 ) {
- $val = "2";
- }
- elsif ( $data >= 1 ) {
- $val = "1";
- }
- if (wantarray) {
- my ( $cond, $rgb, $warn ) = bft2condition($val);
- return ( $val, $rgb, $cond, $warn );
- }
- return $val;
- }
- # Speed: convert mph (miles per hour) to Beaufort wind force scale
- sub mph2bft($) {
- my ($data) = @_;
- my $val = "0";
- if ( $data >= 73 ) {
- $val = "12";
- }
- elsif ( $data >= 64 ) {
- $val = "11";
- }
- elsif ( $data >= 55 ) {
- $val = "10";
- }
- elsif ( $data >= 47 ) {
- $val = "9";
- }
- elsif ( $data >= 39 ) {
- $val = "8";
- }
- elsif ( $data >= 32 ) {
- $val = "7";
- }
- elsif ( $data >= 25 ) {
- $val = "6";
- }
- elsif ( $data >= 19 ) {
- $val = "5";
- }
- elsif ( $data >= 13 ) {
- $val = "4";
- }
- elsif ( $data >= 8 ) {
- $val = "3";
- }
- elsif ( $data >= 4 ) {
- $val = "2";
- }
- elsif ( $data >= 1 ) {
- $val = "1";
- }
- if (wantarray) {
- my ( $cond, $rgb, $warn ) = bft2condition($val);
- return ( $val, $rgb, $cond, $warn );
- }
- return $val;
- }
- #################################
- ### Differential conversions
- ###
- sub distance($$$$;$$) {
- my ( $lat1, $lng1, $lat2, $lng2, $rnd, $unit ) = @_;
- return _round( "0.000000000", $rnd )
- if ( $lat1 eq $lat2 && $lng1 eq $lng2 );
- use constant M_PI => 4 * atan2( 1, 1 );
- my $pi80 = M_PI / 180;
- $lat1 *= $pi80;
- $lng1 *= $pi80;
- $lat2 *= $pi80;
- $lng2 *= $pi80;
- my $r = 6372.797; # mean radius of Earth in km
- my $dlat = $lat2 - $lat1;
- my $dlng = $lng2 - $lng1;
- my $a =
- sin( $dlat / 2 ) * sin( $dlat / 2 ) +
- cos($lat1) * cos($lat2) * sin( $dlng / 2 ) * sin( $dlng / 2 );
- my $c = 2 * atan2( sqrt($a), sqrt( 1 - $a ) );
- my $km = $r * $c;
- return _round(
- ( $unit eq "nmi" ? km2nmi($km) : ( $unit ? km2mi($km) : $km ) ), $rnd );
- }
- sub duration ($$;$) {
- my ( $datetimeNow, $datetimeOld, $format ) = @_;
- if ( $datetimeNow eq "" || $datetimeOld eq "" ) {
- $datetimeNow = "1970-01-01 00:00:00";
- $datetimeOld = "1970-01-01 00:00:00";
- }
- my $timestampNow = main::time_str2num($datetimeNow);
- my $timestampOld = main::time_str2num($datetimeOld);
- my $timeDiff = $timestampNow - $timestampOld;
- # return seconds
- return _round( $timeDiff, 0 )
- if ( defined($format) && $format eq "sec" );
- # return minutes
- return _round( $timeDiff / 60, 0 )
- if ( defined($format) && $format eq "min" );
- # return human readable format
- return s2hms( _round( $timeDiff, 0 ) );
- }
- #################################
- ### Textual unit conversions
- ###
- ######## humanReadable #########################################
- # What : Formats a number or text string to be more readable for humans
- # Syntax: { humanReadable( <value>, [ <format> ] ) }
- # Call : { humanReadable(102345.6789) }
- # { humanReadable(102345.6789, 3) }
- # { humanReadable(102345.6789, "DE") }
- # { humanReadable(102345.6789, "si-fr") }
- # { humanReadable(102345.6789, {
- # group=>3, delim=>".", sep=>"," } ) }
- # { humanReadable("DE44500105175407324931", {
- # group=>4, rev=>0 } ) }
- # Source: https://en.wikipedia.org/wiki/Decimal_mark
- # https://de.wikipedia.org/wiki/Schreibweise_von_Zahlen
- # https://de.wikipedia.org/wiki/Dezimaltrennzeichen
- # https://de.wikipedia.org/wiki/Zifferngruppierung
- sub humanReadable($;$) {
- my ( $v, $f ) = @_;
- my $l =
- $main::attr{global}{humanReadable} ? $main::attr{global}{humanReadable}
- : (
- $main::attr{global}{language} ? $main::attr{global}{language}
- : "EN"
- );
- my $h =
- !$f || ref($f) || !$hr_formats{$f} ? $f
- : (
- $hr_formats{$f}{ref} ? $hr_formats{ $hr_formats{$f}{ref} }
- : $hr_formats{$f}
- );
- my $min =
- ref($h)
- && defined( $h->{min} )
- ? $h->{min}
- : ( !ref($f) && $hr_formats{$f}{min} ? $hr_formats{$f}{min} : 5 );
- my $group =
- ref($h)
- && defined( $h->{group} )
- ? $h->{group}
- : ( !ref($f) && $hr_formats{$f}{group} ? $hr_formats{$f}{group} : 3 );
- my $delim =
- ref($h)
- && $h->{delim}
- ? $h->{delim}
- : $hr_formats{ ( $l =~ /^de|nl|fr|pl/i ? "std-fr" : "std" ) }{delim};
- my $sep =
- ref($h)
- && $h->{sep}
- ? $h->{sep}
- : $hr_formats{ ( $l =~ /^de|nl|fr|pl/i ? "std-fr" : "std" ) }{sep};
- my $reverse = ref($h) && defined( $h->{rev} ) ? $h->{rev} : 1;
- my @p = split( /\./, $v, 2 );
- if ( length( $p[0] ) < $min && length( $p[1] ) < $min ) {
- $v =~ s/\./$sep/g;
- return $v;
- }
- $v =~ s/\./\*/g;
- # digits after thousands separator
- if ( ( $delim eq "\x{202F}" || $delim eq " " )
- && length( $p[1] ) >= $min )
- {
- $v =~ s/(\w{$group})(?=\w)(?!\w*\*)/$1$delim/g;
- }
- # digits before thousands separator
- if ( length( $p[0] ) >= $min ) {
- $v = reverse $v if ($reverse);
- $v =~ s/(\w{$group})(?=\w)(?!\w*\*)/$1$delim/g;
- if ($reverse) {
- $v =~ s/\*/$sep/g;
- return scalar reverse $v;
- }
- }
- $v =~ s/\*/$sep/g;
- return $v;
- }
- # ######## machineReadable #########################################
- # # What : find the first matching number in a string and make it
- # # machine readable.
- # # Syntax: { machineReadable( <value>, [ <global>, [ <format> ]] ) }
- # # Call : { machineReadable("102 345,6789") }
- # sub machineReadable($;$) {
- # my ( $v, $g ) = @_;
- #
- # sub mrVal($$) {
- # my ( $n, $n2 ) = @_;
- # $n .= "." . $n2 if ($n2);
- # $n =~ s/[^\d\.]//g;
- # return $n;
- # }
- #
- #
- # foreach ( "std", "std-fr" ) {
- # my $delim = '\\' . $hr_formats{$_}{delim};
- # $delim .= ' ' if ($_ =~ /^std/);
- #
- # if ( $g
- # && $v =~
- # s/((-?)((?:\d+(?:[$delim]\d)*)+)([\.\,])((?:\d+(?:[$delim]\d)*)+)?)/$2.mrVal($3, $5)/eg
- # )
- # {
- # last;
- # }
- # elsif ( $v =~
- # m/^((\-?)((?:\d(?:[$delim]\d)*)+)(?:([\.\,])((?:\d(?:[$delim]\d)*)+))?)/ )
- # {
- # $v = $2 . mrVal( $3, $5 );
- # last;
- # }
- # }
- #
- # return $v;
- # }
- # Condition: convert temperature (Celsius) to temperature condition
- sub c2condition($;$) {
- my ( $data, $indoor ) = @_;
- my $val = "freeze";
- my $rgb = "0055BB";
- if ($indoor) {
- $data -= 5 if ( $data < 22.5 );
- $data += 5 if ( $data > 25 );
- }
- if ( $data >= 35 ) {
- $val = "hot";
- $rgb = "C72A23";
- }
- elsif ( $data >= 30 ) {
- $val = "high";
- $rgb = "E7652B";
- }
- elsif ( $data >= 14 ) {
- $val = "ideal";
- $rgb = "4C9329";
- }
- elsif ( $data >= 5 ) {
- $val = "low";
- $rgb = "009999";
- }
- elsif ( $data >= 2.5 || $indoor ) {
- $val = "cold";
- $rgb = "0066CC";
- }
- return ( $val, $rgb ) if (wantarray);
- return $val;
- }
- # Condition: convert humidity (percent) to humidity condition
- sub humidity2condition($;$) {
- my ( $data, $indoor ) = @_;
- my $val = "dry";
- my $rgb = "C72A23";
- if ( $data >= 80 ) {
- $val = "wet";
- $rgb = "0066CC";
- }
- elsif ( $data >= 70 ) {
- $val = "high";
- $rgb = "009999";
- }
- elsif ( $data >= 50 ) {
- $val = "ideal";
- $rgb = "4C9329";
- }
- elsif ( $data >= 40 ) {
- $val = "low";
- $rgb = "E7652B";
- }
- return ( $val, $rgb ) if (wantarray);
- return $val;
- }
- # Condition: convert UV-Index to UV condition
- sub uvi2condition($) {
- my ($data) = @_;
- my $val = "low";
- my $rgb = "4C9329";
- if ( $data > 11 ) {
- $val = "extreme";
- $rgb = "674BC4";
- }
- elsif ( $data > 8 ) {
- $val = "veryhigh";
- $rgb = "C72A23";
- }
- elsif ( $data > 6 ) {
- $val = "high";
- $rgb = "E7652B";
- }
- elsif ( $data > 3 ) {
- $val = "moderate";
- $rgb = "F4E54C";
- }
- return ( $val, $rgb ) if (wantarray);
- return $val;
- }
- # Condition: convert Beaufort to wind condition
- sub bft2condition($) {
- my ($data) = @_;
- my $rgb = "FEFEFE";
- my $cond = "calm";
- my $warn = " ";
- if ( $data == 12 ) {
- $rgb = "E93323";
- $cond = "hurricane_force";
- $warn = "hurricane_force";
- }
- elsif ( $data == 11 ) {
- $rgb = "EB4826";
- $cond = "violent_storm";
- $warn = "storm_force";
- }
- elsif ( $data == 10 ) {
- $rgb = "E96E2C";
- $cond = "storm";
- $warn = "storm_force";
- }
- elsif ( $data == 9 ) {
- $rgb = "F19E38";
- $cond = "strong_gale";
- $warn = "gale_force";
- }
- elsif ( $data == 8 ) {
- $rgb = "F7CE46";
- $cond = "gale";
- $warn = "gale_force";
- }
- elsif ( $data == 7 ) {
- $rgb = "FFFF54";
- $cond = "near_gale";
- $warn = "high_winds";
- }
- elsif ( $data == 6 ) {
- $rgb = "D6FD51";
- $cond = "strong_breeze";
- $warn = "high_winds";
- }
- elsif ( $data == 5 ) {
- $rgb = "B1FC4F";
- $cond = "fresh_breeze";
- }
- elsif ( $data == 4 ) {
- $rgb = "B1FC7B";
- $cond = "moderate_breeze";
- }
- elsif ( $data == 3 ) {
- $rgb = "B1FCA3";
- $cond = "gentle_breeze";
- }
- elsif ( $data == 2 ) {
- $rgb = "B1FCD0";
- $cond = "light_breeze";
- }
- elsif ( $data == 1 ) {
- $rgb = "D6FEFE";
- $cond = "light_air";
- }
- return ( $cond, $rgb, $warn ) if (wantarray);
- return $cond;
- }
- sub values2weathercondition($$$$$) {
- my ( $temp, $hum, $light, $isday, $israining ) = @_;
- my $val = "clear";
- if ($israining) {
- $val = "rain";
- }
- elsif ( $light > 40000 ) {
- $val = "sunny";
- }
- elsif ($isday) {
- $val = "cloudy";
- }
- $val = "nt_" . $val unless ($isday);
- return $val;
- }
- #################################
- ### Chronological conversions
- ###
- sub hms2s($) {
- my $in = shift;
- my @a = split( ":", $in );
- return 0 if ( scalar @a < 2 || $in !~ m/^[\d:]*$/ );
- return $a[0] * 3600 + $a[1] * 60 + ( $a[2] ? $a[2] : 0 );
- }
- sub hms2m($) {
- return hms2s(@_) / 60;
- }
- sub hms2h($) {
- return hms2m(@_) / 60;
- }
- sub s2hms($) {
- my ($in) = @_;
- my ( $h, $m, $s );
- $h = int( $in / 3600 );
- $m = int( ( $in - $h * 3600 ) / 60 );
- $s = int( $in - $h * 3600 - $m * 60 );
- return ( $h, $m, $s ) if (wantarray);
- return sprintf( "%02d:%02d:%02d", $h, $m, $s );
- }
- sub m2hms($) {
- my ($in) = @_;
- my ( $h, $m, $s );
- $h = int( $in / 60 );
- $m = int( $in - $h * 60 );
- $s = int( 60 * ( $in - $h * 60 - $m ) );
- return ( $h, $m, $s ) if (wantarray);
- return sprintf( "%02d:%02d:%02d", $h, $m, $s );
- }
- sub h2hms($) {
- my ($in) = @_;
- my ( $h, $m, $s );
- $h = int($in);
- $m = int( 60 * ( $in - $h ) );
- $s = int( 3600 * ( $in - $h ) - 60 * $m );
- return ( $h, $m, $s ) if (wantarray);
- return sprintf( "%02d:%02d:%02d", $h, $m, $s );
- }
- sub IsLeapYear (;$) {
- # Either the value 0 or the value 1 is returned.
- # If 0, it is not a leap year. If 1, it is a
- # leap year. (Works for Julian calendar,
- # established in 1582)
- my $y = shift;
- return undef
- unless ( !$y || $y =~ /^\d{10}(?:\.\d+)?$/ || $y =~ /^[1-2]\d{3}$/ );
- if ( !$y || $y !~ /^[1-2]\d{3}$/ ) {
- my $today = _time($y);
- $y = $today->{year};
- }
- # If $year is not evenly divisible by 4, it is
- # not a leap year; therefore, we return the
- # value 0 and do no further calculations in
- # this subroutine. ("$year % 4" provides the
- # remainder when $year is divided by 4.
- # If there is a remainder then $year is
- # not evenly divisible by 4.)
- return 0 if $y % 4;
- # At this point, we know $year is evenly divisible
- # by 4. Therefore, if it is not evenly
- # divisible by 100, it is a leap year --
- # we return the value 1 and do no further
- # calculations in this subroutine.
- return 1 if $y % 100;
- # At this point, we know $year is evenly divisible
- # by 4 and also evenly divisible by 100. Therefore,
- # if it is not also evenly divisible by 400, it is
- # not leap year -- we return the value 0 and do no
- # further calculations in this subroutine.
- return 0 if $y % 400;
- # Now we know $year is evenly divisible by 4, evenly
- # divisible by 100, and evenly divisible by 400.
- # We return the value 1 because it is a leap year.
- return 1;
- }
- sub IsDst(;$) {
- my ($time) = @_;
- my $ret = _time($time);
- return $ret->{isdst};
- }
- sub IsWeekend(;$) {
- my ($time) = @_;
- my $ret = _time($time);
- return $ret->{iswe};
- }
- sub IsHoliday(;$) {
- my ($time) = @_;
- my $ret = _time($time);
- return $ret->{isholiday};
- }
- # Get current stage of the daytime based on temporal hours
- # https://de.wikipedia.org/wiki/Temporale_Stunden
- sub GetDaytime(;$$$$) {
- my ( $time, $totalTemporalHours, $lang, $params ) = @_;
- $lang = (
- $main::attr{global}{language}
- ? $main::attr{global}{language}
- : "EN"
- ) unless ($lang);
- my $ret = ref($time) eq "HASH" ? $time : _time( $time, $lang, 1, $params );
- return undef unless ( ref($ret) eq "HASH" );
- $ret->{daytimeStages} = $totalTemporalHours
- && $totalTemporalHours =~ m/^\d+$/ ? $totalTemporalHours : 12;
- # TODO: consider srParams
- $ret->{sunrise} = main::sunrise_abs_dat( $ret->{time_t} );
- $ret->{sunrise_s} = hms2s( $ret->{sunrise} );
- $ret->{sunrise_t} = $ret->{midnight_t} + $ret->{sunrise_s};
- $ret->{sunset} = main::sunset_abs_dat( $ret->{time_t} );
- $ret->{sunset_s} = hms2s( $ret->{sunset} );
- $ret->{sunset_t} = $ret->{midnight_t} + $ret->{sunset_s};
- $ret->{isday} = $ret->{time_t} >= $ret->{sunrise_t}
- && $ret->{time_t} < $ret->{sunset_t} ? 1 : 0;
- $ret->{daytimeRel_s} =
- hms2s("$ret->{hour}:$ret->{min}:$ret->{sec}") - $ret->{sunrise_s};
- $ret->{daytimeRel} = s2hms( $ret->{daytimeRel_s} );
- $ret->{daytimeT_s} = $ret->{sunset_s} - $ret->{sunrise_s};
- $ret->{daytimeT} = s2hms( $ret->{daytimeT_s} );
- $ret->{daytimeStageLn_s} =
- $ret->{daytimeT_s} / $ret->{daytimeStages};
- $ret->{daytimeStageLn} = s2hms( $ret->{daytimeStageLn_s} );
- $ret->{daytimeStage_float} =
- $ret->{daytimeRel_s} / $ret->{daytimeStageLn_s};
- $ret->{daytimeStage} =
- int( ( ( $ret->{daytimeRel_s} + 1 ) / $ret->{daytimeStageLn_s} ) + 1 );
- $ret->{daytimeStage} = 0
- if ( $ret->{daytimeStage} < 1
- || $ret->{daytimeStage} > $ret->{daytimeStages} );
- # include season data
- $ret = GetSeason( $ret, $lang );
- #$ret = GetSeasonPheno( $ret, $lang );
- #$ret = GetSeasonSocial( $ret, $lang ); #TODO https://de.wikipedia.org/wiki/F%C3%BCnfte_Jahreszeit
- # change midnight event when season changes
- $ret->{events}{ $ret->{midnight_t} }{VALUE} = 1
- if ( $ret->{seasonMeteoChng} && $ret->{seasonMeteoChng} == 1 );
- $ret->{events}{ $ret->{midnight_t} }{DESC} .=
- ", Begin meteorological $ret->{seasonMeteo_long} season"
- if ( $ret->{seasonMeteoChng} && $ret->{seasonMeteoChng} == 1 );
- $ret->{events}{ $ret->{midnight_t} }{VALUE} = 2
- if ( $ret->{seasonAstroChng} && $ret->{seasonAstroChng} == 1 );
- $ret->{events}{ $ret->{midnight_t} }{DESC} .=
- ", Begin astronomical $ret->{seasonAstro_long} season"
- if ( $ret->{seasonAstroChng} && $ret->{seasonAstroChng} == 1 );
- # calculate daytime from daytimeStage, season and DST
- my $ds = $ret->{daytimeStage};
- while ( !defined( $ret->{daytime} ) ) {
- #TODO let user define %sdt2daytimes through attribute
- $ret->{daytime} =
- $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }{$ds}
- if (
- $sdt2daytimes{ $ret->{seasonMeteo} }
- && $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }
- && defined(
- $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }{$ds}
- )
- );
- $ds--;
- # when no relation was found
- unless ( defined( $ret->{daytime} ) || $ds > -1 ) {
- # assume midevening after sunset
- if ( $ret->{time_s} >= $ret->{sunset_s} ) {
- $ret->{daytime} = 5;
- }
- # assume night before sunrise
- else {
- $ret->{daytime} = 6;
- }
- }
- }
- # daytime during evening and night
- unless ( $ret->{daytimeStage} ) {
- $ret->{daytime} = 4 unless ( $ret->{daytime} > 4 );
- $ret->{daytime} = 5 unless ( $ret->{daytime} > 5 || $ret->{isday} );
- $ret->{daytime} = 6 if ( $ret->{time_s} < $ret->{sunrise_s} );
- }
- $ret->{daytime_long} = $daytimes{en}[ $ret->{daytime} ];
- my @langs = ('EN');
- push @langs, $lang unless ( $lang =~ /^EN/i );
- foreach (@langs) {
- my $l = lc($_);
- $l =~ s/^([a-z]+).*/$1/g;
- next unless ( $daytimes{$l} );
- my $h = $l eq "en" ? $ret : \%{ $ret->{$_} };
- $h->{daytime_long} = $daytimes{$l}[ $ret->{daytime} ];
- }
- # calculate daily schedule
- #
- # Midnight
- $ret->{events}{ $ret->{midnight_t} }{TYPE} = "dayshift";
- $ret->{events}{ $ret->{midnight_t} }{TIME} =
- main::FmtDateTime( $ret->{midnight_t} );
- $ret->{events}{ $ret->{midnight_t} }{DESC} =
- "Begin of night time and new calendar day";
- $ret->{events}{ $ret->{1}{midnight_t} }{TYPE} = "dayshift";
- $ret->{events}{ $ret->{1}{midnight_t} }{TIME} = $ret->{date} . " 24:00:00";
- $ret->{events}{ $ret->{1}{midnight_t} }{DESC} =
- "End of calendar day and begin night time";
- # Holidays
- $ret->{events}{ $ret->{midnight_t} }{DESC} .=
- ", $daystages{en}[2]: $ret->{day_desc}"
- if ( $ret->{isholiday} );
- $ret->{events}{ $ret->{1}{midnight_t} }{DESC} .=
- ", $daystages{en}[2]: $ret->{1}{day_desc}"
- if ( $ret->{1}{isholiday} );
- # DST change
- #FIXME TODO
- if ( $ret->{dstchange} && $ret->{dstchange} == 1 ) {
- my $t = $ret->{midnight_t} + 2 * 60 * 60;
- $ret->{events}{$t}{TYPE} = "dstshift";
- $ret->{events}{$t}{VALUE} = $ret->{isdst};
- $ret->{events}{$t}{TIME} = main::FmtDateTime($t);
- $ret->{events}{$t}{DESC} = "Begin of standard time (-1h)"
- unless ( $ret->{isdst} );
- $ret->{events}{$t}{DESC} = "Begin of daylight saving time (+1h)"
- if ( $ret->{isdst} );
- }
- # daytime stage event forecast for today
- my $i = 1;
- my $b = $ret->{sunrise_t};
- while ( $i <= $ret->{daytimeStages} + 1 ) {
- # find daytime
- my $daytime;
- $daytime = $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }{$i}
- if (
- $sdt2daytimes{ $ret->{seasonMeteo} }
- && $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }
- && defined(
- $sdt2daytimes{ $ret->{seasonMeteo} }{ $ret->{isdst} }{$i}
- )
- );
- # create event
- my $t = int( $b + 0.5 );
- $ret->{events}{$t}{TIME} = main::FmtDateTime($t);
- if ( $i == $ret->{daytimeStages} + 1 ) {
- $ret->{events}{$t}{TYPE} = "daytime";
- $ret->{events}{$t}{VALUE} = "midevening";
- $ret->{events}{$t}{DESC} =
- "End of daytime";
- }
- else {
- $ret->{events}{$t}{TYPE} = "daytimeStage";
- $ret->{events}{$t}{VALUE} = $i;
- $ret->{events}{$t}{DESC} = "Begin of daytime stage $i"
- unless ($daytime);
- if ( defined($daytime) ) {
- $ret->{events}{$t}{TYPE} = "daytime";
- $ret->{events}{$t}{VALUE} = $daytimes{en}[$daytime];
- $ret->{events}{$t}{DESC} =
- "Begin of $daytimes{en}[$daytime] time and daytime stage $i";
- }
- }
- $i++;
- $b += $ret->{daytimeStageLn_s};
- }
- return $ret;
- }
- sub GetSeason (;$$$);
- sub GetSeason (;$$$) {
- my ( $time, $lang, $meteo ) = @_;
- $lang = (
- $main::attr{global}{language}
- ? $main::attr{global}{language}
- : "EN"
- ) unless ($lang);
- my $ret;
- my $wanthash = 0;
- if ( !$time ) {
- $time = time;
- }
- elsif ( ref($time) eq "HASH" ) {
- $ret = $time;
- $wanthash = 1;
- }
- elsif ( $time =~ /^(?:0|1|2|3)$/ ) {
- return $seasons{ lc($lang) }
- ? $seasons{ lc($lang) }[$time]
- : $seasons{en}[$time];
- }
- elsif ( $time =~ /[A-Za-z]/ ) {
- my $index =
- $seasons{ lc($lang) }
- ? _GetIndexFromArray( $time, $seasons{ lc($lang) } )
- : undef;
- return $index;
- }
- elsif ( $time !~ /^\d{10}(?:\.\d+)?$/ ) {
- return undef;
- }
- else {
- $ret = _time($time);
- }
- my $index = 0;
- $index = 3 if ( $ret->{mon} <= 1 );
- $index++ if ( $ret->{mon} >= 5 );
- $index++ if ( $ret->{mon} >= 8 );
- $index++ if ( $ret->{mon} == 11 );
- $ret->{seasonMeteo} = $index;
- $index = 0;
- $index = 3 if ( $ret->{yday} < ( 80 + $ret->{isly} ) );
- $index++ if ( $ret->{yday} >= ( 173 + $ret->{isly} ) );
- $index++ if ( $ret->{yday} >= ( 265 + $ret->{isly} ) );
- $index++ if ( $ret->{yday} >= ( 356 + $ret->{isly} ) );
- $ret->{seasonAstro} = $index;
- unless (wantarray) {
- ( $ret->{'-1'}{seasonMeteo}, $ret->{'-1'}{seasonAstro} ) =
- GetSeason( $ret->{'-1'}{time_t}, $lang );
- ( $ret->{1}{seasonMeteo}, $ret->{1}{seasonAstro} ) =
- GetSeason( $ret->{1}{time_t}, $lang );
- }
- # text strings
- my @langs = ('EN');
- push @langs, $lang unless ( $lang =~ /^EN/i );
- foreach (@langs) {
- my $l = lc($_);
- $l =~ s/^([a-z]+).*/$1/g;
- next unless ( $seasons{$l} );
- my $h = $l eq "en" ? $ret : \%{ $ret->{$_} };
- $h->{seasonMeteo_long} = $seasons{$l}[ $ret->{seasonMeteo} ];
- $h->{seasonAstro_long} = $seasons{$l}[ $ret->{seasonAstro} ];
- }
- if ( $ret->{seasonMeteo} ne $ret->{1}{seasonMeteo} ) {
- $ret->{seasonMeteoChng} = 2;
- }
- if ( $ret->{'-1'}
- && defined( $ret->{'-1'}{seasonMeteo} )
- && defined( $ret->{'-1'}{seasonAstro} )
- && $ret->{1}
- && defined( $ret->{1}{seasonMeteo} )
- && defined( $ret->{1}{seasonAstro} ) )
- {
- $ret->{'-1'}{seasonMeteoChng} = 0;
- $ret->{seasonMeteoChng} = 0;
- $ret->{1}{seasonMeteoChng} = 0;
- if ( $ret->{seasonMeteo} ne $ret->{1}{seasonMeteo} ) {
- $ret->{seasonMeteoChng} = 2;
- $ret->{1}{seasonMeteoChng} = 1;
- }
- elsif ( $ret->{seasonMeteo} ne $ret->{'-1'}{seasonMeteo} ) {
- $ret->{'-1'}{seasonMeteoChng} = 2;
- $ret->{seasonMeteoChng} = 1;
- }
- $ret->{'-1'}{seasonAstroChng} = 0;
- $ret->{seasonAstroChng} = 0;
- $ret->{1}{seasonAstroChng} = 0;
- if ( $ret->{seasonAstro} ne $ret->{1}{seasonAstro} ) {
- $ret->{seasonAstroChng} = 2;
- $ret->{1}{seasonAstroChng} = 1;
- }
- elsif ( $ret->{seasonAstro} ne $ret->{'-1'}{seasonAstro} ) {
- $ret->{'-1'}{seasonAstroChng} = 2;
- $ret->{seasonAstroChng} = 1;
- }
- }
- return $ret if ($wanthash);
- return ( $ret->{seasonMeteo}, $ret->{seasonAstro} ) if (wantarray);
- return $ret->{$lang}{seasonMeteo_long}
- ? $ret->{$lang}{seasonMeteo_long}
- : $ret->{seasonMeteo_long}
- if ($meteo);
- return $ret->{$lang}{seasonAstro_long}
- ? $ret->{$lang}{seasonAstro_long}
- : $ret->{seasonAstro_long};
- }
- # Estimate phenologic season from astro and meteo season
- # https://de.wikipedia.org/wiki/Ph%C3%A4nologie#Ph.C3.A4nologischer_Kalender
- sub GetSeasonPheno (;$$) {
- $lang = (
- $main::attr{global}{language}
- ? $main::attr{global}{language}
- : "EN"
- ) unless ($lang);
- if ( !$time ) {
- $time = time;
- }
- elsif ( $time =~ /^(?:0|1|2|3|4|5|6|7|8|9|10|11)$/ ) {
- return $seasonsPheno{ lc($lang) }
- ? $seasonsPheno{ lc($lang) }[$time]
- : $seasonsPheno{en}[$time];
- }
- elsif ( $time =~ /[A-Za-z]/ ) {
- my $index =
- $seasonsPheno{ lc($lang) }
- ? _GetIndexFromArray( $time, $seasonsPheno{ lc($lang) } )
- : undef;
- return $index;
- }
- elsif ( $time !~ /^\d{10}(?:\.\d+)?$/ ) {
- return undef;
- }
- my (
- $sec, $min, $hour,
- $mday, $mdayrem, $month,
- $monthISO, $year, $week,
- $weekISO, $wday, $wdayISO,
- $yday, $ydayrem, $isdst,
- $isLeapYear, $iswe, $isHolidayYesterday,
- $isHolidayToday, $isHolidayTomorrow
- ) = GetDaySchedule($time);
- my ( $seasonAstro, $seasonAstroIndex, $seasonAstroChng ) = GetSeason($time);
- my ( $seasonMeteo, $seasonMeteoIndex, $seasonMeteoChng ) =
- GetSeason( $time, "en", 1 );
- # stick to astro season first
- my $index = $seasons{pheno}[$seasonAstro];
- # meteos say it's spring time
- if ( $seasonMeteo == 0 ) {
- $index = 0;
- }
- # meteos say it's summer time
- elsif ( $seasonMeteo == 1 ) {
- $index = 3;
- }
- # meteos say it's autumn time
- elsif ( $seasonMeteo == 2 ) {
- $index = 6;
- }
- # meteos say it's winter time
- elsif ( $seasonMeteo == 3 ) {
- $index = 9;
- }
- # if we know our position and spring is ahead
- if ( ( $index == 0 || $index == 1 )
- && $main::attr{global}{latitude}
- && $main::attr{global}{longitude} )
- {
- # it starts in south-west Portugal
- my $dist = distance(
- $main::attr{global}{latitude},
- $main::attr{global}{longitude},
- 37.136633, -8.817837
- );
- # TODO: let begin of early spring be set by user
- my $earlySpringBegin = main::time_str2num("$year-02-28 00:00:00");
- my $days = ( $time - $earlySpringBegin ) / ( 60 * 60 * 24 );
- # comes with 40km per day
- my $currDist = $dist - ( $days * 40 );
- # when season reached location
- if ( $currDist <= 0 ) {
- $index = 2;
- }
- # when season made 60% of it's way
- elsif ( $currDist <= $dist * 0.4 ) {
- $index = 1;
- }
- }
- # assume spring progress from calendar
- elsif ( ( $index == 0 || $index == 1 ) ) {
- $index = 1 if ( $monthISO == 4 );
- $index = 2 if ( $monthISO == 5 );
- }
- # assume summer progress from calendar
- elsif ( $index == 3 ) {
- $index = 4 if ( $monthISO == 7 );
- $index = 5 if ( $monthISO == 8 );
- }
- # if we know our position and autumn is ahead
- elsif (( $index == 6 || $index == 7 )
- && $main::attr{global}{latitude}
- && $main::attr{global}{longitude} )
- {
- # it starts in Helsinki
- my $dist = distance(
- $main::attr{global}{latitude},
- $main::attr{global}{longitude},
- 60.161880, 24.937267
- );
- # TODO: let begin of early autumn be set by user
- my $earlySpringBegin = main::time_str2num("$year-09-01 00:00:00");
- my $days = ( $time - $earlySpringBegin ) / ( 60 * 60 * 24 );
- # comes with 40km per day
- my $currDist = $dist - ( $days * 40 );
- # when season reached location
- if ( $currDist <= 0 ) {
- $index = 8;
- }
- # when season made 60% of it's way
- elsif ( $currDist <= $dist * 0.4 ) {
- $index = 7;
- }
- }
- # assume autumn progress from calendar
- elsif ( ( $index == 6 || $index == 7 ) ) {
- $index = 7 if ( $monthISO == 10 );
- $index = 8 if ( $monthISO == 11 );
- }
- my $seasonPheno =
- defined($index)
- && $index{ lc($lang) }
- ? $seasonsPheno{ lc($lang) }[$index]
- : $seasonsPheno{en}[$index];
- return ( $seasonPheno, $index ) if (wantarray);
- return ($seasonPheno);
- }
- ####################
- # HELPER FUNCTIONS
- sub decimal_mark ($$) {
- my ( $val, $f ) = @_;
- return $val unless ( looks_like_number($val) && $f );
- my $text = reverse $val;
- if ( $f eq "2" ) {
- $text =~ s:\.:,:g;
- $text =~ s/(\d\d\d)(?=\d)(?!\d*,)/$1./g;
- }
- else {
- $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
- }
- return scalar reverse $text;
- }
- sub _round($;$) {
- my ( $val, $n ) = @_;
- $n = 1 unless ( defined($n) );
- return sprintf( "%.${n}f", $val );
- }
- sub _time(;$$$$);
- sub _time(;$$$$) {
- my ( $time, $lang, $dayOffset, $params ) = @_;
- $dayOffset = 1 if ( !defined($dayOffset) || $dayOffset !~ /^-?\d+$/ );
- $lang = (
- $main::attr{global}{language}
- ? $main::attr{global}{language}
- : "EN"
- ) unless ($lang);
- return undef
- unless ( !$time || $time =~ /^\d{10}(?:\.\d+)?$/ );
- my %ret;
- $ret{time_t} = $time if ($time);
- $ret{time_t} = time unless ($time);
- $ret{params} = $params if ($params);
- my @t = localtime( $ret{time_t} );
- (
- $ret{sec}, $ret{min}, $ret{hour}, $ret{mday}, $ret{mon},
- $ret{year}, $ret{wday}, $ret{yday}, $ret{isdst}
- ) = @t;
- $ret{monISO} = $ret{mon} + 1;
- $ret{year} += 1900;
- $ret{date} =
- sprintf( "%04d-%02d-%02d", $ret{year}, $ret{monISO}, $ret{mday} );
- $ret{time} = sprintf( "%02d:%02d", $ret{hour}, $ret{min} );
- $ret{time_hms} =
- sprintf( "%02d:%02d:%02d", $ret{hour}, $ret{min}, $ret{sec} );
- $ret{time_s} = hms2s( $ret{time_hms} ); #FIXME for DST change
- $ret{datetime} = $ret{date} . " " . $ret{time_hms};
- $ret{midnight_t} = $ret{time_t} - $ret{time_s}; #FIXME for DST change
- # get leap year status
- $ret{isly} = IsLeapYear( $ret{year} );
- # remaining monthdays
- $ret{mdayrem} = 0;
- $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 1 );
- $ret{mdayrem} = 28 + $ret{isly} - $ret{mday}
- if ( $ret{monISO} == 2 );
- $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 3 );
- $ret{mdayrem} = 30 - $ret{mday} if ( $ret{monISO} == 4 );
- $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 5 );
- $ret{mdayrem} = 30 - $ret{mday} if ( $ret{monISO} == 6 );
- $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 7 );
- $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 8 );
- $ret{mdayrem} = 30 - $ret{mday} if ( $ret{monISO} == 9 );
- $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 10 );
- $ret{mdayrem} = 30 - $ret{mday} if ( $ret{monISO} == 11 );
- $ret{mdayrem} = 31 - $ret{mday} if ( $ret{monISO} == 12 );
- # remaining yeardays
- $ret{ydayrem} = 365 + $ret{isly} - $ret{yday};
- # ISO 8601 weekday as number with Monday as 1 (1-7)
- $ret{wdaynISO} = strftime( '%u', @t );
- # Week number with the first Sunday as the first day of week one (00-53)
- $ret{week} = strftime( '%U', @t );
- # ISO 8601 week number (00-53)
- $ret{weekISO} = strftime( '%V', @t );
- # weekend
- $ret{iswe} = ( $ret{wday} == 0 || $ret{wday} == 6 ) ? 1 : 0;
- # text strings
- my @langs = ('EN');
- push @langs, $lang unless ( $lang =~ /^EN/i );
- foreach (@langs) {
- my $l = lc($_);
- $l =~ s/^([a-z]+).*/$1/g;
- next unless ( $months{$l} );
- my $h = $l eq "en" ? \%ret : \%{ $ret{$_} };
- $h->{dst_long} = $dst{$l}[ $ret{isdst} ];
- $h->{rday_long} = $reldays{$l}[1];
- $h->{day_desc} = $daystages{$l}[ $ret{iswe} ];
- $h->{wday_long} = $days{$l}[ $ret{wday} ];
- $h->{wday_short} = $dayss{$l}[ $ret{wday} ];
- $h->{mon_long} = $months{$l}[ $ret{mon} ];
- $h->{mon_short} = $monthss{$l}[ $ret{mon} ];
- $h->{date_long} =
- _ReplaceStringByHashKey( \%ret, $dateformats{$l}, $_ );
- $h->{date_short} =
- _ReplaceStringByHashKey( \%ret, $dateformatss{$l}, $_ );
- }
- # holiday
- if ($dayOffset) {
- $ret{'-1'}{isholiday} = 0;
- $ret{1}{isholiday} = 0;
- }
- $ret{isholiday} = 0;
- my $holidayDev =
- $main::attr{global}{holiday2we}
- && main::IsDevice( $main::attr{global}{holiday2we}, "holiday" )
- ? $main::attr{global}{holiday2we}
- : undef;
- if ($holidayDev) {
- my $date = sprintf( "%02d-%02d", $ret{monISO}, $ret{mday} );
- $tod = main::holiday_refresh( $holidayDev, $date );
- if ($dayOffset) {
- $date =
- sprintf( "%02d-%02d", $ret{'-1'}{monISO}, $ret{'-1'}{mday} );
- $ytd = main::holiday_refresh( $holidayDev, $date );
- $date = sprintf( "%02d-%02d", $ret{1}{monISO}, $ret{1}{mday} );
- $tom = main::holiday_refresh( $holidayDev, $date );
- }
- if ( $tod ne "none" ) {
- $ret{iswe} += 2;
- $ret{isholiday} = 1;
- $ret{day_desc} = $tod;
- foreach (@langs) {
- my $l = lc($_);
- $l =~ s/^([a-z]+).*/$1/g;
- next unless ( $months{$l} );
- my $h = $l eq "en" ? \%ret : \%{ $ret{$_} };
- $h->{day_desc} = $tod;
- }
- }
- if ($dayOffset) {
- if ( $ytd ne "none" && $ret{'-1'} ) {
- $ret{'-1'}{isholiday} = 1;
- $ret{'-1'}{day_desc} = $ytd;
- foreach (@langs) {
- my $l = lc($_);
- $l =~ s/^([a-z]+).*/$1/g;
- next unless ( $months{$l} );
- my $h = $l eq "en" ? $ret{'-1'} : \%{ $ret{'-1'}{$_} };
- $h->{day_desc} = $ytd;
- }
- }
- if ( $tom ne "none" && $ret{1} ) {
- $ret{1}{isholiday} = 1;
- $ret{1}{day_desc} = $tom;
- foreach (@langs) {
- my $l = lc($_);
- $l =~ s/^([a-z]+).*/$1/g;
- next unless ( $months{$l} );
- my $h = $l eq "en" ? $ret{1} : \%{ $ret{1}{$_} };
- $h->{day_desc} = $tom;
- }
- }
- }
- }
- if (wantarray) {
- my @a;
- foreach (
- 'sec', 'min', 'hour', 'mday', 'mon',
- 'year', 'wday', 'wdayn', 'yday', 'isdst',
- 'mdayrem', 'monISO', 'week', 'weekISO', 'wdayISO',
- 'wdaynISO', 'ydayrem', 'time_t', 'datetime', 'date',
- 'time_hms', 'time', 'isly',
- )
- {
- push @a, $ret{$_};
- }
- return @a;
- }
- elsif ($dayOffset) {
- my $i = $dayOffset * -1;
- while ( $i < $dayOffset + 1 ) {
- $ret{$i} = _time( $ret{time_t} + ( 24 * 60 * 60 * $i ), $lang, 0 )
- unless ( $i == 0 );
- foreach (@langs) {
- my $l = $_;
- $l =~ s/^([A-Z-a-z]+).*/$1/g;
- $l = lc($l);
- next if ( $i == 0 || !$reldays{$l} );
- my $h = $l eq "en" ? \%{ $ret{$i} } : \%{ $ret{$i}{$l} };
- if ( $i == -1 || $i == 1 ) {
- $h->{rday_long} = $reldays{$l}[ $i + 1 ];
- }
- else {
- delete $h->{rday_long};
- }
- }
- $i++;
- }
- # DST change
- $ret{'-1'}{dstchange} = 0;
- $ret{dstchange} = 0;
- $ret{1}{dstchange} = 0;
- if ( $ret{isdst} ne $ret{1}{isdst} ) {
- $ret{dstchange} = 2;
- $ret{1}{dstchange} = 1;
- }
- elsif ( $ret{isdst} ne $ret{'-1'}{isdst} ) {
- $ret{'-1'}{dstchange} = 2;
- $ret{dstchange} = 1;
- }
- }
- return \%ret;
- }
- sub _GetIndexFromArray($$) {
- my ( $string, $array ) = @_;
- return undef unless ( ref($array) eq "ARRAY" );
- my ($index) = grep { $array->[$_] =~ /^$string$/i } ( 0 .. @$array - 1 );
- return defined $index ? $index : undef;
- }
- sub _ReplaceStringByHashKey($$;$) {
- my ( $hash, $string, $sublvl ) = @_;
- return $string unless ( $hash && ref($hash) eq "HASH" );
- $string = _ReplaceStringByHashKey( $hash->{$sublvl}, $string )
- if ( $sublvl && $hash->{$sublvl} );
- foreach my $key ( keys %{$hash} ) {
- next if ( ref( $hash->{$key} ) );
- my $val = $hash->{$key};
- $string =~ s/%$key%/$val/gi;
- $string =~ s/\$$key/$val/g;
- }
- return $string;
- }
- 1;
|