865 lines
26 KiB
Perl
Executable File
865 lines
26 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
#===============================================================================
|
|
#
|
|
# FILE: reserve_cnews
|
|
#
|
|
# USAGE: ./reserve_cnews [-from[=DATE]] [-count=COUNT] [-[no]dry-run]
|
|
# [-[no]silent] [-config=FILE] [-help] [-debug=N]
|
|
#
|
|
# DESCRIPTION: Reserve a series of slots from a given date for the Community
|
|
# News shows by computing the dates for the reservations and
|
|
# then working out the show numbers from there.
|
|
#
|
|
# OPTIONS: ---
|
|
# REQUIREMENTS: ---
|
|
# BUGS: ---
|
|
# NOTES: ---
|
|
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
|
|
# VERSION: 0.0.14
|
|
# CREATED: 2014-04-29 22:16:00
|
|
# REVISION: 2023-04-10 16:05:36
|
|
#
|
|
#===============================================================================
|
|
|
|
use 5.010;
|
|
use strict;
|
|
use warnings;
|
|
use utf8;
|
|
|
|
use Getopt::Long;
|
|
use Pod::Usage;
|
|
|
|
use Config::General;
|
|
|
|
use Date::Parse;
|
|
use Date::Calc qw{:all};
|
|
|
|
use DBI;
|
|
|
|
use Data::Dumper;
|
|
|
|
#
|
|
# Version number (manually incremented)
|
|
#
|
|
our $VERSION = '0.0.14';
|
|
|
|
#
|
|
# Script name
|
|
#
|
|
( my $PROG = $0 ) =~ s|.*/||mx;
|
|
( my $DIR = $0 ) =~ s|/?[^/]*$||mx;
|
|
$DIR = '.' unless $DIR;
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Declarations
|
|
#-------------------------------------------------------------------------------
|
|
#
|
|
# Constants and other declarations
|
|
#
|
|
my $basedir = "$ENV{HOME}/HPR/Community_News";
|
|
my $configfile = "$basedir/.hpr_db.cfg";
|
|
|
|
my $hostname = 'HPR Volunteers';
|
|
my $seriesname = 'HPR Community News';
|
|
my $tags = 'Community News';
|
|
|
|
my $titlefmt = 'HPR Community News for %s %d';
|
|
my $summaryfmt = 'HPR Volunteers talk about shows released and comments '
|
|
. 'posted in %s %d';
|
|
|
|
my ( $dbh, $sth1, $sth2, $sth3, $h1, $h2, $rv );
|
|
my (@startdate, @rdate, @lastmonth, $show,
|
|
$hostid, $series, $title, $summary
|
|
);
|
|
|
|
#
|
|
# Enable Unicode mode
|
|
#
|
|
binmode STDOUT, ":encoding(UTF-8)";
|
|
binmode STDERR, ":encoding(UTF-8)";
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Options and arguments
|
|
#-------------------------------------------------------------------------------
|
|
my $DEFDEBUG = 0;
|
|
my $DEF_COUNT = 12;
|
|
|
|
#
|
|
# Process options
|
|
#
|
|
my %options;
|
|
Options( \%options );
|
|
|
|
#
|
|
# Default help
|
|
#
|
|
pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 )
|
|
if ( $options{'help'} );
|
|
|
|
#
|
|
# Collect options
|
|
#
|
|
my $DEBUG = ( $options{'debug'} ? $options{'debug'} : $DEFDEBUG );
|
|
my $cfgfile
|
|
= ( defined( $options{config} ) ? $options{config} : $configfile );
|
|
my $dry_run = ( defined( $options{'dry-run'} ) ? $options{'dry-run'} : 0 );
|
|
my $silent = ( defined( $options{silent} ) ? $options{silent} : 0 );
|
|
my $count = ( defined( $options{count} ) ? $options{count} : $DEF_COUNT );
|
|
my $from = $options{from};
|
|
|
|
_debug( $DEBUG >= 1, 'Host name: ' . $hostname );
|
|
_debug( $DEBUG >= 1, 'Series name: ' . $seriesname );
|
|
_debug( $DEBUG >= 1, 'Tags: ' . $tags );
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Configuration file - load data
|
|
#-------------------------------------------------------------------------------
|
|
my $conf = new Config::General(
|
|
-ConfigFile => $cfgfile,
|
|
-InterPolateVars => 1,
|
|
-ExtendedAccess => 1
|
|
);
|
|
my %config = $conf->getall();
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Connect to the database
|
|
#-------------------------------------------------------------------------------
|
|
my $dbhost = $config{database}->{host} // '127.0.0.1';
|
|
my $dbport = $config{database}->{port} // 3306;
|
|
my $dbname = $config{database}->{name};
|
|
my $dbuser = $config{database}->{user};
|
|
my $dbpwd = $config{database}->{password};
|
|
$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
|
|
$dbuser, $dbpwd, { AutoCommit => 1 } )
|
|
or die $DBI::errstr;
|
|
|
|
#
|
|
# Enable client-side UTF8
|
|
#
|
|
$dbh->{mysql_enable_utf8} = 1;
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Find the latest show for reference purposes
|
|
#-------------------------------------------------------------------------------
|
|
$sth1 = $dbh->prepare(
|
|
# q{SELECT id, date FROM eps
|
|
# WHERE DATEDIFF(date,CURDATE()) <= 0 AND DATEDIFF(date,CURDATE()) >= -2
|
|
# ORDER BY date DESC LIMIT 1}
|
|
q{SELECT id, date FROM eps
|
|
WHERE DATEDIFF(date,CURDATE()) BETWEEN -2 AND 0
|
|
ORDER BY date DESC LIMIT 1}
|
|
);
|
|
$sth1->execute;
|
|
if ( $dbh->err ) {
|
|
warn $dbh->errstr;
|
|
}
|
|
|
|
$h1 = $sth1->fetchrow_hashref;
|
|
|
|
my $ref_date = $h1->{date};
|
|
my $ref_show = $h1->{id};
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Find the required hostid
|
|
#-------------------------------------------------------------------------------
|
|
$sth1 = $dbh->prepare(q{SELECT hostid FROM hosts WHERE host = ?});
|
|
$sth1->execute($hostname);
|
|
if ( $dbh->err ) {
|
|
warn $dbh->errstr;
|
|
}
|
|
|
|
unless ( $h1 = $sth1->fetchrow_hashref ) {
|
|
warn "Unable to find host '$hostname' - cannot continue\n";
|
|
exit 1;
|
|
}
|
|
|
|
$hostid = $h1->{hostid};
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Find the required series
|
|
#-------------------------------------------------------------------------------
|
|
$sth1 = $dbh->prepare(q{SELECT id FROM miniseries WHERE name = ?});
|
|
$sth1->execute($seriesname);
|
|
if ( $dbh->err ) {
|
|
warn $dbh->errstr;
|
|
}
|
|
|
|
unless ( $h1 = $sth1->fetchrow_hashref ) {
|
|
warn "Unable to find series '$seriesname' - cannot continue\n";
|
|
exit 1;
|
|
}
|
|
|
|
$series = $h1->{id};
|
|
|
|
_debug( $DEBUG >= 2, 'Reference date: ' . $ref_date );
|
|
_debug( $DEBUG >= 2, 'Reference show: ' . $ref_show );
|
|
_debug( $DEBUG >= 2, 'Host id: ' . $hostid );
|
|
_debug( $DEBUG >= 2, 'Series id: ' . $series );
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# The start date comes from the -from=DATE option, the database or is defaulted
|
|
#-------------------------------------------------------------------------------
|
|
#
|
|
# Use the date provided or the default
|
|
#
|
|
if ( ! defined( $from ) ) {
|
|
#
|
|
# Compute the first of the current month
|
|
#
|
|
_debug($DEBUG >= 3, "From date: Default");
|
|
@startdate = ( ( Today() )[ 0 .. 1 ], 1 );
|
|
}
|
|
elsif ( $from =~ /^$/ ) {
|
|
_debug($DEBUG >= 3, "From date: Database");
|
|
@startdate = get_next_date( $dbh, $series );
|
|
}
|
|
else {
|
|
#
|
|
# Parse the date, convert to start of month
|
|
#
|
|
_debug($DEBUG >= 3, "From date: Explicit");
|
|
@startdate = convert_date( $from, 0 );
|
|
}
|
|
_debug($DEBUG >= 3,"Start date: " . ISO8601_Date(@startdate));
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Set up for date manipulation
|
|
#-------------------------------------------------------------------------------
|
|
my @cdate = @startdate;
|
|
my $monday = 1; # Day of week number 1-7, Monday-Sunday
|
|
print "Start date: ", ISO8601_Date(@startdate), "\n" unless ($silent);
|
|
|
|
#
|
|
# The reference show, taken from the database
|
|
#
|
|
my @ref_date = split( /-/, $ref_date );
|
|
print "Reference show: hpr$ref_show on ", ISO8601_Date(@ref_date), "\n\n"
|
|
unless ($silent);
|
|
|
|
#
|
|
# Prepare some SQL (Note stopgap fix for the INSERT statement associated with $sth3)
|
|
#
|
|
$sth1 = $dbh->prepare(q{SELECT id FROM eps where id = ?});
|
|
$sth2 = $dbh->prepare(q{SELECT id, date FROM eps where title = ?});
|
|
$sth3 = $dbh->prepare(
|
|
q{
|
|
INSERT INTO eps (id,date,hostid,title,summary,series,tags,
|
|
duration,notes,downloads)
|
|
VALUES(?,?,?,?,?,?,?,0,'',0)
|
|
}
|
|
);
|
|
|
|
#
|
|
# Compute a series of dates from the start date
|
|
#
|
|
for my $i ( 1 .. $count ) {
|
|
#
|
|
# Determine the next first Monday of the month and the show number that
|
|
# goes with it
|
|
#
|
|
@rdate = make_date( \@cdate, $monday, 1, 0 );
|
|
$show = $ref_show + Delta_Business_Days( @ref_date, @rdate );
|
|
_debug($DEBUG >= 3,"Date: " . ISO8601_Date(@rdate) . " Show: $show");
|
|
|
|
#
|
|
# Make the text strings for this month
|
|
#
|
|
@lastmonth = Add_Delta_YM( @rdate, 0, -1 );
|
|
$title
|
|
= sprintf( $titlefmt, Month_to_Text( $lastmonth[1] ), $lastmonth[0] );
|
|
$summary
|
|
= sprintf( $summaryfmt, Month_to_Text( $lastmonth[1] ),
|
|
$lastmonth[0] );
|
|
_debug($DEBUG >= 3,"Title: $title");
|
|
_debug($DEBUG >= 3,"Summary: $summary");
|
|
|
|
#
|
|
# Do we already have a show with this title?
|
|
#
|
|
$rv = $sth2->execute($title);
|
|
if ( $dbh->err ) {
|
|
warn $dbh->errstr;
|
|
}
|
|
if ( $rv > 0 ) {
|
|
$h2 = $sth2->fetchrow_hashref;
|
|
unless ($silent) {
|
|
printf
|
|
"Skipping; an episode already exists with title '%s' (hpr%s, %s)\n",
|
|
$title, $h2->{id}, $h2->{date};
|
|
}
|
|
@cdate = Add_Delta_YM( @cdate, 0, 1 );
|
|
next;
|
|
}
|
|
|
|
#
|
|
# Is this show number taken?
|
|
#
|
|
$rv = $sth1->execute($show);
|
|
if ( $dbh->err ) {
|
|
warn $dbh->errstr;
|
|
}
|
|
if ( $rv > 0 ) {
|
|
#
|
|
# Find a free slot
|
|
#
|
|
print "Slot $show for '$title' is allocated. " unless ($silent);
|
|
until ( $rv == 0 && ( Day_of_Week(@rdate) < 6 ) ) {
|
|
$show++ if ( Day_of_Week(@rdate) < 6 );
|
|
@rdate = Add_Delta_Days( @rdate, 1 );
|
|
$rv = $sth1->execute($show);
|
|
if ( $dbh->err ) {
|
|
warn $dbh->errstr;
|
|
}
|
|
}
|
|
print "Next free slot is $show\n" unless ($silent);
|
|
}
|
|
|
|
#
|
|
# Reserve the slot or pretend to
|
|
#
|
|
unless ($dry_run) {
|
|
$rv = $sth3->execute( $show, ISO8601_Date(@rdate), $hostid,
|
|
$title, $summary, $series, $tags );
|
|
if ( $dbh->err ) {
|
|
warn $dbh->errstr;
|
|
}
|
|
if ( $rv > 0 ) {
|
|
printf "Reserved show hpr%d on %s for '%s'\n",
|
|
$show, ISO8601_Date(@rdate), $title
|
|
unless ($silent);
|
|
}
|
|
else {
|
|
print "Error reserving slot for '$title'\n" unless ($silent);
|
|
}
|
|
}
|
|
else {
|
|
printf "Show hpr%d on %s for '%s' not reserved - dry run\n",
|
|
$show, ISO8601_Date(@rdate), $title
|
|
unless ($silent);
|
|
}
|
|
|
|
@cdate = Add_Delta_YM( @cdate, 0, 1 );
|
|
}
|
|
|
|
for my $sth ( $sth1, $sth2, $sth3 ) {
|
|
$sth->finish;
|
|
}
|
|
|
|
$dbh->disconnect;
|
|
|
|
exit;
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: convert_date
|
|
# PURPOSE: Convert a textual date (ideally YYYY-MM-DD) to a Date::Calc
|
|
# date for the start of the given month.
|
|
# PARAMETERS: $textdate date in text form
|
|
# $force Boolean defining whether to skip validating
|
|
# the date
|
|
# RETURNS: The start of the month in the textual date in Date::Calc
|
|
# format
|
|
# DESCRIPTION: Parses the date string and makes a Date::Calc date from the
|
|
# result where the day part is 1. Optionally checks that the
|
|
# date isn't in the past, though $force = 1 ignores this check.
|
|
# THROWS: No exceptions
|
|
# COMMENTS: Requires Date::Calc and Date::Parse
|
|
# Note the validation 'die' has a non-generic message
|
|
# SEE ALSO: N/A
|
|
#===============================================================================
|
|
sub convert_date {
|
|
my ( $textdate, $force ) = @_;
|
|
|
|
my ( @today, @parsed, @startdate );
|
|
|
|
#
|
|
# Reference date
|
|
#
|
|
@today = Today();
|
|
|
|
#
|
|
# Parse and perform rudimentary validation on the $textdate date. Function
|
|
# 'strptime' returns "($ss,$mm,$hh,$day,$month,$year,$zone,$century)".
|
|
#
|
|
# The Date::Calc date $startdate[0] gets the returned year or the current
|
|
# year if no year was parsed, $startdate[1] gets the parsed month or the
|
|
# current month if no month was parsed, and $startdate[2] gets a day of 1.
|
|
#
|
|
@parsed = strptime($textdate);
|
|
die "Unable to parse date '$textdate'\n" unless @parsed;
|
|
|
|
@startdate = (
|
|
( defined( $parsed[5] ) ? $parsed[5] + 1900 : $today[0] ), # year
|
|
( defined( $parsed[4] ) ? $parsed[4] + 1 : $today[1] ), 1
|
|
);
|
|
|
|
#
|
|
# Unless we've overridden the check there should be a positive or zero
|
|
# difference in days between the target date and today's date to prevent
|
|
# going backwards in time.
|
|
#
|
|
unless ($force) {
|
|
unless ( Delta_Days( @today[ 0, 1 ], 1, @startdate ) ge 0 ) {
|
|
warn "Invalid date $textdate (in the past)\n";
|
|
die "Use -force to create a back-dated calendar\n";
|
|
}
|
|
}
|
|
|
|
return @startdate;
|
|
|
|
}
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: get_next_date
|
|
# PURPOSE: Find the next unused date from the database
|
|
# PARAMETERS: $dbh Database handle
|
|
# $series The id of the Community News series (from
|
|
# a previous query)
|
|
# RETURNS: The start of the month of the next free date in Date::Calc
|
|
# format
|
|
# DESCRIPTION: Finds the latest reservation in the database. Uses the date
|
|
# associated with this reservation, converts to Date::Calc
|
|
# format, adds a month to it and ensures it's the first Monday
|
|
# of that month (in case a non-standard reservation had been
|
|
# made)
|
|
# THROWS: No exceptions
|
|
# COMMENTS: TODO: do we need the show number of the latest reservation?
|
|
# SEE ALSO: N/A
|
|
#===============================================================================
|
|
sub get_next_date {
|
|
my ( $dbh, $series ) = @_;
|
|
|
|
my ( $sth, $h );
|
|
my ( $id, $lastdate, @startdate );
|
|
|
|
#
|
|
# Find the last reservation in the database
|
|
#
|
|
$sth = $dbh->prepare( q{
|
|
SELECT id, date
|
|
FROM eps WHERE series = ?
|
|
ORDER BY id DESC LIMIT 1;
|
|
}
|
|
);
|
|
$sth->execute($series);
|
|
if ( $dbh->err ) {
|
|
warn $dbh->errstr;
|
|
}
|
|
|
|
#
|
|
# Get the values returned
|
|
#
|
|
$h = $sth->fetchrow_hashref;
|
|
$id = $h->{id};
|
|
$lastdate = $h->{date};
|
|
|
|
#
|
|
# Convert the date to Date::Calc format, increment by a month and ensure
|
|
# it's the first Monday of the month (in case the last reservation is not
|
|
# on the right day for some reason - such as the day being reserved by
|
|
# some other mechanism)
|
|
#
|
|
@startdate = convert_date( $lastdate, 0 );
|
|
@startdate = Add_Delta_YM( @startdate, 0, 1 );
|
|
@startdate = make_date( \@startdate, 1, 1, 0 );
|
|
|
|
return @startdate;
|
|
}
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: make_date
|
|
# PURPOSE: Make the event date for recurrence
|
|
# PARAMETERS: $refdate
|
|
# An arrayref to the reference date array (usually
|
|
# today's date)
|
|
# $dow Day of week for the event date (1-7, 1=Monday)
|
|
# $n The nth day of the week in the given month required
|
|
# for the event date ($dow=1, $n=1 means first Monday)
|
|
# $offset Number of days to offset the computed date
|
|
# RETURNS: The resulting date as a list for Date::Calc
|
|
# DESCRIPTION: We want to compute a simple date with an offset, such as
|
|
# "the Saturday before the first Monday of the month". We do
|
|
# this by computing a pre-offset date (first Monday of month)
|
|
# then apply the offset (Saturday before).
|
|
# THROWS: No exceptions
|
|
# COMMENTS: TODO Needs more testing to be considered truly universal
|
|
# SEE ALSO:
|
|
#===============================================================================
|
|
sub make_date {
|
|
my ( $refdate, $dow, $n, $offset ) = @_;
|
|
|
|
#
|
|
# Compute the required date: the "$n"th day of week "$dow" in the year and
|
|
# month in @$refdate. This could be a date in the past.
|
|
#
|
|
my @date = Nth_Weekday_of_Month_Year( @$refdate[ 0, 1 ], $dow, $n );
|
|
|
|
#
|
|
# If the computed date plus the offset is before the base date advance
|
|
# a month
|
|
#
|
|
if ( Day_of_Year(@date) + $offset < Day_of_Year(@$refdate) ) {
|
|
#
|
|
# Add a month and recompute
|
|
#
|
|
@date = Add_Delta_YM( @date, 0, 1 );
|
|
@date = Nth_Weekday_of_Month_Year( @date[ 0, 1 ], $dow, $n );
|
|
}
|
|
|
|
#
|
|
# Apply the day offset
|
|
#
|
|
@date = Add_Delta_Days( @date, $offset ) if $offset;
|
|
|
|
#
|
|
# Return a list
|
|
#
|
|
return (@date);
|
|
}
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: Delta_Business_Days
|
|
# PURPOSE: Computes the number of weekdays between two dates
|
|
# PARAMETERS: @date1 - first date in Date::Calc format
|
|
# @date2 - second date in Date::Calc format
|
|
# RETURNS: The business day offset
|
|
# DESCRIPTION: This is a direct copy of the routine of the same name on the
|
|
# Date::Calc manpage.
|
|
# THROWS: No exceptions
|
|
# COMMENTS: Lifted from the manpage for Date::Calc
|
|
# SEE ALSO: N/A
|
|
#===============================================================================
|
|
sub Delta_Business_Days {
|
|
my (@date1) = (@_)[ 0, 1, 2 ];
|
|
my (@date2) = (@_)[ 3, 4, 5 ];
|
|
my ( $minus, $result, $dow1, $dow2, $diff, $temp );
|
|
|
|
$minus = 0;
|
|
$result = Delta_Days( @date1, @date2 );
|
|
if ( $result != 0 ) {
|
|
if ( $result < 0 ) {
|
|
$minus = 1;
|
|
$result = -$result;
|
|
$dow1 = Day_of_Week(@date2);
|
|
$dow2 = Day_of_Week(@date1);
|
|
}
|
|
else {
|
|
$dow1 = Day_of_Week(@date1);
|
|
$dow2 = Day_of_Week(@date2);
|
|
}
|
|
$diff = $dow2 - $dow1;
|
|
$temp = $result;
|
|
if ( $diff != 0 ) {
|
|
if ( $diff < 0 ) {
|
|
$diff += 7;
|
|
}
|
|
$temp -= $diff;
|
|
$dow1 += $diff;
|
|
if ( $dow1 > 6 ) {
|
|
$result--;
|
|
if ( $dow1 > 7 ) {
|
|
$result--;
|
|
}
|
|
}
|
|
}
|
|
if ( $temp != 0 ) {
|
|
$temp /= 7;
|
|
$result -= ( $temp << 1 );
|
|
}
|
|
}
|
|
if ($minus) { return -$result; }
|
|
else { return $result; }
|
|
}
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: ISO8601_Date
|
|
# PURPOSE: Format a Date::Calc date in ISO8601 format
|
|
# PARAMETERS: @date - a date in the Date::Calc format
|
|
# RETURNS: Text string containing a YYYY-MM-DD date
|
|
# DESCRIPTION: Just a convenience to allow a simple call like
|
|
# $str = ISO8601_Date(@date)
|
|
# THROWS: No exceptions
|
|
# COMMENTS: None
|
|
# SEE ALSO: N/A
|
|
#===============================================================================
|
|
sub ISO8601_Date {
|
|
my (@date) = (@_)[ 0, 1, 2 ];
|
|
|
|
if ( check_date(@date) ) {
|
|
return sprintf( "%04d-%02d-%02d", @date );
|
|
}
|
|
else {
|
|
return "*Invalid Date*";
|
|
}
|
|
}
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: _debug
|
|
# PURPOSE: Prints debug reports
|
|
# PARAMETERS: $active Boolean: 1 for print, 0 for no print
|
|
# $message Message to print
|
|
# RETURNS: Nothing
|
|
# DESCRIPTION: Outputs a message if $active is true. It removes any trailing
|
|
# newline and then adds one in the 'print' to the caller doesn't
|
|
# have to bother. Prepends the message with 'D> ' to show it's
|
|
# a debug message.
|
|
# THROWS: No exceptions
|
|
# COMMENTS: None
|
|
# SEE ALSO: N/A
|
|
#===============================================================================
|
|
sub _debug {
|
|
my ( $active, $message ) = @_;
|
|
|
|
chomp($message);
|
|
print "D> $message\n" if $active;
|
|
}
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: Options
|
|
# PURPOSE: Processes command-line options
|
|
# PARAMETERS: $optref Hash reference to hold the options
|
|
# RETURNS: Undef
|
|
# DESCRIPTION:
|
|
# THROWS: no exceptions
|
|
# COMMENTS: none
|
|
# SEE ALSO: n/a
|
|
#===============================================================================
|
|
sub Options {
|
|
my ($optref) = @_;
|
|
|
|
my @options = (
|
|
"help", "debug=i", "config=s", "from:s",
|
|
"count=i", "dry-run!", "silent!",
|
|
);
|
|
|
|
if ( !GetOptions( $optref, @options ) ) {
|
|
pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 );
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
__END__
|
|
|
|
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
# Application Documentation
|
|
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
#{{{
|
|
|
|
=head1 NAME
|
|
|
|
reserve_cnews - reserve Community News shows in the HPR database
|
|
|
|
=head1 VERSION
|
|
|
|
This documentation refers to B<reserve_cnews> version 0.0.14
|
|
|
|
=head1 USAGE
|
|
|
|
./reserve_cnews [-help] [-from[=DATE]] [-count=COUNT]
|
|
[-[no]dry-run] [-[no]silent] [-config=FILE] [-debug=N]
|
|
|
|
Examples:
|
|
|
|
./reserve_cnews -help
|
|
./reserve_cnews
|
|
./reserve_cnews -from=1-June-2014 -dry-run
|
|
./reserve_cnews -from=15-Aug-2015 -count=6
|
|
./reserve_cnews -from=2015-12-06 -count=1 -silent
|
|
./reserve_cnews -from -count=1
|
|
./reserve_cnews -from -count=2 -debug=4
|
|
./reserve_cnews -config=.hpr_livedb.cfg -from=1-March-2019 -dry-run
|
|
|
|
=head1 OPTIONS
|
|
|
|
=over 8
|
|
|
|
=item B<-help>
|
|
|
|
Prints a brief help message describing the usage of the program, and then exits.
|
|
|
|
=item B<-from=DATE> or B<-from>
|
|
|
|
This option defines the starting date from which reservations are to be
|
|
created. The program ignores the day part, though it must be provided, and
|
|
replaces it with the first day of the month.
|
|
|
|
The date format should be B<DD-Mon-YYYY> (e.g. 12-Jun-2014), B<DD-MM-YYYY>
|
|
(e.g. 12-06-2014) or B<YYYY-MM-DD> (e.g. 2014-06-12).
|
|
|
|
If this option is omitted the current date is used.
|
|
|
|
If the B<DATE> part is omitted the script will search the database for the
|
|
reservation with the latest date and will use it as the starting point to
|
|
generate B<-count=COUNT> (or the default 12) reservations.
|
|
|
|
=item B<-count=COUNT>
|
|
|
|
This option defines the number of slots to reserve.
|
|
|
|
If this option is omitted then 12 slots are reserved.
|
|
|
|
=item B<-[no]dry-run>
|
|
|
|
This option in the form B<-dry-run> causes the program omit the step of adding
|
|
reservations to the database. In the form B<-nodry-run> or if omitted, the
|
|
program will perform the update(s).
|
|
|
|
=item B<-[no]silent>
|
|
|
|
This option in the form B<-silent> causes the program omit the reporting of
|
|
what it has done. In the form B<-nosilent> or if omitted, the program will
|
|
report what it is doing.
|
|
|
|
=item B<-config=FILE>
|
|
|
|
This option defines a configuration file other than the default
|
|
I<.hpr_db.cfg>. The file must be formatted as described below in the section
|
|
I<CONFIGURATION AND ENVIRONMENT>.
|
|
|
|
=item B<-debug=N>
|
|
|
|
Sets the level of debugging. The default is 0: no debugging.
|
|
|
|
Values are:
|
|
|
|
=over 4
|
|
|
|
=item 1
|
|
|
|
Produces details of some of the built-in values used.
|
|
|
|
=item 2
|
|
|
|
Produces any output defined for lower levels as well as details of the values
|
|
taken from the database for use when reserving the show(s).
|
|
|
|
=item 3
|
|
|
|
Produces any output defined for lower levels as well as:
|
|
|
|
=over 4
|
|
|
|
=item .
|
|
|
|
Details of how the `-from` date is being interpreted: default, computed from
|
|
the database or explicit. The actual date being used is reported.
|
|
|
|
=item .
|
|
|
|
Details of all dates chosen and their associated sho numbers using the
|
|
algorithm "first Monday of the month".
|
|
|
|
=item .
|
|
|
|
The show title chosen for each reservation is displayed as well as the summary.
|
|
|
|
=back
|
|
|
|
=back
|
|
|
|
=back
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Hacker Public Radio produces a Community News show every month. The show is
|
|
recorded on the Saturday before the first Monday of the month, and should be
|
|
released as soon as possible afterwards.
|
|
|
|
This program reserves future slots in the database for upcoming shows. It
|
|
computes the date of the first Monday of all of the months in the requested
|
|
sequence then determines which show number matches that date. It writes rows
|
|
into the I<reservations> table containing the episode number, the host
|
|
identifier ('HPR Admins') and the reason for the reservation.
|
|
|
|
It is possible that an HPR host has already requested the slot that this
|
|
program determines it should reserve. When this happens the program increments
|
|
the episode number and checks again, and repeats this process until a free
|
|
slot is discovered.
|
|
|
|
It is also possible that a reservation has previously been made in the
|
|
I<reservations> table. When this case occurs the program ignores this
|
|
particular reservation.
|
|
|
|
=head1 DIAGNOSTICS
|
|
|
|
=over 8
|
|
|
|
=item B<Invalid date ...>
|
|
|
|
The date element of the B<-from=DATE> option is not valid. See the description
|
|
of this option for details of what formats are acceptable.
|
|
|
|
=item B<Various database messages>
|
|
|
|
The program can generate warning messages from the database.
|
|
|
|
=item B<Unable to find host '...' - cannot continue>
|
|
|
|
The script needs to find the id number relating to the host that will be used
|
|
for Community News episodes. It does this by looking in the hosts table for
|
|
the name "HPR Volunteers". If this cannot be found, perhaps because it has
|
|
been changed, then the script cannot continue. The remedy is to change the
|
|
variable $hostname to match the new name.
|
|
|
|
=item B<Unable to find series '...' - cannot continue>
|
|
|
|
The script needs to find the id number relating to the series that will be
|
|
used for Community News episodes. It does this by looking in the miniseries
|
|
table for the name "HPR Community News". If this cannot be found, perhaps
|
|
because it has been changed, then the script cannot continue. The remedy is to
|
|
change the variable $seriesname to match the new name.
|
|
|
|
=back
|
|
|
|
|
|
=head1 CONFIGURATION AND ENVIRONMENT
|
|
|
|
The program obtains the credentials it requires for connecting to the HPR
|
|
database by loading them from a configuration file. The file is called
|
|
B<.hpr_db.cfg> and should contain the following data:
|
|
|
|
<database>
|
|
host = 127.0.0.1
|
|
port = PORT
|
|
name = DBNAME
|
|
user = USER
|
|
password = PASSWORD
|
|
</database>
|
|
|
|
=head1 DEPENDENCIES
|
|
|
|
Config::General
|
|
Data::Dumper
|
|
Date::Calc
|
|
Date::Parse
|
|
DBI
|
|
Getopt::Long
|
|
Pod::Usage
|
|
|
|
=head1 BUGS AND LIMITATIONS
|
|
|
|
There are no known bugs in this module.
|
|
Please report problems to Dave Morriss (Dave.Morriss@gmail.com)
|
|
Patches are welcome.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Dave Morriss (Dave.Morriss@gmail.com)
|
|
|
|
=head1 LICENCE AND COPYRIGHT
|
|
|
|
Copyright (c) 2014 - 2023 Dave Morriss (Dave.Morriss@gmail.com). All
|
|
rights reserved.
|
|
|
|
This module is free software; you can redistribute it and/or
|
|
modify it under the same terms as Perl itself. See perldoc perlartistic.
|
|
|
|
=cut
|
|
|
|
#}}}
|
|
|
|
# [zo to open fold, zc to close]
|
|
|
|
# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
|
|
|