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