diff --git a/Community_News/.make_email.cfg b/Community_News/.make_email.cfg new file mode 100644 index 0000000..c4bbd4d --- /dev/null +++ b/Community_News/.make_email.cfg @@ -0,0 +1,21 @@ + + server = chatter.skyehaven.net + port = 64738 + room = HPR + # Default day of the week + dayname = Friday + # Times are UTC + starttime = 15:00:00 + endtime = 17:00:00 + # Usually 2 hours are set aside. This value is used when a different start + # time is provided and no end time. + duration = 02 # hours + # Template is in the current directory + template = make_email_template.tpl + + + name = hpr.db + + + name = recording_dates.dat + diff --git a/Community_News/.make_shownotes.cfg b/Community_News/.make_shownotes.cfg new file mode 100644 index 0000000..1f7769e --- /dev/null +++ b/Community_News/.make_shownotes.cfg @@ -0,0 +1,45 @@ +# +# .make_shownotes.cfg (2025-03-27) +# Configuration file for make_shownotes version >= 4 +# + + title_template = HPR Community News for %s %s + summary_template = HPR Volunteers talk about shows released and comments posted in %s %s + # Repeat the following line with each of the desired tags to make an + # array-like structure + tags = Community News + + # Host id for HPR Volunteers + # Series id for HPR Community News series + hostid = 159 + series_id = 47 + + # Day the Community News show is released + releaseday = Monday + + # Default day of the week for the recording + recordingday = Friday + + # Recording times are UTC + starttime = 16:00:00 + endtime = 17:00:00 + + # cache of previous recording dates and times + cache = recording_dates.dat + + # Templates + # --------- + + # Main note template (actually a soft link) + main_template = shownote_template.tpl + + # Used to make a stand-alone HTML file from the default HTML + # fragment + container_template = shownotes_container.tpl + + + + + # Assume a local file + name = hpr.db + diff --git a/Community_News/build_AOB b/Community_News/build_AOB index acd80cc..6d093ef 100755 --- a/Community_News/build_AOB +++ b/Community_News/build_AOB @@ -241,7 +241,8 @@ AOBMKD="$BASEDIR/aob_$startdate.mkd" # --define "table=$TMP1" "$AOBMKD" |\ # pandoc -f markdown-smart -t html5 -o "${AOBMKD%mkd}html"; then # -if pandoc -f markdown-smart -t html5 "$AOBMKD" -o "${AOBMKD%mkd}html"; then +if tpage "$AOBMKD" |\ + pandoc -f markdown-smart -t html5 -o "${AOBMKD%mkd}html"; then echo "Converted $AOBMKD to HTML" else echo "Conversion of $AOBMKD to HTML failed" diff --git a/Community_News/collect_HPR_database b/Community_News/collect_HPR_database new file mode 100755 index 0000000..94604f8 --- /dev/null +++ b/Community_News/collect_HPR_database @@ -0,0 +1,122 @@ +#!/bin/bash - +#=============================================================================== +# +# FILE: collect_HPR_database +# +# USAGE: ./collect_HPR_database +# +# DESCRIPTION: Collects the SQL dump of the public copy of the HPR database +# from the website and converts it to SQLite. +# +# OPTIONS: None +# REQUIREMENTS: --- +# BUGS: --- +# NOTES: There are dependencies on mysql2sqlite and sqlite3. The former +# comes from https://github.com/mysql2sqlite and is expected to +# be in the same directory as this script. The sqlite3 package +# needs to be installed from the repository appropriate to the +# local OS. It is assumed that wget is available. The script +# uses auto-deleted temporary files for the MySQL dump, and the +# dump converted for SQLite. +# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com +# VERSION: 0.0.1 +# CREATED: 2025-02-22 16:52:40 +# REVISION: 2025-02-22 17:56:00 +# +#=============================================================================== + +set -o nounset # Treat unset variables as an error + +SCRIPT=${0##*/} +BASEDIR=${0%/*} + +VERSION="0.0.1" + +# {{{ -- Functions: cleanup_temp +#=== FUNCTION ================================================================ +# NAME: cleanup_temp +# DESCRIPTION: Cleanup temporary files in case of a keyboard interrupt +# (SIGINT) or a termination signal (SIGTERM) and at script +# exit. Expects to be called from 'trap' so it can just exit +# (assuming it's all that's called) +# PARAMETERS: * - names of temporary files to delete +# RETURNS: Nothing +#=============================================================================== +function cleanup_temp { + for tmp; do + [ -e "$tmp" ] && rm --force "$tmp" + done + exit 0 +} +# }}} + +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +# +# Make sure we're where the script lives +# +cd "$BASEDIR" || { echo "$SCRIPT: Failed to cd to $BASEDIR"; exit 1; } + +# +# Make temporary files and set traps to delete them +# +TMP1=$(mktemp) || { + echo "$SCRIPT: creation of temporary file failed!" + exit 1 +} +TMP2=$(mktemp) || { + echo "$SCRIPT: creation of temporary file failed!" + exit 1 +} +trap 'cleanup_temp $TMP1 $TMP2' SIGHUP SIGINT SIGPIPE SIGTERM EXIT + +# +# Definition of files +# +#------------------------------------------------------------------------------- +mysql2sqlite="$BASEDIR/mysql2sqlite" +snapshot_url="https://www.hackerpublicradio.org/hpr.sql" +db_name="hpr.db" +#------------------------------------------------------------------------------- + +# +# Sanity check +# +[ -e "$mysql2sqlite" ] || { + echo "$SCRIPT: Unable to find mandatory script $mysql2sqlite" + exit 1 +} + +# +# Collect the SQL dump into a temporary file` +# +if ! wget -q "$snapshot_url" -O "$TMP1"; then + echo "$SCRIPT: Failed to download from $snapshot_url" + exit 1 +fi + +# +# Delete the SQLite database if it exists (otherwise the new data is merged +# with it causing chaos) +# +[ -e "$db_name" ] && rm -f "$db_name" + +# +# Convert the MySQL/MariaDB dump. First run sed on it, then run mysql2sqlite +# (from https://github.com/mysql2sqlite) to do the SQL dump conversion. Use +# the result to make a SQLite database. +# +sed '/^DELIMITER ;;/,/^DELIMITER ;/d' "$TMP1" > "$TMP2" +$mysql2sqlite "$TMP2" | sqlite3 "$db_name" + +# +# Report success if the new database exists +# +if [[ -e "$db_name" ]]; then + echo "Created SQLite database '$db_name'" +else + echo "Failed to find the expected new database '$db_name'" +fi + +# vim: syntax=sh:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21:fdm=marker + diff --git a/Community_News/make_email b/Community_News/make_email index 52ce412..747d4e1 100755 --- a/Community_News/make_email +++ b/Community_News/make_email @@ -3,56 +3,60 @@ # # FILE: make_email # -# USAGE: ./make_email [-debug=N] [-month=DATE] [-from=ADDRESS] -# [-to=ADDRESS] [-[no]mail] [-date=DATE] [-start=START_TIME] -# [-end=END_TIME] [-config=FILE] [-dbconfig=FILE] +# USAGE: ./make_email [-debug=N] [-month=DATE] [-date=DATE] +# [-start=START_TIME] [-end=END_TIME] [-output[=FILE]] +# [-config=FILE] # -# DESCRIPTION: Make and send an invitation email for the next Community News +# DESCRIPTION: Make an invitation email for the next Community News # with times per timezone. # # The configuration file (.make_email.cfg) defines the name of # the email template and the defaults used when generating the # message. The date of the recording is computed from the -# current month (Saturday before the first Monday of the month +# current month (Friday before the first Monday of the month # when the show will be posted). It can also be specified # through the -date=DATE option. # # The month the email relates to can be changed through the -# -month=DATA option, though this is rarely used. Use a date of +# -month=DATE option, though this is rarely used. Use a date of # the format 'YYYY-MM-DD' here. The day is ignored but the year # and month are used in the computation. The month specified # must be in the future. # -# The database configuration file defines the database to be -# used to compute the date and show number. Use .hpr_db.cfg for -# the local MariaDB copy (for testing) and .hpr_livedb.cfg for -# the live database (over the ssh tunnel, which must have been -# opened already). -# # OPTIONS: --- # REQUIREMENTS: --- # BUGS: --- # # NOTES: Does not send the email at present. Needs work # 2022-02-28: DBD::MariaDB has vanished, had to revert to MySQL -# again +# again. +# 2025-02-22: Moved to SQLite for the database +# 2025-02-23: Dropped Mail::Mailer and all related code. The +# output is now written to STDOUT or an output file. # # AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com -# VERSION: 0.2.7 +# VERSION: 0.3.3 # CREATED: 2013-10-28 20:35:22 -# REVISION: 2024-05-24 18:53:17 +# REVISION: 2025-02-28 14:40:28 # #=============================================================================== -use 5.010; -use strict; -use warnings; +use v5.36; +use utf8; +use feature qw{ try }; +no warnings qw{ experimental::try }; + +use open ':std', ':encoding(UTF-8)'; # Make all IO UTF-8 + +use Cwd qw( abs_path ); use Getopt::Long; use Pod::Usage; use Config::General; +use File::Copy; + use Date::Parse; use DateTime; @@ -63,8 +67,6 @@ use Date::Calc qw{:all}; use Template; -use Mail::Mailer; - use DBI; use Data::Dumper; @@ -72,7 +74,7 @@ use Data::Dumper; # # Version number (manually incremented) # -our $VERSION = '0.2.7'; +our $VERSION = '0.3.3'; # # Script name @@ -85,11 +87,16 @@ our $VERSION = '0.2.7'; # # Constants and other declarations # -my $basedir = "$ENV{HOME}/HPR/Community_News"; -my $configfile1 = "$basedir/.${PROG}.cfg"; -my $configfile2 = "$basedir/.hpr_db.cfg"; +( my $basedir = abs_path($0) ) =~ s|/?[^/]*$||mx; +my $configfile = "$basedir/.${PROG}.cfg"; -my ( $dbh, $sth1, $sth2, $sth3, $h1, $h2, $rv ); +my ( $dbh, $sth1, $h1, $h2, $rv ); +my ( %recdates, $rdfh ); + +# +# Run in the script's directory +# +chdir($basedir); # # The timezones we want to report. These were generated with @@ -495,18 +502,10 @@ my @zones = ( #}}} ); -# -# Enable Unicode mode -# -binmode STDOUT, ":encoding(UTF-8)"; -binmode STDERR, ":encoding(UTF-8)"; - # # Defaults for options # my $DEF_DEBUG = 0; -my $DEF_FROM = 'Dave.Morriss@gmail.com'; -my $DEF_TO = 'perloid@autistici.org'; # # Options and arguments @@ -521,43 +520,26 @@ pod2usage( -msg => "$PROG version $VERSION\n", -verbose => 0, -exitval => 1 ) if ( $options{'help'} ); # -# Full documentation if requested with -doc +# Full documentation if requested with -doc[umentation] or -man # pod2usage( -msg => "$PROG version $VERSION\n", -verbose => 2, -exitval => 1, -# -noperldoc => 0, ) if ( $options{'documentation'} ); # # Collect options # -my $DEBUG = ( defined( $options{debug} ) ? $options{debug} : $DEF_DEBUG ); -my $month = $options{month}; -my $mail = ( defined( $options{mail} ) ? $options{mail} : 0 ); -my $from_address = ( - defined( $options{fromaddress} ) ? $options{fromaddress} : $DEF_FROM ); -my $to_address - = ( defined( $options{toaddress} ) ? $options{toaddress} : $DEF_TO ); -my $date = $options{date}; -my $start = $options{starttime}; -my $end = $options{endtime}; - -# This value is in the configuration file and can't be overridden. The planned -# end time can be specified however. -#my $duration = $options{duration}; +my $DEBUG = ( defined( $options{debug} ) ? $options{debug} : $DEF_DEBUG ); +my $month = $options{month}; +my $date = $options{date}; +my $start = $options{starttime}; +my $end = $options{endtime}; +my $outfile = $options{output}; my $cfgfile - = ( defined( $options{config} ) ? $options{config} : $configfile1 ); -my $dbcfgfile - = ( defined( $options{dbconfig} ) ? $options{dbconfig} : $configfile2 ); - -# -# Use the 'testfile' mailer if option -nomail was chosen. This writes the file -# 'mailer.testfile' and sends no message -# -my $mailertype = ( $mail ? 'sendmail' : 'testfile' ); + = ( defined( $options{config} ) ? $options{config} : $configfile ); # # Sanity checking the options @@ -565,39 +547,26 @@ my $mailertype = ( $mail ? 'sendmail' : 'testfile' ); die "Unable to find $cfgfile\n" unless ( -e $cfgfile ); die "Use only one of -month=MONTH or -date=DATE\n" if (defined($month) && defined($date)); -#die "Use only one of -endtime=TIME or -duration=HOURS\n" -# if (defined($end) && defined($duration)); #------------------------------------------------------------------------------- -# Load script and database configuration data +# Load configuration data #------------------------------------------------------------------------------- -my $conf = new Config::General( +my $conf = Config::General->new( -ConfigFile => $cfgfile, -InterPolateVars => 1, -ExtendedAccess => 1 ); my %config = $conf->getall(); -#print Dumper( \%config ), "\n"; +_debug( $DEBUG >= 2, '%config: ' . Dumper( \%config ) ); # -# Load database configuration data -# -my $dbconf = new Config::General( - -ConfigFile => $dbcfgfile, - -InterPolateVars => 1, - -ExtendedAccess => 1 -); -my %dbconfig = $dbconf->getall(); -#print Dumper( \%dbconfig ), "\n"; - -# -# Configuration file values with defaults and/or checks +# Configuration file values for the email text with defaults and/or checks # my $server = $config{email}->{server} // 'chatter.skyehaven.net'; my $port = $config{email}->{port} // 64738; my $room = $config{email}->{room} // 'Hacker Public Radio'; -my $duration = $config{email}->{duration} // 2; -my $dayname = $config{email}->{dayname} // 'Sunday'; +my $duration = $config{email}->{duration} // 2; # Hours +my $dayname = $config{email}->{dayname} // 'Friday'; # # If we had a start time specified then check it and ensure the end time makes @@ -637,9 +606,33 @@ my @starttime = split( ':', $start ); my @endtime = split( ':', $end ); die "Missing start/end time(s)\n" unless ( @starttime && @endtime ); +# +# The template from the configuration file +# my $template = $config{email}->{template}; die "Missing template file $template\n" unless (-e $template); +# +# Recording date cache filename in the configuration file +# +my $recdatefile = $config{recdates}->{name}; +unless ($recdatefile) { + warn "No recording date file defined in configuration"; + say STDERR "Continuing without this file"; +} +elsif ( ! -e $recdatefile) { + warn "Can't find recording date file $recdatefile"; + say STDERR "Continuing without this file"; + $recdatefile = undef; +} + +# +# Load the recording dates +# +if ($recdatefile) { + %recdates = load_cache($recdatefile, $rdfh); +} + _debug($DEBUG >= 2, '$start: ' . coalesce($start,''), '$end: ' . coalesce($end,''), @@ -655,24 +648,17 @@ if ($DEBUG >= 1) { # 2021-12-24: moved to MariaDB # 2022-02-28: the MariaDB driver has gone away apparently. Reverted to MySQL # again +# 2025-02-22: Converted to SQLite #------------------------------------------------------------------------------- -my $dbhost = $dbconfig{database}->{host} // '127.0.0.1'; -my $dbport = $dbconfig{database}->{port} // 3306; -my $dbname = $dbconfig{database}->{name}; -my $dbuser = $dbconfig{database}->{user}; -my $dbpwd = $dbconfig{database}->{password}; -#$dbh = DBI->connect( "DBI:MariaDB:database=$dbname;host=$dbhost;port=$dbport", -# $dbuser, $dbpwd, { AutoCommit => 1 } ) -# or croak $DBI::errstr; +my $dbname = $config{database}->{name}; -$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname", - $dbuser, $dbpwd, { AutoCommit => 1 } ) - or die $DBI::errstr; +$dbh = DBI->connect( "DBI:SQLite:dbname=$dbname", + "", "", { AutoCommit => 1 } ); # # Enable client-side UTF8 # -$dbh->{mysql_enable_utf8} = 1; +$dbh->{sqlite_unicode} = 1; # # Date and time values using Date::Calc format @@ -681,7 +667,7 @@ my @today = Today(); my @startdate; my @startmonth; my @reviewdate; -my $monday = 1; # Day of week number 1-7, Monday-Sunday +my $monday = 1; # Day of week number 1-7, Monday-Sunday my $offset = day_offset($dayname)->{offset}; #------------------------------------------------------------------------------- @@ -689,7 +675,7 @@ my $offset = day_offset($dayname)->{offset}; # or the current date. #------------------------------------------------------------------------------- # -# If there's an argument then it'll be an override for the start date +# If there's a -date=DATE option then it'll be an override for the start date # otherwise we'll compute it. # if ( defined($date) ) { @@ -726,7 +712,8 @@ elsif ( defined($month) ) { # # Compute the next meeting date from now (by finding the next first Monday - # of the month then backing up two days to the Saturday). + # of the month then backing up two days to the desired day - default + # Friday). # @startdate = make_date( \@startmonth, $monday, 1, $offset ); } @@ -745,9 +732,11 @@ _debug($DEBUG >= 2, '@startdate: ' . join(',',@startdate)); # before. # if ( $startdate[1] eq $today[1] ) { + # Same month @reviewdate = @startdate; } else { + # Previous month - backup 1 month @reviewdate = Add_Delta_YM( @startdate, 0, -1 ); } @@ -755,7 +744,8 @@ _debug($DEBUG >= 2, '@reviewdate: ' . join(',',@reviewdate)); # # Transfer Date::Calc values into hashes for initialising DateTime objects so -# we can play time zone games +# we can play time zone games. (Note: %dtargs is a hash and we're using hash +# slicing to initialise it). # my ( %dtargs, $dtstart, $dtend ); @dtargs{ 'year', 'month', 'day', 'hour', 'minute', 'second', 'time_zone' } @@ -775,14 +765,15 @@ my $days = $dtf->format_duration($dtoffset); # # Formatted dates for the mail message body # -my ( $year, $monthname, $nicedate, $starttime, $endtime ) = ( - $dtstart->strftime("%Y"), Month_to_Text( $reviewdate[1] ), - $dtstart->strftime("%A, %B %d %Y"), $dtstart->strftime("%R (%Z)"), - $dtend->strftime("%R (%Z)"), +my ( $year, $monthno, $monthname, $nicedate, $starttime, $endtime ) = ( + $dtstart->strftime("%Y"), $dtstart->strftime("%m"), + Month_to_Text( $reviewdate[1] ), $dtstart->strftime("%A, %B %d %Y"), + $dtstart->strftime("%R (%Z)"), $dtend->strftime("%R (%Z)"), ); _debug($DEBUG >= 2, "\$year: $year", + "\$monthno: $monthno", "\$monthname: $monthname", "\$nicedate: $nicedate", "\$starttime: $starttime", @@ -800,38 +791,50 @@ my $subject = $dtstart->strftime( _debug( $DEBUG >= 2, "\$subject: $subject" ); -# -# Prepare to send mail -# -my $mailer = Mail::Mailer->new($mailertype); +#------------------------------------------------------------------------------- +# Open the output file (or STDOUT) - we may need the year and month number to +# do it, if the file name contains '%s'. +#------------------------------------------------------------------------------- +my $outfh; +if ($outfile) { + $outfile = sprintf( $outfile, sprintf( "%d-%02d", $year, $monthno ) ) + if ( $outfile =~ /%s/ ); -# -# Generate the headers we need -# -$mailer->open( - { To => $to_address, - From => $from_address, - Subject => $subject, - } -); + open( $outfh, ">:encoding(UTF-8)", $outfile ) + or die "Unable to open $outfile for writing: $!\n"; +} +else { + open( $outfh, ">&", \*STDOUT ) + or die "Unable to initialise for writing: $!\n"; +} # # Build an array of timezone data for the template # my @timezones; for my $tz (@zones) { - push( @timezones, storeTZ( $dtstart, $dtend, $tz ) ); + push( @timezones, storeTZ( $dtstart, $dtend, $tz ) ); } #------------------------------------------------------------------------------- # Find the number of the show with the notes. Take care because the recording # date might not be on the weekend before the show is released. +# TODO: If this search fails (because in future Community News shows will not +# be reserved), then the date needs to be computed. #------------------------------------------------------------------------------- my $isodate = $dtstart->ymd; +#$sth1 = $dbh->prepare(q{ +# SELECT id FROM eps +# WHERE date > ? +# AND date_format(date,"%W") = 'Monday' +# AND title LIKE 'HPR Community News%' +# ORDER BY date +# LIMIT 1 +#}); $sth1 = $dbh->prepare(q{ SELECT id FROM eps WHERE date > ? - AND date_format(date,"%W") = 'Monday' + AND strftime("%u", date) = '1' AND title LIKE 'HPR Community News%' ORDER BY date LIMIT 1 @@ -848,13 +851,38 @@ unless ( $h1 = $sth1->fetchrow_hashref ) { exit 1; } -my $shownotes = $h1->{id}; +my $episode = $h1->{id}; -_debug( $DEBUG >= 2, "\$shownotes (slot): $shownotes" ); +_debug( $DEBUG >= 2, "\$episode (slot): $episode" ); $sth1->finish; $dbh->disconnect; +#------------------------------------------------------------------------------- +# Update the date cache now we have the date and time details we need. +#------------------------------------------------------------------------------- +( my $monthkey = $dtstart->ymd ) =~ s/\d+$/01/; +my $datestamp = $dtstart->strftime("%F %T"); + +if (exists($recdates{$monthkey})) { + # + # It exists. Is it different? + # + unless ( $recdates{$monthkey} eq $datestamp ) { + # + # Save the new data (assuming it's correct) + # + $recdates{$monthkey} = $datestamp; + update_cache( $recdatefile, \%recdates ); + } +} +else { + # + # Add a new record to the end of the cache file + # + append_cache( $recdatefile, sprintf( "%s,%s", $monthkey, $datestamp ) ); +} + #------------------------------------------------------------------------------- # Fill the template #------------------------------------------------------------------------------- @@ -865,12 +893,10 @@ my $tt = Template->new( ); my $vars = { -# subject => $subject, -# from => $from_address, -# to => $to_address, server => $server, port => $port, room => $room, + subject => $subject, timezones => \@timezones, utc => { days => $days, @@ -880,7 +906,7 @@ my $vars = { start => $starttime, end => $endtime, }, - shownotes => $shownotes, + episode => $episode, # show number }; my $document; @@ -889,23 +915,136 @@ $tt->process( $template, || die $tt->error(), "\n"; # -# Add the template-generated body to the mail message +# Write to the output file # -print $mailer $document; +print $outfh $document; # -# Send the message +# Report the output file name if there is one # -$mailer->close - or die "Couldn't send message: $!\n"; - -unless ($mail) { - print "Message was not sent since -nomail was selected (or defaulted).\n"; - print "Look in 'mailer.testfile' for the output\n"; +if ($outfile) { + say "Output is in $outfile"; } exit; +#=== FUNCTION ================================================================ +# NAME: load_cache +# PURPOSE: Load the date cache into a hash +# PARAMETERS: $cache_name Name of file holding the cache +# RETURNS: Contents of cache as a hash +# DESCRIPTION: Opens the nominated file, parses each record, and adds the +# data to a hash. The record should contain the following: +# * 'YYYY-MM-01' the month for which the details are being +# recorded +# * ',' comma field separator +# * 'YYYY-MM-DD HH:MM:SS' timestamp of the recording +# The file is closed once it has been scanned. The function +# returns the completed hash. +# THROWS: No exceptions +# COMMENTS: None +# SEE ALSO: N/A +#=============================================================================== +sub load_cache { + my ($cache_name) = @_; + + my ( $month, $datetime, %result ); + + # + # Open the file in read mode + # + open( my $dcfh, '<', $cache_name ) + or die "$PROG: failed to open '$cache_name': $!\n"; + + while ( my $line = <$dcfh> ) { + chomp($line); + if ( ( $month, $datetime ) + = ( $line =~ /^(\d{4}-\d{2}-\d{2}),(.*)$/ ) ) + { + $result{$month} = $datetime; + } + # TODO: Report any errors found in the file + } + + close($dcfh) + or warn "$PROG: failed to close '$cache_name': $!\n"; + + return %result; +} + +#=== FUNCTION ================================================================ +# NAME: append_cache +# PURPOSE: Append a new line to the cache +# PARAMETERS: $cache_name Name of file holding the cache +# $line New record to add +# RETURNS: Nothing +# DESCRIPTION: Opens the nominated file and appends the new record in $line. +# The file is closed once it has been updated. +# THROWS: No exceptions +# COMMENTS: None +# SEE ALSO: N/A +#=============================================================================== +sub append_cache { + my ( $cache_name, $line ) = @_; + + # + # Open the file in append mode + # + open( my $dcfh, '>>', $cache_name ) + or die "$PROG: failed to open '$cache_name': $!\n"; + + say $dcfh $line; + + close($dcfh) + or warn "$PROG: failed to close '$cache_name': $!\n"; +} + +#=== FUNCTION ================================================================ +# NAME: update_cache +# PURPOSE: Make changes to an existing line in the cache +# PARAMETERS: $cache_name Name of file holding the cache +# $rhash Hashref holding the updated cache contents +# RETURNS: Nothing +# DESCRIPTION: Makes a backup of the nominated file. Opens, truncates it and +# positions for writing (using 'seek'). The now empty file is +# filled with data from the hash and closed. +# THROWS: No exceptions +# COMMENTS: None +# SEE ALSO: N/A +#=============================================================================== +sub update_cache { + my ( $cache_name, $rhash ) = @_; + + # + # Copy the cache file to a backup + # + copy($cache_name,"${cache_name}~") + or die "Unable to back up $cache_name\n"; + + # + # Open the original file in write mode + # + open( my $dcfh, '>', $cache_name ) + or die "$PROG: failed to open '$cache_name': $!\n"; + + # + # Truncate the file and seek to the start again + # + truncate($dcfh,0) + or die "$PROG: failed to truncate '$cache_name': $!\n"; + seek($dcfh,0,0) + or die "$PROG: failed to seek in '$cache_name': $!\n"; + + # + # Write the cache data to the file + # + for my $key (sort(keys(%$rhash))) { + say $dcfh sprintf("%s,%s",$key, $rhash->{$key}); + } + + close($dcfh) + or warn "$PROG: failed to close '$cache_name': $!\n"; +} #=== FUNCTION ================================================================ # NAME: report_settings @@ -921,36 +1060,18 @@ sub report_settings { my $fmt = "D> %-14s = %s\n"; print "D> Settings from options or default values:\n"; printf $fmt, "Month", coalesce($month,'undef'); - printf $fmt, "Mail", coalesce($mail,'undef'); - printf $fmt, "From", coalesce($from_address,'undef'); - printf $fmt, "To", coalesce($to_address,'undef'); printf $fmt, "Meeting date", coalesce($date,'undef'); printf $fmt, "Start time", join(':',@starttime); printf $fmt, "End time", join(':',@endtime); printf $fmt, "Config file", coalesce($cfgfile,'undef'); - printf $fmt, "DB config file", coalesce($dbcfgfile,'undef'); printf $fmt, "Server", coalesce($server,'undef'); printf $fmt, "Port", coalesce($port,'undef'); printf $fmt, "Room", coalesce($room,'undef'); printf $fmt, "Template", coalesce($template,'undef'); + printf $fmt, "Recording date file", coalesce($recdatefile,'undef'); print "D> ----\n"; } -#=== FUNCTION ================================================================ -# NAME: compute_endtime -# PURPOSE: Given a start time and a duration computes the end time -# PARAMETERS: $rdate arrayref for the date -# $rstime arrayref for the start time -# $rduration arrayref for the duration [HH,MM,SS] -# RETURNS: The end time as a string (HH:MM:SS) -# DESCRIPTION: -# THROWS: No exceptions -# COMMENTS: Decided not to implement this, may do so in future. -# SEE ALSO: N/A -#=============================================================================== -#sub compute_endtime { -#} - #=== FUNCTION ================================================================ # NAME: validate_time # PURPOSE: Validates a time in HH:MM:SS format @@ -1029,7 +1150,7 @@ sub make_date { } # - # Apply the day offset + # Apply any day offset # @date = Add_Delta_Days( @date, $offset ) if $offset; @@ -1047,7 +1168,8 @@ sub make_date { # $end DateTime object containing the ending datetime # as UTC # $tz The textual time zone (need this to be valid) -# RETURNS: A hash containing the timezone name and start and end times +# RETURNS: Reference to a hash containing the timezone name and start and +# end times # DESCRIPTION: Relies on DateTime::TimeZone to do the work to turn a UTC time # into a time in a different time zone. Uses the DateTime # strftime method to format the dates and times for printing. @@ -1076,49 +1198,15 @@ sub storeTZ { return \%result; } -#=== FUNCTION ================================================================ -# NAME: printTZ -# PURPOSE: Print start/end times for a timezone -# PARAMETERS: $fh File handle for writing -# $start DateTime object containing the starting -# datetime as UTC -# $end DateTime object containing the ending datetime -# as UTC -# $tz The textual time zone (need this to be valid) -# RETURNS: Nothing -# DESCRIPTION: Relies on DateTime::TimeZone to do the work to turn a UTC time -# into a time in a different time zone. Uses the DateTime -# strftime method to format the dates and times for printing. -# THROWS: No exceptions -# COMMENTS: None -# SEE ALSO: -#=============================================================================== -sub printTZ { - my ( $fh, $start, $end, $tz ) = @_; - - # - # Adjust time zone - # - $start->set_time_zone($tz); - $end->set_time_zone($tz); - - # - # Print time zone and start/end times in that zone - # - print $fh "$tz\n"; - print $fh $start->strftime("Start: %H:%S %a, %b %d %Y\n"); - print $fh $end->strftime("End: %H:%S %a, %b %d %Y\n\n"); - -} - #=== FUNCTION ================================================================ # NAME: day_offset # PURPOSE: Given a day name computes day attributes including the -# (negative) offset in days from the target Monday to the -# recording date. +# (negative) offset in days from the target release day (Monday) +# to the recording date. # PARAMETERS: $dayname Name of a day of the week -# RETURNS: Hashref containing the full day name, the weekday number and -# the integer offset from Monday to the recording day, or undef. +# RETURNS: Hashref containing the full day name (dayname), the weekday +# number (wday) and the integer offset (offset) from Monday to +# the recording day, or undef. # DESCRIPTION: Uses the hash '%matches' keyed by regular expressions matching # day names. The argument '$dayname' is matched against each # regex in turn and if it matches the sub-hash is returned. This @@ -1239,14 +1327,13 @@ sub Options { my ($optref) = @_; my @options = ( - "help", "documentation|man", - "debug=i", "mail!", - "fromaddress=s", "toaddress=s", - "date=s", "starttime=s", - "endtime=s", "month=s", - "config=s", "dbconfig=s", + "help", "documentation|man", + "debug=i", "date=s", + "starttime=s", "endtime=s", + "month=s", "output:s", + "config=s", ); - # "duration=s", + # "mail!", "fromaddress=s", "toaddress=s", "duration=s", if ( !GetOptions( $optref, @options ) ) { pod2usage( -msg => "Version $VERSION\n", -verbose => 0, -exitval => 1 ); @@ -1264,20 +1351,20 @@ __END__ =head1 NAME -make_email - generates an HPR Community News recording invitation email +make_email - generates the text of an HPR Community News recording invitation + email =head1 VERSION -This documentation refers to make_email version 0.2.7 +This documentation refers to make_email version 0.3.3 =head1 USAGE - make_email [-help] [-documentation] [-debug=N] [-month=DATE] [-[no]mail] - [-from=FROM_ADDRESS] [-to=TO_ADDRESS] [-date=DATE] [-start=START_TIME] - [-end=END_TIME] [-config=FILE] [-dbconfig=FILE] + make_email [-help] [-documentation] [-debug=N] [-month=DATE] [-date=DATE] + [-start=START_TIME] [-end=END_TIME] [-config=FILE] - ./make_email -dbconf=$HOME/HPR/.hpr_livedb.cfg -date=2022-12-27 + ./make_email -date=2022-12-27 =head1 OPTIONS @@ -1293,7 +1380,7 @@ Prints the entire embedded documentation for the program, then exits. Another way to see the full documentation use: -B + perldoc ./make_email =item B<-debug=N> @@ -1351,30 +1438,6 @@ a ISO8601 date such as 2014-03-08 (meaning March 2014) or 1-Jan-2017 (meaning January 2017). Only the year and month parts are used but a valid day must be present. -=item B<-[no]mail> - -** NOTE ** The sending of mail does not work at present, and B<-nomail> should -always be used. - -Causes mail to be sent (B<-mail>) or not sent (B<-nomail>). If the mail is -sent then it is sent via the local MTA (in the assumption that there is one). -If this option is omitted, the default is B<-nomail>, in which case the -message is appended to the file B in the current directory. - -=item B<-from=FROM_ADDRESS> - -** NOTE ** The sending of mail does not work at present. - -This option defines the address from which the message is to be sent. This -address is used in the message header; the message envelope will contain the -I sender. - -=item B<-to=TO_ADDRESS> - -** NOTE ** The sending of mail does not work at present. - -This option defines the address to which the message is to be sent. - =item B<-date=DATE> This is an option provides a non-default date for the recording. Normally the @@ -1405,30 +1468,35 @@ The default end time is defined in the configuration file, but if it is necessary to change it temporarily, this option can be used to do it. The B value must be a valid B time specification. +=item B<-output=FILE> + +This option defines an output file to receive the mail message text. If the option is +omitted the notes are written to STDOUT, allowing them to be redirected if +required. + +The output file name may contain the characters 'B<%s>'. This denotes the point +at which the year and month in the format B are inserted. For example +if the script is being run for February 2025 the option: + + -out=HPR_email_%s.txt + +will cause the generation of the file: + + HPR_email_2025-02.txt + =item B<-config=FILE> This option defines a configuration file other than the default B<.make_email.cfg>. The file must be formatted as described below in the section I. -=item B<-dbconfig=FILE> - -This option defines a database configuration file other than the default -B<.hpr_db.cfg>. The file must be formatted as described below in the section -I. - -The default file is configured to open a local copy of the HPR database. An -alternative is B<.hpr_livedb.cfg> which assumes an SSH tunnel to the live -database and attempts to connect to it. Use the script I to open -the SSH tunnel. - =back =head1 DESCRIPTION -Makes and sends(*) an invitation email for the next Community News with times per -timezone. The message is structured by a Template Toolkit template, so its -content can be adjusted without changing this script. +Makes an invitation email for the next Community News with times per timezone. +The message is structured by a Template Toolkit template, so its contents can +be adjusted without changing this script. In normal operation the script computes the date of the next recording using the algorithm "Saturday before the first Monday of the next month" starting @@ -1446,9 +1514,6 @@ seen as the shows are visited and discussed. The email generated by the script is sent to the HPR mailing list, usually on the Monday prior to the weekend of the recording. -Notes: -* Mail sending does not work at present. - =head1 DIAGNOSTICS =over 8 @@ -1496,11 +1561,6 @@ The month specified in B<-month=DATE> is in the past. The program can generate warning messages from the Template. -=item B - -The email mesage has been constructed but could not be sent. See the error -returned by the mail subsystem for more information. - =back =head1 CONFIGURATION AND ENVIRONMENT @@ -1524,31 +1584,64 @@ needs to contain the following data: =head2 DATABASE CONFIGURATION -The program obtains the credentials it requires for connecting to the HPR -database by loading them from a configuration file. The default file is called -B<.hpr_db.cfg> and should contain the following data: +The program also obtains the details it requires for connecting to a SQLite +copy of the HPR database by loading them from the same configuration file in +a separate section. The data is as follows: - host = 127.0.0.1 - port = PORT name = DBNAME - user = USER - password = PASSWORD -The file B<.hpr_livedb.cfg> should be available to allow access to the -database over an SSH tunnel which has been previously opened. +=head2 DATE CACHE + + + name = recording_dates.dat + + +The program will update a cache of recording dates and times per month. This +is useful for the script B which needs to know about the +Community News show recording time so it can determine how to display +information about comments. See the details for this script. + +The format of the lines in the file is: + + MONTH,TIMESTAMP + +Note the separating comma. The month is an ISO8601 date where the day part is +always B<01>. The timestamp part is the date and time of the recording in the +format: + + YYYY-MM-DD HH:MM:SS + +For example: + + 2024-12-01,2025-01-03 15:00:00 + 2025-01-01,2025-01-31 15:00:00 + 2025-02-01,2025-02-28 16:00:00 + +The dates and times are derived from the configuration file defaults (and those +computed in the script), or the options given when running the script. + +The contents of this cache are loaded into the B script. If there +is no record for the month being processed, one is appended to the file. If +the details already exist they are updated unless they are the same as those +stored. + +A backup of the file is made if the data in a record is being updated. =head1 DEPENDENCIES + Config::General + Cwd DBI + Data::Dumper Date::Calc Date::Parse DateTime DateTime::Format::Duration DateTime::TimeZone + File::Copy Getopt::Long - Mail::Mailer Pod::Usage Template @@ -1560,7 +1653,7 @@ Patches are welcome. =head1 AUTHOR -Dave Morriss (Dave.Morriss@gmail.com) 2013 - 2024 +Dave Morriss (Dave.Morriss@gmail.com) 2013 - 2025 =head1 LICENCE AND COPYRIGHT diff --git a/Community_News/make_email_template.tpl b/Community_News/make_email_template.tpl new file mode 100644 index 0000000..4529e54 --- /dev/null +++ b/Community_News/make_email_template.tpl @@ -0,0 +1,76 @@ +[%# make_email_template.tpl 2025-02-23 -%] +[%# Community News email template -%] +[% USE wrap -%] +[% subject %] + +[% FILTER replace('\n', ' ') -%] +[% IF utc.days > 6 -%] +The Community News for [% utc.month %] will be recorded using Mumble on +[% ELSE -%] +The next Community News will be recorded using Mumble on +[% END -%] +[% utc.date %] between [% utc.start %] and [% utc.end %] in the '[% room %]' room on [% server %] port [% port %]. +[% END %] + +[% FILTER replace('\n', ' ') -%] +During the recording HPR Volunteers will review the shows released during +[% utc.month %] [% utc.year %], they will read comments submitted during that +month, as well as summarising email sent to the HPR mailing list. +[% END %] + +[% FILTER replace('\n', ' ') -%] +All HPR listeners are welcome to join in, but we ask that you listen to all +the shows in [% utc.month %] before you do so. +[% END %] + +[% FILTER replace('\n', ' ') -%] +Occasionally, due to local factors, we might need to change the time, or even +the date, without warning. If you're planning on joining in it might be a good +idea to let us know in advance - email admin@hackerpublicradio.org. Then we +can contact you with the new schedule in the rare event that we have to +make a change. +[% END %] + +[% FILTER replace('\n', ' ') -%] +The notes for the recording are an extended version of the show notes. These +extended elements are removed before the show is made fully available on the +HPR site (and on archive.org). Comments which might have been missed in the +last recording will be marked in red. Comments which would normally be in this +month, but which were read out in the last show are marked in green. Comments +made in the past month to older shows will be displayed in full (so they are +easier to read). +[% END %] + +[% FILTER replace('\n', ' ') -%] +Look here for the notes for this recording: +https://hackerpublicradio.org/eps/hpr[% episode %]/index.html +[% END %] + +Summary: +[% FILTER indent(' ') -%] +Date of recording: [% utc.date %] +Start and end times: [% utc.start %] and [% utc.end %] +Mumble server: [% server %] +Port: [% port %] +Room: [% room %] +[% END -%] + +Refer to https://hackerpublicradio.org/recording.html for how to use Mumble. + +[% FILTER replace('\n', ' ') -%] +There is an iCal file on the HPR site that you can load into a compatible +calendar which will remind you of the next 12 upcoming recording dates. +Access it from https://hackerpublicradio.org/HPR_Community_News_schedule.ics +[% END %] + +See below for start and end times in various international timezones. + +[% FOREACH tz IN timezones -%] +[% tz.name %] +Start: [% tz.start %] +End: [% tz.end %] + +[% END -%] +[%# + # vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21 +-%] diff --git a/Community_News/make_meeting b/Community_News/make_meeting index e792790..06c8700 100755 --- a/Community_News/make_meeting +++ b/Community_News/make_meeting @@ -17,9 +17,9 @@ # Hacking" # AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com # LICENCE: Copyright (c) year 2012-2024 Dave Morriss -# VERSION: 0.2.2 +# VERSION: 0.2.3 # CREATED: 2012-10-13 15:34:01 -# REVISION: 2024-05-24 22:45:56 +# REVISION: 2024-10-28 13:17:44 # #=============================================================================== @@ -42,7 +42,7 @@ use Date::ICal; # # Version number (manually incremented) # -our $VERSION = '0.2.2'; +our $VERSION = '0.2.3'; # # Script name @@ -65,8 +65,6 @@ my ( @startdate, @rdate, @events ); # # Attributes for the calendar message # -#my $server = 'ch1.teamspeak.cc'; -#my $port = 64747; my $server = 'chatter.skyehaven.net'; my $port = 64738; @@ -129,11 +127,12 @@ else { # of having a time zone defined (default UTC, as now). # my $monday = 1; # Day of week number 1-7, Monday-Sunday +my $offset = -3; # Offset from the target date (-3 is Friday) -my @starttime = ( 13, 00, 00 ); # UTC -my @endtime = ( 15, 00, 00 ); +my @starttime = ( 15, 00, 00 ); # UTC +my @endtime = ( 17, 00, 00 ); -my @todostart = ( 9, 00, 00 ); # UTC +my @todostart = ( 9, 00, 00 ); # UTC my @todoend = ( 17, 00, 00 ); # @@ -161,12 +160,13 @@ http://hackerpublicradio.org/recording.php ENDDESC # -# Compute the next recording date from the starting date (@startdate will be -# today's date or the start of the explicitly selected month provided via -# -from=DATE. We want day of the week to be Monday, the first in the month, -# then to go back 1 day from that to get to the Sunday! Simple) +# Compute the next recording date from the starting date. +# Now @startdate will be today's date or the start of the explicitly selected +# month provided via -from=DATE. We want day of the week to be Monday, the +# first in the month, then to go back $offset days from that to get to the +# recording day! Simple. # -@startdate = make_date( \@startdate, $monday, 1, -1 ); +@startdate = make_date( \@startdate, $monday, 1, $offset ); @rdate = @startdate; # @@ -208,7 +208,7 @@ for my $i ( 1 .. $count ) { # # Recording date computation from the start of the month # - @rdate = make_date( \@rdate, $monday, 1, -1 ); + @rdate = make_date( \@rdate, $monday, 1, $offset ); # # Save the current recording date to make an array of arrayrefs @@ -305,8 +305,9 @@ exit; # 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. +# result where the day part is forced to be 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 diff --git a/Community_News/make_shownotes b/Community_News/make_shownotes index 9796b30..9e45ba6 100755 --- a/Community_News/make_shownotes +++ b/Community_News/make_shownotes @@ -4,15 +4,16 @@ # FILE: make_shownotes # # USAGE: ./make_shownotes [-help] [-documentation] [-debug=N] -# [-from=DATE] [-[no]comments] [-[no]markcomments] [-[no]ctext] -# [-lastrecording=DATETIME] [-[no]silent] [-out=FILE] -# [-episode=[N|auto]] [-[no]overwrite] [-mailnotes[=FILE]] -# [-anyotherbusiness=FILE] [-template=FILE] [-config=FILE] -# [-interlock=PASSWORD] +# [-from=DATE] [-[no]comments] [-lastrecording=DATETIME] +# [-[no]silent] [-[no]mailnotes] +# [-full-html=FILE] [-html=FILE] [-json=FILE] # -# DESCRIPTION: Builds shownotes for a Community News show from the HPR -# database using a template. Writes the result to STDOUT or to -# a file. Also writes to the database if requested. +# DESCRIPTION: Builds shownotes for a Community News show from a SQLite copy +# of the HPR database using a TT² template. Writes the results to +# a file or files. +# +# Based on a version created in 2014-04-24 with the same name. +# Development started on this version as 0.4.1. # # OPTIONS: --- # REQUIREMENTS: --- @@ -28,20 +29,25 @@ # Where pod2pdf comes from App::pod2pdf # # AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com -# VERSION: 0.2.2 -# CREATED: 2014-04-24 16:08:30 -# REVISION: 2023-06-30 23:52:06 +# VERSION: 0.4.3 +# ORIGINAL: 2014-04-24 16:08:30 +# CREATED: 2025-03-13 15:07:35 +# REVISION: 2025-03-28 19:14:45 # #=============================================================================== -use 5.010; -use strict; -use warnings; +use v5.40; use utf8; +use feature qw{ say state try }; + +use open ':std', ':encoding(UTF-8)'; # Make all IO UTF-8 + +use Cwd qw( abs_path ); # Detecting where the script lives use Carp; use Getopt::Long; -use Pod::Usage; +BEGIN { $ENV{PERLDOC} = '-MPod::Text::Color'; } +use Pod::Usage qw(pod2usage); # Use colour-capable Pod::Text use Config::General; @@ -52,18 +58,20 @@ use DateTime::Duration; use Template; use Template::Filters; -Template::Filters->use_html_entities; # Use HTML::Entities in the template +Template::Filters->use_html_entities; # Use HTML::Entities in the main template use HTML::Entities; use DBI; +use JSON; + use Data::Dumper; # # Version number (manually incremented) # -our $VERSION = '0.2.2'; +our $VERSION = '0.4.3'; # # Various constants @@ -76,44 +84,62 @@ our $VERSION = '0.2.2'; # # Constants and other declarations # -my $basedir = "$ENV{HOME}/HPR/Community_News"; -my $configfile = "$basedir/.hpr_db.cfg"; -my $bpfile = "$basedir/shownote_template.tpl"; +# We make variable to hold the working directory where the script is located +# +( my $basedir = abs_path($0) ) =~ s|/?[^/]*$||mx; -my $title_template = 'HPR Community News for %s %s'; +my $configfile = "$basedir/.${PROG}.cfg"; # -# Needed to allow an older episode to have its notes regenerated. This is an -# 'apg'-generated password which is just hard to remember and requires some -# thought to use. The idea is to prevent older shownote rewriting by accident. +# Default templates and cache in case there's nothing in the configuration file # -my $interlock_password = 'lumRacboikac'; -my $interlock_enabled = 0; +my $defmain = "shownote_template.tpl"; +my $deftt = 'HPR Community News for %s %s'; +my $defst + = 'HPR Volunteers talk about shows released and comments posted in %s %s'; +my $deftags = ['Community News']; +my $defhostid = 159; +my $defseries_id = 47; +my $defcache = "$basedir/recording_dates.dat"; +my $defcontainer = "$basedir/shownotes_container.tpl"; -my ( $dbh, $sth1, $h1 ); -my ( @startdate, $hosts, $shows ); -my ( @dc_lr, $dt_lr, @dc_lm, $dt_lm ); -my ( $t_days, $missed_comments, $missed_count ); -my ( $comments, $comment_count, $past_count, $ignore_count ); -my ( %past, %current ); +my ( $dbh, $sth1, $h1 ); +my ( @review_month, $releasedate, @releasedate, $hosts, $shows, $episode ); +my ( @dc_lr, $dt_lr, @dc_lm, $dt_lm, @dc_rd, $dt_rd ); +my ( %attributes ); +my ( %date_cache, $date_offset, @deftime ); +my ( $t_time, $missed_comments, $missed_count ); +my ( $comments, $comment_count, $past_count, $ignore_count ); +my ( %past, %current ); + +#------------------------------------------------------------------------------- +# The structure of the JSON to be sent to the HPR server +#------------------------------------------------------------------------------- +my %json_data = ( + key => undef, # $key + ep_num => undef, # $ep_num + ep_date => undef, # $ep_date + email => undef, # $email_padded + title => undef, # $title_encoded + duration => undef, # $duration + summary => undef, # $summary_encoded + series_id => undef, # $series_id + series_name => undef, # $series_name + explicit => undef, # $explicit + episode_license => undef, # $episode_license + tags => undef, # $tags + hostid => undef, # $hostid + host_name => undef, # $host_name + host_license => undef, # $host_license + host_profile => undef, # $host_profile_encoded + notes => undef, # $notes +); # -# The normal recording time (UTC). Any change should be copied in the POD -# documentation below. -# TODO: Should this be in a configuration file? +# Ensure this script runs in the directory it exists in (to simplify +# specifying and accessing files) # -my @deftime = (15, 00, 00); - -# -# Earliest comment release time -# -my @releasetime = (19, 00, 00); - -# -# Enable Unicode mode -# -binmode STDOUT, ":encoding(UTF-8)"; -binmode STDERR, ":encoding(UTF-8)"; +chdir($basedir); #------------------------------------------------------------------------------- # Options and arguments @@ -136,113 +162,76 @@ pod2usage( -msg => "$PROG version $VERSION\n", -verbose => 0, -exitval => 1 ) if ( $options{'help'} ); # -# Full documentation if requested with -documentation +# Full documentation if requested with -documentation or -man # -pod2usage( -msg => "$PROG version $VERSION\n", -verbose => 2, -exitval => 1 ) - if ( $options{'documentation'} ); +pod2usage( + -msg => "$PROG version $VERSION\n", + -verbose => 2, + -exitval => 1, +) if ( $options{'documentation'} ); # # Collect options # -my $DEBUG = ( defined( $options{debug} ) ? $options{debug} : $DEFDEBUG ); -my $cfgfile - = ( defined( $options{config} ) ? $options{config} : $configfile ); +my $DEBUG = ( defined( $options{debug} ) ? $options{debug} : $DEFDEBUG ); my $silent = ( defined( $options{silent} ) ? $options{silent} : 0 ); my $show_comments - = ( defined( $options{comments} ) ? $options{comments} : 0 ); -my $mark_comments - = ( defined( $options{markcomments} ) ? $options{markcomments} : 0 ); -my $ctext = ( defined( $options{ctext} ) ? $options{ctext} : 0 ); + = ( defined( $options{comments} ) ? $options{comments} : 1 ); my $lastrecording = $options{lastrecording}; -my $outfile = $options{out}; -my $episode = $options{episode}; -my $overwrite = ( defined( $options{overwrite} ) ? $options{overwrite} : 0 ); -my $template - = ( defined( $options{template} ) ? $options{template} : $bpfile ); -my $mailnotes = $options{mailnotes}; -my $aobfile = $options{anyotherbusiness}; -my $interlock = $options{interlock}; +my $mailnotes = ( defined( $options{mailnotes} ) ? $options{mailnotes} : 1 ); +my $cfgfile + = ( defined( $options{config} ) ? $options{config} : $configfile ); # -# Sanity checks +# Output files. One must be present - we check later +# +my $full_html_outfile = $options{'full-html'}; +my $html_outfile = $options{html}; +my $json_outfile = $options{json}; + +# +# Sanity checking the options # die "Unable to find configuration file $cfgfile\n" unless ( -e $cfgfile ); -if ( defined($episode) ) { - if ( $episode =~ /^\d+$/ ) { - die "Episode number must be greater than zero\n" - unless ( $episode > 0 ); - } - else { - die "Episode must be a number or 'auto'\n" - unless ( $episode eq 'auto' ); - } -} - -die "Error: Unable to find template $template\n" unless -r $template; # -# We accept '-mailnotes' meaning we want to use a default set of mail notes, -# or '-mailnotes=FILE' which means the notes are in a file for inclusion. If -# the option is omitted then we don't include mail notes (and the template is -# expected to do the right thing). +# We're receiving the datetime for the last recording (that's the recording +# for the previous month), which isn't appropriate unless we're marking +# comments. # -if (defined($mailnotes)) { - if ($mailnotes =~ /^$/) { - # - # The default mail inclusion is provided in a named BLOCK directive in - # the template. The name is hard-wired here - # - # FIXME: there's a dependency between the script and the template here - # which is inflexible. - # - $mailnotes = 'default_mail'; - } - else { - die "Error: Unable to find includefile '$mailnotes'\n" unless -r $mailnotes; - } +if (defined($lastrecording)) { + die "Use -lastrecording=DATETIME only with -full-html=FILE\n" + unless defined($full_html_outfile); } # -# The -anyotherbusiness=FILE or -aob=FILE options provide an HTML file to be -# added to the end of the notes. +# One at least of the output files must be present # -if (defined($aobfile)) { - die "Error: Unable to find includefile '$aobfile'\n" unless -r $aobfile; +unless ($full_html_outfile || $html_outfile || $json_outfile) { + warn "At least one of -html=FILE, -full-html=FILE and -json=FILE " . + "must be present\n"; + die "Missing output file option\n"; } -# -# Use the date provided or the default -# +say "DEBUG level is %d", $DEBUG if $DEBUG > 0; + +#------------------------------------------------------------------------------- +# Use the date provided for the review month or use today's date as the default +#------------------------------------------------------------------------------- if ( defined( $options{from} ) ) { # # Parse and perform rudimentary validation on the -from option # -# my @parsed = strptime( $options{from} ); -# die "Invalid -from=DATE option '$options{from}'\n" -# unless ( defined( $parsed[3] ) -# && defined( $parsed[4] ) -# && defined( $parsed[5] ) ); -# -# $parsed[5] += 1900; -# $parsed[4] += 1; -# @startdate = @parsed[ 5, 4, 3 ]; - @startdate = parse_to_dc($options{from}, undef); + @review_month = parse_to_dc($options{from}, undef); } else { # # Default to the current date # - @startdate = Today(); -} - -# -# If -interlock=PASSWORD was provided is the password valid? -# -if ( defined($interlock) ) { - $interlock_enabled = $interlock eq $interlock_password; - emit( $silent, "Interlock ", - ( $interlock_enabled ? "accepted" : "rejected" ), "\n" ); + @review_month = Today(); } +$review_month[2] = 1; +@dc_lm = @review_month; # TODO: Is this right? #------------------------------------------------------------------------------- # Configuration file - load data @@ -252,246 +241,277 @@ my $conf = Config::General->new( -ConfigFile => $cfgfile, -InterPolateVars => 1, -ExtendedAccess => 1, + -UseApacheInclude => 1, ); my %config = $conf->getall(); -#------------------------------------------------------------------------------- -# Date setup -#------------------------------------------------------------------------------- # -# Transfer Date::Calc values into a hash for initialising a DateTime object. -# Force the day to 1 +# Short-circuit the "paths" to the configuration objects # -my ( @sd, $dt ); -@sd = ( @startdate, 0, 0, 0 ); -$sd[2] = 1; -$dt = dc_to_dt(\@sd); +my $settings_ptr = $config{settings}; +my $db_ptr = $config{database}; -emit( $silent, "Start of month: ", $dt->ymd, "\n" ); +# +# Load general settings from the %config hash +# +my $template = $settings_ptr->{main_template} // $defmain; +my $title_template = $settings_ptr->{title_template} // $deftt; +my $summary_template = $settings_ptr->{summary_template} // $defst; +my $tags = $settings_ptr->{tags} // $deftags; +my $hostid = $settings_ptr->{hostid} // $defhostid; +my $series_id = $settings_ptr->{series_id} // $defseries_id; +my $release_day = $settings_ptr->{releaseday} // 'Monday'; +my $recording_day = $settings_ptr->{recordingday} // 'Friday'; +my $start_time = $settings_ptr->{starttime} // '15:00:00'; +my $end_time = $settings_ptr->{endtime} // '17:00:00'; +my $date_cache_name = $settings_ptr->{cache} // $defcache; +my $container_template = $settings_ptr->{container_template} // $defcontainer; + +# +# Sanity checks on files in the configuration data +# +my %key_files = ( + 'main template' => $template, + 'date cache' => $date_cache_name, + 'container template' => $container_template, +); +for my $key (keys(%key_files)) { + die sprintf( "Unable to find %s file '%s'\n", $key, $key_files{$key} ) + unless ( -e $key_files{$key} ); +} + +# +# Make the tags an array if not already +# +$tags = [$tags] unless ( ref($tags) eq 'ARRAY' ); + +# +# Some time values +# +@deftime = split( ':', $start_time ); +my $release_dow = Decode_Day_of_Week($release_day); + +#------------------------------------------------------------------------------- +# Set last recording date and time from option or cache +#------------------------------------------------------------------------------- +# We're receiving the datetime for the last recording (that's the +# recording for the previous month) as an option, or we'll check the +# cache. +# +if (defined($lastrecording)) { + # + # Parse and perform rudimentary validation on the -lastrecording option + # + emit( $silent, "Last recording from option: ", $lastrecording, "\n" ); + _debug( $DEBUG > 1, '$lastrecording = ' . $lastrecording ); + + @dc_lr = parse_to_dc( $lastrecording, \@deftime ); + _debug( $DEBUG > 1, '@dc_lr = ' . Dumper( \@dc_lr ) ); +} +else { + emit( $silent, "Getting last recording from cache\n" ); + + # + # Load the cache + # + emit( $silent, "Date cache: ", $date_cache_name, "\n" ); + %date_cache = load_cache($date_cache_name); + #_debug( $DEBUG > 1, '%date_cache = ' . Dumper(\%date_cache) ); + + # + # Using last month's date get the cache element + # + @dc_lm = find_last_month(\@review_month); + $lastrecording = $date_cache{dc_to_dt(\@dc_lm)->ymd}; + + # + # Abort if the cache didn't have the date + # + unless (defined($lastrecording)) { + say "The date and time of the last recording is not in the cache"; + say "Use option -lastrecording=DATETIME (or -lr=DATETIME) instead"; + die "Can't continue"; + } + + # + # Set values from this new date + # + _debug( $DEBUG > 1, '$lastrecording = ' . $lastrecording ); + @dc_lr = parse_to_dc( $lastrecording, \@deftime ); + _debug( $DEBUG > 1, '@dc_lr = ' . Dumper( \@dc_lr ) ); +} + +# +# Recording day as text, $start_time in Date::Calc format +# +$recording_day = Day_of_Week_to_Text(Day_of_Week(@dc_lr[0..2])); +$start_time = join(':', @dc_lr[3..5]); + +# +# Numeric date difference +# +$date_offset = get_date_offset( $release_day, $recording_day ); + +# +# Stash all the values computed so far +# +$attributes{review_month} = \@review_month; +$attributes{dc_lm} = \@dc_lm; +$attributes{dc_lr} = \@dc_lr; +$attributes{release_day} = $release_day; +$attributes{release_dow} = $release_dow; +$attributes{recording_day} = $recording_day; +$attributes{lastrecording} = $lastrecording; +$attributes{date_offset} = $date_offset; + +_debug( $DEBUG > 1, '$release_day = ' . $release_day ); +_debug( $DEBUG > 1, '$release_dow = ' . $release_dow ); +_debug( $DEBUG > 1, '$recording_day = ' . $recording_day ); +_debug( $DEBUG > 1, '$lastrecording = ' . coalesce( $lastrecording, 'undef' ) ); +_debug( $DEBUG > 1, '$date_offset = ' . coalesce( $date_offset, 'undef' ) ); +_debug( $DEBUG > 1, '@deftime = (' . join( ',', @deftime ) . ')' ); + +#------------------------------------------------------------------------------- +# Make a DateTime object with the start of the month +#------------------------------------------------------------------------------- +my $dt_som = start_of_month(\@review_month); +$attributes{month_start} = $dt_som->ymd; #------------------------------------------------------------------------------- # 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 } ) +my $dbname = $db_ptr->{name}; +die "Unable to find database\n" unless (-e $dbname); + +$dbh = DBI->connect( "DBI:SQLite:dbname=$dbname", + "", "", { AutoCommit => 1, sqlite_unicode => 1, } ) or croak $DBI::errstr; -# -# Enable client-side UTF8 -# -$dbh->{mysql_enable_utf8} = 1; - -# -# Set the local timezone to UTC for this connection -# -$dbh->do("set time_zone = '+00:00'") or carp $dbh->errstr; - #------------------------------------------------------------------------------- -# Open the output file (or STDOUT) - we may need the date to do it +# Find the episode corresponding to the review month #------------------------------------------------------------------------------- -my $outfh; -if ($outfile) { - $outfile - = sprintf( $outfile, sprintf( "%d-%02d", $dt->year, $dt->month ) ) - if ( $outfile =~ /%s/ ); - emit( $silent, "Output: ", $outfile, "\n" ); +# +# Use the database to compute a show release date and show number, saving +# everything in the %attributes hash. +# +($episode,$releasedate) = find_release_date( $dbh, \%attributes ); +@dc_rd = parse_to_dc($releasedate,[0,0,0]); - open( $outfh, ">:encoding(UTF-8)", $outfile ) - or croak "Unable to open $outfile for writing: $!"; +my $title = sprintf( $title_template, $dt_som->month_name, $dt_som->year ); +my $summary = sprintf($summary_template, $dt_som->month_name, $dt_som->year ); + +# +# Does the computed episode number already exist in the database? This is +# a problem if so +# +$sth1 = $dbh->prepare(q{SELECT * FROM eps WHERE id = ?}); +$sth1->execute($episode); +if ( $dbh->err ) { + carp $dbh->errstr; +} +unless ( $h1 = $sth1->fetchrow_hashref() ) { + emit( $silent, "Slot $episode is unallocated\n" ); } else { - open( $outfh, ">&", \*STDOUT ) - or croak "Unable to initialise for writing: $!"; -} + emit( $silent, + "Error: episode $episode already exists in the database\n"); -#------------------------------------------------------------------------------- -# Check the episode specification if given -#------------------------------------------------------------------------------- -if ( defined($episode) ) { - my $title = sprintf( $title_template, $dt->month_name, $dt->year ); - - emit( $silent, "\n" ); - - # - # Is it a number? - # - if ( $episode =~ /^\d+$/ ) { - emit( $silent, "Writing to numbered episode option selected\n" ); - - # - # Does the number exist in the database? - # - $sth1 = $dbh->prepare(q{SELECT * FROM eps WHERE id = ?}); - $sth1->execute($episode); - if ( $dbh->err ) { - carp $dbh->errstr; - } - if ( $h1 = $sth1->fetchrow_hashref() ) { - # - # Episode exists, do more checks - # - emit( $silent, "Found episode $episode\n" ); - emit( $silent, "Title: ", $h1->{title}, "\n" ); - die "Error: wrong show selected\n" - unless ( $h1->{title} eq $title ); - - unless (validate_date($h1->{date}) || $interlock_enabled) { - die "Error: show $episode has a date in the past\n"; - } - - unless ($overwrite) { - die "Error: show $episode already has notes\n" - unless length( $h1->{notes} ) == 0; - } - } - else { - die "Error: episode $episode does not exist in the database\n"; - } + if ($h1->{title} eq $title) { + say "(Episode $episode is an old-style place-holder. Continuing)"; } else { - # - # The required episode is 'auto' (we already checked). Now we actually - # find the episode number corresponding to the month we're processing. - # We do this by searching for the relevant title in the database. - # - emit( $silent, "Searching for show title: '$title'\n" ); - $sth1 = $dbh->prepare(q{SELECT * FROM eps WHERE title = ?}); - $sth1->execute($title); - if ( $dbh->err ) { - carp $dbh->errstr; - } - if ( $h1 = $sth1->fetchrow_hashref() ) { - # - # Found the episode by title - # - $episode = $h1->{id}; - emit( $silent, "Found episode $episode\n" ); - emit( $silent, "Title: ", $h1->{title}, "\n" ); + die "Trying to overwrite an existing show. Aborting\n"; + } - unless (validate_date($h1->{date}) || $interlock_enabled) { - die "Error: show $episode has a date in the past\n"; - } - - unless ($overwrite) { - die "Error: show $episode already has notes\n" - unless length( $h1->{notes} ) == 0; - } - } - else { - die 'Error: Unable to find an episode ' - . "for the selected month's notes\n"; - } + unless (validate_date($h1->{date})) { + die "Error: show $episode has a date in the past\n"; } } +_debug( $DEBUG > 1, '%attributes: ' . Dumper( \%attributes ) ); + #------------------------------------------------------------------------------- -# If asked (-comments -markcomments) compute the last recording date +# Report important details #------------------------------------------------------------------------------- -if ($show_comments && $mark_comments) { - # - # We're marking comments so need to find the date of the recording of the - # last show. - # - # It's possible to specify date and time of the last recording via option - # '-lastrecording=DATETIME' (in case we recorded early or something), but - # it needs to be parsed. - # - if ( defined( $options{lastrecording} ) ) { - # - # Parse and perform rudimentary validation on the -lastrecording option - # - @dc_lr = parse_to_dc( $options{lastrecording}, \@deftime ); +# +# Convert the D::C datetimes to DateTime objects +# +$dt_lr = dc_to_dt(\@dc_lr); +$dt_lm = dc_to_dt(\@dc_lm); +$dt_rd = dc_to_dt(\@dc_rd); - } - else { - # - # Otherwise we assume the recording was on a Saturday and compute when - # that was. We get back the date and time of the recording as - # a Date::Calc object. - # - @dc_lr = find_last_recording( \@startdate, \@deftime ); - } +emit($silent,"\n"); - # - # Convert the D::C datetime to a DateTime object - # - $dt_lr = dc_to_dt(\@dc_lr); - - # Report it for checking (since this algorithm is complex) - emit( - $silent, - sprintf("* %-100s *\n", - ( defined( $options{lastrecording} ) ? 'Given' : 'Found' ) . - ' last recording date on ' . - $dt_lr->datetime . ' time zone ' . $dt_lr->strftime('%Z') . - ' (' . $dt_lr->epoch . ')' - ) - ); - - # - # Also, we need to know the last month for comment marking - # - @dc_lm = find_last_month(\@startdate); - $dt_lm = dc_to_dt(\@dc_lm); - - # Report it for checking (since this algorithm is complex) - emit( - $silent, - sprintf("* %-100s *\n", - 'Last month computed to be ' . - $dt_lm->datetime . ' time zone ' . $dt_lm->strftime('%Z') . - ' (' . $dt_lm->epoch . ')' - ) - ); - - # - # Work out if the the recording date was before the end of the last - # reviewed month. - # - $t_days = trailing_days(\@dc_lr, \@dc_lm); - emit( - $silent, - sprintf("* %-100s *\n", - 'Recording was in the reviewed month and not on the ' . - 'last day, so comments may have been missed' - ) - ) if $t_days; - - _debug( $DEBUG > 2, '@dc_lr = (' . join(',',@dc_lr) .')' ); - _debug( $DEBUG > 2, '$dt_lr->ymd = ' . $dt_lr->ymd ); - _debug( $DEBUG > 2, '$dt_lr->hms = ' . $dt_lr->hms ); - _debug( $DEBUG > 2, '@dc_lm = (' . join(',',@dc_lm) .')' ); -} -else { - # - # We now need a default for $dt_lr in all cases because the query has been - # changed. - # - @dc_lr = find_last_recording( \@startdate, \@deftime ); - $dt_lr = dc_to_dt(\@dc_lr); +emit($silent,sprintf("* %-100s *\n",'Generating files:')); +for my $file ( + only_defined( + ( defined($html_outfile) ? $html_outfile : undef ), + ( defined($full_html_outfile) ? $full_html_outfile : undef ), + ( defined($json_outfile) ? $json_outfile : undef ) + ) + ) +{ + emit( $silent, sprintf( "* %-100s *\n", "» $file" ) ); } -#------------------------------------------------------------------------------- +emit($silent,"\n"); + +emit( + $silent, + multi_sprintf("* %-100s *\n", + 'Review month ' . $dt_som->month_name . ' ' . $dt_som->year, + 'Generating notes for episode ' . $episode . + ' for release on ' . $dt_rd->ymd, + '', + ( defined( $options{lastrecording} ) ? 'Given' : 'Found' ) . + ' last recording date on ' . + $dt_lr->datetime . ' time zone ' . $dt_lr->strftime('%Z') . + ' (' . $dt_lr->epoch . ')', + 'Last review month computed to be ' . + $dt_lm->datetime . ' time zone ' . $dt_lm->strftime('%Z') . + ' (' . $dt_lm->epoch . ')' + ) +); + +# +# Work out if the recording date was before the end of the last +# reviewed month. +# +$t_time = trailing_time(\@dc_lr, \@dc_lm); +emit( + $silent, + multi_sprintf("* %-100s *\n", + 'The last recording was in the last reviewed month and not on the ' . + 'last day, so comments may have ', + 'been missed' + ) +) if $t_time; + +# +# Report what we have in the 'lastrecording' and 'lastmonth' variables +# +_debug( $DEBUG > 1, '@dc_lr = (' . join(',',@dc_lr) .')' ); +_debug( $DEBUG > 1, '$dt_lr->ymd = ' . $dt_lr->ymd ); +_debug( $DEBUG > 1, '$dt_lr->hms = ' . $dt_lr->hms ); +_debug( $DEBUG > 1, '@dc_lm = (' . join(',',@dc_lm) .')' ); +_debug( $DEBUG > 1, '$t_time = ' . $t_time, '=-' x 20 ); + +#=============================================================================== # Data collection +#=============================================================================== + +#------------------------------------------------------------------------------- +# Get any new hosts for the required month #------------------------------------------------------------------------------- -# -# Prepare to get any new hosts for the required month. We let MySQL compute -# the end of the month. Order by date of first show. -# $sth1 = $dbh->prepare( q{SELECT ho.host, ho.hostid, md.mindate FROM hosts ho JOIN (SELECT hostid, MIN(date) mindate FROM eps GROUP BY hostid) AS md ON ho.hostid = md.hostid - WHERE md.mindate >= ? AND md.mindate < last_day(?) + interval 1 day + WHERE md.mindate >= DATE(?) AND md.mindate < DATE(?,'+1 month') ORDER BY mindate} ); -$sth1->execute( $dt->ymd, $dt->ymd ); +$sth1->execute( $dt_som->ymd, $dt_som->ymd ); if ( $dbh->err ) { carp $dbh->errstr; } @@ -500,46 +520,45 @@ if ( $dbh->err ) { # Grab the data as an arrayref of hashrefs # $hosts = $sth1->fetchall_arrayref( {} ); +_debug( $DEBUG > 1, '$hosts = ' . Dumper($hosts) ); -# -# Prepare to get the episodes for the required month. We let MySQL compute the -# end of the month. We include every column here just in case they'll be -# useful in the template, though this requires some aliasing. +#------------------------------------------------------------------------------- +# Get the episodes for the required month +#------------------------------------------------------------------------------- +# We let SQLite compute the end of the month. We include every column here just +# in case they'll be useful in the main template, though this requires some +# aliasing. # 2015-04-05 The date field has been reformatted so that the 'date' plugin in -# the form is happy with it. +# the template is happy with it. # -$sth1 = $dbh->prepare( - q{SELECT eps.id AS eps_id, --- eps.type, --- date_format(eps.date,'%a %Y-%m-%d') AS date, - date_format(eps.date,'00:00:00 %d/%m/%Y') AS date, --- eps.date, - eps.title, - sec_to_time(eps.duration) as length, - eps.summary, - eps.notes, --- eps.host AS eps_host, - eps.hostid AS eps_hostid, - eps.series, - eps.explicit, - eps.license AS eps_license, - eps.tags, - eps.version, - eps.valid AS eps_valid, - ho.hostid AS ho_hostid, - ho.host AS ho_host, - ho.email, - ho.profile, -- was website, - ho.license AS ho_license, --- ho.repeat, - ho.valid AS ho_valid - FROM eps - JOIN hosts ho ON eps.hostid = ho.hostid - WHERE eps.date >= ? - AND eps.date < last_day(?) + interval 1 day - ORDER BY id} -); -$sth1->execute( $dt->ymd, $dt->ymd ); +$sth1 = $dbh->prepare(q{ + SELECT + eps.id AS eps_id, + strftime('00:00:00 %d/%m/%Y',eps.date) AS date, + eps.title, + time(eps.duration,'unixepoch') as length, + eps.summary, + eps.notes, + eps.hostid AS eps_hostid, + eps.series, + eps.explicit, + eps.license AS eps_license, + eps.tags, + eps.version, + eps.valid AS eps_valid, + ho.hostid AS ho_hostid, + ho.host AS ho_host, + ho.email, + ho.profile, -- was website, + ho.license AS ho_license, + ho.valid AS ho_valid + FROM eps + JOIN hosts ho ON eps.hostid = ho.hostid + WHERE eps.date >= DATE(?) + AND eps.date < DATE(?,'+1 month') + ORDER BY id +}); +$sth1->execute( $dt_som->ymd, $dt_som->ymd ); if ( $dbh->err ) { carp $dbh->errstr; } @@ -549,242 +568,50 @@ if ( $dbh->err ) { # $shows = $sth1->fetchall_arrayref( {} ); -# +#------------------------------------------------------------------------------- # Collect the comments if requested -# +#------------------------------------------------------------------------------- if ($show_comments) { # - # Grab the comments for the selected period. These have weird \' sequences - # in the author, title and text, which doesn't seem right, so we strip - # them. Note that the end date in date ranges seems only to work as - # 'last_day(?) + interval 1 day' presumably because without it the date is - # interpreted as midnight the previous day (e.g. 2014-06-30 is early on - # this day, not early on 2014-07-01 whereas adding 1 day gets this right). - # - # The logic here was rewritten 2015-03-04 and consists of: - # - the sub-select collects the id numbers of all comments that have - # occurred in the selected period - # - because all comments relating to a given show have the same id number - # this identifies all comment groups (comments relating to a given show) - # with members in the period - # - the main query then selects all comments in these groups and joins all - # the required tables to them to get the other data we need; it computes - # the boolean 'in_range' to indicate whether a comment within a group - # should be displayed; it returns *all* comments so we can number them - # - there might have been a way to generate a comment sequence number - # within the SQL but it was decided not to and to do this in the script - # - # Update 2015-03-26: the sort order of the final result used - # 'comment_identifier_id' which didn't seem to work reliably. Changed this - # to 'episode' which seems to work fine. The use of the former was only - # arrived at by guesswork. The guess was obviously wrong. - # - # Update 2015-06-04: the test for whether a comment is approved was - # failing because it was in the wrong place. Also, the sub-select seemed - # wrong, and running through EXPLAIN EXTENDED showed some flaws. - # Redesigned this and the whole query to be more in keeping with the - # algorithm sketched out above. This seems to have solved the problems. - # - # Update 2015-08-17: Still not right; somehow the 'in_range' check got - # mangled and the process of counting comments where a recent one was made - # to an old show was messed up. Dropped the two queries with a UNION and - # went back to the check for comment_identifier_id in a sub-query. This - # time the sub-query is cleverer and returns identifiers where the - # `comment_timestamp` is in the target month *and* the episode date is in - # the target month or before the start of the target month. This works for - # July 2015 (where there's a comment made about an August show) and August - # 2015 (where there's a comment made about a July show). - # - # Update 2023-05-02: Issues with comments received on the day of - # recording. This matter has been addresed earlier in the year but not all - # that well. The way this is all handled is not very clever so tried - # adjusting the main comment query to return such comments since we had - # one on 2023-04-29 which wasn't in the report. - # - #{{{ - # - # Graveyard of old failed queries... - # ================================== -# $sth1 = $dbh->prepare( -# q{ -# SELECT -# cc.comment_identifier_id, -# eps.id AS episode, -#-- ci.identifier_url, -# substr(ci.identifier_url,1,locate('/eps.php?id=',ci.identifier_url)+15) -# AS identifier_url, -# eps.title, -# eps.date, -# ho.host, -# ho.hostid, -# from_unixtime(cc.comment_timestamp,'%Y-%m-%dT%TZ') AS timestamp, -# replace(cc.comment_author_name,'\\\\','') AS comment_author_name, -# replace(cc.comment_title,'\\\\','') AS comment_title, -# replace(cc.comment_text,'\\\\','') AS comment_text, -# cc.comment_timestamp, -# (CASE WHEN (cc.comment_timestamp >= unix_timestamp(?) -# AND cc.comment_timestamp < unix_timestamp(last_day(?) + interval 1 day)) THEN -# 1 ELSE 0 END) AS in_range -# FROM c5t_comment cc -# JOIN c5t_identifier ci ON ci.identifier_id = cc.comment_identifier_id -# JOIN eps ON eps.id = -# substr(ci.identifier_url,locate('/eps.php?id=',ci.identifier_url)+12) -# JOIN hosts ho ON eps.hostid = ho.hostid -# WHERE cc.comment_status = 0 -# AND cc.comment_identifier_id IN ( -# SELECT DISTINCT cc2.comment_identifier_id FROM c5t_comment cc2 -# WHERE ( -# cc2.comment_timestamp >= unix_timestamp(?) -# AND cc2.comment_timestamp < unix_timestamp(last_day(?) + interval 1 day) -# ) -# ) -# AND (eps.date < (last_day(?) + interval 1 day)) -# ORDER BY eps.id ASC, comment_timestamp ASC -# } -# ); -# -# This one is nuts... -# $sth1 = $dbh->prepare( q{ -# ( -# SELECT -# cc.comment_identifier_id, -# eps.id AS episode, -# substr(ci.identifier_url,1,locate('/eps.php?id=',ci.identifier_url)+15) -# AS identifier_url, -# eps.title, -# eps.date, -# ho.host, -# ho.hostid, -# from_unixtime(cc.comment_timestamp,'%Y-%m-%dT%TZ') AS timestamp, -# replace(cc.comment_author_name,'\\\\','') AS comment_author_name, -# replace(cc.comment_title,'\\\\','') AS comment_title, -# replace(cc.comment_text,'\\\\','') AS comment_text, -# cc.comment_timestamp, -# (CASE WHEN (cc.comment_timestamp >= unix_timestamp(?) -# AND cc.comment_timestamp < unix_timestamp(last_day(?) + interval 1 day)) THEN -# 1 ELSE 0 END) AS in_range -# FROM c5t_comment cc -# JOIN c5t_identifier ci ON ci.identifier_id = cc.comment_identifier_id -# JOIN eps ON eps.id = -# substr(ci.identifier_url,locate('/eps.php?id=',ci.identifier_url)+12,4) -# JOIN hosts ho ON eps.hostid = ho.hostid -# WHERE eps.date >= ? AND eps.date < (last_day(?) + interval 1 day) -# ) -# UNION -# ( -# SELECT -# cc.comment_identifier_id, -# eps.id AS episode, -# substr(ci.identifier_url,1,locate('/eps.php?id=',ci.identifier_url)+15) -# AS identifier_url, -# eps.title, -# eps.date, -# ho.host, -# ho.hostid, -# from_unixtime(cc.comment_timestamp,'%Y-%m-%dT%TZ') AS timestamp, -# replace(cc.comment_author_name,'\\\\','') AS comment_author_name, -# replace(cc.comment_title,'\\\\','') AS comment_title, -# replace(cc.comment_text,'\\\\','') AS comment_text, -# cc.comment_timestamp, -# (CASE WHEN (cc.comment_timestamp >= unix_timestamp(?) -# AND cc.comment_timestamp < unix_timestamp(last_day(?) + interval 1 day)) THEN -# 1 ELSE 0 END) AS in_range -# FROM c5t_comment cc -# JOIN c5t_identifier ci ON ci.identifier_id = cc.comment_identifier_id -# JOIN eps ON eps.id = -# substr(ci.identifier_url,locate('/eps.php?id=',ci.identifier_url)+12,4) -# JOIN hosts ho ON eps.hostid = ho.hostid -# WHERE (cc.comment_timestamp >= unix_timestamp(?) -# AND cc.comment_timestamp < unix_timestamp(last_day(?) + interval 1 day)) -# AND eps.date < (last_day(?) + interval 1 day) -# ) -# ORDER BY episode ASC, comment_timestamp ASC -# }); -# -# This one worked fine - after much messing around admittedly: -# $sth1 = $dbh->prepare( q{ -# SELECT -# cc.comment_identifier_id, -# eps.id AS episode, -# substr(ci.identifier_url,1,locate('/eps.php?id=',ci.identifier_url)+15) -# AS identifier_url, -# eps.title, -# eps.date, -# ho.host, -# ho.hostid, -# from_unixtime(cc.comment_timestamp,'%Y-%m-%dT%TZ') AS timestamp, -# replace(cc.comment_author_name,'\\\\','') AS comment_author_name, -# replace(cc.comment_title,'\\\\','') AS comment_title, -# replace(cc.comment_text,'\\\\','') AS comment_text, -# cc.comment_timestamp, -# (CASE WHEN -# ( -# (cc.comment_timestamp >= unix_timestamp(?) -# AND cc.comment_timestamp < unix_timestamp(last_day(?) + interval 1 day)) -# AND eps.date < (last_day(?) + interval 1 day) -# OR (cc.comment_timestamp < unix_timestamp(last_day(?) + interval 1 day) -# AND (eps.date >= ? AND eps.date < (last_day(?) + interval 1 day))) -# ) -# THEN 1 ELSE 0 END) AS in_range -# FROM c5t_comment cc -# JOIN c5t_identifier ci ON ci.identifier_id = cc.comment_identifier_id -# JOIN eps ON eps.id = -# substr(ci.identifier_url,locate('/eps.php?id=',ci.identifier_url)+12,4) -# JOIN hosts ho ON eps.hostid = ho.hostid -# WHERE cc.comment_status = 0 -# AND cc.comment_identifier_id IN -# ( -# SELECT DISTINCT -# cc.comment_identifier_id -# FROM c5t_comment cc -# JOIN c5t_identifier ci ON ci.identifier_id = cc.comment_identifier_id -# JOIN eps ON eps.id = -# substr(ci.identifier_url,locate('/eps.php?id=',ci.identifier_url)+12,4) -# WHERE -# (eps.date >= ? AND eps.date < (last_day(?) + interval 1 day)) -# OR ( -# ( (cc.comment_timestamp >= unix_timestamp(?) -# AND cc.comment_timestamp < unix_timestamp(last_day(?) + interval 1 day)) ) -# AND (eps.date >= ? AND eps.date < (last_day(?) + interval 1 day) -# OR (eps.date < ?)) -# ) -# ) -# ORDER BY episode ASC, comment_timestamp ASC -# }); - #}}} - - #------------------------------------------------------------------------------- # Main comment query - #------------------------------------------------------------------------------- + # $sth1 = $dbh->prepare( q{ SELECT + row_number() OVER + (PARTITION BY eps.id ORDER BY co.comment_timestamp) + AS comment_number, eps.id AS episode, concat('https://hackerpublicradio.org/eps/hpr', - lpad(eps_id,4,0),'/index.html') AS identifier_url, + format('%04d',eps_id),'/index.html') AS identifier_url, eps.title, eps.summary, eps.date, ho.host, ho.hostid, - date_format(co.comment_timestamp,'%Y-%m-%dT%TZ') AS timestamp, + -- date format for TT² + strftime('%Y-%m-%dT%TZ',co.comment_timestamp) AS timestamp, + co.id AS comment_id, co.comment_author_name, co.comment_title, co.comment_text, - unix_timestamp(co.comment_timestamp) AS comment_timestamp_ut, - unix_timestamp( - cast(concat(date(co.comment_timestamp),' ',?) AS DATETIME) - ) AS comment_released_ut, + unixepoch(co.comment_timestamp) AS comment_timestamp_ut, (CASE WHEN ( - (co.comment_timestamp >= ? - AND co.comment_timestamp < (last_day(?) + interval 1 day)) - OR (co.comment_timestamp >= ?) - AND eps.date < (last_day(?) + interval 1 day) - OR (co.comment_timestamp < (last_day(?) + interval 1 day) - AND (eps.date >= ? AND eps.date < (last_day(?) + interval 1 day))) + -- [$dt_som->ymd] + (co.comment_timestamp >= DATE(?) + -- [$dt_som->ymd] + AND co.comment_timestamp < DATE(?,'+1 month')) + -- [$dt_som->ymd] + AND eps.date < DATE(?,'+1 month') + -- [$dt_som->ymd] + OR (co.comment_timestamp < DATE(?,'+1 month') + -- [$dt_som->ymd] [$dt_som->ymd] + AND (eps.date >= DATE(?) AND eps.date < DATE(?,'+1 month'))) ) - THEN 1 ELSE 0 END) AS in_range + THEN 1 ELSE 0 END) AS in_range, + -- [$dt_som->ymd] + (CASE WHEN eps.date < DATE(?) THEN 1 ELSE 0 END) AS past FROM comments co JOIN eps ON eps.id = co.eps_id JOIN hosts ho ON eps.hostid = ho.hostid @@ -795,25 +622,24 @@ if ($show_comments) { FROM eps JOIN comments co ON (eps.id = co.eps_id) WHERE - (eps.date >= ? AND eps.date < (last_day(?) + interval 1 day)) - OR (co.comment_timestamp >= ?) + -- [$dt_som->ymd] [$dt_som->ymd] + (eps.date >= DATE(?) AND eps.date < DATE(?,'+1 month')) OR ( - ( (co.comment_timestamp >= ? - AND co.comment_timestamp < (last_day(?) + interval 1 day)) ) - AND (eps.date >= ? AND eps.date < (last_day(?) + interval 1 day) - OR (eps.date < ?)) + -- [$dt_som->ymd] + ( (co.comment_timestamp >= DATE(?) + -- [$dt_som->ymd] + AND co.comment_timestamp < DATE(?,'+1 month')) ) + -- [$dt_som->ymd] [$dt_som->ymd] + AND (eps.date >= DATE(?) AND eps.date < DATE(?,'+1 month') + -- [$dt_som->ymd] + OR (eps.date < DATE(?))) ) ) ORDER BY episode ASC, comment_timestamp ASC }); $sth1->execute( - $dt_lr->hms, - ( $dt->ymd ) x 2, - $dt_lr->ymd, - ( $dt->ymd ) x 6, - $dt_lr->ymd, - ( $dt->ymd ) x 5 + ( $dt_som->ymd ) x 14 ); if ( $dbh->err ) { carp $dbh->errstr; @@ -835,38 +661,17 @@ if ($show_comments) { # comments we got back. The query has marked the ones we want to count # (and display) using 'in_range'. # - my ( $ep, $lastep, $index ) = ( 0, 0, 0 ); $comment_count = $past_count = $ignore_count = 0; + + # FIXME: Why not remove all comments 'in_range = 0' first then count and + # tidy them? See the section finding missed comments for the way it's done + # there. + # + # Count comments in the arrayref of hashrefs, and tidy the text a little + # for my $row (@$comments) { # - # Give each comment an index whether in_range or not. The indexes - # start from 1 when the episode number changes otherwise they - # increment. - # - $ep = $row->{episode}; - if ( $ep == $lastep ) { - $index++; - } - else { - $index = 1; - } - #print "$ep $index ", $row->{in_range}, "\n"; - _debug( - $DEBUG > 2, - sprintf( - "Index generation: episode=%s, index=%s, in_range=%s", - $ep, $index, $row->{in_range} - ) - ); - $lastep = $ep; - - # - # Save the index for the template - # - $row->{index} = $index; - - # - # Count the valid ones so the template doesn't have to to give a total + # Count the valid ones so the template doesn't have to compute a total # for this month # $comment_count++ if $row->{in_range}; @@ -876,78 +681,59 @@ if ($show_comments) { # why they are there in the first place) # $row->{comment_text} =~ s/\r+//g; - - # - # Dates from the database look like '2016-08-01', we compare them to - # the month we're processing to see if the comments are attached to - # old shows. - # FIXME: test for 'in_range' before setting 'past' - # - if ( validate_date($row->{date},$dt->ymd) ) { - $row->{past} = 0; - } - else { - $row->{past} = 1; - $past_count++ if $row->{in_range}; - } } # - # Now prune all of the comments which are not in_range to give the - # template an easier job + # Now prune all of the comments which are not in_range to make the next + # steps easier. Where there are already comments on an episode we need + # them all returned by the query to generate their index numbers, but now + # we can remove the redundant ones. # @$comments = grep { $_->{in_range} } @$comments; - # Explanation of the resulting structure {{{ + #------------------------------------------------------------------------------- + # Populate %past and %current hashes. + #------------------------------------------------------------------------------- + # These hashes are indexed by episode numbers and each value is an + # arrayref containing comments to that episode, each represented by + # a hashref. These structures can be seen by running with '-debug=3'. # - # Restructure the comments into two hashes keyed by episode number where - # each comment to that episode is stored in sequence in an array. The two - # hashes %past and %current hold comments for shows in the past and for - # the current month. These can be dealt with separately in the template, - # making the logic therein somewhat simpler and clearer. - # - # The hash (of arrays of hashes) can be visualised thus: - # %past = { - # '2457' => [ - # { - # 'past' => 1, - # 'hostid' => 111, - # 'identifier_url' => 'https://hackerpublicradio.org/eps.php?id=2457', - # 'comment_timestamp_ut' => 1556192523, - # 'date' => '2018-01-02', - # 'comment_text' => [snip], - # 'comment_title' => 'aren\'t you forgetting a hub?', - # 'timestamp' => '2019-04-25T11:42:03Z', - # 'in_range' => 1, - # 'index' => 1, - # 'host' => 'knightwise', - # 'title' => 'Getting ready for my new Macbook Pro', - # 'comment_author_name' => 'Bart', - # 'episode' => 2457, - # 'ignore' => 0 - # } - # ] - # } - #}}} - - # - # Also, as we go, mark and count the comments in the %past hash which were - # likely to have been read in the last show, so by this means simplify - # what the template has to do. + # For past shows, when generating notes for hosts, we determine whether to + # ignore them in the recording because they will have been read in the + # last Community News show. They will have green backgrounds if so. The + # released notes have none of this. We determine what to ignore in this + # loop. # for my $row (@$comments) { my $ep = $row->{episode}; - if ($row->{past}) { - if ( $show_comments && $mark_comments ) { - #if ( $row->{comment_timestamp_ut} <= $dt_lr->epoch - if ( $row->{comment_released_ut} <= $dt_lr->epoch - && substr( $row->{date}, 0, 7 ) eq - substr( $dt_lm->ymd, 0, 7 ) ) + + # + # Hash %past contains comments to past shows whereas %current contains + # comments to shows in the reviewed month. + # + if ( $row->{past} ) { + $past_count++; + + # + # Mark past comments to be ignored if received before the + # recording date for the previous month AND we are displaying + # comments AND marking them. We need the last month's + # recording date and time to do this ('$dt_lr'). + # + if ( $full_html_outfile ) { + # + # We want comments and we want them marked + # + if ( $row->{comment_timestamp_ut} <= $dt_lr->epoch + && substr( $row->{date}, 0, 7 ) eq substr( $dt_lm->ymd, 0, 7 ) ) { $row->{ignore} = 1; $ignore_count++; } else { + # + # Comments but no marking thanks + # $row->{ignore} = 0; } } @@ -955,16 +741,32 @@ if ($show_comments) { $row->{ignore} = 0; } - if (exists($past{$ep})) { - push(@{$past{$ep}},$row); + # + # Trim excess newlines + # + if ( $full_html_outfile ) { + { + $/ = ''; + chomp($row->{comment_text}); # NOTE: experimental + } + } + + # + # Add to %past + # + if ( exists( $past{$ep} ) ) { + push( @{ $past{$ep} }, $row ); } else { $past{$ep} = [$row]; } } else { - if (exists($current{$ep})) { - push(@{$current{$ep}},$row); + # + # Add to %current + # + if ( exists( $current{$ep} ) ) { + push( @{ $current{$ep} }, $row ); } else { $current{$ep} = [$row]; @@ -974,49 +776,58 @@ if ($show_comments) { _debug ($DEBUG > 2, '%past: ' . Dumper(\%past), - '%current: ' . Dumper(\%current) + '=-' x 20, + '%current: ' . Dumper(\%current), + '=-' x 20, + '$past_count: ' . "$past_count", + '=-' x 20, + '$ignore_count: ' . "$ignore_count", + '=-' x 20 ); #------------------------------------------------------------------------------- - # Make another data structure of missed coments *if* $t_days is true + # Make another data structure of missed comments *if* $t_time is true #------------------------------------------------------------------------------- - # If $t_days is true then there might be comments from the previous month + # If $t_time is true then there might be comments from the previous month # that weren't covered in the recording. So we add them to the notes just - # for the recording. Trouble is, if they exist they aren't in the comments - # we have gathered, so we'll have to go and search for them with this - # special query. + # for the benefit of the hosts during the recording. Trouble is, if they + # exist they aren't in the comments we have gathered, so we'll have to go + # and search for them with this special query. + # TODO: Should these comments be indexed? # - if ($t_days) { + if ($t_time) { $sth1 = $dbh->prepare( q{ SELECT eps.id AS episode, concat('https://hackerpublicradio.org/eps/hpr', - lpad(eps_id,4,0),'/index.html') AS identifier_url, + format('%04d',eps_id),'/index.html') AS identifier_url, eps.title, eps.summary, eps.date, ho.host, ho.hostid, - date_format(co.comment_timestamp,'%Y-%m-%dT%TZ') AS timestamp, + strftime('%Y-%m-%dT%TZ',co.comment_timestamp) AS timestamp, + co.id AS comment_id, co.comment_author_name, co.comment_title, co.comment_text, - unix_timestamp(co.comment_timestamp) AS comment_timestamp_ut + unixepoch(co.comment_timestamp) AS comment_timestamp_ut FROM comments co JOIN eps ON eps.id = co.eps_id JOIN hosts ho ON eps.hostid = ho.hostid WHERE - co.comment_timestamp >= ? - AND co.comment_timestamp < (last_day(?)+ interval 1 day) + -- [$dt_lr->datetime . 'Z'] + co.comment_timestamp >= DATETIME(?) + -- [$dt_lm->ymd] + AND co.comment_timestamp < DATE(?,'+1 month') ORDER BY episode ASC, comment_timestamp ASC }); # - # Need the date and time of the last recording and the start of the - # last month we reviewed to perform the query. + # Need the date and time of the start of the last recording and the + # start of the last month we reviewed to perform the query. # - # $sth1->execute( $dt_lr->datetime . 'Z', $dt_lm->ymd ); - $sth1->execute( $dt_lr->ymd, $dt_lm->ymd ); + $sth1->execute( $dt_lr->datetime . 'Z', $dt_lm->ymd ); if ( $dbh->err ) { carp $dbh->errstr; } @@ -1037,6 +848,10 @@ if ($show_comments) { # for my $ch (@$missed_comments) { $ch->{comment_text} =~ s/\r+//g; + { + $/ = ''; + chomp($ch->{comment_text}); # NOTE: experimental + } } _debug ($DEBUG > 2, @@ -1046,9 +861,11 @@ if ($show_comments) { # # After a change in design around 2023-05-02 there may be duplicates # in the %past hash and the @$missed_comments array. We need to hide - # the former for now. They will not be hidden when $t_days is false + # the former for now. They will not be hidden when $t_time is false # because we're not bothered about missed comments! # + # TODO: Is this true now? + # if ( $past_count > 0 ) { my @missed_episodes = map { $_->{episode} } @$missed_comments; @@ -1064,6 +881,7 @@ if ($show_comments) { _debug( $DEBUG > 2, '%past (edited): ' . Dumper( \%past ), + '=-' x 20, "\$past_count: $past_count", "\$comment_count: $comment_count" ); @@ -1072,7 +890,7 @@ if ($show_comments) { } #------------------------------------------------------------------------------- -# Fill and print the template +# Prepare the TT² object #------------------------------------------------------------------------------- my $tt = Template->new( { ABSOLUTE => 1, @@ -1085,56 +903,268 @@ my $tt = Template->new( } ); -my $vars = { - review_month => $dt->month_name, - review_year => $dt->year, - hosts => $hosts, - shows => $shows, - comment_count => $comment_count, - past_count => $past_count, - ignore_count => $ignore_count, - missed_count => $missed_count, - missed_comments => $missed_comments, - comments => $comments, # legacy - past => \%past, - current => \%current, - skip_comments => ( $show_comments ? 0 : 1 ), - mark_comments => $mark_comments, - ctext => $ctext, - last_recording => ( $mark_comments ? $dt_lr->epoch : 0 ), - last_month => ( - $mark_comments ? sprintf( "%d-%02d", $dt_lm->year, $dt_lm->month ) : 0 - ), - includefile => $mailnotes, - aob => defined($aobfile), - aobfile => $aobfile, -}; +#------------------------------------------------------------------------------- +# Generate the HTML fragment and add it to the JSON if that output is requested +#------------------------------------------------------------------------------- +if ($html_outfile || $json_outfile) { + my $outfh; -#print Dumper($vars),"\n"; - -my $document; -$tt->process( $template, $vars, \$document, { binmode => ':utf8' } ) - || die $tt->error(), "\n"; -print $outfh $document; - -# -# The episode number tests passed earlier on, so add the notes to the database -# if so requested -# -if ($episode) { - emit( $silent, - "Writing shownotes to the database for episode $episode\n" ); - $sth1 = $dbh->prepare(q{UPDATE eps SET notes = ? WHERE id = ?}); - $sth1->execute( $document, $episode ); - if ( $dbh->err ) { - carp $dbh->errstr; + # + # Settings for creating the HTML fragment + # + if ($html_outfile) { + $outfh = make_filename_and_open($html_outfile, + sprintf( "%d-%02d", $dt_som->year, $dt_som->month )); } + + my $vars = { + review_month => $dt_som->month_name, + review_year => $dt_som->year, + hosts => $hosts, # arrayref of hashrefs + shows => $shows, # arrayref of hashrefs + comment_count => $comment_count, + past_count => $past_count, + ignore_count => $ignore_count, + missed_count => $missed_count, + missed_comments => $missed_comments, # arrayref of hashrefs + comments => $comments, # legacy + past => \%past, + current => \%current, + skip_comments => ( $show_comments ? 0 : 1 ), + mark_comments => 0, # Used to be options. Still + ctext => 0, # needed by the template + last_recording => 0, + last_month => 0, + mailnotes => $mailnotes, + }; + + # + # Write the HTML fragment to a scalar + # + my $document; + $tt->process( $template, $vars, \$document, { binmode => ':utf8' } ) + || die $tt->error(), "\n"; + + # + # Send the HTML fragment to a file if requested + # + if ($html_outfile) { + print $outfh $document; + close($outfh); + } + + #------------------------------------------------------------------------------- + # Create the JSON if requested + #------------------------------------------------------------------------------- + if ($json_outfile) { + $outfh = make_filename_and_open($json_outfile, + sprintf( "%d-%02d", $dt_som->year, $dt_som->month )); + + # + # Collect details from the database + # + $sth1 = $dbh->prepare(q{ + SELECT + h.*, + m.id AS series_id, + m.name AS series_name + FROM hosts h + JOIN miniseries m ON m.id = ? + WHERE h.hostid = ? + }); + $sth1->execute($series_id,$hostid); + if ( $dbh->err ) { + carp $dbh->errstr; + } + unless ( $h1 = $sth1->fetchrow_hashref() ) { + emit( $silent, "Can't find host $hostid\n" ); + die "Problem with constructing JSON\n"; + } + + # + # Build JSON using the HTML fragment + # + $json_data{ep_num} = $episode; + $json_data{ep_date} = $releasedate; + $json_data{email} = $h1->{email}; + $json_data{title} = $title; + $json_data{duration} = 0; # How to do this? + $json_data{summary} = $summary; + $json_data{series_id} = $h1->{series_id}; + $json_data{series_name} = $h1->{series_name}; + $json_data{explicit} = 1; + $json_data{episode_license} = 'CC-BY-SA'; + $json_data{tags} = $tags; # Expect an array + $json_data{hostid} = $h1->{hostid}; + $json_data{host_name} = $h1->{host}; + $json_data{host_license} = $h1->{license}; + $json_data{host_profile} = $h1->{profile}; + $json_data{notes} = $document; +# $json_data{notes} = 'Testing'; + + my $json = JSON->new->utf8; + say $outfh $json->encode(\%json_data); + + $sth1->finish; + + } +} + +#------------------------------------------------------------------------------- +# Generate the enhanced HTML fragment, then encapsulate it in HTML to make it +# standalone. +#------------------------------------------------------------------------------- +if ($full_html_outfile) { + # + # Settings for creating the standalone HTML + # + my $outfh = make_filename_and_open($full_html_outfile, + sprintf( "%d-%02d", $dt_som->year, $dt_som->month )); + + my $vars = { + review_month => $dt_som->month_name, + review_year => $dt_som->year, + hosts => $hosts, + shows => $shows, + comment_count => $comment_count, + past_count => $past_count, + ignore_count => $ignore_count, + missed_count => $missed_count, + missed_comments => $missed_comments, # arrayref of hashrefs + comments => $comments, # legacy + past => \%past, + current => \%current, + skip_comments => ( $show_comments ? 0 : 1 ), + mark_comments => 1, # Used to be options. Still + ctext => 1, # needed by the template + last_recording => $dt_lr->epoch, + last_month => sprintf( "%d-%02d", $dt_lm->year, $dt_lm->month ), + mailnotes => $mailnotes, + }; + + my $document; + $tt->process( $template, $vars, \$document, { binmode => ':utf8' } ) + || die $tt->error(), "\n"; + + # + # We have the HTML in $document, so now we need to use another template to + # make it standalone. + # + $vars = { + shownotes => \$document, + episode => $episode, + month_year => sprintf("%s %d", $dt_som->month_name, $dt_som->year), + }; + + my $full_document; + $tt->process( $container_template, $vars, \$full_document, { binmode => ':utf8' } ) + || die $tt->error(), "\n"; + + print $outfh $full_document; } $dbh->disconnect; exit; +#=== FUNCTION ================================================================ +# NAME: find_release_date +# PURPOSE: Given a reference date and episode number from the database +# find the release date for the current review show. +# PARAMETERS: $dbh database handle +# $atts Hashref containing attributes which is added +# to in this function +# RETURNS: Nothing +# DESCRIPTION: +# THROWS: No exceptions +# COMMENTS: None +# SEE ALSO: N/A +#=============================================================================== +sub find_release_date { + my ( $dbh, $atts ) = @_; + + my ( $sth, $h, $ref_id, $ref_date, @cdate, @ref_date, @reldate, $show ); + + # + # Query to find the show nearest the start of the review month + # + $sth = $dbh->prepare( + q{ + SELECT e.id,e.date + FROM eps e + WHERE e.date BETWEEN date(?,'start of month','-2 days') + AND date(?,'start of month','+2 days') + ORDER BY e.id DESC + LIMIT 1; + } + ); + + # + # Execute using the string version of the start of the month + # + $sth->execute( ( $atts->{month_start} ) x 2 ); + if ( $dbh->err ) { + carp $dbh->errstr; + } + + # + # Maybe it wasn't found? + # + die "Unable to find a reference show\n" + unless ( $h = $sth->fetchrow_hashref() ); + + # + # Save the values found + # + $ref_id = $attributes{ref_id} = $h->{id}; + $ref_date = $attributes{ref_date} = $h->{date}; + + # + # Compute the next month by adding 1 month to the review month + # + @cdate = Add_Delta_YM( @{ $atts->{review_month} }, 0, 1 ); + + # + # Turn 'YYYY-MM-DD' to a Date::Calc date + # + @ref_date = parse_to_dc( $atts->{ref_date} ); + + # + # Compute the show's release date and the show number + # + @reldate = make_date( \@cdate, $atts->{release_dow}, 1, 0 ); + $show = $atts->{ref_id} + Delta_Business_Days( @ref_date, @reldate ); + + # + # Save the results in the shared hash + # + $atts->{release_date} = \@reldate; + $atts->{show} = $show; + + _debug( $DEBUG >= 3, "Date: " . ISO8601_Date(@reldate) . " Show: $show" ); + + return ($show,ISO8601_Date(@reldate)); +} + +#=== FUNCTION ================================================================ +# NAME: start_of_month +# PURPOSE: Generates a DateTime version of the start of a given month +# PARAMETERS: $dc_date Arrayref containing a Date::Calc date in the +# required month. +# RETURNS: Reference to a DateTime date object +# DESCRIPTION: +# THROWS: No exceptions +# COMMENTS: None +# SEE ALSO: N/A +#=============================================================================== +sub start_of_month { + my ($dc_date) = @_; + + my @sd = ( @$dc_date, 0, 0, 0 ); + @sd[2] = 1; + return dc_to_dt(\@sd); +} + #=== FUNCTION ================================================================ # NAME: parse_to_dc # PURPOSE: Parse a textual date (and optional time) to a Date::Calc @@ -1143,27 +1173,31 @@ exit; # $deftime Arrayref default time (as a Date::Calc array # or undef) # RETURNS: A Date::Calc date (and possibly time) as a list -# DESCRIPTION: The $datetime argument is parsed ewith Date::Parse. The year -# and month need to be adjusted. If a default time has been -# supplied then the parsed time is checked and the default time -# used if nothing was found, otherwise the parsed time is used -# and a full 6-component time returned. +# DESCRIPTION: The $datetime argument is parsed with Date::Parse. The year +# and month returned need to be adjusted. If a default time has +# been supplied then the parsed time is checked and the default +# time used if nothing was found, otherwise the parsed time is +# used and a full 6-component datetime returned. # If the default time us undefined this means we don't care # about the time and so we just return the parsed date as # a 3-component list. # THROWS: No exceptions -# COMMENTS: None +# COMMENTS: Date::Parse has added another element to the array it +# generates - the century # SEE ALSO: N/A #=============================================================================== sub parse_to_dc { my ( $datetime, $deftime ) = @_; + die "Undefined \$datetime argument in parse_to_dc\n" + unless defined($datetime); + # What strptime returns: - # 0 1 2 3 4 5 6 - # ($ss,$mm,$hh,$day,$month,$year,$zone) + # 0 1 2 3 4 5 6 7 + # ($ss,$mm,$hh,$day,$month,$year,$zone,$century) # my @parsed = strptime($datetime); - die "Invalid DATE or DATETIME '$datetime'\n" + die "Invalid DATE or DATETIME '$datetime' in parse_to_dc\n" unless ( defined( $parsed[3] ) && defined( $parsed[4] ) && defined( $parsed[5] ) ); @@ -1171,23 +1205,32 @@ sub parse_to_dc { $parsed[5] += 1900; $parsed[4] += 1; +# _debug( $DEBUG > 1, '@parsed = ' . Dumper( \@parsed ) ); + if ( defined($deftime) ) { # - # If no time was supplied add a default one + # If no time was supplied add a default one. The 'scalar(grep ...)' + # counts defined elements in the array slice. If there is a time, + # ensure there are no undefined fields with the 'map' converting them + # to zero. The DateTime package later on does not like there to be + # undefined fields. # - unless ( defined( $parsed[2] ) - && defined( $parsed[1] ) - && defined( $parsed[0] ) ) - { - @parsed[ 2, 1, 0 ] = @$deftime; + if (scalar(grep {$_} @parsed[0..2]) == 0) { + @parsed[ 2, 1, 0 ] = @$deftime; + } + else { + @parsed[0..2] = map {defined($_) ? $_ : 0} @parsed[0..2]; } # - # Return a list + # Return a list containing time and date # return ( @parsed[ 5, 4, 3, 2, 1, 0 ] ); } else { + # + # Return a date only + # return ( @parsed[ 5, 4, 3 ] ); } @@ -1199,7 +1242,7 @@ sub parse_to_dc { # PARAMETERS: $refdt Reference to an array holding a Date::Calc # date and time # RETURNS: Returns a DateTime object converted from the input -# DESCRIPTION: +# DESCRIPTION: # THROWS: No exceptions # COMMENTS: None # SEE ALSO: N/A @@ -1211,8 +1254,8 @@ sub dc_to_dt { # Check we got a 6-element array # if (scalar(@$refdt) != 6) { - print "Invalid Date::Calc date and time (@$refdt)\n"; - die "Aborted\n"; + print STDERR "Invalid Date::Calc date and time (@$refdt) in dc_to_dt\n"; + confess "Aborted\n"; } # @@ -1230,51 +1273,36 @@ sub dc_to_dt { } #=== FUNCTION ================================================================ -# NAME: find_last_recording -# PURPOSE: Finds the recording date of the Community News episode -# relating to the target month -# PARAMETERS: $refdate Reference to an array holding a Date::Calc -# date - the first of the selected month -# $reftime Reference to an array holding a Date::Calc -# time (UTC) -# RETURNS: A Date::Calc object containing the date and time of the last -# Community News recording in the UTC time zone -# DESCRIPTION: We want to find the date of the last Community News recording -# to determine whether a given comment preceded it. The scenario -# is that we're using these notes while making such a recording -# and want to know if comments occured before the last one. If -# they did we should have read them during that show and don't -# need to do so now. We want to pass the date generated here to -# the template so it can compare it with comment dates. To -# complete the story, the template will mark such comments, but -# we'll turn of the marking before the notes are released - they -# are just for use by the people recording the episode. +# NAME: load_cache +# PURPOSE: Load the date cache into a hash +# PARAMETERS: $cache_name Name of file holding the cache +# RETURNS: Contents of cache as a hash +# DESCRIPTION: # THROWS: No exceptions # COMMENTS: None # SEE ALSO: N/A #=============================================================================== -sub find_last_recording { - my ($refdate, $reftime) = @_; +sub load_cache { + my ($cache_name) = @_; - my $monday = 1; # Day of week number 1-7, Monday-Sunday + my ( $month, $datetime, %result ); - # - # Using the given date (the requested month), ensure it's the first day of - # the month - # - my @lastmonth = @$refdate; - $lastmonth[2] = 1; + open( my $dc, '<', $cache_name ) + or die "$0 : failed to open '$cache_name': $!\n"; - # - # Work out the recording date in the target month - # - @lastmonth = Nth_Weekday_of_Month_Year( @$refdate[ 0, 1 ], $monday, 1 ); - @lastmonth = Add_Delta_Days( @lastmonth, -2 ); + while ( my $line = <$dc> ) { + chomp($line); + if ( ( $month, $datetime ) + = ( $line =~ /^(\d{4}-\d{2}-\d{2}),(.*)$/ ) ) + { + $result{$month} = $datetime; + } + } - # - # Return the date as a DateTime object - # - return (@lastmonth,@$reftime); + close($dc) + or warn "$0 : failed to close '$cache_name': $!\n"; + + return %result; } #=== FUNCTION ================================================================ @@ -1296,7 +1324,7 @@ sub find_last_recording { sub find_last_month { my ($refdate) = @_; - my $monday = 1; # Day of week number 1-7, Monday-Sunday + my $monday = 1; # Day of week number 1-7, Monday-Sunday my @starttime = ( 00, 00, 00 ); # UTC # @@ -1316,19 +1344,44 @@ sub find_last_month { # # Return the date as a DateTime object # - return (@lastmonth,@starttime); + return ( @lastmonth, @starttime ); } #=== FUNCTION ================================================================ -# NAME: trailing_days -# PURPOSE: Determines if the last month had 'trailing' days - those after -# the recording date - during which unread comments could have -# been posted. +# NAME: get_date_offset +# PURPOSE: Computes the date offset between the release date and the +# recording date of a show +# PARAMETERS: $relday name of the release day (e.g. "Monday") +# $recday name of the recording day (e.g. "Friday") +# RETURNS: The date offset (a negative number since we always record +# before releasing, not the other way round!) +# DESCRIPTION: +# THROWS: No exceptions +# COMMENTS: None +# SEE ALSO: N/A +#=============================================================================== +sub get_date_offset { + my ( $relday, $recday ) = @_; + + _debug( $DEBUG > 2, 'In get_date_offset', + ' $relday = ' . $relday, ' $recday = ' . $recday + ); + + return ( + Decode_Day_of_Week( $relday, 1 ) - Decode_Day_of_Week( $recday, 1 ) ) + + 1; +} + +#=== FUNCTION ================================================================ +# NAME: trailing_time +# PURPOSE: Determines if the last month had 'trailing' time - those after +# the recording date and time - during which unread comments +# could have been posted. # PARAMETERS: $dc_lr reference to an array containing a Date::Calc # date of the last recording # $dc_lm reference to an array containing a Date::Calc # date of the first day of last month -# RETURNS: A true/false result - 1 if there were trailing days, +# RETURNS: A true/false result - 1 if there was trailing time, # 0 otherwise # DESCRIPTION: If the recording of a Community News show was during the month # being reviewed (e.g. March 2019; recording on 2019-03-30, @@ -1341,7 +1394,7 @@ sub find_last_month { # COMMENTS: None # SEE ALSO: N/A #=============================================================================== -sub trailing_days { +sub trailing_time { my ( $dc_lr, $dc_lm ) = @_; my $offset; @@ -1351,13 +1404,14 @@ sub trailing_days { # if ( $dc_lm->[1] eq $dc_lr->[1] ) { # - # Compute the offset as Delta_Days((First day of last month + days in - # month), recording date). A positive offset (not sure if we'd get + # Compute the offset as Delta_Days(recording date, (First day of last + # month + days in month)). A positive offset (not sure if we'd get # a negative one) means there's some of the month still to go. # - $offset - = Delta_Days( @$dc_lr[0..2], - Add_Delta_Days( @$dc_lm[0..2], Days_in_Month( @$dc_lm[ 0, 1 ] ) ) ); + $offset = Delta_Days( + @$dc_lr[0..2], + Add_Delta_Days( @$dc_lm[0..2], Days_in_Month( @$dc_lm[ 0, 1 ] ) ) + ); return 1 if $offset gt 0; } @@ -1366,11 +1420,11 @@ sub trailing_days { #=== FUNCTION ================================================================ # NAME: validate_date -# PURPOSE: Checks the date found in the database ($date) is before the -# reference date ($refdate) -# PARAMETERS: $date Textual date from the database -# $refdate Optional textual date to compare with. If -# omitted then we use 'Today' +# PURPOSE: Checks the date found in the database ($date) is on or after +# the reference date ($refdate) or Today() +# PARAMETERS: $date String date (e.g. 2025-03-03) +# $refdate Optional string date to compare with. If +# omitted then we use 'Today()' # RETURNS: True (1) if the $date is later than the $refdate, false (0) # otherwise # DESCRIPTION: We need to check that the script is not being used to change @@ -1392,7 +1446,7 @@ sub validate_date { my @refdate; unless (defined($date)) { - warn "check_date: invalid argument\n"; + warn "validate_date: invalid argument\n"; return 0; } @@ -1404,35 +1458,234 @@ sub validate_date { @refdate = Today(); } + _debug( $DEBUG > 2, + '@date = ' . join( ',', @date ), + '@refdate = ' . join( ',', @refdate ) + ); + return (Delta_Days(@refdate,@date) >= 0); } #=== FUNCTION ================================================================ -# NAME: my_decode_entities -# PURPOSE: Call 'HTML::Entities::decode_entities' as a filter in a template -# PARAMETERS: $text The text string to process -# RETURNS: The text string with all HTML entities decoded to Unicode -# DESCRIPTION: This is a local filter to be called in a template. The name -# it's called by is defined in the 'FILTERS' definition in the -# call to Template::new. Maybe this function is redundant and -# the real 'decode_entities' could have been called directly, -# but this is slightly easier to understand (I think). +# NAME: make_date +# PURPOSE: Make an event date based on settings +# 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 my_decode_entities { - my $text = shift; +sub ISO8601_Date { + my (@date) = (@_)[ 0, 1, 2 ]; - decode_entities($text); - return $text; + if ( check_date(@date) ) { + return sprintf( "%04d-%02d-%02d", @date ); + } + else { + return "*Invalid Date*"; + } +} + +#=== FUNCTION ================================================================ +# NAME: make_filename_and_open +# PURPOSE: To construct a filename if the option contains '%s' and open +# the file for output +# PARAMETERS: $filename Name of file with or without '%s' +# $subs String to substitute for '%s' +# RETURNS: File handle +# DESCRIPTION: +# THROWS: No exceptions +# COMMENTS: None +# SEE ALSO: N/A +#=============================================================================== +sub make_filename_and_open { + my ( $filename, $subs ) = @_; + + my $outfh; + + if ( $filename =~ /%s/ ) { + $filename = sprintf( $filename, $subs ); + } + + open( $outfh, ">:encoding(UTF-8)", $filename ) + or croak "Unable to open $filename for writing: $!"; + + return $outfh; +} + +#=== FUNCTION ================================================================ +# NAME: only_defined +# PURPOSE: To join a series of defined arguments into an array +# PARAMETERS: Arbitrary number of arguments +# RETURNS: Array made of defined arguments +# DESCRIPTION: +# THROWS: No exceptions +# COMMENTS: None +# SEE ALSO: N/A +#=============================================================================== +sub only_defined { + my @result; + + foreach (@_) { + push(@result,$_) if defined($_); + } + + return (@result); +} + +#=== FUNCTION ================================================================ +# NAME: coalesce +# PURPOSE: To find the first defined argument and return it +# PARAMETERS: Arbitrary number of arguments +# RETURNS: The first defined argument or undef if there are none +# DESCRIPTION: +# THROWS: No exceptions +# COMMENTS: None +# SEE ALSO: N/A +#=============================================================================== +sub coalesce { + foreach (@_) { + return $_ if defined($_); + } + return; # undef +} + +#=== FUNCTION ================================================================ +# NAME: multi_sprintf +# PURPOSE: Run 'sprintf', repeating the format multiple times with the +# given arguments, returning the result as a string +# PARAMETERS: $fmt format string +# * list of arguments +# RETURNS: A string from concatenating the arguments repeatedly using the +# supplied format +# DESCRIPTION: +# THROWS: No exceptions +# COMMENTS: None +# SEE ALSO: N/A +#=============================================================================== +sub multi_sprintf { + my ($fmt, @args) = @_; + + my $result; + foreach (@args) { + $result .= sprintf($fmt,$_); + } + return $result; } #=== FUNCTION ================================================================ # NAME: emit # PURPOSE: Print text on STDERR unless silent mode has been selected -# PARAMETERS: - Boolean indicating whether to be silent or not +# PARAMETERS: - Boolean indicating whether to be silent or not (if not +# silent, print, or unless silent, print) # - list of arguments to 'print' # RETURNS: Nothing # DESCRIPTION: This is a wrapper around 'print' to determine whether to send @@ -1487,24 +1740,34 @@ sub Options { my ($optref) = @_; my @options = ( - "help", "documentation|man", - "debug=i", "from=s", - "out=s", "template=s", - "comments!", "markcomments|mc!", - "ctext!", "lastrecording|lr=s", - "silent!", "episode=s", - "overwrite!", "mailnotes:s", - "anyotherbusiness|aob=s", "config=s", - "interlock=s" + "help", "documentation|man", + "debug=i", "from=s", + "full-html=s", "html=s", + "json=s", "config=s", + "comments!", "lastrecording|lr=s", + "silent!", "mailnotes!", ); +# "template=s", +# "markcomments|mc!", "ctext!", +# "anyotherbusiness|aob=s", + + # + # Parse the options, and exit with a list of permitted options if there is + # a problem. + # if ( !GetOptions( $optref, @options ) ) { - pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 ); + pod2usage( + -msg => "$PROG version $VERSION\n", + -verbose => 0, + -exitval => 1 + ); } return; } + __END__ #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1514,20 +1777,20 @@ __END__ =head1 NAME -make_shownotes - Make HTML show notes for the Hacker Public Radio Community News show +make_shownotes - Make show notes for the Hacker Public Radio Community News show =head1 VERSION -This documentation refers to B version 0.2.2 +This documentation refers to B version 0.4.3 =head1 USAGE - make_shownotes [-help] [-documentation] [-from=DATE] [-[no]comments] - [-[no]markcomments] [-[no]ctext] [-lastrecording=DATETIME] - [-[no]silent] [-out=FILE] [-episode=[N|auto]] [-[no]overwrite] - [-mailnotes[=FILE]] [-anyotherbusiness=FILE] [-template=FILE] - [-config=FILE] [-interlock=PASSWORD] + make_shownotes [-help] [-documentation|-man] [-config=FILE] + [-from=DATE] [-[no]comments] [-[no]silent] [-[no]mailnotes] + [-lastrecording=DATETIME] + [-full-html=FILE] [-html=FILE] [-json=FILE] + [-debug=N] =head1 OPTIONS @@ -1537,23 +1800,37 @@ This documentation refers to B version 0.2.2 Displays a brief help message describing the usage of the program, and then exits. -=item B<-documentation> +=item B<-documentation> or B<-man> -Displays the entirety of the documentation (using a pager), and then exits. To -generate a PDF version use: +Displays the entirety of the documentation (using a pager), and then exits. + +To generate a PDF version use: pod2pdf make_shownotes --out=make_shownotes.pdf +=item B<-config=FILE> + +The script uses a configuration file to hold the various parameters it needs +to run. This option allows an alternative configuration file to be used. This file +defines many settings including the location of the database. + +See the CONFIGURATION AND ENVIRONMENT section below for the file format. + +If the option is omitted the default file is used: B<.make_shownotes.cfg>, +which is expected to be in the same directory as the script itself. + =item B<-from=DATE> This option is used to indicate the month for which the shownotes are to be generated. The script is able to parse a variety of date formats, but it is -recommended that ISO8601 YYYY-MM-DD format be used (for example 2014-06-30). +recommended that ISO8601 B format be used (for example 2014-06-30). The day part of the date must be present but is ignored and only the month and -year parts are used. +year parts are used (to internally denote the first day of the month). -If this option is omitted the current month is used. +If this option is omitted the current month is used. Of course, this may cause +problems if the notes are to generated for an earlier (or later) month, which +is why this option exists. =item B<-[no]comments> @@ -1561,219 +1838,224 @@ This option controls whether the comments pertaining to the selected month are included in the output. If the option is omitted then no comments are included (B<-nocomments>). -=item B<-[no]markcomments> or B<-[no]mc> +=item I: B<-html=FILE>, B<-full-html=FILE>, B<-json=FILE> -This option controls whether certain comments are marked in the HTML. The -default is B<-nomarkcomments>. The option can be abbreviated to B<-mc> and -B<-nomc>. +There are three output file types that can be generated by the script. At +least one must be present: -The scenario is that we want to use the notes the script generates while -making a Community News recording and we also want them to be the show notes -in the database once the show has been released. +=over 4 -Certain comments relating to shows earlier than this month were already -discussed last month, because they were made before that show was recorded. We -don't want to read them again during this show, so a means of marking them is -needed. +=item I (B<-html=FILE>) -The script determines the date of the last recording (or it can be specified -with the B<-lastrecording=DATETIME> option, or its abbreviation -B<-lr=DATETIME>) and passes it to the template. The template can then compare -this date with the dates of the relevant comments and take action to highlight -those we don't want to re-read. It is up to the template to do what is -necessary to highlight them. +This file will contain the HTML to be added to the HPR database. The page for +the show, when it is released, will be a full web page, with standard header +and footer, and the contents will come from this HTML fragment in the database. -The idea is that we will turn off the marking before the notes are released -- they are just for use by the people recording the episode. +Action will be needed in addition to the script to add this file to the +database, but how this is done is outside the scope of this documentation. -Another action is taken during the processing of comments when this option is -on. On some months of the year the recording is made during the month itself -because the first Monday of the next month is in the first few days of that -month. For example, in March 2019 the date of recording is the 30th, and the -show is released on April 1st. Between the recording and the release of the -show there is time during which more comments could be submitted. +=item I (B<-full-html=FILE>) -Such comments should be in the notes for March (and these can be regenerated -to make sure this is so) but they will not have been read on the March -recording. The B script detects this problem and, if -B<-markcomments> is set (and comments enabled) will show a list of any -eligible comments in a red highlighted box. This is so that the volunteers -recording the show can ensure they read comments that have slipped through -this loophole. The display shows the entire comment including the contents, -but disappears when the notes are refreshed with B<-nomarkcomments> (the -default). +The file created in this case will contain a full, stand-alone HTML page. It +is intended to be circulated to the co-hosts recording the episode to make it +easier to access various information sources during the recording. -In this mode the preamble warning about comments to be ignored used to be -included, but now it is skipped if there are no such comments. This means one -switch can serve two purposes. +In the file the comments relating to past shows will show the full text, and +there will be indications of comments that were read in the last recording, +and any that were missed. + +In order to highlight comments read, and those missed in the previous +recording the script needs to know the date and time of the recording. This +information should be in a date cache file referenced in the configuration +file (usually B). This file is updated when the monthly +mail message is generated (see B). If, for any reason, this has +not happened, the information can be provided with the +B<-lastrecording=DATETIME> option (alternatively written as B<-lr=DATETIME>). +See below for more information. + +=item I (B<-json=FILE>) + +This file will contain JSON data which is intended to be used to upload the +episode to the database. How this is done is outside the scope of this +document. The format used is very close to that used in the workflow which is +used to upload episodes submitted through the upload forms. + +=back + +In all cases the output file name may contain the characters 'B<%s>'. This +denotes the point at which the year and month in the format B are +inserted. For example if the script is being run for July 2014 the option: + + -html=shownotes_%s.html + +This will cause the generation of the file: + + shownotes_2014-07.html =item B<-lastrecording=DATETIME> or B<-lr=DATETIME> -As mentioned for B<-markcomments>, the date of the last recording can be -computed in the assumption that it's on the Saturday before the first Monday -of the month at 15:00. However, on rare occasions it may be necessary to -record on an earlier date and time, which cannot be computed. This value can -be defined with this option. +As mentioned for B<-full-html=FILE>, the script needs the date of the last +recording when marking comments. This can be extracted from the file +referenced in the configuration data using the setting B. By default +the name of this file is B, and its contents are managed +when the script B is run. + +If for any reason the date and time of the last recording is missing, these +values can be defined with this option. The format can be an ISO 8601 date followed by a 24-hour time, such as -'2020-01-25 15:00'. If the time is omitted it defaults to 15:00. - -=item B<-[no]ctext> - -This option controls whether the comment text itself is listed with comments. -This is controlled by the template, but the current default template only -shows the text in the B section of the output. The default -state is B<-noctext> in which the comment texts are not written. +'2020-01-25 15:00'. If the time is omitted it defaults to the value of +I in the configuration file. =item B<-[no]silent> This option controls whether the script reports details of its progress to STDERR. If the option is omitted the report is generated (B<-nosilent>). -The script reports: the month it is working on, the name of the output file -(if appropriate) and details of the process of writing notes to the database -(if the B<-episode=[N|auto]> option is selected). +The script reports: the month it is working on, the name of the requested output files +and details of the process of generating these files. -=item B<-mailnotes[=FILE]> +=item B<-[no]mailnotes> -If desired, the show notes may include a section about recent discussions on -the HPR mailing list. Obviously, this text will change every month, so this -option provides a way in which an external file can be included in the show -notes. +If desired, the show notes may include a section linking to recent discussions +on the HPR Mailman mailing list. -The filename may be omitted which is a way in which a B directive can -be placed in the template and used rather than the file. The B must be -named B because this is the name the script uses in this -circumstance. See B for an example of its use. +The current template (defined in the configuration file by the variable +B, B) simply contains a section +like the following: -The template must contain instructions to include the file or block. The file -name is stored in a variable 'B' in the template. Directives of -the following form may be added to achive this: - - [%- IF includefile.defined %] - Constant header, preamble, etc - [%- INCLUDE $includefile %] - Other constant text or tags + [%- IF mailnotes == 1 -%] +

Mailing List discussions

+

+ Policy decisions surrounding HPR are taken by the community as a whole. + This discussion takes place on the Mailing List which is open to all HPR listeners and + contributors. The discussions are open and available on the HPR server + under Mailman. +

+

The threaded discussions this month can be found here:

+ [% mailthreads %] [%- END %] -The first directive causes the whole block to be ignored if there is no -B<-mailnotes> option. The use of the B directive means that the -included file may contain Template directives itself if desired. +The I variables such as B and B are defined earlier in +the template. -See existing templates for examples of how this is done. +=item B<-debug=N> -=item B<-anyotherbusiness=FILE> or B<-aob=FILE> +Enables debugging mode when N > 0 (zero is the default, no debugging output). +The levels are: -If desired the shownotes may contain an 'Any other business' section. This is -implemented in a template thus: +Values are: - [% IF aob == 1 -%] -

Any other business

- [% INCLUDE $aobfile -%] - [%- END %] +=over 4 -The template variable B is set to 1 if a (valid) file has been provided, -and the name of the file is in B. +=item 1 -The included file is assumed to be HTML. +TBA -=item B<-out=FILE> +=item 2 -This option defines an output file to receive the show notes. If the option is -omitted the notes are written to STDOUT, allowing them to be redirected if -required. +Reports the following (as well as the data for level 1): -The output file name may contain the characters 'B<%s>'. This denotes the point -at which the year and month in the format B are inserted. For example -if the script is being run for July 2014 the option: +=over 4 - -out=shownotes_%s.html +=item . -will cause the generation of the file: +Details of the last recording data (and time) - shownotes_2014-07.html +=back -=item B<-episode=[N|auto]> +=item 3 -This option provides a means of specifying an episode number in the database to -receive the show notes. +Reports the following (as well as the data for level 2): -It either takes a number, or it takes the string 'B' which makes the -script find the correct show number. +=over 4 -First the episode number has to have been reserved in the database. This is -done by running the script 'B'. This makes a reservation with -the title "HPR Community News for ". Normally Community News -slots are reserved several months in advance. +=item . -Close to the date of the Community News show recording this script can be run -to write show notes to the database. For example: +The generation of comment indexes needed in the comment lists. These are +computed after the query has been run. - ./make_shownotes -from=1-Dec-2014 -out=/dev/null \ - -comm -tem=shownote_template5.tpl -ep=auto +=back -This will search for the episode with the title "HPR Community News for -December 2014" and will add notes if the field is empty. Note that it is -necessary to direct the output to /dev/null since the script needs to write -a copy of the notes to STDOUT or to a file. In this case we request comments -to be added to the notes, and we use the template file -B which generates an HTML snippet suitable for the -database. +=item 4 -The writing of the notes to the database will fail if the field is not empty. -See the B<-overwrite> option for how to force the notes to be written. +See the B section for an explanation of the data structures +mentioned here. -If the B<-episode=[N|auto]> option is omitted no attempt is made to write to -the database. +Reports the following (as well as the data for level 3): -=item B<-[no]overwrite> +=over 4 -This option is only relevant in conjunction with the B<-episode=[N|auto]> -option. If B<-overwrite> is chosen the new show notes will overwrite any notes -already in the database. If B<-nooverwrite> is selected, or the option is -omitted, no over writing will take place - it will only be possible to write -notes to the database if the field is empty. +=item . -=item B<-template=FILE> +A dump of the '%past' hash which contains details of comments on past shows. -This option defines the template used to generate the notes. The template is -written using the B