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.4
|
|
# ORIGINAL: 2014-04-24 16:08:30
|
|
# CREATED: 2025-03-13 15:07:35
|
|
# REVISION: 2025-04-01 21:29:10
|
|
#
|
|
#===============================================================================
|
|
|
|
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.4';
|
|
|
|
#
|
|
# 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\n";
|
|
}
|
|
|
|
#
|
|
# 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.4
|
|
|
|
|
|
=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
|