Moved project directories and files to an empty local repo

.gitignore

@@ -0,0 +1,3 @@
+# Ignore vim backup and swap files
+*~
+*.swp

Comment_system/.process_comments.cfg

@@ -0,0 +1,25 @@
+#
+# Main configuration file for 'process_comments' using the local database
+#
+# /home/cendjm/HPR/Comment_system/.process_comments.cfg
+# 2023-02-27 16:42:50
+#
+
+#
+# Settings used in all configuration files
+#
+<<include .process_comments_settings.cfg>>
+
+#
+# Local database
+#
+<<include .hpr_db.cfg>>
+
+#
+# Fake CMS authentication
+#
+<cms>
+    user = "dummy:dummy"
+</cms>
+
+#  vim: syntax=cfg:ts=8:sw=4:tw=150:et:ai:

Comment_system/.process_comments_live.cfg

@@ -0,0 +1,25 @@
+#
+# Main configuration file for 'process_comments' using the live database
+#
+# /home/cendjm/HPR/Comment_system/.process_comments_live.cfg
+# 2023-02-27 16:48:08
+#
+
+#
+# Settings used in all configuration files
+#
+<<include .process_comments_settings.cfg>>
+
+#
+# Local database
+#
+<<include .hpr_livedb.cfg>>
+
+#
+# CMS authentication
+#
+<cms>
+   <<include .hpradmin_curlrc>>
+</cms>
+
+#  vim: syntax=cfg:ts=8:sw=4:tw=150:et:ai:

Comment_system/.process_comments_settings.cfg

@@ -0,0 +1,42 @@
+#
+# Settings for 'process_comments'
+#
+# /home/cendjm/HPR/Comment_system/.process_comments_settings.cfg
+# 2023-02-28 20:37:58
+#
+<settings>
+    PROG       = process_comments
+
+    #
+    # Defaults
+    #
+    basedir    = "$HOME/HPR/Comment_system"
+    configfile = "$basedir/.hpr_db.cfg"
+    logfile    = "$basedir/logs/${PROG}.log"
+    template   = "$basedir/${PROG}.tpl"
+
+    #
+    # Mail message stash area
+    #
+    maildrop   = "$HOME/HPR/CommentDrop"
+    processed  = "$maildrop/processed"
+    rejected   = "$maildrop/rejected"
+    banned     = "$maildrop/banned"
+
+    #
+    # JSON stash area
+    #
+    jsondir    = "$basedir/json"
+    jprocessed = "$jsondir/processed"
+    jrejected  = "$jsondir/rejected"
+    jbanned    = "$jsondir/banned"
+
+    #
+    # How to tell the server the comment's processed
+    #
+    callback_template = \
+            "https://hub.hackerpublicradio.org/cms/comment_process.php?key=%s&action=%s"
+
+</settings>
+
+#  vim: syntax=cfg:ts=8:sw=4:tw=150:et:ai:

Comment_system/manage_comment_spool

@@ -0,0 +1,166 @@
+#!/bin/bash -
+#===============================================================================
+#
+#         FILE: manage_comment_spool
+#
+#        USAGE: ./manage_comment_spool [subject] [message-id]
+#
+#  DESCRIPTION: Deals with comments in the spool area where they are dropped
+#               by Thunderbird. This script is also designed to be run out of
+#               Thunderbird when it turns on or off the LED on the Blinkt!
+#               (using MQTT) and de-duplicates comments if necessary.
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.3
+#      CREATED: 2023-07-14 15:38:33
+#     REVISION: 2023-12-24 16:00:05
+#
+#===============================================================================
+
+set -o nounset                              # Treat unset variables as an error
+
+SCRIPT=${0##*/}
+
+VERSION="0.0.3"
+
+STDOUT="/dev/fd/2"
+
+#===  FUNCTION  ================================================================
+#         NAME: alert
+#  DESCRIPTION: Turn a LED on the Blinkt! host to an RGB colour
+#   PARAMETERS: 1 - LED number 0..7
+#               2 - RGB colour as 'R,G,B' values, default '0,0,0'
+#      RETURNS: 1 on error, otherwise 0
+#===============================================================================
+function alert () {
+    local LED="${1}"
+    local RGB="${2:-0,0,0}"
+
+    local BHOST="192.168.0.63"
+
+    mosquitto_pub -h $BHOST -t pimoroni/blinkt -m "rgb,$LED,$RGB"
+
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: _usage
+#  DESCRIPTION: Report usage
+#   PARAMETERS: None
+#      RETURNS: Nothing
+#===============================================================================
+_usage () {
+    cat >$STDOUT <<-endusage
+Usage: ./${SCRIPT} [-h] [-s] [subject] [message-id]
+
+Version: $VERSION
+
+Script to be invoked via Thunderbird to manage and report on the comment spool
+area
+
+Options:
+  -h                    Print this help
+  -s                    Silent mode, output less text about actions
+
+Arguments:
+    subject
+    message-id
+These are optional and are only provided when called by Thunderbir
+
+Examples
+  ./${SCRIPT} -h
+
+endusage
+    exit
+}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+#
+# Option defaults
+#
+SILENT=0  # not silent by default
+
+#
+# Process options
+#
+while getopts :hs opt
+do
+    case "${opt}" in
+        h) _usage;;
+        s) SILENT=1;;
+        ?) echo "$SCRIPT: Invalid option; aborting"; exit 1;;
+    esac
+done
+shift $((OPTIND - 1))
+
+#
+# Constants
+#
+BASENAME="$HOME/HPR/Comment_system"
+LOGDIR="$BASENAME/logs"
+LOG="$LOGDIR/$SCRIPT.log"
+SPOOLDIR="$HOME/HPR/CommentDrop"
+
+# The LED to light
+LED=1
+
+# Whether we're doing alerts
+ALERTING=1
+
+#
+# We expect to be called with two arguments if called from Thunderbird,
+# otherwise we'll make empty defaults.
+#
+if [[ $# -eq 2 ]]; then
+    subject="$1"
+    message_id="$2"
+else
+    subject=
+    message_id=
+fi
+
+#
+# Check the spool directory
+#
+declare -a EMAIL
+mapfile -t EMAIL < <(find "$SPOOLDIR" -maxdepth 1 -name "*.eml" -printf '%p\n')
+
+#
+# Clear out files which end in '-1.eml' (or any single digit number), and tidy
+# the array as well.
+#
+i=0
+for m in "${EMAIL[@]}"; do
+    if [[ "$m" =~ -[1-9].eml$ ]]; then
+        unset "EMAIL[$i]"
+        rm -f "$m"
+    fi
+    ((i++))
+done
+
+#
+# If we have comments left we turn on the LED, otherwise we turn it off
+#
+comments="${#EMAIL[@]}"
+if [[ $comments -eq 0 ]]; then
+    [ "$SILENT" == 0 ] && echo "Nothing found"
+    [ "$ALERTING" == 1 ] && alert $LED
+    exit
+else
+    [ "$SILENT" == 0 ] && echo "Found $comments $(ngettext comment comments "$comments")"
+    [ "$ALERTING" == 1 ] && alert $LED '0,255,128'
+fi
+
+#
+# Log the call, but only if there were comments.  This includes the two
+# arguments passed by the filter, the subject and message-id.
+#
+echo "$SCRIPT $(date +'%F %H:%M:%S') '$$' '$subject' '$message_id'" >> "$LOG"
+
+exit
+
+# vim: syntax=sh:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21

Comment_system/process_comments.tpl

@@ -0,0 +1,21 @@
+[%# process_comments.tpl 2017-09-12 -%]
+[%- USE wrap -%]
+
+Comment to moderate ([% file %]):
+################################################################################
+Show:   [% db.id %] by [% db.host %] released on [% db.date %]
+        entitled "[% db.title %]"
+
+Author:        [% comment.comment_author_name %]
+Date:          [% comment.comment_timestamp %]
+Title:         [% comment.comment_title %]
+[% IF comment.justification.defined && comment.justification != 'Current Comment' -%]
+Justification: [% comment.justification %]
+[% END -%]
+
+Text:
+[% comment.comment_text FILTER wrap(80) %]
+################################################################################
+[%#
+  # vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]

Community_News/.summarise_mail.cfg

@@ -0,0 +1,13 @@
+<gmane>
+    url = http://download.gmane.org/gmane.network.syndication.podcast.hacker-public-radio
+    template1 = "$url/%d/%d"
+    lookahead = 100
+    thread = http://comments.gmane.org/gmane.network.syndication.podcast.hacker-public-radio
+    template2 = "$thread/%d"
+</gmane>
+
+<cache>
+    directory = /home/cendjm/HPR/Community_News/mail_cache
+    filename = gmane.mbox
+    regex = "<http://permalink\.gmane\.org/gmane\.network\.syndication\.podcast\.hacker-public-radio/(\d+)>"
+</cache>

Community_News/aob_template.mkd_

@@ -0,0 +1,9 @@
+### Example section
+
+- Bulleted list item 1
+
+- Bulleted list item 2
+
+[%#
+vim: syntax=markdown:ts=8:sw=4:ai:et:tw=78:fo=tcqn:fdm=marker:com-=b\:-
+-%]

Community_News/build_AOB

@@ -0,0 +1,252 @@
+#!/bin/bash -
+#===============================================================================
+#
+#         FILE: build_AOB
+#
+#        USAGE: ./build_AOB [date]
+#
+#  DESCRIPTION: Build the AOB files for a particular month
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.12
+#      CREATED: 2021-04-15 17:36:22
+#     REVISION: 2024-03-15 09:50:02
+#
+#===============================================================================
+
+set -o nounset                              # Treat unset variables as an error
+
+SCRIPT=${0##*/}
+BASEDIR=${0%/*}
+
+VERSION="0.0.12"
+
+STDOUT="/dev/fd/2"
+
+#
+# Make sure we're in the working directory
+#
+cd "$BASEDIR" || exit 1
+
+#
+# Load library functions
+#
+LIB="$HOME/bin/function_lib.sh"
+[ -e "$LIB" ] || { echo "$SCRIPT: Unable to source functions"; exit 1; }
+# shellcheck disable=SC1090
+source "$LIB"
+
+# {{{ -- Functions usage and _DEBUG
+#===  FUNCTION  ================================================================
+#         NAME: _usage
+#  DESCRIPTION: Report usage
+#   PARAMETERS: None
+#      RETURNS: Nothing
+#===============================================================================
+_usage () {
+    cat >$STDOUT <<-endusage
+Usage: ./${SCRIPT} [-h] [-D] [date]
+
+Version: $VERSION
+
+Converts the AOB in Markdown format for a particular month to HTML and to text
+
+Options:
+  -h                    Print this help
+  -D                    Select debug mode (works the same; more output)
+
+Arguments (optional):
+    date                Specifies the month to build the AOB for. The default
+                        is the current month. The format can be YYYY-MM (e.g.
+                        2022-05) or any date format that the 'date' command
+                        can parse, so 2022-04-01 or 01-Apr-2022 and so on. If
+                        the date cannot be parsed an error will be reported.
+
+Examples
+  ./${SCRIPT} -h
+  ./${SCRIPT} -D 01-February-2021
+  ./${SCRIPT} 2021-02
+
+endusage
+    exit
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: _DEBUG
+#  DESCRIPTION: Writes a message if in DEBUG mode
+#   PARAMETERS: List of messages
+#      RETURNS: Nothing
+#===============================================================================
+_DEBUG () {
+    [ "$DEBUG" == 0 ] && return
+    for msg in "$@"; do
+        printf 'D> %s\n' "$msg"
+    done
+}
+
+# }}}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+#
+# Base and database directories
+#
+PARENT="$HOME/HPR"
+BASEDIR="$PARENT/Community_News"
+cd "$BASEDIR" || {
+    echo "Failed to cd to $BASEDIR";
+    exit 1;
+}
+# IADIR="$PARENT/InternetArchive"
+
+#
+# Option defaults
+#
+DEBUG=0
+
+#
+# Process options
+#
+while getopts :hdD opt
+do
+    case "${opt}" in
+        h) _usage;;
+        D) DEBUG=1;;
+        ?) echo "$SCRIPT: Invalid option; aborting"; exit 1;;
+    esac
+done
+shift $((OPTIND - 1))
+
+#
+# Handle the optional argument
+#
+if [[ $# -eq 1 ]]; then
+    startdate="$1"
+    # Normalise a YYYY-MM date so 'date' will not complain
+    if [[ $startdate =~ ^[0-9]{4}-[0-9]{2}$ ]]; then
+        startdate+='-01'
+    fi
+    # Validate the date and standardise it if it's OK
+    tmp="$(date -d "$startdate" +%Y-%m)" || {
+        echo "Use a date such as $(date +%Y-%m)"
+        exit 1
+    }
+    startdate="$tmp"
+else
+    startdate="$(date +%Y-%m)"
+fi
+
+_DEBUG "Date used: $startdate"
+
+#
+# We added a new field in 2022, 'item_last_updated' which is taken from the IA
+# (which we discovered was being maintained). It is a Unix date field, but the
+# view 'episodes_view' converts it.
+#
+# TODO: Since query3 was added it has made query1 and query2 obsolete. We
+# generate a per-month table with query3 which is turned into HTML using awk
+# and used in the AOB report. The code below that uses these queries and their
+# results could now be removed (or commented out).
+#
+#query1="select count(*) from episodes where id between 871 and 2429 and with_derived = 1"
+
+##query1="select count(*) from episodes_view where id between 871 and 2429 and \
+##item_last_updated between '${startdate}-01' and \
+##date('${startdate}-01','+1 month') and with_derived = 1"
+##
+##query2='select count(*) from episodes where id between 871 and 2429 and with_derived = 0'
+##
+##query3=$(cat <<ENDOFQ3
+##SELECT
+##    strftime('%Y-%m',item_last_updated) AS month,
+##    count(*) AS count
+##FROM episodes_view
+##WHERE id BETWEEN 871 AND 2429
+##AND item_last_updated IS NOT NULL
+##AND item_last_updated < date('${startdate}-01','+1 month')
+##GROUP BY strftime('%Y-%m',item_last_updated);
+##ENDOFQ3
+##)
+##
+##_DEBUG "Query used (1): $query1"
+##_DEBUG "Query used (2): $query2"
+##_DEBUG "Query used (3): $query3"
+##
+#
+# The database
+#
+##IADB="$IADIR/ia.db"
+##
+#
+# Collect the values
+#
+##UPLOADS=$(echo "$query1" | sqlite3 -list "$IADB")
+##REMAINING=$(echo "$query2" | sqlite3 -list "$IADB")
+##TABLE=$(echo "$query3" | sqlite3 -list "$IADB")
+##
+##_DEBUG "Uploads=$UPLOADS (query 1)"
+##_DEBUG "Remaining=$REMAINING (query 2)"
+##_DEBUG "Table=$TABLE"
+
+#
+# Files we need to build the AOB
+#
+AOBMKD="$BASEDIR/aob_$startdate.mkd"
+
+#
+# Sanity check
+#
+[ -e "$AOBMKD" ] || { echo "Unable to find $AOBMKD"; exit 1; }
+
+#
+# Make temporary files and set traps to delete them
+#
+##TMP1=$(mktemp) || { echo "$SCRIPT: creation of temporary file failed!"; exit 1; }
+##trap 'cleanup_temp $TMP1' SIGHUP SIGINT SIGPIPE SIGTERM EXIT
+##
+#
+# Use Awk to process the table we failed to generate in SQL :-(
+#
+##awk -F '|' -f /dev/fd/7 <<<"$TABLE" >"$TMP1" 7<<'ENDAWK'
+##BEGIN{
+##    total = 0
+##    remainder = (2429 - 871 + 1)
+##    print "<table>"
+##    print "<tr><th>Month</th><th>Month count</th>"\
+##        "<th>Running total</th><th>Remainder</th></tr>"
+##}
+##{
+##    total = total + $2
+##    remainder = remainder - $2
+##    printf "<tr><td>%s</td><td>%s</td><td>%s</td><td>%s</td></tr>\n",
+##        $1,$2,total,remainder
+##}
+##END{
+##    print "</table>"
+##}
+##ENDAWK
+##cat >>"$TMP1" <<ENDDATE
+##<p><small><small>Table updated: $(date --utc +'%F %T')</small></small></p>
+##ENDDATE
+##_DEBUG "Table" "$(cat "$TMP1")"
+
+#
+# Build the output files
+#
+# if tpage --define "uploads=$UPLOADS" --define "remaining=$REMAINING" \
+#     --define "table=$TMP1" "$AOBMKD" |\
+#     pandoc -f markdown-smart -t html5 -o "${AOBMKD%mkd}html"; then
+#
+if pandoc -f markdown-smart -t html5 "$AOBMKD" -o "${AOBMKD%mkd}html"; then
+    echo "Converted $AOBMKD to HTML"
+else
+    echo "Conversion of $AOBMKD to HTML failed"
+fi
+
+exit
+
+# vim: syntax=sh:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21:fdm=marker

Community_News/comments_only.tpl

@@ -0,0 +1,121 @@
+[%# comments_only.tpl 2018-11-05                        -%]
+[%# Textual comment summary for Community News.         -%]
+[%# This one partitions comments into past and current. -%]
+[%# It requires make_shownotes > V0.0.28                -%]
+[%- USE date -%]
+[%- USE wrap -%]
+[%- DEFAULT mark_comments = 0
+    aob = 0                   -%]
+[% TAGS outline -%]
+%% IF mark_comments == 1 && missed_comments.size > 0
+=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
+/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
+=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
+
+Missed comments last month
+--------------------------
+
+Note to Volunteers: These are comments for shows last month that were not read
+in the last show because they arrived after the recording.
+
+%% FOREACH comment IN missed_comments
+================================================================================
+hpr[% comment.episode %] ([% comment.date %]) "[% comment.title %]" by [% comment.host %].
+  ------------------------------------------------------------------------------
+  From: [% comment.comment_author_name -%] on [% date.format(comment.comment_timestamp_ut,'%Y-%m-%d','UTC') -%]:
+[%- IF comment.comment_title.length > 0 -%]
+ "[% comment.comment_title %]"
+[%- ELSE -%]
+ "[no title]"
+[%- END %]
+  ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+[% wrap(comment.comment_text, 80, '  ', '  ') FILTER decode_entities %]
+
+%% END
+=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
+/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
+=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
+%% END
+
+Comments this month
+-------------------
+
+%% IF comment_count > 0
+There [%- comment_count == 1 ? "is $comment_count comment" : "are $comment_count comments" -%] in total.
+
+%% IF past_count > 0
+Past shows
+----------
+
+There [% past_count == 1 ? "is $past_count comment" : "are $past_count comments" %] on [% past.size %] previous [% past.size == 1 ? "show" : "shows" %]:
+%% FOREACH ep IN past.keys.sort
+%% arr = past.$ep
+
+================================================================================
+hpr[% arr.0.episode %] ([% arr.0.date %]) "[% arr.0.title %]" by [% arr.0.host %].
+%% FOREACH row IN arr
+  ------------------------------------------------------------------------------
+  Comment [% row.index %]: [% row.comment_author_name -%] on [% date.format(row.comment_timestamp_ut,'%Y-%m-%d','UTC') -%]:
+[%- IF row.comment_title.length > 0 -%]
+ "[% row.comment_title FILTER decode_entities %]"
+[%- ELSE -%]
+ "[no title]"
+[%- END %]
+  ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+[% IF mark_comments == 1 && ((row.comment_timestamp_ut <= last_recording) && (arr.0.date.substr(0,7) == last_month)) -%]
+[% wrap(row.comment_text, 80, '| ', '| ') FILTER decode_entities %]
+[% ELSE -%]
+[% wrap(row.comment_text, 80, '  ', '  ') FILTER decode_entities %]
+[% END -%]
+%% END
+%% END
+
+
+=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
+/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
+=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
+
+%% END
+
+%% cc = (comment_count - past_count)
+%% IF cc > 0
+This month's shows
+------------------
+
+There [% cc == 1 ? "is $cc comment" : "are $cc comments" %] on [% current.size %] of this month's shows:
+%% FOREACH ep IN current.keys.sort
+%% arr = current.$ep
+
+================================================================================
+hpr[% arr.0.episode %] ([% arr.0.date %]) "[% arr.0.title %]" by [% arr.0.host %].
+%% FOREACH row IN arr
+  ------------------------------------------------------------------------------
+  Comment [% row.index %]: [% row.comment_author_name -%] on [% date.format(row.comment_timestamp_ut,'%Y-%m-%d','UTC') -%]:
+[%- IF row.comment_title.length > 0 -%]
+ "[% row.comment_title FILTER decode_entities %]"
+[%- ELSE -%]
+ "[no title]"
+[%- END %]
+  ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+[% wrap(row.comment_text, 80, '  ', '  ') FILTER decode_entities %]
+%% END
+%% END
+%% END
+
+%% ELSE
+There were no comments this month.
+%% END
+
+[%# Any other business? -%]
+[% IF aob == 1 -%]
+=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
+/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
+=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
+Any other business
+------------------
+
+[% INCLUDE $aobfile -%]
+[%- END %]
+[%#
+  # vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]

Community_News/mailnote_template.tpl

@@ -0,0 +1,21 @@
+[%# mailnote_template.tpl 2015-06-12
+  # This is the main (and default) template used by the script
+  # 'summarise_mail'. It generates an HTML snippet which simply lists all of
+  # the message threads passed to it in the 'threads' hash and reports the
+  # total. This HTML is then inserted into the notes generated by
+  # the 'make_shownotes' script.
+-%]
+[%- aa = 'archived-at' -%]
+<ol>
+    [%- FOREACH key IN threads.keys.sort %]
+    <li><em>From:</em> [% threads.$key.from.0 FILTER html_entity %]<br/>
+        <em>Date:</em> [% threads.$key.date %]<br/>
+        <em>Subject:</em> [% threads.$key.subject FILTER html_entity %]<br/>
+        <em>Link:</em> <a href="[% threads.$key.thread %]" target="_blank">[% threads.$key.thread %]</a><br/>
+        <em>Messages:</em> [% threads.$key.count %]<br/>[% key != threads.keys.sort.last ? '<br/>' : '' %]</li>
+    [%- END %]
+</ol>
+Total messages this month: [% total %]<br/>
+[%#
+  # vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]

Community_News/mailnote_template2.tpl

@@ -0,0 +1,22 @@
+[%# mailnote_template2.tpl
+  # This is an alternative template for use with the 'summarise_mail' script.
+  # It generates a plain text version of the mail threads and is intended to
+  # be used by the Community News hosts when reading through the month's
+  # message threads.
+-%]
+[%- aa = 'archived-at' -%]
+[%- FOREACH key IN threads.keys.sort -%]
+From:     [% threads.$key.from.0 %]
+Date:     [% threads.$key.date %]
+Subject:  [% threads.$key.subject %]
+Link:     [% threads.$key.thread %]
+Messages: [% threads.$key.count %]
+--------------------------------------------------------------------------------
+
+[%- END -%]
+
+Total messages this month: [% total %]
+[%#
+  # vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]
+

Community_News/make_meeting

@@ -0,0 +1,484 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: make_meeting
+#
+#        USAGE: ./make_meeting
+#
+#  DESCRIPTION: Makes a recurrent iCalendar meeting to be loaded into
+#               a calendar. This is apparently necessary when the 'RRULE'
+#               recurrence description is not adequate.
+#
+#      OPTIONS: None
+# REQUIREMENTS: Needs modules Getopt::Long, Data::ICal, Date::Parse and
+#               Date::Calc
+#         BUGS: ---
+#        NOTES: Based on a script distributed with the HPR episode "iCalendar
+#               Hacking"
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      LICENCE: Copyright (c) year 2012-2024 Dave Morriss
+#      VERSION: 0.2.2
+#      CREATED: 2012-10-13 15:34:01
+#     REVISION: 2024-05-24 22:45:56
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+
+use Getopt::Long;
+
+use Data::ICal;
+use Data::ICal::Entry::Event;
+use Data::ICal::Entry::Todo;
+
+use Date::Parse;
+use Date::Calc qw{:all};
+use Date::ICal;
+
+#use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.2.2';
+
+#
+# Script name
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+my ( @startdate, @rdate, @events );
+
+#
+# Attributes for the calendar message
+#
+#my $server = 'ch1.teamspeak.cc';
+#my $port   = 64747;
+my $server = 'chatter.skyehaven.net';
+my $port   = 64738;
+
+#-------------------------------------------------------------------------------
+# Options and arguments
+#-------------------------------------------------------------------------------
+my $DEF_COUNT   = 12;
+#my $DEF_SUMMARY = 'Send out CNews email';
+
+#
+# Process options
+#
+my %options;
+Options( \%options );
+
+#
+# Default help
+#
+usage() if ( $options{'help'} );
+
+#
+# Collect options
+#
+my $count = ( defined( $options{count} ) ? $options{count} : $DEF_COUNT );
+my $reminder = ( defined( $options{reminder} ) ? $options{reminder} : 0 );
+my $force    = ( defined( $options{force} )    ? $options{force}    : 0 );
+
+#my $reminder_summary = ( defined( $options{summary} ) ? $options{summary} :
+#    $DEF_SUMMARY );
+
+#
+# Two reminders: 8 days ahead reminder to check with Ken, 5 days ahead
+# reminder to send out the email.
+#
+my %reminders = (
+    email => [ -5, 'Send out CNews email' ],
+    check => [ -8, 'Check CNews date with Ken' ],
+);
+
+#
+# Use the date provided or the default
+#
+if ( defined( $options{from} ) ) {
+    #
+    # Parse the date, convert to start of month and (optionally) validate it
+    #
+    @startdate = convert_date( $options{from}, $force );
+}
+else {
+    #
+    # Use the current date
+    #
+    @startdate = Today();
+}
+
+#
+# Date and time values
+#
+# TODO: These should be in a configuration file, and should ideally be capable
+# of having a time zone defined (default UTC, as now).
+#
+my $monday = 1;    # Day of week number 1-7, Monday-Sunday
+
+my @starttime = ( 13, 00, 00 );    # UTC
+my @endtime   = ( 15, 00, 00 );
+
+my @todostart = ( 9,  00, 00 );    # UTC
+my @todoend   = ( 17, 00, 00 );
+
+#
+# Format of an ISO UTC datetime
+#
+my $fmt = "%02d%02d%02dT%02d%02d%02dZ";
+
+#
+# Constants for the event
+#
+my $calname     = 'HPR Community News';
+my $timezone    = 'UTC';
+my $location    = "$server port: $port";
+my $summary     = 'HPR Community News Recording Dates';
+my $description = <<ENDDESC;
+Mumble settings
+-------------------
+Server Name:    Anything you like
+Server Address: $server
+Port:           $port
+Name:           Your name or alias is fine
+
+Information about Mumble can be found here:
+http://hackerpublicradio.org/recording.php
+ENDDESC
+
+#
+# Compute the next recording date from the starting date (@startdate will be
+# today's date or the start of the explicitly selected month provided via
+# -from=DATE. We want day of the week to be Monday, the first in the month,
+# then to go back 1 day from that to get to the Sunday! Simple)
+#
+@startdate = make_date( \@startdate, $monday, 1, -1 );
+@rdate = @startdate;
+
+#
+# Create the calendar object
+#
+my $calendar = Data::ICal->new();
+
+#
+# Some calendar properties
+#
+$calendar->add_properties(
+    'X-WR-CALNAME'  => $calname,
+    'X-WR-TIMEZONE' => $timezone,
+);
+
+#
+# Create the event object
+#
+my $vevent = Data::ICal::Entry::Event->new();
+
+#
+# Add some event properties
+#
+$vevent->add_properties(
+    summary     => $summary,
+    location    => $location,
+    description => $description,
+    dtstart     => sprintf( $fmt, @startdate, @starttime ),
+    dtend       => sprintf( $fmt, @startdate, @endtime ),
+);
+
+#
+# Add recurring dates. (Note that this generates RDATE entries rather than
+# 1 entry with multiple dates; this is because this module doesn't seem to
+# have the ability to generate the concatenated entry. The two modes of
+# expressing the repeated dates seem to be equivalent.)
+#
+for my $i ( 1 .. $count ) {
+    #
+    # Recording date computation from the start of the month
+    #
+    @rdate = make_date( \@rdate, $monday, 1, -1 );
+
+    #
+    # Save the current recording date to make an array of arrayrefs
+    #
+    push( @events, [@rdate] );
+
+    #
+    # Add this date to the multi-date event
+    #
+    $vevent->add_property( rdate =>
+            [ sprintf( $fmt, @rdate, @starttime ), { value => 'DATE-TIME' } ],
+    );
+
+    #
+    # Increment the meeting date for the next one. If we're early in the month
+    # by one day otherwise to the beginning of the next month. This is
+    # necessary because otherwise make_date will skip months.
+    #
+    if ( $rdate[2] < 7 ) {
+        @rdate = Add_Delta_Days( @rdate, 1 );
+    }
+    else {
+        @rdate = ( ( Add_Delta_YM( @rdate, 0, 1 ) )[ 0 .. 1 ], 1 );
+    }
+}
+
+#
+# Add the event into the calendar
+#
+$calendar->add_entry($vevent);
+
+#
+# Are we to add reminders?
+#
+if ($reminder) {
+    #
+    # Loop through the cache of recording dates
+    #
+    for my $i ( 0 .. $count - 1 ) {
+        #
+        # Loop through the reminders hash
+        #
+        for my $key (keys(%reminders)) {
+            #
+            # A new Todo entry each iteration
+            #
+            my $vtodo = Data::ICal::Entry::Todo->new();
+
+            #
+            # Get a recording date from the cache and subtract 5 days from it to
+            # get the preceding Monday
+            #
+            @rdate = @{ $events[$i] };
+            @rdate = Add_Delta_Days( @rdate, $reminders{$key}->[0] );
+
+            #
+            # Add the date as the date part of the Todo
+            #
+            $vtodo->add_properties(
+                summary => $reminders{$key}->[1],
+                status  => 'INCOMPLETE',
+                dtstart => Date::ICal->new(
+                    ical => sprintf( $fmt, @rdate, @todostart )
+                )->ical,
+                due => Date::ICal->new(
+                    ical => sprintf( $fmt, @rdate, @todoend )
+                )->ical,
+            );
+
+            #
+            # Add to the calendar
+            #
+            $calendar->add_entry($vtodo);
+
+        }
+    }
+
+}
+
+#
+# Print the result
+#
+print $calendar->as_string;
+
+exit;
+
+#===  FUNCTION  ================================================================
+#         NAME: convert_date
+#      PURPOSE: Convert a textual date (ideally YYYY-MM-DD) to a Date::Calc
+#               date for the start of the given month.
+#   PARAMETERS: $textdate       date in text form
+#               $force          Boolean defining whether to skip validating
+#                               the date
+#      RETURNS: The start of the month in the textual date in Date::Calc
+#               format
+#  DESCRIPTION: Parses the date string and makes a Date::Calc date from the
+#               result where the day part is 1. Optionally checks that the
+#               date isn't in the past, though $force = 1 ignores this check.
+#       THROWS: No exceptions
+#     COMMENTS: Requires Date::Calc and Date::Parse
+#               Note the validation 'die' has a non-generic message
+#     SEE ALSO: N/A
+#===============================================================================
+sub convert_date {
+    my ( $textdate, $force ) = @_;
+
+    my ( @today, @parsed, @startdate );
+
+    #
+    # Reference date
+    #
+    @today = Today();
+
+    #
+    # Parse and perform rudimentary validation on the $textdate date. Function
+    # 'strptime' returns "($ss,$mm,$hh,$day,$month,$year,$zone,$century)".
+    #
+    # The Date::Calc date $startdate[0] gets the returned year or the current
+    # year if no year was parsed, $startdate[1] gets the parsed month or the
+    # current month if no month was parsed, and $startdate[2] gets a day of 1.
+    #
+    @parsed    = strptime($textdate);
+    die "Unable to parse date '$textdate'\n" unless @parsed;
+
+    @startdate = (
+        ( defined( $parsed[5] ) ? $parsed[5] + 1900 : $today[0] ),    # year
+        ( defined( $parsed[4] ) ? $parsed[4] + 1 : $today[1] ), 1
+    );
+
+    #
+    # Unless we've overridden the check there should be a positive or zero
+    # difference in days between the target date and today's date to prevent
+    # going backwards in time.
+    #
+    unless ($force) {
+        unless ( Delta_Days( @today[ 0, 1 ], 1, @startdate ) ge 0 ) {
+            warn "Invalid date $textdate (in the past)\n";
+            die "Use -force to create a back-dated calendar\n";
+        }
+    }
+
+    return @startdate;
+
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: make_date
+#      PURPOSE: Make the event date for recurrence
+#   PARAMETERS: $refdate        An arrayref to the reference date array
+#                               (usually today's date)
+#               $dow            Day of week for the event date (1-7, 1=Monday)
+#               $n              The nth day of the week ($dow) 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 Sunday before the first Monday of the month". We do
+#               this by computing a pre-offset date (first Monday of month)
+#               then apply the offset (Sunday 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: 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: usage
+#      PURPOSE: Display a usage message and exit
+#   PARAMETERS: None
+#      RETURNS: To command line level with exit value 1
+#  DESCRIPTION: Builds the usage message using global values
+#       THROWS: no exceptions
+#     COMMENTS: none
+#     SEE ALSO: n/a
+#===============================================================================
+sub usage {
+    print STDERR <<EOD;
+Usage: $PROG [options] [FILE...]
+
+$PROG v$VERSION
+
+Makes a recurrent iCalendar meeting to be loaded into a calendar. Optionally
+adds reminders in the form of TODO items in relation to each meeting.
+
+    -help               Display this information
+    -from=DATE          Start date for the calendar
+    -count=N            Number of entries; default 12
+    -[no]force          Allow a -from=DATE date before today; default not
+    -[no]reminder       Add a reminder TODO item; default no
+
+EOD
+#    -summary=TEXT       Alternative text for the reminder (default 'Send out
+#                        CNews email')
+    exit(1);
+}
+
+#===  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", "from=s", "count=i", "force!", "reminder!");
+#        "summary|rs=s" );
+
+    if ( !GetOptions( $optref, @options ) ) {
+        usage();
+    }
+
+    return;
+}
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker

Community_News/reserve_cnews

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

Community_News/shownote_template.tpl

@@ -0,0 +1 @@
+shownote_template11.tpl

Community_News/shownote_template10.tpl

@@ -0,0 +1,164 @@
+[%# shownote_template10.tpl 2018-11-05 -%]
+[%# HTML snippet for insertion into the database -%]
+[%# This one uses the new format for the mailing list data, and partitions -%]
+[%# comments into past and current. It also marks comments that don't need -%]
+[%# to be read when -markcomments is selected. It requires make_shownotes > V0.0.28 -%]
+[%- USE date -%]
+[%- prefix = "http://hackerpublicradio.org"
+    correspondents = "$prefix/correspondents.php"
+    mailthreads = "$prefix/pipermail/hpr_hackerpublicradio.org/$review_year-$review_month/thread.html" -%]
+[%- DEFAULT skip_comments = 0
+    mark_comments = 0 -%]
+[%- IF mark_comments == 1 %]
+<style>
+p#ignore, li#ignore {
+    background-color: lightgreen;
+    color:maroon;
+    }
+</style>
+[%- END %]
+[%# For the '-mailnotes' option without a file we generate our own inclusion. -%]
+[%# We pretend 'default_mail' is a filename in the calling script. Messy.     -%]
+[% BLOCK default_mail -%]
+<a href="[% mailthreads %]" target="_blank">[% mailthreads %]</a>
+[% END -%]
+
+<h2>New hosts</h2>
+<p>
+[% IF hosts.size > 0 -%]
+Welcome to our new host[%- hosts.size > 1 ? 's' : '' -%]: <br />
+[%- count = 0 %]
+[%# List the new hosts. If a name contains a comma quote it.                  -%]
+[%- FOREACH row IN hosts %]
+    [%- count = count + 1 %]
+    [%- hostname = (row.host.search(',') ? row.host.replace('^(.*)$','"$1"') : row.host) %]
+    <a href="[% correspondents %]?hostid=[% row.hostid %]" target="_blank">[% hostname %]</a>
+    [%- count < hosts.size ? ', ' : '.' %]
+[%- END %]
+[% ELSE -%]
+There were no new hosts this month.
+[% END -%]
+</p>
+
+<h2>Last Month's Shows</h2>
+[%# The 'summary' attribute is deprecated in HTML5 but is included here to      -%]
+[%# prevent errors being reported in the note checker                           -%]
+<table id="t01" summary="Last month's shows">
+    <tr>
+    <th>Id</th>
+    <th>Day</th>
+    <th>Date</th>
+    <th>Title</th>
+    <th>Host</th>
+    </tr>
+    [%- FOREACH row IN shows %]
+    <tr valign="top">
+    <td><strong><a href="http://hackerpublicradio.org/eps.php?id=[% row.eps_id %]" target="_blank">[% row.eps_id %]</a></strong></td>
+    <td>[% date.format(row.date,'%a') %]</td>
+    <td>[% date.format(row.date,'%Y-%m-%d') %]</td>
+    <td><a href="http://hackerpublicradio.org/eps.php?id=[% row.eps_id %]" target="_blank">[% row.title %]</a></td>
+    <td><a href="[% correspondents %]?hostid=[% row.ho_hostid %]" target="_blank">[% row.ho_host FILTER html_entity %]</a></td>
+    </tr>
+    [%- END %]
+</table>
+
+[%# ---------------------------------------------------------------------------------------- -%]
+[%# Skip comments if told to by the caller -%]
+[%- IF skip_comments == 0 -%]
+<h2>Comments this month</h2>
+
+[% IF comment_count > 0 -%]
+[%- IF mark_comments == 1 -%]
+<p id="ignore"><b>Note to Volunteers</b>: Comments marked in green were read in the last
+Community News show and should be ignored in this one.</p>
+[%- END -%]
+<p>These are comments which have been made during the past month, either to shows
+released during the month or to past shows.<br/>
+There [%- comment_count == 1 ? "is $comment_count comment" : "are $comment_count comments" -%] in total.</p>
+[% IF past_count > 0 -%]
+<p>There [% past_count == 1 ? "is $past_count comment" : "are $past_count comments" %] on
+[% past.size %] previous [% past.size == 1 ? "show" : "shows" %]:</p>
+<ul>
+[%- FOREACH ep IN past.keys.sort -%]
+[%- arr = past.$ep -%]
+<li><strong><a href="[% arr.0.identifier_url %]#comments" target="_blank">hpr[% arr.0.episode %]</a></strong>
+([% arr.0.date %]) "<em>[% arr.0.title %]</em>"
+by <a href="[% correspondents %]?hostid=[% arr.0.hostid %]" target="_blank">[% arr.0.host %]</a>.</li>
+<li style="list-style: none; display: inline">
+<ul>
+[%- FOREACH row IN arr -%]
+[%- IF mark_comments == 1 && ((row.comment_timestamp_ut <= last_recording) && (arr.0.date.substr(0,7) == last_month)) -%]
+<li id="ignore">
+[%- ELSE %]
+<li>
+[%- END %]
+<a href="[% row.identifier_url %]#[% row.index %]" target="_blank">Comment [% row.index %]</a>:
+[% row.comment_author_name FILTER html_entity -%] on [% date.format(row.comment_timestamp_ut,'%Y-%m-%d','UTC') -%]:
+[%- IF row.comment_title.length > 0 %]
+"[% row.comment_title %]"
+[%- ELSE -%]
+"[no title]"
+[%- END -%]
+</li>
+[%- END -%]
+</ul><br/>
+</li>
+[%- END -%]
+</ul>
+[%- END %]
+[%# ---------------------------------------------------------------------------------------- -%]
+[% cc = (comment_count - past_count) -%]
+[% IF cc > 0 -%]
+<p>There [% cc == 1 ? "is $cc comment" : "are $cc comments" %] on [% current.size %] of this month's shows:</p>
+<ul>
+[%- FOREACH ep IN current.keys.sort -%]
+[%- arr = current.$ep -%]
+<li><strong><a href="[% arr.0.identifier_url %]#comments" target="_blank">hpr[% arr.0.episode %]</a></strong>
+([% arr.0.date %]) "<em>[% arr.0.title %]</em>"
+by <a href="[% correspondents %]?hostid=[% arr.0.hostid %]" target="_blank">[% arr.0.host %]</a>.</li>
+<li style="list-style: none; display: inline">
+<ul>
+[%- FOREACH row IN arr -%]
+<li><a href="[% row.identifier_url %]#[% row.index %]" target="_blank">Comment [% row.index %]</a>:
+[% row.comment_author_name FILTER html_entity -%] on [% date.format(row.comment_timestamp_ut,'%Y-%m-%d','UTC') -%]:
+[%- IF row.comment_title.length > 0 %]
+"[% row.comment_title %]"
+[%- ELSE -%]
+"[no title]"
+[%- END -%]
+</li>
+[%- END -%]
+</ul><br/>
+</li>
+[%- END -%]
+</ul>
+[%- END %]
+[%- ELSE %]
+There were no comments this month.
+[%- END %]
+[%- END %]
+
+[%# ---------------------------------------------------------------------------------------- -%]
+[%- IF includefile.defined -%]
+<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="http://hackerpublicradio.org/maillist"
+target="_blank">Mail List</a> which is open to all HPR listeners and
+contributors. The discussions are open and available on the HPR server under
+<a href="http://hackerpublicradio.org/pipermail/hpr_hackerpublicradio.org/">Mailman</a>.
+</p>
+<p>The threaded discussions this month can be found here:</p>
+[% INCLUDE $includefile -%]
+[%- END %]
+
+[%# ---------------------------------------------------------------------------------------- -%]
+[%# Any other business? -%]
+[% IF aob == 1 -%]
+<h2>Any other business</h2>
+[% INCLUDE $aobfile -%]
+[%- END %]
+[%#
+  # vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]
+

Community_News/shownote_template11.tpl

@@ -0,0 +1,234 @@
+[%# shownote_template11.tpl 2024-05-07 -%]
+[%# HTML snippet for insertion into the database -%]
+[%# This one uses the new format for the mailing list data, and partitions -%]
+[%# comments into past and current. It also marks comments that don't need -%]
+[%# to be read when -markcomments is selected. It requires make_shownotes >= V0.0.30 -%]
+[%- USE date -%]
+[%- USE pad4 = format('%04d') -%]
+[%- correspondents = "https://hackerpublicradio.org/correspondents"
+    mailbase="https://lists.hackerpublicradio.com/pipermail/hpr"
+    mailthreads = "$mailbase/$review_year-$review_month/thread.html" -%]
+[%- DEFAULT skip_comments = 0
+    mark_comments = 0
+    ctext = 0
+    ignore_count = 0
+    missed_count = 0
+    past_count = 0
+-%]
+[%# Embedded CSS. The 'table' and 'hr' settings are always there but the rest is only for if -%]
+[%# we are marking comments                                                                  -%]
+<style>
+table td.shrink {
+    white-space:nowrap
+}
+hr.thin {
+    border: 0;
+    height: 0;
+    border-top: 1px solid rgba(0, 0, 0, 0.1);
+    border-bottom: 1px solid rgba(255, 255, 255, 0.3);
+}
+[%- IF mark_comments == 1 %]
+p#ignore, li#ignore {
+    background-color: lightgreen;
+    color:maroon;
+}
+div#highlight {
+  border-style: solid;
+  border-color: red;
+  padding-right: 20px;
+  padding-left: 20px;
+}
+[%- END %]
+</style>
+[%# For the '-mailnotes' option without a file we generate our own inclusion. -%]
+[%# We pretend 'default_mail' is a filename in the calling script. Messy.     -%]
+[% BLOCK default_mail -%]
+<a href="[% mailthreads %]" target="_blank">[% mailthreads %]</a>
+[% END -%]
+
+<h2>New hosts</h2>
+<p>
+[% IF hosts.size > 0 -%]
+Welcome to our new host[%- hosts.size > 1 ? 's' : '' -%]: <br />
+[%- count = 0 %]
+[%# List the new hosts. If a name contains a comma quote it.                  -%]
+[%- FOREACH row IN hosts %]
+    [%- count = count + 1 %]
+    [%- hostname = (row.host.search(',') ? row.host.replace('^(.*)$','"$1"') : row.host) %]
+    <a href="[% correspondents %]/[% pad4(row.hostid) %].html" target="_blank">[% hostname %]</a>
+    [%- count < hosts.size ? ', ' : '.' %]
+[%- END %]
+[% ELSE -%]
+There were no new hosts this month.
+[% END -%]
+</p>
+
+<h2>Last Month's Shows</h2>
+[%# The id 't01' is in the HPR CSS but might give trouble on the IA -%]
+<table id="t01">
+<tr>
+<th>Id</th>
+<th>Day</th>
+<th>Date</th>
+<th>Title</th>
+<th>Host</th>
+</tr>
+[%- FOREACH row IN shows %]
+<tr>
+<td><strong><a href="https://hackerpublicradio.org/eps/hpr[% pad4(row.eps_id) %]/index.html" target="_blank">[% row.eps_id %]</a></strong></td>
+<td>[% date.format(row.date,'%a') %]</td>
+<td class="shrink">[% date.format(row.date,'%Y-%m-%d') %]</td>
+<td><a href="https://hackerpublicradio.org/eps/hpr[% pad4(row.eps_id) %]/index.html" target="_blank">[% row.title %]</a></td>
+<td><a href="[% correspondents %]/[% pad4(row.ho_hostid) %].html" target="_blank">[% row.ho_host FILTER html_entity %]</a></td>
+</tr>
+[%- END %]
+</table>
+
+[%# ---------------------------------------------------------------------------------------- -%]
+[%# Skip comments if told to by the caller -%]
+[%- IF skip_comments == 0 -%]
+[%# Handle any missed comments if mark_comments is true -%]
+[%- IF mark_comments == 1 && missed_count > 0 -%]
+<br/><div id="highlight">
+<h2>Missed comment[%- missed_comments.size > 1 ? 's' : '' -%] last month</h2>
+<p><b>Note to Volunteers</b>: These are comments for shows last month that were not read in the last show because they arrived on or after the recording day. This section will be removed before these notes are released.</p>
+<ul>
+[%- FOREACH comment IN missed_comments -%]
+<li><strong><a href="[% comment.identifier_url %]#comments" target="_blank">hpr[% comment.episode %]</a></strong>
+([% comment.date %]) "<em>[% comment.title %]</em>" by <a href="[% correspondents %]/[% pad4(comment.hostid) %].html" target="_blank">[% comment.host %]</a>.<br/>
+<small>Summary: "<em>[% comment.summary %]</em>"</small><br/>
+From: [% comment.comment_author_name FILTER html_entity -%] on [% date.format(comment.comment_timestamp_ut,'%Y-%m-%d','UTC') -%]:
+[%- IF comment.comment_title.length > 0 %]
+"[% comment.comment_title %]"
+[%- ELSE -%]
+"[no title]"
+[%- END -%]
+<br/><hr class="thin">[% comment.comment_text FILTER html_line_break %]
+</li><br/>
+[%- END -%]
+</ul></div>
+[%- END -%]
+[%# ---------------------------------------------------------------------------------------- -%]
+<h2>Comments this month</h2>
+
+[% IF comment_count > 0 -%]
+[%- IF mark_comments == 1 && ignore_count > 0 -%]
+<p id="ignore"><b>Note to Volunteers</b>: Comments marked in green were read in the last
+Community News show and should be ignored in this one.</p>
+[%- END -%]
+<p>These are comments which have been made during the past month, either to shows released during the month or to past shows.
+There [%- comment_count == 1 ? "is $comment_count comment" : "are $comment_count comments" -%] in total.</p>
+[% IF past_count > 0 -%]
+<h3>Past shows</h3>
+<p>There [% past_count == 1 ? "is $past_count comment" : "are $past_count comments" %] on
+[% past.size %] previous [% past.size == 1 ? "show" : "shows" %]:</p>
+<ul>
+[%# Loop through by episode then by comment relating to that episode -%]
+[%-    FOREACH ep IN past.keys.sort -%]
+[%-       arr = past.$ep -%]
+<li><strong><a href="[% arr.0.identifier_url %]#comments" target="_blank">hpr[% arr.0.episode %]</a></strong>
+([%       arr.0.date %]) "<em>[% arr.0.title %]</em>"
+by <a href="[% correspondents %]/[% pad4(arr.0.hostid) %].html" target="_blank">[% arr.0.host %]</a>.<br/>
+[%-       IF mark_comments == 1 || ctext == 1 -%]
+<small>Summary: "<em>[% arr.0.summary %]</em>"</small></li>
+[%-       END %]
+<li style="list-style: none; display: inline">
+<ul>
+[%-       FOREACH row IN arr -%]
+[%#          IF mark_comments == 1 && ((row.comment_timestamp_ut <= last_recording) && (arr.0.date.substr(0,7) == last_month)) -%]
+[%#          IF mark_comments == 1 && ((row.comment_released_ut <= last_recording) && (arr.0.date.substr(0,7) == last_month)) -%]
+[%-          IF mark_comments == 1 && row.ignore == 1 -%]
+<li id="ignore">
+[%-          ELSE %]
+<li>
+[%-          END %]
+<a href="[% row.identifier_url %]#[% row.index %]" target="_blank">Comment [% row.index %]</a>:
+[%        row.comment_author_name FILTER html_entity -%] on [% date.format(row.comment_timestamp_ut,'%Y-%m-%d','UTC') -%]:
+[%-          IF row.comment_title.length > 0 %]
+"[%             row.comment_title %]"
+[%-          ELSE -%]
+"[no title]"
+[%-          END -%]
+[%# Add the comment body in too if ctext is true -%]
+[%-          IF ctext == 1 %]
+<br/><hr class="thin">[% row.comment_text FILTER html_line_break %]
+</li><br/>
+[%-          ELSE -%]
+</li>
+[%-          END -%]
+[%-       END -%]
+</ul><br/>
+</limage>
+[%-    END -%]
+</ul>
+[%-    IF mark_comments == 1 || ctext == 1 -%]
+<p><small><small><em>Updated on [% date.format(date.now,'%Y-%m-%d %H:%M:%S') %]</em></small></small></p>
+[%-    END -%]
+[%- END %]
+[%# ---------------------------------------------------------------------------------------- -%]
+[% cc = (comment_count - past_count) -%]
+[% IF cc > 0 -%]
+<h3>This month's shows</h3>
+<p>There [% cc == 1 ? "is $cc comment" : "are $cc comments" %] on [% current.size %] of this month's shows:</p>
+<ul>
+[%- FOREACH ep IN current.keys.sort -%]
+[%- arr = current.$ep -%]
+<li><strong><a href="[% arr.0.identifier_url %]#comments" target="_blank">hpr[% arr.0.episode %]</a></strong>
+([% arr.0.date %]) "<em>[% arr.0.title %]</em>"
+by <a href="[% correspondents %]/[% pad4(arr.0.hostid) %].html" target="_blank">[% arr.0.host %]</a>.</li>
+<li style="list-style: none; display: inline">
+<ul>
+[%- FOREACH row IN arr -%]
+<li><a href="[% row.identifier_url %]#[% row.index %]" target="_blank">Comment [% row.index %]</a>:
+[% row.comment_author_name FILTER html_entity -%] on [% date.format(row.comment_timestamp_ut,'%Y-%m-%d','UTC') -%]:
+[%- IF row.comment_title.length > 0 %]
+"[% row.comment_title %]"
+[%- ELSE -%]
+"[no title]"
+[%- END -%]
+</li>
+[%- END -%]
+</ul><br/>
+</li>
+[%- END -%]
+</ul>
+[%- END %]
+[%- ELSE %]
+There were no comments this month.
+[%- END %]
+[%- END %]
+
+[%# ---------------------------------------------------------------------------------------- -%]
+[%- IF includefile.defined -%]
+<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="https://hackerpublicradio.org/maillist"
+target="_blank">Mail 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>
+[% INCLUDE $includefile -%]
+[%- END %]
+
+[%# ---------------------------------------------------------------------------------------- -%]
+<h2>Events Calendar</h2>
+<p>With the kind permission of <strong>LWN.net</strong> we are linking to
+<a href="https://lwn.net/Calendar/" target="_blank">The LWN.net Community Calendar</a>.</p>
+<p>Quoting the site:</p>
+<blockquote>This is the LWN.net community event calendar, where we track
+events of interest to people using and developing Linux and free software.
+Clicking on individual events will take you to the appropriate web
+page.</blockquote>
+
+[%# ---------------------------------------------------------------------------------------- -%]
+[%# Any other business? -%]
+[% IF aob == 1 -%]
+<h2>Any other business</h2>
+[% INCLUDE $aobfile -%]
+[%- END %]
+[%#
+  # vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]
+

Community_News/shownote_template2.tpl

@@ -0,0 +1,95 @@
+[%# shownote_template.tpl -%]
+[%- correspondents = "http://hackerpublicradio.org/correspondents.php" %]
+[%- DEFAULT skip_comments = 0 %]
+<!DOCTYPE HTML>
+<html>
+<body>
+<h1>HPR Community News for [% review_month %]</h1>
+
+<h2>New hosts</h2>
+<p>
+[% IF hosts.size > 0 -%]
+Welcome to our new hosts: <br />
+[%- count = 0 %]
+[%- FOREACH row IN hosts %]
+    [%- count = count + 1 %]
+    <a href="[% correspondents %]?hostid=[% row.hostid %]">[% row.host %]</a>
+    [%- count < hosts.size ? ', ' : '.' %]
+[%- END %]
+[% ELSE -%]
+There were no new hosts this month.
+[% END -%]
+</p>
+
+<h2>Last Month's Shows</h2>
+<table>
+    <thead>
+	<tr>
+	<th align="left">Id</th>
+	<th align="left">Date</th>
+	<th align="left">Title</th>
+	<th align="left">Host</th>
+	</tr>
+    </thead>
+    <tbody>
+	[%- FOREACH row IN shows %]
+	<tr valign="top">
+	<td align="left"><strong>[% row.eps_id %]</strong></td>
+	<td align="left">[% row.date %]</td>
+	<td align="left"><a href="http://hackerpublicradio.org/eps.php?id=[% row.eps_id %]">[% row.title FILTER html_entity %]</a></td>
+	<td align="left"><a href="[% correspondents %]?hostid=[% row.ho_hostid %]">[% row.ho_host FILTER html_entity %]</a></td>
+	</tr>
+	[%- END %]
+    </tbody>
+</table>
+
+[%- IF includefile.defined %]
+<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="http://hackerpublicradio.org/maillist">Mail List</a> which is open to all
+HPR listeners and contributors. The discussions are open and available on the
+<a href="http://news.gmane.org/gmane.network.syndication.podcast.hacker-public-radio">Gmane</a>
+archive.
+</p>
+<p>
+Discussed this month were:
+[%- INCLUDE $includefile %]
+</p>
+[%- END %]
+
+[%# Skip comments if told to by the caller %]
+[%- IF skip_comments == 0 %]
+<h2>Comments this month</h2>
+
+[% IF comments.size > 0 -%]
+<p>There are [% comments.size %] comments:</p>
+<ul>
+[%- last_ep = 0 %]
+[%- FOREACH row IN comments %]
+[%- IF last_ep != row.episode %]
+<hr/>
+[%- END %]
+[%- last_ep = row.episode %]
+<li><strong>hpr[% row.episode %]</strong> [% row.comment_author_name FILTER html_entity -%]:
+[%- IF row.comment_title.length > 0 %]
+"[% row.comment_title FILTER html_entity %]", 
+[%- ELSE -%]
+"[no title]", 
+[%- END -%]
+relating to the show <a href="http://hackerpublicradio.org[% row.comment_identifier%]">hpr[% row.episode %]</a>
+([% row.date %]) "<em>[% row.title FILTER html_entity %]</em>"
+by <a href="[% correspondents %]?hostid=[% row.hostid %]">[% row.host %]</a>.</li>
+[%- END %]
+</ul>
+[%- ELSE %]
+There were no comments this month.
+[%- END %]
+[%- END %]
+
+</body>
+</html>
+[%# 
+  # vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]
+

Community_News/shownote_template3.tpl

@@ -0,0 +1,102 @@
+[%# shownote_template3.tpl -%]
+[%- USE date -%]
+[%- correspondents = "http://hackerpublicradio.org/correspondents.php" -%]
+[%- DEFAULT skip_comments = 0 -%]
+<!DOCTYPE HTML>
+<html>
+<body>
+<h1>HPR Community News for [% review_month %]</h1>
+
+<h2>New hosts</h2>
+<p>
+[% IF hosts.size > 0 -%]
+Welcome to our new hosts: <br />
+[%- count = 0 %]
+[%- FOREACH row IN hosts %]
+    [%- count = count + 1 %]
+    <a href="[% correspondents %]?hostid=[% row.hostid %]">[% row.host %]</a>
+    [%- count < hosts.size ? ', ' : '.' %]
+[%- END %]
+[% ELSE -%]
+There were no new hosts this month.
+[% END -%]
+</p>
+
+<h2>Last Month's Shows</h2>
+<table>
+    <thead>
+	<tr>
+	<th align="left">Id</th>
+	<th align="left">Date</th>
+	<th align="left">Title</th>
+	<th align="left">Host</th>
+	</tr>
+    </thead>
+    <tbody>
+	[%- FOREACH row IN shows %]
+	<tr valign="top">
+	<td align="left"><strong>[% row.eps_id %]</strong></td>
+	<td align="left">[% row.date %]</td>
+	<td align="left"><a href="http://hackerpublicradio.org/eps.php?id=[% row.eps_id %]">[% row.title FILTER html_entity %]</a></td>
+	<td align="left"><a href="[% correspondents %]?hostid=[% row.ho_hostid %]">[% row.ho_host FILTER html_entity %]</a></td>
+	</tr>
+	[%- END %]
+    </tbody>
+</table>
+
+[%- IF includefile.defined -%]
+<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="http://hackerpublicradio.org/maillist">Mail List</a> which is open to all
+HPR listeners and contributors. The discussions are open and available on the
+<a href="http://news.gmane.org/gmane.network.syndication.podcast.hacker-public-radio">Gmane</a>
+archive.
+</p>
+<p>
+Discussed this month were:
+[%- INCLUDE $includefile %]
+</p>
+[%- END -%]
+
+[%# Skip comments if told to by the caller -%]
+[%- IF skip_comments == 0 -%]
+<h2>Comments this month</h2>
+
+[% IF comments.size > 0 -%]
+<p>There are [% comments.size %] comments:</p>
+<ul>
+[%- last_ep = 0 -%]
+[%- FOREACH row IN comments -%]
+[%= IF last_ep != row.episode =%]
+[%= IF last_ep != 0 %]
+</ol><br/></li>
+[%= END %]
+<li><strong><a href="http://hackerpublicradio.org[% row.comment_identifier %]">hpr[% row.episode %]</a></strong>
+([% row.date %]) "<em>[% row.title FILTER html_entity %]</em>"
+by <a href="[% correspondents %]?hostid=[% row.hostid %]">[% row.host %]</a>.
+<ol>
+[%- END -%]
+[%- last_ep = row.episode %]
+<li>[% row.comment_author_name FILTER html_entity -%] on [% date.format(row.comment_timestamp,'%Y-%m-%d') -%]:
+[%- IF row.comment_title.length > 0 -%]
+"[% row.comment_title FILTER html_entity %]"
+[%- ELSE -%]
+"[no title]"
+[%- END -%]
+</li>
+[%- END -%]
+</ol>
+</li>
+</ul>
+[%- ELSE %]
+There were no comments this month.
+[%- END %]
+[%- END %]
+
+</body>
+</html>
+[%# 
+  # vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]
+

Community_News/shownote_template4.tpl

@@ -0,0 +1,121 @@
+[%# shownote_template4.tpl -%]
+[%- correspondents = "http://hackerpublicradio.org/correspondents.php" %]
+[%- DEFAULT skip_comments = 0 %]
+<!DOCTYPE HTML>
+<html>
+<body>
+<h1>HPR Community News for [% review_month %]</h1>
+
+<h2>New hosts</h2>
+<p>
+[% IF hosts.size > 0 -%]
+Welcome to our new [% hosts.size == 1 ? 'host' : 'hosts' %]: <br />
+[%- count = 0 %]
+[%- FOREACH row IN hosts %]
+    [%- count = count + 1 %]
+    <a href="[% correspondents %]?hostid=[% row.hostid %]">[% row.host %]</a>
+    [%- count < hosts.size ? ', ' : '.' %]
+[%- END %]
+[% ELSE -%]
+There were no new hosts this month.
+[% END -%]
+</p>
+
+<h2>Last Month's Shows</h2>
+<table>
+    <thead>
+	<tr>
+	<th align="left">Id</th>
+	<th align="left">Date</th>
+	<th align="left">Title</th>
+	<th align="left">Host</th>
+	</tr>
+    </thead>
+    <tbody>
+	[%- FOREACH row IN shows %]
+	<tr valign="top">
+	<td align="left"><strong>[% row.eps_id %]</strong></td>
+	<td align="left">[% row.date %]</td>
+	<td align="left"><a href="http://hackerpublicradio.org/eps.php?id=[% row.eps_id %]">[% row.title FILTER html_entity %]</a></td>
+	<td align="left"><a href="[% correspondents %]?hostid=[% row.ho_hostid %]">[% row.ho_host FILTER html_entity %]</a></td>
+	</tr>
+	[%- END %]
+    </tbody>
+</table>
+
+[%- IF includefile.defined %]
+<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="http://hackerpublicradio.org/maillist">Mail List</a> which is open to all
+HPR listeners and contributors. The discussions are open and available on the
+<a href="http://news.gmane.org/gmane.network.syndication.podcast.hacker-public-radio">Gmane</a>
+archive.
+</p>
+<p>
+Discussed this month were:
+[%- INCLUDE $includefile %]
+</p>
+[%- END %]
+
+[%# Skip comments if told to by the caller %]
+[%- IF skip_comments == 0 %]
+<h2>Comments this month</h2>
+
+[% IF comments.size > 0 -%]
+<p>There are [% comments.size %] comments:</p>
+
+<table border="1">
+    <thead>
+	<tr>
+	<th align="left">Show</th>
+	<th align="left">Title</th>
+	<th align="left">Host</th>
+	<th align="left">From</th>
+	<th align="left">Subject</th>
+	</tr>
+    </thead>
+    <tbody>
+        [%- FOREACH row IN comments %]
+        <tr valign="top">
+        <td><a href="http://hackerpublicradio.org/eps.php?id=[% row.episode %]">[% row.episode %]</a></td>
+        <td>[% row.title FILTER html_entity %]</td>
+        <td><a href="[% correspondents %]?hostid=[% row.hostid %]">[% row.host %]</a></td>
+        <td>[% row.comment_author_name FILTER html_entity %]</td>
+        <td>
+        [%- IF row.comment_title.length > 0 %]
+        [% row.comment_title FILTER html_entity %]
+        [%- ELSE %]
+        -
+        [%- END %]
+        </tr>
+        [%- END %]
+        </td>
+    </tbody>
+</table>
+
+<ul>
+[%- FOREACH row IN comments %]
+<li><strong>hpr[% row.episode %]</strong>
+[% row.comment_author_name FILTER html_entity %]:
+[%- IF row.comment_title.length > 0 %]
+"[% row.comment_title FILTER html_entity %]",
+[%- ELSE %]
+"[no title]", 
+[%- END %]
+relating to the show <a href="http://hackerpublicradio.org[% row.comment_identifier%]">hpr[% row.episode %]</a>
+([% row.date %]) "<em>[% row.title FILTER html_entity %]</em>"
+by <a href="[% correspondents %]?hostid=[% row.hostid %]">[% row.host %]</a>.</li>
+[%- END %]
+</ul>
+[%- ELSE %]
+There were no comments this month.
+[%- END %]
+[%- END %]
+
+</body>
+</html>
+[%# 
+  # vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]
+

Community_News/shownote_template5.tpl

@@ -0,0 +1,100 @@
+[%# shownote_template5.tpl 2016-07-23 -%]
+[%# HTML snippet for insertion into the database -%]
+[%- USE date -%]
+[%- correspondents = "http://hackerpublicradio.org/correspondents.php" -%]
+[%- DEFAULT skip_comments = 0 -%]
+[%# <h1>HPR Community News for {% review_month %}</h1> -%]
+
+<h2>New hosts</h2>
+<p>
+[% IF hosts.size > 0 -%]
+Welcome to our new host[%- hosts.size > 1 ? 's' : '' -%]: <br />
+[%- count = 0 %]
+[%- FOREACH row IN hosts %]
+    [%- count = count + 1 %]
+    <a href="[% correspondents %]?hostid=[% row.hostid %]" target="_blank">[% row.host %]</a>
+    [%- count < hosts.size ? ', ' : '.' %]
+[%- END %]
+[% ELSE -%]
+There were no new hosts this month.
+[% END -%]
+</p>
+
+<h2>Last Month's Shows</h2>
+[%# The 'summary' attribute is deprecated in HTML5 but is included here to      -%]
+[%# prevent errors being reported in the note checker                           -%]
+<table id="t01" summary="Last month's shows">
+    <tr>
+    <th align="left">Id</th>
+    <th align="left">Day</th>
+    <th align="left">Date</th>
+    <th align="left">Title</th>
+    <th align="left">Host</th>
+    </tr>
+    [%- FOREACH row IN shows %]
+    <tr valign="top">
+    <td align="left"><strong><a href="http://hackerpublicradio.org/eps.php?id=[% row.eps_id %]" target="_blank">[% row.eps_id %]</a></strong></td>
+    <td align="left">[% date.format(row.date,'%a') %]</td>
+    <td align="left">[% date.format(row.date,'%Y-%m-%d') %]</td>
+    <td align="left"><a href="http://hackerpublicradio.org/eps.php?id=[% row.eps_id %]" target="_blank">[% row.title %]</a></td>
+    <td align="left"><a href="[% correspondents %]?hostid=[% row.ho_hostid %]" target="_blank">[% row.ho_host FILTER html_entity %]</a></td>
+    </tr>
+    [%- END %]
+</table>
+
+[%- IF includefile.defined -%]
+<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="http://hackerpublicradio.org/maillist" target="_blank">Mail List</a> which is open to all
+HPR listeners and contributors. The discussions are open and available on the
+<a href="http://news.gmane.org/gmane.network.syndication.podcast.hacker-public-radio" target="_blank">Gmane</a>
+archive.
+</p>
+<p>The main threads this month were:</p>
+[% INCLUDE $includefile -%]
+[%- END %]
+
+[%# Skip comments if told to by the caller -%]
+[%- IF skip_comments == 0 -%]
+<h2>Comments this month</h2>
+
+[% IF comment_count > 0 -%]
+<p>These are comments which have been made during the past month, either to shows
+released during the month or to past shows.</p>
+<p>There [%- comment_count == 1 ? "is $comment_count comment" : "are $comment_count comments" -%]:</p>
+<ul>
+[%- last_ep = 0 -%]
+[%- FOREACH row IN comments -%]
+[%= IF last_ep != row.episode =%]
+[%= IF last_ep != 0 %]
+</ul><br/></li>
+[%= END %]
+<li><strong><a href="[% row.identifier_url %]#comments" target="_blank">hpr[% row.episode %]</a></strong>
+([% row.date %]) "<em>[% row.title %]</em>"
+by <a href="[% correspondents %]?hostid=[% row.hostid %]" target="_blank">[% row.host %]</a>.
+<ul>
+[%- END -%]
+[%- last_ep = row.episode %]
+[%= IF row.in_range =%]
+<li><a href="[% row.identifier_url %]#[% row.index %]" target="_blank">Comment [% row.index %]</a>:
+[% row.comment_author_name FILTER html_entity -%] on [% date.format(row.comment_timestamp,'%Y-%m-%d') -%]:
+[%- IF row.comment_title.length > 0 %]
+"[% row.comment_title FILTER html_entity %]"
+[%- ELSE -%]
+"[no title]"
+[%- END -%]
+</li>
+[%- END -%]
+[%- END -%]
+</ul>
+</li>
+</ul>
+[%- ELSE %]
+There were no comments this month.
+[%- END %]
+[%- END %]
+[%#
+  # vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]
+

Community_News/shownote_template6.tpl

@@ -0,0 +1,107 @@
+[%# shownote_template6.tpl 2016-08-17 -%]
+[%# HTML snippet for insertion into the database -%]
+[%# This one uses the new format for the mailing list data -%]
+[%- USE date -%]
+[%- prefix = "http://hackerpublicradio.org"
+    correspondents = "$prefix/correspondents.php"
+    mailthreads = "$prefix/pipermail/hpr_hackerpublicradio.org/$review_year-$review_month/thread.html" -%]
+[%- DEFAULT skip_comments = 0 -%]
+[%# For the '-mailnotes' option without a file we generate our own inclusion. -%]
+[%# We pretend 'default_mail' is a filename in the calling script. Messy.     -%]
+[% BLOCK default_mail -%]
+<a href="[% mailthreads %]" target="_blank">[% mailthreads %]</a>
+[% END -%]
+
+<h2>New hosts</h2>
+<p>
+[% IF hosts.size > 0 -%]
+Welcome to our new host[%- hosts.size > 1 ? 's' : '' -%]: <br />
+[%- count = 0 %]
+[%- FOREACH row IN hosts %]
+    [%- count = count + 1 %]
+    <a href="[% correspondents %]?hostid=[% row.hostid %]" target="_blank">[% row.host %]</a>
+    [%- count < hosts.size ? ', ' : '.' %]
+[%- END %]
+[% ELSE -%]
+There were no new hosts this month.
+[% END -%]
+</p>
+
+<h2>Last Month's Shows</h2>
+[%# The 'summary' attribute is deprecated in HTML5 but is included here to      -%]
+[%# prevent errors being reported in the note checker                           -%]
+<table id="t01" summary="Last month's shows">
+    <tr>
+    <th align="left">Id</th>
+    <th align="left">Day</th>
+    <th align="left">Date</th>
+    <th align="left">Title</th>
+    <th align="left">Host</th>
+    </tr>
+    [%- FOREACH row IN shows %]
+    <tr valign="top">
+    <td align="left"><strong><a href="http://hackerpublicradio.org/eps.php?id=[% row.eps_id %]" target="_blank">[% row.eps_id %]</a></strong></td>
+    <td align="left">[% date.format(row.date,'%a') %]</td>
+    <td align="left">[% date.format(row.date,'%Y-%m-%d') %]</td>
+    <td align="left"><a href="http://hackerpublicradio.org/eps.php?id=[% row.eps_id %]" target="_blank">[% row.title %]</a></td>
+    <td align="left"><a href="[% correspondents %]?hostid=[% row.ho_hostid %]" target="_blank">[% row.ho_host FILTER html_entity %]</a></td>
+    </tr>
+    [%- END %]
+</table>
+
+[%- IF includefile.defined -%]
+<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="http://hackerpublicradio.org/maillist" target="_blank">Mail List</a> which is open to all
+HPR listeners and contributors. The discussions are open and available on the
+<a href="http://news.gmane.org/gmane.network.syndication.podcast.hacker-public-radio" target="_blank">Gmane</a>
+archive and the <a href="http://hackerpublicradio.org/pipermail/hpr_hackerpublicradio.org/">Mailman</a> archive.
+</p>
+<p>The threaded discussions this month can be found here:</p>
+[% INCLUDE $includefile -%]
+[%- END %]
+
+[%# Skip comments if told to by the caller -%]
+[%- IF skip_comments == 0 -%]
+<h2>Comments this month</h2>
+
+[% IF comment_count > 0 -%]
+<p>These are comments which have been made during the past month, either to shows
+released during the month or to past shows.</p>
+<p>There [%- comment_count == 1 ? "is $comment_count comment" : "are $comment_count comments" -%]:</p>
+<ul>
+[%- last_ep = 0 -%]
+[%- FOREACH row IN comments -%]
+[%= IF last_ep != row.episode =%]
+[%= IF last_ep != 0 %]
+</ul><br/></li>
+[%= END %]
+<li><strong><a href="[% row.identifier_url %]#comments" target="_blank">[% row.past ? "[hpr$row.episode]" : "hpr$row.episode" %]</a></strong>
+([% row.date %]) "<em>[% row.title %]</em>"
+by <a href="[% correspondents %]?hostid=[% row.hostid %]" target="_blank">[% row.host %]</a>.
+<ul>
+[%- END -%]
+[%- last_ep = row.episode %]
+[%= IF row.in_range =%]
+<li><a href="[% row.identifier_url %]#[% row.index %]" target="_blank">Comment [% row.index %]</a>:
+[% row.comment_author_name FILTER html_entity -%] on [% date.format(row.comment_timestamp,'%Y-%m-%d') -%]:
+[%- IF row.comment_title.length > 0 %]
+"[% row.comment_title FILTER html_entity %]"
+[%- ELSE -%]
+"[no title]"
+[%- END -%]
+</li>
+[%- END -%]
+[%- END -%]
+</ul>
+</li>
+</ul>
+[%- ELSE %]
+There were no comments this month.
+[%- END %]
+[%- END %]
+[%#
+  # vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]
+

Community_News/shownote_template7.tpl

@@ -0,0 +1,138 @@
+[%# shownote_template7.tpl 2016-10-02 -%]
+[%# HTML snippet for insertion into the database -%]
+[%# This one uses the new format for the mailing list data, and partitions -%]
+[%# comments into past and current. It requires make_shownotes > V0.0.21   -%]
+[%- USE date -%]
+[%- prefix = "http://hackerpublicradio.org"
+    correspondents = "$prefix/correspondents.php"
+    mailthreads = "$prefix/pipermail/hpr_hackerpublicradio.org/$review_year-$review_month/thread.html" -%]
+[%- DEFAULT skip_comments = 0 -%]
+[%# For the '-mailnotes' option without a file we generate our own inclusion. -%]
+[%# We pretend 'default_mail' is a filename in the calling script. Messy.     -%]
+[% BLOCK default_mail -%]
+<a href="[% mailthreads %]" target="_blank">[% mailthreads %]</a>
+[% END -%]
+
+<h2>New hosts</h2>
+<p>
+[% IF hosts.size > 0 -%]
+Welcome to our new host[%- hosts.size > 1 ? 's' : '' -%]: <br />
+[%- count = 0 %]
+[%- FOREACH row IN hosts %]
+    [%- count = count + 1 %]
+    [%- hostname = (row.host.search(',') ? row.host.replace('^(.*)$','"$1"') : row.host) %]
+    <a href="[% correspondents %]?hostid=[% row.hostid %]" target="_blank">[% hostname %]</a>
+    [%- count < hosts.size ? ', ' : '.' %]
+[%- END %]
+[% ELSE -%]
+There were no new hosts this month.
+[% END -%]
+</p>
+
+<h2>Last Month's Shows</h2>
+[%# The 'summary' attribute is deprecated in HTML5 but is included here to      -%]
+[%# prevent errors being reported in the note checker                           -%]
+<table id="t01" summary="Last month's shows">
+    <tr>
+    <th>Id</th>
+    <th>Day</th>
+    <th>Date</th>
+    <th>Title</th>
+    <th>Host</th>
+    </tr>
+    [%- FOREACH row IN shows %]
+    <tr valign="top">
+    <td><strong><a href="http://hackerpublicradio.org/eps.php?id=[% row.eps_id %]" target="_blank">[% row.eps_id %]</a></strong></td>
+    <td>[% date.format(row.date,'%a') %]</td>
+    <td>[% date.format(row.date,'%Y-%m-%d') %]</td>
+    <td><a href="http://hackerpublicradio.org/eps.php?id=[% row.eps_id %]" target="_blank">[% row.title %]</a></td>
+    <td><a href="[% correspondents %]?hostid=[% row.ho_hostid %]" target="_blank">[% row.ho_host FILTER html_entity %]</a></td>
+    </tr>
+    [%- END %]
+</table>
+
+[%- IF includefile.defined -%]
+<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="http://hackerpublicradio.org/maillist"
+target="_blank">Mail List</a> which is open to all HPR listeners and
+contributors. The discussions are open and available in the archives run
+externally by <a href="http://news.gmane.org/gmane.network.syndication.podcast.hacker-public-radio" target="_blank">Gmane</a>
+(see below) and on the HPR server under <a href="http://hackerpublicradio.org/pipermail/hpr_hackerpublicradio.org/">Mailman</a>.
+</p>
+<p><em>Note: since the summer of 2016 Gmane has changed location and is currently
+being reestablished. At the moment the HPR archive is not available there.</em></p>
+<p>The threaded discussions this month can be found here:</p>
+[% INCLUDE $includefile -%]
+[%- END %]
+
+[%# Skip comments if told to by the caller -%]
+[%- IF skip_comments == 0 -%]
+<h2>Comments this month</h2>
+
+[% IF comment_count > 0 -%]
+<p>These are comments which have been made during the past month, either to shows
+released during the month or to past shows.<br/>
+There [%- comment_count == 1 ? "is $comment_count comment" : "are $comment_count comments" -%] in total.</p>
+[% IF past_count > 0 -%]
+<p>There [% past_count == 1 ? "is $past_count comment" : "are $past_count comments" %] on
+[% past.size %] previous [% past.size == 1 ? "show" : "shows" %]:</p>
+<ul>
+[%- FOREACH ep IN past.keys.sort -%]
+[%- arr = past.$ep -%]
+<li><strong><a href="[% arr.0.identifier_url %]#comments" target="_blank">hpr[% arr.0.episode %]</a></strong>
+([% arr.0.date %]) "<em>[% arr.0.title %]</em>"
+by <a href="[% correspondents %]?hostid=[% arr.0.hostid %]" target="_blank">[% arr.0.host %]</a>.</li>
+<li style="list-style: none; display: inline">
+<ul>
+[%- FOREACH row IN arr -%]
+<li><a href="[% row.identifier_url %]#[% row.index %]" target="_blank">Comment [% row.index %]</a>:
+[% row.comment_author_name FILTER html_entity -%] on [% date.format(row.comment_timestamp,'%Y-%m-%d') -%]:
+[%- IF row.comment_title.length > 0 %]
+"[% row.comment_title FILTER html_entity %]"
+[%- ELSE -%]
+"[no title]"
+[%- END -%]
+</li>
+[%- END -%]
+</ul><br/>
+</li>
+[%- END -%]
+</ul>
+[%- END %]
+[%# ---------------------------------------------------------------------------------------- -%]
+[% cc = (comment_count - past_count) -%]
+[% IF cc > 0 -%]
+<p>There [% cc == 1 ? "is $cc comment" : "are $cc comments" %] on [% current.size %] of this month's shows:</p>
+<ul>
+[%- FOREACH ep IN current.keys.sort -%]
+[%- arr = current.$ep -%]
+<li><strong><a href="[% arr.0.identifier_url %]#comments" target="_blank">hpr[% arr.0.episode %]</a></strong>
+([% arr.0.date %]) "<em>[% arr.0.title %]</em>"
+by <a href="[% correspondents %]?hostid=[% arr.0.hostid %]" target="_blank">[% arr.0.host %]</a>.</li>
+<li style="list-style: none; display: inline">
+<ul>
+[%- FOREACH row IN arr -%]
+<li><a href="[% row.identifier_url %]#[% row.index %]" target="_blank">Comment [% row.index %]</a>:
+[% row.comment_author_name FILTER html_entity -%] on [% date.format(row.comment_timestamp,'%Y-%m-%d') -%]:
+[%- IF row.comment_title.length > 0 %]
+"[% row.comment_title FILTER html_entity %]"
+[%- ELSE -%]
+"[no title]"
+[%- END -%]
+</li>
+[%- END -%]
+</ul><br/>
+</li>
+[%- END -%]
+</ul>
+[%- END %]
+[%- ELSE %]
+There were no comments this month.
+[%- END %]
+[%- END %]
+[%#
+  # vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]
+

Community_News/shownote_template8.tpl

@@ -0,0 +1,164 @@
+[%# shownote_template8.tpl 2017-09-10 -%]
+[%# HTML snippet for insertion into the database -%]
+[%# This one uses the new format for the mailing list data, and partitions -%]
+[%# comments into past and current. It also marks comments that don't need -%]
+[%# to be read when -markcomments is selected. It requires make_shownotes > V0.0.22 -%]
+[%- USE date -%]
+[%- prefix = "http://hackerpublicradio.org"
+    correspondents = "$prefix/correspondents.php"
+    mailthreads = "$prefix/pipermail/hpr_hackerpublicradio.org/$review_year-$review_month/thread.html" -%]
+[%- DEFAULT skip_comments = 0
+    mark_comments = 0 -%]
+[%- IF mark_comments == 1 %]
+<style>
+p#ignore, li#ignore {
+    background-color: lightgreen;
+    color:maroon;
+    }
+</style>
+[%- END %]
+[%# For the '-mailnotes' option without a file we generate our own inclusion. -%]
+[%# We pretend 'default_mail' is a filename in the calling script. Messy.     -%]
+[% BLOCK default_mail -%]
+<a href="[% mailthreads %]" target="_blank">[% mailthreads %]</a>
+[% END -%]
+
+<h2>New hosts</h2>
+<p>
+[% IF hosts.size > 0 -%]
+Welcome to our new host[%- hosts.size > 1 ? 's' : '' -%]: <br />
+[%- count = 0 %]
+[%# List the new hosts. If a name contains a comma quote it.                  -%]
+[%- FOREACH row IN hosts %]
+    [%- count = count + 1 %]
+    [%- hostname = (row.host.search(',') ? row.host.replace('^(.*)$','"$1"') : row.host) %]
+    <a href="[% correspondents %]?hostid=[% row.hostid %]" target="_blank">[% hostname %]</a>
+    [%- count < hosts.size ? ', ' : '.' %]
+[%- END %]
+[% ELSE -%]
+There were no new hosts this month.
+[% END -%]
+</p>
+
+<h2>Last Month's Shows</h2>
+[%# The 'summary' attribute is deprecated in HTML5 but is included here to      -%]
+[%# prevent errors being reported in the note checker                           -%]
+<table id="t01" summary="Last month's shows">
+    <tr>
+    <th>Id</th>
+    <th>Day</th>
+    <th>Date</th>
+    <th>Title</th>
+    <th>Host</th>
+    </tr>
+    [%- FOREACH row IN shows %]
+    <tr valign="top">
+    <td><strong><a href="http://hackerpublicradio.org/eps.php?id=[% row.eps_id %]" target="_blank">[% row.eps_id %]</a></strong></td>
+    <td>[% date.format(row.date,'%a') %]</td>
+    <td>[% date.format(row.date,'%Y-%m-%d') %]</td>
+    <td><a href="http://hackerpublicradio.org/eps.php?id=[% row.eps_id %]" target="_blank">[% row.title %]</a></td>
+    <td><a href="[% correspondents %]?hostid=[% row.ho_hostid %]" target="_blank">[% row.ho_host FILTER html_entity %]</a></td>
+    </tr>
+    [%- END %]
+</table>
+
+[%- IF includefile.defined -%]
+<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="http://hackerpublicradio.org/maillist"
+target="_blank">Mail List</a> which is open to all HPR listeners and
+contributors. The discussions are open and available in the archives run
+externally by <a href="http://news.gmane.org/gmane.network.syndication.podcast.hacker-public-radio" target="_blank">Gmane</a>
+(see below) and on the HPR server under <a href="http://hackerpublicradio.org/pipermail/hpr_hackerpublicradio.org/">Mailman</a>.
+</p>
+<p><em>Note: since the summer of 2016 Gmane has changed location and is currently
+being reestablished. At the moment the HPR archive is not available there.</em></p>
+<p>The threaded discussions this month can be found here:</p>
+[% INCLUDE $includefile -%]
+[%- END %]
+
+[%# Skip comments if told to by the caller -%]
+[%- IF skip_comments == 0 -%]
+<h2>Comments this month</h2>
+
+[% IF comment_count > 0 -%]
+[%- IF mark_comments == 1 -%]
+<p id="ignore"><b>Note to Volunteers</b>: Comments marked in green were read in the last
+Community News show and should be ignored in this one.</p>
+[%- END -%]
+<p>These are comments which have been made during the past month, either to shows
+released during the month or to past shows.<br/>
+There [%- comment_count == 1 ? "is $comment_count comment" : "are $comment_count comments" -%] in total.</p>
+[% IF past_count > 0 -%]
+<p>There [% past_count == 1 ? "is $past_count comment" : "are $past_count comments" %] on
+[% past.size %] previous [% past.size == 1 ? "show" : "shows" %]:</p>
+<ul>
+[%- FOREACH ep IN past.keys.sort -%]
+[%- arr = past.$ep -%]
+<li><strong><a href="[% arr.0.identifier_url %]#comments" target="_blank">hpr[% arr.0.episode %]</a></strong>
+([% arr.0.date %]) "<em>[% arr.0.title %]</em>"
+by <a href="[% correspondents %]?hostid=[% arr.0.hostid %]" target="_blank">[% arr.0.host %]</a>.</li>
+<li style="list-style: none; display: inline">
+<ul>
+[%- FOREACH row IN arr -%]
+[%- IF mark_comments == 1 && (row.comment_timestamp_ut <= last_recording) -%]
+<li id="ignore">
+[%- ELSE %]
+<li>
+[%- END %]
+<a href="[% row.identifier_url %]#[% row.index %]" target="_blank">Comment [% row.index %]</a>:
+[% row.comment_author_name FILTER html_entity -%] on [% date.format(row.comment_timestamp_ut,'%Y-%m-%d') -%]:
+[%- IF row.comment_title.length > 0 %]
+"[% row.comment_title FILTER html_entity %]"
+[%- ELSE -%]
+"[no title]"
+[%- END -%]
+</li>
+[%- END -%]
+</ul><br/>
+</li>
+[%- END -%]
+</ul>
+[%- END %]
+[%# ---------------------------------------------------------------------------------------- -%]
+[% cc = (comment_count - past_count) -%]
+[% IF cc > 0 -%]
+<p>There [% cc == 1 ? "is $cc comment" : "are $cc comments" %] on [% current.size %] of this month's shows:</p>
+<ul>
+[%- FOREACH ep IN current.keys.sort -%]
+[%- arr = current.$ep -%]
+<li><strong><a href="[% arr.0.identifier_url %]#comments" target="_blank">hpr[% arr.0.episode %]</a></strong>
+([% arr.0.date %]) "<em>[% arr.0.title %]</em>"
+by <a href="[% correspondents %]?hostid=[% arr.0.hostid %]" target="_blank">[% arr.0.host %]</a>.</li>
+<li style="list-style: none; display: inline">
+<ul>
+[%- FOREACH row IN arr -%]
+<li><a href="[% row.identifier_url %]#[% row.index %]" target="_blank">Comment [% row.index %]</a>:
+[% row.comment_author_name FILTER html_entity -%] on [% date.format(row.comment_timestamp,'%Y-%m-%d') -%]:
+[%- IF row.comment_title.length > 0 %]
+"[% row.comment_title FILTER html_entity %]"
+[%- ELSE -%]
+"[no title]"
+[%- END -%]
+</li>
+[%- END -%]
+</ul><br/>
+</li>
+[%- END -%]
+</ul>
+[%- END %]
+[%- ELSE %]
+There were no comments this month.
+[%- END %]
+[%- END %]
+[%# ---------------------------------------------------------------------------------------- -%]
+[%# Any other business? -%]
+[% IF aob == 1 -%]
+<h2>Any other business</h2>
+[% INCLUDE $aobfile -%]
+[%- END %]
+[%#
+  # vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]
+

Community_News/shownote_template9.tpl

@@ -0,0 +1,164 @@
+[%# shownote_template9.tpl 2017-12-20 -%]
+[%# HTML snippet for insertion into the database -%]
+[%# This one uses the new format for the mailing list data, and partitions -%]
+[%# comments into past and current. It also marks comments that don't need -%]
+[%# to be read when -markcomments is selected. It requires make_shownotes > V0.0.22 -%]
+[%- USE date -%]
+[%- prefix = "http://hackerpublicradio.org"
+    correspondents = "$prefix/correspondents.php"
+    mailthreads = "$prefix/pipermail/hpr_hackerpublicradio.org/$review_year-$review_month/thread.html" -%]
+[%- DEFAULT skip_comments = 0
+    mark_comments = 0 -%]
+[%- IF mark_comments == 1 %]
+<style>
+p#ignore, li#ignore {
+    background-color: lightgreen;
+    color:maroon;
+    }
+</style>
+[%- END %]
+[%# For the '-mailnotes' option without a file we generate our own inclusion. -%]
+[%# We pretend 'default_mail' is a filename in the calling script. Messy.     -%]
+[% BLOCK default_mail -%]
+<a href="[% mailthreads %]" target="_blank">[% mailthreads %]</a>
+[% END -%]
+
+<h2>New hosts</h2>
+<p>
+[% IF hosts.size > 0 -%]
+Welcome to our new host[%- hosts.size > 1 ? 's' : '' -%]: <br />
+[%- count = 0 %]
+[%# List the new hosts. If a name contains a comma quote it.                  -%]
+[%- FOREACH row IN hosts %]
+    [%- count = count + 1 %]
+    [%- hostname = (row.host.search(',') ? row.host.replace('^(.*)$','"$1"') : row.host) %]
+    <a href="[% correspondents %]?hostid=[% row.hostid %]" target="_blank">[% hostname %]</a>
+    [%- count < hosts.size ? ', ' : '.' %]
+[%- END %]
+[% ELSE -%]
+There were no new hosts this month.
+[% END -%]
+</p>
+
+<h2>Last Month's Shows</h2>
+[%# The 'summary' attribute is deprecated in HTML5 but is included here to      -%]
+[%# prevent errors being reported in the note checker                           -%]
+<table id="t01" summary="Last month's shows">
+    <tr>
+    <th>Id</th>
+    <th>Day</th>
+    <th>Date</th>
+    <th>Title</th>
+    <th>Host</th>
+    </tr>
+    [%- FOREACH row IN shows %]
+    <tr valign="top">
+    <td><strong><a href="http://hackerpublicradio.org/eps.php?id=[% row.eps_id %]" target="_blank">[% row.eps_id %]</a></strong></td>
+    <td>[% date.format(row.date,'%a') %]</td>
+    <td>[% date.format(row.date,'%Y-%m-%d') %]</td>
+    <td><a href="http://hackerpublicradio.org/eps.php?id=[% row.eps_id %]" target="_blank">[% row.title %]</a></td>
+    <td><a href="[% correspondents %]?hostid=[% row.ho_hostid %]" target="_blank">[% row.ho_host FILTER html_entity %]</a></td>
+    </tr>
+    [%- END %]
+</table>
+
+[%# ---------------------------------------------------------------------------------------- -%]
+[%# Skip comments if told to by the caller -%]
+[%- IF skip_comments == 0 -%]
+<h2>Comments this month</h2>
+
+[% IF comment_count > 0 -%]
+[%- IF mark_comments == 1 -%]
+<p id="ignore"><b>Note to Volunteers</b>: Comments marked in green were read in the last
+Community News show and should be ignored in this one.</p>
+[%- END -%]
+<p>These are comments which have been made during the past month, either to shows
+released during the month or to past shows.<br/>
+There [%- comment_count == 1 ? "is $comment_count comment" : "are $comment_count comments" -%] in total.</p>
+[% IF past_count > 0 -%]
+<p>There [% past_count == 1 ? "is $past_count comment" : "are $past_count comments" %] on
+[% past.size %] previous [% past.size == 1 ? "show" : "shows" %]:</p>
+<ul>
+[%- FOREACH ep IN past.keys.sort -%]
+[%- arr = past.$ep -%]
+<li><strong><a href="[% arr.0.identifier_url %]#comments" target="_blank">hpr[% arr.0.episode %]</a></strong>
+([% arr.0.date %]) "<em>[% arr.0.title %]</em>"
+by <a href="[% correspondents %]?hostid=[% arr.0.hostid %]" target="_blank">[% arr.0.host %]</a>.</li>
+<li style="list-style: none; display: inline">
+<ul>
+[%- FOREACH row IN arr -%]
+[%- IF mark_comments == 1 && (row.comment_timestamp_ut <= last_recording) -%]
+<li id="ignore">
+[%- ELSE %]
+<li>
+[%- END %]
+<a href="[% row.identifier_url %]#[% row.index %]" target="_blank">Comment [% row.index %]</a>:
+[% row.comment_author_name FILTER html_entity -%] on [% date.format(row.comment_timestamp_ut,'%Y-%m-%d') -%]:
+[%- IF row.comment_title.length > 0 %]
+"[% row.comment_title FILTER html_entity %]"
+[%- ELSE -%]
+"[no title]"
+[%- END -%]
+</li>
+[%- END -%]
+</ul><br/>
+</li>
+[%- END -%]
+</ul>
+[%- END %]
+[%# ---------------------------------------------------------------------------------------- -%]
+[% cc = (comment_count - past_count) -%]
+[% IF cc > 0 -%]
+<p>There [% cc == 1 ? "is $cc comment" : "are $cc comments" %] on [% current.size %] of this month's shows:</p>
+<ul>
+[%- FOREACH ep IN current.keys.sort -%]
+[%- arr = current.$ep -%]
+<li><strong><a href="[% arr.0.identifier_url %]#comments" target="_blank">hpr[% arr.0.episode %]</a></strong>
+([% arr.0.date %]) "<em>[% arr.0.title %]</em>"
+by <a href="[% correspondents %]?hostid=[% arr.0.hostid %]" target="_blank">[% arr.0.host %]</a>.</li>
+<li style="list-style: none; display: inline">
+<ul>
+[%- FOREACH row IN arr -%]
+<li><a href="[% row.identifier_url %]#[% row.index %]" target="_blank">Comment [% row.index %]</a>:
+[% row.comment_author_name FILTER html_entity -%] on [% date.format(row.comment_timestamp_ut,'%Y-%m-%d') -%]:
+[%- IF row.comment_title.length > 0 %]
+"[% row.comment_title FILTER html_entity %]"
+[%- ELSE -%]
+"[no title]"
+[%- END -%]
+</li>
+[%- END -%]
+</ul><br/>
+</li>
+[%- END -%]
+</ul>
+[%- END %]
+[%- ELSE %]
+There were no comments this month.
+[%- END %]
+[%- END %]
+
+[%# ---------------------------------------------------------------------------------------- -%]
+[%- IF includefile.defined -%]
+<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="http://hackerpublicradio.org/maillist"
+target="_blank">Mail List</a> which is open to all HPR listeners and
+contributors. The discussions are open and available on the HPR server under
+<a href="http://hackerpublicradio.org/pipermail/hpr_hackerpublicradio.org/">Mailman</a>.
+</p>
+<p>The threaded discussions this month can be found here:</p>
+[% INCLUDE $includefile -%]
+[%- END %]
+
+[%# ---------------------------------------------------------------------------------------- -%]
+[%# Any other business? -%]
+[% IF aob == 1 -%]
+<h2>Any other business</h2>
+[% INCLUDE $aobfile -%]
+[%- END %]
+[%#
+  # vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]
+

Community_News/tag_contributors.tpl

@@ -0,0 +1,44 @@
+[%# tag_contributors.tpl
+    A file to contain tag/summary contributor data. Made as a separate file to
+    be invoked with a PROCESS directive in the main Markdown file. If the
+    statements are placed there they look like some kind of Markdown stuff and
+    mess up Vim's formatting.
+-%]
+[% MACRO host(id) GET "http://hackerpublicradio.org/correspondents.php?hostid=$id" -%]
+[% kenfallon = host(30) -%]
+[% windigo = host(215) -%]
+[% perloid = host(225) -%]
+[% nybill = host(235) -%]
+[% tonyhughes = host(338) -%]
+[% bjb = host(357) -%]
+[% ahuka = host(198) -%]
+[% baffled = "Kirk Reiser" -%]
+[% claudiom = host(152) -%]
+[% archer72 = host(318) -%]
+[% crvs = host(385) -%]
+[% danielpersson = host(382) -%]
+[% roan = host(293) -%]
+[%# NOTE: Add variables as '$var' -%]
+[% contributors = [
+    "[Archer72]($archer72)"
+    "[Rho`n]($roan)"
+]
+-%]
+[% everyone = [
+    "[Ahuka]($ahuka)"
+    "[archer72]($archer72)"
+    "[bjb]($bjb)"
+    "[ClaudioM]($claudiom)"
+    "[crvs]($crvs)"
+    "[Daniel Persson]($danielpersson)"
+    "[Dave Morriss]($perloid)"
+    "[Ken Fallon]($kenfallon)"
+    "[Kirk Reiser]($baffled)"
+    "[NYbill]($nybill)"
+    "[Rho`n]($roan)"
+    "[Tony Hughes]($tonyhughes)"
+    "[Windigo]($windigo)"
+
+]
+-%]
+

Database/.find_series.yml

@@ -0,0 +1,230 @@
+ignore:
+  - 'aka'
+  - 'all'
+  - 'amp'
+  - 'an'
+  - 'and'
+  - 'app'
+  - 'are'
+  - 'art'
+  - 'as'
+  - 'at'
+  - 'ayn'
+  - 'bad'
+  - 'bag'
+  - 'bbs'
+  - 'be'
+  - 'ben'
+  - 'big'
+  - 'bit'
+  - 'box'
+  - 'bug'
+  - 'by'
+  - 'car'
+  - 'cd'
+  - 'cje'
+  - 'cu'
+  - 'cut'
+  - 'dad'
+  - 'dan'
+  - 'day'
+  - 'do'
+  - 'doe'
+  - 'dso'
+  - 'ec'
+  - 'ed'
+  - 'eee'
+  - 'egg'
+  - 'eol'
+  - 'ep'
+  - 'era'
+  - 'eve'
+  - 'fab'
+  - 'fav'
+  - 'feb'
+  - 'fix'
+  - 'for'
+  - 'fun'
+  - 'gd'
+  - 'gen'
+  - 'get'
+  - 'gmc'
+  - 'go'
+  - 'got'
+  - 'gsm'
+  - 'guy'
+  - 'har'
+  - 'has'
+  - 'his'
+  - 'how'
+  - 'hpr'
+  - 'ian'
+  - 'ilf'
+  - 'im'
+  - 'in'
+  - 'ink'
+  - 'ip'
+  - 'ipv'
+  - 'is'
+  - 'it'
+  - 'its'
+  - 'jan'
+  - 'jon'
+  - 'jwp'
+  - 'ken'
+  - 'la'
+  - 'lee'
+  - 'lot'
+  - 'low'
+  - 'lug'
+  - 'man'
+  - 'map'
+  - 'may'
+  - 'me'
+  - 'mf'
+  - 'mod'
+  - 'mp'
+  - 'mrs'
+  - 'my'
+  - 'new'
+  - 'nix'
+  - 'no'
+  - 'non'
+  - 'not'
+  - 'now'
+  - 'of'
+  - 'off'
+  - 'oh'
+  - 'old'
+  - 'on'
+  - 'one'
+  - 'or'
+  - 'os'
+  - 'oss'
+  - 'ota'
+  - 'our'
+  - 'out'
+  - 'own'
+  - 'pam'
+  - 'pat'
+  - 'pay'
+  - 'pc'
+  - 'pe'
+  - 'pis'
+  - 'pre'
+  - 'prn'
+  - 'pt'
+  - 'qsk'
+  - 'rds'
+  - 'rf'
+  - 'rfa'
+  - 'rm'
+  - 'rob'
+  - 'run'
+  - 'rxy'
+  - 'sap'
+  - 'sdf'
+  - 'set'
+  - 'sex'
+  - 'sfl'
+  - 'sfs'
+  - 'she'
+  - 'sky'
+  - 'so'
+  - 'son'
+  - 'tab'
+  - 'tag'
+  - 'ted'
+  - 'th'
+  - 'the'
+  - 'tip'
+  - 'to'
+  - 'tom'
+  - 'too'
+  - 'tv'
+  - 'two'
+  - 'up'
+  - 'us'
+  - 'use'
+  - 'van'
+  - 'vol'
+  - 'vs'
+  - 'war'
+  - 'way'
+  - 'we'
+  - 'wep'
+  - 'who'
+  - 'why'
+  - 'win'
+  - 'wow'
+  - 'wtf'
+  - 'xd'
+  - 'xdc'
+  - 'xgo'
+  - 'xp'
+  - 'you'
+  - 'with'
+  - '--'
+  - '--tz'
+  - 'updating'
+  - 'hosts'
+  - 'future'
+  - 'favorite'
+  - 'making'
+  - 'screen'
+  - 'should'
+  - 'next'
+  - 'word'
+  - 'city'
+  - 'others'
+  - 'some'
+  - 'needs'
+  - 'other'
+  - 'call'
+  - 'alternative'
+  - 'road'
+  - 'month'
+  - 'july'
+  - 'care'
+  - 'quick'
+  - 'pt.'
+  - 'over'
+  - 'under'
+  - 'made'
+  - 'without'
+  - '//'
+  - 'more'
+  - 'when'
+  - 'p-'
+  - 'behind'
+  - 'using'
+  - 'after'
+  - 'about'
+  - 'part'
+  - 'show'
+  - 'public'
+  - 'from'
+  - 'your'
+  - 'this'
+  - 'david'
+  - 'tony'
+  - 'chris'
+  - 'jonathan'
+  - 'kulp'
+  - 'john'
+  - 'klaatu'
+  - 'into'
+  - 'whitman'
+  - 'pokey'
+  - 'xokes'
+  - 'drachenblut'
+  - 'scott'
+  - 'nybill'
+  - 'conder'
+  - 'jake'
+  - 'leclanche'
+  - 'stuart'
+  - 'they'
+  - 'josh'
+  - 'jezra'
+  - 'smith'

Database/clean_csv_tags

@@ -0,0 +1,324 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: clean_csv_tags
+#
+#        USAGE: ./clean_csv_tags
+#
+#  DESCRIPTION: Make sure tags in the eps.tags field of the HPR database
+#               conform to CSV format.
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.2
+#      CREATED: 2017-01-30 15:32:04
+#     REVISION: 2019-10-06 21:50:52
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use Carp;
+use Getopt::Long;
+use Config::General;
+use Text::CSV_XS;
+use List::MoreUtils qw{uniq};
+use SQL::Abstract;
+use DBI;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.2';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.cfg";
+
+my ( $dbh, $sth1, $h1, $rv );
+my ( %eps_tags, %diffs );
+my $status;
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#-------------------------------------------------------------------------------
+# Options and arguments
+#-------------------------------------------------------------------------------
+#
+# Process options
+#
+my %options;
+Options( \%options );
+
+Usage() if ( $options{'help'} );
+
+#
+# Collect options
+#
+my $cfgfile
+    = ( defined( $options{config} ) ? $options{config} : $configfile );
+
+my $aq      = ( defined( $options{aq} )        ? $options{aq}        : 0 );
+my $verbose = ( defined( $options{verbose} )   ? $options{verbose}   : 0 );
+my $dry_run = ( defined( $options{'dry-run'} ) ? $options{'dry-run'} : 1 );
+
+#
+# Load configuration data
+#
+my $conf = new Config::General(
+    -ConfigFile      => $cfgfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or croak $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+#-------------------------------------------------------------------------------
+# Collect and process the id numbers and tags from the 'eps' table
+#-------------------------------------------------------------------------------
+%eps_tags = %{ collect_eps_tags( $dbh ) };
+
+#
+# Dump all id numbers and tags if the verbose level is high enough
+#
+if ( $verbose >= 2 ) {
+    my $csv = Text::CSV_XS->new( { always_quote => $aq } );
+
+    print "\nTags collected from the 'eps' table\n\n";
+    foreach my $id ( sort { $a <=> $b } keys(%eps_tags) ) {
+        $status = $csv->combine( @{ $eps_tags{$id} } );
+        printf "%04d: %s\n", $id, $csv->string();
+    }
+}
+
+if ($dry_run) {
+    print "\nNo changes made, dry-run mode\n";
+    exit;
+}
+
+#-------------------------------------------------------------------------------
+# Turn all the saved and cleaned tags into CSV strings again and save them
+# back to the database. TODO: find differences and only write those back
+#-------------------------------------------------------------------------------
+#
+# Force quoting everywhere
+#
+my $csv = Text::CSV_XS->new( { always_quote => $aq } );
+
+#
+# Loop through the hash in order of show number
+#
+for my $id ( sort keys %eps_tags ) {
+    #
+    # Put the array fields back together
+    #
+    $status = $csv->combine( @{ $eps_tags{$id} } );
+
+    #
+    # Write them to the database
+    #
+    $dbh->do( q{UPDATE eps SET tags = ? WHERE id = ?},
+        undef, $csv->string(), $id );
+    if ( $dbh->err ) {
+        warn $dbh->errstr;
+    }
+
+}
+
+exit;
+
+#===  FUNCTION  ================================================================
+#         NAME: collect_eps_tags
+#      PURPOSE: Collects the tags from the eps.tags field
+#   PARAMETERS: $dbh            Database handle
+#      RETURNS: A reference to the hash created by collecting all the tags
+#  DESCRIPTION: Read the 'id' and tags' fields from the database. Parse the
+#               tags as CSV data, flagging any errors. Trim each one and store
+#               them in a hash keyed on the id number. The list of tags is
+#               stored as an array in sorted order after ensuring there are
+#               no duplicates.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub collect_eps_tags {
+    my ( $dbh ) = @_;
+
+    my ( $status, @fields, %hash );
+    my ( $sth,    $h );
+
+    #
+    # For parsing the field as CSV
+    # NOTE: Unexplained error in [E. E. "Doc" Smith] (show 2462). Works with
+    # double replaced by single quote, but doesn't work if quotes escaped (by
+    # doubling) whether all tags are quoted or not. With 'auto_diag' enabled
+    # get the error:
+    # CSV_XS ERROR: 2034 - EIF - Loose unescaped quote @ rec 1632 pos 40 field 3
+    #
+    # NOTE: Adding 'allow_loose_quotes' avoids the issue
+    #
+    my $csv = Text::CSV_XS->new(
+        { binary => 1, auto_diag => 1, allow_loose_quotes => 1 } );
+
+    #
+    # Query the eps table for all the id and tags
+    #
+    $sth = $dbh->prepare(
+        q{SELECT id,tags FROM eps
+            WHERE length(tags) > 0
+            ORDER BY id}
+    ) or die $DBI::errstr;
+    if ( $dbh->err ) {
+        warn $dbh->errstr;
+    }
+
+    $sth->execute;
+    if ( $dbh->err ) {
+        warn $dbh->errstr;
+    }
+
+    #
+    # Loop through what we got
+    #
+    while ( $h = $sth->fetchrow_hashref ) {
+        #
+        # Parse the tag list
+        #
+        $status = $csv->parse( $h->{tags} );
+        unless ($status) {
+            #
+            # Report and skip any errors
+            #
+            print "Parse error on episode ", $h->{id}, "\n";
+            print $csv->error_input(), "\n";
+            next;
+        }
+        @fields = $csv->fields();
+
+        next unless (@fields);
+
+        #
+        # Trim all tags (don't alter $_ when doing it)
+        #
+        @fields = map {
+            my $t = $_;
+            $t =~ s/(^\s+|\s+$)//g;
+            $t;
+        } @fields;
+
+        #
+        # De-duplicate
+        #
+        @fields = uniq(@fields);
+
+        #print "$h->{id}: ",join(",",@fields),"\n";
+
+        #
+        # Save the id and its tags, sorted for comparison, with empty elements
+        # removed too
+        #
+        $hash{ $h->{id} } = [ sort grep {!/^$/} @fields ];
+
+    }
+
+    #print Dumper(\%hash),"\n";
+
+    return \%hash;
+
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: Usage
+#      PURPOSE: Display a usage message and exit
+#   PARAMETERS: None
+#      RETURNS: To command line level with exit value 1
+#  DESCRIPTION: Builds the usage message using global values
+#       THROWS: no exceptions
+#     COMMENTS: none
+#     SEE ALSO: n/a
+#===============================================================================
+sub Usage {
+    print STDERR <<EOD;
+Usage: $PROG [options] project
+
+$PROG v$VERSION
+
+    -help               Display this information
+    -config=FILE        Define an alternative configuration file (e.g. that
+                        for the live database)
+    -[no]aq             Turn on/off the 'always_quote' setting in Text::CSV_XS,
+                        Default is off (0)
+    -[no]dry-run        Display what would have been done but make no changes.
+                        Default is -dry-run.
+    -verbose            A repeatable option which turns up the verbosity from
+                        0 (silent) to 2 (lots of stuff). Default is 0.
+
+EOD
+    exit(1);
+}
+
+#===  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", "verbose+", "dry-run!", "config=s", "aq!", );
+
+    if ( !GetOptions( $optref, @options ) ) {
+        Usage();
+    }
+
+    return;
+}
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
+

Database/convert_latin1

@@ -0,0 +1,657 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: convert_latin1
+#
+#        USAGE: ./convert_latin1 [-help] [-doc] [-config=FILE] [-debug=N]
+#
+#  DESCRIPTION: Find and convert 'latin1' characters to 'utf8' in the HPR
+#               database
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.1.2
+#      CREATED: 2023-05-04 10:07:04
+#     REVISION: 2023-05-08 12:15:49
+#
+#===============================================================================
+
+use v5.16;
+use strict;
+use warnings;
+#use utf8;
+
+# Using experimental features, some of which require warnings to be turned off
+use feature qw{ postderef say signatures state try };
+no warnings qw{
+    experimental::postderef
+    experimental::signatures
+    experimental::try
+};
+
+use Getopt::Long;
+use Pod::Usage;
+
+use Config::General;
+
+#use Encode qw( encode decode is_utf8 );
+#use Try::Tiny;
+#use TryCatch;
+
+use SQL::Abstract;
+use DBI;
+
+use Log::Handler;
+use Log::Handler::Output::File;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.1.2';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.cfg";
+my $logfile    = "$basedir/${PROG}.log";
+
+my ( $dbh, $sth1, $sth2, $h1 );
+my ( $sql, $utf8, $viewed );
+
+#
+# Map of latin1 characters with their Unicode equivalents {{{
+#
+# Commented out 2023-05-10 since no longer wanted
+#
+#my %map_latin1 = (
+#    q{€â‚¬}  => "\N{U+20AC}",
+#    q{ÀÀ}   => "\N{U+00C0}",
+#    q{ÁÃ}    => "\N{U+00C1}",
+#    q{‚‚}  => "\N{U+201A}",
+#    q{ÂÂ}   => "\N{U+00C2}",
+#    q{ƒÆ’}   => "\N{U+0192}",
+#    q{ÃÃ}   => "\N{U+00C3}",
+#    q{„„}  => "\N{U+201E}",
+#    q{ÄÄ}   => "\N{U+00C4}",
+#    q{……}  => "\N{U+2026}",
+#    q{ÅÃ…}   => "\N{U+00C5}",
+#    q{†â€}   => "\N{U+2020}",
+#    q{ÆÆ}   => "\N{U+00C6}",
+#    q{‡â€¡}  => "\N{U+2021}",
+#    q{ÇÇ}   => "\N{U+00C7}",
+#    q{ˆË†}   => "\N{U+02C6}",
+#    q{ÈÈ}   => "\N{U+00C8}",
+#    q{‰â€°}  => "\N{U+2030}",
+#    q{ÉÉ}   => "\N{U+00C9}",
+#    q{ŠÅ}    => "\N{U+0160}",
+#    q{ÊÊ}   => "\N{U+00CA}",
+#    q{‹â€¹}  => "\N{U+2039}",
+#    q{ËË}   => "\N{U+00CB}",
+#    q{ŒÅ’}   => "\N{U+0152}",
+#    q{ÌÃŒ}   => "\N{U+00CC}",
+#    q{ÍÃ}    => "\N{U+00CD}",
+#    q{ŽÅ½}   => "\N{U+017D}",
+#    q{ÎÃŽ}   => "\N{U+00CE}",
+#    q{ÏÃ}    => "\N{U+00CF}",
+#    q{ÐÃ}    => "\N{U+00D0}",
+#    q{‘‘}  => "\N{U+2018}",
+#    q{ÑÑ}   => "\N{U+00D1}",
+#    q{Չ۪}  => "\N{U+2019}",
+#    q{ÒÃ’}   => "\N{U+00D2}",
+#    q{““}  => "\N{U+201C}",
+#    q{ÓÓ}   => "\N{U+00D3}",
+#    q{”â€}   => "\N{U+201D}",
+#    q{ÔÔ}   => "\N{U+00D4}",
+#    q{•â€¢}  => "\N{U+2022}",
+#    q{ÕÕ}   => "\N{U+00D5}",
+#    q{––}  => "\N{U+2013}",
+#    q{ÖÖ}   => "\N{U+00D6}",
+#    q{——}  => "\N{U+2014}",
+#    q{××}   => "\N{U+00D7}",
+#    q{˜Ëœ}   => "\N{U+02DC}",
+#    q{ØØ}   => "\N{U+00D8}",
+#    q{™â„¢}  => "\N{U+2122}",
+#    q{ÙÙ}   => "\N{U+00D9}",
+#    q{šÅ¡}   => "\N{U+0161}",
+#    q{ÚÚ}   => "\N{U+00DA}",
+#    q{݉ۼ}  => "\N{U+203A}",
+#    q{ÛÛ}   => "\N{U+00DB}",
+#    q{œÅ“}   => "\N{U+0153}",
+#    q{ÜÃœ}   => "\N{U+00DC}",
+#    q{ÝÃ}    => "\N{U+00DD}",
+#    q{žÅ¾}   => "\N{U+017E}",
+#    q{ÞÞ}   => "\N{U+00DE}",
+#    q{ŸÅ¸}   => "\N{U+0178}",
+#    q{ßß}   => "\N{U+00DF}",
+#    q{Â}     => "\N{U+00A0}",
+#    q{àÃ}    => "\N{U+00E0}",
+#    q{¡Â¡}   => "\N{U+00A1}",
+#    q{áá}   => "\N{U+00E1}",
+#    q{¢Â¢}   => "\N{U+00A2}",
+#    q{ââ}   => "\N{U+00E2}",
+#    q{£Â£}   => "\N{U+00A3}",
+#    q{ãã}   => "\N{U+00E3}",
+#    q{¤Â¤}   => "\N{U+00A4}",
+#    q{ää}   => "\N{U+00E4}",
+#    q{¥Â¥}   => "\N{U+00A5}",
+#    q{åÃ¥}   => "\N{U+00E5}",
+#    q{¦Â¦}   => "\N{U+00A6}",
+#    q{ææ}   => "\N{U+00E6}",
+#    q{§Â§}   => "\N{U+00A7}",
+#    q{çç}   => "\N{U+00E7}",
+#    q{¨Â¨}   => "\N{U+00A8}",
+#    q{èè}   => "\N{U+00E8}",
+#    q{©Â©}   => "\N{U+00A9}",
+#    q{éé}   => "\N{U+00E9}",
+#    q{ªÂª}   => "\N{U+00AA}",
+#    q{êê}   => "\N{U+00EA}",
+#    q{«Â«}   => "\N{U+00AB}",
+#    q{ëë}   => "\N{U+00EB}",
+#    q{¬Â¬}   => "\N{U+00AC}",
+#    q{ìì}   => "\N{U+00EC}",
+#    q{­Â­}   => "\N{U+00AD}",
+#    q{íí}   => "\N{U+00ED}",
+#    q{®Â®}   => "\N{U+00AE}",
+#    q{îî}   => "\N{U+00EE}",
+#    q{¯Â¯}   => "\N{U+00AF}",
+#    q{ïï}   => "\N{U+00EF}",
+#    q{°Â°}   => "\N{U+00B0}",
+#    q{ðð}   => "\N{U+00F0}",
+#    q{±Â±}   => "\N{U+00B1}",
+#    q{ññ}   => "\N{U+00F1}",
+#    q{²Â²}   => "\N{U+00B2}",
+#    q{òò}   => "\N{U+00F2}",
+#    q{³Â³}   => "\N{U+00B3}",
+#    q{óó}   => "\N{U+00F3}",
+#    q{´Â´}   => "\N{U+00B4}",
+#    q{ôô}   => "\N{U+00F4}",
+#    q{µÂµ}   => "\N{U+00B5}",
+#    q{õõ}   => "\N{U+00F5}",
+#    q{¶Â¶}   => "\N{U+00B6}",
+#    q{öö}   => "\N{U+00F6}",
+#    q{·Â·}   => "\N{U+00B7}",
+#    q{÷÷}   => "\N{U+00F7}",
+#    q{¸Â¸}   => "\N{U+00B8}",
+#    q{øø}   => "\N{U+00F8}",
+#    q{¹Â¹}   => "\N{U+00B9}",
+#    q{ùù}   => "\N{U+00F9}",
+#    q{ºÂº}   => "\N{U+00BA}",
+#    q{úú}   => "\N{U+00FA}",
+#    q{»Â»}   => "\N{U+00BB}",
+#    q{ûû}   => "\N{U+00FB}",
+#    q{¼Â¼}   => "\N{U+00BC}",
+#    q{üü}   => "\N{U+00FC}",
+#    q{½Â½}   => "\N{U+00BD}",
+#    q{ýý}   => "\N{U+00FD}",
+#    q{¾Â¾}   => "\N{U+00BE}",
+#    q{þþ}   => "\N{U+00FE}",
+#    q{¿Â¿}   => "\N{U+00BF}",
+#    q{ÿÿ}   => "\N{U+00FF}",
+#);
+
+#
+# Build a regex from all of the hash keys
+#
+#my $regex = join('|',sort(keys(%map_latin1)));
+#$regex=qr{$regex};
+
+#}}}
+
+#
+# Enable Unicode output mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#-------------------------------------------------------------------------------
+# Options and arguments {{{
+#-------------------------------------------------------------------------------
+#
+# Process options
+#
+my %options;
+Options( \%options );
+
+#
+# Default help
+#
+pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 )
+    if ( $options{'help'} );
+
+#
+# Full documentation if requested with -doc
+#
+pod2usage( -msg => "$PROG version $VERSION\n", -verbose => 2, -exitval => 1 )
+    if ( $options{'doc'} );
+
+#
+# Collect options
+#
+my $cfgfile
+    = ( defined( $options{config} ) ? $options{config} : $configfile );
+my $dry_run = ( defined( $options{'dry-run'} ) ? $options{'dry-run'} : 0 );
+my $verbose = ( defined( $options{verbose} )   ? $options{verbose}   : 0 );
+my $field   = $options{field};
+my $skip    = $options{skip} // 0;
+my $limit   = $options{limit} // 0;
+
+# }}}
+
+#
+# Sanity checks
+#
+die "Unable to find $cfgfile\n" unless ( -e $cfgfile );
+if ($field) {
+    $field = lc($field);
+    die "Invalid value for -field=FIELD\n"
+        unless ( $field =~ /title|summary|tags|notes/ );
+}
+else {
+    $field = 'title';
+}
+
+#-------------------------------------------------------------------------------
+# Load configuration data
+#-------------------------------------------------------------------------------
+my $conf = new Config::General(
+    -ConfigFile      => $cfgfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+#-------------------------------------------------------------------------------
+# Set up logging keeping the default log layout except for the date
+#-------------------------------------------------------------------------------
+my $log = Log::Handler->new();
+
+$log->add(
+    file => {
+        timeformat => "%Y-%m-%d %H:%M:%S",
+        filename   => $logfile,
+        maxlevel   => 7,
+        minlevel   => 0,
+        utf8       => 1,
+    }
+);
+
+#
+# Log the settings being used
+#
+$log->info("---- Running version $VERSION");
+$log->info("Configuration file $cfgfile");
+$log->info("Processing field '$field'");
+$log->info("Skipping $skip non-ASCII rows") if $skip;
+$log->info("Update limit is $limit") if $limit;
+$log->info("Dry-run mode") if ($dry_run);
+
+#
+# Adjust limit
+#
+$limit += $skip if $skip;
+
+#-------------------------------------------------------------------------------
+# Perform a scan of episodes for the chosen field which contains non-ASCII
+#-------------------------------------------------------------------------------
+$sql = sprintf(
+    q{SELECT id,%s FROM eps WHERE %s <> CONVERT(%s USING ASCII) ORDER BY id},
+    $field, $field, $field
+);
+
+$sth1 = $dbh->prepare($sql) or die $DBI::errstr;
+
+$sth1->execute;
+if ( $dbh->err ) {
+    warn $dbh->errstr;
+}
+
+#
+# Prepare SQL::Abstract and the SQL template for the updates
+#
+my $sqla = SQL::Abstract->new;
+
+my $stmt1 = sprintf(
+    q{UPDATE eps SET %s = CONVERT(BINARY CONVERT(%s USING latin1) USING utf8)},
+    $field, $field
+);
+
+#-------------------------------------------------------------------------------
+# Loop through what we get from the main query, attempting to convert each field
+#-------------------------------------------------------------------------------
+$viewed = 0;
+while ( $h1 = $sth1->fetchrow_hashref ) {
+    $viewed++;
+    next if $viewed <= $skip;
+
+    #
+    # Prepare the 'WHERE' part of the SQL
+    #
+    my %where = ( id => $h1->{id} );
+    my ( $stmt2, @bind ) = $sqla->where( \%where );
+    my $stmt = "${stmt1}${stmt2}";
+
+    #
+    # In dry-run mode just report what would have been done, otherwise try and
+    # make the change.
+    #
+    if ($dry_run) {
+        if ($verbose) {
+            printf "[%04d] %s\n", $h1->{id},
+                (
+                  $field eq 'notes'
+                ? ''
+                : $h1->{$field}
+                );
+        }
+
+        say "SQL: ${stmt}";
+        say "Arguments: ",join( ',', @bind );
+    }
+    else {
+        $sth2 = $dbh->prepare($stmt) or die $DBI::errstr;
+
+        #
+        # The SQL could generate an error which we'll try and intercept
+        #
+        try {
+            $sth2->execute(@bind)
+                or die $DBI::errstr;
+            $log->info("Updated $field field for row $h1->{id}");
+        }
+        catch ($e) {
+            $log->info("Failed to update $field field for row $h1->{id}");
+            $log->info("Error: $e");
+        }
+    }
+
+}
+continue {
+    if ($limit) {
+        if ($viewed >= $limit) {
+            $log->info("Update limit reached");
+            last;
+        };
+    }
+}
+
+exit;
+
+#===  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",     "doc",     "dry-run!", "verbose!",
+        "config=s", "field=s", "skip=i",   "limit=i",
+    );
+
+    if ( !GetOptions( $optref, @options ) ) {
+        pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 );
+    }
+
+    return;
+}
+
+__END__
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#  Application Documentation
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#{{{
+
+=head1 NAME
+
+convert_latin1 - a script to convert fields in the HPR database to UTF-8
+
+=head1 VERSION
+
+This documentation refers to convert_latin1 version 0.1.2
+
+
+=head1 USAGE
+
+    ./convert_latin1 [-help] [-doc] [-config=FILE] [-[no]dry-run]
+        [-[no]verbose] [-field=FIELDNAME] [-skip=N] [-limit=N]
+
+    ./convert_latin1 -config=.hpr_livedb.cfg -verb -field=title
+    ./convert_latin1 -config=.hpr_livedb.cfg -verb -dry-run -field=notes
+        -limit=10
+
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<-help>
+
+Prints a brief help message describing the usage of the program, and then exits.
+
+=item B<-doc>
+
+Displays the entirety of the documentation (using a pager), and then exits. To
+generate a PDF version use:
+
+    pod2pdf convert_latin1 --out=convert_latin1.pdf
+
+=item B<-config=FILE>
+
+This option allows an alternative configuration file to be used. This file
+defines the location of the database, its port, its name and the username and
+password to be used to access it. This feature was added to allow the script
+to access alternative databases or the live database over an SSH tunnel.
+
+See the CONFIGURATION AND ENVIRONMENT section below for the file format.
+
+If the option is omitted the default file is used: B<.hpr_db.cfg>
+
+=item B<-[no]dry-run>
+
+Controls whether the program runs in a mode where it performs database
+updates. When enabled the details of the updates to be performed are shown,
+otherwise the updates are applied. The default B<-nodry-run> allows the
+program to perform the changes.
+
+=item B<-[no]verbose>
+
+Normally very little is reported by the script, although details of errors
+are reported. When B<-verbose> is selected more information
+about the number of rows needing work, the updates performed (or which would
+have been performed) and how many changes were made is reported.
+
+=item B<-field=FIELDNAME>
+
+This option defines the database field name to be converted. The permitted
+names are B<title>, B<summary>, B<tags> and B<notes> and the table is asumed
+to be B<eps>. If the option is not provided the default field B<title> will be
+used.
+
+=item B<-skip=N>
+
+This option defines the number of database rows to skip when processing the
+selected field. If omitted then no rows are skipped. The option is useful to
+allow the work to be split into manageable batches, in conjunction with the
+B<-limit=N> option below.
+
+=item B<-limit=N>
+
+This option defines the number of database rows to work on when processing the
+selected field. If omitted then all rows are processed (after any skip defined
+with te B<-skip=N> option). The option is useful to allow the work to split
+into manageable batches, in conjunction with the B<-skip=N> option above.
+
+=back
+
+=head1 DESCRIPTION
+
+=head2 OVERVIEW
+
+The script is designed to repair the HPR MySQL (MariaDB) database which holds
+show metadata. The database was created with 'latin1' encoding, and was later
+changed to use UTF-8. However, no action was taken to ensure the PHP software
+managing the database also used UTF-8. This meant that the 'latin1' encoded data
+was still being generated as Unicode UTF-8 data was being added, and was being
+rendered in the expected way, while there was little or no UTF-8 data being
+stored.
+
+The PHP deficiencies were rectified in April 2023 but this meant that all
+non-ASCII characters stored in the database before that were rendered
+incorrectly. The solution was to convert all 'latin1' non-ASCII data into
+UTF-8, and that is what this script does.
+
+Detecting non ASCII in database fields was performed with the following SQL:
+
+    SELECT id,field FROM eps WHERE field <> CONVERT(field USING ASCII) ORDER BY id
+
+This is used to generate a list of all rows which might need conversion to
+UTF-8. However, the test is only whether there is non-ASCII data in the row.
+
+Ideally, the conversion could have been performed entirely within the database
+with SQL such as the following (for each field):
+
+    UPDATE eps SET field = CONVERT(binary CONVERT(field USING latin1) USING utf8)
+    WHERE field <> CONVERT(field USING ASCII);
+
+However, the conversion to UTF-8 fails when the field already contains such
+characters, stopping the query.
+
+MySQL and MariaDB are capable of trapping errors (like using B<try/catch> in
+various programming languages), but only in stored procedures. It was felt to
+be undesirable to create stored procedures on the HPR database since this was
+only possible through B<phpMyAdmin> which is due to be phased out.
+
+This script was written to enable the catching of errors instead.
+
+=head2 SCRIPT DESIGN
+
+The main loop returns all rows with non-ASCII characters in the field being
+processed. For each row an 'UPDATE' query is performed using the 'id' field
+(episode number) to select it:
+
+    UPDATE eps SET field = CONVERT(BINARY CONVERT(field USING latin1) USING utf8)
+    WHERE id = value
+
+This is performed inside a B<try/catch> statement so that if the query fails
+it does not stop the script. Successes and failures are logged.
+
+This algorithm is fairly slow, particularly for the 'notes' field which has
+the most (nearly 600) non-ASCII rows. However, it seems to work as desired.
+
+The B<-skip=N> and B<-limit=N> options allow control over the conversion
+process such that the work can be done in batches.
+
+Note that the log file used by the script is called B<convert_latin1.log>. It
+is appended to on every run. The file name can only be changed by editing the
+script.
+
+=head1 DIAGNOSTICS
+
+A list of every error and warning message that the application can generate
+(even the ones that will "never happen"), with a full explanation of each
+problem, one or more likely causes, and any suggested remedies. If the
+application generates exit status codes (e.g. under Unix) then list the exit
+status associated with each error.
+
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+The script obtains the credentials it requires to open the HPR database from
+a configuration file. The name of the file it expects is B<.hpr_db.cfg> in the
+directory holding the script. This can be changed by use of the
+B<-configuration=FILE> option as described above.
+
+The configuration file format is as follows:
+
+ <database>
+     host = 127.0.0.1
+     port = PORT
+     name = DATABASE
+     user = USERNAME
+     password = PASSWORD
+ </database>
+
+=head1 DEPENDENCIES
+
+    Config::General
+    DBI
+    Data::Dumper
+    Getopt::Long
+    Log::Handler
+    Log::Handler::Output::File
+    Pod::Usage
+    SQL::Abstract
+
+The script uses the experimental B<try> feature and disables the warning that
+this feature generates. Note that this feature is only available in Perl
+versions at 5.34.0 or above (the script was developed under v5.36.0).
+
+=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) 2023 Dave Morriss  (Dave.Morriss@gmail.com). All rights reserved.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See perldoc perlartistic.
+
+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]
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
+

Database/create_series

@@ -0,0 +1,469 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: create_series
+#
+#        USAGE: ./create_series -name=NAME -description=DESC [-[no]private]
+#               [-image=IMAGE] [-[no]valid] [-[no]updatedb] [-config=FILE] [-help]
+#
+#  DESCRIPTION: Create a new series in the HPR database
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.4
+#      CREATED: 2015-01-15 16:09:09
+#     REVISION: 2022-04-12 21:37:02
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use Getopt::Long;
+use Pod::Usage;
+
+use Config::General;
+
+use Try::Tiny;
+use IO::Prompter;
+
+use DBI;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.4';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.cfg";
+
+my ( $dbh, $sth1, $h1, $rv, $rc );
+my ( $answer, $id );
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#-------------------------------------------------------------------------------
+# Options and arguments
+#-------------------------------------------------------------------------------
+#
+# Process options
+#
+my %options;
+Options( \%options );
+
+#
+# Default help
+#
+pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 )
+    if ( $options{'help'} );
+
+#
+# Collect options
+#
+my $cfgfile
+    = ( defined( $options{config} ) ? $options{config} : $configfile );
+
+my $updatedb = ( defined( $options{'updatedb'} ) ? $options{'updatedb'} : 0 );
+
+my $name        = $options{'name'};
+my $description = $options{'description'};
+my $private = ( defined( $options{'private'} ) ? $options{'private'} : 0 );
+my $image   = ( defined( $options{'image'} ) ? $options{'image'} : '' );
+my $valid   = ( defined( $options{'valid'} ) ? $options{'valid'} : 1 );
+
+die "Options -name and -description are mandatory\n"
+    unless ( $name && $description );
+
+#
+# Sanity check
+#
+die "Unable to find $cfgfile\n" unless ( -e $cfgfile );
+
+#
+# Check we have the right values
+#
+printf "Planning to add the following series:\n" .
+    "Name:        %s\n" .
+    "Description: %s\n" .
+    "Private:     %s\n" .
+    "Image:       '%s'\n" .
+    "Valid:       %s\n",
+    $name,
+    $description,
+    ( $private ? 'Yes' : 'No' ),
+    $image,
+    ( $valid ? 'Yes' : 'No');
+
+print "Note that -updatedb has not been set, so no changes will be made.\n"
+    unless ($updatedb);
+
+#
+# Ask for confirmation, failing gracefully if there's a problem
+#
+try {
+    $answer = prompt(
+        -in     => *STDIN,
+        -out    => *STDERR,
+        -prompt => 'Is this correct? ',
+        -style  => 'red',
+        -yn
+    );
+}
+catch {
+    warn "Problem collecting answer $_";
+    $answer = 0;
+};
+
+unless ($answer) {
+    print "Exiting...\n";
+    exit;
+}
+
+#-------------------------------------------------------------------------------
+# Configuration file - load data
+#-------------------------------------------------------------------------------
+my $conf = Config::General->new(
+    -ConfigFile      => $cfgfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+
+# 2022-04-12 The MariaDB driver was there and then it wasn't!
+#
+#$dbh = DBI->connect( "DBI:MariaDB:database=$dbname;host=$dbhost;port=$dbport",
+#    $dbuser, $dbpwd, { AutoCommit => 1 } )
+#    or die $DBI::errstr;
+
+$dbh = DBI->connect( "dbi:mysql:database=$dbname;host=$dbhost;port=$dbport",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+#
+# Does a series with this name already exist?
+#
+$sth1 = $dbh->prepare(q{
+    SELECT id AS count FROM miniseries WHERE name = ?
+});
+$sth1->execute($name);
+if ( $dbh->err ) {
+    warn $dbh->errstr;
+}
+if ( $h1 = $sth1->fetchrow_hashref ) {
+    print "A series with the name '$name' already exists\n";
+    exit;
+}
+
+#
+# Should be OK to create the series if we get here, so long as we've been
+# asked to do so.
+#
+if ($updatedb) {
+    #
+    # Go into transaction mode here so we can fail safely
+    #
+    $rc = $dbh->begin_work or die $dbh->errstr;
+
+    #
+    # Perform the INSERT
+    #
+    $rv = $dbh->do(q{
+        INSERT INTO miniseries (name,description,private,image,valid)
+        VALUES(?,?,?,?,?)
+    },
+        undef,
+        $name,
+        $description,
+        $private,
+        $image,
+        $valid
+    );
+
+    #
+    # Respond to any error by rolling back
+    #
+    if ( $dbh->err ) {
+        warn $dbh->errstr;
+        eval{ $dbh->rollback };
+        $rv = 0;
+    }
+    else {
+        $dbh->commit;
+    }
+    $rv = 0 if ( $rv eq '0E0' );
+
+    #
+    # Report any success
+    #
+    if ($rv) {
+        #
+        # Find out what id we just generated and report it if found
+        #
+        $id = $dbh->last_insert_id();
+        if ($id) {
+            print "Series added with id $id\n";
+        } else {
+            print "Series added\n";
+        }
+    }
+    else {
+        print "Series not added due to error\n";
+    }
+
+} else {
+    print "Option -noupdatedb chosen, database not updated\n";
+}
+
+#
+# We've finished with the database
+#
+$dbh->disconnect;
+
+exit;
+
+#===  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",          "config=s", "updatedb!", "name=s",
+        "description=s", "private!", "image:s",   "valid!"
+    );
+
+    if ( !GetOptions( $optref, @options ) ) {
+        pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 );
+    }
+
+    return;
+}
+
+__END__
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#  Application Documentation
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#{{{
+
+=head1 NAME
+
+create_series - create a new series in the 'miniseries' table in the HPR DB
+
+=head1 VERSION
+
+This documentation refers to create_series version 0.0.4
+
+
+=head1 USAGE
+
+    create_series -name=NAME -description=DESC [-[no]private]
+        [-image=IMAGE] [-[no]valid] [-[no]updatedb] [-config=FILE] [-help]
+
+    desc="An overview of this open-source graphics program, "
+    desc+="with a focus on photographic issues."
+    create_series -update -name='GIMP' -description="$desc"
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-[no]updatedb>
+
+This option is required to make the script apply any changes that are made to
+the database. By default no updates are applied (B<-noupdatedb>).
+
+=item B<-name=NAME>
+
+This mandatory option defines the title for the new series. The limit on the
+length of the name is 100 characters and the script will reject anything
+longer than this.
+
+=item B<-description=DESC>
+
+This mandatory option defines the description for the new series. There is no limit on the
+length of this field, but it may be difficult to enter very large amounts of
+text here. One solution might be to prepare the text in a file and use
+a command substitution to enter it.
+
+    create_series -update -name='GIMP' -description="$(cat GIMP.txt)"
+
+=item B<-[no]private>
+
+Series can be private or public. Selecting B<-private> creates a new private
+series, whereas B<-noprivate> creates a public series. The default is to
+create a public one.
+
+=item B<-image=IMAGE>
+
+The image field in the database is not currently used. Three series have
+a short text string in this field, but no data in the field seems to be used
+anywhere. It would be possible to add data to this field in the database when
+creating a series, and this option is available to do so, but by default
+an empty string is inserted. Note that the database design does not allow this
+field to be NULL for unknown reasons.
+
+=item B<-[no]valid>
+
+Series can be valid or invalid. Selecting B<-valid> creates a new valid
+series, whereas B<-novalid> creates an invalid series. The default is to
+create a valid one.
+
+Series marked invalid are not displayed, but there are none in this state at
+the moment.
+
+=item B<-config=FILE>
+
+This option allows an alternative configuration file to be used. This file
+defines the location of the database, its port, its name and the username and
+password to be used to access it. This feature was added to allow the script
+to access alternative databases or the live database over an SSH tunnel.
+
+See the CONFIGURATION AND ENVIRONMENT section below for the file format.
+
+If the option is omitted the default file is used: B<.hpr_db.cfg>
+
+=back
+
+=head1 DESCRIPTION
+
+The script collects the necessary attributes for a new series in the HPR
+database, displays them for validation and if requested, adds them to the
+database.
+
+Every series must have a name and a description. The settings for I<private>,
+I<image> and I<valid> have defaults as described above. The values and
+defaults are shown as follows and the user is prompted to decide whether to
+proceed with series creation or not:
+
+    Planning to add the following series:
+    Name:        GIMP
+    Description: An overview of this open-source graphics program, with a focus on photographic issues.
+    Private:     No
+    Image:       ''
+    Valid:       Yes
+    Is this correct?
+
+Answering 'Y' to this prompt will result in creation (assuming this is
+possible).
+
+Upon creation the script reports the B<id> value assigned to the series. This
+is useful to know when adding episodes to the series.
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item B<Options -name and -description are mandatory>
+
+Both of these options must be present when creating a new series. This is
+a fatal error.
+
+=item B<DBI connect ... failed: Access denied for user ... >
+
+The database connection has been denied. Check the configuration details (see
+below). This a fatal error.
+
+=back
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+The script obtains the credentials it requires to open the HPR database from
+a configuration file. The name of the file it expects is B<.hpr_db.cfg> in the
+directory holding the script. This configuration file can be overridden using
+the B<-config=FILE> option as described above.
+
+The configuration file format is as follows:
+
+ <database>
+     host = 127.0.0.1
+     port = PORT
+     name = DATABASE
+     user = USERNAME
+     password = PASSWORD
+ </database>
+
+=head1 DEPENDENCIES
+
+ Config::General
+ DBI
+ Data::Dumper
+ Getopt::Long
+ IO::Prompter
+ Pod::Usage
+ Try::Tiny
+
+=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) 2015-2020 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]
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
+

Database/double_host.sql

@@ -0,0 +1,18 @@
+/*---------------------------------------------------------------------------
+ * Written a while ago. I think it finds hosts called "'host1' and 'host2'"
+ * and pulls the individual hosts out of the pair so that they can be
+ * installed into the table as separate hosts
+ ---------------------------------------------------------------------------- */
+select ho.hostid, ho.host, n1.hostid, n1.host, n1.host1, n2.hostid, n2.host, n2.host2
+from hosts ho
+left join (select hostid, host, left(host,instr(host,' and ')-1) as host1
+    from hosts
+    where host like '% and %') as n1
+on n1.host1 = ho.host
+left join (select hostid, host, substring(host,instr(host,' and ')+5) as host2
+    from hosts
+    where host like '% and %') as n2
+on n2.host2 = ho.host
+where n1.host1 is not null
+or n2.host2 is not null
+;

Database/edit_episode

@@ -0,0 +1,832 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: edit_episode
+#
+#        USAGE: ./edit_episode [-h] [-debug=N] [-config=FILE] [-[no]update]
+#                       [-[no]title] [-[no]summary] [-[no]tags] [-[no]notes]
+#                       [-[no]ctitle] [-[no]ctext] [-cnumber=N] shownumber
+#
+#  DESCRIPTION: A simple command-line editor for the HPR database
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: Had to revert to MySQL due to a problem with DBD::MariaDB
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.1.3
+#      CREATED: 2015-06-17 23:17:50
+#     REVISION: 2022-02-16 20:07:45
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use Getopt::Long;
+use Pod::Usage;
+
+use Config::General;
+use File::Temp;
+use File::Slurper qw{ read_text };
+use SQL::Abstract;
+use DBI;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.1.3';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.cfg";
+
+#
+# Declarations
+#
+my ( $dbh, $sth1, $h1, $rc );
+my (%changes);
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#
+# Options and arguments
+#
+my %options;
+Options( \%options );
+
+#
+# Default help
+#
+pod2usage( -msg => "Version $VERSION\n", -exitval => 1 )
+    if ( $options{'help'} );
+
+#
+# Collect options
+#
+my $DEBUG = ( $options{'debug'} ? $options{'debug'} : 0 );
+
+my $cfgfile
+    = ( defined( $options{config} ) ? $options{config} : $configfile );
+
+my $updatedb = ( defined( $options{'updatedb'} ) ? $options{'updatedb'} : 0 );
+
+my $title   = ( defined( $options{'title'} )   ? $options{'title'}   : 0 );
+my $summary = ( defined( $options{'summary'} ) ? $options{'summary'} : 0 );
+my $tags    = ( defined( $options{'tags'} )    ? $options{'tags'}    : 0 );
+my $notes   = ( defined( $options{'notes'} )   ? $options{'notes'}   : 0 );
+my $ctitle  = ( defined( $options{'ctitle'} )  ? $options{'ctitle'}  : 0 );
+my $ctext   = ( defined( $options{'ctext'} )   ? $options{'ctext'}   : 0 );
+my $cnumber = $options{'cnumber'};
+
+die "Select one of -title, -summary, -tags, -notes, -ctitle and -ctext\n"
+    unless ( $title || $summary || $tags || $notes || $ctitle || $ctext );
+
+die "Needs a comment number (-cnumber=N)\n"
+    if ( ( $ctitle || $ctext ) && ( !$cnumber ) );
+
+#
+# Get the arg
+#
+my $show = shift;
+pod2usage( -msg => "Specify the show number\n", -exitval => 1 ) unless $show;
+
+#
+# Sanity check
+#
+die "Unable to find $cfgfile\n" unless ( -e $cfgfile );
+
+#
+# Load configuration data
+#
+my $conf = new Config::General(
+    -ConfigFile      => $cfgfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#
+# Connect to the database
+#
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+
+#$dbh = DBI->connect( "DBI:MariaDB:database=$dbname;host=$dbhost;port=$dbport",
+#    $dbuser, $dbpwd, { AutoCommit => 1 } )
+#    or die $DBI::errstr;
+
+$dbh = DBI->connect( "dbi:mysql:database=$dbname;host=$dbhost;port=$dbport",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+#
+# Prepare to read the database for the selected episode and count the number
+# of comments it has in case we need to know later.
+#
+$sth1 = $dbh->prepare(q{
+    SELECT
+        e.*, count(c.id) as comment_count
+    FROM eps e
+    LEFT JOIN comments c ON e.id = c.eps_id
+    GROUP BY e.id
+    HAVING e.id = ?
+});
+$sth1->execute($show);
+if ( $dbh->err ) {
+    warn $dbh->errstr;
+}
+
+#
+# Did we find the episode?
+#
+if ( $h1 = $sth1->fetchrow_hashref ) {
+    #
+    # Found, so do the episode details need changing?
+    #
+    if ( $title || $summary || $tags || $notes ) {
+        change_episode( $dbh, $h1, $show, $updatedb, $title, $summary, $tags,
+            $notes );
+    }
+
+    #
+    # Are we to change comment details?
+    #
+    if ( $ctitle || $ctext ) {
+        if ( $h1->{comment_count} > 0 ) {
+            change_comment( $dbh, $h1, $show, $cnumber, $updatedb, $ctitle,
+                $ctext );
+        }
+        else {
+            print "This show has no comments\n";
+        }
+    }
+}
+else {
+    print "Unable to find show number $show\n";
+}
+
+#$dbh->disconnect;
+
+exit;
+
+#===  FUNCTION  ================================================================
+#         NAME: change_episode
+#      PURPOSE: Make changes to a row in the 'eps' table for a show
+#   PARAMETERS: $dbh            open handle of the MySQL database
+#               $h              handle of the query that returned the episode
+#                               record and comment count
+#               $show           show number being updated
+#               $updatedb       Boolean; true when changes are to be made
+#               $title          Boolean; true when the episode title is to be
+#                               changed
+#               $summary        Boolean; true when the episode summary is to be
+#                               changed
+#               $tags           Boolean; true when the episode tags are to be
+#                               changed
+#               $notes          Boolean; true when the episode notes are to be
+#                               changed
+#      RETURNS: Nothing
+#  DESCRIPTION: The episode has been found in the database. The requested
+#               changes are applied. If after comparing old with new changes
+#               are found they are applied, otherwise nothing is done.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub change_episode {
+    my ( $dbh, $h, $show, $updatedb, $title, $summary, $tags, $notes ) = @_;
+
+    my (%changes);
+
+    #<<< [perltidy messes up the following]
+    if ($title) {
+        $changes{title} = check_field( 'title',
+            scalar( run_editor( $h->{title} ) ), 100, qr{(\n)} );
+    }
+    if ($summary) {
+        $changes{summary} = check_field( 'summary',
+            scalar( run_editor( $h->{summary} ) ), 100, qr{(\n)} );
+    }
+    if ($tags) {
+        $changes{tags} = check_field( 'tags',
+            scalar( run_editor( $h->{tags} ) ), 200, qr{(\n)} );
+    }
+    if ($notes) {
+        $changes{notes} = run_editor( $h->{notes}, ['+set filetype=html'] );
+    }
+    #>>>
+    print Dumper( \%changes ), "\n" if ( $DEBUG > 2 );
+
+    #
+    # Are we updating the database then?
+    #
+    if ($updatedb) {
+        #
+        # Was anything edited?
+        #
+        if (%changes) {
+            #
+            # Did the edits do anything? If not delete the element from the
+            # hash since there's no point writing it to the database
+            #
+            for my $key ( keys(%changes) ) {
+                if ( $changes{$key} eq $h->{$key} ) {
+                    print "No change made to $key, ignored\n";
+                    delete( $changes{$key} );
+                }
+            }
+            print Dumper( \%changes ), "\n" if ( $DEBUG > 2 );
+        }
+
+        #
+        # If there's anything left apply the changes
+        #
+        if (%changes) {
+            #
+            # Go into transaction mode here so we can fail safely
+            #
+            $rc = $dbh->begin_work or die $dbh->errstr;
+
+            my $sql = SQL::Abstract->new;
+            my %where = ( id => $show );
+            my ( $stmt, @bind ) = $sql->update( 'eps', \%changes, \%where );
+
+            my $sth = $dbh->prepare($stmt);
+            my $rv  = $sth->execute(@bind);
+
+            #
+            # Respond to any error by rolling back
+            #
+            if ( $dbh->err ) {
+                warn $dbh->errstr;
+                eval { $dbh->rollback };
+                $rv = 0;
+            }
+            else {
+                $dbh->commit;
+            }
+            $rv = 0 if ( $rv eq '0E0' );
+
+            #
+            # Report the update
+            #
+            if ($rv) {
+                my $ccount = scalar( keys(%changes) );
+                printf "Updated database (%d %s to the eps row)\n",
+                    $ccount, _plural( 'change', $ccount );
+            }
+            else {
+                print "Episode not updated due to error\n";
+            }
+
+        }
+        else {
+            #
+            # No changes were found
+            #
+            print "There was nothing to do\n";
+        }
+    }
+    else {
+        print "Option -noupdatedb chosen database not updated\n";
+    }
+
+    return;
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: change_comment
+#      PURPOSE: Make changes to a comment relating to a show
+#   PARAMETERS: $dbh            open handle of the MySQL database
+#               $h              handle of the query that returned the episode
+#                               record and comment count
+#               $show           show number being updated
+#               $cnumber        comment number within show
+#               $updatedb       Boolean; true when changes are to be made
+#               $ctitle         Boolean; true when the comment title is to be
+#                               changed
+#               $ctext          Boolean; true when the comment text is to be
+#                               changed
+#      RETURNS: Nothing
+#  DESCRIPTION: The episode has been found in the database and the number of
+#               comments determined. We know there are more than zero comments
+#               otherwise this routine woulkd not have been called. We check
+#               that the requested comment number is in range here (if could
+#               have been done before invocation). We query the target comment
+#               and modify one or both of the requested fields. If, after
+#               comparing old with new, changes are found, they are applied,
+#               otherwise nothing is done.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub change_comment {
+    my ( $dbh, $h, $show, $cnumber, $updatedb, $ctitle, $ctext ) = @_;
+
+    my ( $sth1, $h1 );
+    my (%changes);
+
+    if ( $cnumber <= $h->{comment_count} ) {
+        #
+        # Get the requested comment
+        #
+        $sth1 = $dbh->prepare(
+            q{
+                SELECT *
+                FROM comments
+                WHERE eps_id = ?
+                ORDER BY comment_timestamp
+                LIMIT 1
+                OFFSET ?
+            }
+        );
+        $sth1->execute( $show, $cnumber - 1 );
+        if ( $dbh->err ) {
+            warn $dbh->errstr;
+        }
+
+        #
+        # If found perform changes, otherwise it wasn't found (not sure how
+        # that's possible but you never know)
+        #
+        if ( $h1 = $sth1->fetchrow_hashref ) {
+            if ($ctitle) {
+                $changes{comment_title} = run_editor( $h1->{comment_title} );
+            }
+            if ($ctext) {
+                $changes{comment_text} = run_editor( $h1->{comment_text} );
+            }
+            print Dumper( \%changes ), "\n" if ( $DEBUG > 2 );
+
+            #
+            # Are we updating the database then?
+            #
+            if ($updatedb) {
+                #
+                # Was anything edited?
+                #
+                if (%changes) {
+                    #
+                    # Did the edits do anything? If not delete the element from the
+                    # hash since there's no point writing it to the database
+                    #
+                    for my $key ( keys(%changes) ) {
+                        if ( $changes{$key} eq $h1->{$key} ) {
+                            print "No change made to $key, ignored\n";
+                            delete( $changes{$key} );
+                        }
+                    }
+                    print Dumper( \%changes ), "\n" if ( $DEBUG > 2 );
+                }
+
+                #
+                # If there's anything left apply the changes
+                #
+                if (%changes) {
+                    #
+                    # Go into transaction mode here so we can fail safely
+                    #
+                    $rc = $dbh->begin_work or die $dbh->errstr;
+
+                    my $sql = SQL::Abstract->new;
+                    my %where = ( id => $h1->{id} );
+                    my ( $stmt, @bind )
+                        = $sql->update( 'comments', \%changes, \%where );
+
+                    my $sth = $dbh->prepare($stmt);
+                    my $rv  = $sth->execute(@bind);
+
+                    #
+                    # Respond to any error by rolling back
+                    #
+                    if ( $dbh->err ) {
+                        warn $dbh->errstr;
+                        eval { $dbh->rollback };
+                        $rv = 0;
+                    }
+                    else {
+                        $dbh->commit;
+                    }
+                    $rv = 0 if ( $rv eq '0E0' );
+
+                    #
+                    # Report the update
+                    #
+                    if ($rv) {
+                        my $ccount = scalar(keys(%changes));
+                        printf "Updated database (%d %s to the comments row)\n",
+                            $ccount, _plural( 'change', $ccount );
+                    }
+                    else {
+                        print "Comment not updated due to error\n";
+                    }
+
+                }
+                else {
+                    print "There was nothing to do\n";
+                }
+            }
+            else {
+                print "Option -noupdatedb chosen database not updated\n";
+            }
+        }
+    }
+    else {
+        print "Requested comment is out of range\n";
+    }
+
+    return;
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: run_editor
+#      PURPOSE: Run an interactive vim editor on a string
+#   PARAMETERS: $string         String to edit
+#               $options        An arrayref containing options for vim
+#                               (optional) Example '+set paste'. Each option
+#                               (such as '-c startinsert') needs to be
+#                               a separate array element.
+#      RETURNS: Edited string
+#  DESCRIPTION: Makes a temporary file with File::Temp ensuring that the file
+#               is in utf8 mode. Writes the edit string to the file and invokes
+#               the 'vim' editor on it. The resulting file is then read back
+#               into a string and returned to the caller, again taking care to
+#               retain utf8 mode.
+#       THROWS: No exceptions
+#     COMMENTS: File::Slurp and UTF-8 don't go well together. Moved to
+#               File::Slurper instead
+#     SEE ALSO: N/A
+#===============================================================================
+sub run_editor {
+    my ( $string, $options ) = @_;
+
+    #
+    # Build an arguments array for 'system'
+    #
+    my @args;
+    push( @args, @$options ) if $options;
+
+    #
+    # Make a temporary file
+    #
+    my $tfh = File::Temp->new;
+    binmode $tfh, ":encoding(UTF-8)";
+    my $tfn = $tfh->filename;
+    print $tfh $string if $string;
+    $tfh->close;
+
+    #
+    # Add the filename to the arguments
+    #
+    push( @args, $tfn );
+
+    die "Edit failed\n"
+        unless ( system( ( 'vim', @args ) ) == 0 );
+
+    return read_text($tfn);
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: check_field
+#      PURPOSE: Checks the a field is not too long and doesn't contain certain
+#               characters
+#   PARAMETERS: $name           name of field
+#               $field          string to be checked
+#               $maxlen         maximum string length
+#               $regex          regex containing illegal characters to be removed
+#      RETURNS: The input string truncated and with any illegal characters
+#               removed.
+#  DESCRIPTION: Runs a substitution on the string then truncates the result if
+#               it is too long.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub check_field {
+    my ( $name, $field, $maxlen, $regex ) = @_;
+
+    return unless $field;
+
+    $field =~ s/$regex//g;
+    if ( length($field) > $maxlen ) {
+        warn "Field '$name' too long ("
+            . length($field)
+            . "); truncated to "
+            . $maxlen . "\n";
+        $field = substr( $field, 0, $maxlen );
+    }
+    return $field;
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: _plural
+#      PURPOSE: Add an 's' to a word depending on a number
+#   PARAMETERS: $word           word to pluralise
+#               $count          number being used in message
+#      RETURNS: The word in a plural form or not
+#  DESCRIPTION: Just hides the expression that adds an 's' or not behind
+#               a function call
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub _plural {
+    my ( $word, $count ) = @_;
+
+    return $word . ( abs($count) != 1 ? 's' : '' );
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: Options
+#      PURPOSE: Processes command-line options
+#   PARAMETERS: $optref     Hash reference to hold the options
+#      RETURNS: Undef
+#  DESCRIPTION:
+#       THROWS: no exceptions
+#     COMMENTS: none
+#     SEE ALSO: n/a
+#===============================================================================
+sub Options {
+    my ($optref) = @_;
+
+    my @options = (
+        "help",     "debug=i", "config=s", "updatedb!", "title!",
+        "summary!", "tags!",   "notes!", "ctitle!", "ctext!", "cnumber=i",
+    );
+
+    if ( !GetOptions( $optref, @options ) ) {
+        pod2usage( -msg => "Version $VERSION\n", -exitval => 1 );
+    }
+
+    return;
+}
+
+__END__
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#  Application Documentation
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#{{{
+
+=head1 NAME
+
+edit_episode - edit one or more fields in the database for a given HPR show
+
+=head1 VERSION
+
+This documentation refers to edit_episode version 0.1.3
+
+
+=head1 USAGE
+
+    edit_episode [-help] [-debug=N] [-config=FILE] [-[no]updatedb] [-[no]title]
+        [-[no]summary] [-[no]tags] [-[no]notes] [-[no]ctitle] [-[no]ctext]
+        [-cnumber=N] shownumber
+
+    edit_episode -updatedb -title 1234
+    edit_episode -updatedb -title -summary 2000
+    edit_episode -updatedb -tags 2050
+    edit_episode -updatedb -notes 2045
+    edit_episode -updatedb -ctext -cnumber=1 2813
+
+
+=head1 REQUIRED ARGUMENTS
+
+=over 4
+
+=item B<shownumber>
+
+The script must be provided with a single show number to operate on.
+
+=back
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-[no]updatedb>
+
+This option is required to make the script apply any changes that are made to
+the database. By default no updates are applied (B<-noupdatedb>).
+
+=item B<-[no]title>
+
+This option, if given (as B<-title>) indicates that the 'title' field of the
+row for the selected episode is to be edited. The Vim editor is invoked to
+make changes. The default is B<-notitle> meaning that this field is not to be
+edited.
+
+=item B<-[no]summary>
+
+This option, if given (as B<-summary>) indicates that the 'summary' field of the
+row for the selected episode is to be edited. The Vim editor is invoked to
+make changes. The default is B<-nosummary> meaning that this field is not to be
+edited.
+
+=item B<-[no]tags>
+
+This option, if given (as B<-tags>) indicates that the 'tags' field of the
+row for the selected episode is to be edited. The Vim editor is invoked to
+make changes. The default is B<-notags> meaning that this field is not to be
+edited.
+
+=item B<-[no]notes>
+
+This option, if given (as B<-notes>) indicates that the 'notes' field of the
+row for the selected episode is to be edited. The Vim editor is invoked to
+make changes. The default is B<-nonotes> meaning that this field is not to be
+edited.
+
+=item B<-[no]ctitle>
+
+This option, if given (as B<-ctitle>) indicates that the 'title' field of the
+row for the selected comment is to be edited. The Vim editor is invoked to
+make changes. The default is B<-noctitle> meaning that this field is not to be
+edited.
+
+=item B<-[no]ctext>
+
+This option, if given (as B<-ctext>) indicates that the 'comment_text' field
+of the row for the selected comment is to be edited. The Vim editor is invoked
+to make changes. The default is B<-noctext> meaning that this field is not to
+be edited.
+
+=item B<-cnumber=N>
+
+If comment fields are being edited then a comment index is required. The
+comments are numbered starting from 1 and are sorted in the submission
+timestamp order. This number must be in the range 1..N where I<N> is the
+number of comments on this particular show.
+
+=item B<-config=FILE>
+
+This option allows an alternative configuration file to be used. This file
+defines the location of the database, its port, its name and the username and
+password to be used to access it. This feature was added to allow the script
+to access alternative databases or the live database over an SSH tunnel.
+
+See the CONFIGURATION AND ENVIRONMENT section below for the file format.
+
+If the option is omitted the default file is used: B<.hpr_db.cfg>
+
+=back
+
+At least one of the options B<-title>, B<-summary>, B<-tags> and B<-notes>
+must be provided otherwise the script will abort with an error.
+
+=head1 DESCRIPTION
+
+The script B<edit_episode> provides an editor interface to certain fields in
+the HPR database. The fields are:
+
+=over 4
+
+=item B<title>
+
+    A single line of up to 100 characters of text. The line is rendered as an
+    "<h1>" tag on the web page and is incorporated into the RSS feed, so it
+    must only contain characters legal in these contexts.
+
+=item B<summary>
+
+    A single line of up to 100 characters of text. The line is rendered as an
+    "<h3>" tag on the web page and is incorporated into the RSS feed, so it
+    must only contain characters legal in these contexts.
+
+=item B<tags>
+
+    A single line of up to 200 characters of text. The field holds tags
+    relevant to the content of the episode in CSV format.
+
+=item B<notes>
+
+    A block of HTML which is to be included inside "<article>" tags making up
+    the show notes on the web page for the episode.
+
+=item B<comment_title>
+
+    A single line of text. The title is stored in a 'text' field in the
+    database and could be of any length, but will not be rendered correctly
+    if it exceeds 100 characters.
+
+=item B<comment_text>
+
+    A block of text (NOT HTML) which is the body of the comment. There are no
+    limit contraints here although the code that initiaslly accepts a comment
+    does impose a limit. Thus it would be unwise to make this field too large.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item B<Select one of -title, -summary, -tags, -notes, -ctitle and -ctext>
+
+At least one of these options is required. This a fatal error.
+
+=item B<Needs a comment number (-cnumber=N)>
+
+If one of B<-ctitle> and B<-ctext> is provided then a comment number is needed.
+
+=item B<Specify the show number>
+
+The show number has been omitted. This a fatal error.
+
+=item B<DBI connect ... failed: Access denied for user ... >
+
+The database connection has been denied. Check the configuration details (see
+below). This a fatal error.
+
+=item B<Edit failed>
+
+If the Vim edit session fails in some way the script reports it this way.
+
+=back
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+The script obtains the credentials it requires to open the HPR database from
+a configuration file. The name of the file it expects is B<.hpr_db.cfg> in the
+directory holding the script. This configuration file can be overridden using
+the B<-config=FILE> option as described above.
+
+The configuration file format is as follows:
+
+ <database>
+     host = 127.0.0.1
+     port = PORT
+     name = DATABASE
+     user = USERNAME
+     password = PASSWORD
+ </database>
+
+=head1 DEPENDENCIES
+
+ Config::General
+ DBI
+ Data::Dumper
+ File::Slurp
+ File::Temp
+ Getopt::Long
+ Pod::Usage
+ SQL::Abstract
+
+=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) 2015-2019 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]
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker

Database/edit_host

@@ -0,0 +1,648 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: edit_host
+#
+#        USAGE: ./edit_host [-help] [-debug=N] [-[no]update] [-config=FILE]
+#               [-[no]espeak_name] [-hostid=id] [-[no]regex] host_name
+#
+#  DESCRIPTION: A simple editor for the HPR hosts table
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: DBI::MariaDB was here for a while then reverted to DBI::mysql.
+#               Had to revert this script onn 2023-01-22.
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.7
+#      CREATED: 2018-04-07 22:05:06
+#     REVISION: 2023-01-22 14:06:48
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use Getopt::Long;
+use Pod::Usage;
+
+use Config::General;
+use File::Temp;
+use File::Slurper qw{ read_text };
+use SQL::Abstract;
+use DBI;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.7';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.cfg";
+
+#
+# Declarations
+#
+my ( $dbh, $sth1, $h1, $rc );
+my ( $host_name, %changes );
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#
+# Options and arguments
+#
+my %options;
+Options( \%options );
+
+#
+# Default help
+#
+pod2usage( -msg => "Version $VERSION\n", -exitval => 1 )
+    if ( $options{'help'} );
+
+#
+# Collect options
+#
+my $DEBUG = ( $options{'debug'} ? $options{'debug'} : 0 );
+
+my $cfgfile
+    = ( defined( $options{config} ) ? $options{config} : $configfile );
+
+my $updatedb = ( defined( $options{'updatedb'} ) ? $options{'updatedb'} : 0 );
+my $regexp = ( defined( $options{'regexp'} ) ? $options{'regexp'} : 0 );
+
+my $email   = ( defined( $options{'email'} )   ? $options{'email'}   : 0 );
+my $profile = ( defined( $options{'profile'} ) ? $options{'profile'} : 0 );
+my $espeak_name
+    = ( defined( $options{'espeak_name'} ) ? $options{'espeak_name'} : 0 );
+
+#
+# There must be at least one field to change
+#
+die "Select one of -email, -profile and -espeak_name\n"
+    unless ( $email || $profile || $espeak_name );
+
+#
+# Was a host id provided (through an option)?
+#
+my $hostid = $options{'hostid'};
+
+#
+# Deal with the two routes: one via the unique host id, and the other vai the
+# less unique host name
+#
+unless ($hostid) {
+    #
+    # Get the arg
+    #
+    $host_name = shift;
+    pod2usage( -msg => "Specify the host name\n", -exitval => 1 )
+        unless $host_name;
+}
+
+#
+# Sanity check
+#
+die "Unable to find $cfgfile\n" unless ( -e $cfgfile );
+
+#
+# Load configuration data
+#
+my $conf = new Config::General(
+    -ConfigFile      => $cfgfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#
+# Connect to the database
+#
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+
+#$dbh = DBI->connect( "DBI:MariaDB:database=$dbname;host=$dbhost;port=$dbport",
+#    $dbuser, $dbpwd, { AutoCommit => 1 } )
+#    or die $DBI::errstr;
+
+$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Prepare to read the database either for the hostid or the exact or
+# approximate name
+#
+if ($hostid) {
+    #
+    # Simple hostid query
+    #
+    $sth1 = $dbh->prepare(q{SELECT * FROM hosts WHERE hostid = ?});
+    $sth1->execute($hostid);
+    if ( $dbh->err ) {
+        die $dbh->errstr;
+    }
+}
+else {
+    #
+    # Host name query
+    #
+    if ($regexp) {
+        #
+        # Regexp match requested. Count how many matches there are
+        #
+        $sth1 = $dbh->prepare(
+            q{SELECT count(*) AS count FROM hosts WHERE host REGEXP ?});
+        $sth1->execute($host_name);
+        if ( $dbh->err ) {
+            warn $dbh->errstr;
+        }
+        if ( $h1 = $sth1->fetchrow_hashref ) {
+            die "Too many matches to regex $host_name\n"
+                unless $h1->{count} == 1;
+        }
+        else {
+            die "Unable to find host matching regex $host_name\n";
+        }
+
+        $sth1 = $dbh->prepare(q{SELECT * FROM hosts WHERE host REGEXP ?});
+    }
+    else {
+        $sth1 = $dbh->prepare(q{SELECT * FROM hosts WHERE host = ?});
+    }
+
+    #
+    # Execute the query
+    #
+    $sth1->execute($host_name);
+    if ( $dbh->err ) {
+        die $dbh->errstr;
+    }
+}
+
+#
+# Did we find it?
+#
+if ( $h1 = $sth1->fetchrow_hashref ) {
+    #
+    # Found. Save the hostid to simplify the update if we don't already have
+    # it
+    #
+    $hostid //= $h1->{hostid};
+
+    #
+    # So what needs changing?
+    #
+    #<<< [perltidy messes up the following]
+    if ($email) {
+        $changes{email} = check_field( 'email',
+            scalar( run_editor( $h1->{email}, ['+set paste'] ) ), 256, qr{(\n)} );
+    }
+    if ($profile) {
+        $changes{profile} = run_editor( $h1->{profile}, ['+set paste'] );
+    }
+    if ($espeak_name) {
+        $changes{espeak_name} = check_field( 'espeak_name',
+            scalar( run_editor( $h1->{espeak_name} ) ), 256, qr{(\n)} );
+    }
+    #>>>
+    print Dumper( \%changes ), "\n" if ( $DEBUG > 2 );
+
+    #
+    # Are we updating the database then?
+    #
+    if ($updatedb) {
+        #
+        # Was anything edited?
+        #
+        if (%changes) {
+            #
+            # Did the edits do anything? If not delete the element from the
+            # hash since there's no point writing it to the database
+            #
+            for my $key ( keys(%changes) ) {
+                if ( $changes{$key} eq $h1->{$key} ) {
+                    print "No change made to $key, ignored\n";
+                    delete( $changes{$key} );
+                }
+            }
+            print Dumper( \%changes ), "\n" if ( $DEBUG > 2 );
+        }
+
+        #
+        # If there's anything left apply the changes
+        #
+        if (%changes) {
+            #
+            # Go into transaction mode here so we can fail safely
+            #
+            $rc = $dbh->begin_work or die $dbh->errstr;
+
+            my $sql = SQL::Abstract->new;
+            my %where = ( hostid => $hostid );
+            my ( $stmt, @bind ) = $sql->update( 'hosts', \%changes, \%where );
+            #print "$stmt\n";
+            #print join( ",", map {"'$_'"} @bind ), "\n";
+
+            my $sth = $dbh->prepare($stmt);
+            my $rv  = $sth->execute(@bind);
+
+            #
+            # Respond to any error by rolling back
+            #
+            if ( $dbh->err ) {
+                warn $dbh->errstr;
+                eval { $dbh->rollback };
+                $rv = 0;
+            }
+            else {
+                $dbh->commit;
+            }
+            $rv = 0 if ( $rv eq '0E0' );
+
+            #
+            # Update the log file
+            #
+            if ($rv) {
+                print "Updated database\n";
+            }
+            else {
+                print "Database not updated due to error\n";
+            }
+
+        }
+        else {
+            print "There was nothing to do\n";
+        }
+    }
+    else {
+        print "Database not updated\n";
+    }
+}
+else {
+    if ($hostid) {
+        print "Unable to find host number $hostid\n";
+    }
+    else {
+        print "Unable to find host name $host_name\n";
+    }
+}
+
+exit;
+
+#===  FUNCTION  ================================================================
+#         NAME: run_editor
+#      PURPOSE: Run an interactive vim editor on a string
+#   PARAMETERS: $string         String to edit
+#               $options        An arrayref containing options for vim
+#                               (optional) Example '+set paste'. Each option
+#                               (such as '-c startinsert') needs to be
+#                               a separate array element.
+#      RETURNS: Edited string
+#  DESCRIPTION: Makes a temporary file with File::Temp ensuring that the file
+#               is in utf8 mode. Writes the edit string to the file and invokes
+#               the 'vim' editor on it. The resulting file is then read back
+#               into a string and returned to the caller, again taking care to
+#               retain utf8 mode.
+#       THROWS: No exceptions
+#     COMMENTS: File::Slurp and UTF-8 don't go well together. Moved to
+#               File::Slurper instead
+#     SEE ALSO: N/A
+#===============================================================================
+sub run_editor {
+    my ( $string, $options ) = @_;
+
+    #
+    # Build an arguments array for 'system'
+    #
+    my @args;
+    push( @args, @$options ) if $options;
+
+    #
+    # Make a temporary file
+    #
+    my $tfh = File::Temp->new;
+    binmode $tfh, ":encoding(UTF-8)";
+    my $tfn = $tfh->filename;
+    print $tfh $string if $string;
+    $tfh->close;
+
+    #
+    # Add the filename to the arguments
+    #
+    push( @args, $tfn );
+
+    die "Edit failed\n"
+        unless ( system( ( 'vim', @args ) ) == 0 );
+
+    return read_text($tfn);
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: check_field
+#      PURPOSE: Checks the a field is not too long and doesn't contain certain
+#               characters
+#   PARAMETERS: $name           name of field
+#               $field          string to be checked
+#               $maxlen         maximum string length
+#               $regex          regex containing illegal characters to be removed
+#      RETURNS: The input string truncated and with any illegal characters
+#               removed.
+#  DESCRIPTION: Runs a substitution on the string then truncates the result if
+#               it is too long.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub check_field {
+    my ( $name, $field, $maxlen, $regex ) = @_;
+
+    return unless $field;
+
+    $field =~ s/$regex//g;
+    if ( length($field) > $maxlen ) {
+        warn "Field '$name' too long ("
+            . length($field)
+            . "); truncated to "
+            . $maxlen . "\n";
+        $field = substr( $field, 0, $maxlen );
+    }
+    return $field;
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: Options
+#      PURPOSE: Processes command-line options
+#   PARAMETERS: $optref     Hash reference to hold the options
+#      RETURNS: Undef
+#  DESCRIPTION:
+#       THROWS: no exceptions
+#     COMMENTS: none
+#     SEE ALSO: n/a
+#===============================================================================
+sub Options {
+    my ($optref) = @_;
+
+    my @options = (
+        "help",     "debug=i", "updatedb!", "config=s",
+        "hostid=i", "regexp",  "email!",    "profile!",
+        "espeak_name!",
+    );
+
+    if ( !GetOptions( $optref, @options ) ) {
+        pod2usage( -msg => "Version $VERSION\n", -exitval => 1 );
+    }
+
+    return;
+}
+
+__END__
+
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#  Application Documentation
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#{{{
+
+=head1 NAME
+
+edit_host - edit one or more fields in the database for a given host
+
+=head1 VERSION
+
+This documentation refers to edit_host version 0.0.7
+
+
+=head1 USAGE
+
+    edit_host [-h] [-debug=N] [-[no]updatedb] [-hostid=ID] [-regexp]
+    [-[no]email] [-[no]profile] [-[no]espeak_name] [-config=FILE] hostname
+
+    edit_host -updatedb -espeak_name operat0r
+    edit_host -updatedb -espeak_name -regexp oper
+    edit_host -updatedb -email -espeak -host=225
+
+
+=head1 REQUIRED ARGUMENTS
+
+=over 4
+
+=item B<hostname>
+
+Unless the B<-hostid=ID> option is given (see the OPTIONS section) it is
+necessary to provide a host name.
+
+Unless the B<-regexp> option is provided (see the OPTIONS section) the
+hostname must match exactly, otherwise it is regarded as a MySQL regular
+expression.
+
+=back
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-[no]updatedb>
+
+This option is required to make the script apply any changes that are made to
+the database. By default no updates are applied (B<-noupdatedb>).
+
+=item B<-regexp>
+
+This option causes the B<hostname> argument to be interpreted as a regular
+expression for the MySQL database. By default the argument is treated as if it
+is an exact match.
+
+=item B<-hostid=ID>
+
+The host can be specified by the host ID through this route. If this used then
+the B<hostname> argument is not required (and is ignored if given).
+
+=item B<-[no]email>
+
+This option, if given (as B<-email>), indicates that the 'email' field is to
+be edited.  The Vim editor is invoked to make changes. The default is
+B<-noemail> meaning that this field is not to be edited.
+
+=item B<-[no]profile>
+
+This option, if given (as B<-profile>), indicates that the 'profile' field is
+to be edited.  The Vim editor is invoked to make changes. The default is
+B<-noprofile> meaning that this field is not to be edited.
+
+=item B<-[no]espeak_name>
+
+This option, if given (as B<-espeak_name>), indicates that the 'espeak_name'
+field is to be edited.  The Vim editor is invoked to make changes. The default
+is B<-noespeak_name> meaning that this field is not to be edited.
+
+=item B<-config=FILE>
+
+This option allows an alternative configuration file to be used. This file
+defines the location of the database, its port, its name and the username and
+password to be used to access it. This feature was added to allow the script
+to access alternative databases or the live database over an SSH tunnel.
+
+See the CONFIGURATION AND ENVIRONMENT section below for the file format.
+
+If the option is omitted the default file is used: B<.hpr_db.cfg>
+
+=back
+
+=head1 DESCRIPTION
+
+The script B<edit_host> provides an editor interface to certain fields in
+the B<hosts> table of the HPR database. The fields are:
+
+=over 4
+
+=item B<email>
+
+A single line of up to 256 characters of text. The line is stored in a 'TEXT'
+field but it makes no sense to make it too long even though an email address
+can be arbitrarily long. The current maximum address length in the database is
+44 characters.
+
+=item B<profile>
+
+A multi-line line of text of arbitrary length and content. The contents are
+the host's profile in optional HTML format to be displayed on the page which
+lists all of their contributions to HPR.
+
+=item B<espeak_name>
+
+A single line of up to 256 characters of text. The line is stored in a 'TEXT'
+field but it makes no sense to make it too long. Its purpose is to provide the
+'espeak' program with a form of the host name (or alias) which can be spoken
+as the host requires. For example the host 'thelovebug' finds his name spoken
+as "thel ove bug" and this can be corrected by storing 'TheLoveBug' in this
+field.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item B<Select one of -email, -profile and -espeak_name>
+
+At least one of these options is required. This a fatal error.
+
+=item B<Specify the host name>
+
+If no host name has been provided, and the B<-hostid=ID> option has not been
+used the script is unable to determine the host to edit. This is a fatal
+error.
+
+=item B<Unable to find ...>
+
+The configuration file containing details of the database cannot be found.
+This is a fatal error.
+
+=item B<DBI connect ... failed: Access denied for user ... >
+
+The database connection has been denied. Check the configuration details (see
+below). This a fatal error.
+
+=item B<Too many matches to regex ...>
+
+In B<-regex> mode a hostname has been provided that matches too many hosts in
+the database. Try again with a less ambiguous name. This a fatal error.
+
+=item B<Unable to find host matching regex ...>
+
+In B<-regex> mode a hostname has been provided that matches no hosts in the
+database. Try again. This a fatal error.
+
+=item B<Edit failed>
+
+If the Vim edit session fails in some way the script reports it this way. This
+a fatal error.
+
+=item B<Field '...' is too long (...); truncated to ...>
+
+The string provided for the field is greater than the limit and has been
+truncated. This is a warning.
+
+=back
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+The script obtains the credentials it requires to open the HPR database from
+a configuration file. The name of the file it expects is B<.hpr_db.cfg> in the
+directory holding the script. To change this will require changing the script.
+
+The configuration file format is as follows:
+
+ <database>
+     host = 127.0.0.1
+     port = PORT
+     name = DATABASE
+     user = USERNAME
+     password = PASSWORD
+ </database>
+
+=head1 DEPENDENCIES
+
+ Config::General
+ DBI
+ Data::Dumper
+ File::Slurper
+ File::Temp
+ Getopt::Long
+ Pod::Usage
+ SQL::Abstract
+
+=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) 2018 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]
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
+

Database/edit_series

@@ -0,0 +1,666 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: edit_series
+#
+#        USAGE: ./edit_series [-help] [-debug=N] [-[no]update] [-config=FILE]
+#               [-series_id=id] [-[no]regex] [-[no]description] [-[no]private]
+#               [-[no]valid] series_name
+#
+#  DESCRIPTION: A simple editor for the HPR miniseries table
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: Based on edit_host
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.3
+#      CREATED: 2020-06-21 17:58:19
+#     REVISION: 2021-06-23 22:11:13
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use Getopt::Long;
+use Pod::Usage;
+
+use Config::General;
+use File::Temp;
+use File::Slurper qw{ read_text };
+use SQL::Abstract;
+use DBI;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.3';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.cfg";
+
+#
+# Declarations
+#
+my ( $dbh, $sth1, $h1, $rc );
+my ( $series_name, %changes );
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#
+# Options and arguments
+#
+my %options;
+Options( \%options );
+
+#
+# Default help
+#
+pod2usage( -msg => "Version $VERSION\n", -exitval => 1 )
+    if ( $options{'help'} );
+
+#
+# Collect options
+#
+my $DEBUG = ( $options{'debug'} ? $options{'debug'} : 0 );
+
+my $cfgfile
+    = ( defined( $options{config} ) ? $options{config} : $configfile );
+
+my $updatedb = ( defined( $options{'updatedb'} ) ? $options{'updatedb'} : 0 );
+my $regexp   = ( defined( $options{'regexp'} )   ? $options{'regexp'}   : 0 );
+
+my $description = $options{'description'};
+my $private     = $options{'private'};
+my $valid       = $options{'valid'};
+
+#
+# There must be at least one field to change. We check for the definition here
+# because the values returned may be zero or one or the variable may be
+# undefined.
+#
+die "Select one of -[no]description, -[no]private and -[no]valid\n"
+    unless ( defined($description) || defined($private) || defined($valid) );
+
+#
+# Was a series id provided (through an option)?
+#
+my $series_id = $options{'series_id'};
+
+#
+# Deal with the two routes: one via the unique series id, and the other vai the
+# less unique series name
+#
+unless ($series_id) {
+    #
+    # Get the arg
+    #
+    $series_name = shift;
+    pod2usage( -msg => "Specify the series name\n", -exitval => 1 )
+        unless $series_name;
+}
+
+#
+# Sanity check
+#
+die "Unable to find $cfgfile\n" unless ( -e $cfgfile );
+
+#
+# Load configuration data
+#
+my $conf = new Config::General(
+    -ConfigFile      => $cfgfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#
+# Connect to the database
+#
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+
+# 2022-04-12 The MariaDB driver was there one minute and then it wasn't!
+#
+#$dbh = DBI->connect( "DBI:MariaDB:database=$dbname;host=$dbhost;port=$dbport",
+#    $dbuser, $dbpwd, { AutoCommit => 1 } )
+#    or die $DBI::errstr;
+
+$dbh = DBI->connect( "dbi:mysql:database=$dbname;host=$dbhost;port=$dbport",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+#
+# Prepare to read the database either for the series_id or the exact or
+# approximate name
+#
+if ($series_id) {
+    #
+    # Simple series_id query
+    #
+    $sth1 = $dbh->prepare(q{SELECT * FROM miniseries WHERE id = ?});
+    $sth1->execute($series_id);
+    if ( $dbh->err ) {
+        warn $dbh->errstr;
+    }
+}
+else {
+    #
+    # Series name query
+    #
+    if ($regexp) {
+        #
+        # Regexp match requested. Count how many matches there are
+        #
+        $sth1 = $dbh->prepare(
+            q{SELECT count(*) AS count FROM miniseries WHERE name REGEXP ?});
+        $sth1->execute($series_name);
+        if ( $dbh->err ) {
+            warn $dbh->errstr;
+        }
+        if ( $h1 = $sth1->fetchrow_hashref ) {
+            my $matches = $h1->{count};
+            if ($matches > 1) {
+                die "Too many matches to regex '$series_name' ($matches)\n";
+            } elsif ($matches == 0) {
+                die "No matches to regex '$series_name'\n";
+            }
+        }
+        else {
+            die "Unable to find series matching regex '$series_name'\n";
+        }
+
+        $sth1 = $dbh->prepare(q{SELECT * FROM miniseries WHERE name REGEXP ?});
+    }
+    else {
+        $sth1 = $dbh->prepare(q{SELECT * FROM miniseries WHERE name = ?});
+    }
+
+    #
+    # Execute the query
+    #
+    $sth1->execute($series_name);
+    if ( $dbh->err ) {
+        warn $dbh->errstr;
+    }
+}
+
+#
+# Did we find it?
+#
+if ( $h1 = $sth1->fetchrow_hashref ) {
+    #
+    # Found. Save the series_id to simplify the update if we don't already have
+    # it
+    #
+    $series_id //= $h1->{id};
+
+    #
+    # Report on the series details
+    #
+    printf "Series details\n" .
+        "Id:          %s\n" .
+        "Name:        %s\n" .
+        "Description: %s\n" .
+        "Private:     %s\n" .
+        "Image:       '%s'\n" .
+        "Valid:       %s\n",
+        $h1->{id},
+        $h1->{name},
+        (   length( $h1->{description} ) > 80
+            ? substr( $h1->{description}, 0, 80 ) . '...'
+            : $h1->{description} ),
+        $h1->{private},
+        $h1->{image},
+        $h1->{valid};
+
+    #
+    # So what needs changing?
+    #
+    #<<< [perltidy messes up the following]
+    if ($description) {
+        $changes{description} = check_field( 'description',
+            scalar( run_editor( $h1->{description}, ['+set paste'] ) ), 1500, qr{(\n)} );
+    }
+    if (defined($private)) {
+        $changes{private} = $private if ($h1->{private} ne $private);
+    }
+    if (defined($valid)) {
+        $changes{valid} = $valid if ($h1->{valid} ne $valid);
+    }
+    #>>>
+    print Dumper( \%changes ), "\n" if ( $DEBUG > 2 );
+
+    #
+    # Are we updating the database then?
+    #
+    if ($updatedb) {
+        #
+        # Was anything edited?
+        #
+        if (%changes) {
+            #
+            # Did the edits do anything? If not delete the element from the
+            # hash since there's no point writing it to the database
+            #
+            for my $key ( keys(%changes) ) {
+                if ( $changes{$key} eq $h1->{$key} ) {
+                    print "No change made to $key, ignored\n";
+                    delete( $changes{$key} );
+                }
+            }
+            print Dumper( \%changes ), "\n" if ( $DEBUG > 2 );
+        }
+
+        #
+        # If there's anything left apply the changes
+        #
+        if (%changes) {
+            #
+            # Go into transaction mode here so we can fail safely
+            #
+            $rc = $dbh->begin_work or die $dbh->errstr;
+
+            my $sql   = SQL::Abstract->new;
+            my %where = ( id => $series_id );
+            my ( $stmt, @bind )
+                = $sql->update( 'miniseries', \%changes, \%where );
+            #print "$stmt\n";
+            #print join( ",", map {"'$_'"} @bind ), "\n";
+
+            my $sth = $dbh->prepare($stmt);
+            my $rv  = $sth->execute(@bind);
+
+            #
+            # Respond to any error by rolling back
+            #
+            if ( $dbh->err ) {
+                warn $dbh->errstr;
+                eval { $dbh->rollback };
+                $rv = 0;
+            }
+            else {
+                $dbh->commit;
+            }
+            $rv = 0 if ( $rv eq '0E0' );
+
+            #
+            # Update the log file
+            #
+            if ($rv) {
+                print "Updated database\n";
+                print "Changed fields: ",
+                    join( ", ", sort( keys(%changes) ) ), "\n";
+            }
+            else {
+                print "Series not updated due to error\n";
+            }
+
+        }
+        else {
+            print "There was nothing to do\n";
+        }
+    }
+    else {
+        print "Database not updated\n";
+    }
+}
+else {
+    if ($series_id) {
+        print "Unable to find series number $series_id\n";
+    }
+    else {
+        print "Unable to find series name $series_name\n";
+    }
+}
+
+exit;
+
+#===  FUNCTION  ================================================================
+#         NAME: run_editor
+#      PURPOSE: Run an interactive vim editor on a string
+#   PARAMETERS: $string         String to edit
+#               $options        An arrayref containing options for vim
+#                               (optional). Example '+set paste'. Each option
+#                               (such as '-c startinsert') needs to be
+#                               a separate array element.
+#      RETURNS: Edited string
+#  DESCRIPTION: Makes a temporary file with File::Temp ensuring that the file
+#               is in utf8 mode. Writes the edit string to the file and invokes
+#               the 'vim' editor on it. The resulting file is then read back
+#               into a string and returned to the caller, again taking care to
+#               retain utf8 mode.
+#       THROWS: No exceptions
+#     COMMENTS: File::Slurp and UTF-8 don't go well together. Moved to
+#               File::Slurper instead
+#     SEE ALSO: N/A
+#===============================================================================
+sub run_editor {
+    my ( $string, $options ) = @_;
+
+    #
+    # Build an arguments array for 'system'
+    #
+    my @args;
+    push( @args, @$options ) if $options;
+
+    #
+    # Make a temporary file
+    #
+    my $tfh = File::Temp->new;
+    binmode $tfh, ":encoding(UTF-8)";
+    my $tfn = $tfh->filename;
+    print $tfh $string if $string;
+    $tfh->close;
+
+    #
+    # Add the filename to the arguments
+    #
+    push( @args, $tfn );
+
+    die "Edit failed\n"
+        unless ( system( ( 'vim', @args ) ) == 0 );
+
+    return read_text($tfn);
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: check_field
+#      PURPOSE: Checks the a field is not too long and doesn't contain certain
+#               characters
+#   PARAMETERS: $name           name of field
+#               $field          string to be checked
+#               $maxlen         maximum string length
+#               $regex          regex containing illegal characters to be removed
+#      RETURNS: The input string truncated and with any illegal characters
+#               removed.
+#  DESCRIPTION: Runs a substitution on the string then truncates the result if
+#               it is too long.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub check_field {
+    my ( $name, $field, $maxlen, $regex ) = @_;
+
+    return unless $field;
+
+    $field =~ s/$regex//g;
+    if ( length($field) > $maxlen ) {
+        warn "Field '$name' too long ("
+            . length($field)
+            . "); truncated to "
+            . $maxlen . "\n";
+        $field = substr( $field, 0, $maxlen );
+    }
+    return $field;
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: Options
+#      PURPOSE: Processes command-line options
+#   PARAMETERS: $optref     Hash reference to hold the options
+#      RETURNS: Undef
+#  DESCRIPTION:
+#       THROWS: no exceptions
+#     COMMENTS: none
+#     SEE ALSO: n/a
+#===============================================================================
+sub Options {
+    my ($optref) = @_;
+
+    my @options = (
+        "help",        "debug=i", "updatedb!",    "config=s",
+        "series_id=i", "regexp",  "description!", "private!",
+        "valid!",
+    );
+
+    if ( !GetOptions( $optref, @options ) ) {
+        pod2usage( -msg => "Version $VERSION\n", -exitval => 1 );
+    }
+
+    return;
+}
+
+__END__
+
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#  Application Documentation
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#{{{
+
+=head1 NAME
+
+edit_series - edit one or more fields in the database for a given series
+
+=head1 VERSION
+
+This documentation refers to edit_series version 0.0.3
+
+
+=head1 USAGE
+
+    edit_series [-h] [-debug=N] [-[no]updatedb] [-series_id=ID] [-regexp]
+    [-[no]description] [-[no]private] [-[no]valid] [-config=FILE] series_name
+
+    edit_series -updatedb -description GIMP
+    edit_series -updatedb -description -regexp Awk
+    edit_series -updatedb -noprivate -valid -series_id=102
+
+
+=head1 REQUIRED ARGUMENTS
+
+=over 4
+
+=item B<series_name>
+
+Unless the B<-series_id=ID> option is given (see the OPTIONS section) it is
+necessary to provide a series name.
+
+Unless the B<-regexp> option is provided (see the OPTIONS section) the
+series name must match exactly, otherwise it is regarded as a MySQL regular
+expression.
+
+=back
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-[no]updatedb>
+
+This option is required to make the script apply any changes that are made to
+the database. By default no updates are applied (B<-noupdatedb>).
+
+=item B<-regexp>
+
+This option causes the B<series_name> argument to be interpreted as a regular
+expression for the MySQL database. By default the argument is treated as if it
+is an exact match.
+
+=item B<-series_id=ID>
+
+The series can be specified by the series ID through this route. If this used then
+the B<series_name> argument is not required (and is ignored if given).
+
+=item B<-[no]description>
+
+This option, if given (as B<-description>), indicates that the 'description'
+field is to be edited.  The Vim editor is invoked to make changes. The default
+is B<-nodescription> meaning that this field is not to be edited.
+
+=item B<-[no]private>
+
+This option, if given (as B<-private>), indicates that the 'private' field is
+to be set to 'true'. If given as B<-noprivate> this field is set to 'false'.
+If omitted altogether then the field is not changed.
+
+=item B<-[no]valid>
+
+This option, if given (as B<-valid>), indicates that the 'valid' field is to
+be set to 'true'. If given as B<-novalid> this field is set to 'false'.
+If omitted altogether then the field is not changed.
+
+=item B<-config=FILE>
+
+This option allows an alternative configuration file to be used. This file
+defines the location of the database, its port, its name and the username and
+password to be used to access it. This feature was added to allow the script
+to access alternative databases or the live database over an SSH tunnel.
+
+See the CONFIGURATION AND ENVIRONMENT section below for the file format.
+
+If the option is omitted the default file is used: B<.hpr_db.cfg>
+
+=back
+
+=head1 DESCRIPTION
+
+The script B<edit_series> provides an editor interface to certain fields in
+the B<miniseries> table of the HPR database. The fields are:
+
+=over 4
+
+=item B<description>
+
+This field is stored in a 'TEXT' field in the database. It is possible for
+the field to contain HTML, and some series do. In general it is better to keep
+this field short since it is displayed in its entirety before the notes for
+each show in the series.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item B<Select one of -description, -private and -valid>
+
+At least one of these options is required. This a fatal error.
+
+=item B<Specify the series name>
+
+If no series name has been provided, and the B<-series_id=ID> option has not been
+used the script is unable to determine the series to edit. This is a fatal
+error.
+
+=item B<Unable to find ...>
+
+The configuration file containing details of the database cannot be found.
+This is a fatal error.
+
+=item B<DBI connect ... failed: Access denied for user ... >
+
+The database connection has been denied. Check the configuration details (see
+below). This a fatal error.
+
+=item B<Too many matches to regex ...>
+
+In B<-regex> mode a series name has been provided that matches too many series in
+the database. Try again with a less ambiguous name. This a fatal error.
+
+=item B<Unable to find series matching regex ...>
+
+In B<-regex> mode a series name has been provided that matches no qseries in the
+database. Try again. This a fatal error.
+
+=item B<Edit failed>
+
+If the Vim edit session fails in some way the script reports it this way. This
+a fatal error.
+
+=item B<Field '...' is too long (...); truncated to ...>
+
+The string provided for the field is greater than the limit and has been
+truncated. This is a warning.
+
+=back
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+The script obtains the credentials it requires to open the HPR database from
+a configuration file. The name of the file it expects is B<.hpr_db.cfg> in the
+directory holding the script. To change this will require changing the script.
+
+The configuration file format is as follows:
+
+ <database>
+     host = 127.0.0.1
+     port = PORT
+     name = DATABASE
+     user = USERNAME
+     password = PASSWORD
+ </database>
+
+=head1 DEPENDENCIES
+
+ Config::General
+ DBI
+ Data::Dumper
+ File::Slurper
+ File::Temp
+ Getopt::Long
+ Pod::Usage
+ SQL::Abstract
+
+=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) 2020 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]
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
+

Database/edit_tsu_blank

@@ -0,0 +1,293 @@
+#!/bin/bash -
+#===============================================================================
+#
+#         FILE: edit_tsu_blank
+#
+#        USAGE: ./edit_tsu_blank
+#
+#  DESCRIPTION: Edit a template for generating a tag and summary update email.
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: Now obsolete but retained for reference
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.11
+#      CREATED: 2016-06-16 10:58:32
+#     REVISION: 2021-09-16 12:51:18
+#
+#===============================================================================
+
+set -o nounset                              # Treat unset variables as an error
+
+SCRIPT=${0##*/}
+
+VERSION="0.0.11"
+
+#
+# Load library functions
+#
+LIB="$HOME/bin/function_lib.sh"
+[ -e "$LIB" ] || { echo "$SCRIPT: Unable to source functions"; exit 1; }
+# shellcheck source=/home/cendjm/bin/function_lib.sh
+source "$LIB"
+
+#===  FUNCTION  ================================================================
+#         NAME: find_work
+#  DESCRIPTION: Using 'grep' to count the number of un-edited lines in certain
+#               files make a list of their names and the number of edits for
+#               display in a 'select'.
+#   PARAMETERS: 1 - the name of the directory holding the files
+#               2 - the prefix of each file to identify them exactly
+#               3 - the name of an array to hold the list
+#      RETURNS: Nothing (uses a nameref argument)
+#===============================================================================
+find_work () {
+    local bd="${1:?Usage: find_work basedir prefix array}"
+    local pf="${2:?Usage: find_work basedir prefix array}"
+    local -n result="${3:?Usage: find_work basedir prefix array}"
+    local -a work
+    local elem count
+
+    # Load all filenames into an array
+    mapfile -t work < <(grep -E -c "^(summary|tags): *$" "$bd/$pf"*[^~])
+
+    # Add names containing work to the result array
+    for elem in "${work[@]}"; do
+        count="${elem##*:}"
+        if [[ $count -gt 0 ]]; then
+            printf -v count '%2d' "$count"
+            # Add colour and a reset for the yellow to be added later
+            result+=( "${elem%%:*}${reset} (${red}$count${reset} edits)" )
+        fi
+    done
+}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+#
+# Check arguments
+#
+if [[ $# -ne 0 ]]; then
+    echo "($SCRIPT Version $VERSION)"
+    echo "Usage: $SCRIPT"
+    exit
+fi
+
+#
+# Directories and files
+#
+BASEDIR="$HOME/HPR/Database"
+TSU="$BASEDIR/tsu"
+VALIDATOR="$BASEDIR/validate_edits.awk"
+STATUSFILE="$BASEDIR/tag_summary_actions.csv"
+
+PREFIX="tag_summary_updates_"
+
+#
+# Sanity checks
+#
+[ -d "$BASEDIR" ] || { echo "Unable to find directory $BASEDIR"; exit 1; }
+[ -d "$TSU" ] || { echo "Unable to find directory $TSU"; exit 1; }
+
+[ -e "$VALIDATOR" ] || { echo "File $VALIDATOR not found"; exit 1; }
+[ -e "$STATUSFILE" ] || { echo "File $STATUSFILE not found"; exit 1; }
+
+#
+# Colour codes
+#
+define_colours
+
+#
+# Using a function find which files have un-edited parts and save their names
+# and the number of edits in an array
+#
+declare -a choices
+find_work "$TSU" "${PREFIX}" choices
+
+#
+# There could be no files with edits
+#
+if [[ ${#choices[@]} -eq 0 ]]; then
+    echo "${red}There are no files in need of editing!${reset}"
+    exit 1
+fi
+
+#
+# Prompt for a choice from the array of files, removing the path from each
+# choice for readability. (Sadly 'select' changed its behaviour in Bash
+# 5 necessitating this). Add a yellow colour code before the resulting
+# filename; there's already a reset after the name.
+#
+PS3="Enter a number: "
+echo "Files in need of editing:"
+# select choice in "${choices[@]##*/}"
+select choice in "${choices[@]/${TSU}\//${yellow}}"
+do
+    break
+done
+
+retval=$?
+if [[ $retval -ne 0 ]]; then
+    echo "${red}Selection aborted${reset}"
+    exit 1
+fi
+
+#
+# Since we removed the full path in the 'select' list 'choice' contains that
+# name rather than the file path, so we need to make it such a path. We also
+# need to remove the string "(X edits)" from the end, and all the colour codes
+# we added earlier, then edit the file.
+#
+# We include Vim settings for the text width and filetype, and perform
+# a search for the next field that needs work (using 'silent!' to stop nasty
+# error messages if there's nothing that matches).
+#
+# We use an Awk script to determine if the file contains any shows which have
+# already been updated by another person. We use the file $STATUSFILE which
+# gets updated every time a report is generated.
+#
+
+# Strip colour codes
+choice="${choice//$yellow/}"
+choice="${choice//$red/}"
+choice="${choice//$reset/}"
+
+#
+# Run the Awk validator, and if OK edit the file, otherwise try to explain
+# what's wrong.
+#
+choice="$TSU/${choice%% *}"
+if awk --assign "csv=$STATUSFILE" -f "$VALIDATOR" "$choice"; then
+    csum1=$(md5sum < "$choice")
+    echo "Editing $choice"
+    vim +"set tw=100 ft=text" -c 'silent! /^\(summary\|tags\):\s*$'  "$choice"
+    csum2=$(md5sum < "$choice")
+
+    if [[ $csum1 == "$csum2" ]]; then
+        echo "${yellow}No change was made${reset}"
+        exit
+    fi
+else
+    echo "${red}Errors found checking the file${reset}"
+    echo "Show(s) in this file have already been updated in the database."
+    echo "Somebody else has probably sent in an update for show(s) in the range."
+    echo "The file ${yellow}${choice}${reset}"
+    echo "has been edited automatically to comment out the updated show(s) and"
+    echo "is now ready for editing in the usual way (rerun this script to do it)."
+    echo "----"
+    echo "(This error may also be caused by an internal fault when running"
+    echo "awk. Check the file to be certain.)"
+    exit 1
+fi
+
+#
+# Perform a check on what is now in the file looking for lines that are too
+# long or with a bad show number
+#
+echo "${yellow}Checking show numbers and lengths of summaries and tags${reset}"
+re="^([A-Za-z]+): *(.*) *$"
+count=0; errors=0
+while read -r line; do
+    ((count++))
+    if [[ $line =~ $re ]]; then
+        key="${BASH_REMATCH[1]}"
+        value="${BASH_REMATCH[2]}"
+        case $key in
+            show)
+                if [[ ! $value =~ [0-9]{1,4} ]]; then
+                    ((errors++))
+                    printf '**Error**\n%02d: %s\n' "$count" "$line"
+                    echo "${blue}The show value must be a number (${#value})${reset}"
+                fi
+                ;;
+
+            summary)
+                if [[ ${#value} -gt 100 ]]; then
+                    ((errors++))
+                    printf '**Error**\n%02d: %s\n' "$count" "$line"
+                    echo "${blue}Value too long (${#value}, should be 100 max)${reset}"
+                fi
+                ;;
+
+            tags)
+                if [[ ${#value} -gt 200 ]]; then
+                    ((errors++))
+                    printf '**Error**\n%02d: %s\n' "$count" "$line"
+                    echo "${blue}Value too long (${#value}, should be 200 max)${reset}"
+                fi
+                ;;
+
+            esac
+    fi
+done < "$choice"
+
+#
+# Report a summary of the check
+#
+if [[ $errors -eq 0 ]]; then
+    echo "${green}No errors found${reset}"
+else
+    echo "${red}Found $errors errors${reset}"
+fi
+
+#
+# Make temporary files and set traps to delete them
+#
+TMP1=$(mktemp) || {
+    echo "$SCRIPT: ${red}creation of temporary file failed!${reset}"
+    exit 1
+}
+trap 'cleanup_temp $TMP1' SIGHUP SIGINT SIGPIPE SIGTERM EXIT
+
+#
+# Make a temporary Awk script
+#
+cat > "$TMP1" <<'ENDAWK'
+BEGIN {
+    shows = total = finished = todo = 0
+}
+
+/^show:/          { shows++ }
+/^tags:\s*$/      { total++; todo++ }
+/^tags:\s*\S+/    { total++; finished++ }
+/^summary:\s*$/   { total++; todo++ }
+/^summary:\s*\S+/ { total++; finished++ }
+
+END {
+    printf "shows=%d\n",shows
+    printf "total=%d\n",total
+    printf "finished=%d\n",finished
+    printf "todo=%d\n",todo
+    printf "left=%2.1f%%\n",(todo/total)*100
+}
+ENDAWK
+
+#
+# Run the Awk script and make variables
+#
+declare shows total todo finished left
+eval "$(awk -f "$TMP1" "$choice")"
+
+# todo="$(grep -E -c "^(summary|tags):\s*$" "$choice")"
+# total="$(grep -E -c "^(summary|tags):" "$choice")"
+# completed="$(grep -E -c "^(summary|tags): *\w+" "$choice")"
+
+#
+# Is there still work to do on this file?
+#
+echo "${yellow}File statistics:${reset}"
+printf '%s%-19s %s%s\n' "${purple}" "Total shows:" "$shows" "${reset}"
+printf '%s%-19s %s%s\n' "${purple}" "Additions required:" "$total" "${reset}"
+printf '%s%-19s %s%s\n' "${purple}" "Already done:" "$finished" "${reset}"
+printf '%s%-19s %s%s\n' "${purple}" "Percent left:" "$left" "${reset}"
+case $todo in
+    0) echo "${green}All required work on this file has been done${reset}";;
+    1) echo "${red}There is still $todo tag/summary to add${reset}";;
+    *) echo "${red}There are still $todo tags/summaries to add${reset}"
+esac
+
+exit
+
+# vim: syntax=sh:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+

Database/find_double_hosts

@@ -0,0 +1,425 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: find_double_hosts
+#
+#        USAGE: ./find_double_hosts
+#
+#  DESCRIPTION: Find HPR shows with two hosts (host is "A and B"), find the
+#               hosts if possible and flag updates to the database to
+#               represent the dual nature.
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.2
+#      CREATED: 2017-10-13 19:17:51
+#     REVISION: 2017-10-13 19:19:43
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use Config::General;
+use DBI;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.2';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile1 = "$basedir/.hpr_db.cfg";
+my $configfile2 = "$basedir/.hpr_pg.cfg";
+
+my $email_template  = 'host_%s@hackerpublicradio.org';
+my $default_licence = 'CC-BY-SA';
+
+my ( $dbh1, $dbh2, $sth1, $h1, $rv1, $sth2, $h2, $rv2, $sth3, $h3, $rv3, $sth4, $h4, $rv4 );
+
+my ( %doubles, @h, %hosts, $unknown, $default_email );
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#
+# Load database configuration data
+#
+my $conf1 = Config::General->new(
+    -ConfigFile      => $configfile1,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config1 = $conf1->getall();
+
+my $conf2 = Config::General->new(
+    -ConfigFile      => $configfile2,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config2 = $conf2->getall();
+
+#-------------------------------------------------------------------------------
+# Connect to the MariaDB database
+#-------------------------------------------------------------------------------
+my $dbtype1 = $config1{database}->{type} // 'mysql';
+my $dbhost1 = $config1{database}->{host} // '127.0.0.1';
+my $dbport1 = $config1{database}->{port} // 3306;
+my $dbname1 = $config1{database}->{name};
+my $dbuser1 = $config1{database}->{user};
+my $dbpwd1  = $config1{database}->{password};
+$dbh1
+    = DBI->connect( "dbi:$dbtype1:host=$dbhost1;port=$dbport1;database=$dbname1",
+    $dbuser1, $dbpwd1, { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh1->{mysql_enable_utf8} = 1;
+
+#-------------------------------------------------------------------------------
+# Connect to the PostgreSQL database
+#-------------------------------------------------------------------------------
+my $dbtype2 = $config2{database}->{type} // 'Pg';
+my $dbhost2 = $config2{database}->{host} // '127.0.0.1';
+my $dbport2 = $config2{database}->{port} // 5432;
+my $dbname2 = $config2{database}->{name};
+my $dbuser2 = $config2{database}->{user};
+my $dbpwd2  = $config2{database}->{password};
+$dbh2 = DBI->connect( "dbi:$dbtype2:host=$dbhost2;database=$dbname2;port=$dbport2",
+    $dbuser2, $dbpwd2, { PrintError => 0, AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh2->{pg_enable_utf8} = 1;
+
+#-------------------------------------------------------------------------------
+# Query preparation
+#-------------------------------------------------------------------------------
+#
+# MariaDB query to find double hosts
+#
+my $sql1 = q{
+    SELECT hostid, host FROM hosts
+    WHERE host regexp '[[:<:]]and[[:>:]]'
+    ORDER BY hostid
+};
+
+$sth1 = $dbh1->prepare($sql1) or die $DBI::errstr;
+if ( $dbh1->err ) {
+    warn $dbh1->errstr;
+}
+
+#
+# MariaDB query to find the host by name
+#
+$sth2 = $dbh1->prepare(q{SELECT hostid FROM hosts WHERE host REGEXP ?})
+    or die $DBI::errstr;
+if ( $dbh1->err ) {
+    warn $dbh1->errstr;
+}
+
+#
+# PostgreSQL query to register an unknown host
+#
+$sth3
+    = $dbh2->prepare(q{INSERT INTO hosts (host,email,license) VALUES (?,?,?)})
+    or die $DBI::errstr;
+if ( $dbh2->err ) {
+    warn $dbh2->errstr;
+}
+
+#
+# PostgreSQL query to find shows with particular host ids
+#
+$sth4 = $dbh2->prepare(
+    q{
+        SELECT e.id AS eps_id
+        FROM episodes e
+        JOIN episodes_hosts_xref eh ON (e.id = eh.episodes_id)
+        JOIN hosts h ON (h.id = eh.hosts_id)
+        WHERE h.id = ?
+    }
+) or die $DBI::errstr;
+if ( $dbh2->err ) {
+    warn $dbh2->errstr;
+}
+
+#-------------------------------------------------------------------------------
+# Find all the "double hosts"
+#-------------------------------------------------------------------------------
+#
+# Query MariaDB for the target hosts
+#
+$sth1->execute;
+if ( $dbh1->err ) {
+    die $dbh1->errstr;
+}
+
+#
+# Loop through the list of double hostnames and parse them out. Save the
+# originals in the %doubles hash and the parsed names in the %hosts hash.
+#
+while ( $h1 = $sth1->fetchrow_hashref ) {
+    #
+    # Each hash value is a hash containing the original id, and, in a sub-hash
+    # the replacement ids
+    #
+    $doubles{$h1->{host}} = {
+        double => $h1->{hostid},
+        singles => {},
+    };
+
+    #
+    # Parse the double host string
+    #
+    @h = ( $h1->{host} =~ /^(.+)\s+and\s+(.+)$/ );
+
+    printf "%-4d %s", $h1->{hostid}, $h1->{host};
+    print " [", join( ",", @h ), "]\n";
+
+    #
+    # Initialise the entries for %doubles and %hosts
+    #
+    for my $host (@h) {
+        $doubles{$h1->{host}}->{singles}->{$host} = undef;
+        unless ( exists( $hosts{$host} ) ) {
+            $hosts{$host} = 0;
+        }
+    }
+}
+
+print '-' x 80,"\n";
+
+#-------------------------------------------------------------------------------
+# Find the single hosts in the 'hosts' table
+#-------------------------------------------------------------------------------
+#
+# Scan the list of individual hosts and find them in the 'hosts' table
+#
+$unknown = 0;
+foreach my $host ( sort(keys(%hosts)) ) {
+    $rv2 = $sth2->execute("^$host\$");
+    if ( $dbh1->err ) {
+        die $dbh1->errstr;
+    }
+    $rv2 = 0 if ( $rv2 eq '0E0' );
+
+    if ($rv2) {
+        $h2 = $sth2->fetchrow_hashref;
+        print "Found id for $host: ", $h2->{hostid}, "\n";
+        $hosts{$host} = $h2->{hostid};
+        save_hostid(\%doubles,$host,$h2->{hostid});
+    }
+    else {
+        print "Can't find $host\n";
+        $unknown++;
+    }
+}
+
+#print Dumper(\%hosts),"\n";
+
+print '-' x 80,"\n";
+
+#-------------------------------------------------------------------------------
+# Allocate all unknown hosts a host id in the PostgreSQL database, and give an
+# unique email address.
+#-------------------------------------------------------------------------------
+if ( $unknown > 0 ) {
+    print "Registering $unknown hosts\n";
+
+    foreach my $host ( sort( keys(%hosts) ) ) {
+        if ( $hosts{$host} == 0 ) {
+            $rv3 = $sth3->execute( $host, undef, $default_licence );
+            if ( $dbh2->err ) {
+                die $dbh2->errstr;
+            }
+
+            #
+            # Write a row to the 'hosts' table and save the id number
+            # generated
+            #
+            my $newid = $dbh2->last_insert_id( undef, undef, undef, undef,
+                { sequence => 'host_seq' } );
+            $hosts{$host} = $newid;
+            save_hostid(\%doubles,$host,$newid);
+            print "Host $host added with id $newid\n";
+
+            #
+            # Give the new host entry a default email address
+            #
+            $default_email = sprintf($email_template,$newid);
+            $rv3 = $dbh2->do( 'UPDATE hosts SET email = ? WHERE id = ?',
+                undef, $default_email, $newid );
+            if ( $dbh2->err ) {
+                warn $dbh2->errstr;
+            }
+            $rv3 = 0 if ( $rv3 eq '0E0' );
+
+            warn "Failed to set email address $default_email for $host\n"
+                unless ( defined($rv3) );
+
+        }
+    }
+}
+
+print '-' x 80,"\n";
+
+#-------------------------------------------------------------------------------
+# Now %doubles contains all the original names and host ids and %hosts
+# contains the parsed out names and their ids. We can look for shows
+# attributed to the first set and re-attribute them to the second set.
+#-------------------------------------------------------------------------------
+print "Changing host associations for shows with two hosts\n";
+foreach my $double ( sort( keys(%doubles) ) ) {
+    print "Processing $double\n";
+    my ( $doubleid, @newids ) = (
+        $doubles{$double}->{double},
+        values( %{ $doubles{$double}->{singles} } )
+    );
+    print "  Original id: $doubleid\n";
+    print "  Replacements: ", join( ", ", @newids ), "\n";
+
+    #
+    # Find shows marked as belonging to this double-host
+    #
+    $sth4->execute($doubleid);
+    if ( $dbh2->err ) {
+        die $dbh2->errstr;
+    }
+
+    #
+    # Process all the shows
+    #
+    while ( $h4 = $sth4->fetchrow_hashref ) {
+        my $eps_id = $h4->{eps_id};
+        print "  Show $eps_id is ascribed to host $doubleid\n";
+
+        $dbh2->begin_work();
+
+        #
+        # Delete the xref link for the double host
+        #
+        $rv4
+            = $dbh2->do(
+            'DELETE FROM episodes_hosts_xref WHERE episodes_id = ?',
+            undef, $eps_id );
+        if ( $dbh2->err ) {
+            warn $dbh2->errstr;
+        }
+        $rv4 = 0 if ( $rv4 eq '0E0' );
+
+        if ( defined($rv4) ) {
+            print "  Deleted entry from episodes_hosts_xref for $eps_id\n";
+        }
+        else {
+            warn "Problem deleting from episodes_hosts_xref for $eps_id\n";
+        }
+
+        #
+        # Add links for the single hosts
+        #
+        foreach my $hid (@newids) {
+            $rv4 = $dbh2->do( 'INSERT INTO episodes_hosts_xref VALUES (?,?)',
+                undef, $eps_id, $hid );
+            if ( $dbh2->err ) {
+                warn $dbh2->errstr;
+            }
+            $rv4 = 0 if ( $rv4 eq '0E0' );
+
+            if ( defined($rv4) ) {
+                print "  Added entry to episodes_hosts_xref values ",
+                    "$eps_id,$hid\n";
+            }
+            else {
+                warn "Problem adding to episodes_hosts_xref values "
+                    . "$eps_id,$hid\n";
+            }
+
+        }
+
+        #
+        # Commit the delete/inserts above
+        #
+        $dbh2->commit();
+
+    }
+    print '~' x 80, "\n";
+
+    #
+    # Delete the double host (NOTE: This will fail due to referential
+    # integrity if the DELETE above failed, so there is scope for debris to be
+    # left around)
+    #
+    $rv4 = $dbh2->do( 'DELETE FROM hosts WHERE id = ?', undef, $doubleid );
+    if ( $dbh2->err ) {
+        warn $dbh2->errstr;
+    }
+    $rv4 = 0 if ( $rv4 eq '0E0' );
+
+    if ( defined($rv4) ) {
+        print "  Deleted entry from hosts for id $doubleid ($double)\n";
+    }
+    else {
+        warn "Problem deleting from hosts for id $doubleid ($double)\n";
+    }
+
+}
+
+print '-' x 80,"\n";
+
+exit;
+
+#===  FUNCTION  ================================================================
+#         NAME: save_hostid
+#      PURPOSE: Saves the host id after searching for the key in the %doubles
+#               hash
+#   PARAMETERS: $doubles                hashref to %doubles
+#               $host                   host key
+#               $hostid                 host id number
+#      RETURNS: Nothing
+#  DESCRIPTION: Searches the %doubles hash for particular keys in the
+#               'singles' sub-hash. If found saves the corresponding host id
+#               there.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub save_hostid {
+    my ( $doubles, $host, $hostid ) = @_;
+
+    foreach my $key ( keys(%$doubles) ) {
+        if ( exists( $doubles->{$key}->{singles}->{$host} ) ) {
+            $doubles->{$key}->{singles}->{$host} = $hostid;
+        }
+    }
+}
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
+

Database/find_series

@@ -0,0 +1,397 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: find_series
+#
+#        USAGE: ./find_series
+#
+#  DESCRIPTION: Gathers information from the HPR database to assist with the
+#               process of placing episodes into series groups
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.5
+#      CREATED: 2014-04-25 17:11:21
+#     REVISION: 2016-06-15 15:51:55
+#
+#===============================================================================
+
+use v5.16;
+use strict;
+use warnings;
+use utf8;
+
+use Config::General;
+use List::MoreUtils qw(uniq);
+use YAML::XS qw{LoadFile};
+
+use DBI;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.5';
+
+#
+# Various constants
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.cfg";
+my $ignorefile = "$basedir/.$PROG.yml";
+
+my $file_template = "${PROG}_%d.out";
+
+my ( $dbh,    $sth1,    $h1 );
+my ( @ignore, $title,   @words, $pair );
+my ( %eps,    %tags,    @taglist, %single_words, %double_words );
+my ( $phase,  $outfile, $outfh );
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#
+# Load YAML ignore list
+#
+my $yaml = LoadFile($ignorefile);
+@ignore = uniq( @{ $yaml->{ignore} } );
+
+#
+# Load database configuration data
+#
+my $conf = Config::General->new(
+    -ConfigFile      => $configfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+#
+# Prepare to collect episode titles with the series it's related to
+#
+$sth1 = $dbh->prepare(
+    q{SELECT
+            eps.id AS eps_id,
+            eps.date,
+            eps.title,
+            eps.duration,
+            eps.summary,
+            eps.notes,
+            eps.hostid,
+            eps.series,
+            eps.explicit,
+            eps.license,
+            eps.tags,
+            eps.version,
+            eps.downloads,
+            eps.valid AS eps_valid,
+            ms.id AS ms_id,
+            ms.name,
+            ms.description,
+            ms.private,
+            ms.image,
+            ms.valid AS ms_valid
+        FROM eps
+        JOIN miniseries ms ON eps.series = ms.id
+        WHERE eps.valid = 1}
+);
+$sth1->execute;
+if ( $dbh->err ) {
+    warn $dbh->errstr;
+}
+
+#
+# Generate an output file for phase 1
+#
+$phase = 1;
+newOutput( \$outfh, $file_template, $phase++ );
+print $outfh "Show  (Series) Title\n";
+
+#-------------------------------------------------------------------------------
+# Walk through the episode/series list from the database and build structures
+# from them.
+#-------------------------------------------------------------------------------
+# The structures built are:
+#
+# %eps - a hash indexed by the episode number with an arrayref as the
+# value. The arrayref starts with the episode title and is followed by the
+# important words from the title in lower case. The term "important" means
+# that the word must consist of the allowed characters and not be in the
+# 'ignore' list.
+#
+# %tags - a hash indexed by the episode number with a CSV string of tags
+# associated with the episode as the value.
+#
+# %single_words - a hash indexed by one of the words collected from the title
+# (see %eps above). The value of each element is complex. It consists of an
+# arrayref, the first element of which is a count of the succeeding elements.
+# The next N elements are arrayrefs each of which contains two elements: an
+# episode number and an episode title. Here is an example in Data::Dumper
+# format:
+#
+# 'pre-ibm' => [
+#                2,
+#                [
+#                  687,
+#                  'pre-IBM PC computer history 1'
+#                ],
+#                [
+#                  691,
+#                  'pre-IBM PC computer history 2'
+#                ]
+#              ],
+#
+#-------------------------------------------------------------------------------
+while ( $h1 = $sth1->fetchrow_hashref ) {
+    #
+    # Report what we found
+    #
+    printf $outfh "%4d: (%-2d)     %s\n", $h1->{eps_id}, $h1->{ms_id},
+        $h1->{title};
+
+    #
+    # Skip this episode if it already has a series
+    #
+    next if $h1->{series} > 0;
+
+    #
+    # Save this episode for later
+    #
+    $eps{ $h1->{eps_id} } = [ $h1->{title} ];
+
+    #
+    # Save tag details
+    #
+    $tags{ $h1->{eps_id} } = $h1->{tags};
+
+    #
+    # Strip any trailing full stop, and chop the title into words
+    #
+    ( $title = $h1->{title} ) =~ s/\.$//;
+    @words = split( /\s+/, $title );
+
+    #
+    # Remove all unwanted characters and force to lowercase (use 'fc' for case
+    # folding since it's aware of character sets)
+    #
+    foreach my $word (@words) {
+        $word =~ s{[^a-zA-Z./_-]}{}g;
+        $word = fc($word);
+    }
+
+    #
+    # Clean up the word list after removing unwanted characters
+    #
+    @words = grep { $_ !~ /^-*$/ } @words;
+
+    #
+    # Extract pairs of words before they're made unique and make a hash
+    # pointing to the episodes they originated from
+    #
+    for (my $i = 0; $i < $#words; $i++) {
+        $pair = "$words[$i] $words[$i+1]";
+
+        if ( exists( $double_words{$pair} ) ) {
+            $double_words{$pair}->[0] += 1;
+            push( @{ $double_words{$pair} },
+                [ $h1->{eps_id}, $h1->{title} ] );
+        }
+        else {
+            $double_words{$pair} = [ 1, [ $h1->{eps_id}, $h1->{title} ] ];
+        }
+    }
+
+    #
+    # Make the word list unique
+    #
+    @words = uniq(@words);
+
+    #
+    # Walk the tidied single word list
+    #
+    foreach my $word (@words) {
+        #
+        # Ignore very short words and words in the ignore list
+        #
+        next if length($word) < 2;
+        next if grep( /^$word$/, @ignore );
+
+        #
+        # Save this word in the episodes hash
+        #
+        push( @{ $eps{ $h1->{eps_id} } }, $word );
+
+        #
+        # If the word is not known initialise the entry containing an arrayref
+        # with a counter and another arrayref with the saved episode number
+        # and title. If it's known, increment the counter and stash the
+        # episode details as another arrayref.
+        #
+        if ( exists( $single_words{$word} ) ) {
+            $single_words{$word}->[0] += 1;
+            push( @{ $single_words{$word} },
+                [ $h1->{eps_id}, $h1->{title} ] );
+        }
+        else {
+            $single_words{$word} = [ 1, [ $h1->{eps_id}, $h1->{title} ] ];
+        }
+    }
+}
+
+#
+# We've finished with the database
+#
+$dbh->disconnect;
+
+#-------------------------------------------------------------------------------
+# Done the first pass, prepare for the next
+#-------------------------------------------------------------------------------
+newOutput( \$outfh, $file_template, $phase++ );
+
+#
+# Process the saved data in increasing order of the frequency. Print the word
+# and its frequency and follow that by the stashed episode details in the
+# order we saw them
+#
+foreach my $key (
+    sort { $single_words{$a}->[0] <=> $single_words{$b}->[0] }
+    sort( keys(%single_words) )
+    )
+{
+    if ( $single_words{$key}->[0] > 3 ) {
+        printf $outfh "%15s: %s\n", $key, $single_words{$key}->[0];
+        for ( my $i = 1; $i <= $single_words{$key}->[0]; $i++ ) {
+            printf $outfh "%17s%4d: %s", ' ', @{ $single_words{$key}->[$i] };
+            @taglist
+                = split( /\s*,\s*/, $tags{ $single_words{$key}->[$i]->[0] } );
+            if (@taglist) {
+                print $outfh " [", join( ",", @taglist ), "]\n";
+            }
+            else {
+                print $outfh "\n";
+            }
+        }
+        print $outfh "\n";
+    }
+}
+
+#-------------------------------------------------------------------------------
+# Done the second pass, prepare for the next
+#-------------------------------------------------------------------------------
+newOutput( \$outfh, $file_template, $phase++ );
+
+#
+# Look through the collected data from the point of view of the episode, list
+# all the (relevant) words in the title in order and report their frequencies
+#
+for my $key ( sort { $a <=> $b } keys(%eps) ) {
+    printf $outfh "%4d: %s\n", $key, $eps{$key}->[0];
+    for ( my $i = 1; $i < scalar( @{ $eps{$key} } ); $i++ ) {
+        my $word = $eps{$key}->[$i];
+        printf $outfh "      %15s %d\n", $word, $single_words{$word}->[0];
+    }
+    print $outfh "\n";
+}
+
+#-------------------------------------------------------------------------------
+# Done the third pass, prepare for the next
+#-------------------------------------------------------------------------------
+newOutput( \$outfh, $file_template, $phase++ );
+
+#
+# So the pairs of words we collected earlier might show something interesting.
+# Let's see.
+#
+foreach my $key (
+    sort { $double_words{$a}->[0] <=> $double_words{$b}->[0] }
+    sort( keys(%double_words) )
+    )
+{
+    if ( $double_words{$key}->[0] > 3 ) {
+        printf $outfh "%15s: %s\n", $key, $double_words{$key}->[0];
+        for ( my $i = 1; $i <= $double_words{$key}->[0]; $i++ ) {
+            printf $outfh "%17s%4d: %s", ' ', @{ $double_words{$key}->[$i] };
+            @taglist
+                = split( /\s*,\s*/, $tags{ $double_words{$key}->[$i]->[0] } );
+            if (@taglist) {
+                print $outfh " [", join( ",", @taglist ), "]\n";
+            }
+            else {
+                print $outfh "\n";
+            }
+        }
+        print $outfh "\n";
+    }
+}
+
+
+close($outfh);
+
+exit;
+
+#===  FUNCTION  ================================================================
+#         NAME: newOutput
+#      PURPOSE: Generate a new output file
+#   PARAMETERS: $fh             a scalar ref pointing to a variable to hold a
+#                               file handle
+#               $template       a string suitable for sprintf for defining the
+#                               name of the output file
+#               $phase          an integer to be incorporated into the output
+#                               file name
+#      RETURNS: Nothing
+#  DESCRIPTION: Closes any existing file and opens a new one with the same
+#               file handle. The name of the file is derived from the template
+#               and the phase number.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub newOutput {
+    my ( $fh, $template, $phase ) = @_;
+
+    if ($$fh) {
+        close($$fh) if ( tell($$fh) > -1 );
+    }
+
+    my $outfile = sprintf( $template, $phase );
+    open( $$fh, '>:encoding(UTF-8)', $outfile )
+        or die "Unable to open $outfile\n";
+
+    return;
+}
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker

Database/fix_urls

@@ -0,0 +1,708 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: fix_urls
+#
+#        USAGE: ./fix_urls [-help] [-doc] [-debug=N] [-dry-run] [-config=FILE]
+#                       [-limit=N] tablename
+#
+#  DESCRIPTION: Scans the HPR database to find URLs which do not have the
+#               'https:' scheme and correct them.
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: Had to revert to MySQL because of a problem with DBD::MariaDB
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.5
+#      CREATED: 2021-12-29 13:57:28
+#     REVISION: 2022-02-28 10:51:27
+#
+#===============================================================================
+
+use v5.16;
+use strict;
+use warnings;
+use utf8;
+use feature qw{ postderef say signatures state };
+no warnings qw{ experimental::postderef experimental::signatures };
+
+use Getopt::Long;
+use Pod::Usage;
+
+use Config::General;
+use DBI;
+
+use SQL::Abstract;
+
+use Log::Handler;
+use Log::Handler::Output::File;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.5';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.cfg";
+my $logfile    = "$basedir/${PROG}.log";
+
+my $dbh;
+
+                                #<<<  do not let perltidy change formatting
+#
+# The database tables we'll search and how to do what we need.
+#
+# main_key - the name of a table (with a hashref as the value)
+#       index           the database field we're using to find a row
+#       fields          fields we may need to edit (an arrayref)
+#       logfields       fields we will log (an arrayref)
+#       mainQ           the query that finds all rows needing work
+#       rowQ            a query for finding a row using the index value
+#
+my %tables = (
+    'comments' => {
+        index     => 'id',
+        fields    => [qw{comment_title comment_text}],
+        logfields => [qw{eps_id comment_title}],
+        mainQ     => q{
+            select id
+                from comments
+                where comment_text regexp 'http://[^[:space:]]'
+                    or comment_title regexp 'http://[^[:space:]]'
+            order by id},
+        rowQ => q{select * from comments where id = ?},
+    },
+    'eps' => {
+        index     => 'id',
+        fields    => [qw{title summary notes}],
+        logfields => [qw{title date}],
+        mainQ     => q{
+            select id
+                from eps
+                where title regexp 'http://[^[:space:]]'
+                    or summary regexp 'http://[^[:space:]]'
+                    or notes regexp 'http://[^[:space:]]'
+            order by id
+            },
+        rowQ => q{select * from eps where id = ?},
+    },
+    'hosts' => {
+        index     => 'hostid',
+        fields    => [qw{profile}],
+        logfields => [qw{host email}],
+        mainQ     => q{
+            select hostid
+                from hosts
+                where profile regexp 'http://[^[:space:]]'
+            order by hostid},
+        rowQ => q{select * from hosts where hostid = ?},
+    },
+    'miniseries' => {
+        index     => 'id',
+        fields    => [qw{description}],
+        logfields => [qw{name}],
+        mainQ     => q{
+            select id
+                from miniseries
+                where description regexp 'http://[^[:space:]]'
+            order by id},
+        rowQ => q{select * from miniseries where id = ?},
+    },
+);
+                                #>>>
+my @table_names = keys(%tables);
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#-------------------------------------------------------------------------------
+# Options and arguments
+#-------------------------------------------------------------------------------
+my $DEF_DEBUG = 0;
+my $DEF_LIMIT = 0;
+
+#
+# Process options
+#
+my %options;
+Options( \%options );
+
+#
+# Default help
+#
+pod2usage( -msg => "$PROG version $VERSION\n", -verbose => 0, -exitval => 1 )
+    if ( $options{'help'} );
+
+#
+# Full documentation if requested with -doc
+#
+pod2usage(
+    -msg       => "$PROG version $VERSION\n",
+    -verbose   => 2,
+    -exitval   => 1,
+    -noperldoc => 0,
+) if ( $options{'doc'} );
+
+#
+# Collect options
+#
+my $DEBUG = ( defined( $options{debug} ) ? $options{debug} : $DEF_DEBUG );
+
+my $cfgfile
+    = ( defined( $options{config} ) ? $options{config} : $configfile );
+
+my $dry_run = ( defined( $options{'dry-run'} ) ? $options{'dry-run'} : 0 );
+my $verbose = ( defined( $options{'verbose'} ) ? $options{'verbose'} : 0 );
+
+my $limit = ( defined( $options{limit} ) ? $options{limit} : $DEF_LIMIT );
+$limit = abs($limit);
+
+#
+# Sanity check
+#
+die "Unable to find config file '$cfgfile'\n" unless ( -e $cfgfile );
+
+#
+# Table choice
+#
+my $table = shift;
+die "Database table not specified\n" unless $table;
+die "Not a valid table name: $table\n"
+    unless ( grep { $_ =~ /^$table$/ } @table_names );
+
+#
+# Load configuration data
+#
+my $conf = new Config::General(
+    -ConfigFile      => $cfgfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+#$dbh = DBI->connect( "DBI:MariaDB:host=$dbhost;port=$dbport;database=$dbname",
+#    $dbuser, $dbpwd, { AutoCommit => 1, RaiseError => 1 } )
+#    or die $DBI::errstr;
+
+$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+
+#-------------------------------------------------------------------------------
+# Set up logging keeping the default log layout except for the date
+#-------------------------------------------------------------------------------
+my $log = Log::Handler->new();
+
+$log->add(
+    file => {
+        timeformat => "%Y-%m-%d %H:%M:%S",
+        filename   => $logfile,
+        maxlevel   => 7,
+        minlevel   => 0,
+        utf8       => 1,
+    }
+);
+
+$log->info("Configuration file $cfgfile");
+$log->info("Processing table $table");
+$log->info("Dry-run mode") if ($dry_run);
+
+process_table( $dbh, \%tables, $table, $dry_run, $limit );
+
+exit;
+
+#===  FUNCTION  ================================================================
+#         NAME: process_table
+#      PURPOSE: Processes a table to change any instances of 'http://' to
+#               'https://'
+#   PARAMETERS: $dbh            open database handle
+#               $rtables        reference to the %tables hash
+#               $table          name of the table being processed
+#               $dry_run        Boolean showing whether this is dry run or not
+#               $limit          number of updates to apply, 0 = no limit
+#      RETURNS:
+#  DESCRIPTION:
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub process_table {
+    my ( $dbh, $rtables, $table, $dry_run, $limit ) = @_;
+
+    my ( $sth1,       $sth2,  $h );
+    my ( $work_query, @work,  $row_query, @fields, @logfields, $new, $index );
+    my ( $sql,        $stmt,  @bind,      %fieldvals, %where );
+    my ( $workcount,  $count, $updates,   $logfmt );
+
+    #
+    # Prepare to build SQL
+    #
+    $sql = SQL::Abstract->new;
+
+    $count   = 0;
+    $updates = 0;
+
+    #
+    # Find any rows in need of work as an array/list of the index values. The
+    # selectall_arrayref returns a reference to an array containing arrayrefs,
+    # so the 'map' flattens that structure.
+    #
+    $work_query = $rtables->{$table}->{mainQ};
+    @work       = map { $_->[0] } @{ $dbh->selectall_arrayref($work_query) };
+
+    $workcount = scalar(@work);
+    printf "Number of rows requiring work: %d\n", $workcount if $verbose;
+
+    _debug( $DEBUG >= 1, "Number of rows requiring work: $workcount" )
+        unless $verbose;
+    _debug( $DEBUG >= 2,
+        "Rows requiring work: " . join( ",", @work ) . "\n" );
+
+    #
+    # If there's nothing to do say so and leave
+    #
+    unless (@work) {
+        print "Nothing to do to table '$table'!\n";
+        return;
+    }
+
+    #
+    # Pull configuration values from the hash
+    #
+    $row_query = $rtables->{$table}->{rowQ};
+    @fields    = @{ $rtables->{$table}->{fields} };
+    @logfields = @{ $rtables->{$table}->{logfields} };
+    $index     = $rtables->{$table}->{index};
+
+    _debug( $DEBUG >= 3, "\$row_query = $row_query" );
+    _debug( $DEBUG >= 3, "\@fields = " . join( ",", @fields ) );
+    _debug( $DEBUG >= 3, "\$index = $index" );
+
+    #
+    # Prepare for logging by making a format string for sprintf
+    #
+    $logfmt = 'Updated row with ';
+    $logfmt .= join( ", ", map {"$_ = '%s'"} $index, @logfields );
+
+    _debug( $DEBUG >= 3, "\$logfmt = $logfmt" );
+
+    #
+    # Set up query for the next eligible row
+    #
+    $sth1 = $dbh->prepare($row_query) or die $DBI::errstr;
+    if ( $dbh->err ) {
+        die $dbh->errstr;
+    }
+
+    #
+    # Loop through rows needing work
+    #
+    foreach my $pkey (@work) {
+        #
+        # The row is indexed by the per-table key
+        #
+        $sth1->execute($pkey) or die $DBI::errstr;
+        if ( $dbh->err ) {
+            die $dbh->errstr;
+        }
+
+        #
+        # Grab the row (there must be only one with this index)
+        #
+        if ( $h = $sth1->fetchrow_hashref ) {
+            #
+            # Set up the 'where' options for SQL::Abstract
+            #
+            %where = ( $index => { '=', $pkey } );
+            _debug( $DEBUG >= 3, Dumper( \%where ) );
+
+            #
+            # Work on the fields we know might contain HTML
+            #
+            for my $field (@fields) {
+                #
+                # Perform the change
+                #
+                ( $new = $h->{$field} ) =~ s{\bhttp://(\S)}{https://$1}ig;
+
+                #
+                # Set up SQL::Abstract parameters
+                #
+                $fieldvals{$field} = $new;
+            }
+
+            #
+            # Use SQL::Abstract to make the statement and the bind parameters
+            #
+            ( $stmt, @bind ) = $sql->update( $table, \%fieldvals, \%where );
+
+            #
+            # Do the change or report it depending on dry-run mode
+            #
+            unless ($dry_run) {
+                $sth2 = $dbh->prepare($stmt) or die $DBI::errstr;
+                $sth2->execute(@bind)        or die $DBI::errstr;
+                $log->info( sprintf( $logfmt, $pkey, @{$h}{@logfields} ) );
+                printf $logfmt. "\n", $pkey, @{$h}{@logfields} if $verbose;
+                $updates++;
+            }
+            else {
+                print "No change made in dry-run mode\n";
+                if ($verbose) {
+                    print "SQL: $stmt\n";
+                    print "Bind> ", join( "\nBind> ", @bind ), "\n";
+                    print '-' x 80, "\n";
+                }
+            }
+        }
+
+        #
+        # Apply the limit if appropriate
+        #
+        $count++;
+        unless ( $limit == 0 ) {
+            last if ( $count >= $limit );
+        }
+
+    }
+
+    unless ($dry_run) {
+        $log->info("Number of updates = $updates");
+        if ($verbose) {
+            print "Number of updates = $updates\n";
+            printf "Remaining rows needing attention: %d\n",
+                $workcount - $updates;
+        }
+    }
+
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: concat
+#      PURPOSE: Reimplementation of join but with any undefined or empty
+#               arguments removed
+#   PARAMETERS: $sep            The string to be used to separate elements in
+#                               the result
+#               [variable args] Any number of arguments to be joined together
+#                               with the separator
+#      RETURNS: The concatenated arguments
+#  DESCRIPTION: Giving 'join' an array that may contain undefined elements will
+#               result in empty results in the output string and error
+#               messages as the undefined elements are processed. Giving it
+#               empty string elements will result in dangling separators in
+#               the output. This routine removes the undefined and empty
+#               elements before joining the rest.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO:
+#===============================================================================
+sub concat {
+    my $sep = shift;
+
+    my @args = grep { defined($_) && length($_) > 0 } @_;
+
+    return join( $sep, @args );
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: _debug
+#      PURPOSE: Prints debug reports
+#   PARAMETERS: $active         Boolean: 1 for print, 0 for no print
+#               $message        Message to print
+#      RETURNS: Nothing
+#  DESCRIPTION: Outputs a message if $active is true. It removes any trailing
+#               newline and then adds one in the 'print' to the caller doesn't
+#               have to bother. Prepends the message with 'D> ' to show it's
+#               a debug message.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub _debug {
+    my ( $active, $message ) = @_;
+
+    chomp($message);
+    print "D> $message\n" if $active;
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: Options
+#      PURPOSE: Processes command-line options
+#   PARAMETERS: $optref     Hash reference to hold the options
+#      RETURNS: Undef
+#  DESCRIPTION:
+#       THROWS: no exceptions
+#     COMMENTS: none
+#     SEE ALSO: n/a
+#===============================================================================
+sub Options {
+    my ($optref) = @_;
+
+    my @options = (
+        "help",     "doc",      "debug=i", "verbose!",
+        "dry-run!", "config=s", "limit=i",
+    );
+
+    if ( !GetOptions( $optref, @options ) ) {
+        pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 );
+    }
+
+    return;
+}
+
+__END__
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#  Application Documentation
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#{{{
+
+
+=head1 NAME
+
+fix_urls - Fixes 'http://' urls in the HPR database
+
+=head1 VERSION
+
+This documentation refers to fix_urls version 0.0.5
+
+
+=head1 USAGE
+
+    ./fix_urls [-help] [-doc] [-debug=N] [-[no]dry-run] [-[no]verbose]
+        [-config=FILE] [-limit=N] tablename
+
+    fix_urls -help
+    fix_urls -doc
+
+    fix_urls -limit=10 -dry-run comments
+    fix_urls -limit=10 comments
+    fix_urls -limit=10 -verbose comments
+
+    fix_urls -config=.hpr_livedb.cfg -debug=1 -dry-run -limit=1 comments
+
+=head1 REQUIRED ARGUMENTS
+
+=over 4
+
+=item B<tablename>
+
+The mandatory argument required by the script is the name of the table to
+process. The choices are:
+
+    comments
+    eps
+    hosts
+    miniseries
+
+=back
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<-help>
+
+Prints a brief help message describing the usage of the program, and then exits.
+
+=item B<-doc>
+
+Displays the entirety of the documentation (using a pager), and then exits. To
+generate a PDF version use:
+
+    pod2pdf fix_urls --out=fix_urls.pdf
+
+=item B<-debug=N>
+
+Selects a level of debugging. Debug information consists of a line or series
+of lines prefixed with the characters 'D>':
+
+=over 4
+
+=item B<0>
+
+No debug output is generated: this is the default
+
+=item B<1>
+
+Displays the number of updates required in a table.
+
+=item B<2>
+
+As for level 1, and also displays the primary key values of all rows requiring
+work in the table.
+
+=item B<3>
+
+As for level 2, and also displays some internal values for verification.
+
+=back
+
+=item B<-[no]dry-run>
+
+Controls whether the program runs in a mode where it performs database
+updates. When enabled the details of the updates to be performed are shown,
+otherwise the  updates are applied. The default B<-nodry-run> allows the
+program to perform the changes.
+
+=item B<-[no]verbose>
+
+Normally very little is reported by the script, although details of which rows
+have been changed are logged. When B<-verbose> is selected more information
+about the number of rows needing work, the updates performed (or which would
+have been performed) and how many changes were made is reported.
+
+=item B<-limit=N>
+
+This option allows the number of rows in the chosen table to be limited during
+a B<-dry-run> pass or an update pass. If omitted, or if a value of zero is
+given, then all eligible rows are processed.
+
+=item B<-config=FILE>
+
+This option allows an alternative configuration file to be used. This file
+defines the location of the database, its port, its name and the username and
+password to be used to access it. This feature was added to allow the script
+to access alternative databases or the live database over an SSH tunnel.
+
+See the CONFIGURATION AND ENVIRONMENT section below for the file format.
+
+If the option is omitted the default file is used: B<.hpr_db.cfg>
+
+=back
+
+=head1 DESCRIPTION
+
+The B<fix_urls> script performs edits on fields in tables in the HPR database.
+As written, the purpose is to change all occurrences of 'http://' to
+'https://', though it could be used for other tasks. It is not designed to be
+easily changeable from one to another, but the code can be changed to do this
+if needed.
+
+A single table is processed in each run, and the number of rows may be limited
+if required by using the B<-limit=N> option.
+
+The eligible tables are defined in a hash structure B<%tables> which defines
+the fields to be processed and the queries needed to search for all rows
+requiring work and to get a particular row to work on. It also defines which
+fields are to be reported in the log file.
+
+A log file is appended to when the script is run, which has the name
+B<fix_urls.log> in the same directory as the script.
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item B<Unable to find config file '...'>
+
+Type: fatal
+
+The configuration file in the B<-config=FILE> option cannot be found.
+
+=item B<Database table not specified>
+
+Type: fatal
+
+The mandatory table name argument was not provided.
+
+=item B<Not a valid table name: ...>
+
+Type: fatal
+
+The mandatory table name argument specified an unknown table name.
+
+=item B<[DBI error messages]>
+
+Type: fatal
+
+Generated when a database interface error has been detected, such as failure
+to connect to the database or failure to prepare or execute a query.
+
+=back
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+The script obtains the credentials it requires to open a local copy of the HPR
+database from a configuration file. The name of the file it expects is
+B<.hpr_db.cfg> in the directory holding the script. This configuration file
+can be overridden using the B<-config=FILE> option as described above.
+
+The configuration file format is as follows:
+
+ <database>
+     host = 127.0.0.1
+     port = PORT
+     name = DATABASE
+     user = USERNAME
+     password = PASSWORD
+ </database>
+
+=head1 DEPENDENCIES
+
+    Config::General
+    DBI
+    Data::Dumper
+    Getopt::Long
+    Log::Handler
+    Pod::Usage
+    SQL::Abstract
+
+=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) 2021-2020 Dave Morriss (Dave.Morriss@gmail.com). All rights reserved.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See perldoc perlartistic.
+
+=cut
+
+#}}}
+
+# [zo to open fold, zc to close]
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
+

Database/generate_tag_reports

@@ -0,0 +1,75 @@
+#!/bin/bash -
+#===============================================================================
+#
+#         FILE: generate_tag_reports
+#
+#        USAGE: ./generate_tag_reports
+#
+#  DESCRIPTION: Runs 'report_missing_tags' and 'make tags' to generate the
+#               pages for the HPR website: report_missing_tags.php and
+#               tags.php
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.5
+#      CREATED: 2021-01-02 13:02:47
+#     REVISION: 2022-09-09 08:05:47
+#
+#===============================================================================
+
+set -o nounset                              # Treat unset variables as an error
+
+SCRIPT=${0##*/}
+VERSION="0.0.5"
+
+BASEDIR="$HOME/HPR/Database"
+cd "$BASEDIR" || { echo "$SCRIPT: Failed to cd to $BASEDIR"; exit 1; }
+
+REPORT="$BASEDIR/make_tag_index"
+LIVECFG="$BASEDIR/.hpr_livedb.cfg"    # soft link
+# PHPREP="$BASEDIR/report_missing_tags.php"
+# CSVREP1="$BASEDIR/tag_summary_actions.csv"
+# CSVREP2="$BASEDIR/tags_shows.csv"
+# JSONREP="$BASEDIR/tag_data.json"
+# HTMLTAGS="$BASEDIR/tags.html"
+PHPTAGS="$BASEDIR/tags.php"
+
+#
+# Sanity checks
+#
+[ -e "$REPORT" ] || { echo "$SCRIPT: missing script $REPORT"; exit 1; }
+[ -e "$LIVECFG" ] || { echo "$SCRIPT: missing file $LIVECFG"; exit 1; }
+
+if ! tunnel_is_open; then
+    echo "Open the tunnel to run this script"
+    exit 1
+fi
+
+#
+# Run the main report with the default template (make_tag_index.tpl)
+#
+if $REPORT -config="$LIVECFG" -out="$PHPTAGS"; then
+    echo "$SCRIPT v$VERSION"
+    [ -e "$PHPTAGS" ] && echo "Generated $PHPTAGS"
+else
+    echo "$SCRIPT: failed to run $REPORT"
+    exit 1
+fi
+
+#
+# Generate the standalone tag list from the output of the report script
+#
+# if [[ -e $HTMLTAGS ]]; then
+#     make tags
+#     [ -e "$PHPTAGS" ] && echo "Generated $PHPTAGS"
+# else
+#     echo "$SCRIPT: missing file $HTMLTAGS"
+# fi
+
+exit
+
+# vim: syntax=sh:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+

Database/host_image

@@ -0,0 +1,179 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: host_image
+#
+#        USAGE: ./host_image
+#
+#  DESCRIPTION: Collects Gravatar images for HPR hosts. This version simply
+#               cycles through the list of hosts from the local copy of the
+#               database and attempts to collect the Gravatar for every one
+#               that has an email address and isn't marked as having a local
+#               image (provided via the show upload form) in the database.
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.2
+#      CREATED: 2016-08-31 16:52:52
+#     REVISION: 2021-10-15 21:02:52
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use Config::General;
+use Digest::MD5 qw{md5_hex};
+#use Digest::MD5::File qw{file_md5_hex};
+use LWP::Simple;
+use DBI;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.2';
+
+#
+# Script name
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.cfg";
+my $imgpath    = "$basedir/www/images/hosts/%s.png";
+my $urlformat  = 'https://secure.gravatar.com/avatar/%s.png?d=404&s=90';
+
+my ( $dbh, $sth1, $h1, $rv );
+my ( $host, $hostid, $email, $grav_url, $img, $res );
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#
+# Load configuration data
+#
+my $conf = new Config::General(
+    -ConfigFile      => $configfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+# 2021-10-15: moved to MariaDB
+#-------------------------------------------------------------------------------
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+
+$dbh = DBI->connect( "DBI:MariaDB:host=$dbhost;port=$dbport;database=$dbname",
+    $dbuser, $dbpwd, { AutoCommit => 1, RaiseError => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8 (MySQL only)
+#
+# $dbh->{mysql_enable_utf8} = 1;
+
+#-------------------------------------------------------------------------------
+# Prepare SQL for finding hosts
+#-------------------------------------------------------------------------------
+$sth1 = $dbh->prepare(
+    q{SELECT host, hostid, email FROM hosts
+        WHERE valid = '1' AND local_image = '0'
+        ORDER BY hostid ASC}
+);
+$sth1->execute;
+if ( $dbh->err ) {
+    die $dbh->errstr;
+}
+
+#-------------------------------------------------------------------------------
+# Loop through the hosts gathering gravatars
+#-------------------------------------------------------------------------------
+while ( $h1 = $sth1->fetchrow_hashref ) {
+    $host   = $h1->{host};
+    $hostid = $h1->{hostid};
+    $email  = $h1->{email};
+
+    #
+    # We need an email address
+    #
+    next unless ($email);
+
+    $res = fetch( $hostid, $host, $email, $urlformat, $imgpath );
+}
+
+$sth1->finish;
+
+$dbh->disconnect;
+
+exit;
+
+#===  FUNCTION  ================================================================
+#         NAME: fetch
+#      PURPOSE: Perform the fetching and saving of a gravatar image
+#   PARAMETERS: $hostid         - host number from database
+#               $host           - host name from database
+#               $email          - email address from database
+#               $urlformat      - template for building the gravatar URL
+#               $imgpath        - template for building the file path
+#      RETURNS: Nothing
+#  DESCRIPTION: Uses LWP to collect the gravatar image using the URL
+#               constructed from a template and the email address, writes it
+#               to the constructed file path.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub fetch {
+    my ( $hostid, $host, $email, $urlformat, $imgpath ) = @_;
+
+    #
+    # Build the URL and the image file path
+    #
+    my $grav_url = sprintf( $urlformat, md5_hex( lc($email) ) );
+    my $img      = sprintf( $imgpath,   $hostid );
+
+    printf "%3d: %s (%s) %s %s - ", $hostid, $host, $email, $grav_url, $img;
+
+    #
+    # Collect the gravatar if there is one
+    #
+    my $res = getstore( $grav_url, $img );
+
+    #
+    # Remove any garbage
+    #
+    if ( $res != 200 ) {
+        print "Failed ($res)\n";
+        unlink($img);
+        return 0;
+    }
+    else {
+        print "OK\n";
+        return 1;
+    }
+}
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
+

Database/hosts_eps.sql

@@ -0,0 +1,107 @@
+--
+-- Set up a many-to-many relationship between tables hosts and eps
+-- -----------------------------------------------------------------------------
+--
+
+--
+-- Make a table called 'new_hosts' containing a copy of the hosts table
+-- with the same structure but no data. Shrink the hostid column to int(5).
+--
+DROP TABLE IF EXISTS new_hosts;
+CREATE TABLE IF NOT EXISTS new_hosts (
+    hostid int(5) NOT NULL AUTO_INCREMENT,
+    PRIMARY KEY (hostid)
+) ENGINE=InnoDB
+    SELECT * FROM hosts WHERE 0 = 1;
+
+-- without the "double host" entries (host='Host1 and Host2')
+--    SELECT * FROM hosts where host NOT LIKE '% and %';
+
+SHOW warnings;
+
+--
+-- Make a table called 'new_eps' containing a copy of the eps table without
+-- the host-related columns but no data.
+--
+DROP TABLE IF EXISTS new_eps;
+CREATE TABLE IF NOT EXISTS new_eps (
+    id int(5) NOT NULL,
+    PRIMARY KEY (id)
+) ENGINE=InnoDB
+    SELECT
+	id,
+	date,
+	title,
+	summary,
+	notes,
+	series,
+	explicit,
+	license,
+	tags,
+	version,
+	valid
+    FROM eps WHERE 0 = 1;
+
+SHOW warnings;
+
+--
+-- Table structure for the mapping table 'hosts_eps'
+--
+DROP TABLE IF EXISTS hosts_eps;
+CREATE TABLE IF NOT EXISTS hosts_eps (
+    host_id int(5) NOT NULL
+	REFERENCES new_hosts(hostid),
+    eps_id int(5) NOT NULL
+	REFERENCES new_eps(id),
+    PRIMARY KEY hosts_eps_pk (host_id,eps_id)
+) ENGINE=InnoDB;
+
+SHOW warnings;
+
+--
+-- Populate the hosts_eps table
+--
+/*
+INSERT INTO hosts_eps (host_id, eps_id)
+    SELECT ho.hostid, eps.id
+	FROM hosts ho
+	JOIN eps ON ho.hostid = eps.hostid
+	ORDER BY ho.hostid, eps.id;
+
+SHOW warnings;
+*/
+
+--
+-- Make a view to simplify access to new_hosts and new_eps
+--
+DROP VIEW IF EXISTS hosts_with_eps;
+CREATE VIEW hosts_with_eps AS
+    SELECT
+	nh.hostid,
+	nh.host,
+	nh.email,
+	nh.profile,
+	nh.license AS host_license,
+	nh.local_image,
+	nh.valid AS host_valid,
+	ne.id,
+	ne.date,
+	ne.title,
+	ne.summary,
+	ne.notes,
+	ne.series,
+	ne.explicit,
+	ne.license AS eps_license,
+	ne.tags,
+	ne.version,
+	ne.valid AS eps_valid
+    FROM new_hosts nh
+    JOIN hosts_eps he ON (nh.hostid = he.host_id)
+    JOIN new_eps ne ON (he.eps_id = ne.id)
+    ORDER BY nh.hostid, ne.id;
+
+SHOW warnings;
+
+/*
+vim: syntax=sql ai tw=75:
+*/

Database/hpr_schema.pgsql

@@ -0,0 +1,336 @@
+/* =============================================================================
+ * PostgreSQL Schema - designs for a new HPR database
+ *
+ * File:        hpr_schema.pgsql
+ * Created:     2017-03-15
+ * Updated:     2017-10-16
+ * =============================================================================
+ */
+
+/* ------------------------------------------------------------------------------
+ * Drop everything to start with. The order is important because of the
+ * relations between tables. Also, some items are dependent and go with the
+ * tables.
+ * ------------------------------------------------------------------------------
+ */
+DROP TABLE IF EXISTS comments CASCADE;
+DROP TABLE IF EXISTS episodes CASCADE;
+DROP TABLE IF EXISTS episodes_hosts_xref CASCADE;
+DROP TABLE IF EXISTS episodes_series_xref CASCADE;
+DROP TABLE IF EXISTS episodes_tags_xref CASCADE;
+DROP TABLE IF EXISTS hosts CASCADE;
+DROP TABLE IF EXISTS licenses CASCADE;
+DROP TABLE IF EXISTS series CASCADE;
+DROP TABLE IF EXISTS tags CASCADE;
+
+--  DROP INDEX IF EXISTS episode_release_date_key;
+
+DROP SEQUENCE IF EXISTS comment_seq;
+DROP SEQUENCE IF EXISTS episode_seq;
+DROP SEQUENCE IF EXISTS host_seq;
+DROP SEQUENCE IF EXISTS license_seq;
+DROP SEQUENCE IF EXISTS series_seq;
+DROP SEQUENCE IF EXISTS tag_seq;
+
+-- DROP VIEW IF EXISTS eht_view;
+
+/* ------------------------------------------------------------------------------
+ * Table 'licenses' - licenses relating to episodes (needed because 'hosts'
+ * references it)
+ * ------------------------------------------------------------------------------
+ */
+CREATE SEQUENCE license_seq;
+
+ALTER TABLE license_seq
+  OWNER TO hpradmin;
+
+CREATE TABLE licenses (
+    id                  integer default nextval('license_seq') PRIMARY KEY,
+    short_name          varchar(11) NOT NULL UNIQUE,
+    long_name           varchar(40) NOT NULL,
+    url                 varchar(80) NOT NULL
+);
+
+ALTER TABLE licenses
+  OWNER TO hpradmin;
+
+/*
+ * Load the table since it's quite short. Don't set the id to ensure the
+ * sequence is updated properly.
+ */
+INSERT INTO licenses (short_name, long_name, url) VALUES
+('CC-0', 'Public Domain Dedication', 'http://creativecommons.org/publicdomain/zero/1.0/'),
+('CC-BY', 'Attribution', 'http://creativecommons.org/licenses/by/4.0'),
+('CC-BY-SA', 'Attribution-ShareAlike', 'http://creativecommons.org/licenses/by-sa/3.0'),
+('CC-BY-ND', 'Attribution-NoDerivs', 'http://creativecommons.org/licenses/by-nd/4.0'),
+('CC-BY-NC', 'Attribution-NonCommercial', 'http://creativecommons.org/licenses/by-nc/4.0'),
+('CC-BY-NC-SA', 'Attribution-NonCommercial-ShareAlike', 'http://creativecommons.org/licenses/by-nc-sa/4.0'),
+('CC-BY-NC-ND', 'Attribution-NonCommercial-NoDerivs', 'http://creativecommons.org/licenses/by-nc-nd/4.0');
+
+/* ------------------------------------------------------------------------------
+ * Table 'episodes' - HPR shows
+ * ------------------------------------------------------------------------------ */
+CREATE SEQUENCE episode_seq;
+
+ALTER TABLE episode_seq
+  OWNER TO hpradmin;
+
+CREATE TABLE episodes (
+    id                  integer default nextval('episode_seq') PRIMARY KEY,
+    release_date        date NOT NULL,
+    title               varchar(100) NOT NULL,
+    summary             varchar(100),
+    notes               text NOT NULL,
+    explicit            smallint NOT NULL DEFAULT '1',
+    license             varchar(11) NOT NULL DEFAULT 'CC-BY-SA'
+                            REFERENCES licenses (short_name),
+    duration            integer NOT NULL DEFAULT 0,
+    downloads           integer NOT NULL DEFAULT 0
+);
+
+ALTER TABLE episodes
+  OWNER TO hpradmin;
+
+CREATE INDEX episode_release_date_key
+  ON episodes
+  USING btree
+  (release_date);
+
+/* ------------------------------------------------------------------------------
+ * Table 'hosts' - hosts contributing shows
+ * ------------------------------------------------------------------------------ */
+CREATE SEQUENCE host_seq;
+
+ALTER TABLE host_seq
+  OWNER TO hpradmin;
+
+CREATE TABLE hosts (
+    id                  integer default nextval('host_seq') PRIMARY KEY,
+    host                varchar(1024) UNIQUE NOT NULL,
+--  email               varchar(1024) CHECK (email <> ''),
+    email               varchar(1024) UNIQUE NOT NULL,
+    profile             text,
+    license             varchar(11) NOT NULL DEFAULT 'CC-BY-SA'
+                            REFERENCES licenses (short_name),
+    local_image         smallint NOT NULL DEFAULT '0',
+    gpg                 text,
+    valid               smallint NOT NULL DEFAULT '1',
+    date_added          date
+);
+
+ALTER TABLE hosts
+  OWNER TO hpradmin;
+
+/* ------------------------------------------------------------------------------
+ * Table 'episodes_hosts_xref' - joining table between 'episodes' and 'hosts'
+ * ------------------------------------------------------------------------------ */
+CREATE TABLE episodes_hosts_xref (
+    episodes_id         integer REFERENCES episodes(id)
+                                ON DELETE RESTRICT,
+    hosts_id            integer REFERENCES hosts(id)
+                                ON DELETE CASCADE,
+                        PRIMARY KEY (episodes_id, hosts_id)
+);
+
+ALTER TABLE episodes_hosts_xref
+  OWNER TO hpradmin;
+
+/* ------------------------------------------------------------------------------
+ * Table 'tags' - tags relating to episodes
+ * ------------------------------------------------------------------------------ */
+CREATE SEQUENCE tag_seq;
+
+ALTER TABLE tag_seq
+  OWNER TO hpradmin;
+
+CREATE TABLE tags (
+    id                  integer default nextval('tag_seq') PRIMARY KEY,
+    tag                 varchar(1024) NOT NULL
+);
+
+ALTER TABLE tags
+  OWNER TO hpradmin;
+
+/* ------------------------------------------------------------------------------
+ * Table 'episodes_tags_xref' - joining table between 'episodes' and 'tags'
+ * ------------------------------------------------------------------------------ */
+CREATE TABLE episodes_tags_xref (
+    episodes_id         integer REFERENCES episodes(id)
+                            ON DELETE RESTRICT,
+    tags_id             integer REFERENCES tags(id)
+                            ON DELETE CASCADE,
+                        PRIMARY KEY (episodes_id, tags_id)
+);
+
+ALTER TABLE episodes_tags_xref
+  OWNER TO hpradmin;
+
+/* ------------------------------------------------------------------------------
+ * Table 'series' - series grouping for episodes
+ * ------------------------------------------------------------------------------ */
+CREATE SEQUENCE series_seq;
+
+ALTER TABLE series_seq
+  OWNER TO hpradmin;
+
+CREATE TABLE series (
+    id                  integer default nextval('series_seq') PRIMARY KEY,
+    name                varchar(100) NOT NULL,
+    description         text NOT NULL,
+    private             smallint NOT NULL DEFAULT '0',
+    image               text,
+    valid               smallint NOT NULL DEFAULT '1'
+);
+
+ALTER TABLE series
+  OWNER TO hpradmin;
+
+/* ------------------------------------------------------------------------------
+ * Table 'episodes_series_xref' - joining table between 'episodes' and 'series'
+ * ------------------------------------------------------------------------------ */
+CREATE TABLE episodes_series_xref (
+    episodes_id         integer REFERENCES episodes(id)
+                            ON DELETE RESTRICT,
+    series_id           integer REFERENCES series(id)
+                            ON DELETE CASCADE,
+                        PRIMARY KEY (episodes_id, series_id)
+);
+
+ALTER TABLE episodes_series_xref
+  OWNER TO hpradmin;
+
+/* ------------------------------------------------------------------------------
+ * Table 'comments' - comments relating to episodes
+ * ------------------------------------------------------------------------------ */
+CREATE SEQUENCE comment_seq;
+
+ALTER TABLE comment_seq
+  OWNER TO hpradmin;
+
+CREATE TABLE comments (
+    id                  integer default nextval('comment_seq') PRIMARY KEY,
+    eps_id              integer REFERENCES episodes(id)
+                            ON DELETE RESTRICT,
+    comment_timestamp   timestamp without time zone NOT NULL,
+    comment_author_name varchar(1024),
+    comment_title       varchar(1024),
+    comment_text        text,
+    last_changed        timestamp without time zone NOT NULL
+                            DEFAULT timezone('UTC'::text, now())
+);
+
+ALTER TABLE comments
+  OWNER TO hpradmin;
+
+/* ------------------------------------------------------------------------------
+ * Tables from "Today with a Techie" for further processing
+ * ------------------------------------------------------------------------------ */
+CREATE SEQUENCE twat_hosts_seq;
+
+ALTER TABLE twat_hosts_seq
+  OWNER TO hpradmin;
+
+CREATE TABLE twat_hosts (
+    id                  integer default nextval('twat_hosts_seq') PRIMARY KEY,
+    host                varchar(1024) NOT NULL,
+    email               varchar(1024),
+    website             varchar(1024),
+    repeat              integer NOT NULL
+);
+
+ALTER TABLE twat_hosts
+  OWNER TO hpradmin;
+
+
+CREATE SEQUENCE twat_episodes_seq;
+
+ALTER TABLE twat_episodes_seq
+  OWNER TO hpradmin;
+
+CREATE TABLE twat_episodes (
+    ep_num              integer default nextval('twat_episodes_seq') PRIMARY KEY,
+    date                integer NOT NULL,
+    host                varchar(1024) NOT NULL,
+    topic               varchar(1024) NOT NULL,
+    writeup             text,
+    url                 varchar(1024) NOT NULL
+);
+
+ALTER TABLE twat_episodes
+  OWNER TO hpradmin;
+
+/* ------------------------------------------------------------------------------
+ * Experimental views
+ * ------------------------------------------------------------------------------ */
+--
+-- eh_view
+--
+CREATE OR REPLACE VIEW eh_view AS
+SELECT
+    ep.id,
+    ep.release_date,
+    ep.title,
+    (SELECT string_agg(host, ', ' ORDER BY host)
+        FROM hosts h2,
+             episodes_hosts_xref eh2
+        WHERE eh2.hosts_id = h2.id
+        GROUP BY eh2.episodes_id
+        HAVING eh2.episodes_id = ep.id) AS hosts
+FROM episodes ep
+GROUP BY ep.id
+ORDER BY ep.id;
+
+ALTER TABLE eh_view
+  OWNER TO hpradmin;
+
+--
+-- eht_view
+--
+CREATE OR REPLACE VIEW eht_view AS
+SELECT  e.*,
+        h.host,
+        t.tag,
+        (SELECT string_agg(tag, ', ')
+            FROM tags t2,
+                    episodes_tags_xref et2
+            WHERE et2.tags_id = t2.id
+            GROUP BY et2.episodes_id
+            HAVING et2.episodes_id = e.id) AS tags
+FROM episodes e,
+     hosts h,
+     episodes_hosts_xref eh,
+     episodes_tags_xref et,
+     tags t
+WHERE e.id = eh.episodes_id
+  AND h.id = eh.hosts_id
+  AND e.id = et.episodes_id
+  AND et.tags_id = t.id
+GROUP BY e.id,
+         h.host,
+         t.tag
+ORDER BY e.id;
+
+--  CREATE OR REPLACE VIEW eht_view AS
+--  SELECT
+--  e.*,
+--  h.host,
+--  t.tag,
+--  (SELECT string_agg(tag, ', ')
+    --  FROM tags t2, episodes_tags_xref et2
+    --  WHERE et2.tags_id = t2.id
+    --  GROUP BY et2.episodes_id
+    --  HAVING et2.episodes_id = e.id) AS tags
+--  FROM episodes e, hosts h, episodes_hosts_xref eh, episodes_tags_xref et, tags t
+--  WHERE e.id = eh.episodes_id
+--  AND h.id = eh.hosts_id
+--  AND e.id = et.episodes_id
+--  AND et.tags_id = t.id
+--  GROUP BY e.id,h.host,t.tag
+--  ORDER BY e.id;
+
+ALTER TABLE eht_view
+  OWNER TO hpradmin;
+
+-- Footer ---------------------------------------------------------------------
+
+-- vim: syntax=pgsql:ts=8:sw=4:ai:tw=78:et:fo=tcrqn21:nu:rnu

Database/load_downloads

@@ -0,0 +1,118 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: load_downloads
+#
+#        USAGE: ./load_downloads infile
+#
+#  DESCRIPTION: Loads episode downloads from a file into the 'eps' table
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.1
+#      CREATED: 2014-08-30 17:46:47
+#     REVISION: 2014-08-30 17:46:52
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use Config::General;
+use Text::CSV_XS;
+
+use DBI;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.1';
+
+#
+# Script name
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.cfg";
+
+my ( $dbh, $sth1, $sth2, $sth3, $sth4, $h1, $h2, $rv );
+my ( $infile, $row );
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#
+# Check the input file
+#
+$infile = shift;
+die "Usage: $PROG input_file\n" unless $infile;
+die "Unable to find/read file '$infile'\n" unless -r $infile;
+
+#
+# Load configuration data
+#
+my $conf = new Config::General(
+    -ConfigFile      => $configfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbhost = $config{database}->{host};
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+$dbh = DBI->connect( "dbi:mysql:host=$dbhost;database=$dbname",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+$sth1 = $dbh->prepare(q{UPDATE eps SET downloads = ? WHERE id = ?});
+
+#
+# Open the input file
+#
+open( my $in, "<", $infile ) or die "Unable to open $infile: $!\n";
+
+my $csv = Text::CSV_XS->new;
+
+#
+# Process all lines as CSV
+#
+while ( $row = $csv->getline($in) ) {
+    $sth1->execute( $row->[1], $row->[0] );
+    if ( $dbh->err ) {
+        warn $dbh->errstr;
+    }
+}
+
+close($in);
+
+exit;
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
+

Database/make_tag_index

@@ -0,0 +1,518 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: make_tag_index
+#
+#        USAGE: ./make_tag_index [-help] [-debug=N] [-out=FILE] [-config=FILE]
+#
+#  DESCRIPTION: Make tag lookup pages for the HPR website
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.2
+#      CREATED: 2022-09-08 11:52:53
+#     REVISION: 2022-09-10 14:59:38
+#
+#===============================================================================
+
+use v5.16;
+use strict;
+use warnings;
+use utf8;
+use feature qw{ postderef say signatures state };
+no warnings qw{ experimental::postderef experimental::signatures };
+
+use Getopt::Long;
+use Pod::Usage;
+
+use Config::General;
+
+use Template;
+use Template::Filters;
+Template::Filters->use_html_entities;    # Use HTML::Entities in the template
+
+use Text::CSV_XS;
+
+use DBI;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.2';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.cfg";
+my $template   = "$basedir/$PROG.tpl";
+
+my ( $dbh, $sth1, $h1 );
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#-------------------------------------------------------------------------------
+# Options and arguments
+#-------------------------------------------------------------------------------
+my $DEF_DEBUG = 0;
+
+#
+# Process options
+#
+my %options;
+Options( \%options );
+
+#
+# Default help
+#
+pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 )
+    if ( $options{'help'} );
+
+#
+# Full documentation if requested with -doc
+#
+pod2usage( -msg => "$PROG version $VERSION\n", -verbose => 2, -exitval => 1 )
+    if ( $options{'doc'} );
+
+#
+# Collect options
+#
+my $DEBUG = ( defined( $options{debug} ) ? $options{debug} : $DEF_DEBUG );
+my $cfgfile
+    = ( defined( $options{config} ) ? $options{config} : $configfile );
+
+my $templatefile = $options{template};
+my $outfile      = $options{out};
+
+#-------------------------------------------------------------------------------
+# Template is the default pre-defined string or a filename
+#-------------------------------------------------------------------------------
+if ($templatefile) {
+    die "Unable to find template $templatefile\n" unless ( -e $templatefile );
+}
+else {
+    $templatefile = $template;
+}
+
+#-------------------------------------------------------------------------------
+# Open the output file (or STDOUT)
+#-------------------------------------------------------------------------------
+my $outfh;
+if ($outfile) {
+    open( $outfh, ">:encoding(UTF-8)", $outfile )
+        or die "Unable to open $outfile for writing: $!";
+}
+else {
+    open( $outfh, ">&", \*STDOUT )
+        or die "Unable to initialise for writing: $!";
+}
+
+#
+# Sanity check
+#
+die "Unable to find $cfgfile\n" unless ( -e $cfgfile );
+
+#
+# Load configuration data
+#
+my $conf = new Config::General(
+    -ConfigFile      => $cfgfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+#-------------------------------------------------------------------------------
+# Perform a scan of episodes for tags and accumulate them in a hash
+#-------------------------------------------------------------------------------
+$sth1 = $dbh->prepare(q{SELECT id,title,tags FROM eps WHERE length(tags) > 0})
+    or die $DBI::errstr;
+
+$sth1->execute;
+if ( $dbh->err ) {
+    warn $dbh->errstr;
+}
+
+my ( $status, @fields, %tag_ids, $lastkey, @tagindex, %showtitles );
+
+my $csv = Text::CSV_XS->new(
+    {   binary             => 1,
+        auto_diag          => 1,
+        escape_char        => "\\",
+        allow_loose_quotes => 1
+    }
+);
+
+#
+# Loop through the episodes returned by the query
+#
+while ( $h1 = $sth1->fetchrow_hashref ) {
+    #
+    # Stash the show title with the show number
+    #
+    $showtitles{ $h1->{id} } = $h1->{title};
+
+    #
+    # Parse the tag list for the current episode
+    #
+    $status = $csv->parse( $h1->{tags} );
+    unless ($status) {
+        #
+        # Report any errors
+        #
+        print "Parse error on episode ", $h1->{id}, "\n";
+        print $csv->error_input(), "\n";
+        next;
+    }
+    @fields = $csv->fields();
+
+    #
+    # Not sure why there are no tags but if not ignore this episode
+    #
+    next unless (@fields);
+
+    #
+    # Trim and lowercase all tags
+    #
+    @fields = map {
+        my $t = $_;
+        $t =~ s/(^\s+|\s+$)//g;
+        lc($t)
+    } @fields;
+
+    #
+    # Loop through the tags. For each tag add the associated episode id to the
+    # %tag_ids hash. The key to this hash is the lower case tag and the value
+    # is an array of episode numbers.
+    #
+    foreach my $tag (@fields) {
+        if ( defined( $tag_ids{$tag} ) ) {
+            #
+            # Add to the existing array
+            #
+            push( @{ $tag_ids{$tag} }, $h1->{id} );
+        }
+        else {
+            #
+            # Create the episode array
+            #
+            $tag_ids{$tag} = [ $h1->{id} ];
+        }
+    }
+}
+
+#
+# Dumps the whole tags table. Warning!
+#
+_debug( $DEBUG > 2, '%tag_ids: ' . Dumper( \%tag_ids ) );
+
+#-------------------------------------------------------------------------------
+# Make an alphabetic index of the tags
+#-------------------------------------------------------------------------------
+$lastkey = '';
+foreach my $tag ( sort( keys(%tag_ids) ) ) {
+    if ( substr( $tag, 0, 1 ) ne $lastkey ) {
+        $lastkey = substr( $tag, 0, 1 );
+        push( @tagindex, $tag );
+    }
+}
+
+_debug( $DEBUG > 1, '@tagindex: ' . Dumper( \@tagindex ) );
+
+#-------------------------------------------------------------------------------
+# Fill and print the template
+#-------------------------------------------------------------------------------
+my $tt = Template->new(
+    {   ABSOLUTE     => 1,
+        ENCODING     => 'utf8',
+        INCLUDE_PATH => $basedir,
+        OUTPUT_PATH  => '.',
+    }
+);
+my $vars = {
+    tag_ids  => \%tag_ids,
+    tagindex => \@tagindex,
+    titles   => \%showtitles,
+};
+my $document;
+$tt->process( $templatefile, $vars, \$document, { binmode => ':utf8' } )
+    || die $tt->error(), "\n";
+
+print $outfh $document;
+close($outfh);
+
+$dbh->disconnect;
+
+exit;
+
+#===  FUNCTION  ================================================================
+#         NAME: _debug
+#      PURPOSE: Prints debug reports
+#   PARAMETERS: $active         Boolean: 1 for print, 0 for no print
+#               $message        Message to print
+#      RETURNS: Nothing
+#  DESCRIPTION: Outputs a message if $active is true. It removes any trailing
+#               newline and then adds one in the 'print' to the caller doesn't
+#               have to bother. Prepends the message with 'D> ' to show it's
+#               a debug message.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub _debug {
+    my ( $active, $message ) = @_;
+
+    chomp($message);
+    print "D> $message\n" if $active;
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: Options
+#      PURPOSE: Processes command-line options
+#   PARAMETERS: $optref     Hash reference to hold the options
+#      RETURNS: Undef
+#  DESCRIPTION:
+#       THROWS: no exceptions
+#     COMMENTS: none
+#     SEE ALSO: n/a
+#===============================================================================
+sub Options {
+    my ($optref) = @_;
+
+    my @options
+        = ( "help", "doc", "debug=i", "template=s", "out=s", "config=s", );
+
+    if ( !GetOptions( $optref, @options ) ) {
+        pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 );
+    }
+
+    return;
+}
+
+__END__
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#  Application Documentation
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#{{{
+
+=head1 NAME
+
+make_tag_index - Generate a tag index from the tags in the database
+
+=head1 VERSION
+
+This documentation refers to make_tag_index version 0.0.2
+
+=head1 USAGE
+
+    ./make_tag_index [-help] [-doc] [-debug=N] [-template=FILE] [-out=FILE]
+        [-config=FILE]
+
+    ./make_tag_index -help
+    ./make_tag_index -doc
+    ./make_tag_index -out=tags.php
+    ./make_tag_index -template=MTI_1.tpl -out=tags.php
+    ./make_tag_index -config=$HOME/HPR/.hpr_livedb.cfg -out=tags.php
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<-help>
+
+Prints a brief help message describing the usage of the program, and then exits.
+
+=item B<-doc>
+
+Displays the entirety of the documentation (using a pager), and then exits. To
+generate a PDF version use:
+
+    pod2pdf make_tag_index --out=make_tag_index.pdf
+
+
+=item B<-debug=N>
+
+Causes certain debugging information to be displayed.
+
+    0   (the default) no debug output
+    1   N/A
+    2   dumps @tagindex an array containing tags and show numbers for the index
+    3   dumps %tag_ids the data used to build the entire tag list (warning!)
+
+=item B<-out=FILE>
+
+This option defines an output file to receive the report. If the option is
+omitted the report is written to STDOUT, allowing it to be redirected if
+required.
+
+=item B<-config=FILE>
+
+This option allows an alternative configuration file to be used. This file
+defines the location of the database, its port, its name and the username and
+password to be used to access it. This feature was added to allow the script
+to access alternative databases or the live database over an SSH tunnel.
+
+See the CONFIGURATION AND ENVIRONMENT section below for the file format.
+
+If the option is omitted the default file is used: B<.hpr_db.cfg>
+
+=item B<-template=FILE>
+
+This option defines the template used to generate the tag index. The template
+is written using the B<Template> toolkit language.
+
+If the option is omitted then the script uses the file
+B<make_tag_index.tpl> in the same directory as the script. If this file
+does not exist then the script will exit with an error message.
+
+=back
+
+=head1 DESCRIPTION
+
+The script reads all episodes in the HPR database. Each row contains a 'tags'
+field which contains tags as a comma-separated list. This list is parsed and
+stored in a Perl hash. The hash is keyed by the lower-case tag and the value
+part of each hash element contains a Perl arrayref containing a list of show
+numbers. The tag/show hash is called B<%tag_ids>. There are over 5800 tags in
+the system in September 2022.
+
+An array called B<@tagindex> is also created which holds the first tag of each
+group starting with the same character. So, with a particular tag population,
+the 'a' group might start with 'aaron newcomb', 'b' with 'b+ tree' and so
+forth.
+
+A further hash called B<%showtitles> is indexed by show number and holds the
+title of the show. This has been added in preparation for producing a tag
+index pages which have better accessibility features.
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item B<Unable to find template ...>
+
+Type: fatal
+
+The template specified does not exist.
+
+=item B<Unable to open ... for writing: ...>
+
+Type: fatal
+
+The nominated output file cannot be written to.
+
+=item B<Unable to initialise for writing: ...>;
+
+Type: fatal
+
+Trying to write to STDOUT has failed.
+
+=item B<Unable to find ...>
+
+Type: fatal
+
+The nominated configuration file cannot be found
+
+=item B<various database errors>
+
+Type: fatal
+
+Failure while opening the database or preparing a query.
+
+=item B<Errors from Template Toolkit>
+
+Type: fatal
+
+The template could not be processed
+
+=back
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+The script obtains the credentials it requires to open the HPR database from
+a configuration file. The name of the file it expects is B<.hpr_db.cfg> in the
+directory holding the script. To change this will require changing the script.
+
+The configuration file format is as follows:
+
+ <database>
+     host = 127.0.0.1
+     port = PORT
+     name = DATABASE
+     user = USERNAME
+     password = PASSWORD
+ </database>
+
+=head1 DEPENDENCIES
+
+Config::General
+DBI
+Data::Dumper
+Getopt::Long
+Pod::Usage
+Template
+Template::Filters
+Text::CSV_XS
+
+=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) 2022 Dave Morriss (Dave.Morriss@gmail.com). All rights reserved.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See perldoc perlartistic.
+
+=cut
+
+#}}}
+
+# [zo to open fold, zc to close]
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
+

Database/make_tag_index.tpl

@@ -0,0 +1,85 @@
+[%# make_tag_index.tpl 2022-09-14 -%]
+[%# version: 0.0.3 -%]
+[%# Default page summarising tag data from the database, generates PHP -%]
+[%- USE date -%]
+[%- DEFAULT title = 'Tag summary' -%]
+<?php
+# released under a Creative Commons Attribution-ShareAlike 3.0 Unported license. http://creativecommons.org/licenses/by-sa/3.0/
+$body="help_out";
+require "/home/hpr/php/hpr.php";
+include '/home/hpr/www/header.php';
+?>
+
+<main id="maincontent">
+<style>
+    .columns3 { columns: 3 auto; list-style-type: none }
+    hr.thin {
+        border: 0;
+        height: 0;
+        border-top: 1px solid rgba(0, 0, 0, 0.1);
+        border-bottom: 1px solid rgba(255, 255, 255, 0.3);
+    }
+    p.ralign { text-align: right }
+</style>
+<article>
+<a id="TOP"><h1 class="title">[% title %]</h1></a>
+<h4 class="date">Page generated on [% date.format(date.now,'%Y-%m-%d at %H:%M:%S UTC','en_GB',1) %]</h4>
+<p>This section summarises all of the tags currently used throughout the
+database. The tags are in alphabetical order and each is followed by links to
+the show numbers where it is used so you can see the context the author used
+it in. There are currently [% tag_ids.size %] unique tags in the system.</p>
+<h4>Alphabetical index</h4>
+<p>This is an index to the initial letters of the tags below.</p>
+<ul class="columns3">
+[%# tagindex contains the first tag in an alphabetic list that has a different
+first letter from the previous one. We use it to build an alphabetic table of
+anchors linking to the blocks of tags starting with that character. -%]
+[%- FOREACH index IN tagindex %]
+<li><a href="#[% index.replace('\s','_') %]"><strong>[% index.substr(0,1) %]</strong></a></li>
+[%- END %]
+</ul>
+<hr/>
+[%# BLOCK tags -%]
+<ul>
+[%# tag_ids is a hash keyed by tags, each containing an array of episode
+numbers. If a tag matches the one in 'index' place an anchor to it for the
+alphabetic index above. %]
+[%- index = tagindex.shift %]
+[%- FOREACH pair IN tag_ids.pairs %]
+[%- IF pair.key == index %]
+</ul>
+<p class="ralign"><a href="#TOP">&#129137; Go to index</a></p>
+<h3>Tags beginning with '[% index.substr(0,1) %]'</h3>
+<ul>
+<li>
+[%- index = tagindex.shift %]
+[%- ELSE %]
+<li>
+[%- END %]
+<a id="[% pair.key.replace('\s','_') %]"><strong>[% pair.key FILTER html_entity %]</strong></a>: 
+    [%- count = 0 %]
+    [%- FOREACH id IN pair.value.nsort %]
+        [%- count = count + 1 %]
+        <a href="https://hackerpublicradio.org/eps.php?id=[% id FILTER format("%04i") %]"
+            target="_blank" aria-label="[% pair.key FILTER html_entity %] - show [% id %]">[% id %]</a>
+        [%- count < pair.value.size ? ', ' : '' %]
+    [%- END %]
+</li>
+[%- END %]
+</ul>
+[%# END -%]
+
+<p>
+<a href="#TOP">Go to TOP of page</a>
+</p>
+</article>
+
+</main>
+
+<?php
+include 'footer.html';
+?>
+
+[%#
+  vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]

Database/make_tsu_blank

@@ -0,0 +1,332 @@
+#!/bin/bash -
+#===============================================================================
+#
+#         FILE: make_tsu_blank
+#
+#        USAGE: ./make_tsu_blank [-h] [-D] start count
+#
+#  DESCRIPTION: Make a template for generating a tag and summary update email.
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: Now obsolete but retained for reference purposes
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.8
+#      CREATED: 2016-05-28 16:21:22
+#     REVISION: 2021-06-23 13:03:31
+#
+#===============================================================================
+
+set -o nounset                              # Treat unset variables as an error
+
+SCRIPT=${0##*/}
+
+VERSION="0.0.8"
+
+STDOUT="/dev/fd/2"
+
+#
+# Load library functions
+#
+LIB="$HOME/bin/function_lib.sh"
+[ -e "$LIB" ] || { echo "$SCRIPT: Unable to source functions"; exit 1; }
+# shellcheck source=/home/cendjm/bin/function_lib.sh
+source "$LIB"
+
+#
+# Colour codes
+#
+define_colours
+
+#
+# We need the SSH tunnel (The script to test this and to open it, open_tunnel,
+# are in ~/bin. This needs to be set up if running this stuff somewhere else)
+#
+if ! tunnel_is_open; then
+    echo "$SCRIPT: ${red}The SSH tunnel must be open to do this${reset}"
+    exit 1
+fi
+
+#===  FUNCTION  ================================================================
+#         NAME: _usage
+#  DESCRIPTION: Report usage
+#   PARAMETERS: None
+#      RETURNS: Nothing
+#===============================================================================
+_usage () {
+    cat >$STDOUT <<-endusage
+Usage: ./${SCRIPT} [-h] [-d] [-D] start count
+
+Version: $VERSION
+
+Generates a file of tag and summary updates for shows in the given range which
+can be edited and submitted to tags@hackerpublicradio.org in order to update
+the relevant shows.
+
+Options:
+  -h                    Print this help
+  -D                    Select debug mode (works the same; more output)
+
+Arguments:
+    start               starting show number
+    count               number of shows (shouldn't exceed 20)
+
+Examples
+  ./${SCRIPT} -h
+  ./${SCRIPT} -D 700 10
+
+endusage
+    exit
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: _DEBUG
+#  DESCRIPTION: Writes a message if in DEBUG mode
+#   PARAMETERS: List of messages
+#      RETURNS: Nothing
+#===============================================================================
+_DEBUG () {
+    [ "$DEBUG" == 0 ] && return
+    for msg in "$@"; do
+        printf 'D> %s\n' "$msg"
+    done
+}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+#
+# Option defaults
+#
+DEBUG=0
+
+#
+# Process options
+#
+while getopts :hdD opt
+do
+    case "${opt}" in
+        h) _usage;;
+        D) DEBUG=1;;
+        ?) echo "$SCRIPT: Invalid option; aborting"; exit 1;;
+    esac
+done
+shift $((OPTIND - 1))
+
+#
+# Directories and files
+#
+BASEDIR="$HOME/HPR/Database"
+TSU="$BASEDIR/tsu"
+
+PREFIX="tag_summary_updates_"
+GENERATOR="$BASEDIR/query2tt2"
+LIVECFG="$BASEDIR/.hpr_livedb.cfg"
+TEMPLATE="$BASEDIR/query2tt2_taglist.tpl"
+
+#
+# Sanity checks
+#
+[ -d "$BASEDIR" ] || { echo "Unable to find directory $BASEDIR"; exit 1; }
+[ -d "$TSU" ] || { echo "Unable to find directory $TSU"; exit 1; }
+
+for item in $GENERATOR $LIVECFG $TEMPLATE; do
+    [ -e "$item" ] || {
+        echo "Unable to find component: $item"
+        exit 1
+    }
+done
+
+#
+# Maximum number of shows to scan. This is advisory since we might want to
+# scan 40 and only get 3 which need work!
+#
+LIMIT=20
+
+#
+# Check arguments
+#
+if [[ $# -ne 2 ]]; then
+    _usage
+fi
+
+#
+# Validate arguments and make the END variable
+#
+START="$1"
+COUNT="$2"
+
+RE='^[0-9]+$'
+if ! [[ $START =~ $RE ]]; then
+    echo "${red}Invalid starting value: $1${reset}"
+    exit 1
+fi
+if ! [[ $COUNT =~ $RE ]]; then
+    echo "${red}Invalid count value: $2${reset}"
+    exit 1
+fi
+
+#
+# Deal with leading zeroes if any by forcing such numbers to base 10
+#
+START=$((10#$START))
+COUNT=$((10#$COUNT))
+((END = START + COUNT - 1))
+
+_DEBUG "Start: $START" "Count: $COUNT" "End: $END"
+
+#
+# Argument sanity checks
+#
+if [[ $COUNT -gt $LIMIT ]]; then
+    echo "${yellow}Range: $START..$END ($COUNT)${reset}"
+    echo "${yellow}You are asking for a count greater than 20.${reset}"
+    echo "${red}Beware! This could be unmanageable!${reset}"
+    if ! yes_no 'Are you sure you want this? %s ' 'N'; then
+        echo "${red}Request ignored. Please try again.${reset}"
+        exit
+    fi
+fi
+
+#
+# Generate the output file path
+#
+printf -v OUTFILE "%s/%s%04d-%04d.txt" "$TSU" "$PREFIX"  "$START" "$END"
+
+_DEBUG "Output: $OUTFILE"
+
+#
+# Does the output file exist? If so, can we detect any work having been done
+# to it?
+#
+overwrite=0
+if [[ -e $OUTFILE ]]; then
+    if [[ -s $OUTFILE ]]; then
+        echo "${yellow}${OUTFILE/$HOME/\~} already exists.${reset}"
+        if grep -E -q "^(summary|tags): ?\w+" "$OUTFILE"; then
+            echo -n "${yellow}** Work has been done on this file"
+            missing=$(grep -E -c "^(summary|tags): *$" "$OUTFILE")
+            if ((missing)); then
+                echo " (there are still tags/summaries to be added).${reset}"
+            else
+                echo ".${reset}"
+            fi
+        else
+            echo "${yellow}This file has not had tags or summaries added.${reset}"
+        fi
+
+        if ! yes_no 'Are you sure you want to replace it? %s ' 'N'; then
+            echo "${red}File not overwritten${reset}"
+            exit
+        else
+            overwrite=1
+        fi
+    else
+        #
+        # This shouldn't happen. An empty file caused by a failed query or
+        # because there's nothing to do should be cleared away immediately
+        # rather than here where the file has been left hanging around.
+        #
+        echo "${yellow}${OUTFILE/$HOME/\~} exists but is empty. Deleting it.${reset}"
+        rm -f "$OUTFILE"
+    fi
+fi
+
+_DEBUG "Overwrite: $overwrite"
+
+#
+# If we're overwriting no collision check otherwise check check check!
+#
+if [[ $overwrite -eq 0 ]]; then
+    #
+    # Check for collisions.
+    #
+    # Look for individual files already created, taking the FROM and TO values
+    # from their names. Look to see if the range START-END is in the range FROM-TO
+    # or the other way round. Print all collisions. Any found mean the script
+    # can't continue.
+    #
+    # Note that we have to force numbers to base 10 in case they have leading
+    # zeroes (and will therefore be treated as octal).
+    #
+    collisions=0
+    FILERE="${PREFIX}([0-9]{4})-([0-9]{4})\\.txt$"
+    for f in "$TSU"/"${PREFIX}"*; do
+        if [[ $f =~ $FILERE ]]; then
+            FROM="${BASH_REMATCH[1]}"
+            FROM=$((10#$FROM))
+            TO="${BASH_REMATCH[2]}"
+            TO=$((10#$TO))
+            if [[ (( $START -ge $FROM && $START -le $TO ) ||\
+                ( $END -ge $FROM && $END -le $TO )) || \
+                (( $FROM -ge $START && $FROM -le $END ) ||\
+                ( $TO -ge $START && $TO -le $END )) ]]; then
+                printf \
+                    '%sCollision: range %04d-%04d overlaps the range %04d-%04d (in '%s')%s\n' \
+                    "${red}" "$START" "$END" "$FROM" "$TO" "${f##*/}" "${reset}"
+                ((collisions++))
+            fi
+        fi
+    done
+
+    if [[ $collisions -gt 0 ]]; then
+        echo "${red}Found $collisions collisions; aborting${reset}"
+        exit 1
+    fi
+fi
+
+#
+# Define the SQL.
+# 2021-06-20: Now we make a simpler query and rely on a script and template to
+# format everything.
+#
+SQL=$(cat <<ENDSQL
+SELECT
+    id, summary, tags
+FROM eps
+WHERE id BETWEEN $START AND $END
+AND (length(summary) = 0 OR length(tags) = 0)
+ORDER BY id
+ENDSQL
+)
+
+_DEBUG "----" "$SQL" "----"
+
+
+#
+# Run MySQL with the query.
+# 2021-06-20: The script below does all we want using the predefined template
+#
+$GENERATOR -config="$LIVECFG" -template="$TEMPLATE" "$SQL" > "$OUTFILE"
+RES=$?
+
+#
+# Die if the query failed, and clear up the empty output file if found
+#
+[ $RES -eq 0 ] || {
+    echo "${red}Query failed; aborting${reset}"
+    if [[ -e $OUTFILE && ! -s $OUTFILE ]]; then
+        rm -f "$OUTFILE"
+    fi
+    exit 1
+}
+
+#
+# An empty file could be "successfully" created. If so we delete it
+#
+if [[ -s $OUTFILE ]]; then
+    #
+    # Report the file created.
+    #
+    # 2021-06-20: The original sed call is not needed any more because the
+    # script we ran made the file in the form we want.
+    #
+    echo "${green}Output is in ${OUTFILE/$HOME/\~}${reset}"
+else
+    rm -f "$OUTFILE"
+    echo "${yellow}No episodes need work in that range${reset}"
+fi
+
+exit
+
+# vim: syntax=sh:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21

Database/new_hosts_in_last_year.sql

@@ -0,0 +1,32 @@
+/* -----------------------------------------------------------------------------
+ * Find all new hosts who joined in the last year (ignoring those with queued
+ * shows in the future)
+ *
+ */
+SELECT h.hostid,
+       h.host,
+       min(e.date) AS joindate,
+       count(e.id) AS COUNT
+FROM eps e
+JOIN hosts h ON e.hostid = h.hostid
+GROUP BY h.hostid
+HAVING min(e.date) >= (curdate() - INTERVAL 364 DAY)
+AND min(e.date) <= curdate()
+ORDER BY min(e.date);
+
+/* -----------------------------------------------------------------------------
+* Total shows produced by the new hosts in the past year
+*/
+SELECT sum(COUNT) AS total_shows
+FROM
+  (SELECT h.hostid,
+          h.host,
+          min(e.date) AS joindate,
+                         count(e.id) AS COUNT
+   FROM eps e
+   JOIN hosts h ON e.hostid = h.hostid
+   GROUP BY h.hostid
+   HAVING min(e.date) >= (curdate() - INTERVAL 364 DAY)
+   AND min(e.date) <= curdate()
+   ORDER BY min(e.date)) src;
+

Database/normalise_tags.sql

@@ -0,0 +1,114 @@
+/*
+ * Define a function to return a particular element from a comma-delimited
+ * string. There is nothing already present in MySQL to do this.
+ *
+ * Create a table to hold the split tags, storing them in lower- and
+ * upper-case form.
+ *
+ * Define a procedure to do the work of visiting every row in the 'eps' table
+ * to extract the tags and place them in the 'tags' table with the episode id
+ * they are associated with. This could be run on a periodic basis ('call
+ * NormaliseEpisodeTags()') preceded by the statement 'DELETE FROM tags;'. The
+ * 'lctags' column needs to be created with the statement 'UPDATE tags SET
+ * lctag = LOWER(tag);'.
+ *
+ * With the 'tags' table filled then it can be queried for tag information as
+ * shown in the examples below.
+ *
+ * 1. To count tag frequencies (case insensitive) and show the top 50:
+ *
+ * SELECT tag,lctag,COUNT(tag) AS freq FROM tags GROUP BY tag ORDER BY COUNT(tag) DESC LIMIT 50;
+ *
+ * 2. To return the episode numbers of shows tagged with a particular word:
+ *
+ * SELECT e.id,e.date,e.title,h.host FROM eps e JOIN hosts h ON e.hostid = h.hostid
+ *      WHERE e.id IN (SELECT id FROM tags WHERE lctag = 'linux');
+ *
+ * ----------------------------------------------------------------------------
+ * (These ideas were based upon the discussions at
+ * https://stackoverflow.com/questions/17942508/sql-split-values-to-multiple-rows)
+ * ----------------------------------------------------------------------------
+ */
+
+DELIMITER $$
+
+/*
+ * Create function 'strSplit'
+ *
+ * Arguments:
+ *      x       - string to work on
+ *      delim   - delimiter to split on
+ *      pos     - starting position
+ *
+ */
+DROP FUNCTION IF EXISTS strSplit;
+
+CREATE FUNCTION strSplit(x VARCHAR(65000), delim VARCHAR(12), pos INTEGER)
+    RETURNS VARCHAR(65000)
+BEGIN
+    DECLARE output VARCHAR(65000);
+    SET output = TRIM(
+        REPLACE(
+            SUBSTRING(
+                SUBSTRING_INDEX(x, delim, pos),
+                LENGTH(SUBSTRING_INDEX(x, delim, pos - 1)) + 1
+            ),
+            delim,
+            ''
+        )
+    );
+    IF output = '' THEN
+        SET output = null;
+    END IF;
+    RETURN output;
+END $$
+
+/*
+ * Create procedure 'NormaliseEpisodeTags'
+ *
+ */
+DROP PROCEDURE IF EXISTS NormaliseEpisodeTags;
+
+CREATE PROCEDURE NormaliseEpisodeTags()
+BEGIN
+    DECLARE i INTEGER;
+
+    SET i = 1;
+    REPEAT
+        INSERT INTO tags (id, tag, lctag)
+            SELECT id, strSplit(tags, ',', i), lower(strSplit(tags, ',', i))
+                FROM eps
+                WHERE strSplit(tags, ',', i) IS NOT NULL;
+        SET i = i + 1;
+    UNTIL ROW_COUNT() = 0
+    END REPEAT;
+END $$
+
+DELIMITER ;
+
+/*
+ * Create table 'tags'
+ *
+ */
+DROP TABLE IF EXISTS tags;
+
+CREATE TABLE tags (
+    id int(5) NOT NULL,
+    tag varchar(200),
+    lctag varchar(200)
+);
+
+-- DROP INDEX tags_all ON tags;
+CREATE UNIQUE INDEX tags_all ON tags (id,tag,lctag);
+
+-- DROP INDEX tags_id ON tags;
+CREATE INDEX tags_id ON tags (id);
+
+-- DROP INDEX tags_tag ON tags;
+CREATE INDEX tags_tag ON tags (tag);
+
+-- DROP INDEX tags_lctag ON tags;
+CREATE INDEX tags_lctag ON tags (lctag);
+
+
+-- vim: syntax=sql:ts=8:ai:tw=78:et:fo=tcrqn21:comments+=b\:--

Database/query2csv

@@ -0,0 +1,137 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: query2csv
+#
+#        USAGE: ./query2csv query
+#
+#  DESCRIPTION: Runs a query given as the only argument. Caution is needed
+#               since *any* query will be run. The result of the query is
+#               output in CSV form on STDOUT. The CSV is always quoted to
+#               cater for the more simplistic consumers.
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: Had to revert to MySQL because of a problem with DBD::MariaDB
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.2
+#      CREATED: 2015-07-11 15:53:01
+#     REVISION: 2022-02-16 23:17:16
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use Config::General;
+use Text::CSV_XS;
+use DBI;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.2';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_livedb.cfg";
+
+my ( $dbh, $sth1, $aref1 );
+my ( $query, $csv );
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#
+# Load database configuration data
+#
+my $conf = Config::General->new(
+    -ConfigFile      => $configfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#-------------------------------------------------------------------------------
+# Options and arguments
+#-------------------------------------------------------------------------------
+$query = shift;
+die "Usage: $PROG query\n" unless $query;
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+#$dbh = DBI->connect( "DBI:MariaDB:host=$dbhost;port=$dbport;database=$dbname",
+#    $dbuser, $dbpwd, { AutoCommit => 1 } )
+#    or die $DBI::errstr;
+
+$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+#
+# Set up the query
+#
+$sth1 = $dbh->prepare($query) or die $DBI::errstr;
+if ( $dbh->err ) {
+    warn $dbh->errstr;
+}
+
+#
+# Perform the query
+#
+$sth1->execute;
+if ( $dbh->err ) {
+    warn $dbh->errstr;
+}
+
+#
+# Prepare to make CSV. Not sure if always quoting is the best idea though
+#
+$csv = Text::CSV_XS->new(
+#    { always_quote => 1 }
+);
+
+#
+# Loop through the returned rows making and printing CSV. Each row is returned
+# as an arrayref to make it easy to join everything.
+#
+while ( $aref1 = $sth1->fetchrow_arrayref ) {
+    $csv->combine(@$aref1);
+    print $csv->string(), "\n";
+}
+
+exit;
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
+

Database/query2json

@@ -0,0 +1,134 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: query2json
+#
+#        USAGE: ./query2json query
+#
+#  DESCRIPTION: Runs a query given as the only argument. Caution is needed
+#               since *any* query will be run. The result of the query is
+#               output in JSON form on STDOUT.
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: Had to revert to MySQL because of a problem with DBD::MariaDB
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.2
+#      CREATED: 2021-06-18 13:24:49
+#     REVISION: 2023-01-05 16:17:24
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use Config::General;
+use JSON;
+use DBI;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.2';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_livedb.cfg";
+
+my ( $dbh, $sth1, $aref1 );
+my ( $query, $result, $json );
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#
+# Load database configuration data
+#
+my $conf = Config::General->new(
+    -ConfigFile      => $configfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#-------------------------------------------------------------------------------
+# Options and arguments
+#-------------------------------------------------------------------------------
+$query = shift;
+die "Usage: $PROG query\n" unless $query;
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+#$dbh = DBI->connect( "DBI:MariaDB:host=$dbhost;port=$dbport;database=$dbname",
+#    $dbuser, $dbpwd, { AutoCommit => 1 } )
+#    or die $DBI::errstr;
+
+$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+#
+# Set up the query
+#
+$sth1 = $dbh->prepare($query) or die $DBI::errstr;
+if ( $dbh->err ) {
+    warn $dbh->errstr;
+}
+
+#
+# Perform the query
+#
+$sth1->execute;
+if ( $dbh->err ) {
+    warn $dbh->errstr;
+}
+
+#
+# Grab everything as an arrayref of hashrefs
+#
+$result = $sth1->fetchall_arrayref( {} );
+
+#
+# Prepare for JSON, forcing object key sorting (expensive)
+#
+$json = JSON->new->utf8->canonical;
+
+#
+# Encode the Perl structure to JSON
+#
+print $json->encode($result), "\n";
+
+exit;
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker

Database/query2tt2

@@ -0,0 +1,626 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: query2tt2
+#
+#        USAGE: ./query2tt2 [-help] [-debug=N] [-config=FILE] [-query=FILE]
+#               [-template=FILE]
+#               [-dbarg=ARG1 [-dbarg=ARG2] ...]
+#               [-define KEY1=VALUE1 [-define KEY2=VALUE2] ...
+#               [-define KEYn=VALUEn]] [QUERY]
+#
+#  DESCRIPTION: Built for use with the Hacker Public Radio database, but could
+#               be used in any context with a MariaDB database.
+#               Runs a query given as the only argument (or in a file).
+#               Caution is needed since *any* query will be run, not just
+#               SELECT commands. The result of the query is output in
+#               a specified format defined by a template on STDOUT. The query
+#               can have arguments provided by '-dbarg=ARG' to be used in '?'
+#               placeholders in the SQL. The template can receive variables
+#               through the option '-define KEY=VALUE'. A configuration file
+#               is needed, though there is a default ('.hpr_db.cfg'), which
+#               accesses the local snapshot.
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: Had to revert to MySQL because of a problem with DBD::MariaDB
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.4
+#      CREATED: 2021-06-18 13:24:49
+#     REVISION: 2024-01-19 17:15:45
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+use open ':encoding(UTF-8)';
+
+# Using experimental features, some of which require warnings to be turned off
+use feature qw{ say try };
+no warnings qw{
+    experimental::try
+};
+
+use Getopt::Long;
+use Pod::Usage;
+
+use Config::General;
+#use Try::Tiny;
+use File::Slurper qw{ read_text };
+use Hash::Merge;
+use Template;
+use DBI;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.4';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.cfg";
+
+my ( $dbh, $sth1 );
+my ( $query, $result, @names, $document );
+
+#
+# Default template iterates through all rows in the 'result' matrix and for
+# each row displays the field name (key) from array 'names', and its value.
+# There's a blank line after each row.
+#
+my $def_template = <<'ENDTPL';
+[% FOREACH row IN result -%]
+[% FOREACH key IN names -%]
+[% key %]: [% row.$key %]
+[% END -%]
+
+[% END -%]
+ENDTPL
+
+#-------------------------------------------------------------------------------
+# There should be no need to edit anything after this point
+#-------------------------------------------------------------------------------
+
+#
+# Enable Unicode mode
+#
+#binmode STDOUT, ":encoding(UTF-8)";
+#binmode STDERR, ":encoding(UTF-8)";
+
+#-------------------------------------------------------------------------------
+# Options and arguments
+#-------------------------------------------------------------------------------
+my %options;
+Options( \%options );
+
+#
+# Default help
+#
+pod2usage( -msg => "Version $VERSION\n", -exitval => 1 )
+    if ( $options{'help'} );
+
+#
+# Full documentation if requested with -doc
+#
+pod2usage(
+    -msg => "$PROG version $VERSION\n",
+    -verbose => 2,
+    -exitval => 1,
+    -noperldoc => 0,
+) if ( $options{'doc'} );
+
+
+#
+# Collect options
+#
+my $DEBUG = ( $options{'debug'} ? $options{'debug'} : 0 );
+
+my $cfgfile
+    = ( defined( $options{config} ) ? $options{config} : $configfile );
+
+my $queryfile = $options{query};
+my $template  = $options{template};
+
+my @dbargs = _dbargs( \%options );
+my %defs   = _define( \%options );
+_debug( $DEBUG >= 3, '@dbargs: ' . join( ',', @dbargs ) );
+_debug( $DEBUG >= 3, '%defs: ' . Dumper(\%defs) );
+
+#-------------------------------------------------------------------------------
+# Option checks and defaults
+#-------------------------------------------------------------------------------
+die "Unable to find configuration file $cfgfile\n" unless ( -e $cfgfile );
+_debug( $DEBUG >= 3, '$cfgfile: ' . $cfgfile );
+
+#
+# Query is an argument string or is in a file
+#
+if ($queryfile) {
+    die "Unable to find query file $queryfile\n" unless ( -e $queryfile );
+    $query = read_text($queryfile);
+}
+else {
+    $query = shift;
+    pod2usage( -msg => "Please specify a SQL query\n", -exitval => 1 )
+        unless $query;
+}
+_debug( $DEBUG >= 3, '$query: ' . Dumper(\$query) );
+
+#
+# Template is the default pre-defined string or a filename
+#
+if ($template) {
+    die "Unable to find template $template\n" unless ( -e $template );
+}
+else {
+    $template = \$def_template;
+}
+_debug(
+    $DEBUG >= 3,
+    '$template: '
+        . (ref($template) eq ''
+        ? "filename $template"
+        : "reference to string\n$$template")
+);
+
+#-------------------------------------------------------------------------------
+# Load database configuration data
+#-------------------------------------------------------------------------------
+my $conf = Config::General->new(
+    -ConfigFile      => $cfgfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+
+$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+#
+# Set up the query
+#
+$sth1 = $dbh->prepare($query) or die $DBI::errstr;
+if ( $dbh->err ) {
+    die $dbh->errstr;
+}
+
+#
+# Perform the query
+#
+try {
+    $sth1->execute(@dbargs);
+    if ( $dbh->err ) {
+        die $dbh->errstr;
+    }
+}
+catch ($e) {
+    #
+    # The 'die' above was triggered. The error is in $_.
+    #
+    my $pcount = grep {/\?/} split( '', $query );
+    my $acount = scalar(@dbargs);
+    print STDERR "Failed to execute query.\n";
+    print STDERR "Placeholder/Argument mismatch: $pcount/$acount\n";
+    exit;
+};
+
+#
+# Grab everything from the query as an arrayref of hashrefs
+#
+$result = $sth1->fetchall_arrayref( {} );
+_debug( $DEBUG >= 3, '$result: ' . Dumper($result) );
+
+#
+# Collect field names
+#
+@names = @{$sth1->{NAME}};
+_debug( $DEBUG >= 3, '@names: ' . Dumper(\@names) );
+
+#
+# Set up the template
+#
+my $tt = Template->new(
+    {   ABSOLUTE     => 1,
+        ENCODING     => 'utf8',
+        INCLUDE_PATH => $basedir,
+    }
+);
+
+#
+# Send collected data to the template
+#
+my $vars = { names => \@names, result => $result, };
+if (%defs) {
+    #
+    # If we have definitions add them to $vars
+    #
+    my $merge  = Hash::Merge->new('LEFT_PRECEDENT');
+    my %merged = %{ $merge->merge( $vars, \%defs ) };
+    $vars = \%merged;
+}
+_debug( $DEBUG >= 3, '$vars: ' . Dumper($vars) );
+
+$tt->process( $template, $vars, \$document, { binmode => ':utf8' } )
+    || die $tt->error(), "\n";
+print $document;
+
+exit;
+
+#===  FUNCTION  ================================================================
+#         NAME: _debug
+#      PURPOSE: Prints debug reports
+#   PARAMETERS: $active         Boolean: 1 for print, 0 for no print
+#               $message        Message to print
+#      RETURNS: Nothing
+#  DESCRIPTION: Outputs a message if $active is true. It removes any trailing
+#               newline and then adds one in the 'print' to the caller doesn't
+#               have to bother. Prepends the message with 'D> ' to show it's
+#               a debug message.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub _debug {
+    my ( $active, $message ) = @_;
+
+    chomp($message);
+    print STDERR "D> $message\n" if $active;
+}
+
+
+#===  FUNCTION  ================================================================
+#         NAME: _dbargs
+#      PURPOSE: Collects database arguments for the main query
+#   PARAMETERS: $opts   hash reference holding the options
+#      RETURNS: An array holding all of the arguments
+#  DESCRIPTION: If there are -dbargs options they will be an array in the hash
+#               returned by Getopt::Long. We return the array to the caller.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub _dbargs {
+    my ($opts) = @_;
+
+    my @args;
+
+    if ( defined( $opts->{dbargs} ) ) {
+        @args = @{ $opts->{dbargs} };
+    }
+
+    return (@args);
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: _define
+#      PURPOSE: Handles multiple instances of the same option '-define x=42'
+#   PARAMETERS: $opts   hash reference holding the options
+#      RETURNS: A hash containing all of the named items (e.g. { 'x' => 42 })
+#  DESCRIPTION: If there are -define options they will be a hashref in the hash
+#               returned by Getopt::Long. We return the internal hash to the
+#               caller. Doesn't handle the issue that we don't want the keys
+#               'names' and 'result', though perhaps it should.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO:
+#===============================================================================
+sub _define {
+    my ($opts) = @_;
+
+    my %defs;
+
+    if ( defined( $opts->{define} ) ) {
+        %defs = %{ $opts->{define} };
+    }
+
+    return (%defs);
+}
+
+#===  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",    "doc",        "debug=i",   "config=s",
+        "query=s", "template=s", "dbargs=s@", "define=s%",
+    );
+
+    if ( !GetOptions( $optref, @options ) ) {
+        pod2usage( -msg => "Version $VERSION\n", -exitval => 1 );
+    }
+
+    return;
+}
+
+__END__
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#  Application Documentation
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#{{{
+
+=head1 NAME
+
+query2tt2 - A script for formatting a report from database query using a template
+
+=head1 VERSION
+
+This documentation refers to query2tt2 version 0.0.4
+
+=head1 USAGE
+
+    query2tt2 [-help] [-debug=N] [-config=FILE] [-query=FILE]
+         [-template=FILE] [QUERY]
+
+    query2tt2 -help
+
+    query2tt2 -query=tag_query_580-589.sql
+
+    query2tt2 -config=.hpr_livedb.cfg -template=query2tt2_taglist.tpl \
+    'select id,summary,tags from eps where id between 580 AND 589 AND (length(summary) = 0 or length(tags) = 0) ORDER BY id'
+
+    query2tt2 -config=.hpr_livedb.cfg -query=hosts_showcount.sql \
+        -dbargs '2021-01-01' -dbargs '2021-12-31' \
+        -def year=2021 -template=~/HPR/Community_News/hosts_list.tpl
+
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-help>
+
+Prints a brief help message describing the usage of the program, and then exits.
+
+=item B<-doc>
+
+Displays the entirety of the documentation (using a pager), and then exits. To
+generate a PDF version use:
+
+    pod2pdf query2tt2 --out=query2tt2.pdf
+
+=item B<-debug=N>
+
+Selects a level of debugging. Debug information consists of a line or series
+of lines prefixed with the characters 'D>':
+
+=over 4
+
+=item B<0>
+
+No debug output is generated: this is the default
+
+=item B<3>
+
+Prints all data structures from options or from the database
+
+=back
+
+(The debug levels need work!)
+
+=item B<-config=FILE>
+
+This option allows an alternative configuration file to be used. This file
+defines the location of the database, its port, its name and the username and
+password to be used to access it. This feature was added to allow the script
+to access alternative databases or the live HPR database over an SSH tunnel.
+
+See the CONFIGURATION AND ENVIRONMENT section below for the file format.
+
+If the option is omitted the default file is used: B<.hpr_db.cfg>
+
+=item B<-query=FILE>
+
+The script needs an SQL query to be applied to the database. This may be
+supplied as a file, in which case this option gives the name of the file.
+
+Alternatively the query can be given as a delimited string on the command
+line.
+
+If neither method is used the script aborts with an error message.
+
+=item B<-dbarg=ARG> [ B<-dbarg=ARG> ... ]
+
+The query can have place holders ('?') in it and the corresponding values can
+be passed to the script through the B<-dbarg=ARG> option. The option can be
+repeated as many times as required and the order of B<ARG> values is
+preserved.
+
+=item B<-template=FILE>
+
+The results of the query are fed to the Template Toolkit system for
+reformatting. This option provides the name of the template definition file.
+If this option is omitted then the script uses a very simple internal template
+which is roughly equivalent to the effect in MySQL/MariaDB of ending a query
+with I<\G>.
+
+See below in the B<DESCRIPTION> section for the constraints imposed on the
+contents of the template.
+
+Output from the template is written to STDOUT.
+
+=item B<-define KEY1=VALUE1> [ B<-define KEY2=VALUE2> ... B<-define KEYn=VALUEn> ]
+
+The Template Toolkit (TT2) template may receive values from the command line
+using this option. The argument to the B<-define> option is a B<key=value>
+pair. Keys should be unique otherwise they will overwrite one another. The
+keys will become TT2 variables and the values will be assigned to them.
+
+=back
+
+=head1 DESCRIPTION
+
+The purpose of the script is to run a query against the HPR database (a local
+copy or the live one on the server over an SSH tunnel). The database choice is
+made via a configuration file. The default file points to the local database,
+but the alternative (discussed later) accesses the live database.
+
+The data returned from the query is then passed through a Template Toolkit
+template so that it can be formatted. There are many ways in which this can be
+done. A default template is built into the script which displays the data in
+a very simple form.
+
+A knowledge of the Template Toolkit package is required to write templates.
+
+The template receives two data structures:
+
+=over 4
+
+=item B<names>
+
+This is an array of the field (column) names used in the query in the order
+they are referenced. This is to help with writing out fields in the same order
+as the query, if this is required.
+
+=item B<result>
+
+This is an array of hashes returned from the query. Relational databases
+return sets which are effectively tables or matrices of information. Perl
+represents this structure as an array of hashes where each array element
+corresponds to a row in the returned table, and each hash contains the fields
+or columns. Perl does not guarantee hash key ordering, so the B<names> array
+(above) is provided to ensure order is preserved.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item B<Unable to find configuration file ...>
+
+The nominated (or default) configuration file could not be found.
+
+=item B<Unable to find query file ...>
+
+The nominated query file could not be found.
+
+=item B<Couldn't open ...: ...>
+
+The nominated query file could not be opened.
+
+=item B<Unable to find template file ...>
+
+The nominated template file could not be found.
+
+=item B<various database errors>
+
+An error has occurred while performing a database operation.
+
+=item B<Failed to execure query.>
+
+There is a mismatch between the number of placeholders in the query ('?'
+characters) and the number of arguments provided through the B<-dbargs=ARG>
+option. The script will attempt to analyse whether there are too many or too
+few arguments
+
+There is a mismatch between the number of placeholders in the query ('?'
+characters) and the number of arguments provided through the B<-dbargs=ARG>
+option. The script will attempt to analyse whether there are too many or too
+few arguments
+
+=item B<Template Toolkit error>
+
+An error has occurred while processing the template.
+
+=back
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+The script obtains the credentials it requires to open the MariaDB database
+from a configuration file. The name of the file it expects is B<.hpr_db.cfg>
+in the directory holding the script. This configuration file can be overridden
+using the B<-config=FILE> option as described above.
+
+The configuration file format is as follows:
+
+ <database>
+     host = 127.0.0.1
+     port = PORT
+     name = DATABASE
+     user = USERNAME
+     password = PASSWORD
+ </database>
+
+=head1 DEPENDENCIES
+
+    Config::General
+    DBI
+    Data::Dumper
+    File::Slurper
+    Getopt::Long
+    Hash::Merge
+    Pod::Usage
+    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) 2021, 2022, 2024 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]
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker

Database/query2tt2_taglist.tpl

@@ -0,0 +1,20 @@
+[%# query2tt2_taglist.tpl 2021-12-31 -%]
+[%# Template to make a template for missing summaries and tags -%]
+[%# Now obsolete; the tag/summary project has finished -%]
+[% FOREACH row IN result -%]
+show: [% row.id %]
+[% IF row.summary.length > 0 -%]
+#summary: [% row.summary %]
+[% ELSE -%]
+summary: 
+[% END -%]
+[% IF row.tags.length > 0 -%]
+#tags: [% row.tags %]
+[% ELSE -%]
+tags: 
+[% END -%]
+
+[% END -%]
+[%#
+  vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]

Database/refresh_tags

@@ -0,0 +1,613 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: refresh_tags
+#
+#        USAGE: ./refresh_tags
+#
+#  DESCRIPTION: Parse tags from the eps.tags field and use them to populate
+#               the tags table. The eps tag list is definitive (though it's
+#               quite limited since it's only 200 characters long), and so the
+#               tags table is kept in step by adding and deleting.
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.3
+#      CREATED: 2016-07-17 15:59:24
+#     REVISION: 2017-01-30 17:13:28
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use Carp;
+use Getopt::Long;
+use Config::General;
+use Text::CSV;
+use SQL::Abstract;
+use DBI;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.3';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.cfg";
+
+my ( $dbh, $sth1, $h1 );
+my ( $status, @fields );
+my ( %eps_tags, %tags_tags, %diffs );
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#
+# Load configuration data
+#
+my $conf = Config::General->new(
+    -ConfigFile      => $configfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1,
+);
+my %config = $conf->getall();
+
+#-------------------------------------------------------------------------------
+# Options and arguments
+#-------------------------------------------------------------------------------
+#
+# Process options
+#
+my %options;
+Options( \%options );
+
+Usage() if ( $options{'help'} );
+
+#
+# Collect options
+#
+my $verbose = ( defined( $options{verbose} )   ? $options{verbose}   : 0 );
+my $dry_run = ( defined( $options{'dry-run'} ) ? $options{'dry-run'} : 1 );
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or croak $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+my $csv = Text::CSV_XS->new;
+
+#-------------------------------------------------------------------------------
+#  Collect and process the id numbers and tags from the 'eps' table
+#-------------------------------------------------------------------------------
+%eps_tags = %{ collect_eps_tags( $dbh, $verbose ) };
+
+#-------------------------------------------------------------------------------
+# Collect any tags we've already stashed in the database
+#-------------------------------------------------------------------------------
+%tags_tags = %{ collect_db_tags( $dbh, $verbose ) };
+
+#-------------------------------------------------------------------------------
+# Now compare the two sources to look for differences
+#-------------------------------------------------------------------------------
+%diffs = %{ find_differences(\%eps_tags,\%tags_tags) };
+
+#-------------------------------------------------------------------------------
+# Perform the updates if there are any
+#-------------------------------------------------------------------------------
+if (%diffs) {
+    print "Differences found\n";
+    unless ($dry_run) {
+        #
+        # Loop through all of the actions by episode number
+        #
+        foreach my $id ( sort { $a <=> $b } keys(%diffs) ) {
+
+            #
+            # Do deletions before additions
+            #
+            if ( exists( $diffs{$id}->{deletions} ) ) {
+                do_deletions( $dbh, $verbose, $id, $diffs{$id}->{deletions} );
+            }
+
+            #
+            # Do additions after deletions
+            #
+            if ( exists( $diffs{$id}->{additions} ) ) {
+                do_additions( $dbh, $sth1, $verbose, $id,
+                    $diffs{$id}->{additions} );
+            }
+
+        }
+    }
+    else {
+        print "No changes made - dry run\n";
+    }
+}
+else {
+    print "No differences found\n";
+}
+
+exit;
+
+#===  FUNCTION  ================================================================
+#         NAME: collect_eps_tags
+#      PURPOSE: Collects the tags from the eps.tags field
+#   PARAMETERS: $dbh            Database handle
+#               $verbose        Verbosity level
+#      RETURNS: A reference to the hash created by collecting all the tags
+#  DESCRIPTION:
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub collect_eps_tags {
+    my ( $dbh, $verbose ) = @_;
+
+    my ( $status, @fields, %hash );
+    my ( $sth,    $h );
+
+    #
+    # For parsing the field as CSV
+    # NOTE: Unexplained error in [E. E. "Doc" Smith] (show 2462). Works with
+    # double replaced by single quote, but doesn't work if quotes escaped (by
+    # doubling) whether all tags are quoted or not. With 'auto_diag' enabled
+    # get the error:
+    # CSV_XS ERROR: 2034 - EIF - Loose unescaped quote @ rec 1632 pos 40 field 3
+    #
+    # NOTE: Adding 'allow_loose_quotes' avoids the issue
+    #
+    my $csv = Text::CSV_XS->new(
+        { binary => 1, auto_diag => 1, allow_loose_quotes => 1 } );
+
+    #
+    # Query the eps table for all the id and tags
+    #
+    $sth = $dbh->prepare(
+        q{SELECT id,tags FROM eps
+            WHERE length(tags) > 0
+            ORDER BY id}
+    ) or die $DBI::errstr;
+    if ( $dbh->err ) {
+        warn $dbh->errstr;
+    }
+
+    $sth->execute;
+    if ( $dbh->err ) {
+        warn $dbh->errstr;
+    }
+
+    #
+    # Loop through what we got
+    #
+    while ( $h = $sth->fetchrow_hashref ) {
+       #
+       # Parse the tag list
+       #
+        $status = $csv->parse( $h->{tags} );
+        unless ($status) {
+            #
+            # Report any errors
+            #
+            print "Parse error on episode ", $h->{id}, "\n";
+            print $csv->error_input(), "\n";
+            next;
+        }
+        @fields = $csv->fields();
+
+        next unless (@fields);
+
+        #
+        # Trim all tags (don't alter $_ when doing it)
+        #
+        @fields = map {
+            my $t = $_;
+            $t =~ s/(^\s+|\s+$)//g;
+            $t;
+        } @fields;
+
+        #print "$h->{id}: ",join(",",@fields),"\n";
+
+        #
+        # Save the id and its tags, sorted for comparison, with empty elements
+        # removed too
+        #
+        $hash{ $h->{id} } = [ sort grep {!/^$/} @fields ];
+
+    }
+
+    #print Dumper(\%hash),"\n";
+
+    #
+    # Dump all id numbers and tags if the verbose level is high enough
+    #
+    if ( $verbose >= 2 ) {
+        print "\nTags collected from the 'eps' table\n\n";
+        foreach my $id ( sort { $a <=> $b } keys(%hash) ) {
+            printf "%04d: %s\n", $id, join( ",", @{ $hash{$id} } );
+        }
+    }
+
+    return \%hash;
+
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: collect_db_tags
+#      PURPOSE: Collects the tags already stored in the database
+#   PARAMETERS: $dbh            Database handle
+#               $verbose        Verbosity level
+#      RETURNS: A reference to the hash created by collecting all the tags
+#  DESCRIPTION:
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub collect_db_tags {
+    my ( $dbh, $verbose ) = @_;
+
+    my %hash;
+    my ( $sth, $h );
+
+    #
+    # Query the database for tag data
+    #
+
+    $sth = $dbh->prepare(q{SELECT * FROM tags ORDER BY id})
+        or die $DBI::errstr;
+    if ( $dbh->err ) {
+        warn $dbh->errstr;
+    }
+
+    $sth->execute;
+    if ( $dbh->err ) {
+        warn $dbh->errstr;
+    }
+
+    #
+    # Loop through what we got building an array of tags per episode number
+    #
+    while ( $h = $sth->fetchrow_hashref ) {
+        if ( defined( $hash{ $h->{id} } ) ) {
+            push( @{ $hash{ $h->{id} } }, $h->{tag} );
+        }
+        else {
+            $hash{ $h->{id} } = [ $h->{tag} ];
+        }
+    }
+
+    #
+    # Sort all the tag arrays for comparison
+    #
+    foreach my $id ( keys(%hash) ) {
+        $hash{$id} = [ sort @{ $hash{$id} } ];
+    }
+
+    #
+    # Dump all id numbers and tags if the verbose level is high enough
+    #
+    if ( $verbose >= 2 ) {
+        print "\nTags collected from the 'tags' table\n\n";
+        foreach my $id ( sort { $a <=> $b } keys(%hash) ) {
+            printf "%04d: %s\n", $id, join( ",", @{ $hash{$id} } );
+        }
+        print '=-' x 40,"\n";
+    }
+
+    return \%hash;
+
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: find_differences
+#      PURPOSE: Find the differences between two hashes containing tags
+#   PARAMETERS: $master         Reference to the master hash
+#               $slave          Reference to the slave hash
+#      RETURNS: A reference to the hash created checking for differences
+#  DESCRIPTION:
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub find_differences {
+    my ($master,$slave) = @_;
+
+    my %hash;
+
+    foreach my $id ( sort { $a <=> $b } keys(%$master) ) {
+        my %iddiffs = array_compare( $master->{$id}, $slave->{$id} );
+        if (%iddiffs) {
+            if ( $verbose >= 1 ) {
+                #
+                # Report what was found if asked to
+                #
+                print "Episode: $id\n";
+                print "Update:\n\teps:  ", join( ",", @{ $master->{$id} } ), "\n";
+                print "\ttags: ",
+                (
+                    defined( $slave->{$id} )
+                    ? join( ",", @{ $slave->{$id} } )
+                    : '--None--' ), "\n";
+                print '-' x 80,"\n";
+            }
+            $hash{$id} = {%iddiffs};
+        }
+    }
+
+    #
+    # Report differences and actions if the verbose level is high enough
+    #
+    if ( $verbose >= 2 ) {
+        print "\nDifferences and actions\n\n";
+        foreach my $id ( sort { $a <=> $b } keys(%hash) ) {
+            print "Episode: $id\n";
+            if ( exists( $hash{$id}->{deletions} ) ) {
+                print "Deletions: ";
+                print join( ",", @{ $hash{$id}->{deletions} } ), "\n";
+            }
+            if ( exists( $hash{$id}->{additions} ) ) {
+                print "Additions: ";
+                print join( ",", @{ $hash{$id}->{additions} } ), "\n";
+            }
+            print '-' x 80, "\n";
+        }
+    }
+
+    return \%hash;
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: do_deletions
+#      PURPOSE: Perform any deletions indicated in an array for a given
+#               episode
+#   PARAMETERS: $dbh            Database handle
+#               $verbose        Verbosity level
+#               $id             Episode number
+#               $tags           Reference to an array of tags for this episode
+#      RETURNS: Nothing
+#  DESCRIPTION:
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub do_deletions {
+    my ( $dbh, $verbose, $id, $tags ) = @_;
+
+    my ( $stmt, @bind, %data, %where );
+
+    #
+    # We will dynamically build SQL as we go
+    #
+    my $sql = SQL::Abstract->new;
+
+    #
+    # Process the list of tags we have been given
+    #
+    for my $i ( 0 .. $#$tags ) {
+        #
+        # Set up a deletion '... where id = ? and tag = ?'
+        #
+        %where = ( id => $id, tag => $tags->[$i] );
+
+        ( $stmt, @bind ) = $sql->delete( 'tags', \%where );
+
+        my $sth = $dbh->prepare($stmt);
+        my $rv  = $sth->execute(@bind);
+        if ( $dbh->err ) {
+            warn $dbh->errstr;
+        }
+        $rv = 0 if ( $rv eq '0E0' );
+
+        #
+        # Report the action
+        #
+        if ($rv) {
+            print "Deleted tag for show $id ($tags->[$i])\n";
+        }
+
+    }
+
+    print "Deleted ", scalar(@$tags), " row",
+        ( scalar(@$tags) != 1 ? 's' : '' ), "\n";
+
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: do_additions
+#      PURPOSE: Perform any additions indicated in an array for a given
+#               episode
+#   PARAMETERS: $dbh            Database handle
+#               $sth            A prepared database handle with a query to
+#                               search for the target tag
+#               $verbose        Verbosity level
+#               $id             Episode number
+#               $tags           Reference to an array of tags for this episode
+#      RETURNS: Nothing
+#  DESCRIPTION: FIXME
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub do_additions {
+    my ( $dbh, $sth, $verbose, $id, $tags ) = @_;
+
+    my ( $sth1, $rv, $h, $tid, $stmt, @bind, %data );
+
+    #
+    # We will dynamically build SQL as we go
+    #
+    my $sql = SQL::Abstract->new;
+
+    my @lctags = map { lc($_) } @$tags;
+
+    for my $i ( 0 .. $#$tags ) {
+        #
+        # Build the row we're going to add
+        #
+        %data = (
+            id    => $id,
+            tag   => $tags->[$i],
+            lctag => $lctags[$i]
+        );
+
+        ( $stmt, @bind ) = $sql->insert( 'tags', \%data );
+
+        my $sth = $dbh->prepare($stmt);
+        my $rv  = $sth->execute(@bind);
+        if ( $dbh->err ) {
+            warn $dbh->errstr;
+        }
+        $rv = 0 if ( $rv eq '0E0' );
+
+        #
+        # Report the action
+        #
+        if ($rv) {
+            print "Added tag for show $id ($tags->[$i])\n";
+        }
+    }
+
+    print "Added ", scalar(@$tags), " row",
+        ( scalar(@$tags) != 1 ? 's' : '' ), "\n";
+
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: array_compare
+#      PURPOSE: Compares the elements of two arrays to see if an element
+#               present in the master is also present in the slave
+#   PARAMETERS: $arr1   A reference to the first array; the MASTER
+#               $arr2   A reference to the second array; the SLAVE
+#      RETURNS: A hash containing arrays of additions and deletions of the
+#               elements that are different. The structure is:
+#               {
+#                   additions => [ tag1, tag2 .. tagn ],
+#                   deletions => [ tag1, tag2 .. tagn ],
+#               }
+#               The returned hash will be empty if there are no differences.
+#  DESCRIPTION: The requirement is to find if there are differences, then to
+#               find what they are so that other code can make the slave array
+#               match the master. The two arrays come from a database, so
+#               we're trying to make a second source (slave) equal the first
+#               (master).
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub array_compare {
+    my ( $arr1, $arr2 ) = @_;
+
+    my %res;
+    my ( @additions, @deletions );
+    my %h1 = map { $_ => 1 } @$arr1;
+    my %h2 = map { $_ => 1 } @$arr2;
+
+    #
+    # Find additions
+    #
+    for my $key ( keys(%h1) ) {
+        unless ( exists( $h2{$key} ) ) {
+            push( @additions, $key );
+        }
+    }
+
+    #
+    # Find deletions
+    #
+    for my $key ( keys(%h2) ) {
+        unless ( exists( $h1{$key} ) ) {
+            push( @deletions, $key );
+        }
+    }
+
+    $res{additions} = [@additions] if @additions;
+    $res{deletions} = [@deletions] if @deletions;
+
+    return %res;
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: Usage
+#      PURPOSE: Display a usage message and exit
+#   PARAMETERS: None
+#      RETURNS: To command line level with exit value 1
+#  DESCRIPTION: Builds the usage message using global values
+#       THROWS: no exceptions
+#     COMMENTS: none
+#     SEE ALSO: n/a
+#===============================================================================
+sub Usage {
+    print STDERR <<EOD;
+Usage: $PROG [options] project
+
+$PROG v$VERSION
+
+    -help               Display this information
+    -[no]dry-run        Display what would have been done but make no changes.
+                        Default is -dry-run.
+    -verbose            A repeatable option which turns up the verbosity from
+                        0 (silent) to 2 (lots of stuff). Default is 0.
+
+EOD
+    exit(1);
+}
+
+#===  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", "verbose+", "dry-run!", );
+
+    if ( !GetOptions( $optref, @options ) ) {
+        Usage();
+    }
+
+    return;
+}
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
+

Database/refresh_tags_2

@@ -0,0 +1,775 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: refresh_tags_2
+#
+#        USAGE: ./refresh_tags_2
+#
+#  DESCRIPTION: Parse tags from the eps.tags field and use them to populate
+#               the eps_tags2_xref and tags2 tables. The eps tag list is
+#               definitive (though it's quite limited since it's only 200
+#               characters long), and so the junction table eps_tags2_xref and
+#               the normalised tags table tags2 are kept in step by adding
+#               and deleting.
+#               This script is for demonstration purposes. It is not the
+#               definitive answer to the tag management problem in the HPR
+#               database, though it's close :-)
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.3
+#      CREATED: 2016-07-22 16:48:49
+#     REVISION: 2017-03-14 21:11:33
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use Carp;
+use Getopt::Long;
+use Config::General;
+use Text::CSV;
+use SQL::Abstract;
+use DBI;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.3';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.cfg";
+
+my ( $dbh, $sth1, $h1, $rv );
+my ( %eps_tags, %tags_tags, %diffs );
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#
+# Load configuration data
+#
+my $conf = Config::General->new(
+    -ConfigFile      => $configfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1,
+);
+my %config = $conf->getall();
+
+#-------------------------------------------------------------------------------
+# Options and arguments
+#-------------------------------------------------------------------------------
+#
+# Process options
+#
+my %options;
+Options( \%options );
+
+Usage() if ( $options{'help'} );
+
+#
+# Collect options
+#
+my $verbose = ( defined( $options{verbose} )   ? $options{verbose}   : 0 );
+my $dry_run = ( defined( $options{'dry-run'} ) ? $options{'dry-run'} : 1 );
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or croak $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+#-------------------------------------------------------------------------------
+#  Collect and process the id numbers and tags from the 'eps' table
+#-------------------------------------------------------------------------------
+%eps_tags = %{ collect_eps_tags( $dbh, $verbose ) };
+
+#-------------------------------------------------------------------------------
+# Collect any tags we've already stashed in the database.
+#-------------------------------------------------------------------------------
+%tags_tags = %{ collect_db_tags( $dbh, $verbose ) };
+
+#-------------------------------------------------------------------------------
+# Now compare the two sources to look for differences
+#-------------------------------------------------------------------------------
+%diffs = %{ find_differences(\%eps_tags,\%tags_tags) };
+
+#-------------------------------------------------------------------------------
+# Perform the updates if there are any
+#-------------------------------------------------------------------------------
+if (%diffs) {
+    print "Differences found\n\n";
+    unless ($dry_run) {
+        #
+        # Scan for all deletions in the %diffs hash by traversing it by sorted
+        # episode number. If deletions are found for an episode they are
+        # performed.
+        #
+        foreach my $id ( sort { $a <=> $b } keys(%diffs) ) {
+            if ( exists( $diffs{$id}->{deletions} ) ) {
+                do_deletions( $dbh, $verbose, $id, $diffs{$id}->{deletions} );
+            }
+        }
+
+        #
+        # Prepare to search for tags
+        #
+        $sth1 = $dbh->prepare(q{SELECT * FROM tags2 WHERE tag = ?})
+            or die $DBI::errstr;
+        if ( $dbh->err ) {
+            warn $dbh->errstr;
+        }
+
+        #
+        # Scan for all additions in the %diffs hash
+        #
+        foreach my $id ( sort { $a <=> $b } keys(%diffs) ) {
+            if ( exists( $diffs{$id}->{additions} ) ) {
+                do_additions( $dbh, $sth1, $verbose, $id,
+                    $diffs{$id}->{additions} );
+            }
+        }
+
+        #
+        # Having deleted all the requested rows from the junction table remove
+        # any tags that are "orphaned" as a consequence. If we were using
+        # foreign keys we could let the database do this.
+        #
+        $sth1 = $dbh->prepare(
+            q{DELETE FROM tags2
+              WHERE id NOT IN (SELECT DISTINCT tags2_id FROM eps_tags2_xref)}
+        ) or die $DBI::errstr;
+        if ( $dbh->err ) {
+            warn $dbh->errstr;
+        }
+
+        $rv = $sth1->execute;
+        if ( $dbh->err ) {
+            warn $dbh->errstr;
+        }
+        $rv = 0 if ( $rv eq '0E0' );
+
+        #
+        # Report the action
+        #
+        if ($rv) {
+            print "Deleted ", $rv, " orphan tag", ( $rv != 1 ? 's' : '' ),
+                "\n";
+        }
+
+    }
+    else {
+        print "No changes made - dry run\n";
+    }
+}
+else {
+    print "No differences found\n";
+}
+
+exit;
+
+#===  FUNCTION  ================================================================
+#         NAME: collect_eps_tags
+#      PURPOSE: Collects the tags from the eps.tags field
+#   PARAMETERS: $dbh            Database handle
+#               $verbose        Verbosity level
+#      RETURNS: A reference to the hash created by collecting all the tags
+#  DESCRIPTION: FIXME
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub collect_eps_tags {
+    my ( $dbh, $verbose ) = @_;
+
+    my ( $status, @fields, %hash );
+    my ( $sth,    $h );
+
+    #
+    # For parsing the field as CSV
+    #
+    my $csv = Text::CSV_XS->new(
+        {   binary             => 1,
+            auto_diag          => 1,
+            allow_loose_quotes => 1
+        }
+    );
+
+    #
+    # Query the eps table for all the id and tags
+    #
+    $sth = $dbh->prepare(
+        q{SELECT id,tags FROM eps
+            WHERE length(tags) > 0
+            ORDER BY id}
+    ) or die $DBI::errstr;
+    if ( $dbh->err ) {
+        warn $dbh->errstr;
+    }
+
+    $sth->execute;
+    if ( $dbh->err ) {
+        warn $dbh->errstr;
+    }
+
+    #
+    # Loop through what we got
+    #
+    while ( $h = $sth->fetchrow_hashref ) {
+       #
+       # Parse the tag list
+       #
+        $status = $csv->parse( $h->{tags} );
+        unless ($status) {
+            #
+            # Report any errors
+            #
+            print "Parse error on episode ", $h->{id}, "\n";
+            print $csv->error_input(), "\n";
+            next;
+        }
+        @fields = $csv->fields();
+
+        next unless (@fields);
+
+        #
+        # Trim all tags (don't alter $_ when doing it)
+        #
+        @fields = map {
+            my $t = $_;
+            $t =~ s/(^\s+|\s+$)//g;
+            $t;
+        } @fields;
+
+        #print "$h->{id}: ",join(",",@fields),"\n";
+
+        #
+        # Save the id and its tags, sorted for comparison, with empty elements
+        # removed too
+        #
+        $hash{ $h->{id} } = [ sort grep {!/^$/} @fields ];
+
+    }
+
+    #print Dumper(\%hash),"\n";
+
+    #
+    # Dump all id numbers and tags if the verbose level is high enough
+    #
+    if ( $verbose >= 3 ) {
+        print "\nTags collected from the 'eps' table\n\n";
+        foreach my $id ( sort { $a <=> $b } keys(%hash) ) {
+            printf "%04d: %s\n", $id, join( ",", @{ $hash{$id} } );
+        }
+    }
+
+    return \%hash;
+
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: collect_db_tags
+#      PURPOSE: Collects the tags already stored in the database
+#   PARAMETERS: $dbh            Database handle
+#               $verbose        Verbosity level
+#      RETURNS: A reference to the hash created by collecting all the tags
+#  DESCRIPTION:
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub collect_db_tags {
+    my ( $dbh, $verbose ) = @_;
+
+    my %hash;
+    my ( $sth, $h );
+
+    #
+    # Query the database for tag data
+    #
+    # We use the junction table (eps_tags2_xref), traversing it by episode number
+    # and linking the table of tags (tags2). This results in a list of the tags
+    # relating to an episode, which should be similar to (if not the same as) the
+    # 'tags' field in the 'eps' table.
+    #
+    $sth = $dbh->prepare(
+        q{SELECT et.eps_id AS id,t.tag,t.lctag
+            FROM eps_tags2_xref et
+            JOIN tags2 t ON et.tags2_id = t.id
+            ORDER BY et.eps_id}
+    ) or die $DBI::errstr;
+    if ( $dbh->err ) {
+        warn $dbh->errstr;
+    }
+
+    $sth->execute;
+    if ( $dbh->err ) {
+        warn $dbh->errstr;
+    }
+
+    #
+    # Loop through what we got, building an array of tags per episode number
+    #
+    while ( $h = $sth->fetchrow_hashref ) {
+        if ( defined( $hash{ $h->{id} } ) ) {
+            push( @{ $hash{ $h->{id} } }, $h->{tag} );
+        }
+        else {
+            $hash{ $h->{id} } = [ $h->{tag} ];
+        }
+    }
+
+    #
+    # Sort all the tag arrays for comparison
+    #
+    foreach my $id ( keys(%hash) ) {
+        $hash{$id} = [ sort @{ $hash{$id} } ];
+    }
+
+    #
+    # Dump all id numbers and tags if the verbose level is high enough
+    #
+    if ( $verbose >= 3 ) {
+        print "\nTags collected from the 'tags2' table\n\n";
+        foreach my $id ( sort { $a <=> $b } keys(%hash) ) {
+            printf "%04d: %s\n", $id, join( ",", @{ $hash{$id} } );
+        }
+        print '=-' x 40,"\n";
+    }
+
+    return \%hash;
+
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: find_differences
+#      PURPOSE: Find the differences between two hashes containing tags
+#   PARAMETERS: $master         Reference to the master hash
+#               $slave          Reference to the slave hash
+#      RETURNS: A reference to the hash created checking for differences
+#  DESCRIPTION: The function is presented with two hashes. The 'master' hash
+#               has come from the CSV string in the 'eps' table. The 'slave'
+#               hash has come from the table of tags 'tags2'. These hashes are
+#               keyed by episode number and each element contains a reference
+#               to a sorted array of tags.
+#               This function compares two tag arrays for an episode using
+#               function 'array_compare' and receives back a hash of additions
+#               and deletions:
+#               {
+#                   additions => [ tag1, tag2 .. tagn ],
+#                   deletions => [ tag1, tag2 .. tagn ],
+#               }
+#               These are stored in a result hash keyed by episode number, and
+#               a reference to this hash is returned to the caller.
+#               This function can report a lot of details about what has been
+#               found if the level of verbosity is high enough.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub find_differences {
+    my ($master,$slave) = @_;
+
+    my %hash;
+
+    foreach my $id ( sort { $a <=> $b } keys(%$master) ) {
+        my %iddiffs = array_compare( $master->{$id}, $slave->{$id} );
+        if (%iddiffs) {
+            if ( $verbose >= 1 ) {
+                #
+                # Report what was found if asked to
+                #
+                print "Episode: $id\n";
+                print "Update:\n\teps:  ", join( ",", @{ $master->{$id} } ), "\n";
+                print "\ttags: ",
+                (
+                    defined( $slave->{$id} )
+                    ? join( ",", @{ $slave->{$id} } )
+                    : '--None--' ), "\n";
+                print '-' x 80,"\n";
+            }
+            $hash{$id} = {%iddiffs};
+        }
+    }
+
+    #
+    # Report differences and actions if the verbose level is high enough
+    #
+    if ( $verbose >= 2 ) {
+        print "\nDifferences and actions\n\n";
+        foreach my $id ( sort { $a <=> $b } keys(%hash) ) {
+            print "Episode: $id\n";
+            if ( exists( $hash{$id}->{deletions} ) ) {
+                print "Deletions: ";
+                print join( ",", @{ $hash{$id}->{deletions} } ), "\n";
+            }
+            if ( exists( $hash{$id}->{additions} ) ) {
+                print "Additions: ";
+                print join( ",", @{ $hash{$id}->{additions} } ), "\n";
+            }
+            print '-' x 80, "\n";
+        }
+    }
+
+    return \%hash;
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: do_deletions
+#      PURPOSE: Perform any deletions indicated in an array for a given
+#               episode
+#   PARAMETERS: $dbh            Database handle
+#               $verbose        Verbosity level
+#               $id             Episode number
+#               $tags           Reference to an array of tags for this episode
+#      RETURNS: Nothing
+#  DESCRIPTION: A tag deletion consists of its removal from the joining table.
+#               Only when there are no more references to the actual tag can
+#               it then be deleted. If the tables were in a database with
+#               foreign keys then we could leave the database itself to handle
+#               this (MariaDB could do it but we'd need to redefine the tables
+#               to use InnoDB rather than MyISAM. The latter is the legacy
+#               table structure from the days when MySQL didn't have foreign
+#               keys).
+#               This function does not perform the tag deletion since this
+#               easier to leave until all deletions have finished.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub do_deletions {
+    my ( $dbh, $verbose, $id, $tags ) = @_;
+
+    my ( $stmt, @bind, %data, %where );
+
+    #
+    # We will dynamically build SQL as we go
+    #
+    my $sql = SQL::Abstract->new;
+
+    #
+    # Process the list of tags we have been given
+    #
+    for my $i ( 0 .. $#$tags ) {
+        #
+        # Set up a deletion '... where eps_id = ? and
+        # tags2 = (select id from tags2 where tag = ?)'
+        #
+        my ( $sub_stmt, @sub_bind )
+            = ( "SELECT id FROM tags2 WHERE tag = ?", $tags->[$i] );
+
+        %where = (
+            eps_id      => $id,
+            tags2_id => \[ "= ($sub_stmt)" => @sub_bind ]
+        );
+
+        ( $stmt, @bind ) = $sql->delete( 'eps_tags2_xref', \%where );
+        if ( $verbose >= 2 ) {
+            print "Statement: $stmt\n";
+            print "Bind: ", join( ",", @bind ), "\n";
+        }
+
+        #
+        # Do the deletion
+        #
+        my $sth = $dbh->prepare($stmt);
+        my $rv = $sth->execute(@bind);
+        if ( $dbh->err ) {
+            warn $dbh->errstr;
+        }
+        $rv = 0 if ( $rv eq '0E0' );
+
+        #
+        # Report the action
+        #
+        if ($rv) {
+            print "Deleted tag for show $id ($tags->[$i])\n";
+        }
+
+    }
+
+    print "Deleted ", scalar(@$tags), " row",
+        ( scalar(@$tags) != 1 ? 's' : '' ), "\n";
+
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: do_additions
+#      PURPOSE: Perform any additions indicated in an array for a given
+#               episode
+#   PARAMETERS: $dbh            Database handle
+#               $sth            A prepared database handle with a query to
+#                               search for the target tag
+#               $verbose        Verbosity level
+#               $id             Episode number
+#               $tags           Reference to an array of tags for this episode
+#      RETURNS: Nothing
+#  DESCRIPTION: The addition of a tag for an episode consists of creating the
+#               tag in the 'tags2' table (unless it already exists) and
+#               making a joining table entry for it. This what this function
+#               does.
+#               FIXME: Not very resilient to failure.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub do_additions {
+    my ( $dbh, $sth, $verbose, $id, $tags ) = @_;
+
+    my ( $sth1, $rv, $h, $tid, $stmt, @bind, %data );
+
+    #
+    # We will dynamically build SQL as we go
+    #
+    my $sql = SQL::Abstract->new;
+
+    my @lctags = map { lc($_) } @$tags;
+
+    #
+    # Loop through the array of tags (using an integer so we can index the
+    # current tag)
+    #
+    for my $i ( 0 .. $#$tags ) {
+        #
+        # Look to see if this tag exists
+        #
+        $sth->execute( $tags->[$i] );
+        if ( $dbh->err ) {
+            warn $dbh->errstr;
+        }
+
+        #
+        # If it's already in the table just store the id otherwise
+        # add a new entry
+        #
+        if ( $h = $sth->fetchrow_hashref ) {
+            $tid = $h->{id};
+        }
+        else {
+            #
+            # Build the row we're going to add
+            #
+            %data = (
+                tag   => $tags->[$i],
+                lctag => $lctags[$i]
+            );
+
+            #
+            # Build the SQL, reporting the result if asked
+            #
+            ( $stmt, @bind ) = $sql->insert( 'tags2', \%data );
+            if ( $verbose >= 2 ) {
+                print "Statement: $stmt\n";
+                print "Bind: ", join( ",", @bind ), "\n";
+            }
+
+            #
+            # Add the tag to 'tags2'
+            #
+            $sth1 = $dbh->prepare($stmt);
+            $rv   = $sth1->execute(@bind);
+            if ( $dbh->err ) {
+                warn $dbh->errstr;
+            }
+            $rv = 0 if ( $rv eq '0E0' );
+
+            #
+            # Ask the database for the id we just added
+            # FIXME: what if it failed?
+            #
+            $tid = $sth1->{mysql_insertid};
+
+            #
+            # Report the action
+            #
+            if ($rv) {
+                print "Added new tag '$tags->[$i]' ($tid)\n";
+            }
+        }
+
+        #
+        # Now we know we have a tag in the tags2 table so now we can create
+        # the eps_tags2_xref entry
+        #
+        %data = (
+            eps_id   => $id,
+            tags2_id => $tid
+        );
+
+        #
+        # Build the SQL, reporting the result if asked
+        #
+        ( $stmt, @bind ) = $sql->insert( 'eps_tags2_xref', \%data );
+        if ( $verbose >= 2 ) {
+            print "Statement: $stmt\n";
+            print "Bind: ", join( ",", @bind ), "\n";
+        }
+
+        #
+        # Add the row
+        #
+        $sth1 = $dbh->prepare($stmt);
+        $rv   = $sth1->execute(@bind);
+        if ( $dbh->err ) {
+            warn $dbh->errstr;
+        }
+        $rv = 0 if ( $rv eq '0E0' );
+
+        #
+        # Report the action
+        #
+        if ($rv) {
+            printf "Added new junction row (eps_id=%s,tags2_id=%s -> %s)\n",
+                $id, $tid, $tags->[$i];
+        }
+
+    }
+
+    print "Added ", scalar(@$tags), " row",
+        ( scalar(@$tags) != 1 ? 's' : '' ), "\n";
+
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: array_compare
+#      PURPOSE: Compares the elements of two arrays to see if an element
+#               present in the master is also present in the slave
+#   PARAMETERS: $arr1   A reference to the first array; the MASTER
+#               $arr2   A reference to the second array; the SLAVE
+#      RETURNS: A hash containing arrays of additions and deletions of the
+#               elements that are different. The structure is:
+#               {
+#                   additions => [ tag1, tag2 .. tagn ],
+#                   deletions => [ tag1, tag2 .. tagn ],
+#               }
+#               The returned hash will be empty if there are no differences.
+#  DESCRIPTION: The requirement is to find if there are differences, then to
+#               find what they are so that other code can make the slave array
+#               match the master. The two arrays come from a database, so
+#               we're trying to make a second source (slave) equal the first
+#               (master).
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub array_compare {
+    my ( $arr1, $arr2 ) = @_;
+
+    my %res;
+    my ( @additions, @deletions );
+
+    #
+    # Use hashes to make it easier to find existence of stuff
+    #
+    my %h1 = map { lc($_) => 1 } @$arr1;
+    my %h2 = map { lc($_) => 1 } @$arr2;
+
+    #
+    # Find additions
+    #
+    for my $key ( keys(%h1) ) {
+        unless ( exists( $h2{$key} ) ) {
+            push( @additions, $key );
+        }
+    }
+
+    #
+    # Find deletions
+    #
+    for my $key ( keys(%h2) ) {
+        unless ( exists( $h1{$key} ) ) {
+            push( @deletions, $key );
+        }
+    }
+
+    $res{additions} = [@additions] if @additions;
+    $res{deletions} = [@deletions] if @deletions;
+
+    return %res;
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: Usage
+#      PURPOSE: Display a usage message and exit
+#   PARAMETERS: None
+#      RETURNS: To command line level with exit value 1
+#  DESCRIPTION: Builds the usage message using global values
+#       THROWS: no exceptions
+#     COMMENTS: none
+#     SEE ALSO: n/a
+#===============================================================================
+sub Usage {
+    print STDERR <<EOD;
+Usage: $PROG [options] project
+
+$PROG v$VERSION
+
+    -help               Display this information
+    -[no]dry-run        Display what would have been done but make no changes.
+                        Default is -dry-run.
+    -verbose            A repeatable option which turns up the verbosity from
+                        0 (silent) to 3 (lots and lots of stuff). Default is 0.
+
+EOD
+    exit(1);
+}
+
+#===  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", "verbose+", "dry-run!", );
+
+    if ( !GetOptions( $optref, @options ) ) {
+        Usage();
+    }
+
+    return;
+}
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
+

Database/remodel_db_hosts_eps

@@ -0,0 +1,354 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: remodel_db_host_eps
+#
+#        USAGE: ./remodel_db_host_eps
+#
+#  DESCRIPTION: Remodel the 'hosts' and 'eps' tables in the HPR database so
+#               that a many-to-many relationship between host and episode can
+#               be established.
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.2
+#      CREATED: 2014-05-08 10:55:28
+#     REVISION: 2015-06-26 13:33:20
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use YAML::Syck;
+use List::Util qw{max};
+use List::MoreUtils qw{uniq};
+use DBI;
+#use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.2';
+
+#
+# Script name
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.yml";
+
+my ( $dbh, $sth1, $sth2, $sth3, $sth4, $h1, $h2, $rv );
+my ( %hosts_by_name, %hosts_by_id, %eps, @names, $hostid, $hid, $max_hostid );
+
+#
+# Names of fields in the 'hosts' table in the appropriate order for the later
+# INSERT statement
+#
+my @host_flds = qw{
+    hostid
+    host
+    email
+    profile
+    license
+    local_image
+    valid
+};
+
+#
+# Names of fields in the 'eps' table in the appropriate order for the later
+# INSERT statement. Note that it omits the 'hostid' field.
+#
+my @eps_flds = qw{
+    id
+    date
+    title
+    summary
+    notes
+    series
+    explicit
+    license
+    tags
+    version
+    valid
+};
+
+#
+# Enable Unicode output mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#
+# Load configuration data
+#
+my %config = %{ LoadFile($configfile) };
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+$dbh
+    = DBI->connect( "dbi:mysql:dbname=$dbname", $dbuser, $dbpwd,
+    { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
+# The expectation is that we have the following original tables:
+# hosts         - the details of each host (contains some double entries
+#                 "hostA and hostB")
+# eps           - the details of all episodes, currently with a host id number
+#                 against each one
+#
+# We also have the following new tables for the transition:
+# new_hosts     - an empty copy of the 'hosts' table, InnoDB
+# new_eps       - an empty copy of the 'eps' table without the 'hostid'
+#                 column, InnoDB
+# hosts_eps     - a mapping table for joining together the 'new_hosts' and
+#                 'new_eps' tables, InnoDB with foreign keys
+#
+# See the file 'hosts_eps.sql' for the DDL which creates these tables.
+#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
+
+#-------------------------------------------------------------------------------
+# Collect the entire 'hosts' table
+#-------------------------------------------------------------------------------
+$sth1 = $dbh->prepare(q{SELECT * FROM hosts ORDER BY hostid DESC});
+$sth1->execute;
+if ( $dbh->err ) {
+    die $dbh->errstr;
+}
+
+#
+# Grab the data as an arrayref of hashrefs
+#
+my $hosts = $sth1->fetchall_arrayref( {} );
+
+#
+# Make hashes keyed on the host name and on the id
+#
+%hosts_by_name = map { $_->{host}   => $_ } @{$hosts};
+%hosts_by_id   = map { $_->{hostid} => $_ } @{$hosts};
+
+$max_hostid = max( map { $_->{hostid} } values(%hosts_by_name) );
+
+#-------------------------------------------------------------------------------
+# Collect the entire 'eps' table
+#-------------------------------------------------------------------------------
+$sth1 = $dbh->prepare(q{SELECT * FROM eps ORDER BY id DESC});
+$sth1->execute;
+if ( $dbh->err ) {
+    die $dbh->errstr;
+}
+
+#
+# Grab the data as an arrayref of hashrefs
+#
+my $eps = $sth1->fetchall_arrayref( {} );
+
+#
+# Make a hash keyed on the episode number
+#
+%eps = map { $_->{id} => $_ } @{$eps};
+
+#-------------------------------------------------------------------------------
+# Walk the hash of hosts by name, finding double host entries. Stash the
+# episode numbers against the hosts (but do it messily resulting in duplicates
+# as a side effect)
+#-------------------------------------------------------------------------------
+foreach my $key ( keys(%hosts_by_name) ) {
+    $hostid = $hosts_by_name{$key}->{hostid};
+
+    #
+    # Is this a double ("HostA and HostB") entry?
+    #
+    if ( @names = ( $key =~ /^([[:print:]]+) and ([[:print:]]+)$/ ) ) {
+        printf "%3d: %s\n", $hosts_by_name{$key}->{hostid}, $key;
+
+        #
+        # Process the names picked out of the 'host' field
+        #
+        foreach my $name (@names) {
+            if ( exists( $hosts_by_name{$name} ) ) {
+                #
+                # Known name,  report it
+                #
+                printf "\t%3d: %s\n", $hosts_by_name{$name}->{hostid}, $name;
+                printf "Replace %d with %d\n",
+                    $hosts_by_name{$key}->{hostid},
+                    $hosts_by_name{$name}->{hostid};
+
+                #
+                # Collect all episodes relating to the double id ($hostid) and
+                # add them to the known id ($hid)
+                #
+                $hid = $hosts_by_name{$name}->{hostid};
+                $hosts_by_id{$hid}->{eps}
+                    = collect_eps( $hostid, \%eps,
+                    $hosts_by_id{$hid}->{eps} );
+
+                #
+                # Mark the double id as not valid
+                #
+                $hosts_by_id{$hostid}->{valid} = 0;
+            }
+            else {
+                #
+                # Unknown name, make a new host entry
+                #
+                print "\t'$name' not known\n";
+                $max_hostid++;
+                $hosts_by_id{$max_hostid} = {
+                    'profile'     => '',
+                    'local_image' => '0',
+                    'hostid'      => $max_hostid,
+                    'license'     => 'CC-BY-SA',
+                    'host'        => $name,
+                    'valid'       => '1',
+                    'email'       => ''
+                };
+
+                #
+                # Save all episodes for this name
+                #
+                $hid = $hosts_by_name{$key}->{hostid};
+                $hosts_by_id{$max_hostid}->{eps}
+                    = collect_eps( $hid, \%eps,
+                    $hosts_by_id{$max_hostid}->{eps} );
+            }
+        }
+    }
+    else {
+        #
+        # Single host, just collect all their episodes
+        #
+        $hosts_by_id{$hostid}->{eps}
+            = collect_eps( $hostid, \%eps, $hosts_by_id{$hostid}->{eps} );
+    }
+}
+
+#-------------------------------------------------------------------------------
+# Report on the structure we built, de-duplicating as we go
+#-------------------------------------------------------------------------------
+foreach my $hid ( sort { $a <=> $b } keys(%hosts_by_id) ) {
+    if ( exists( $hosts_by_id{$hid}->{eps} ) ) {
+        #
+        # De-duplicate the episode list
+        #
+        @{ $hosts_by_id{$hid}->{eps} }
+            = sort { $a <=> $b } uniq( @{ $hosts_by_id{$hid}->{eps} } );
+
+        #
+        # Print the host details followed by the episodes
+        #
+        printf "Hostid: %d [%s,%d] (%d)\n", $hid,
+            $hosts_by_id{$hid}->{host},
+            $hosts_by_id{$hid}->{hostid},
+            scalar( @{ $hosts_by_id{$hid}->{eps} } );
+        foreach my $ep ( @{ $hosts_by_id{$hid}->{eps} } ) {
+            printf "  Episode: %d\n", $ep;
+        }
+    }
+}
+
+#-------------------------------------------------------------------------------
+# Turn the %hosts_by_id hash into database insert statements
+#-------------------------------------------------------------------------------
+my $sql1 = sprintf( "INSERT INTO new_hosts VALUES(%s)",
+    join( ",", map { '?' } @host_flds ) );
+$sth1 = $dbh->prepare($sql1);
+
+my $sql2 = sprintf( "INSERT INTO new_eps VALUES(%s)",
+    join( ",", map { '?' } @eps_flds ) );
+$sth2 = $dbh->prepare($sql2);
+
+$sth3 = $dbh->prepare(q{INSERT INTO hosts_eps VALUES(?,?)});
+
+#
+# The 'new_hosts' table
+#
+foreach my $hid ( sort { $a <=> $b } keys(%hosts_by_id) ) {
+    $sth1->execute( @{ $hosts_by_id{$hid} }{@host_flds} );
+    if ( $dbh->err ) {
+        die $dbh->errstr;
+    }
+}
+
+#
+# The 'new_eps' table
+#
+foreach my $eid ( sort { $a <=> $b } keys(%eps) ) {
+    $sth2->execute( @{ $eps{$eid} }{@eps_flds} );
+    if ( $dbh->err ) {
+        die $dbh->errstr;
+    }
+}
+
+#
+# The 'hosts_eps' table
+#
+foreach my $hid ( sort { $a <=> $b } keys(%hosts_by_id) ) {
+    if ( exists( $hosts_by_id{$hid}->{eps} ) ) {
+        foreach my $ep ( @{ $hosts_by_id{$hid}->{eps} } ) {
+            $sth3->execute( $hosts_by_id{$hid}->{hostid}, $ep );
+            if ( $dbh->err ) {
+                die $dbh->errstr;
+            }
+        }
+    }
+}
+
+exit;
+
+#===  FUNCTION  ================================================================
+#         NAME: collect_eps
+#      PURPOSE: Collect all the episodes relating to a hostid and return them,
+#               along with the contents of $current as an array of hashrefs
+#   PARAMETERS: $hostid         the host id we're interested in
+#               $eps            hashref containing anonymous hashes keyed by
+#                               episode number
+#               $current        a reference to any existing array of episodes
+#                               for this host id
+#      RETURNS: A reference to the resulting array of anonymous hashes
+#  DESCRIPTION:
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub collect_eps {
+    my ( $hostid, $eps, $current ) = @_;
+    my @host_eps;
+
+    @host_eps = @{$current} if $current;
+
+    foreach my $epsid ( keys(%$eps) ) {
+        if ( $eps->{$epsid}->{hostid} == $hostid ) {
+            push( @host_eps, $epsid );
+        }
+    }
+
+    return \@host_eps;
+}
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker

Database/remodel_db_series_eps

@@ -0,0 +1,110 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: remodel_db_series_eps
+#
+#        USAGE: ./remodel_db_series _eps
+#
+#  DESCRIPTION: Script to perform the steps necessary to remodel the series
+#  		information in the hpr_hpr database. We want to have
+#  		a many-to-many relationship between episodes and series.
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: This code is extremely trivial. It could be done just as well
+#               with plain SQL. However, having a script will potentially
+#               allow other things to be done during the table load, such as
+#               reading other series associations from a file.
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.1
+#      CREATED: 2015-06-26 12:30:27
+#     REVISION: 2015-06-26 15:28:12
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use YAML::Syck;
+use DBI;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.1';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.yml";
+
+my ( $dbh, $sth1, $sth2, $sth3, $sth4, $h1, $h2, $rv );
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#
+# Load configuration data
+#
+my %config = %{ LoadFile($configfile) };
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+$dbh
+    = DBI->connect( "dbi:mysql:dbname=$dbname", $dbuser, $dbpwd,
+    { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+#-------------------------------------------------------------------------------
+# Set up the SQL and query the 'eps' table since everything has a series, even
+# if it's 0
+#-------------------------------------------------------------------------------
+$sth1 = $dbh->prepare(q{SELECT * FROM eps ORDER BY id DESC});
+$sth2 = $dbh->prepare(q{INSERT INTO series_eps VALUES(?,?)});
+
+$sth1->execute;
+if ( $dbh->err ) {
+    die $dbh->errstr;
+}
+
+#-------------------------------------------------------------------------------
+# Walk the entire 'eps' table simply adding rows into the 'series_eps' table
+#-------------------------------------------------------------------------------
+while ( $h1 = $sth1->fetchrow_hashref ) {
+    $sth2->execute($h1->{series},$h1->{id});
+    if ( $dbh->err ) {
+        die $dbh->errstr;
+    }
+}
+
+exit;
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
+
+

Database/report_missing_tags

@@ -0,0 +1,750 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: report_missing_tags
+#
+#        USAGE: ./report_missing_tags [-help] [-out=FILE]
+#               [-sort=FIELD1[,FIELD2...]] [-action-csv=FILE] [-tags-csv=FILE]
+#               [-json=FILE] [-config=FILE]
+#
+#  DESCRIPTION: Generate a report of shows which are missing tags and
+#               summaries in the HPR database.
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: ---
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.1.4
+#      CREATED: 2015-08-03 21:20:53
+#     REVISION: 2022-08-03 23:00:42
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use Getopt::Long;
+use Pod::Usage;
+
+use Config::General;
+
+use Template;
+use Template::Filters;
+Template::Filters->use_html_entities;    # Use HTML::Entities in the template
+
+use Text::CSV_XS;
+
+use JSON;
+
+use DBI;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.1.4';
+
+#
+# Script and directory names
+#
+( my $PROG = $0 ) =~ s|.*/||mx;
+( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
+$DIR = '.' unless $DIR;
+
+#-------------------------------------------------------------------------------
+# Declarations
+#-------------------------------------------------------------------------------
+#
+# Constants and other declarations
+#
+my $basedir    = "$ENV{HOME}/HPR/Database";
+my $configfile = "$basedir/.hpr_db.cfg";
+my $template   = "$basedir/$PROG.tpl";
+
+my ( $dbh, $sth1, $h1 );
+my ( $s_count, $t_count, $st_count, $missing, $showsbyhosts );
+my @order_by;
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#-------------------------------------------------------------------------------
+# Options and arguments
+#-------------------------------------------------------------------------------
+my $DEF_DEBUG = 0;
+
+#
+# Process options
+#
+my %options;
+Options( \%options );
+
+#
+# Default help
+#
+pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 )
+    if ( $options{'help'} );
+
+#
+# Collect options
+#
+my $DEBUG = ( defined( $options{debug} ) ? $options{debug} : $DEF_DEBUG );
+my $cfgfile
+    = ( defined( $options{config} ) ? $options{config} : $configfile );
+
+my $outfile = $options{out};
+
+if ( exists( $options{sort} ) ) {
+    @order_by = getMultiOpts( $options{sort}, ',', 1,
+        [ 'id', 'date', 'title', 'hostid', 'host' ] );
+}
+else {
+    @order_by = qw{ id };
+}
+_debug( $DEBUG > 1, '@order_by: ' . join( "/", @order_by ) );
+
+#
+# Handle the optional Action CSV output file
+#
+my $acsvfile = $options{'action-csv'};
+my $acsvfh;
+if ($acsvfile) {
+    open( $acsvfh, ">:encoding(UTF-8)", $acsvfile )
+        or die "Unable to open $acsvfile for writing: $!";
+}
+
+#
+# Handle the optional Tags CSV output file
+#
+my $tcsvfile = $options{'tags-csv'};
+my $tcsvfh;
+if ($tcsvfile) {
+    open( $tcsvfh, ">:encoding(UTF-8)", $tcsvfile )
+        or die "Unable to open $tcsvfile for writing: $!";
+}
+
+#
+# Handle the optional JSON output file
+#
+my $jsonfile = $options{json};
+my $jsonfh;
+if ($jsonfile) {
+    open( $jsonfh, ">:encoding(UTF-8)", $jsonfile )
+        or die "Unable to open $jsonfile for writing: $!";
+}
+
+#-------------------------------------------------------------------------------
+# Open the output file (or STDOUT) - we may need the date to do it
+#-------------------------------------------------------------------------------
+my $outfh;
+if ($outfile) {
+    open( $outfh, ">:encoding(UTF-8)", $outfile )
+        or die "Unable to open $outfile for writing: $!";
+}
+else {
+    open( $outfh, ">&", \*STDOUT )
+        or die "Unable to initialise for writing: $!";
+}
+
+#
+# Sanity check
+#
+die "Unable to find $cfgfile\n" unless ( -e $cfgfile );
+
+#
+# Load configuration data
+#
+my $conf = new Config::General(
+    -ConfigFile      => $cfgfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+#-------------------------------------------------------------------------------
+# Get the counts of missing items
+#-------------------------------------------------------------------------------
+$sth1 = $dbh->prepare(
+    q{
+    SELECT
+        (SELECT count(*) FROM eps
+         WHERE length(summary) = 0 AND DATEDIFF(date,CURDATE()) <= 0) AS s_count,
+        (SELECT count(*) FROM eps
+         WHERE length(tags) = 0 AND DATEDIFF(date,CURDATE()) <= 0) AS t_count,
+        (SELECT count(*) FROM eps
+         WHERE length(summary) = 0 AND length(tags) = 0
+         AND DATEDIFF(date,CURDATE()) <= 0) AS st_count
+}
+) or die $DBI::errstr;
+
+$sth1->execute;
+if ( $dbh->err ) {
+    warn $dbh->errstr;
+}
+
+#
+# Fetch the data from the query and use hashref slicing to extract
+#
+$h1 = $sth1->fetchrow_hashref();
+( $s_count, $t_count, $st_count )
+    = @{$h1}{ 's_count', 't_count', 'st_count' };
+
+_debug( $DEBUG > 1, '$s_count, $t_count, $st_count: ' .
+    Dumper(\$s_count, \$t_count, \$st_count));
+
+#-------------------------------------------------------------------------------
+#  Create the main query with selected sort arguments
+#-------------------------------------------------------------------------------
+my $sql = q{
+    SELECT
+        e.id,
+        date_format(e.date,'00:00:00 %d/%m/%Y') AS date,
+        e.title,
+        h.host,
+        e.hostid AS hostid,
+        if(length(e.summary) = 0,0,1) AS summary,
+        if(length(e.tags) = 0,0,1) AS tags
+    FROM eps e JOIN hosts h ON e.hostid = h.hostid
+    WHERE (length(e.summary) = 0
+        OR length(e.tags) = 0)
+        AND DATEDIFF(e.date,CURDATE()) <= 0
+};
+
+$sql .= 'ORDER BY ' . join( ",", @order_by );
+
+#-------------------------------------------------------------------------------
+# Perform the main query and grab the results as an array of hashes
+#-------------------------------------------------------------------------------
+$sth1 = $dbh->prepare($sql) or die $DBI::errstr;
+if ( $dbh->err ) {
+    die $dbh->errstr;
+}
+
+$sth1->execute;
+if ( $dbh->err ) {
+    die $dbh->errstr;
+}
+
+#
+# Grab the data as an arrayref of hashrefs
+#
+$missing = $sth1->fetchall_arrayref( {} );
+
+#
+# If asked for an action CSV file deal with it here
+#
+if ($acsvfile) {
+    foreach my $row (@{$missing}) {
+        printf $acsvfh "%s,%s,%s\n", $row->{id},$row->{summary},$row->{tags};
+    }
+    close($acsvfh);
+}
+
+#-------------------------------------------------------------------------------
+# Perform a query relating hosts to shows. Each host who has shows in the
+# database without tags or a summary is returned with the list of shows
+# needing attention.
+#-------------------------------------------------------------------------------
+$sth1 = $dbh->prepare(
+    q{
+    SELECT
+        e.hostid,
+        h.host,
+        group_concat(e.id ORDER BY e.id) AS shows
+    FROM eps e
+    JOIN hosts h ON e.hostid = h.hostid
+    WHERE (length(e.summary) = 0
+        OR length(e.tags) = 0)
+        AND DATEDIFF(e.date,CURDATE()) <= 0
+    GROUP BY e.hostid
+    ORDER BY h.host
+    }
+) or die $DBI::errstr;
+
+$sth1->execute;
+if ( $dbh->err ) {
+    warn $dbh->errstr;
+}
+
+#
+# Grab the data as an arrayref of hashrefs
+#
+$showsbyhosts = $sth1->fetchall_arrayref( {} );
+
+#-------------------------------------------------------------------------------
+# Perform a scan of episodes for tags and accumulate them in a hash
+#-------------------------------------------------------------------------------
+$sth1 = $dbh->prepare(
+    q{SELECT id,title,tags FROM eps WHERE length(tags) > 0}
+) or die $DBI::errstr;
+
+$sth1->execute;
+if ( $dbh->err ) {
+    warn $dbh->errstr;
+}
+
+my ( $status, @fields, %tag_ids, $lastkey, @tagindex, %showtitles );
+
+my $csv = Text::CSV_XS->new(
+    { binary => 1, auto_diag => 1, allow_loose_quotes => 1 } );
+
+#
+# Loop through the episodes returned by the query
+#
+while ( $h1 = $sth1->fetchrow_hashref ) {
+    #
+    # Stash the show title with the show number
+    #
+    $showtitles{$h1->{id}} = $h1->{title};
+
+    #
+    # Parse the tag list for the current episode
+    #
+    $status = $csv->parse( $h1->{tags} );
+    unless ($status) {
+        #
+        # Report any errors
+        #
+        print "Parse error on episode ", $h1->{id}, "\n";
+        print $csv->error_input(), "\n";
+        next;
+    }
+    @fields = $csv->fields();
+
+    #
+    # Not sure why there are no tags but if not ignore this episode
+    #
+    next unless (@fields);
+
+    #
+    # Trim and lowercase all tags
+    #
+    @fields = map {
+        my $t = $_;
+        $t =~ s/(^\s+|\s+$)//g;
+        lc($t)
+    } @fields;
+
+    #
+    # Loop through the tags. For each tag add the associated episode id to the
+    # %tag_ids hash. The key to this hash is the lower case tag and the value
+    # is an array of episode numbers.
+    #
+    foreach my $tag (@fields) {
+        if ( defined( $tag_ids{$tag} ) ) {
+            #
+            # Add to the existing array
+            #
+            push( @{$tag_ids{$tag}}, $h1->{id} );
+        }
+        else {
+            #
+            # Create the episode array
+            #
+            $tag_ids{$tag} = [$h1->{id}];
+        }
+    }
+}
+
+#
+# Dumps the whole tags table. Warning!
+#
+_debug( $DEBUG > 2, '%tag_ids: ' . Dumper( \%tag_ids ) );
+
+#-------------------------------------------------------------------------------
+# Make an alphabetic index of the tags
+#-------------------------------------------------------------------------------
+$lastkey = '';
+foreach my $tag ( sort( keys(%tag_ids) ) ) {
+    if (substr($tag,0,1) ne $lastkey) {
+        $lastkey = substr($tag,0,1);
+        push(@tagindex,$tag);
+    }
+}
+
+_debug( $DEBUG > 1, '@tagindex: ' . Dumper( \@tagindex ) );
+
+#-------------------------------------------------------------------------------
+# Output tags and show numbers in CSV form if requested
+#-------------------------------------------------------------------------------
+if ($tcsvfile) {
+    my @line;
+    foreach my $tag ( sort( keys(%tag_ids) ) ) {
+        push(@line,$tag);
+
+        foreach my $show (@{$tag_ids{$tag}}) {
+            push(@line,$show);
+        }
+
+        print $tcsvfh join(",",@line), "\n";
+        @line = ();
+    }
+    close($tcsvfh);
+}
+
+
+#-------------------------------------------------------------------------------
+# Output a JSON report of the TSU (Tag and Summary Update) project if
+# requested. Now no longer needed since the TSU project is finished.
+#-------------------------------------------------------------------------------
+if ($jsonfile) {
+    my $jvars = {
+        without_summaries => $s_count,
+        without_tags      => $t_count,
+        without_either    => $st_count,
+        need_work         => $s_count + $t_count - $st_count,
+    };
+
+    my $json = JSON->new->utf8;
+    print $jsonfh $json->encode($jvars);
+    close($jsonfh);
+}
+
+#-------------------------------------------------------------------------------
+# Fill and print the template
+#-------------------------------------------------------------------------------
+my $tt = Template->new(
+    {   ABSOLUTE     => 1,
+        ENCODING     => 'utf8',
+        INCLUDE_PATH => $basedir,
+        OUTPUT_PATH  => '.',
+    }
+);
+my $vars = {
+    title    => 'Shows without a summary and/or tags',
+    order_by => \@order_by,
+    s_count  => $s_count,
+    t_count  => $t_count,
+    st_count => $st_count,
+    shows    => $missing,
+    byhost   => $showsbyhosts,
+    tag_ids  => \%tag_ids,
+    tagindex => \@tagindex,
+    titles   => \%showtitles,
+};
+my $document;
+$tt->process( $template, $vars, \$document, { binmode => ':utf8' } )
+    || die $tt->error(), "\n";
+
+print $outfh $document;
+close($outfh);
+
+$dbh->disconnect;
+
+exit;
+
+#===  FUNCTION  ================================================================
+#         NAME: _debug
+#      PURPOSE: Prints debug reports
+#   PARAMETERS: $active         Boolean: 1 for print, 0 for no print
+#               $message        Message to print
+#      RETURNS: Nothing
+#  DESCRIPTION: Outputs a message if $active is true. It removes any trailing
+#               newline and then adds one in the 'print' to the caller doesn't
+#               have to bother. Prepends the message with 'D> ' to show it's
+#               a debug message.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub _debug {
+    my ( $active, $message ) = @_;
+
+    chomp($message);
+    print "D> $message\n" if $active;
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: getMultiOpts
+#      PURPOSE: For use with a Getopt::Long option which is defined as "opt=s@"
+#   PARAMETERS: $rargs          reference to an array of arguments from
+#                               GetOpt::Long
+#               $delim          delimiter to be used to split arguments
+#               $lc             1 -> lowercase the arguments, 0 -> leave alone
+#               $rallowed       reference to an array of allowed values (use
+#                               undef if anything is allowed)
+#      RETURNS: A list containing all of the individual arguments
+#  DESCRIPTION: With "opt=s@" in the option definition the script will only
+#               accept the repetition of the option with different values. You
+#               can present "-opt=a,b,c" but no special parsing is done on
+#               this. This function extends option parsing to cater for such
+#               lists. The list is made unique and care is taken to keep the
+#               original order.
+#       THROWS: No exceptions
+#     COMMENTS: None
+#     SEE ALSO: N/A
+#===============================================================================
+sub getMultiOpts {
+    my ( $rargs, $delim, $lc, $rallowed ) = @_;
+
+    #
+    # Defaults
+    #
+    $delim = ',' unless $delim;
+    $lc    = 0   unless $lc;
+
+    #
+    # Walk through the array of arguments and check them, lower case them,
+    # save them or split them
+    #
+    my @args;
+    foreach my $arg (@$rargs) {
+        $arg = lc($arg) if $lc;
+        if ( $arg =~ /$delim/ ) {
+            push( @args, split( /$delim/, $arg ) );
+        }
+        else {
+            push( @args, $arg );
+        }
+    }
+
+    #
+    # Remove the elements that aren't allowed
+    #
+    if ($rallowed) {
+        my @new;
+        foreach my $elem (@args) {
+            push( @new, $elem ) if grep( /^$elem$/, @$rallowed );
+        }
+        @args = @new;
+    }
+
+    #
+    # De-duplicate the result (without losing the original order)
+    #
+    my @arr1;
+    foreach my $elem (@args) {
+        push( @arr1, $elem ) if !grep( /^$elem$/, @arr1 );
+    }
+    @args = @arr1;
+
+    #
+    # Return the array as a list
+    #
+    return @args;
+}
+
+#===  FUNCTION  ================================================================
+#         NAME: Options
+#      PURPOSE: Processes command-line options
+#   PARAMETERS: $optref     Hash reference to hold the options
+#      RETURNS: Undef
+#  DESCRIPTION:
+#       THROWS: no exceptions
+#     COMMENTS: none
+#     SEE ALSO: n/a
+#===============================================================================
+sub Options {
+    my ($optref) = @_;
+
+    my @options = (
+        "help",         "debug=i",    "out=s",  "sort=s@",
+        "action-csv=s", "tags-csv=s", "json=s", "config=s",
+    );
+
+    if ( !GetOptions( $optref, @options ) ) {
+        pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 );
+    }
+
+    return;
+}
+
+__END__
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#  Application Documentation
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#{{{
+
+=head1 NAME
+
+report_missing_tags - Report missing HPR summaries and/or tags
+
+=head1 VERSION
+
+This documentation refers to B<report_missing_tags> version 0.1.4
+
+=head1 USAGE
+
+    ./report_missing_tags [-help] [-debug=N] [-out=FILE]
+        [-sort=FIELD1[,FIELD2...]] [-action-csv=FILE] [-tags-csv=FILE]
+        [-json=FILE] [-config=FILE]
+
+    Examples:
+
+    ./report_missing_tags
+    ./report_missing_tags -help
+    ./report_missing_tags -out=missing_tags.html
+    ./report_missing_tags -out=missing_tags.html -action-csv=tag_summary_actions.csv
+    ./report_missing_tags -out=missing_tags.html -tags-csv=tag_summary_actions.csv
+    ./report_missing_tags -out=missing_tags.html -json=tag_data.json
+    ./report_missing_tags -out=missing_tags.html -config=$HOME/HPR/.hpr_livedb.cfg
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<-help>
+
+Prints a brief help message describing the usage of the program, and then exits.
+
+=item B<-debug=N>
+
+Causes certain debugging information to be displayed.
+
+    0   (the default) no debug output
+    1   N/A
+    2   reports the chosen sort order and the counts of work yet to be done
+        (now obsolete). Also dumps:
+            - @tagindex an array containing tags for the index
+    3   dumps data structures:
+            - %tag_ids: the data used to build the entire tag list (warning!)
+
+=item B<-out=FILE>
+
+This option defines an output file to receive the report. If the option is
+omitted the report is written to STDOUT, allowing it to be redirected if
+required.
+
+=item B<-sort=FIELD1[,FIELD2...]>
+
+Changes the sort order of the report. The default is to sort by the I<id>
+column, but other columns may be used, one or more.
+
+=item B<-action-csv=FILE>
+
+This optionally defines a file into which simple CSV data is written showing
+the actions needed for shows missing tags or summarise. The CSV rows consist
+of: the show number, a 0/1 value for the summary, and a 0/1 value for the
+tags. This is for the use of other tools that need to know if it's OK to
+present a show in a list for editing in order to add new summary and/or tags.
+See the way B<make_tsu_blank> and B<edit_tsu_blank> work.
+
+=item B<-tags-csv=FILE>
+
+This optionally defines a file to contain CSV for tags and shows which iuse
+them.
+
+=item B<-json=FILE>
+
+This optionally defines file into which some of the tag counts are written in
+JSON format. The items written are:
+
+    {
+    "without_tags": 341,
+    "without_summaries": 363,
+    "need_work": 398,
+    "without_either": 306
+    }
+
+=item B<-config=FILE>
+
+This option allows an alternative configuration file to be used. This file
+defines the location of the database, its port, its name and the username and
+password to be used to access it. This feature was added to allow the script
+to access alternative databases or the live database over an SSH tunnel.
+
+See the CONFIGURATION AND ENVIRONMENT section below for the file format.
+
+If the option is omitted the default file is used: B<.hpr_db.cfg>
+
+=back
+
+=head1 DESCRIPTION
+
+A full description of the application and its features.
+May include numerous subsections (i.e. =head2, =head3, etc.)
+
+
+=head1 DIAGNOSTICS
+
+A list of every error and warning message that the application can generate
+(even the ones that will "never happen"), with a full explanation of each
+problem, one or more likely causes, and any suggested remedies. If the
+application generates exit status codes (e.g. under Unix) then list the exit
+status associated with each error.
+
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+A full explanation of any configuration system(s) used by the application,
+including the names and locations of any configuration files, and the
+meaning of any environment variables or properties that can be set. These
+descriptions must also include details of any configuration language used
+
+
+=head1 DEPENDENCIES
+
+A list of all the other modules that this module relies upon, including any
+restrictions on versions, and an indication whether these required modules are
+part of the standard Perl distribution, part of the module's distribution,
+or must be installed separately.
+
+
+=head1 INCOMPATIBILITIES
+
+A list of any modules that this module cannot be used in conjunction with.
+This may be due to name conflicts in the interface, or competition for
+system or program resources, or due to internal limitations of Perl
+(for example, many modules that use source code filters are mutually
+incompatible).
+
+
+=head1 BUGS AND LIMITATIONS
+
+A list of known problems with the module, together with some indication
+whether they are likely to be fixed in an upcoming release.
+
+Also a list of restrictions on the features the module does provide:
+data types that cannot be handled, performance issues and the circumstances
+in which they may arise, practical limitations on the size of data sets,
+special cases that are not (yet) handled, etc.
+
+The initial template usually just has:
+
+There are no known bugs in this module.
+Please report problems to <Maintainer name(s)>  (<contact address>)
+Patches are welcome.
+
+=head1 AUTHOR
+
+Dave Morriss (Dave.Morriss@gmail.com)
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright (c) 2015 Dave Morriss (Dave.Morriss@gmail.com). All rights reserved.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See perldoc perlartistic.
+
+=cut
+
+#}}}
+
+# [zo to open fold, zc to close]
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker

Database/report_missing_tags.tpl

@@ -0,0 +1 @@
+report_missing_tags_0.1.1.tpl

Database/report_missing_tags_0.1.1.tpl

@@ -0,0 +1,254 @@
+[%# report_missing_tags.tpl 2022-08-03 -%]
+[%# version: 0.1.1 -%]
+[%# Page summarising data from the database, generates PHP -%]
+[%# USE dumper -%]
+[%- USE date -%]
+[%- DEFAULT title = 'Test' -%]
+[%- DEFAULT htmltags = 'tags.html' -%]
+[%- table_size = 37 count = 0 anchors = [] -%]
+<?php
+# released under a Creative Commons Attribution-ShareAlike 3.0 Unported license. http://creativecommons.org/licenses/by-sa/3.0/
+$body="help_out";
+require "/home/hpr/php/hpr.php";
+include '/home/hpr/www/header.php';
+?>
+
+<main id="maincontent">
+<style>
+    .columns3 { columns: 3 auto; list-style-type: none }
+    hr.thin {
+        border: 0;
+        height: 0;
+        border-top: 1px solid rgba(0, 0, 0, 0.1);
+        border-bottom: 1px solid rgba(255, 255, 255, 0.3);
+    }
+    p.ralign { text-align: right }
+</style>
+<article>
+<a id="TOP"><h1 class="title">[% title %]</h1></a>
+<h3 class="date">Page generated on [% date.format(date.now,'%Y-%m-%d at %H:%M:%S UTC','en_GB',1) %]</h3>
+<h4>Sort order: [%- order_by.join(', ') %]</h4>
+<h4>Current counts</h4>
+<ul>
+<li><b>[% s_count %]</b> shows without summaries</li>
+<li><b>[% t_count %]</b> shows without tags</li>
+<li><b>[% st_count %]</b> shows with neither summaries nor tags</li>
+<li><b>[% needwork = s_count+t_count-st_count; needwork %]</b> shows which need work</li>
+</ul>
+<h4>Instructions</h4>
+<ol>
+<li>Find a show in the list below</li>
+<li>Check in the list which attributes are missing: summary and/or tags</li>
+<li>Click the show number or title to visit the show page</li>
+<li>Read the show notes and listen to the show to determine the missing information</li>
+<li>Submit your updates by email to <em>tags at hackerpublicradio.org</em></li>
+</ol>
+<p>Please send simple ASCII email. No HTML please, and no multipart, encrypted
+or signed messages; the script can't handle them at the moment! (We are
+working on a solution to some of this though). Remember, the internals of an
+email are <em>complex</em> and the script isn't clever enough to deal with all
+the many possible formats. <strong>Please be gentle with it!</strong></p>
+<p>Format the message as follows:</p>
+<pre>
+show:12345
+summary:Using Linux at Christmas to make tomato soup in a sporran
+tags:linux,christmas,sporran,tomato soup
+
+show: 12346
+tags: sausage,clothing,hairpiece
+</pre>
+<ul>
+<li>Start with the <code>show:XXXX</code> line (just the show number, no
+<code>'hpr'</code>)</li>
+<li>If either the summary or the tags are already present on the show you can omit them from the group</li>
+<li>It's not possible to change existing summaries or tags by this route, only to add missing ones</li>
+<li>Ensure the summary text isn't longer than 100 characters</li>
+<li>The tags need to be separated by commas</li>
+<li>If you need to add a tag with a comma in it enclose the tag in double quotes</li>
+<li>The length of the tag list can't exceed 200 characters</li>
+<li>You can update more than one show per email if you want</li>
+<li>Blank lines between the groups of <em>show</em>/<em>summary</em>/<em>tags</em> lines are fine (as shown), as are comment lines beginning with '#'</li>
+</ul>
+<p>Updates will be processed with a script, which is run manually, and this page
+will be refreshed once the changes have been made. The timestamp above shows
+when it was last refreshed.</p>
+<hr/>
+</article>
+
+[% IF needwork > 0 -%]
+
+[%- BLOCK table_head -%]
+<p>
+<a href="#END">Go to END of section</a>
+</p>
+<table id="t01" style="width:100%">
+    <tr>
+    <th style="width:5%">Id</th>
+    <th style="width:12%">Date</th>
+    <th style="width:50%">Title</th>
+    <th style="width:17%">Host</th>
+    <th style="width:8%">Summary</th>
+    <th style="width:8%">Tags</th>
+    </tr>
+[%- END -%]
+
+[%- BLOCK table_foot -%]
+</table>
+<p>
+<a href="#TOP">Go to TOP of page</a>
+</p>
+[%- END -%]
+
+<article>
+<h3>Section Index</h3>
+<ul>
+<li><a href="#Shows_by_host">Shows by host</a></li>
+<li><a href="#Tag_summary">Tag summary</a></li>
+</ul>
+<hr/>
+</article>
+
+[%# Make the index. Point to the first show and every $table_size shows -%]
+[%# thereafter. Keep the id numbers in a list for use later.            -%]
+<article>
+<h3>Tables of shows requiring attention</h3>
+<p>The following index is to help you find shows in need of attention.</p>
+
+<h4>Index of tables</h4>
+<ul>
+[%- count = 0 %]
+[%- FOREACH row IN shows %]
+    [%- IF count % table_size == 0 && count < shows.size %]
+    <li><a href="#show[% row.id %]">Go to show number [% row.id %]</a></li>
+    [%- anchors.push(row.id) %]
+    [%- END %]
+    [%- count = count + 1 %]
+[%- END %]
+</ul>
+<hr/>
+</article>
+
+<article>
+[% count = 0 -%]
+<small>
+<a id="show[% anchors.shift %]"></a>
+[%- PROCESS table_head %]
+    [%- FOREACH row IN shows %]
+    <tr valign="top">
+    <td align="left"><strong><a href="http://hackerpublicradio.org/eps.php?id=[% row.id FILTER format("%04i") %]" target="_blank">[% row.id %]</a></strong></td>
+    <td align="left">[% date.format(row.date,'%Y-%m-%d') %]</td>
+    <td align="left"><a href="http://hackerpublicradio.org/eps.php?id=[% row.id FILTER format("%04i") %]" target="_blank">[% row.title %]</a></td>
+    <td align="left">[% row.host FILTER html_entity %]</a></td>
+    <td align="left">[% row.summary == 0 ? 'No' : 'Yes' %]</a></td>
+    <td align="left">[% row.tags == 0 ? 'No' : 'Yes' %]</a></td>
+    </tr>
+    [%- count = count + 1 -%]
+    [%- IF count % table_size == 0 && count < shows.size -%]
+    [%- PROCESS table_foot %]
+    <a id="show[% anchors.shift %]"></a>
+    [%- PROCESS table_head %]
+    [%- END -%]
+    [%- END %]
+[%- PROCESS table_foot %]
+</small>
+<a id="END"></a>
+<p>Total shows = [% count %]</p>
+<hr/>
+</article>
+
+<article>
+<a id="Shows_by_host"><h3>Shows by host</h3></a>
+<p>This section lists all HPR hosts who have shows without summaries and/or tags. The show numbers in question are listed against each host and can be clicked to open the show. </p>
+<p> If you are one of the hosts below it would be very much appreciated if you could help out by adding the summary and or tags to all of your shows that do not have them. You are the person who is best able to add these missing items to your shows!</p>
+<ul>
+[%- FOREACH row IN byhost %]
+<li><strong><a href="http://hackerpublicradio.org/correspondents.php?hostid=[% row.hostid %]" target="_blank">[% row.host %]</a></strong>:
+    [%- showlist = row.shows.split(',') %]
+    [%- count = 0 %]
+    [%- FOREACH show IN showlist %]
+        [%- count = count + 1 %]
+        <a href="http://hackerpublicradio.org/eps.php?id=[% show FILTER format("%04i") %]" target="_blank">[% show %]</a>
+        [%- count < showlist.size ? ', ' : '' %]
+    [%- END %]
+</li>
+[%- END %]
+</ul>
+<p>
+<a href="#TOP">Go to TOP of page</a>
+</p>
+<hr/>
+</article>
+
+[% ELSE -%]
+<article>
+<h3>The project is finished!</h3>
+<p>All shows have been processed! Thanks to everyone who has helped!</p>
+<hr/>
+</article>
+[% END -%]
+
+<article>
+[% BLOCK tags -%]
+<a id="Tag_summary"><h3>Tag summary</h3></a>
+<h4 class="date">Page generated on [% date.format(date.now,'%Y-%m-%d at %H:%M:%S UTC','en_GB',1) %]</h4>
+<p>This section summarises all of the tags currently used throughout the
+database. The tags are in alphabetical order and each is followed by links to
+the show numbers where it is used so you can see the context the author used
+it in. There are currently [% tag_ids.size %] unique tags in the system.</p>
+<h4>Alphabetical index</h4>
+<p>This is an index to the initial letters of the tags below.</p>
+<ul class="columns3">
+[%# tagindex contains the first tag in an alphabetic list that has a different
+first letter from the previous one. We use it to build an alphabetic table of
+anchors linking to the blocks of tags starting with that character. -%]
+[%- FOREACH index IN tagindex %]
+<li><a href="#[% index.replace('\s','_') %]"><strong>[% index.substr(0,1) %]</strong></a></li>
+[%- END %]
+</ul>
+<hr/>
+[%# BLOCK tags -%]
+<ul>
+[%# tag_ids is a hash keyed by tags, each containing an array of episode
+numbers. If a tag matches the one in 'index' place an anchor to it for the
+alphabetic index above. %]
+[%- index = tagindex.shift %]
+[%- FOREACH pair IN tag_ids.pairs %]
+[%- IF pair.key == index %]
+</ul>
+<p class="ralign"><a href="#Tag_summary">&#129137; Go to index</a></p>
+<h3>Tags beginning with '[% index.substr(0,1) %]'</h3>
+<ul>
+<li>
+[%- index = tagindex.shift %]
+[%- ELSE %]
+<li>
+[%- END %]
+<a id="[% pair.key.replace('\s','_') %]"><strong>[% pair.key FILTER html_entity %]</strong></a>: 
+    [%- count = 0 %]
+    [%- FOREACH id IN pair.value.nsort %]
+        [%- count = count + 1 %]
+        <a href="http://hackerpublicradio.org/eps.php?id=[% id FILTER format("%04i") %]"
+            target="_blank" aria-label="Tag [% pair.key FILTER html_entity %]: show [% id %]">[% id %]</a>
+        [%- count < pair.value.size ? ', ' : '' %]
+    [%- END %]
+</li>
+[%- END %]
+</ul>
+[% END -%]
+[% INCLUDE tags FILTER redirect("$htmltags") -%]
+[% INSERT $htmltags -%]
+<p>
+<a href="#TOP">Go to TOP of page</a>
+</p>
+</article>
+
+</main>
+
+
+<?php
+include 'footer.html';
+?>
+
+[%#
+  vim: syntax=tt2:ts=8:sw=4:ai:et:tw=78:fo=tcrqn21
+-%]

Database/reservations.sql

@@ -0,0 +1,47 @@
+-- MySQL dump 10.13  Distrib 5.6.30, for debian-linux-gnu (x86_64)
+--
+-- Host: localhost    Database: hpr_hpr
+-- ------------------------------------------------------
+-- Server version	5.6.30-1
+
+/*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */;
+/*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */;
+/*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */;
+/*!40101 SET NAMES utf8 */;
+/*!40103 SET @OLD_TIME_ZONE=@@TIME_ZONE */;
+/*!40103 SET TIME_ZONE='+00:00' */;
+/*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */;
+/*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */;
+/*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */;
+/*!40111 SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0 */;
+
+--
+-- Table structure for table `reservations`
+--
+
+DROP TABLE IF EXISTS `reservations`;
+/*!40101 SET @saved_cs_client     = @@character_set_client */;
+/*!40101 SET character_set_client = utf8 */;
+CREATE TABLE `reservations` (
+  `ip` varchar(45) COLLATE utf8_unicode_ci NOT NULL,
+  `timestamp` datetime NOT NULL,
+  `key` varchar(46) COLLATE utf8_unicode_ci NOT NULL,
+  `ep_num` int(5) NOT NULL,
+  `ep_date` date NOT NULL,
+  `email` text COLLATE utf8_unicode_ci NOT NULL,
+  `verified` tinyint(1) NOT NULL DEFAULT '0',
+  PRIMARY KEY (`key`),
+  UNIQUE KEY `key` (`key`)
+) ENGINE=MyISAM DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci COMMENT='To keep track of reservations';
+/*!40101 SET character_set_client = @saved_cs_client */;
+/*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
+
+/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
+/*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;
+/*!40014 SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS */;
+/*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */;
+/*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */;
+/*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */;
+/*!40111 SET SQL_NOTES=@OLD_SQL_NOTES */;
+
+-- Dump completed on 2016-08-07 22:06:16

Database/series_eps.sql

@@ -0,0 +1,56 @@
+--
+-- Set up a many-to-many relationship between tables (mini)series and eps
+-- -----------------------------------------------------------------------------
+--
+
+--
+-- Table structure for the mapping table 'series_eps'
+--
+DROP TABLE IF EXISTS series_eps;
+CREATE TABLE IF NOT EXISTS series_eps (
+    series_id int(5) NOT NULL
+	REFERENCES miniseries(id),
+    eps_id int(5) NOT NULL
+	REFERENCES eps(id),
+    PRIMARY KEY series_eps_pk (series_id,eps_id)
+) ENGINE=InnoDB;
+
+SHOW warnings;
+
+--
+-- Make a view to simplify access to eps and (mini)series. This simply
+-- joins the two tables through the 'series_eps' table. Some fields need
+-- renaming to avoid clashes.
+--
+DROP VIEW IF EXISTS eps_with_series;
+CREATE VIEW eps_with_series AS
+    SELECT
+	e.id AS eps_id,
+	e.date,
+	e.title,
+	e.duration,
+	e.summary,
+	e.notes,
+	e.hostid,
+	e.explicit,
+	e.license,
+	e.tags,
+	e.version,
+	e.downloads,
+	e.valid AS eps_valid,
+	ms.id AS series_id,
+	ms.name,
+	ms.description,
+	ms.private,
+	ms.image,
+	ms.valid AS series_valid
+    FROM eps e
+    JOIN series_eps se ON (e.id = se.eps_id)
+    JOIN miniseries ms ON (ms.id = se.series_id)
+    ORDER BY e.id, ms.id;
+
+SHOW warnings;
+
+/*
+vim: syntax=sql ai tw=75:
+*/

Database/shows_per_host_in_last_year.sql

@@ -0,0 +1,212 @@
+--
+-- What's the latest show today?
+--
+
+SELECT concat('Latest show number on this date: ',curdate()) AS '';
+
+SELECT max(id) AS latest_show
+FROM eps
+WHERE date <= curdate();
+
+-- -----------------------------------------------------------------------------
+-- How many hosts are there up to and including today? Note there are 49 hosts
+-- with no shows at all, imported from the TWAT data, so a simple count of
+-- rows is not going to be correct.
+--
+
+SELECT count(*) AS total_users_to_today
+FROM
+  ( SELECT e.id
+   FROM hosts h,
+        eps e
+   WHERE e.hostid = h.hostid
+     AND e.date <= curdate()
+   GROUP BY h.host) AS ttab;
+
+--
+-- How many new hosts are there in the (future) queue?
+--
+
+SELECT h.host AS upcoming_new_host,
+       min(e.date) AS joindate
+FROM hosts h,
+     eps e
+WHERE e.hostid = h.hostid
+GROUP BY h.host
+HAVING min(e.date) > curdate();
+
+-- -----------------------------------------------------------------------------
+-- Find all new hosts who joined in the last year (ignoring those with queued
+-- shows in the future)
+--
+
+SELECT 'Hosts joining in the last year with number of shows done' AS '';
+
+SELECT h.hostid,
+       h.host,
+       min(e.date) AS joindate,
+       count(e.id) AS COUNT
+FROM eps e
+JOIN hosts h ON e.hostid = h.hostid
+GROUP BY h.hostid
+HAVING min(e.date) >= (curdate() - INTERVAL 364 DAY)
+AND min(e.date) <= curdate()
+ORDER BY min(e.date);
+
+SELECT COUNT(*) AS new_host_count,
+            sum(COUNT) AS total_shows
+FROM
+  ( SELECT h.hostid,
+           h.host,
+           min(e.date) AS joindate,
+                          count(e.id) AS COUNT
+   FROM eps e
+   JOIN hosts h ON e.hostid = h.hostid
+   GROUP BY h.hostid
+   HAVING min(e.date) >= (curdate() - INTERVAL 364 DAY)
+   AND min(e.date) <= curdate()
+   ORDER BY min(e.date)) src;
+
+-- -----------------------------------------------------------------------------
+-- Display all hosts contributing > 10 shows in the last year then count the
+-- number of shows
+--
+
+SELECT 'Hosts contributing > 10 shows in the last year' AS '';
+
+SELECT e.hostid,
+       h.host,
+       COUNT(e.hostid) AS shows
+FROM eps e
+JOIN hosts h ON e.hostid = h.hostid
+WHERE e.date <= curdate()
+  AND e.date >= (curdate() - interval 364 DAY)
+GROUP BY e.hostid
+HAVING COUNT(e.hostid) > 10
+ORDER BY COUNT(e.hostid) DESC;
+
+
+SELECT COUNT(*) AS no_of_hosts,
+            sum(shows) AS sum_of_shows_by_group
+FROM
+  ( SELECT e.hostid,
+           h.host,
+           COUNT(e.hostid) AS shows
+   FROM eps e
+   JOIN hosts h ON e.hostid = h.hostid
+   WHERE e.date <= curdate()
+     AND e.date >= (curdate() - interval 364 DAY)
+   GROUP BY e.hostid
+   HAVING COUNT(e.hostid) > 10
+   ORDER BY COUNT(e.hostid) DESC) AS ttab;
+
+--
+-- Display all hosts contributing > 5 shows in the last year then count the
+-- number of shows. Remember this includes the > 10 group too!
+--
+
+SELECT 'Hosts contributing > 5 shows in the last year' AS '';
+
+SELECT e.hostid,
+       h.host,
+       COUNT(e.hostid) AS shows
+FROM eps e
+JOIN hosts h ON e.hostid = h.hostid
+WHERE e.date <= curdate()
+  AND e.date >= (curdate() - interval 364 DAY)
+GROUP BY e.hostid
+HAVING COUNT(e.hostid) > 5
+ORDER BY COUNT(e.hostid) DESC;
+
+
+SELECT COUNT(*) AS no_of_hosts,
+            sum(shows) AS sum_of_shows_by_group
+FROM
+  ( SELECT e.hostid,
+           h.host,
+           COUNT(e.hostid) AS shows
+   FROM eps e
+   JOIN hosts h ON e.hostid = h.hostid
+   WHERE e.date <= curdate()
+     AND e.date >= (curdate() - interval 364 DAY)
+   GROUP BY e.hostid
+   HAVING COUNT(e.hostid) > 5
+   ORDER BY COUNT(e.hostid) DESC) AS ttab;
+
+--
+-- How many hosts contributed shows in the last year
+--
+
+SELECT 'Number of hosts contributing shows in the last year' AS '';
+
+
+SELECT COUNT(*) AS hosts_contributing_last_year,
+            sum(shows) AS sum_of_shows_by_group
+FROM
+  ( SELECT e.hostid,
+           h.host,
+           COUNT(e.hostid) AS shows
+   FROM eps e
+   JOIN hosts h ON e.hostid = h.hostid
+   WHERE e.date <= curdate()
+     AND e.date >= (curdate() - interval 364 DAY)
+   GROUP BY e.hostid
+   ORDER BY COUNT(e.hostid) DESC ) AS hly;
+
+-- -----------------------------------------------------------------------------
+-- How many new hosts were there per year and how many shows have they
+-- contributed overall?
+--
+
+SELECT 'Hosts per year and their contributions' AS '';
+
+SELECT joinyear,
+       COUNT(*) AS new_hosts,
+            sum(shows) AS shows
+FROM
+  ( SELECT extract(YEAR
+                   FROM min(e.date)) AS joinyear,
+           count(e.id) AS shows
+   FROM eps e
+   JOIN hosts h ON e.hostid = h.hostid
+   WHERE e.date <= curdate()
+   GROUP BY h.hostid
+   ORDER BY min(e.date)) AS ttab
+GROUP BY joinyear;
+
+-- -----------------------------------------------------------------------------
+-- Hosts who joined, did a show but haven't been seen since January of the
+-- year 3 years ago.
+--
+
+SELECT 'Hosts not seen for the past three years' AS '';
+
+SELECT COUNT(*) AS departed_hosts
+FROM
+  ( SELECT h.hostid,
+           h.host,
+           min(e.date) AS joindate,
+                          max(e.date) AS lastshow,
+                                         count(e.id) AS shows
+   FROM eps e
+   JOIN hosts h ON e.hostid = h.hostid
+   WHERE e.date <= curdate()
+   GROUP BY h.hostid
+   HAVING lastshow < date_format(date_sub(curdate(),INTERVAL 3 YEAR),'%Y-01-01')
+   ORDER BY shows,
+            min(e.date)) ttab;
+
+-- -----------------------------------------------------------------------------
+-- Show hosts and shows per month throughout the HPR history
+--
+
+SELECT 'Hosts and shows per month throughout the HPR history' AS '';
+
+SELECT extract(year_month
+               FROM e.date) AS MONTH,
+       COUNT(e.id) AS shows,
+            COUNT(DISTINCT e.hostid) AS hosts
+FROM eps e
+WHERE e.date < date_format(curdate(),"%Y-%c-01")
+GROUP BY MONTH;
+

Database/triggers.sql

@@ -0,0 +1,38 @@
+/*
+ * Trigger declarations for hpr_hpr
+ *
+ */
+
+--
+-- Table 'log' to hold details of certain background activities invoked by
+-- stored procedures and triggers
+--
+DROP TABLE IF EXISTS log;
+CREATE TABLE log (
+    id int(5) NOT NULL AUTO_INCREMENT,
+    stamp timestamp DEFAULT now(),
+    message text NOT NULL,
+    PRIMARY KEY (id)
+);
+
+--
+-- When an episode is added to the eps table check whether there is an
+-- entry in the reservations table with the same id. If there is, delete
+-- it. Log the deletion in the log table.
+--
+DROP TRIGGER IF EXISTS check_reservations;
+DELIMITER $$
+CREATE TRIGGER check_reservations BEFORE INSERT ON eps
+FOR EACH ROW
+BEGIN
+    IF EXISTS(SELECT id FROM reservations WHERE id = NEW.id) THEN
+	DELETE FROM reservations WHERE id = NEW.id;
+	INSERT INTO log (message) VALUES(concat('DELETE FROM reservations WHERE id = ',NEW.id));
+    END IF;
+END;
+$$
+DELIMITER ;
+
+/*
+vim: syntax=sql ai tw=75:
+*/

Database/tsu/X_tag_summary_updates_1060-1079.txt

@@ -0,0 +1,56 @@
+show: 1063
+summary: Following an interview with Richard Stallman on the Linux Action Show
+tags: software freedom,GPL,BSD licence
+
+show: 1064
+summary:
+tags:
+
+show: 1065
+summary:
+tags:
+
+show: 1067
+summary:
+tags:
+
+show: 1068
+summary:
+tags:
+
+show: 1069
+summary:
+tags:
+
+show: 1071
+summary:
+tags:
+
+show: 1073
+summary: An introduction to the concept of presentation versus content
+tags: presentation,content,css
+
+show: 1074
+summary: Interview with Alan Pope
+tags: interview,oggcamp,oggcamp11
+
+show: 1075
+summary: A newscast from Talk Geek to Me
+tags: newscast,TGTM
+
+show: 1076
+summary: Describing the upcoming Ohio LinuxFest conference and expo
+tags: interview,OLF 2012,Ohio LinuxFest
+
+show: 1077
+summary: Interview with Christina Haralanova from Canada
+tags: interview,FSCONS 2011,freedom,hacking
+
+show: 1078
+summary: The European Parliament and the issue of software patentability
+tags: patent,software patent,unitary patent,Free Software
+
+show: 1079
+summary: Episode 12: LMAX
+tags: Distributed Systems Podcast,LMAX Disruptor,Java,C,C++,Fedora,Red Hat
+

Database/tsu/X_tag_summary_updates_1080-1099.txt

@@ -0,0 +1,56 @@
+show: 1081
+summary: Preparing photographs for posting on a website
+tags: GIMP,photography
+
+show: 1083
+summary: The concept of a compiler
+tags: compiler,neocortex,lexical analysis,preprocessing,parsing,semantic analysis,code generation,assembling,linking
+
+show: 1084
+summary: A Full Circle Podcast interview with Paul Levy
+tags: Interview,Full Circle Podcast
+
+show: 1085
+summary:
+tags:
+
+show: 1087
+summary:
+tags: FSCONS
+
+show: 1088
+summary:
+tags:
+
+show: 1089
+summary:
+tags:
+
+show: 1092
+summary:
+tags:
+
+show: 1093
+summary:
+tags:
+
+show: 1094
+summary:
+tags:
+
+show: 1096
+summary:
+tags:
+
+show: 1097
+summary:
+tags:
+
+show: 1098
+summary:
+tags:
+
+show: 1099
+summary:
+tags:
+

Database/tsu/shows_from_host30_part_1.txt

@@ -0,0 +1,43 @@
+show: 0036
+tags: LPI, bus, System Bus, PCI Bus
+summary: Ken covers computer buses and system resources
+
+show: 0056
+tags: Open Street Map, GPS, POI
+summary: Ken encourages people to add to Open Street Map
+
+show: 0057
+tags: LPI, hard disks
+summary: Ken covers how disks are dealt with in Linux
+
+show: 0102
+tags: LPI, SCSI
+summary: Ken covers SCSI skipping over modem and sound
+
+show: 0115
+tags: Linux Promotion
+summary: Ken Fallon discusses ways to promote linux
+
+show: 0135
+tags: LPI, lspci
+summary: Setup different PC expansion cards
+
+show: 0140
+tags: LPI, modems, ISDN, DSL
+summary: LPIC topic 1.101.6 — Configure Communication Devices
+
+show: 0160
+tags: dvgrab, archiving
+summary: Ken walks us through moving off DV tapes to disk
+
+show: 0185
+tags: sox, sleep, tar
+summary: Ken gives us quick bash tips
+
+show: 0206
+tags: promotion
+summary: Ken's failed attempt to set up a site that promotes devices that run linux
+
+show: 0227
+tags: Squid, proxy server
+summary: Ken explains how to install and run a local squid proxy

Database/tsu/tag_summary_updates_0530-0539.txt

@@ -0,0 +1,28 @@
+#show: 533
+#summary: 
+#tags: 
+#
+show: 534
+summary: 
+tags: 
+
+show: 535
+summary: 
+tags: 
+
+show: 536
+summary: 
+tags: 
+
+#show: 537
+#summary: 
+#tags: 
+#
+#show: 538
+#summary: 
+#tags: 
+#
+#show: 539
+#summary: 
+#tags: 
+#

Database/tsu/tag_summary_updates_0540-0544.txt

@@ -0,0 +1,16 @@
+#show: 540
+##summary: Uber Leet Hacker Force Radio issue 4
+#tags: 
+#
+#show: 541
+##summary: Moxie Marlinspike interview
+#tags: 
+#
+#show: 542
+#summary: 
+#tags: 
+#
+#show: 544
+#summary: 
+#tags: 
+#

Database/tsu/tag_summary_updates_0545-0549.txt

@@ -0,0 +1,20 @@
+#show: 545
+#summary: 
+#tags: 
+#
+#show: 546
+#summary: 
+#tags: 
+#
+#show: 547
+#summary: 
+#tags: 
+#
+#show: 548
+#summary: 
+##tags: Spam
+#
+#show: 549
+#summary: 
+#tags: 
+#

Database/tsu/tag_summary_updates_0550-0559.txt

@@ -0,0 +1,40 @@
+#show: 550
+#summary: 
+#tags: 
+#
+#show: 551
+#summary: 
+#tags: 
+#
+#show: 552
+##summary: Uber Leet Hacker Force Radio issue 5
+#tags: 
+#
+#show: 553
+#summary: 
+#tags: 
+#
+#show: 554
+#summary: 
+##tags: Wifi,Wireless,WAP
+#
+#show: 555
+#summary: 
+#tags: 
+#
+#show: 556
+#summary: 
+#tags: 
+#
+#show: 557
+#summary: 
+#tags: 
+#
+#show: 558
+#summary: 
+#tags: 
+#
+#show: 559
+#summary: 
+#tags: 
+#

Database/tsu/tag_summary_updates_0560-0569.txt

@@ -0,0 +1,32 @@
+show: 560
+summary: A discussion of "podfading" - the fading away of once-active podcasts
+tags: Podcasting,Podfading
+
+show: 561
+#summary: Hacker Radio Live discusses vulnerabilities in WEP (Wired equivalent privacy) encryption
+tags: encryption,WEP,Wired equivalent privacy,stream cipher
+
+show: 564
+summary: An innovative mobile computing platform, the "Robocop mobile computing fortissimo", aka robomofo
+tags: mobile computing,tablet,video glasses,Vuzix,Pandora,mini-ITX
+
+show: 565
+summary: Hacker Radio Live discusses and demonstrates radio scanners
+tags: scanner,radio
+
+show: 566
+summary: An experimental scheme to micro-manage personal free time
+tags: time management,productivity,gopher,phlog
+
+show: 567
+summary: Visiting the University of Minnesota Supercomputing Institute
+tags: Minnesota,supercomputer,HPC,Cray,Beowulf Cluster,PVM
+
+show: 568
+#summary: Hacker Radio Live discusses MythTV and how Mr. E. Nigma uses it at home
+tags: MythTV,MythBuntu,capture card,Linux MCE,XBMC
+
+show: 569
+summary: Installing Windows 7 Ultimate under Virtual Box
+#tags: Windows,Install,Virtual
+

Database/tsu/tag_summary_updates_0570-0579.txt

@@ -0,0 +1,36 @@
+show: 570
+summary: The upcoming Google Privacy Policy is read by espeak
+tags: policy,privacy,Google
+
+show: 572
+#summary: In this episode Klaatu talks to Mark Terranova from Zareason
+tags: Zareason,Linux computer,SELF 2010
+
+show: 573
+#summary: Episode 39 of "Linux In The Ham Shack" syndicated on HPR
+tags: Ubuntu 10.04,Crunchbang,morse code,SELF 2010
+
+show: 574
+summary: Maco and her new Sign Language Tutor application
+tags: Qt,KDE,Ubuntu Women
+
+show: 575
+summary: A recording of a presentation by Robert McWilliam from Software Freedom Day Event 2009
+tags: FOSS,Windows
+
+show: 576
+summary: HeathenX from the screencasters speaks about art on Linux
+#tags: OLF 2009,interview
+
+show: 577
+summary: An interview recorded at PyCon 2010, Atlanta, with Antoine Pitrou
+tags: Python,twisted,wxWidgets,CPython,Global interpreter lock,GIL
+
+show: 578
+summary: A recording of a presentation by Nick Walker from Software Freedom Day Event 2009
+tags: open source security
+
+show: 579
+summary: Jeff, a student, sponsor of SELF and volunteer and Loafy, a volunteer, first time at SELF
+tags: SELF 2010,volunteer,interview
+

Database/tsu/tag_summary_updates_0580-0589.txt

@@ -0,0 +1,20 @@
+show: 580
+summary: Several well-known HPR contributors are recorded in discussion
+tags: recording methods,HPR history,audio editing,mono,encoding
+
+show: 581
+summary: A talk by Phillip Geyer at Software Freedom Day Dundee 2009 about Open Source Games
+tags: Dundee,gaming,game development,game engine,game development community
+
+show: 582
+summary: deepgeek interviews Ken Fallon about the future of HPR
+tags: podcast,community,Today with a Techie,podfade
+
+show: 583
+summary: Alan Hicks at SouthEast LinuxFest 2010, the second annual festival
+#tags: SELF, interview
+
+show: 588
+summary: Brian Smith at SouthEast LinuxFest 2010, the second annual festival
+#tags: SELF, interview
+

Database/tsu/tag_summary_updates_0590-0599.txt

@@ -0,0 +1,8 @@
+show: 593
+summary: A show from a new host about using Linux at home and at work
+tags: Unix,Mandrake,Ubuntu,Mint,GIMP,OpenOffice
+
+show: 595
+summary: The first episode of the Read 'n Code podcast from a new host
+tags: Seneca,Stoicism,Python,Zen
+

Database/tsu/tag_summary_updates_0600-0609.txt

@@ -0,0 +1,11 @@
+show: 607
+summary: Rebecca is in sales at bueda.com
+tags: semantic web,social network,hipster boxing,privacy
+
+show: 608
+summary: Sampling Linux distributions and learning the command line
+tags: DSL,Ubuntu,Mandrake,CentOS,Mint,command line
+
+show: 609
+summary: A new host speaks of his first inklings of a Windows-free world
+tags: Ubuntu,IBM mainframe,Tom Merritt

Database/tsu/tag_summary_updates_0610-0619.txt

@@ -0,0 +1,8 @@
+show: 613
+summary: Some reflections on investing and saving
+tags: investment,E-Trade,microfinance,MicroPlace,share,hard asset
+
+show: 614
+summary: We look at what sound is, and how we represent it digitally
+tags: frequency,amplitude,bit rate, bit depth,Ardour,codec
+

Database/tsu/tag_summary_updates_0620-0629.txt

@@ -0,0 +1,20 @@
+show: 623
+summary: GNU nano is a simple editor, inspired by Pico
+tags: editor,command line,Pine,Pico
+
+show: 624
+summary: Episode 3: personal hygiene
+tags: stairwell,yurt,shower,gym membership,urban camping,
+
+show: 626
+summary: Episode 4: organizing your gear
+tags: backpack,locker,ziplock bag,travel mug,urban camping
+
+show: 627
+summary: Ruji's journey to Linux
+tags:  Mac OS X,Windows XP,freeware,shareware,FOSS,Mandriva,Ubuntu,Sabayon
+
+show: 628
+summary: brother mouse speaks of Tasker in his first show for HPR
+tags: Tasker,Android,automation
+

Database/tsu/tag_summary_updates_0630-0639.txt

@@ -0,0 +1,12 @@
+show: 634
+summary: Episode 5: where to find food
+tags: free food,dumpster diving,stealing,bartering
+
+show: 635
+summary: A new contributor talks about the downside of external cloud solutions
+tags: del.icio.us,atlassian.com,insipid
+
+show: 638
+summary: Episode 6: making money
+tags: part-time job,odd job,business card,freelance,street performing
+

Database/tsu/tag_summary_updates_0640-0649.txt

@@ -0,0 +1,12 @@
+show: 641
+summary: Episode 7: what to do all day!
+tags: job,cafe,library,university,parks,friends,streets,community establishment
+
+show: 645
+summary: Curbuntu interviews Baylee Juran, a public-school teacher
+tags: education,Second Life,HTML,CSS
+
+show: 646
+summary: Using Android without a phone or data plan, just WiFi
+tags: unlocked phone,SIP,Session Initiation Protocol,GPS
+

Database/tsu/tag_summary_updates_0660-0669.txt

@@ -0,0 +1,20 @@
+show: 661
+summary: Finding open wireless networks in a neighbourhood using a smartphone
+tags: Wardriving,Warwalking,Warchalking,GPS
+
+show: 662
+summary: Xoke records an HPR episode while installing DD-WRT
+#tags: WiFi,Wireless,DDWRT,Hardware
+
+show: 663
+summary: Podcast listening, and some suggestions of what to listen to
+tags: Sansa E200,Rockbox,iPod Mini,hpodder,Android,Cyanogenmod
+
+show: 668
+summary: Kurt Vonnegut's novel Slaughterhouse-five considered with the Erlang language
+tags: Kurt Vonnegut,postmodernism,Erlang,concurrency,fault tolerance
+
+show: 669
+summary: The audio recording of KFive's talk at Ohio Linux Fest 2010
+tags: Open Source
+

Database/tsu/tag_summary_updates_0670-0679.txt

@@ -0,0 +1,15 @@
+show: 673
+summary: droops voices regrets over the lack of imagination in the placement of some caches
+tags: geocaching,gps
+
+show: 334
+summary: Theater of the Imagination - part 1
+
+show: 677
+summary: Some descriptions of the base concepts
+tags: audiocast,broadcast,audio drama,RSS
+
+show: 679
+summary: An interview with Christian Tismer after PyCon 2010
+tags: Pycon,Stackless,psyco,PyPy,Unladen Swallow
+

Database/tsu/tag_summary_updates_0680-0689.txt

@@ -0,0 +1,8 @@
+show: 680
+summary: Broam talks of Auctions yard sales and flea markets
+tags: auction,yard sale,flea market
+
+show: 688
+summary: The first HPR Audio Book Club show: Badge Of Infamy written by Lester Del Rey
+tags: HPR AudioBookClub,Badge Of Infamy
+

Database/tsu/tag_summary_updates_0690-0699.txt

@@ -0,0 +1,8 @@
+show: 691
+summary: MrGadgets talks more about early computers (before the PC)
+tags: s-100 bus,CP/M,Ohio Scientific Inc.,Motorola 6800,Commodore VIC-20
+
+show: 696
+summary: Mr Gadgets talks about how he got to Linux
+tags: 6502,Z80,6800A,Moog Synthesizer,Commodore PET,TRS-80 Color Computer,KIM-1
+

Database/tsu/tag_summary_updates_0700-0739.txt

@@ -0,0 +1,32 @@
+show: 705
+summary: A new host's first show - about Linux experiences
+tags: RedHat,Arch Linux,Linux Fest North West
+
+show: 706
+summary: Some advice for sighted people when encountering a blind person
+tags: accessibility
+
+show: 708
+summary: A view of Linux in the Enterprise
+tags: SAP,Enterprise Resource Planning,ERP,Oracle Enterprise Linux,Novell
+
+show: 719
+summary: What language reveals about you; linguistics; dead languages
+tags: language,neologism,accent,spelling,linguistics,dialect
+
+show: 721
+summary: lostnbronx describes Audio Drama and how to make your own
+tags: audio drama,script
+
+show: 727
+summary: A description of how to get the control you should already have over an electronic device you own
+tags: Motorola cliq,cyanogenmod,root access
+
+show: 728
+summary: Two HPR hosts, Dismal Science and Sunzofman1, discuss equality in computing culture
+tags: privilege,minorities,wage discrimination
+
+show: 734
+summary: Syndicated Thursday Presents: The Language Frontier Episode 4.5
+tags: language,obscurity
+

Database/tsu/tag_summary_updates_0740-0749.txt

@@ -0,0 +1,32 @@
+show: 740
+summary: Distributed Denial of Service attacks
+tags: DDoS,Distributed Denial of Service,botnet,LOIC,Low Orbit Ion Cannon
+
+show: 742
+summary: Ken Fallon interviews Dave over Mumble about his use of Linux
+tags: Interview,PC repair,Linux Mint,Mumble
+
+show: 744
+summary: Skirlet's penultimate show in the series
+tags: language,movie subtitle,Esperanto
+
+show: 745
+summary: MrGadgets speaks of lessons learned with a product called Wingz
+tags: COMDEX,Innovative Software,Wingz,spreadsheet,Informix
+
+show: 746
+summary: Ken Fallon interviews Tony Whitmore of the Ubuntu-UK Podcast about OggCamp11
+#tags: oggcamp,oggcamp11
+
+show: 747
+summary: A discussion between two HPR hosts, one in Dundee and the other in Vancouver
+tags: Botnet,DNS Tunneling
+
+show: 748
+#summary: Today I share with you my list of favorite audiocasts w/ratings and reviews
+tags: podcast,audiocast
+
+show: 749
+summary: The process of preparing the Full Circle Podcast: preparation
+#tags: Full Circle Podcast
+

Database/tsu/tag_summary_updates_0750-0759.txt

@@ -0,0 +1,36 @@
+show: 750
+summary: In his first episode NewAgeTechnoHippie describes his Linux journey
+tags: Redhat Linux, LILO, Fedora, Arch Linux, Maemo, Nokia N900
+
+show: 751
+summary: A submission to HPR by Lord Drachenblut and Downer
+tags: Anonymous, LulzSec, Cloudflare
+
+show: 752
+summary: Another part of Mr Gadgets' journey to daily use of Linux
+tags: Knoppix, live CD, microdrive, compact flash
+
+show: 753
+#summary: KFive interviews klaatu of Slackermedia
+tags: Indiana Linux Fest, ILF, Slackware, multimedia studio
+
+show: 754
+summary: The last episode in the series
+tags: Noam Chomsky,Esperanto
+
+show: 755
+summary: Bariman talks about changes to his Linux audio setup
+tags: Jack Audio Driver,limits.conf, audio mixer, Ardour, Audacity, Kid3Tag, MMA, Muse, Lilypond
+
+show: 756
+summary: An introduction to Radio Frequencies
+tags: electromagnetic radiation, packet radio
+
+show: 758
+#summary: Ken interviews Jon Spriggs of CCHits.net
+tags: CCHits.net, music, Creative Commons, PHP
+
+show: 759
+#summary: A weekly meeting to revise for the LPI exams
+tags: LPI exam,www.linuxbasix.com,PS1,export
+

Database/tsu/tag_summary_updates_0760-0769.txt

@@ -0,0 +1,32 @@
+show: 760
+summary: Klaatu interviews /dev/Rob0 at the South East Linux Fest 2011
+#tags: SELF, interview
+
+show: 762
+summary: lostnbronx speaks about dramatic audio
+tags: condenser microphone,XLR,phantom power,pop filter,audio drama
+
+show: 763
+summary: MrGadgets talks about what are in his opinion some very terrible movies
+tags: movies,bad movies
+
+show: 764
+summary: Granola is software that improves the energy efficiency of your PC or laptop
+#tags: Full Circle Podcast
+
+show: 765
+summary: Klaatu interviews Dave S. Yates and Jeremy Sands at the South East Linux Fest 2011
+#tags: SELF 2011, interview
+
+show: 766
+summary: A personal account of technological history
+tags: OS/2,IBM PS/2,Microchannel,SCSI,Windows 98,Knoppix
+
+show: 767
+summary: Klaatu interviews John "Maddog" Hall  at the South East Linux Fest 2011
+#tags: SELF 2011, interview
+
+show: 768
+summary: Ken describes the use of the GNU 'sort' command
+tags: GNU sort
+

Database/tsu/tag_summary_updates_0770-0779.txt

@@ -0,0 +1,20 @@
+#show: 772
+#summary: Adding volume control to children's electronic toys
+#tags: electronics, resistor, capacitor, soldering
+#
+#show: 773
+#summary: Interview with Gabriel Weinberg of DuckDuckGo
+#tags: search engine,privacy
+#
+#show: 774
+#summary: The process of preparing the Full Circle Podcast: recording
+#tags: Behringer microphone,pop filter,Skype,Skype call recorder
+
+show: 776
+summary: Open Source and Hackable Hardware
+tags: Linksys NSLU2,Radio Shack,Heathkit,Microcentre,soldering
+
+show: 777
+summary: A look at aspects of the services jointly referred to as "The Cloud"
+tags: hypervisor,virtual environment,container,security,network storage,SAS,PAAS
+

Database/tsu/tag_summary_updates_0780-0789.txt

@@ -0,0 +1,12 @@
+show: 780
+summary: klaatu interviews Jason DeRose about a Kickstarter campaign for NovaCut, a video editor
+tags: Kickstarter,NovaCut,video editor
+
+show: 782
+summary: MrGadgets discusses Open Source Software versus closed and proprietary options
+tags: Open Source Software,walled garden,user experience
+
+show: 786
+summary: Designing a system to live stream video from multiple cameras at a sporting event
+tags: video,live stream,camera
+

Database/tsu/tag_summary_updates_0790-0799.txt

@@ -0,0 +1,32 @@
+show: 791
+summary: Ken talks to Moose, one of the organizers of Ohio LinuxFest
+tags: Ohio LinuxFest, OLF 2011
+
+show: 792
+summary: A response to episode 785 by Quvmoh on binaural recording
+tags: audio,binaural recording,matrix microphone
+
+show: 793
+summary: Part 6 of Klaatu's Networking Basics miniseries
+tags: networking, server, client, DHCP, router
+
+show: 794
+summary: A report from the U-Cubed unconference at Mad-Lab, Manchester, UK
+#tags: Full Circle Podcast
+
+show: 795
+summary: An interview with John Uren at OggCamp 2011
+tags:  Civil Service, open-source software, EtherPad
+
+show: 796
+summary: An interview with Shane Marks from the Nexus maker space in Cork, Ireland
+tags:  hackerspace,Ireland
+
+show: 797
+summary: Mike Hingley's first HPR episode where he describes how he got into Linux
+tags: Ubuntu
+
+show: 799
+summary: Details of how the Full Circle Podcast is prepared, part four
+#tags: Full Circle Podcast
+

Database/tsu/tag_summary_updates_0800-0809.txt

@@ -0,0 +1,36 @@
+#show: 800
+#summary: The danger of a open source monoculture in the mobile OS space
+#tags: webOS,Android,IOS,Windows Phone 7,Nokia N900
+#
+#show: 801
+#summary: Part 1 of the series on packaging applications
+#tags: package,packaging,yesplz,Slackware,SlackBuild
+#
+#show: 802
+#summary: An interview at OggCamp 11 with Ana Nelson about Dexy, a software documentation tool
+#tags: Dexy,language-specific documentation
+
+show: 803
+summary: The NovaCut video editor was a Kickstarter project in 2011
+tags: NovaCut,video,editor,Kickstarter
+
+show: 804
+summary: Ken Fallon interviews Wayne Myers at OggCamp 11
+#tags: oggcamp,oggcamp11
+
+show: 805
+summary: Mr Gadgets phones in to talk about the Monster Cable company
+tags: HiFi,audiophile,decibel,skin effect
+
+show: 807
+summary: Part 6 of the Networking series: How to set up a simple DNS server
+tags: networking,DNS,Domain Name System,MaraDNS
+
+show: 808
+summary: Interview at SELF about a PC recycling project with the Carolina Free PC Foundation
+tags: SELF,Carolina Free PC Foundation,Upstate Carolina Linux User Group
+
+show: 809
+summary: DeepGeek explains Segmented Downloading
+tags: Segmented Downloading
+

Database/tsu/tag_summary_updates_0810-0819.txt

@@ -0,0 +1,40 @@
+show: 810
+summary: An introduction from a new host
+tags: Knoppix,Slackware,Fedora,Debian,Ubuntu,Arch Linux
+
+show: 811
+summary: Plans to create a Drupal CMS with a Creative Commons torrent tracker
+tags: torrent,torrent seeder,creative commons,Drupal,EFF,GNU
+
+show: 812
+summary: Useful tips on how to determine if someone is a patent troll or not
+tags: patent,patent troll
+
+show: 813
+summary: Ken talks to Gemma Cameron aka @ruby_gem about Barcamp Blackpool
+tags: Barcamp Blackpool,unconference
+
+show: 814
+#summary: A visit to the Knightcast podcast
+tags: Amahi
+
+show: 815
+summary: An event to celebrate and promote the use of free and open source software
+tags: Tayside Linux User Group,Dundee
+
+show: 816
+#summary: Modern Survivalism - part 1 of 2
+tags: recipe
+
+show: 817
+summary: Script to install Windows to an external USB hard drive
+tags: USB hard disk,Windows 7,swapfile,pagefile
+
+show: 818
+summary: Using a Sansa player as a podcast recorder
+tags: Sansa Clip+,recording,RockBox
+
+show: 819
+summary: The process of editing the Full Circle podcast audio, part 5
+#tags: Full Circle Podcast
+

Database/tsu/tag_summary_updates_0820-0829.txt

@@ -0,0 +1,36 @@
+show: 820
+summary: Part 9 - configuring a web server and a MySQL server
+tags: DHCP,DNS,web server,MySQL server,apache,nginx,lighttpd,virtual host
+
+show: 821
+summary: Mr. Gadgets discusses his experiences with various Android tablets
+tags: resistive screen,Android apps,Google marketplace,Amazon marketplace
+
+show: 822
+summary: The GiffGaff Community Phone project
+tags: giffgaff,community phone project
+
+show: 823
+summary: Phonon's Gstreamer backend
+tags: KDE,Phonon,Gstreamer,Amarok,Dragon Player
+
+show: 824
+summary: Fossbox at OpenTech 2011
+#tags: Full Circle Podcast
+
+show: 825
+summary: Interview with Jamey Sharp at XDC 2011
+tags: X.Org Developer Conference,XDC,XCB
+
+show: 827
+summary: HPR at OLF
+tags: Ohio Linux Fest,OLF,lock picking,HostGator.com
+
+show: 828
+summary: The demise of physical retail stores
+tags: online store,physical store,book reader
+
+show: 829
+summary: Prof Jocelyn Bell-Burnell, discoverer of pulsars, on the Jodcast podcast
+tags: astronomy,quasar,pulsar,radio telescope,neutron star,transient pulsar
+