forked from HPR/hpr-tools
Updates prior to the handover to SGOTI
.make_email.cfg: New configuration file to simplify the original options to 'make_email' .make_shownotes.cfg: New configuration file to simplify the original extremely obscure options to 'make_shownotes' collect_HPR_database: Script to simplify the collection and setup of MySQL dumps from the HPR server and conversion to a SQLite database. make_email: Many changes to make the script simpler to use. It looks for all files in the same directory as the script. Reduced the number of options and added a new configuration file. Now reads and writes a date cache file (defined in the configuration file) where it writes the date and time of the next recording. Now uses a local SQLite database rather than linking to the live HPR database (more secure). Takes an output file name (with optional '%s'). Functions for loading and updating the date cache (also used by 'make_shownotes'). Doesn't attempt to generate a real mail message, just something that can be cut and pasted into a mail client. make_email_template.tpl: TT2 template for generating the mail message. This whole function was moved from the script itself to this templating system, making it all a lot simpler. make_meeting: Minor updates. This script is probably obsolete. make_shownotes: Almost totally rewritten. It looks for all files in the same directory as the script. Reduced the number of options and added a new configuration file. Now reads a date cache file (defined in the configuration file) where 'make_email' has written the date and time of the next recording. Now generates output files rather than writing to the live HPR database. These files can be added to the database on the 'hub' using existing workflow(s). One of the files generated is a stand-alone full HTML file for circulation to volunteers recording the show. The others are the HTML snippet to add to the database, and a JSON version for use in the hub workflow. The full HTML gets the expanded comments and contains markers of comments already read or missed last month. This version computes the episode number and date which will be used to post the resulting show (previously reserved slots were searched for in the database). The extremely complex query that collects comments has been thoroughly tested and enhanced and seems to be reliable. Dropped the "Any Other Business" section (and all code relating to it in the script and the template). shownote_template.tpl: Soft link to the latest template. Doing this needs consideration given that the configuration file could just reference the appropriate file. This technique may just be a nuisance. shownote_template11.tpl: Previous template, updated for the last release of 'make_shownotes'. Now replaced. shownote_template12.tpl: New template without AOB capability.
This commit is contained in:
@@ -3,56 +3,60 @@
|
||||
#
|
||||
# FILE: make_email
|
||||
#
|
||||
# USAGE: ./make_email [-debug=N] [-month=DATE] [-from=ADDRESS]
|
||||
# [-to=ADDRESS] [-[no]mail] [-date=DATE] [-start=START_TIME]
|
||||
# [-end=END_TIME] [-config=FILE] [-dbconfig=FILE]
|
||||
# USAGE: ./make_email [-debug=N] [-month=DATE] [-date=DATE]
|
||||
# [-start=START_TIME] [-end=END_TIME] [-output[=FILE]]
|
||||
# [-config=FILE]
|
||||
#
|
||||
# DESCRIPTION: Make and send an invitation email for the next Community News
|
||||
# DESCRIPTION: Make an invitation email for the next Community News
|
||||
# with times per timezone.
|
||||
#
|
||||
# The configuration file (.make_email.cfg) defines the name of
|
||||
# the email template and the defaults used when generating the
|
||||
# message. The date of the recording is computed from the
|
||||
# current month (Saturday before the first Monday of the month
|
||||
# current month (Friday before the first Monday of the month
|
||||
# when the show will be posted). It can also be specified
|
||||
# through the -date=DATE option.
|
||||
#
|
||||
# The month the email relates to can be changed through the
|
||||
# -month=DATA option, though this is rarely used. Use a date of
|
||||
# -month=DATE option, though this is rarely used. Use a date of
|
||||
# the format 'YYYY-MM-DD' here. The day is ignored but the year
|
||||
# and month are used in the computation. The month specified
|
||||
# must be in the future.
|
||||
#
|
||||
# The database configuration file defines the database to be
|
||||
# used to compute the date and show number. Use .hpr_db.cfg for
|
||||
# the local MariaDB copy (for testing) and .hpr_livedb.cfg for
|
||||
# the live database (over the ssh tunnel, which must have been
|
||||
# opened already).
|
||||
#
|
||||
# OPTIONS: ---
|
||||
# REQUIREMENTS: ---
|
||||
# BUGS: ---
|
||||
#
|
||||
# NOTES: Does not send the email at present. Needs work
|
||||
# 2022-02-28: DBD::MariaDB has vanished, had to revert to MySQL
|
||||
# again
|
||||
# again.
|
||||
# 2025-02-22: Moved to SQLite for the database
|
||||
# 2025-02-23: Dropped Mail::Mailer and all related code. The
|
||||
# output is now written to STDOUT or an output file.
|
||||
#
|
||||
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
|
||||
# VERSION: 0.2.7
|
||||
# VERSION: 0.3.3
|
||||
# CREATED: 2013-10-28 20:35:22
|
||||
# REVISION: 2024-05-24 18:53:17
|
||||
# REVISION: 2025-02-28 14:40:28
|
||||
#
|
||||
#===============================================================================
|
||||
|
||||
use 5.010;
|
||||
use strict;
|
||||
use warnings;
|
||||
use v5.36;
|
||||
use utf8;
|
||||
use feature qw{ try };
|
||||
no warnings qw{ experimental::try };
|
||||
|
||||
use open ':std', ':encoding(UTF-8)'; # Make all IO UTF-8
|
||||
|
||||
use Cwd qw( abs_path );
|
||||
|
||||
use Getopt::Long;
|
||||
use Pod::Usage;
|
||||
|
||||
use Config::General;
|
||||
|
||||
use File::Copy;
|
||||
|
||||
use Date::Parse;
|
||||
|
||||
use DateTime;
|
||||
@@ -63,8 +67,6 @@ use Date::Calc qw{:all};
|
||||
|
||||
use Template;
|
||||
|
||||
use Mail::Mailer;
|
||||
|
||||
use DBI;
|
||||
|
||||
use Data::Dumper;
|
||||
@@ -72,7 +74,7 @@ use Data::Dumper;
|
||||
#
|
||||
# Version number (manually incremented)
|
||||
#
|
||||
our $VERSION = '0.2.7';
|
||||
our $VERSION = '0.3.3';
|
||||
|
||||
#
|
||||
# Script name
|
||||
@@ -85,11 +87,16 @@ our $VERSION = '0.2.7';
|
||||
#
|
||||
# Constants and other declarations
|
||||
#
|
||||
my $basedir = "$ENV{HOME}/HPR/Community_News";
|
||||
my $configfile1 = "$basedir/.${PROG}.cfg";
|
||||
my $configfile2 = "$basedir/.hpr_db.cfg";
|
||||
( my $basedir = abs_path($0) ) =~ s|/?[^/]*$||mx;
|
||||
my $configfile = "$basedir/.${PROG}.cfg";
|
||||
|
||||
my ( $dbh, $sth1, $sth2, $sth3, $h1, $h2, $rv );
|
||||
my ( $dbh, $sth1, $h1, $h2, $rv );
|
||||
my ( %recdates, $rdfh );
|
||||
|
||||
#
|
||||
# Run in the script's directory
|
||||
#
|
||||
chdir($basedir);
|
||||
|
||||
#
|
||||
# The timezones we want to report. These were generated with
|
||||
@@ -495,18 +502,10 @@ my @zones = (
|
||||
#}}}
|
||||
);
|
||||
|
||||
#
|
||||
# Enable Unicode mode
|
||||
#
|
||||
binmode STDOUT, ":encoding(UTF-8)";
|
||||
binmode STDERR, ":encoding(UTF-8)";
|
||||
|
||||
#
|
||||
# Defaults for options
|
||||
#
|
||||
my $DEF_DEBUG = 0;
|
||||
my $DEF_FROM = 'Dave.Morriss@gmail.com';
|
||||
my $DEF_TO = 'perloid@autistici.org';
|
||||
|
||||
#
|
||||
# Options and arguments
|
||||
@@ -521,43 +520,26 @@ pod2usage( -msg => "$PROG version $VERSION\n", -verbose => 0, -exitval => 1 )
|
||||
if ( $options{'help'} );
|
||||
|
||||
#
|
||||
# Full documentation if requested with -doc
|
||||
# Full documentation if requested with -doc[umentation] or -man
|
||||
#
|
||||
pod2usage(
|
||||
-msg => "$PROG version $VERSION\n",
|
||||
-verbose => 2,
|
||||
-exitval => 1,
|
||||
# -noperldoc => 0,
|
||||
) if ( $options{'documentation'} );
|
||||
|
||||
#
|
||||
# Collect options
|
||||
#
|
||||
my $DEBUG = ( defined( $options{debug} ) ? $options{debug} : $DEF_DEBUG );
|
||||
my $month = $options{month};
|
||||
my $mail = ( defined( $options{mail} ) ? $options{mail} : 0 );
|
||||
my $from_address = (
|
||||
defined( $options{fromaddress} ) ? $options{fromaddress} : $DEF_FROM );
|
||||
my $to_address
|
||||
= ( defined( $options{toaddress} ) ? $options{toaddress} : $DEF_TO );
|
||||
my $date = $options{date};
|
||||
my $start = $options{starttime};
|
||||
my $end = $options{endtime};
|
||||
|
||||
# This value is in the configuration file and can't be overridden. The planned
|
||||
# end time can be specified however.
|
||||
#my $duration = $options{duration};
|
||||
my $DEBUG = ( defined( $options{debug} ) ? $options{debug} : $DEF_DEBUG );
|
||||
my $month = $options{month};
|
||||
my $date = $options{date};
|
||||
my $start = $options{starttime};
|
||||
my $end = $options{endtime};
|
||||
my $outfile = $options{output};
|
||||
|
||||
my $cfgfile
|
||||
= ( defined( $options{config} ) ? $options{config} : $configfile1 );
|
||||
my $dbcfgfile
|
||||
= ( defined( $options{dbconfig} ) ? $options{dbconfig} : $configfile2 );
|
||||
|
||||
#
|
||||
# Use the 'testfile' mailer if option -nomail was chosen. This writes the file
|
||||
# 'mailer.testfile' and sends no message
|
||||
#
|
||||
my $mailertype = ( $mail ? 'sendmail' : 'testfile' );
|
||||
= ( defined( $options{config} ) ? $options{config} : $configfile );
|
||||
|
||||
#
|
||||
# Sanity checking the options
|
||||
@@ -565,39 +547,26 @@ my $mailertype = ( $mail ? 'sendmail' : 'testfile' );
|
||||
die "Unable to find $cfgfile\n" unless ( -e $cfgfile );
|
||||
die "Use only one of -month=MONTH or -date=DATE\n"
|
||||
if (defined($month) && defined($date));
|
||||
#die "Use only one of -endtime=TIME or -duration=HOURS\n"
|
||||
# if (defined($end) && defined($duration));
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
# Load script and database configuration data
|
||||
# Load configuration data
|
||||
#-------------------------------------------------------------------------------
|
||||
my $conf = new Config::General(
|
||||
my $conf = Config::General->new(
|
||||
-ConfigFile => $cfgfile,
|
||||
-InterPolateVars => 1,
|
||||
-ExtendedAccess => 1
|
||||
);
|
||||
my %config = $conf->getall();
|
||||
#print Dumper( \%config ), "\n";
|
||||
_debug( $DEBUG >= 2, '%config: ' . Dumper( \%config ) );
|
||||
|
||||
#
|
||||
# Load database configuration data
|
||||
#
|
||||
my $dbconf = new Config::General(
|
||||
-ConfigFile => $dbcfgfile,
|
||||
-InterPolateVars => 1,
|
||||
-ExtendedAccess => 1
|
||||
);
|
||||
my %dbconfig = $dbconf->getall();
|
||||
#print Dumper( \%dbconfig ), "\n";
|
||||
|
||||
#
|
||||
# Configuration file values with defaults and/or checks
|
||||
# Configuration file values for the email text with defaults and/or checks
|
||||
#
|
||||
my $server = $config{email}->{server} // 'chatter.skyehaven.net';
|
||||
my $port = $config{email}->{port} // 64738;
|
||||
my $room = $config{email}->{room} // 'Hacker Public Radio';
|
||||
my $duration = $config{email}->{duration} // 2;
|
||||
my $dayname = $config{email}->{dayname} // 'Sunday';
|
||||
my $duration = $config{email}->{duration} // 2; # Hours
|
||||
my $dayname = $config{email}->{dayname} // 'Friday';
|
||||
|
||||
#
|
||||
# If we had a start time specified then check it and ensure the end time makes
|
||||
@@ -637,9 +606,33 @@ my @starttime = split( ':', $start );
|
||||
my @endtime = split( ':', $end );
|
||||
die "Missing start/end time(s)\n" unless ( @starttime && @endtime );
|
||||
|
||||
#
|
||||
# The template from the configuration file
|
||||
#
|
||||
my $template = $config{email}->{template};
|
||||
die "Missing template file $template\n" unless (-e $template);
|
||||
|
||||
#
|
||||
# Recording date cache filename in the configuration file
|
||||
#
|
||||
my $recdatefile = $config{recdates}->{name};
|
||||
unless ($recdatefile) {
|
||||
warn "No recording date file defined in configuration";
|
||||
say STDERR "Continuing without this file";
|
||||
}
|
||||
elsif ( ! -e $recdatefile) {
|
||||
warn "Can't find recording date file $recdatefile";
|
||||
say STDERR "Continuing without this file";
|
||||
$recdatefile = undef;
|
||||
}
|
||||
|
||||
#
|
||||
# Load the recording dates
|
||||
#
|
||||
if ($recdatefile) {
|
||||
%recdates = load_cache($recdatefile, $rdfh);
|
||||
}
|
||||
|
||||
_debug($DEBUG >= 2,
|
||||
'$start: ' . coalesce($start,''),
|
||||
'$end: ' . coalesce($end,''),
|
||||
@@ -655,24 +648,17 @@ if ($DEBUG >= 1) {
|
||||
# 2021-12-24: moved to MariaDB
|
||||
# 2022-02-28: the MariaDB driver has gone away apparently. Reverted to MySQL
|
||||
# again
|
||||
# 2025-02-22: Converted to SQLite
|
||||
#-------------------------------------------------------------------------------
|
||||
my $dbhost = $dbconfig{database}->{host} // '127.0.0.1';
|
||||
my $dbport = $dbconfig{database}->{port} // 3306;
|
||||
my $dbname = $dbconfig{database}->{name};
|
||||
my $dbuser = $dbconfig{database}->{user};
|
||||
my $dbpwd = $dbconfig{database}->{password};
|
||||
#$dbh = DBI->connect( "DBI:MariaDB:database=$dbname;host=$dbhost;port=$dbport",
|
||||
# $dbuser, $dbpwd, { AutoCommit => 1 } )
|
||||
# or croak $DBI::errstr;
|
||||
my $dbname = $config{database}->{name};
|
||||
|
||||
$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
|
||||
$dbuser, $dbpwd, { AutoCommit => 1 } )
|
||||
or die $DBI::errstr;
|
||||
$dbh = DBI->connect( "DBI:SQLite:dbname=$dbname",
|
||||
"", "", { AutoCommit => 1 } );
|
||||
|
||||
#
|
||||
# Enable client-side UTF8
|
||||
#
|
||||
$dbh->{mysql_enable_utf8} = 1;
|
||||
$dbh->{sqlite_unicode} = 1;
|
||||
|
||||
#
|
||||
# Date and time values using Date::Calc format
|
||||
@@ -681,7 +667,7 @@ my @today = Today();
|
||||
my @startdate;
|
||||
my @startmonth;
|
||||
my @reviewdate;
|
||||
my $monday = 1; # Day of week number 1-7, Monday-Sunday
|
||||
my $monday = 1; # Day of week number 1-7, Monday-Sunday
|
||||
my $offset = day_offset($dayname)->{offset};
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
@@ -689,7 +675,7 @@ my $offset = day_offset($dayname)->{offset};
|
||||
# or the current date.
|
||||
#-------------------------------------------------------------------------------
|
||||
#
|
||||
# If there's an argument then it'll be an override for the start date
|
||||
# If there's a -date=DATE option then it'll be an override for the start date
|
||||
# otherwise we'll compute it.
|
||||
#
|
||||
if ( defined($date) ) {
|
||||
@@ -726,7 +712,8 @@ elsif ( defined($month) ) {
|
||||
|
||||
#
|
||||
# Compute the next meeting date from now (by finding the next first Monday
|
||||
# of the month then backing up two days to the Saturday).
|
||||
# of the month then backing up two days to the desired day - default
|
||||
# Friday).
|
||||
#
|
||||
@startdate = make_date( \@startmonth, $monday, 1, $offset );
|
||||
}
|
||||
@@ -745,9 +732,11 @@ _debug($DEBUG >= 2, '@startdate: ' . join(',',@startdate));
|
||||
# before.
|
||||
#
|
||||
if ( $startdate[1] eq $today[1] ) {
|
||||
# Same month
|
||||
@reviewdate = @startdate;
|
||||
}
|
||||
else {
|
||||
# Previous month - backup 1 month
|
||||
@reviewdate = Add_Delta_YM( @startdate, 0, -1 );
|
||||
}
|
||||
|
||||
@@ -755,7 +744,8 @@ _debug($DEBUG >= 2, '@reviewdate: ' . join(',',@reviewdate));
|
||||
|
||||
#
|
||||
# Transfer Date::Calc values into hashes for initialising DateTime objects so
|
||||
# we can play time zone games
|
||||
# we can play time zone games. (Note: %dtargs is a hash and we're using hash
|
||||
# slicing to initialise it).
|
||||
#
|
||||
my ( %dtargs, $dtstart, $dtend );
|
||||
@dtargs{ 'year', 'month', 'day', 'hour', 'minute', 'second', 'time_zone' }
|
||||
@@ -775,14 +765,15 @@ my $days = $dtf->format_duration($dtoffset);
|
||||
#
|
||||
# Formatted dates for the mail message body
|
||||
#
|
||||
my ( $year, $monthname, $nicedate, $starttime, $endtime ) = (
|
||||
$dtstart->strftime("%Y"), Month_to_Text( $reviewdate[1] ),
|
||||
$dtstart->strftime("%A, %B %d %Y"), $dtstart->strftime("%R (%Z)"),
|
||||
$dtend->strftime("%R (%Z)"),
|
||||
my ( $year, $monthno, $monthname, $nicedate, $starttime, $endtime ) = (
|
||||
$dtstart->strftime("%Y"), $dtstart->strftime("%m"),
|
||||
Month_to_Text( $reviewdate[1] ), $dtstart->strftime("%A, %B %d %Y"),
|
||||
$dtstart->strftime("%R (%Z)"), $dtend->strftime("%R (%Z)"),
|
||||
);
|
||||
|
||||
_debug($DEBUG >= 2,
|
||||
"\$year: $year",
|
||||
"\$monthno: $monthno",
|
||||
"\$monthname: $monthname",
|
||||
"\$nicedate: $nicedate",
|
||||
"\$starttime: $starttime",
|
||||
@@ -800,38 +791,50 @@ my $subject = $dtstart->strftime(
|
||||
|
||||
_debug( $DEBUG >= 2, "\$subject: $subject" );
|
||||
|
||||
#
|
||||
# Prepare to send mail
|
||||
#
|
||||
my $mailer = Mail::Mailer->new($mailertype);
|
||||
#-------------------------------------------------------------------------------
|
||||
# Open the output file (or STDOUT) - we may need the year and month number to
|
||||
# do it, if the file name contains '%s'.
|
||||
#-------------------------------------------------------------------------------
|
||||
my $outfh;
|
||||
if ($outfile) {
|
||||
$outfile = sprintf( $outfile, sprintf( "%d-%02d", $year, $monthno ) )
|
||||
if ( $outfile =~ /%s/ );
|
||||
|
||||
#
|
||||
# Generate the headers we need
|
||||
#
|
||||
$mailer->open(
|
||||
{ To => $to_address,
|
||||
From => $from_address,
|
||||
Subject => $subject,
|
||||
}
|
||||
);
|
||||
open( $outfh, ">:encoding(UTF-8)", $outfile )
|
||||
or die "Unable to open $outfile for writing: $!\n";
|
||||
}
|
||||
else {
|
||||
open( $outfh, ">&", \*STDOUT )
|
||||
or die "Unable to initialise for writing: $!\n";
|
||||
}
|
||||
|
||||
#
|
||||
# Build an array of timezone data for the template
|
||||
#
|
||||
my @timezones;
|
||||
for my $tz (@zones) {
|
||||
push( @timezones, storeTZ( $dtstart, $dtend, $tz ) );
|
||||
push( @timezones, storeTZ( $dtstart, $dtend, $tz ) );
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
# Find the number of the show with the notes. Take care because the recording
|
||||
# date might not be on the weekend before the show is released.
|
||||
# TODO: If this search fails (because in future Community News shows will not
|
||||
# be reserved), then the date needs to be computed.
|
||||
#-------------------------------------------------------------------------------
|
||||
my $isodate = $dtstart->ymd;
|
||||
#$sth1 = $dbh->prepare(q{
|
||||
# SELECT id FROM eps
|
||||
# WHERE date > ?
|
||||
# AND date_format(date,"%W") = 'Monday'
|
||||
# AND title LIKE 'HPR Community News%'
|
||||
# ORDER BY date
|
||||
# LIMIT 1
|
||||
#});
|
||||
$sth1 = $dbh->prepare(q{
|
||||
SELECT id FROM eps
|
||||
WHERE date > ?
|
||||
AND date_format(date,"%W") = 'Monday'
|
||||
AND strftime("%u", date) = '1'
|
||||
AND title LIKE 'HPR Community News%'
|
||||
ORDER BY date
|
||||
LIMIT 1
|
||||
@@ -848,13 +851,38 @@ unless ( $h1 = $sth1->fetchrow_hashref ) {
|
||||
exit 1;
|
||||
}
|
||||
|
||||
my $shownotes = $h1->{id};
|
||||
my $episode = $h1->{id};
|
||||
|
||||
_debug( $DEBUG >= 2, "\$shownotes (slot): $shownotes" );
|
||||
_debug( $DEBUG >= 2, "\$episode (slot): $episode" );
|
||||
|
||||
$sth1->finish;
|
||||
$dbh->disconnect;
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
# Update the date cache now we have the date and time details we need.
|
||||
#-------------------------------------------------------------------------------
|
||||
( my $monthkey = $dtstart->ymd ) =~ s/\d+$/01/;
|
||||
my $datestamp = $dtstart->strftime("%F %T");
|
||||
|
||||
if (exists($recdates{$monthkey})) {
|
||||
#
|
||||
# It exists. Is it different?
|
||||
#
|
||||
unless ( $recdates{$monthkey} eq $datestamp ) {
|
||||
#
|
||||
# Save the new data (assuming it's correct)
|
||||
#
|
||||
$recdates{$monthkey} = $datestamp;
|
||||
update_cache( $recdatefile, \%recdates );
|
||||
}
|
||||
}
|
||||
else {
|
||||
#
|
||||
# Add a new record to the end of the cache file
|
||||
#
|
||||
append_cache( $recdatefile, sprintf( "%s,%s", $monthkey, $datestamp ) );
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
# Fill the template
|
||||
#-------------------------------------------------------------------------------
|
||||
@@ -865,12 +893,10 @@ my $tt = Template->new(
|
||||
);
|
||||
|
||||
my $vars = {
|
||||
# subject => $subject,
|
||||
# from => $from_address,
|
||||
# to => $to_address,
|
||||
server => $server,
|
||||
port => $port,
|
||||
room => $room,
|
||||
subject => $subject,
|
||||
timezones => \@timezones,
|
||||
utc => {
|
||||
days => $days,
|
||||
@@ -880,7 +906,7 @@ my $vars = {
|
||||
start => $starttime,
|
||||
end => $endtime,
|
||||
},
|
||||
shownotes => $shownotes,
|
||||
episode => $episode, # show number
|
||||
};
|
||||
|
||||
my $document;
|
||||
@@ -889,23 +915,136 @@ $tt->process( $template,
|
||||
|| die $tt->error(), "\n";
|
||||
|
||||
#
|
||||
# Add the template-generated body to the mail message
|
||||
# Write to the output file
|
||||
#
|
||||
print $mailer $document;
|
||||
print $outfh $document;
|
||||
|
||||
#
|
||||
# Send the message
|
||||
# Report the output file name if there is one
|
||||
#
|
||||
$mailer->close
|
||||
or die "Couldn't send message: $!\n";
|
||||
|
||||
unless ($mail) {
|
||||
print "Message was not sent since -nomail was selected (or defaulted).\n";
|
||||
print "Look in 'mailer.testfile' for the output\n";
|
||||
if ($outfile) {
|
||||
say "Output is in $outfile";
|
||||
}
|
||||
|
||||
exit;
|
||||
|
||||
#=== FUNCTION ================================================================
|
||||
# NAME: load_cache
|
||||
# PURPOSE: Load the date cache into a hash
|
||||
# PARAMETERS: $cache_name Name of file holding the cache
|
||||
# RETURNS: Contents of cache as a hash
|
||||
# DESCRIPTION: Opens the nominated file, parses each record, and adds the
|
||||
# data to a hash. The record should contain the following:
|
||||
# * 'YYYY-MM-01' the month for which the details are being
|
||||
# recorded
|
||||
# * ',' comma field separator
|
||||
# * 'YYYY-MM-DD HH:MM:SS' timestamp of the recording
|
||||
# The file is closed once it has been scanned. The function
|
||||
# returns the completed hash.
|
||||
# THROWS: No exceptions
|
||||
# COMMENTS: None
|
||||
# SEE ALSO: N/A
|
||||
#===============================================================================
|
||||
sub load_cache {
|
||||
my ($cache_name) = @_;
|
||||
|
||||
my ( $month, $datetime, %result );
|
||||
|
||||
#
|
||||
# Open the file in read mode
|
||||
#
|
||||
open( my $dcfh, '<', $cache_name )
|
||||
or die "$PROG: failed to open '$cache_name': $!\n";
|
||||
|
||||
while ( my $line = <$dcfh> ) {
|
||||
chomp($line);
|
||||
if ( ( $month, $datetime )
|
||||
= ( $line =~ /^(\d{4}-\d{2}-\d{2}),(.*)$/ ) )
|
||||
{
|
||||
$result{$month} = $datetime;
|
||||
}
|
||||
# TODO: Report any errors found in the file
|
||||
}
|
||||
|
||||
close($dcfh)
|
||||
or warn "$PROG: failed to close '$cache_name': $!\n";
|
||||
|
||||
return %result;
|
||||
}
|
||||
|
||||
#=== FUNCTION ================================================================
|
||||
# NAME: append_cache
|
||||
# PURPOSE: Append a new line to the cache
|
||||
# PARAMETERS: $cache_name Name of file holding the cache
|
||||
# $line New record to add
|
||||
# RETURNS: Nothing
|
||||
# DESCRIPTION: Opens the nominated file and appends the new record in $line.
|
||||
# The file is closed once it has been updated.
|
||||
# THROWS: No exceptions
|
||||
# COMMENTS: None
|
||||
# SEE ALSO: N/A
|
||||
#===============================================================================
|
||||
sub append_cache {
|
||||
my ( $cache_name, $line ) = @_;
|
||||
|
||||
#
|
||||
# Open the file in append mode
|
||||
#
|
||||
open( my $dcfh, '>>', $cache_name )
|
||||
or die "$PROG: failed to open '$cache_name': $!\n";
|
||||
|
||||
say $dcfh $line;
|
||||
|
||||
close($dcfh)
|
||||
or warn "$PROG: failed to close '$cache_name': $!\n";
|
||||
}
|
||||
|
||||
#=== FUNCTION ================================================================
|
||||
# NAME: update_cache
|
||||
# PURPOSE: Make changes to an existing line in the cache
|
||||
# PARAMETERS: $cache_name Name of file holding the cache
|
||||
# $rhash Hashref holding the updated cache contents
|
||||
# RETURNS: Nothing
|
||||
# DESCRIPTION: Makes a backup of the nominated file. Opens, truncates it and
|
||||
# positions for writing (using 'seek'). The now empty file is
|
||||
# filled with data from the hash and closed.
|
||||
# THROWS: No exceptions
|
||||
# COMMENTS: None
|
||||
# SEE ALSO: N/A
|
||||
#===============================================================================
|
||||
sub update_cache {
|
||||
my ( $cache_name, $rhash ) = @_;
|
||||
|
||||
#
|
||||
# Copy the cache file to a backup
|
||||
#
|
||||
copy($cache_name,"${cache_name}~")
|
||||
or die "Unable to back up $cache_name\n";
|
||||
|
||||
#
|
||||
# Open the original file in write mode
|
||||
#
|
||||
open( my $dcfh, '>', $cache_name )
|
||||
or die "$PROG: failed to open '$cache_name': $!\n";
|
||||
|
||||
#
|
||||
# Truncate the file and seek to the start again
|
||||
#
|
||||
truncate($dcfh,0)
|
||||
or die "$PROG: failed to truncate '$cache_name': $!\n";
|
||||
seek($dcfh,0,0)
|
||||
or die "$PROG: failed to seek in '$cache_name': $!\n";
|
||||
|
||||
#
|
||||
# Write the cache data to the file
|
||||
#
|
||||
for my $key (sort(keys(%$rhash))) {
|
||||
say $dcfh sprintf("%s,%s",$key, $rhash->{$key});
|
||||
}
|
||||
|
||||
close($dcfh)
|
||||
or warn "$PROG: failed to close '$cache_name': $!\n";
|
||||
}
|
||||
|
||||
#=== FUNCTION ================================================================
|
||||
# NAME: report_settings
|
||||
@@ -921,36 +1060,18 @@ sub report_settings {
|
||||
my $fmt = "D> %-14s = %s\n";
|
||||
print "D> Settings from options or default values:\n";
|
||||
printf $fmt, "Month", coalesce($month,'undef');
|
||||
printf $fmt, "Mail", coalesce($mail,'undef');
|
||||
printf $fmt, "From", coalesce($from_address,'undef');
|
||||
printf $fmt, "To", coalesce($to_address,'undef');
|
||||
printf $fmt, "Meeting date", coalesce($date,'undef');
|
||||
printf $fmt, "Start time", join(':',@starttime);
|
||||
printf $fmt, "End time", join(':',@endtime);
|
||||
printf $fmt, "Config file", coalesce($cfgfile,'undef');
|
||||
printf $fmt, "DB config file", coalesce($dbcfgfile,'undef');
|
||||
printf $fmt, "Server", coalesce($server,'undef');
|
||||
printf $fmt, "Port", coalesce($port,'undef');
|
||||
printf $fmt, "Room", coalesce($room,'undef');
|
||||
printf $fmt, "Template", coalesce($template,'undef');
|
||||
printf $fmt, "Recording date file", coalesce($recdatefile,'undef');
|
||||
print "D> ----\n";
|
||||
}
|
||||
|
||||
#=== FUNCTION ================================================================
|
||||
# NAME: compute_endtime
|
||||
# PURPOSE: Given a start time and a duration computes the end time
|
||||
# PARAMETERS: $rdate arrayref for the date
|
||||
# $rstime arrayref for the start time
|
||||
# $rduration arrayref for the duration [HH,MM,SS]
|
||||
# RETURNS: The end time as a string (HH:MM:SS)
|
||||
# DESCRIPTION:
|
||||
# THROWS: No exceptions
|
||||
# COMMENTS: Decided not to implement this, may do so in future.
|
||||
# SEE ALSO: N/A
|
||||
#===============================================================================
|
||||
#sub compute_endtime {
|
||||
#}
|
||||
|
||||
#=== FUNCTION ================================================================
|
||||
# NAME: validate_time
|
||||
# PURPOSE: Validates a time in HH:MM:SS format
|
||||
@@ -1029,7 +1150,7 @@ sub make_date {
|
||||
}
|
||||
|
||||
#
|
||||
# Apply the day offset
|
||||
# Apply any day offset
|
||||
#
|
||||
@date = Add_Delta_Days( @date, $offset ) if $offset;
|
||||
|
||||
@@ -1047,7 +1168,8 @@ sub make_date {
|
||||
# $end DateTime object containing the ending datetime
|
||||
# as UTC
|
||||
# $tz The textual time zone (need this to be valid)
|
||||
# RETURNS: A hash containing the timezone name and start and end times
|
||||
# RETURNS: Reference to a hash containing the timezone name and start and
|
||||
# end times
|
||||
# DESCRIPTION: Relies on DateTime::TimeZone to do the work to turn a UTC time
|
||||
# into a time in a different time zone. Uses the DateTime
|
||||
# strftime method to format the dates and times for printing.
|
||||
@@ -1076,49 +1198,15 @@ sub storeTZ {
|
||||
return \%result;
|
||||
}
|
||||
|
||||
#=== FUNCTION ================================================================
|
||||
# NAME: printTZ
|
||||
# PURPOSE: Print start/end times for a timezone
|
||||
# PARAMETERS: $fh File handle for writing
|
||||
# $start DateTime object containing the starting
|
||||
# datetime as UTC
|
||||
# $end DateTime object containing the ending datetime
|
||||
# as UTC
|
||||
# $tz The textual time zone (need this to be valid)
|
||||
# RETURNS: Nothing
|
||||
# DESCRIPTION: Relies on DateTime::TimeZone to do the work to turn a UTC time
|
||||
# into a time in a different time zone. Uses the DateTime
|
||||
# strftime method to format the dates and times for printing.
|
||||
# THROWS: No exceptions
|
||||
# COMMENTS: None
|
||||
# SEE ALSO:
|
||||
#===============================================================================
|
||||
sub printTZ {
|
||||
my ( $fh, $start, $end, $tz ) = @_;
|
||||
|
||||
#
|
||||
# Adjust time zone
|
||||
#
|
||||
$start->set_time_zone($tz);
|
||||
$end->set_time_zone($tz);
|
||||
|
||||
#
|
||||
# Print time zone and start/end times in that zone
|
||||
#
|
||||
print $fh "$tz\n";
|
||||
print $fh $start->strftime("Start: %H:%S %a, %b %d %Y\n");
|
||||
print $fh $end->strftime("End: %H:%S %a, %b %d %Y\n\n");
|
||||
|
||||
}
|
||||
|
||||
#=== FUNCTION ================================================================
|
||||
# NAME: day_offset
|
||||
# PURPOSE: Given a day name computes day attributes including the
|
||||
# (negative) offset in days from the target Monday to the
|
||||
# recording date.
|
||||
# (negative) offset in days from the target release day (Monday)
|
||||
# to the recording date.
|
||||
# PARAMETERS: $dayname Name of a day of the week
|
||||
# RETURNS: Hashref containing the full day name, the weekday number and
|
||||
# the integer offset from Monday to the recording day, or undef.
|
||||
# RETURNS: Hashref containing the full day name (dayname), the weekday
|
||||
# number (wday) and the integer offset (offset) from Monday to
|
||||
# the recording day, or undef.
|
||||
# DESCRIPTION: Uses the hash '%matches' keyed by regular expressions matching
|
||||
# day names. The argument '$dayname' is matched against each
|
||||
# regex in turn and if it matches the sub-hash is returned. This
|
||||
@@ -1239,14 +1327,13 @@ sub Options {
|
||||
my ($optref) = @_;
|
||||
|
||||
my @options = (
|
||||
"help", "documentation|man",
|
||||
"debug=i", "mail!",
|
||||
"fromaddress=s", "toaddress=s",
|
||||
"date=s", "starttime=s",
|
||||
"endtime=s", "month=s",
|
||||
"config=s", "dbconfig=s",
|
||||
"help", "documentation|man",
|
||||
"debug=i", "date=s",
|
||||
"starttime=s", "endtime=s",
|
||||
"month=s", "output:s",
|
||||
"config=s",
|
||||
);
|
||||
# "duration=s",
|
||||
# "mail!", "fromaddress=s", "toaddress=s", "duration=s",
|
||||
|
||||
if ( !GetOptions( $optref, @options ) ) {
|
||||
pod2usage( -msg => "Version $VERSION\n", -verbose => 0, -exitval => 1 );
|
||||
@@ -1264,20 +1351,20 @@ __END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
make_email - generates an HPR Community News recording invitation email
|
||||
make_email - generates the text of an HPR Community News recording invitation
|
||||
email
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
This documentation refers to make_email version 0.2.7
|
||||
This documentation refers to make_email version 0.3.3
|
||||
|
||||
|
||||
=head1 USAGE
|
||||
|
||||
make_email [-help] [-documentation] [-debug=N] [-month=DATE] [-[no]mail]
|
||||
[-from=FROM_ADDRESS] [-to=TO_ADDRESS] [-date=DATE] [-start=START_TIME]
|
||||
[-end=END_TIME] [-config=FILE] [-dbconfig=FILE]
|
||||
make_email [-help] [-documentation] [-debug=N] [-month=DATE] [-date=DATE]
|
||||
[-start=START_TIME] [-end=END_TIME] [-config=FILE]
|
||||
|
||||
./make_email -dbconf=$HOME/HPR/.hpr_livedb.cfg -date=2022-12-27
|
||||
./make_email -date=2022-12-27
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
@@ -1293,7 +1380,7 @@ Prints the entire embedded documentation for the program, then exits.
|
||||
|
||||
Another way to see the full documentation use:
|
||||
|
||||
B<perldoc ./make_email>
|
||||
perldoc ./make_email
|
||||
|
||||
=item B<-debug=N>
|
||||
|
||||
@@ -1351,30 +1438,6 @@ a ISO8601 date such as 2014-03-08 (meaning March 2014) or 1-Jan-2017 (meaning
|
||||
January 2017). Only the year and month parts are used but a valid day must be
|
||||
present.
|
||||
|
||||
=item B<-[no]mail>
|
||||
|
||||
** NOTE ** The sending of mail does not work at present, and B<-nomail> should
|
||||
always be used.
|
||||
|
||||
Causes mail to be sent (B<-mail>) or not sent (B<-nomail>). If the mail is
|
||||
sent then it is sent via the local MTA (in the assumption that there is one).
|
||||
If this option is omitted, the default is B<-nomail>, in which case the
|
||||
message is appended to the file B<mailer.testfile> in the current directory.
|
||||
|
||||
=item B<-from=FROM_ADDRESS>
|
||||
|
||||
** NOTE ** The sending of mail does not work at present.
|
||||
|
||||
This option defines the address from which the message is to be sent. This
|
||||
address is used in the message header; the message envelope will contain the
|
||||
I<real> sender.
|
||||
|
||||
=item B<-to=TO_ADDRESS>
|
||||
|
||||
** NOTE ** The sending of mail does not work at present.
|
||||
|
||||
This option defines the address to which the message is to be sent.
|
||||
|
||||
=item B<-date=DATE>
|
||||
|
||||
This is an option provides a non-default date for the recording. Normally the
|
||||
@@ -1405,30 +1468,35 @@ The default end time is defined in the configuration file, but if it is
|
||||
necessary to change it temporarily, this option can be used to do it. The
|
||||
B<END_TIME> value must be a valid B<HH:MM> time specification.
|
||||
|
||||
=item B<-output=FILE>
|
||||
|
||||
This option defines an output file to receive the mail message text. If the option is
|
||||
omitted the notes are written to STDOUT, allowing them to be redirected if
|
||||
required.
|
||||
|
||||
The output file name may contain the characters 'B<%s>'. This denotes the point
|
||||
at which the year and month in the format B<YYYY-MM> are inserted. For example
|
||||
if the script is being run for February 2025 the option:
|
||||
|
||||
-out=HPR_email_%s.txt
|
||||
|
||||
will cause the generation of the file:
|
||||
|
||||
HPR_email_2025-02.txt
|
||||
|
||||
=item B<-config=FILE>
|
||||
|
||||
This option defines a configuration file other than the default
|
||||
B<.make_email.cfg>. The file must be formatted as described below in the
|
||||
section I<CONFIGURATION AND ENVIRONMENT>.
|
||||
|
||||
=item B<-dbconfig=FILE>
|
||||
|
||||
This option defines a database configuration file other than the default
|
||||
B<.hpr_db.cfg>. The file must be formatted as described below in the section
|
||||
I<CONFIGURATION AND ENVIRONMENT>.
|
||||
|
||||
The default file is configured to open a local copy of the HPR database. An
|
||||
alternative is B<.hpr_livedb.cfg> which assumes an SSH tunnel to the live
|
||||
database and attempts to connect to it. Use the script I<open_tunnel> to open
|
||||
the SSH tunnel.
|
||||
|
||||
=back
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Makes and sends(*) an invitation email for the next Community News with times per
|
||||
timezone. The message is structured by a Template Toolkit template, so its
|
||||
content can be adjusted without changing this script.
|
||||
Makes an invitation email for the next Community News with times per timezone.
|
||||
The message is structured by a Template Toolkit template, so its contents can
|
||||
be adjusted without changing this script.
|
||||
|
||||
In normal operation the script computes the date of the next recording using
|
||||
the algorithm "Saturday before the first Monday of the next month" starting
|
||||
@@ -1446,9 +1514,6 @@ seen as the shows are visited and discussed.
|
||||
The email generated by the script is sent to the HPR mailing list, usually on
|
||||
the Monday prior to the weekend of the recording.
|
||||
|
||||
Notes:
|
||||
* Mail sending does not work at present.
|
||||
|
||||
=head1 DIAGNOSTICS
|
||||
|
||||
=over 8
|
||||
@@ -1496,11 +1561,6 @@ The month specified in B<-month=DATE> is in the past.
|
||||
|
||||
The program can generate warning messages from the Template.
|
||||
|
||||
=item B<Couldn't send message: ...>
|
||||
|
||||
The email mesage has been constructed but could not be sent. See the error
|
||||
returned by the mail subsystem for more information.
|
||||
|
||||
=back
|
||||
|
||||
=head1 CONFIGURATION AND ENVIRONMENT
|
||||
@@ -1524,31 +1584,64 @@ needs to contain the following data:
|
||||
|
||||
=head2 DATABASE CONFIGURATION
|
||||
|
||||
The program obtains the credentials it requires for connecting to the HPR
|
||||
database by loading them from a configuration file. The default file is called
|
||||
B<.hpr_db.cfg> and should contain the following data:
|
||||
The program also obtains the details it requires for connecting to a SQLite
|
||||
copy of the HPR database by loading them from the same configuration file in
|
||||
a separate section. The data is as follows:
|
||||
|
||||
<database>
|
||||
host = 127.0.0.1
|
||||
port = PORT
|
||||
name = DBNAME
|
||||
user = USER
|
||||
password = PASSWORD
|
||||
</database>
|
||||
|
||||
The file B<.hpr_livedb.cfg> should be available to allow access to the
|
||||
database over an SSH tunnel which has been previously opened.
|
||||
=head2 DATE CACHE
|
||||
|
||||
<recdates>
|
||||
name = recording_dates.dat
|
||||
</recdates>
|
||||
|
||||
The program will update a cache of recording dates and times per month. This
|
||||
is useful for the script B<make_shownotes> which needs to know about the
|
||||
Community News show recording time so it can determine how to display
|
||||
information about comments. See the details for this script.
|
||||
|
||||
The format of the lines in the file is:
|
||||
|
||||
MONTH,TIMESTAMP
|
||||
|
||||
Note the separating comma. The month is an ISO8601 date where the day part is
|
||||
always B<01>. The timestamp part is the date and time of the recording in the
|
||||
format:
|
||||
|
||||
YYYY-MM-DD HH:MM:SS
|
||||
|
||||
For example:
|
||||
|
||||
2024-12-01,2025-01-03 15:00:00
|
||||
2025-01-01,2025-01-31 15:00:00
|
||||
2025-02-01,2025-02-28 16:00:00
|
||||
|
||||
The dates and times are derived from the configuration file defaults (and those
|
||||
computed in the script), or the options given when running the script.
|
||||
|
||||
The contents of this cache are loaded into the B<make_email> script. If there
|
||||
is no record for the month being processed, one is appended to the file. If
|
||||
the details already exist they are updated unless they are the same as those
|
||||
stored.
|
||||
|
||||
A backup of the file is made if the data in a record is being updated.
|
||||
|
||||
=head1 DEPENDENCIES
|
||||
|
||||
Config::General
|
||||
Cwd
|
||||
DBI
|
||||
Data::Dumper
|
||||
Date::Calc
|
||||
Date::Parse
|
||||
DateTime
|
||||
DateTime::Format::Duration
|
||||
DateTime::TimeZone
|
||||
File::Copy
|
||||
Getopt::Long
|
||||
Mail::Mailer
|
||||
Pod::Usage
|
||||
Template
|
||||
|
||||
@@ -1560,7 +1653,7 @@ Patches are welcome.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Dave Morriss (Dave.Morriss@gmail.com) 2013 - 2024
|
||||
Dave Morriss (Dave.Morriss@gmail.com) 2013 - 2025
|
||||
|
||||
=head1 LICENCE AND COPYRIGHT
|
||||
|
||||
|
Reference in New Issue
Block a user