a83e945c08
.make_email.cfg: New configuration file to simplify the original options
to 'make_email'
.make_shownotes.cfg: New configuration file to simplify the original
extremely obscure options to 'make_shownotes'
collect_HPR_database: Script to simplify the collection and setup
of MySQL dumps from the HPR server and conversion to a SQLite
database.
make_email: Many changes to make the script simpler to use. It looks for
all files in the same directory as the script. Reduced the number of
options and added a new configuration file. Now reads and writes
a date cache file (defined in the configuration file) where it
writes the date and time of the next recording. Now uses a local
SQLite database rather than linking to the live HPR database (more
secure). Takes an output file name (with optional '%s'). Functions
for loading and updating the date cache (also used by
'make_shownotes'). Doesn't attempt to generate a real mail message,
just something that can be cut and pasted into a mail client.
make_email_template.tpl: TT2 template for generating the mail message.
This whole function was moved from the script itself to this
templating system, making it all a lot simpler.
make_meeting: Minor updates. This script is probably obsolete.
make_shownotes: Almost totally rewritten. It looks for all files in the
same directory as the script. Reduced the number of options and
added a new configuration file. Now reads a date cache
file (defined in the configuration file) where 'make_email' has
written the date and time of the next recording. Now generates
output files rather than writing to the live HPR database. These
files can be added to the database on the 'hub' using existing
workflow(s). One of the files generated is a stand-alone full HTML file
for circulation to volunteers recording the show. The others are the
HTML snippet to add to the database, and a JSON version for use in
the hub workflow. The full HTML gets the expanded comments and
contains markers of comments already read or missed last month. This
version computes the episode number and date which will be used to
post the resulting show (previously reserved slots were searched for
in the database). The extremely complex query that collects comments
has been thoroughly tested and enhanced and seems to be reliable.
Dropped the "Any Other Business" section (and all code relating to
it in the script and the template).
shownote_template.tpl: Soft link to the latest template. Doing this
needs consideration given that the configuration file could just
reference the appropriate file. This technique may just be
a nuisance.
shownote_template11.tpl: Previous template, updated for the last release
of 'make_shownotes'. Now replaced.
shownote_template12.tpl: New template without AOB capability.
2522 lines
83 KiB
Perl
Executable File
2522 lines
83 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
#===============================================================================
|
|
#
|
|
# FILE: make_shownotes
|
|
#
|
|
# USAGE: ./make_shownotes [-help] [-documentation] [-debug=N]
|
|
# [-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 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: ---
|
|
# BUGS: ---
|
|
# NOTES: To view the entire documentation use:
|
|
#
|
|
# ./make_shownotes -documentation
|
|
#
|
|
# To create a PDF version of the documentation:
|
|
#
|
|
# pod2pdf make_shownotes --out=make_shownotes.pdf
|
|
#
|
|
# Where pod2pdf comes from App::pod2pdf
|
|
#
|
|
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
|
|
# 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 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;
|
|
BEGIN { $ENV{PERLDOC} = '-MPod::Text::Color'; }
|
|
use Pod::Usage qw(pod2usage); # Use colour-capable Pod::Text
|
|
|
|
use Config::General;
|
|
|
|
use Date::Parse;
|
|
use Date::Calc qw{:all};
|
|
use DateTime;
|
|
use DateTime::Duration;
|
|
|
|
use Template;
|
|
use Template::Filters;
|
|
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.4.3';
|
|
|
|
#
|
|
# Various constants
|
|
#
|
|
( my $PROG = $0 ) =~ s|.*/||mx;
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Declarations
|
|
#-------------------------------------------------------------------------------
|
|
#
|
|
# Constants and other declarations
|
|
#
|
|
# We make variable to hold the working directory where the script is located
|
|
#
|
|
( my $basedir = abs_path($0) ) =~ s|/?[^/]*$||mx;
|
|
|
|
my $configfile = "$basedir/.${PROG}.cfg";
|
|
|
|
#
|
|
# Default templates and cache in case there's nothing in the configuration file
|
|
#
|
|
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 ( @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
|
|
);
|
|
|
|
#
|
|
# Ensure this script runs in the directory it exists in (to simplify
|
|
# specifying and accessing files)
|
|
#
|
|
chdir($basedir);
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Options and arguments
|
|
#-------------------------------------------------------------------------------
|
|
#
|
|
# Option defaults
|
|
#
|
|
my $DEFDEBUG = 0;
|
|
|
|
#
|
|
# Process options
|
|
#
|
|
my %options;
|
|
Options( \%options );
|
|
|
|
#
|
|
# Default help is just the USAGE section
|
|
#
|
|
pod2usage( -msg => "$PROG version $VERSION\n", -verbose => 0, -exitval => 1 )
|
|
if ( $options{'help'} );
|
|
|
|
#
|
|
# Full documentation if requested with -documentation or -man
|
|
#
|
|
pod2usage(
|
|
-msg => "$PROG version $VERSION\n",
|
|
-verbose => 2,
|
|
-exitval => 1,
|
|
) if ( $options{'documentation'} );
|
|
|
|
#
|
|
# Collect options
|
|
#
|
|
my $DEBUG = ( defined( $options{debug} ) ? $options{debug} : $DEFDEBUG );
|
|
my $silent = ( defined( $options{silent} ) ? $options{silent} : 0 );
|
|
my $show_comments
|
|
= ( defined( $options{comments} ) ? $options{comments} : 1 );
|
|
my $lastrecording = $options{lastrecording};
|
|
my $mailnotes = ( defined( $options{mailnotes} ) ? $options{mailnotes} : 1 );
|
|
my $cfgfile
|
|
= ( defined( $options{config} ) ? $options{config} : $configfile );
|
|
|
|
#
|
|
# 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 );
|
|
|
|
#
|
|
# 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($lastrecording)) {
|
|
die "Use -lastrecording=DATETIME only with -full-html=FILE\n"
|
|
unless defined($full_html_outfile);
|
|
}
|
|
|
|
#
|
|
# One at least of the output files must be present
|
|
#
|
|
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";
|
|
}
|
|
|
|
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
|
|
#
|
|
@review_month = parse_to_dc($options{from}, undef);
|
|
}
|
|
else {
|
|
#
|
|
# Default to the current date
|
|
#
|
|
@review_month = Today();
|
|
}
|
|
$review_month[2] = 1;
|
|
@dc_lm = @review_month; # TODO: Is this right?
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Configuration file - load data
|
|
#-------------------------------------------------------------------------------
|
|
emit( $silent, "Configuration file: ", $cfgfile, "\n" );
|
|
my $conf = Config::General->new(
|
|
-ConfigFile => $cfgfile,
|
|
-InterPolateVars => 1,
|
|
-ExtendedAccess => 1,
|
|
-UseApacheInclude => 1,
|
|
);
|
|
my %config = $conf->getall();
|
|
|
|
#
|
|
# Short-circuit the "paths" to the configuration objects
|
|
#
|
|
my $settings_ptr = $config{settings};
|
|
my $db_ptr = $config{database};
|
|
|
|
#
|
|
# 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 $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;
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Find the episode corresponding to the review month
|
|
#-------------------------------------------------------------------------------
|
|
#
|
|
# 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]);
|
|
|
|
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 {
|
|
emit( $silent,
|
|
"Error: episode $episode already exists in the database\n");
|
|
|
|
if ($h1->{title} eq $title) {
|
|
say "(Episode $episode is an old-style place-holder. Continuing)";
|
|
}
|
|
else {
|
|
die "Trying to overwrite an existing show. Aborting\n";
|
|
}
|
|
|
|
unless (validate_date($h1->{date})) {
|
|
die "Error: show $episode has a date in the past\n";
|
|
}
|
|
}
|
|
|
|
_debug( $DEBUG > 1, '%attributes: ' . Dumper( \%attributes ) );
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Report important details
|
|
#-------------------------------------------------------------------------------
|
|
#
|
|
# 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);
|
|
|
|
emit($silent,"\n");
|
|
|
|
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
|
|
#-------------------------------------------------------------------------------
|
|
$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 >= DATE(?) AND md.mindate < DATE(?,'+1 month')
|
|
ORDER BY mindate}
|
|
);
|
|
$sth1->execute( $dt_som->ymd, $dt_som->ymd );
|
|
if ( $dbh->err ) {
|
|
carp $dbh->errstr;
|
|
}
|
|
|
|
#
|
|
# Grab the data as an arrayref of hashrefs
|
|
#
|
|
$hosts = $sth1->fetchall_arrayref( {} );
|
|
_debug( $DEBUG > 1, '$hosts = ' . Dumper($hosts) );
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# 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 template is happy with it.
|
|
#
|
|
$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;
|
|
}
|
|
|
|
#
|
|
# Grab the data as an arrayref of hashrefs
|
|
#
|
|
$shows = $sth1->fetchall_arrayref( {} );
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Collect the comments if requested
|
|
#-------------------------------------------------------------------------------
|
|
if ($show_comments) {
|
|
|
|
#
|
|
# 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',
|
|
format('%04d',eps_id),'/index.html') AS identifier_url,
|
|
eps.title,
|
|
eps.summary,
|
|
eps.date,
|
|
ho.host,
|
|
ho.hostid,
|
|
-- 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,
|
|
unixepoch(co.comment_timestamp) AS comment_timestamp_ut,
|
|
(CASE WHEN
|
|
(
|
|
-- [$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,
|
|
-- [$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
|
|
WHERE eps.id IN
|
|
(
|
|
SELECT DISTINCT
|
|
eps.id
|
|
FROM eps
|
|
JOIN comments co ON (eps.id = co.eps_id)
|
|
WHERE
|
|
-- [$dt_som->ymd] [$dt_som->ymd]
|
|
(eps.date >= DATE(?) AND eps.date < DATE(?,'+1 month'))
|
|
OR (
|
|
-- [$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_som->ymd ) x 14
|
|
);
|
|
if ( $dbh->err ) {
|
|
carp $dbh->errstr;
|
|
}
|
|
|
|
#
|
|
# Grab the data as an arrayref of hashrefs
|
|
#
|
|
$comments = $sth1->fetchall_arrayref( {} );
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Post-process the results of the query
|
|
#-------------------------------------------------------------------------------
|
|
# The comment structure needs some further work because it contains all
|
|
# comments for a given show but no indexes we can use (because the query
|
|
# didn't generate any - this is a lot easier in PostgreSQL (and possibly
|
|
# SQLite)). We also need to know how many comments we have within the
|
|
# target period, which is usually a smaller number than the number of
|
|
# comments we got back. The query has marked the ones we want to count
|
|
# (and display) using 'in_range'.
|
|
#
|
|
$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) {
|
|
#
|
|
# Count the valid ones so the template doesn't have to compute a total
|
|
# for this month
|
|
#
|
|
$comment_count++ if $row->{in_range};
|
|
|
|
#
|
|
# Make the comment text cleaner by removing carriage returns (not sure
|
|
# why they are there in the first place)
|
|
#
|
|
$row->{comment_text} =~ s/\r+//g;
|
|
}
|
|
|
|
#
|
|
# 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;
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# 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'.
|
|
#
|
|
# 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};
|
|
|
|
#
|
|
# 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;
|
|
}
|
|
}
|
|
else {
|
|
$row->{ignore} = 0;
|
|
}
|
|
|
|
#
|
|
# 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 {
|
|
#
|
|
# Add to %current
|
|
#
|
|
if ( exists( $current{$ep} ) ) {
|
|
push( @{ $current{$ep} }, $row );
|
|
}
|
|
else {
|
|
$current{$ep} = [$row];
|
|
}
|
|
}
|
|
}
|
|
|
|
_debug ($DEBUG > 2,
|
|
'%past: ' . Dumper(\%past),
|
|
'=-' 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 comments *if* $t_time is true
|
|
#-------------------------------------------------------------------------------
|
|
# 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 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_time) {
|
|
$sth1 = $dbh->prepare( q{
|
|
SELECT
|
|
eps.id AS episode,
|
|
concat('https://hackerpublicradio.org/eps/hpr',
|
|
format('%04d',eps_id),'/index.html') AS identifier_url,
|
|
eps.title,
|
|
eps.summary,
|
|
eps.date,
|
|
ho.host,
|
|
ho.hostid,
|
|
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,
|
|
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
|
|
-- [$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 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 );
|
|
if ( $dbh->err ) {
|
|
carp $dbh->errstr;
|
|
}
|
|
|
|
#
|
|
# Grab the data as an arrayref of hashrefs
|
|
#
|
|
$missed_comments = $sth1->fetchall_arrayref( {} );
|
|
$missed_count = (
|
|
defined($missed_comments)
|
|
? scalar(@$missed_comments)
|
|
: 0
|
|
);
|
|
|
|
#
|
|
# Make the comment text cleaner by removing carriage returns (not sure
|
|
# why they are there in the first place)
|
|
#
|
|
for my $ch (@$missed_comments) {
|
|
$ch->{comment_text} =~ s/\r+//g;
|
|
{
|
|
$/ = '';
|
|
chomp($ch->{comment_text}); # NOTE: experimental
|
|
}
|
|
}
|
|
|
|
_debug ($DEBUG > 2,
|
|
'@missed_comments: ' . Dumper($missed_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_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;
|
|
|
|
_debug( $DEBUG > 2,
|
|
'@missed_episodes: ' . Dumper( \@missed_episodes ) );
|
|
|
|
delete( @past{@missed_episodes} );
|
|
|
|
my $old_pc = $past_count;
|
|
$past_count = scalar( keys(%past) );
|
|
$comment_count -= ($old_pc - $past_count);
|
|
|
|
_debug(
|
|
$DEBUG > 2,
|
|
'%past (edited): ' . Dumper( \%past ),
|
|
'=-' x 20,
|
|
"\$past_count: $past_count",
|
|
"\$comment_count: $comment_count"
|
|
);
|
|
}
|
|
}
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Prepare the TT² object
|
|
#-------------------------------------------------------------------------------
|
|
my $tt = Template->new(
|
|
{ ABSOLUTE => 1,
|
|
ENCODING => 'utf8',
|
|
INCLUDE_PATH => $basedir,
|
|
FILTERS => {
|
|
# For HTML->ASCII in comments_only.tpl, decode HTML entities
|
|
'decode_entities' => \&my_decode_entities,
|
|
},
|
|
}
|
|
);
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Generate the HTML fragment and add it to the JSON if that output is requested
|
|
#-------------------------------------------------------------------------------
|
|
if ($html_outfile || $json_outfile) {
|
|
my $outfh;
|
|
|
|
#
|
|
# 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
|
|
# datetime
|
|
# PARAMETERS: $datetime Datetime as a string
|
|
# $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 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: 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 7
|
|
# ($ss,$mm,$hh,$day,$month,$year,$zone,$century)
|
|
#
|
|
my @parsed = strptime($datetime);
|
|
die "Invalid DATE or DATETIME '$datetime' in parse_to_dc\n"
|
|
unless ( defined( $parsed[3] )
|
|
&& defined( $parsed[4] )
|
|
&& defined( $parsed[5] ) );
|
|
|
|
$parsed[5] += 1900;
|
|
$parsed[4] += 1;
|
|
|
|
# _debug( $DEBUG > 1, '@parsed = ' . Dumper( \@parsed ) );
|
|
|
|
if ( defined($deftime) ) {
|
|
#
|
|
# 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.
|
|
#
|
|
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 containing time and date
|
|
#
|
|
return ( @parsed[ 5, 4, 3, 2, 1, 0 ] );
|
|
}
|
|
else {
|
|
#
|
|
# Return a date only
|
|
#
|
|
return ( @parsed[ 5, 4, 3 ] );
|
|
}
|
|
|
|
}
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: dc_to_dt
|
|
# PURPOSE: Converts a Date::Calc datetime into a DateTime equivalent
|
|
# PARAMETERS: $refdt Reference to an array holding a Date::Calc
|
|
# date and time
|
|
# RETURNS: Returns a DateTime object converted from the input
|
|
# DESCRIPTION:
|
|
# THROWS: No exceptions
|
|
# COMMENTS: None
|
|
# SEE ALSO: N/A
|
|
#===============================================================================
|
|
sub dc_to_dt {
|
|
my ($refdt) = @_;
|
|
|
|
#
|
|
# Check we got a 6-element array
|
|
#
|
|
if (scalar(@$refdt) != 6) {
|
|
print STDERR "Invalid Date::Calc date and time (@$refdt) in dc_to_dt\n";
|
|
confess "Aborted\n";
|
|
}
|
|
|
|
#
|
|
# Convert to DateTime to get access to formatting stuff
|
|
#
|
|
my ( %dtargs, $dt );
|
|
@dtargs{ 'year', 'month', 'day', 'hour', 'minute', 'second', 'time_zone' }
|
|
= ( @$refdt, 'UTC' );
|
|
$dt = DateTime->new(%dtargs);
|
|
|
|
#
|
|
# Return the date as a DateTime object
|
|
#
|
|
return $dt;
|
|
}
|
|
|
|
#=== 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:
|
|
# THROWS: No exceptions
|
|
# COMMENTS: None
|
|
# SEE ALSO: N/A
|
|
#===============================================================================
|
|
sub load_cache {
|
|
my ($cache_name) = @_;
|
|
|
|
my ( $month, $datetime, %result );
|
|
|
|
open( my $dc, '<', $cache_name )
|
|
or die "$0 : failed to open '$cache_name': $!\n";
|
|
|
|
while ( my $line = <$dc> ) {
|
|
chomp($line);
|
|
if ( ( $month, $datetime )
|
|
= ( $line =~ /^(\d{4}-\d{2}-\d{2}),(.*)$/ ) )
|
|
{
|
|
$result{$month} = $datetime;
|
|
}
|
|
}
|
|
|
|
close($dc)
|
|
or warn "$0 : failed to close '$cache_name': $!\n";
|
|
|
|
return %result;
|
|
}
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: find_last_month
|
|
# PURPOSE: Finds the previous month for working out marks
|
|
# PARAMETERS: $refdate Reference to an array holding a Date::Calc
|
|
# date - the first of the selected month
|
|
# RETURNS: A DateTime object containing the first day of the last month.
|
|
# DESCRIPTION: We need the details of the last month because if we're marking
|
|
# comments we have already read out in the previous Community
|
|
# News show, but don't want to mark comments to shows before
|
|
# that month, even if the comments fell within the target month.
|
|
# This is a complex edge condition that wasn't appreciated in the
|
|
# first implementation.
|
|
# THROWS: No exceptions
|
|
# COMMENTS: None
|
|
# SEE ALSO: N/A
|
|
#===============================================================================
|
|
sub find_last_month {
|
|
my ($refdate) = @_;
|
|
|
|
my $monday = 1; # Day of week number 1-7, Monday-Sunday
|
|
my @starttime = ( 00, 00, 00 ); # UTC
|
|
|
|
#
|
|
# Using the given date (the requested month for the notes), ensure it's
|
|
# the first day of the month
|
|
#
|
|
my @lastmonth = @$refdate;
|
|
$lastmonth[2] = 1;
|
|
|
|
#
|
|
# Subtract one day to enter the previous month and force the first day of
|
|
# the resulting month
|
|
#
|
|
@lastmonth = Add_Delta_Days( @lastmonth, -1 );
|
|
$lastmonth[2] = 1;
|
|
|
|
#
|
|
# Return the date as a DateTime object
|
|
#
|
|
return ( @lastmonth, @starttime );
|
|
}
|
|
|
|
#=== FUNCTION ================================================================
|
|
# 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 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,
|
|
# release on 2019-04-01) then a comment could have been made
|
|
# after (or during!) the recording and probably would not have
|
|
# been read during the show. We want to spot such a case and
|
|
# highlight it in the *next* recording!
|
|
# Yes, I know this is obsessive, but it needs a solution!!!
|
|
# THROWS: No exceptions
|
|
# COMMENTS: None
|
|
# SEE ALSO: N/A
|
|
#===============================================================================
|
|
sub trailing_time {
|
|
my ( $dc_lr, $dc_lm ) = @_;
|
|
|
|
my $offset;
|
|
|
|
#
|
|
# Are the last month and the recording month the same?
|
|
#
|
|
if ( $dc_lm->[1] eq $dc_lr->[1] ) {
|
|
#
|
|
# 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 ] ) )
|
|
);
|
|
return 1 if $offset gt 0;
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: validate_date
|
|
# 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
|
|
# the notes for a Community News show in the past. This is
|
|
# because sometimes the generated notes are edited after they
|
|
# have been created to add other elements, and we do not want to
|
|
# accidentally destroy such changes. We just compute the
|
|
# difference between today and the date of the target episode.
|
|
# If the difference in days is greater than 0 then it's OK.
|
|
# We also want to be able to use this routine to check whether
|
|
# comments relate to old shows or this month's.
|
|
# THROWS: No exceptions
|
|
# COMMENTS: None
|
|
# SEE ALSO: N/A
|
|
#===============================================================================
|
|
sub validate_date {
|
|
my ($date, $refdate) = @_;
|
|
|
|
my @refdate;
|
|
|
|
unless (defined($date)) {
|
|
warn "validate_date: invalid argument\n";
|
|
return 0;
|
|
}
|
|
|
|
my @date = ($date =~ /^(\d{4})-(\d{2})-(\d{2})$/);
|
|
if (defined($refdate)) {
|
|
@refdate = ($refdate =~ /^(\d{4})-(\d{2})-(\d{2})$/);
|
|
}
|
|
else {
|
|
@refdate = Today();
|
|
}
|
|
|
|
_debug( $DEBUG > 2,
|
|
'@date = ' . join( ',', @date ),
|
|
'@refdate = ' . join( ',', @refdate )
|
|
);
|
|
|
|
return (Delta_Days(@refdate,@date) >= 0);
|
|
|
|
}
|
|
|
|
#=== FUNCTION ================================================================
|
|
# 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 ISO8601_Date {
|
|
my (@date) = (@_)[ 0, 1, 2 ];
|
|
|
|
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 (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
|
|
# a message to STDERR depending on a boolean. We need this to be
|
|
# able to make the script silent when the -silent option is
|
|
# selected
|
|
# THROWS: No exceptions
|
|
# COMMENTS: None
|
|
# SEE ALSO: N/A
|
|
#===============================================================================
|
|
sub emit {
|
|
unless (shift) {
|
|
print STDERR @_;
|
|
}
|
|
}
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: _debug
|
|
# PURPOSE: Prints debug reports
|
|
# PARAMETERS: $active Boolean: 1 for print, 0 for no print
|
|
# @messages List of messages to print
|
|
# RETURNS: Nothing
|
|
# DESCRIPTION: Outputs messages to STDERR if $active is true. For each
|
|
# message it removes any trailing newline and then adds one in
|
|
# the 'print' so the caller doesn't have to bother. Prepends
|
|
# each message with 'D> ' to show it's a debug message.
|
|
# THROWS: No exceptions
|
|
# COMMENTS: None
|
|
# SEE ALSO: N/A
|
|
#===============================================================================
|
|
sub _debug {
|
|
my ( $active, @messages ) = @_;
|
|
|
|
return unless $active;
|
|
foreach my $msg (@messages) {
|
|
chomp($msg);
|
|
print STDERR "D> $msg\n";
|
|
}
|
|
}
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: Options
|
|
# PURPOSE: Processes command-line options
|
|
# PARAMETERS: $optref Hash reference to hold the options
|
|
# RETURNS: Undef
|
|
# DESCRIPTION:
|
|
# THROWS: no exceptions
|
|
# COMMENTS: none
|
|
# SEE ALSO: n/a
|
|
#===============================================================================
|
|
sub Options {
|
|
my ($optref) = @_;
|
|
|
|
my @options = (
|
|
"help", "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",
|
|
-verbose => 0,
|
|
-exitval => 1
|
|
);
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
|
|
__END__
|
|
|
|
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
# Application Documentation
|
|
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
#{{{
|
|
|
|
=head1 NAME
|
|
|
|
make_shownotes - Make show notes for the Hacker Public Radio Community News show
|
|
|
|
=head1 VERSION
|
|
|
|
This documentation refers to B<make_shownotes> version 0.4.3
|
|
|
|
|
|
=head1 USAGE
|
|
|
|
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
|
|
|
|
=over 8
|
|
|
|
=item B<-help>
|
|
|
|
Displays a brief help message describing the usage of the program, and then exits.
|
|
|
|
=item B<-documentation> or B<-man>
|
|
|
|
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 B<YYYY-MM-DD> 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 (to internally denote the first day of the month).
|
|
|
|
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>
|
|
|
|
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 I<Output file options>: B<-html=FILE>, B<-full-html=FILE>, B<-json=FILE>
|
|
|
|
There are three output file types that can be generated by the script. At
|
|
least one must be present:
|
|
|
|
=over 4
|
|
|
|
=item I<HTML fragment> (B<-html=FILE>)
|
|
|
|
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.
|
|
|
|
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.
|
|
|
|
=item I<Standalone HTML> (B<-full-html=FILE>)
|
|
|
|
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 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<recording_dates.dat>). This file is updated when the monthly
|
|
mail message is generated (see B<make_email>). 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<JSON details> (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<YYYY-MM> 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<-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<cache>. By default
|
|
the name of this file is B<recording_dates.dat>, and its contents are managed
|
|
when the script B<make_email> 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 the value of
|
|
I<starttime> 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 requested output files
|
|
and details of the process of generating these files.
|
|
|
|
=item B<-[no]mailnotes>
|
|
|
|
If desired, the show notes may include a section linking to recent discussions
|
|
on the HPR Mailman mailing list.
|
|
|
|
The current template (defined in the configuration file by the variable
|
|
B<main_template>, B<shownote_template12.tpl>) simply contains a section
|
|
like the following:
|
|
|
|
[%- IF mailnotes == 1 -%]
|
|
<h2>Mailing List discussions</h2>
|
|
<p>
|
|
Policy decisions surrounding HPR are taken by the community as a whole.
|
|
This discussion takes place on the <a href="[% mailinglist %]"
|
|
target="_blank">Mailing List</a> which is open to all HPR listeners and
|
|
contributors. The discussions are open and available on the HPR server
|
|
under <a href="[% mailbase %]">Mailman</a>.
|
|
</p>
|
|
<p>The threaded discussions this month can be found here:</p>
|
|
<a href="[% mailthreads %]" target="_blank">[% mailthreads %]</a>
|
|
[%- END %]
|
|
|
|
The I<TT2> variables such as B<mailinglist> and B<mailthreads> are defined earlier in
|
|
the template.
|
|
|
|
=item B<-debug=N>
|
|
|
|
Enables debugging mode when N > 0 (zero is the default, no debugging output).
|
|
The levels are:
|
|
|
|
Values are:
|
|
|
|
=over 4
|
|
|
|
=item 1
|
|
|
|
TBA
|
|
|
|
=item 2
|
|
|
|
Reports the following (as well as the data for level 1):
|
|
|
|
=over 4
|
|
|
|
=item .
|
|
|
|
Details of the last recording data (and time)
|
|
|
|
=back
|
|
|
|
=item 3
|
|
|
|
Reports the following (as well as the data for level 2):
|
|
|
|
=over 4
|
|
|
|
=item .
|
|
|
|
The generation of comment indexes needed in the comment lists. These are
|
|
computed after the query has been run.
|
|
|
|
=back
|
|
|
|
=item 4
|
|
|
|
See the B<DESCRIPTION> section for an explanation of the data structures
|
|
mentioned here.
|
|
|
|
Reports the following (as well as the data for level 3):
|
|
|
|
=over 4
|
|
|
|
=item .
|
|
|
|
A dump of the '%past' hash which contains details of comments on past shows.
|
|
|
|
=item .
|
|
|
|
A dump of the '%current' hash which contains details of comments on this
|
|
month's shows.
|
|
|
|
=item .
|
|
|
|
A dump of the '@missed_comments' array containing comments that arrived after
|
|
the last recording.
|
|
|
|
=item .
|
|
|
|
A list of the duplicated episode numbers in '@missed_episodes'
|
|
|
|
=item .
|
|
|
|
Another dump of '%past' after it has been cleaned up. Also the count of
|
|
comments to past shows and the comment count.
|
|
|
|
=back
|
|
|
|
=back
|
|
|
|
=back
|
|
|
|
=head1 MARKING COMMENTS
|
|
|
|
Explaining the marking of comments in the full HTML file:
|
|
|
|
=over 4
|
|
|
|
This is only relevant when generating the full stand-alone HTML ("handout")
|
|
for circulation to the volunteers recording the Community News episode. In
|
|
this output the comments sent in to past shows (those before the review month)
|
|
include their full texts in order to make reading them easier.
|
|
|
|
Normally comments (to shows in the reviewed month) are read as the shows
|
|
themselves are reviewed, so the full texts are not needed in this handout.
|
|
|
|
In addition to this, there is a possibility that certain comments relating to
|
|
past shows 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.
|
|
|
|
As well as this, some comments may have been missed in the last month because
|
|
the recording was made before the end of the review month. 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 the next 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.
|
|
|
|
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<make_shownotes> script detects this problem and, if
|
|
generating full notes 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 script extracts the date of the last recording from the I<cache> file (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 that don't want to be re-read or were missed last month. It
|
|
is up to the template to do what is necessary to highlight them.
|
|
|
|
=back
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
=head2 Overview
|
|
|
|
This script generates notes for the next Hacker Public Radio I<Community News>
|
|
show. It does this by collecting various details of activity from the HPR
|
|
database and passing them to a template. The default template is called
|
|
B<shownote_template.tpl> (defined in the configuration file) and this
|
|
generates HTML, but any suitable textual format could be generated if
|
|
required, by using a different template.
|
|
|
|
=head2 Data Gathering
|
|
|
|
Four types of information are collected by the script:
|
|
|
|
=over 4
|
|
|
|
=item -
|
|
|
|
Details of new hosts who have released new shows in the selected month
|
|
|
|
=item -
|
|
|
|
Details of shows which have been released in the selected month
|
|
|
|
=item -
|
|
|
|
Comments which have been submitted to the HPR website in the selected month.
|
|
These need to be related to shows in the current period or in the past.
|
|
Comments made about shows which have not yet been released (but are visible on
|
|
the website) are not included even though they are made in the current month.
|
|
|
|
=item -
|
|
|
|
A link to the current threads on the mailing list in the past month can be included. This
|
|
is done by default but can be skipped if the B<-nomailnotes> option is used.
|
|
|
|
=back
|
|
|
|
=head2 Report Generation
|
|
|
|
The four components listed above are formatted in the following way by the
|
|
default template.
|
|
|
|
=over 4
|
|
|
|
=item B<New Hosts>
|
|
|
|
These are formatted as a list of links to the B<hostid> with the host's name.
|
|
|
|
=item B<Shows>
|
|
|
|
These are formatted into an HTML table containing the show number, title and
|
|
host name. The show title is a link to the show page on the HPR website. The
|
|
host name is a link to the host page on the website.
|
|
|
|
=item B<Comments>
|
|
|
|
These are formatted with <article> tags separated by horizontal lines.
|
|
A <header> shows the author name and title and a <footer> displays a link to
|
|
the show and the show's host and the show title is also included. Where
|
|
relevant, the body of the article contains the comment text with line breaks.
|
|
|
|
=item B<Mailing list discussions>
|
|
|
|
A link to the mail threads on the mailing list is included if the
|
|
B<-mailnotes> option is chosen or defaulted.
|
|
|
|
See the explanation of the B<-mailnotes> option for more details.
|
|
|
|
=back
|
|
|
|
=head2 Variable, Field and Hash names
|
|
|
|
If you wish to write your own template refer to the following lists for the
|
|
names of items. Also refer to the default template B<shownote_template.tpl>
|
|
for the techniques used there. (Note that B<shownote_template.tpl> is a soft
|
|
link to the current default template, such as B<shownote_template12.tpl>, the
|
|
link name is currently used in the configuration file).
|
|
|
|
The hash and field names available to the template are as follows
|
|
|
|
=over 4
|
|
|
|
=item B<Global variables>
|
|
|
|
Variable Name Details
|
|
------------- -------
|
|
review_month The month name of the report date
|
|
review_year The year of the report date
|
|
comment_count The number of comments in total
|
|
past_count The number of comments on old shows
|
|
ignore_count The number of past comments to ignore
|
|
missed_count The number of comments missed last time
|
|
skip_comments Set when -comments is omitted
|
|
mark_comments Set when comments are being marked
|
|
ctext Set when the comment texts in the 'Past shows'
|
|
section are to be shown
|
|
last_recording The date the last recording was made
|
|
in Unixtime format
|
|
last_month The month prior to the month for which the notes are
|
|
being generated (computed if comments are being
|
|
marked) in 'YYYY-MM' format
|
|
mailnotes Set when a mail link is required
|
|
|
|
=item B<New Hosts>
|
|
|
|
The name of the hash in the template is B<hosts>. The hash might be empty if
|
|
there are no new hosts in the month. See the default template for how to
|
|
handle this.
|
|
|
|
Field Name Details
|
|
---------- -------
|
|
host Name of host
|
|
hostid Host id number
|
|
|
|
=item B<Show Details>
|
|
|
|
The name of the hash in the template is B<shows>. Note that there are more
|
|
fields available than are used in the default template. Note also that certain
|
|
field names are aliases to avoid clashes (e.g. I<eps_hostid> and I<ho_hostid>).
|
|
|
|
Field Name Details
|
|
---------- -------
|
|
eps_id Episode number
|
|
date Episode date
|
|
title Episode title
|
|
length Episode duration
|
|
summary Episode summary
|
|
notes Episode show notes
|
|
eps_hostid The numerical host id from the 'eps' table
|
|
series The series number from the 'eps' table
|
|
explicit The explicit marker for the show
|
|
eps_license The license for the show
|
|
tags The show's tags as a comma-delimited string
|
|
version ?Obsolete?
|
|
eps_valid The valid value from the 'eps' table
|
|
ho_hostid The host id number from the 'hosts' table
|
|
ho_host The host name
|
|
email The hosts's email address (protected)
|
|
profile The host's profile
|
|
ho_license The default license for the host
|
|
ho_valid The valid value from the 'hosts' table
|
|
|
|
=item B<Comment Details>
|
|
|
|
Two hashes are created for comments. The hash named B<past> contains comments
|
|
made in the review month to shows before this month, and B<current> contains
|
|
comments to this month's shows. Note that these hashes are only populated if
|
|
the B<-comments> option is provided or defaulted. Both hashes have the same
|
|
structure.
|
|
|
|
Field Name Details
|
|
---------- -------
|
|
episode Episode number
|
|
identifier_url Full show URL
|
|
title Episode title
|
|
date Episode date
|
|
host Host name
|
|
hostid Host id number
|
|
timestamp Comment timestamp in ISO8601 format
|
|
comment_author_name Name of the commenter
|
|
comment_title Title of comment
|
|
comment_text Text of the comment
|
|
comment_timestamp_ut Comment timestamp in Unixtime format
|
|
in_range Boolean (0/1) denoting whether the comment was made
|
|
in the target month
|
|
index The numerical index of the comment for a given show
|
|
ignore Boolean (0/1), set if the comment is to be ignored
|
|
|
|
The purpose of the B<in_range> value is to denote whether a comment was made
|
|
in the target month. This is used in the script to split the comments into the
|
|
B<past> and B<current> hashes. It is therefore of little use in the template,
|
|
but is retained in case it might be useful. The B<index> value can be used in
|
|
the template to refer to the comment, make linking URLs etc. It is generated
|
|
by the SQL.
|
|
|
|
=item B<Mailing List Link>
|
|
|
|
The variable B<mailnotes> contains 0 or 1 depending on whether the link and
|
|
accompanying text are required.
|
|
|
|
=back
|
|
|
|
=head2 Filters
|
|
|
|
A filter called B<decode_entities> is available to the template. The reason
|
|
for creating this was when the HTML of a comment is being listed as text
|
|
(Unicode actually). Since comment text is stored in the database as HTML with
|
|
entities when appropriate this is needed to prevent the plain text showing
|
|
I<&> and the like verbatim. It is not currently used, but has been left in
|
|
case it might be of use in future.
|
|
|
|
=head1 DIAGNOSTICS
|
|
|
|
=over 4
|
|
|
|
=item B<Unable to find configuration file ...>
|
|
|
|
The nominated configuration file in B<-config=FILE> (or the default file)
|
|
cannot be found.
|
|
|
|
=item B<Error: Unable to find AOB file ...>
|
|
|
|
The AOB file referred to in the error message is missing. Th
|
|
|
|
=item B<Use -lastrecording=DATETIME only with -full-html=FILE>
|
|
|
|
The B<-lastrecording=DATETIME> option is only relevant when the full
|
|
stand-alone HTML is being generated. This is a fatal error.
|
|
|
|
=item B<At least one of -html=FILE, -full-html=FILE and -json=FILE must be present>
|
|
|
|
The script writes up to three output files, as explained above. At least one
|
|
must be present otherwise there is no point in running it!
|
|
|
|
=item B<Error: Unable to find ... file ...>
|
|
|
|
The type of mandatory file with the name referred to in the error message is missing.
|
|
|
|
=item B<The date and time of the last recording is not in the cache>
|
|
|
|
Followed by:
|
|
|
|
Use option -lastrecording=DATETIME (or -lr=DATETIME) instead
|
|
Can't continue
|
|
|
|
This means that the date and time expected in the date cache cannot be found,
|
|
so the script needs to be run again with the information presented in the
|
|
option mentioned.
|
|
|
|
=item B<Unable to find database>
|
|
|
|
The SQLite database referenced in the configuration file has not been found.
|
|
|
|
=item B<Trying to overwrite an existing show. Aborting>
|
|
|
|
After a check on the database, the computed episode number matches a slot that
|
|
has already been allocated. A check has been made for an old-style placeholder
|
|
for Community News episodes, but no match was found, so the script has aborted
|
|
in case an existing episode will be overwritten.
|
|
|
|
=item B<Error: show ... has a date in the past>
|
|
|
|
The date computed for the Community News episode is in the past. Perhaps the
|
|
wrong date or month was specified in an option?
|
|
|
|
=item B<Problem with constructing JSON>
|
|
|
|
A request for JSON output has been made. The script is attempting to collect
|
|
information about the host who is preparing the show (I<HPR Volunteers>) but
|
|
the database query has failed.
|
|
|
|
It is possible the configuration file entry I<hostid> contains the wrong host
|
|
id number.
|
|
|
|
=item B<Unable to find a reference show>
|
|
|
|
The script is attempting to find the release date (and episode number) for the
|
|
Community News show in the database. It does this by finding a reference
|
|
episode and stepping forward, incrementing the episode number and date. The
|
|
reference date is the earliest in the target month, but for some unexpected
|
|
reason this has not been found.
|
|
|
|
=item B<Invalid DATE or DATETIME '...' in parse_to_dc>
|
|
|
|
It is likely that the date provided through the B<-from=DATE> option is
|
|
invalid. Use an ISO8601 date in the format I<YYYY-MM-DD>.
|
|
|
|
=item B<... failed to open '...': ...>
|
|
|
|
There was a problem opening the date cache file. Check the details in the
|
|
configuration file. This file is expected to be located in the same directory
|
|
as the script.
|
|
|
|
=item B<... failed to close '...': ...>
|
|
|
|
There was a problem closing the date cache file.
|
|
|
|
=item B<Invalid Date::Calc date and time (...) in dc_to_dt>
|
|
|
|
There was a problem processing a date (and time). A likely cause is an invalid
|
|
date in one of options which requires and date or date and time. The script
|
|
will report more than usual on this error to try and aid with debugging.
|
|
|
|
=back
|
|
|
|
=head1 CONFIGURATION AND ENVIRONMENT
|
|
|
|
The script obtains the details and settings it required from a configuration
|
|
file. The name of the file it expects is B<.make_shownotes.cfg>, but this can
|
|
be changed with the B<-config=FILE> option.
|
|
|
|
The configuration file is expected to be in the directory holding the
|
|
script. The script determines its location dynamically for this purpose.
|
|
|
|
The configuration file contains the following settings, which are explained
|
|
at the end.
|
|
|
|
#
|
|
# .make_shownotes.cfg (2025-03-27)
|
|
# Configuration file for make_shownotes version >= 4
|
|
#
|
|
<settings>
|
|
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
|
|
|
|
</settings>
|
|
|
|
<database>
|
|
# Assume a local file
|
|
name = hpr.db
|
|
</database>
|
|
|
|
=head2 Details
|
|
|
|
If any mandatory elements are omitted from the configuration file they are
|
|
given default values in the script.
|
|
|
|
=over 4
|
|
|
|
=item B<Section "settings">
|
|
|
|
=over 4
|
|
|
|
=item B<title_template>, B<summary_template>
|
|
|
|
These are (I<sprintf>) templates for these database fields, which are added to the full HTML
|
|
and the JSON. They are filled in (using I<sprintf>) in the script.
|
|
|
|
=item B<tags>
|
|
|
|
Up to now, Community News episodes have used the tag B<"Community News">, so
|
|
this is now used in the configuration file.
|
|
|
|
=item B<hostid>, B<series_id>
|
|
|
|
As documented in the file, these are the internal numbers from the database
|
|
for the host and series associated with the show.
|
|
|
|
=item B<releaseday>, B<recordingday>, B<starttime>, B<endtime>
|
|
|
|
These values define default dates and times for the recording of the show and
|
|
the date of release.
|
|
|
|
=item B<cache>
|
|
|
|
This is the name of the file holding recording dates and times for Community
|
|
News shows. The file is updated when B<make_email> is run since this script
|
|
defines the recording date and time. The script expects this file to be in the
|
|
directory holding the script itself, though an absolute path could be used if
|
|
needed.
|
|
|
|
=item B<main_template>, B<container_template>
|
|
|
|
These are I<TT2> templates to be used by the script. The first is the template
|
|
used to generate the two types of HTML, and the second is used to generate
|
|
stand-alone HTML when the B<-full-html=FILE> option is used. The script uses
|
|
both templates when generating the full HTML.
|
|
|
|
The B<container_template> contains a snapshot of an HPR HTML page with the body
|
|
removed and the header and footer retained. The generated notes are added by
|
|
the script, giving the HTML which can be handed out to the volunteers hosting
|
|
the recording.
|
|
|
|
=back
|
|
|
|
=item B<Section "database">
|
|
|
|
=over 4
|
|
|
|
=item B<name>
|
|
|
|
This contains the name of the SQLite database. This is a file which is
|
|
expected to be in the same directory as the script.
|
|
|
|
=back
|
|
|
|
=back
|
|
|
|
=head1 DEPENDENCIES
|
|
|
|
Modules used:
|
|
|
|
Carp
|
|
Config::General
|
|
Cwd
|
|
DBI
|
|
Data::Dumper
|
|
Date::Calc
|
|
Date::Parse
|
|
DateTime::Duration
|
|
DateTime
|
|
Getopt::Long
|
|
HTML::Entities
|
|
JSON
|
|
Pod::Usage
|
|
Template::Filters
|
|
Template
|
|
|
|
=head1 BUGS AND LIMITATIONS
|
|
|
|
There are no known bugs in this module.
|
|
Please report problems to Dave Morriss (Dave.Morriss@gmail.com)
|
|
Patches are welcome.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Dave Morriss (Dave.Morriss@gmail.com)
|
|
|
|
|
|
=head1 LICENCE AND COPYRIGHT
|
|
|
|
Copyright (c) 2014-2025 Dave Morriss (Dave.Morriss@gmail.com). All rights reserved.
|
|
|
|
This module is free software; you can redistribute it and/or
|
|
modify it under the same terms as Perl itself. See perldoc perlartistic.
|
|
|
|
This program is distributed in the hope that it will be useful
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
=cut
|
|
|
|
#}}}
|
|
|
|
# [zo to open fold, zc to close or za to toggle]
|
|
|
|
# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker:spell
|