forked from HPR/hpr-tools
		
	
		
			
	
	
		
			865 lines
		
	
	
		
			26 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
		
		
			
		
	
	
			865 lines
		
	
	
		
			26 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
| 
								 | 
							
								#!/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
							 | 
						||
| 
								 | 
							
								
							 |