path: root/lib/RHRD/utils.pm

# rddb.pm
#
#  rhrdlibs
#
#  Copyright (C) 2015-2016 Christian Pointner <equinox@helsinki.at>
#
#  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 <http://www.gnu.org/licenses/>.
#

package RHRD::utils;

use strict;
use POSIX;
use IPC::Open3;
use IO::Handle;
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), use 0 for specials",
  DB_PARAM_STARTTIME_HINT => "must be in format HHMM (without seperator) in 24 hour format, use '----' for specials",
  DB_PARAM_LEN_HINT => "must be a positive number below 1440, use 0 for specials",
  DB_PARAM_SHOWTYPE_HINT => "only n, r and s are allowed with n -> normal, r -> re-run, s -> special",

  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   use - for specials",

  # this is a subset of the colors from: stackoverflow.com/questions/2328339
  POOL_COLORS => ["#FFFFFF", "#FFFF00", "#1CE6FF", "#FF34FF", "#FF4A46", "#008941", "#006FA6",
                  "#FFDBE5", "#7A4900", "#0000A6", "#63FFAC", "#B79762", "#004D43", "#8FB0FF",
                  "#5A0007", "#809693", "#FEFFE6", "#4FC601", "#3B5DFF", "#4A3B53", "#FF2F80",
                  "#61615A", "#BA0900", "#6B7900", "#00C2A0", "#FFAA92", "#FF90C9", "#B903AA",
                  "#7B4F4B", "#A1C299", "#0AA6D8", "#00846F", "#997D87", "#D16100", "#6A3A4C",
                  "#FFB500", "#C2FFED", "#A079BF", "#CC0744", "#C0B9B2", "#C2FF99", "#012C58",
                  "#00489C", "#6F0062", "#0CBD66", "#EEC3FF", "#B77B68", "#7A87A1", "#788D66",
                  "#885578", "#FAD09F", "#FF8A9A", "#D157A0", "#BEC459", "#0086ED", "#886F4C",
                  "#549E79", "#FFF69F", "#72418F", "#BC23FF", "#99ADC0", "#3A2465", "#922329",
                  "#5B4534", "#404E55", "#0089A3", "#CB7E98", "#A4E804", "#324E72", "#A30059",
                  "#B4A8BD", "#452C2C", "#636375", "#A3C8C9", "#9B9700", "#D0AC94", "#FF6832",
                  "#575329", "#00FECF", "#B05B6F", "#8CD0FF", "#1E6E00", "#66E1D3", "#CFCDAC",
                  "#A77500", "#6367A9", "#A05837", "#772600", "#D790FF", "#5B4E51", "#8ADBB4",
                  "#83AB58", "#D1F7CE", "#C8D0F6", "#A3A489", "#806C66", "#BF5650", "#66796D",
                  "#DA007C", "#FF1A59"]
};

sub get_musicpool_color
{
  my ($num) = @_;

  $num = 0 if($num < 0 || $num > $#{+POOL_COLORS});
  return POOL_COLORS->[$num];
}

sub dropbox_param_type_ok
{
  my ($type) = @_;

  unless(defined($type) && ($type eq 'S' || $type eq 'M' || $type eq 'J')) {
    return (0, "unknown 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 ne '----' && ($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 dropbox_param_showtype_ok
{
  my ($type) = @_;

  unless(defined($type) && ($type eq 'n' || $type eq 'r' || $type eq 's')) {
    return (0, "unknown show-type '" . (defined($type) ? $type : 'undef') . "'", DB_PARAM_SHOWTYPE_HINT);
  }
  return (1, 'OK', DB_PARAM_SHOWTYPE_HINT);
}

sub dropbox_param_showtype_to_string
{
  my ($type) = @_;

  if($type eq 'n') {
    return "regular";
  } elsif($type eq 'r') {
    return "re-run";
  } elsif($type eq 's') {
    return "special";
  }
  return "invalid show-type!";
}

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);
  } elsif(uc($dow) eq "-") {
    return (0, 'OK', CMDLINE_DOW_HINT);
  }
  return (undef, 'invalid day-of-week', CMDLINE_DOW_HINT);
}

sub cmdline_ask_yn
{
  my ($question) = @_;

  print "$question (y/N)? ";
  my $answer = <STDIN>;
  chomp($answer) if(defined $answer);
  unless(defined $answer && lc($answer) eq 'y') {
    print "aborting.\n";
    return 0;
  }
  return 1;
}

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);
}


#########################################
## PV

sub pv_execute_action
{
  my $action = shift;
  my $stdin = shift;
  my @args = @_;

  my @script = ('python', '/srv/pv/pv/manage.py', $action, @args);

  my ($reader, $writer, $error ) = ( new IO::Handle, new IO::Handle, new IO::Handle );
  $writer->autoflush(1);
  local $SIG{CHLD} = 'DEFAULT';
  my $pid = open3($writer, $reader, $error, @script);
  binmode($reader, ":utf8");
  binmode($writer, ":utf8");
  binmode($error, ":utf8");
  print $writer $stdin if defined($stdin);
  close $writer;
  waitpid $pid, 0;
  my $err_out = join('', <$error>);
  my $read_out = join('', <$reader>);
  if ( $? >> 8 ) {
    my $log = "\n\nPV: executing action returned non-zero value\n";
    $log .= "STDERR:\n" . $err_out . "\n" unless $err_out eq '';
    $log .= "STDOUT:\n" . $read_out . "\n" unless $read_out eq '';
    return(1, $log);
  } else {
    my $log = '';
    $log .= $read_out . "\n" unless $read_out eq '';
    $log .= $err_out . "\n" unless $err_out eq '';
    return(0, $log);
  }
}


return 1;