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 | ||
|  | 
 |