#!/usr/bin/perl -w # # 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 . # use strict; use RHRD::rddb; use RHRD::utils; use DateTime; use Date::Calc; use DateTime::Format::Strptime; sub print_usage { print STDERR "Usage: rhrd-schedules (generate|get) YYYY-MM-DD\n" . " rhrd-schedules show (W1|W2|W3|W4|ALL) (MO|TU|WE|TH|FR|SA|SU|ALL)\n" . " rhrd-schedules orphans\n"; } sub generate { my ($ctx, $year, $month, $day) = @_; my ($ret, $data) = RHRD::utils::fetch_parse_json("https://pv.helsinki.at/export/day_schedule/$year/$month/$day/", "rhrd-schedules"); if(!$ret) { print STDERR "Error fetching export from PV: $data\n"; return 1; } my $errcnt = 0; my @shows = (); for my $entry (@{$data}) { my $start = DateTime::Format::Strptime::strptime("%Y-%m-%d_%H:%M:%S", ${$entry}{'start'}); my $title = ${$entry}{'title'}; my $pvid = ${$entry}{'id'}; my $showid = ${$entry}{'automation-id'}; next if $pvid == 1; # 'Unmoderiertes Musikprogramm' # maybe only the end is on this day - we don't need this to include in the log since only # start times matter here. next if ($start->year != $year || $start->month != $month || $start->day != $day); if($showid < 0) { print "WARNING: skipping entry whith unset automation id -> $start: $title ($pvid)\n"; $errcnt++; next; } my ($showid_min, $showid_max, $errorstring) = RHRD::rddb::get_showid_range($ctx); unless(defined $showid_min) { print "$showid_max: $errorstring\n"; return 1; } if ($showid < $showid_min || $showid > $showid_max) { print "WARNING: skipping entry whith out of range automation id ($showid) -> $start: $title ($pvid)\n"; next; } (my $exists, my $status, $errorstring) = RHRD::rddb::check_show_exists($ctx, $showid); unless(defined $exists) { print "$status: $errorstring\n"; return 1; } if($exists != 1) { print "WARNING: skipping entry whith not existing automation id ($showid) -> $start: $title ($pvid)\n"; next; } # Rivendell has problems with events starting at midnight if($start->hour == 0 && $start->minute == 0 && $start->second == 0) { $start->set_second(1); } my $show = {}; $show->{'ID'} = $showid; $show->{'START_TIME'} = ($start->hour * 3600) + ($start->minute * 60) + $start->second; push @shows, $show; } my ($result, $status, $errorstring) = RHRD::rddb::create_or_update_schedule_log($ctx, $year, $month, $day, @shows); unless(defined $result) { print "$status: $errorstring\n"; return 1; } return $errcnt; } sub get { my ($ctx, $year, $month, $day) = @_; my @shows = RHRD::rddb::get_schedule_log($ctx, $year, $month, $day); if(!defined $shows[0] && defined $shows[1]) { print STDERR "$shows[1]: $shows[2]\n"; return 1; } for my $href (@shows) { print $href->{'START'} . ": " . $href->{'ID'} . " | " . $href->{'TITLE'} . " (" . $href->{'LEN'} . " ms)\n"; } return 0; } sub show__day { my ($ctx, $year, $month, $day) = @_; print "https://pv.helsinki.at/export/day_schedule/$year/$month/$day/\n"; my ($ret, $data) = RHRD::utils::fetch_parse_json("https://pv.helsinki.at/export/day_schedule/$year/$month/$day/", "rhrd-schedules"); if(!$ret) { print STDERR "Error fetching export from PV: $data\n"; return 1; } my $dow = Date::Calc::Day_of_Week($year, $month, $day); my $week = RHRD::utils::get_rd_week(DateTime->new(year => $year, month => $month, day => $day, hour => 12)); my $errcnt = 0; for my $entry (@{$data}) { my $start = DateTime::Format::Strptime::strptime("%Y-%m-%d_%H:%M:%S", ${$entry}{'start'}); my $start_short = DateTime::Format::Strptime::strftime("%H:%M", $start); my $end = DateTime::Format::Strptime::strptime("%Y-%m-%d_%H:%M:%S", ${$entry}{'end'}); my $duration = $start->delta_ms($end); my $title = ${$entry}{'title'}; my $pvid = ${$entry}{'id'}; my $showid = ${$entry}{'automation-id'}; next if $pvid == 1; # 'Unmoderiertes Musikprogramm' # maybe only the end is on this day - we don't need this to include in the log since only # start times matter here. next if ($start->year != $year || $start->month != $month || $start->day != $day); print " " . DateTime::Format::Strptime::strftime("%H:%M:%S", $start) . ": ($showid) -> "; if($showid > 0) { my ($show, $status, $errorstring) = RHRD::rddb::get_show_info($ctx, $showid); if(!defined $show) { print "$status: $errorstring\n"; $errcnt++; } else { ${$show}{'DOW'} = 7 if ${$show}{'DOW'} == 0; my @weeks = split('', ${$show}{'RHYTHM'}); if ($title ne ${$show}{'TITLE'} && ($title . " (Wiederholung)") ne ${$show}{'TITLE'}) { print "WARNING: title mismatch (PV: '$title' != RD: '" . ${$show}{'TITLE'} . "') -- PV-id: $pvid\n"; $errcnt++; } elsif ($dow != ${$show}{'DOW'}) { print "WARNING: wrong day of week (PV: " . Date::Calc::Day_of_Week_to_Text($dow) . " != RD: " . Date::Calc::Day_of_Week_to_Text(${$show}{'DOW'}) . ") -- PV-id: $pvid\n"; $errcnt++; } elsif ($weeks[$week-1] != '1') { print "WARNING: this is week $week but show rhythm is: " . ${$show}{'RHYTHM'} . " -> show shouldn't air in this week. -- PV-id: $pvid\n"; $errcnt++; } elsif ($duration->{'minutes'} != ${$show}{'LEN'}) { print "WARNING: wrong show length (PV: " . $duration->minutes . " != RD: " . ${$show}{'LEN'} . ") -- PV-id: $pvid\n"; $errcnt++; } elsif ($start_short ne ${$show}{'STARTTIME'}) { print "WARNING: wrong show start-time (PV: " . $start_short . " != RD: " . ${$show}{'STARTTIME'} . ") -- PV-id: $pvid\n"; $errcnt++; } else { print "OK: $title\n"; } } } else { print "ERROR: show '$pvid|$title' not configured\n"; $errcnt++; } } return $errcnt; } # (W1|W2|W3|W4|ALL) sub parse_rdweek { my ($week) = @_; if(uc($week) eq "ALL") { return (1, 2, 3, 4); } my ($w, undef, $hint) = RHRD::utils::cmdline_rdweek($week); unless(defined($w)) { print "error parsing week: $week, " . $hint . " or ALL\n"; return (); } return $w; } # (MO|TU|WE|TH|FR|SA|SU|ALL) sub parse_dow { my ($dow) = @_; if(uc($dow) eq "ALL") { return (1, 2, 3, 4, 5, 6, 7); } my ($d, undef, $hint) = RHRD::utils::cmdline_dow($dow); unless(defined($d)) { print "error parsing day of week: $dow, " . $hint . " or ALL\n"; return (); } return $d; } sub cmp_dates { my ($a, $b) = @_; my $delta = Date::Calc::Delta_Days(@{$a}, @{$b}); if($delta > 0) { return -1; } if($delta < 0) { return 1; } return 0; } sub gen_dates { my ($week, $dow) = @_; my @weeks = parse_rdweek($week); return () unless(@weeks); my @dows = parse_dow($dow); return () unless(@dows); my $curweek = RHRD::utils::get_rd_week(); my @today = Date::Calc::Today(); my @dates = (); for $week (@weeks) { my @base = Date::Calc::Standard_to_Business(@today); if($curweek != $week) { my $diff = ($week - $curweek)*7; @base = Date::Calc::Standard_to_Business(Date::Calc::Add_Delta_Days(@today, $diff)); } for $dow (@dows) { $base[2] = $dow; my @date = Date::Calc::Business_to_Standard(@base); if(Date::Calc::Delta_Days(@today, @date) < 0) { @date = Date::Calc::Add_Delta_Days(@date, 28) } push @dates, \@date; } } return sort { cmp_dates($a, $b) } @dates; } sub show { my ($ctx, $week, $dow) = @_; my @dates = gen_dates($week, $dow); unless(@dates) { return -1; } for my $date (@dates) { print Date::Calc::Date_to_Text(@{$date}) . ":\n"; my $errcnt = show__day($ctx, @{$date}); print " -> $errcnt errors.\n\n"; } return 0; } sub orphans { my ($ctx) = @_; my @dates = gen_dates("ALL", "ALL"); unless(@dates) { return -1; } my @showids = RHRD::rddb::list_showids($ctx); if(!defined $showids[0] && defined $showids[1]) { print STDERR "$showids[1]: $showids[2]"; return -1; } my %shows; for my $showid (@showids) { $shows{$showid} = 0; } for my $date (@dates) { my ($year, $month, $day) = @{$date}; my ($ret, $data) = RHRD::utils::fetch_parse_json("https://pv.helsinki.at/export/day_schedule/$year/$month/$day/", "rhrd-schedules"); if(!$ret) { print STDERR "Error fetching export from PV: $data\n"; return 1; } for my $entry (@{$data}) { my $start = DateTime::Format::Strptime::strptime("%Y-%m-%d_%H:%M:%S", ${$entry}{'start'}); my $pvid = ${$entry}{'id'}; my $showid = ${$entry}{'automation-id'}; next if $pvid == 1; # 'Unmoderiertes Musikprogramm' # maybe only the end is on this day - we don't need this to include in the log since only # start times matter here. next if ($start->year != $year || $start->month != $month || $start->day != $day); if($showid < 0) { next; } $shows{$showid}++; } } for my $showid (sort keys %shows) { if($shows{$showid} == 0) { my ($show, $status, $errorstring) = RHRD::rddb::get_show_info($ctx, $showid); if(!defined $show) { print "$status: $errorstring\n"; } else { print "$showid: " . ${$show}{'TITLE'} . "\n"; } } } return 0; } my $num_args = $#ARGV + 1; if($num_args < 1) { print_usage(); exit(1); } my $cmd = $ARGV[0]; my $ret = 0; my ($ctx, undef, $errorstring) = RHRD::rddb::init(); if(defined $ctx) { if($cmd eq "generate") { if($num_args == 2 && $ARGV[1] =~ m/^(\d{4})-(\d{2})-(\d{2})$/) { $ret = generate($ctx, $1, $2, $3); } else { print_usage(); $ret = 1; } } elsif($cmd eq "get") { if($num_args == 2 && $ARGV[1] =~ m/^(\d{4})-(\d{2})-(\d{2})$/) { $ret = get($ctx, $1, $2, $3); } else { print_usage(); $ret = 1; } } elsif($cmd eq "show") { if($num_args != 3) { print_usage(); $ret = 1; } else { $ret = show($ctx, $ARGV[1], $ARGV[2]); } } elsif($cmd eq "orphans") { if($num_args != 1) { print_usage(); $ret = 1; } else { $ret = orphans($ctx); } } else { print_usage(); $ret = 1; } RHRD::rddb::destroy($ctx); } else { print STDERR "$errorstring\n"; $ret = 1; } exit $ret;