# rddb.pm # # rhrdlibs # # Copyright (C) 2015-2016 Christian Pointner # # This file is part of rhrdlibs. # # rhrdlibs is free software: you can redistribute it and/or modify # it under the terms of the GNU Affero General Public License as published by # the Free Software Foundation, either version 3 of the License, or # any later version. # # rhrdlibs is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Affero General Public License for more details. # # You should have received a copy of the GNU Affero General Public License # along with rhrdlibs. If not, see . # package RHRD::utils; use strict; use POSIX; use DateTime; use DateTime::TimeZone; use LWP::Simple; use URI::Fetch; use JSON::MaybeXS; use URI::QueryParam; sub get_rd_week { my ($time) = @_; # # This computes the current Rivendell Week based on the number # of weeks since epoch. # # Explanation: # epoch was at 01.01.1970 which was a Thursday. # Monday in that week is (s-from-epoch + 3*24*60*60) seconds ago. # This needs to be adjusted by the timezone offset for Europe/Vienna # which is of course not constant (damn you daylight savings time) # Divide this by (7*24*60*60) and you get the number of # weeks since the Monday in the week of epoch adjusted for timezone offsets. # This week had week number 3 so add an offset of 2 and # get the modulo of 4. This rounded down gives you the current week # with 0 meaning Week 1. So add 1 to that number and you will get # the current RD week. # if(!defined($time)) { $time = DateTime->now(); } my $tz = DateTime::TimeZone->new(name => 'Europe/Vienna'); my $tz_offset = $tz->offset_for_datetime($time); my $sEpoch = $time->epoch() + $tz_offset; my $week = floor(((($sEpoch + 259200)/604800) + 2) % 4) + 1; return $week; } use constant { DB_PARAM_TYPE_HINT => "only S, M and J are allowed with S -> Show, M -> Musicpool, J -> Jingles", DB_PARAM_RHYTHM_HINT => "only 0 or 1 are allowed, length must be exactly 4 and it must not be '0000'", DB_PARAM_DOW_HINT => "must be between 1 and 7 (1=Monday, ..., 7=Sunday)", DB_PARAM_STARTTIME_HINT => "must be in format HHMM (without seperator) in 24 hour format", DB_PARAM_LEN_HINT => "must be a positive number below 1440", CMDLINE_WEEK_HINT => "must be one of W1, W2, W3, W4", CMDLINE_DOW_HINT => "must be one of MO, TU, WE, TH, FR, SA, SU", }; sub dropbox_param_type_ok { my ($type) = @_; unless(defined($type) && ($type == 'S' || $type == 'M' || $type == 'J')) { return (0, "unkown type '" . (defined($type) ? $type : 'undef') . "'", DB_PARAM_TYPE_HINT); } return (1, 'OK', DB_PARAM_TYPE_HINT); } sub dropbox_param_rhythm_ok { my ($rhythm) = @_; if(!defined($rhythm) || $rhythm !~ m/^[01]{4}$/ || $rhythm eq '0000') { return (0, "rhythm '" . (defined($rhythm) ? $rhythm : 'undef') . "' contains illegal characters or is too long/short", DB_PARAM_RHYTHM_HINT); } return (1, 'OK', DB_PARAM_RHYTHM_HINT); } sub dropbox_param_dow_ok { my ($dow) = @_; if(!defined($dow) || $dow < 1 || $dow > 7) { return (0, "dow '" . (defined($dow) ? $dow : 'undef') . "' is out of bounds", DB_PARAM_DOW_HINT); } return (1, 'OK', DB_PARAM_DOW_HINT); } sub dropbox_param_starttime_ok { my ($starttime) = @_; if(!defined($starttime) || $starttime !~ m/^[0-2][0-9][0-5][0-9]$/ || $starttime > 2359) { return (0, "starttime '" . (defined($starttime) ? $starttime : 'undef') . "' is not a valid clock time", DB_PARAM_STARTTIME_HINT); } return (1, 'OK', DB_PARAM_STARTTIME_HINT); } sub dropbox_param_len_ok { my ($len) = @_; if(!defined($len) || $len <= 0 || $len > 1440) { return (0, "len '" . (defined($len) ? $len : 'undef') . "' is out of bounds", DB_PARAM_LEN_HINT); } return (1, 'OK', DB_PARAM_LEN_HINT); } sub cmdline_rdweek { my ($dow) = @_; if(uc($dow) eq "W1") { return (1, 'OK', CMDLINE_WEEK_HINT); } elsif(uc($dow) eq "W2") { return (2, 'OK', CMDLINE_WEEK_HINT); } elsif(uc($dow) eq "W3") { return (3, 'OK', CMDLINE_WEEK_HINT); } elsif(uc($dow) eq "W4") { return (4, 'OK', CMDLINE_WEEK_HINT); } return (undef, 'invalid week', CMDLINE_WEEK_HINT); } sub cmdline_dow { my ($dow) = @_; if(uc($dow) eq "MO") { return (1, 'OK', CMDLINE_DOW_HINT); } elsif(uc($dow) eq "TU") { return (2, 'OK', CMDLINE_DOW_HINT); } elsif(uc($dow) eq "WE") { return (3, 'OK', CMDLINE_DOW_HINT); } elsif(uc($dow) eq "TH") { return (4, 'OK', CMDLINE_DOW_HINT); } elsif(uc($dow) eq "FR") { return (5, 'OK', CMDLINE_DOW_HINT); } elsif(uc($dow) eq "SA") { return (6, 'OK', CMDLINE_DOW_HINT); } elsif(uc($dow) eq "SU") { return (7, 'OK', CMDLINE_DOW_HINT); } return (undef, 'invalid day-of-week', CMDLINE_DOW_HINT); } sub fetch_parse_json { my ($url, $ua_str, $headers, $queries) = @_; my $uri = URI->new($url); if (defined $queries) { while(my ($name, $value) = each %{$queries}) { $uri->query_param($name => $value); } } $ua_str = "Radio Helsinki Rivendell Utilities" unless $ua_str; my $ua = LWP::UserAgent->new; $ua->agent($ua_str); $ua->env_proxy; if (defined $headers) { while(my ($field, $value) = each %{$headers}) { $ua->default_header($field, $value); } } my $res = URI::Fetch->fetch($uri, UserAgent => $ua) or return (0, URI::Fetch->errstr); if($res->status == URI::Fetch::URI_GONE()) { return (0, "This resource has been permanently removed"); } my $json = $res->content; my $data; eval { my $j = JSON::MaybeXS->new(utf8 => 0); $data = $j->decode($json); 1; } or do { return (0, "error parsing import result"); }; return (1, $data); } return 1;