paulj/hpr-tools
1
0
Fork 0
forked from HPR/hpr-tools
Code Pull Requests Activity
Files
e3e458b2d29a2f9107d643de52970911ea118692
hpr-tools/Community_News/make_email

1579 lines
44 KiB
Perl
Executable File
Raw Blame History

#!/usr/bin/env perl
#===============================================================================
#
# 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]
#
# DESCRIPTION: Make and send 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
# 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
# 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
#
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
# VERSION: 0.2.7
# CREATED: 2013-10-28 20:35:22
# REVISION: 2024-05-24 18:53:17
#
#===============================================================================
use 5.010;
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use Config::General;
use Date::Parse;
use DateTime;
use DateTime::TimeZone;
use DateTime::Format::Duration;
use Date::Calc qw{:all};
use Template;
use Mail::Mailer;
use DBI;
use Data::Dumper;
#
# Version number (manually incremented)
#
our $VERSION = '0.2.7';
#
# Script name
#
( my $PROG = $0 ) =~ s|.*/||mx;
#-------------------------------------------------------------------------------
# Declarations
#-------------------------------------------------------------------------------
#
# Constants and other declarations
#
my $basedir = "$ENV{HOME}/HPR/Community_News";
my $configfile1 = "$basedir/.${PROG}.cfg";
my $configfile2 = "$basedir/.hpr_db.cfg";
my ( $dbh, $sth1, $sth2, $sth3, $h1, $h2, $rv );
#
# The timezones we want to report. These were generated with
# DateTime::TimeZone->all_names(). Just uncomment the desired elements.
#
my @zones = (
#{{{
#'Africa/Abidjan',
#'Africa/Accra',
#'Africa/Addis_Ababa',
#'Africa/Algiers',
#'Africa/Asmara',
#'Africa/Bamako',
#'Africa/Bangui',
#'Africa/Banjul',
#'Africa/Bissau',
#'Africa/Blantyre',
#'Africa/Brazzaville',
#'Africa/Bujumbura',
#'Africa/Cairo',
#'Africa/Casablanca',
#'Africa/Ceuta',
#'Africa/Conakry',
#'Africa/Dakar',
#'Africa/Dar_es_Salaam',
#'Africa/Djibouti',
#'Africa/Douala',
#'Africa/El_Aaiun',
#'Africa/Freetown',
#'Africa/Gaborone',
#'Africa/Harare',
#'Africa/Johannesburg',
#'Africa/Kampala',
#'Africa/Khartoum',
#'Africa/Kigali',
#'Africa/Kinshasa',
#'Africa/Lagos',
#'Africa/Libreville',
#'Africa/Lome',
#'Africa/Luanda',
#'Africa/Lubumbashi',
#'Africa/Lusaka',
#'Africa/Malabo',
#'Africa/Maputo',
#'Africa/Maseru',
#'Africa/Mbabane',
#'Africa/Mogadishu',
#'Africa/Monrovia',
#'Africa/Nairobi',
#'Africa/Ndjamena',
#'Africa/Niamey',
#'Africa/Nouakchott',
#'Africa/Ouagadougou',
#'Africa/Porto-Novo',
#'Africa/Sao_Tome',
#'Africa/Tripoli',
#'Africa/Tunis',
#'Africa/Windhoek',
#'America/Adak',
#'America/Anchorage',
#'America/Antigua',
#'America/Araguaina',
#'America/Argentina/Buenos_Aires',
#'America/Argentina/Catamarca',
#'America/Argentina/Cordoba',
#'America/Argentina/Jujuy',
#'America/Argentina/La_Rioja',
#'America/Argentina/Mendoza',
#'America/Argentina/Rio_Gallegos',
#'America/Argentina/Salta',
#'America/Argentina/San_Juan',
#'America/Argentina/San_Luis',
#'America/Argentina/Tucuman',
#'America/Argentina/Ushuaia',
#'America/Asuncion',
#'America/Atikokan',
#'America/Bahia',
#'America/Bahia_Banderas',
#'America/Barbados',
#'America/Belem',
#'America/Belize',
#'America/Blanc-Sablon',
#'America/Boa_Vista',
#'America/Bogota',
#'America/Boise',
#'America/Cambridge_Bay',
#'America/Campo_Grande',
#'America/Cancun',
#'America/Caracas',
#'America/Cayenne',
#'America/Cayman',
'America/Chicago',
#'America/Chihuahua',
#'America/Costa_Rica',
#'America/Creston',
#'America/Cuiaba',
#'America/Curacao',
#'America/Danmarkshavn',
#'America/Dawson',
#'America/Dawson_Creek',
#'America/Denver',
#'America/Detroit',
#'America/Edmonton',
#'America/Eirunepe',
#'America/El_Salvador',
#'America/Fortaleza',
#'America/Glace_Bay',
#'America/Godthab',
#'America/Goose_Bay',
#'America/Grand_Turk',
#'America/Guatemala',
#'America/Guayaquil',
#'America/Guyana',
#'America/Halifax',
#'America/Havana',
#'America/Hermosillo',
#'America/Indiana/Indianapolis',
#'America/Indiana/Knox',
#'America/Indiana/Marengo',
#'America/Indiana/Petersburg',
#'America/Indiana/Tell_City',
#'America/Indiana/Vevay',
#'America/Indiana/Vincennes',
#'America/Indiana/Winamac',
#'America/Inuvik',
#'America/Iqaluit',
#'America/Jamaica',
#'America/Juneau',
#'America/Kentucky/Louisville',
#'America/Kentucky/Monticello',
#'America/La_Paz',
#'America/Lima',
'America/Los_Angeles',
#'America/Maceio',
#'America/Managua',
#'America/Manaus',
#'America/Martinique',
#'America/Matamoros',
#'America/Mazatlan',
#'America/Menominee',
#'America/Merida',
#'America/Metlakatla',
#'America/Mexico_City',
#'America/Miquelon',
#'America/Moncton',
#'America/Monterrey',
#'America/Montevideo',
#'America/Montreal',
#'America/Nassau',
'America/New_York',
#'America/Nipigon',
#'America/Nome',
#'America/Noronha',
#'America/North_Dakota/Beulah',
#'America/North_Dakota/Center',
#'America/North_Dakota/New_Salem',
#'America/Ojinaga',
#'America/Panama',
#'America/Pangnirtung',
#'America/Paramaribo',
#'America/Phoenix',
#'America/Port-au-Prince',
#'America/Port_of_Spain',
#'America/Porto_Velho',
#'America/Puerto_Rico',
#'America/Rainy_River',
#'America/Rankin_Inlet',
#'America/Recife',
#'America/Regina',
#'America/Resolute',
#'America/Rio_Branco',
#'America/Santa_Isabel',
#'America/Santarem',
#'America/Santiago',
#'America/Santo_Domingo',
#'America/Sao_Paulo',
#'America/Scoresbysund',
#'America/Sitka',
#'America/St_Johns',
#'America/Swift_Current',
#'America/Tegucigalpa',
#'America/Thule',
#'America/Thunder_Bay',
#'America/Tijuana',
#'America/Toronto',
#'America/Vancouver',
#'America/Whitehorse',
#'America/Winnipeg',
#'America/Yakutat',
#'America/Yellowknife',
#'Antarctica/Casey',
#'Antarctica/Davis',
#'Antarctica/DumontDUrville',
#'Antarctica/Macquarie',
#'Antarctica/Mawson',
#'Antarctica/Palmer',
#'Antarctica/Rothera',
#'Antarctica/Syowa',
#'Antarctica/Vostok',
#'Asia/Aden',
#'Asia/Almaty',
#'Asia/Amman',
#'Asia/Anadyr',
#'Asia/Aqtau',
#'Asia/Aqtobe',
#'Asia/Ashgabat',
#'Asia/Baghdad',
#'Asia/Bahrain',
#'Asia/Baku',
#'Asia/Bangkok',
#'Asia/Beirut',
#'Asia/Bishkek',
#'Asia/Brunei',
#'Asia/Choibalsan',
#'Asia/Chongqing',
#'Asia/Colombo',
#'Asia/Damascus',
#'Asia/Dhaka',
#'Asia/Dili',
#'Asia/Dubai',
#'Asia/Dushanbe',
#'Asia/Gaza',
#'Asia/Harbin',
#'Asia/Hebron',
#'Asia/Ho_Chi_Minh',
'Asia/Hong_Kong',
#'Asia/Hovd',
#'Asia/Irkutsk',
#'Asia/Jakarta',
#'Asia/Jayapura',
#'Asia/Jerusalem',
#'Asia/Kabul',
#'Asia/Kamchatka',
#'Asia/Karachi',
#'Asia/Kashgar',
#'Asia/Kathmandu',
#'Asia/Khandyga',
#'Asia/Kolkata',
#'Asia/Krasnoyarsk',
#'Asia/Kuala_Lumpur',
#'Asia/Kuching',
#'Asia/Kuwait',
#'Asia/Macau',
#'Asia/Magadan',
#'Asia/Makassar',
#'Asia/Manila',
#'Asia/Muscat',
#'Asia/Nicosia',
#'Asia/Novokuznetsk',
#'Asia/Novosibirsk',
#'Asia/Omsk',
#'Asia/Oral',
#'Asia/Phnom_Penh',
#'Asia/Pontianak',
#'Asia/Pyongyang',
#'Asia/Qatar',
#'Asia/Qyzylorda',
#'Asia/Rangoon',
#'Asia/Riyadh',
#'Asia/Sakhalin',
#'Asia/Samarkand',
#'Asia/Seoul',
#'Asia/Shanghai',
#'Asia/Singapore',
#'Asia/Taipei',
#'Asia/Tashkent',
#'Asia/Tbilisi',
#'Asia/Tehran',
#'Asia/Thimphu',
#'Asia/Tokyo',
#'Asia/Ulaanbaatar',
#'Asia/Urumqi',
#'Asia/Ust-Nera',
#'Asia/Vientiane',
#'Asia/Vladivostok',
#'Asia/Yakutsk',
#'Asia/Yekaterinburg',
#'Asia/Yerevan',
#'Atlantic/Azores',
#'Atlantic/Bermuda',
#'Atlantic/Canary',
#'Atlantic/Cape_Verde',
#'Atlantic/Faroe',
#'Atlantic/Madeira',
#'Atlantic/Reykjavik',
#'Atlantic/South_Georgia',
#'Atlantic/St_Helena',
#'Atlantic/Stanley',
#'Australia/Adelaide',
'Australia/Brisbane',
#'Australia/Broken_Hill',
#'Australia/Currie',
#'Australia/Darwin',
#'Australia/Eucla',
#'Australia/Hobart',
#'Australia/Lindeman',
#'Australia/Lord_Howe',
#'Australia/Melbourne',
'Australia/Perth',
'Australia/Sydney',
#'CET',
#'CST6CDT',
#'EET',
#'EST',
#'EST5EDT',
'Europe/Amsterdam',
#'Europe/Andorra',
#'Europe/Athens',
#'Europe/Belgrade',
#'Europe/Berlin',
#'Europe/Brussels',
#'Europe/Bucharest',
#'Europe/Budapest',
#'Europe/Chisinau',
#'Europe/Copenhagen',
#'Europe/Dublin',
#'Europe/Gibraltar',
#'Europe/Helsinki',
#'Europe/Istanbul',
#'Europe/Kaliningrad',
#'Europe/Kiev',
#'Europe/Lisbon',
'Europe/London',
#'Europe/Luxembourg',
#'Europe/Madrid',
#'Europe/Malta',
#'Europe/Minsk',
#'Europe/Monaco',
#'Europe/Moscow',
#'Europe/Oslo',
#'Europe/Paris',
#'Europe/Prague',
#'Europe/Riga',
#'Europe/Rome',
#'Europe/Samara',
#'Europe/Simferopol',
#'Europe/Sofia',
#'Europe/Stockholm',
#'Europe/Tallinn',
#'Europe/Tirane',
#'Europe/Uzhgorod',
#'Europe/Vienna',
#'Europe/Vilnius',
#'Europe/Volgograd',
#'Europe/Warsaw',
#'Europe/Zaporozhye',
'Europe/Zurich',
#'HST',
#'Indian/Antananarivo',
#'Indian/Chagos',
#'Indian/Christmas',
#'Indian/Cocos',
#'Indian/Comoro',
#'Indian/Kerguelen',
#'Indian/Mahe',
#'Indian/Maldives',
#'Indian/Mauritius',
#'Indian/Mayotte',
#'Indian/Reunion',
#'MET',
#'MST',
#'MST7MDT',
#'PST8PDT',
#'Pacific/Apia',
'Pacific/Auckland',
#'Pacific/Chatham',
#'Pacific/Chuuk',
#'Pacific/Easter',
#'Pacific/Efate',
#'Pacific/Enderbury',
#'Pacific/Fakaofo',
#'Pacific/Fiji',
#'Pacific/Funafuti',
#'Pacific/Galapagos',
#'Pacific/Gambier',
#'Pacific/Guadalcanal',
#'Pacific/Guam',
#'Pacific/Honolulu',
#'Pacific/Kiritimati',
#'Pacific/Kosrae',
#'Pacific/Kwajalein',
#'Pacific/Majuro',
#'Pacific/Marquesas',
#'Pacific/Midway',
#'Pacific/Nauru',
#'Pacific/Niue',
#'Pacific/Norfolk',
#'Pacific/Noumea',
#'Pacific/Pago_Pago',
#'Pacific/Palau',
#'Pacific/Pitcairn',
#'Pacific/Pohnpei',
#'Pacific/Port_Moresby',
#'Pacific/Rarotonga',
#'Pacific/Saipan',
#'Pacific/Tahiti',
#'Pacific/Tarawa',
#'Pacific/Tongatapu',
#'Pacific/Wake',
#'Pacific/Wallis',
'UTC',
#'WET',
#}}}
);
#
# 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
#
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{'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 $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' );
#
# Sanity checking the options
#
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
#-------------------------------------------------------------------------------
my $conf = new Config::General(
-ConfigFile => $cfgfile,
-InterPolateVars => 1,
-ExtendedAccess => 1
);
my %config = $conf->getall();
#print Dumper( \%config ), "\n";
#
# 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
#
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';
#
# If we had a start time specified then check it and ensure the end time makes
# sense. Otherwise use the configuration file defaults, but don't check them.
#
if ($start) {
#
# Check start time and add a seconds field if needed
#
$start = validate_time($start);
#
# The end time usually needs to be 2 hours from the start if not
# specified. The actual duration is specified in the configuration file
# (with a default above).
#
unless ($end) {
my @end = split( ':', $start );
$end[0] += $duration;
$end = join(':',@end);
}
#
# Check and add a seconds field if needed
#
$end = validate_time($end);
}
else {
$start = $config{email}->{starttime};
$end = $config{email}->{endtime};
}
#
# Start and end times from options or the configuration file
#
my @starttime = split( ':', $start );
my @endtime = split( ':', $end );
die "Missing start/end time(s)\n" unless ( @starttime && @endtime );
my $template = $config{email}->{template};
die "Missing template file $template\n" unless (-e $template);
_debug($DEBUG >= 2,
'$start: ' . coalesce($start,''),
'$end: ' . coalesce($end,''),
'--'
);
if ($DEBUG >= 1) {
report_settings();
}
#-------------------------------------------------------------------------------
# Connect to the database
# 2021-12-24: moved to MariaDB
# 2022-02-28: the MariaDB driver has gone away apparently. Reverted to MySQL
# again
#-------------------------------------------------------------------------------
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;
$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;
#
# Date and time values using Date::Calc format
#
my @today = Today();
my @startdate;
my @startmonth;
my @reviewdate;
my $monday = 1; # Day of week number 1-7, Monday-Sunday
my $offset = day_offset($dayname)->{offset};
#-------------------------------------------------------------------------------
# Work out the start date from the -date=DATE option, the -month=DATE option
# or the current date.
#-------------------------------------------------------------------------------
#
# If there's an argument then it'll be an override for the start date
# otherwise we'll compute it.
#
if ( defined($date) ) {
#
# Parse and perform rudimentary validation on the argument
#
my @parsed = strptime($date);
die "Invalid -date=DATE option '$date'\n"
unless ( defined( $parsed[3] )
&& defined( $parsed[4] )
&& defined( $parsed[5] ) );
$parsed[5] += 1900;
$parsed[4] += 1;
@startdate = @parsed[ 5, 4, 3 ];
die "Date is in the past '$date'; aborting\n"
unless ( Date_to_Days(@startdate) > Date_to_Days(@today) );
}
elsif ( defined($month) ) {
#
# Parse the month out of the -month=DATE argument
#
my @parsed = strptime($month);
die "Invalid -month=DATE option '$month'\n"
unless ( defined( $parsed[3] )
&& defined( $parsed[4] )
&& defined( $parsed[5] ) );
$parsed[5] += 1900;
$parsed[4] += 1;
@startmonth = @parsed[ 5, 4, 3 ];
die "Date is in the past '$month'; aborting\n"
unless ( Date_to_Days(@startmonth) > Date_to_Days(@today) );
#
# Compute the next meeting date from now (by finding the next first Monday
# of the month then backing up two days to the Saturday).
#
@startdate = make_date( \@startmonth, $monday, 1, $offset );
}
else {
#
# Compute the next meeting date from now (by finding the next first Monday
# of the month then backing up a number of days to the required date).
#
@startdate = make_date( \@today, $monday, 1, $offset );
}
_debug($DEBUG >= 2, '@startdate: ' . join(',',@startdate));
#
# The month being reviewed is sometimes the same month and sometimes the month
# before.
#
if ( $startdate[1] eq $today[1] ) {
@reviewdate = @startdate;
}
else {
@reviewdate = Add_Delta_YM( @startdate, 0, -1 );
}
_debug($DEBUG >= 2, '@reviewdate: ' . join(',',@reviewdate));
#
# Transfer Date::Calc values into hashes for initialising DateTime objects so
# we can play time zone games
#
my ( %dtargs, $dtstart, $dtend );
@dtargs{ 'year', 'month', 'day', 'hour', 'minute', 'second', 'time_zone' }
= ( @startdate, @starttime, 'UTC' );
$dtstart = DateTime->new(%dtargs);
@dtargs{ 'hour', 'minute', 'second' } = (@endtime);
$dtend = DateTime->new(%dtargs);
#
# Compute the number of days until the recording
#
my $dtnow = DateTime->now( time_zone => 'UTC' );
my $dtoffset = $dtstart->delta_days($dtnow);
my $dtf = DateTime::Format::Duration->new( pattern => '%e' );
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)"),
);
_debug($DEBUG >= 2,
"\$year: $year",
"\$monthname: $monthname",
"\$nicedate: $nicedate",
"\$starttime: $starttime",
"\$endtime: $endtime"
);
#
# Build the subject line
#
my $waittime = ( $days > 6 ? "in $days days" : "next %A" );
my $next = ( $days > 6 ? '' : 'next ' );
my $forspec = ( $days > 6 ? "for $monthname " : "" );
my $subject = $dtstart->strftime(
"HPR Community News ${forspec}- $waittime on %FT%TZ");
_debug( $DEBUG >= 2, "\$subject: $subject" );
#
# Prepare to send mail
#
my $mailer = Mail::Mailer->new($mailertype);
#
# Generate the headers we need
#
$mailer->open(
{ To => $to_address,
From => $from_address,
Subject => $subject,
}
);
#
# Build an array of timezone data for the template
#
my @timezones;
for my $tz (@zones) {
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.
#-------------------------------------------------------------------------------
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->execute($isodate);
if ( $dbh->err ) {
warn $dbh->errstr;
}
_debug( $DEBUG >= 2, "\$isodate: $isodate" );
unless ( $h1 = $sth1->fetchrow_hashref ) {
warn "Unable to find a reserved show on the specified date - cannot continue\n";
exit 1;
}
my $shownotes = $h1->{id};
_debug( $DEBUG >= 2, "\$shownotes (slot): $shownotes" );
$sth1->finish;
$dbh->disconnect;
#-------------------------------------------------------------------------------
# Fill the template
#-------------------------------------------------------------------------------
my $tt = Template->new(
{ ABSOLUTE => 1,
ENCODING => 'utf8',
}
);
my $vars = {
# subject => $subject,
# from => $from_address,
# to => $to_address,
server => $server,
port => $port,
room => $room,
timezones => \@timezones,
utc => {
days => $days,
month => $monthname,
year => $year,
date => $nicedate,
start => $starttime,
end => $endtime,
},
shownotes => $shownotes,
};
my $document;
$tt->process( $template,
$vars, \$document, { binmode => ':utf8' } )
|| die $tt->error(), "\n";
#
# Add the template-generated body to the mail message
#
print $mailer $document;
#
# Send the message
#
$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";
}
exit;
#=== FUNCTION ================================================================
# NAME: report_settings
# PURPOSE: Report settings from options (or defaults)
# PARAMETERS: None
# RETURNS: Nothing
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
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');
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
# PARAMETERS: $time Time string
# RETURNS: The input string with any missing fields added in
# DESCRIPTION: The input time needs to be in the format HH:MM[:SS] where
# a missing seconds value is replaced with '00'. A regex check
# on the format is performed, and if that passes a check is made
# on the time values (using 'check_time').
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub validate_time {
my ($time) = (@_);
if ( defined($time) ) {
if ( ( my @fields )
= ( $time =~ /(\d{1,2}):(\d{1,2})(?::(\d{1,2}))?/ ) )
{
@fields = map { defined($_) ? sprintf('%02d',$_) : "00" } @fields;
$time = join( ':', @fields );
}
else {
die "Invalid time: $time\n";
}
unless ( check_time(split(':',$time)) ) {
die "Invalid time: $time\n";
}
}
return $time;
}
#=== 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
# $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: This function was originally written for my HPR episode on
# iCalendar.
# 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: storeTZ
# PURPOSE: Store start/end times for a timezone
# PARAMETERS: $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: 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.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub storeTZ {
my ( $start, $end, $tz ) = @_;
my %result;
#
# Adjust time zone
#
$start->set_time_zone($tz);
$end->set_time_zone($tz);
#
# Print time zone and start/end times in that zone
#
$result{name} = "$tz";
$result{start} = $start->strftime("%H:%S %a, %b %d %Y");
$result{end} = $end->strftime("%H:%S %a, %b %d %Y");
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.
# 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.
# 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
# allows the caller to use 'day_offset($dayname)->{dayname}' to
# get the full name of the day if needed, or the offset as
# 'day_offset($dayname)->{offset}'. If there is no match
# 'undef' is returned.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub day_offset {
my ( $dayname ) = @_;
my %matches = (
qr{^(?i)Sun(day)?$} => {
dayname => 'Sunday',
wday => 7,
offset => -1,
},
qr{^(?i)Sat(urday)?$} => {
dayname => 'Saturday',
wday => 6,
offset => -2,
},
qr{^(?i)Fri(day)?$} => {
dayname => 'Friday',
wday => 5,
offset => -3,
},
qr{^(?i)Thu(rsday)?$} => {
dayname => 'Thursday',
wday => 4,
offset => -4,
},
qr{^(?i)Wed(nesday)?$} => {
dayname => 'Wednesday',
wday => 3,
offset => -5,
},
qr{^(?i)Tue(sday)?$} => {
dayname => 'Tuesday',
wday => 2,
offset => -6,
},
qr{^(?i)Mon(day)?$} => {
dayname => 'Monday',
wday => 1,
offset => -7,
},
);
my $match;
foreach my $re (keys(%matches)) {
if ($dayname =~ $re) {
$match = $matches{$re};
last;
}
}
return $match;
}
#=== FUNCTION ================================================================
# NAME: _debug
# PURPOSE: Prints debug reports
# PARAMETERS: $active Boolean: 1 for print, 0 for no print
# $messages... Arbitrary list of messages to print
# RETURNS: Nothing
# DESCRIPTION: Outputs messages if $active is true. It removes any trailing
# newline from each one and then adds one in the 'print' to the
# caller doesn't have to bother. Prepends each message with 'D>'
# to show it's a debug message.
# THROWS: No exceptions
# COMMENTS: Differs from other functions of the same name
# SEE ALSO: N/A
#===============================================================================
sub _debug {
my $active = shift;
my $message;
return unless $active;
while ($message = shift) {
chomp($message);
print STDERR "D> $message\n";
}
}
#=== FUNCTION ================================================================
# NAME: coalesce
# PURPOSE: To find the first defined argument and return it
# PARAMETERS: Arbitrary number of arguments
# RETURNS: The first defined argument or undef if there are none
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub coalesce {
foreach (@_) {
return $_ if defined($_);
}
return undef; ## no critic
}
#=== FUNCTION ================================================================
# NAME: Options
# PURPOSE: Processes command-line options
# PARAMETERS: $optref Hash reference to hold the options
# RETURNS: Undef
# DESCRIPTION:
# THROWS: no exceptions
# COMMENTS: none
# SEE ALSO: n/a
#===============================================================================
sub Options {
my ($optref) = @_;
my @options = (
"help", "documentation|man",
"debug=i", "mail!",
"fromaddress=s", "toaddress=s",
"date=s", "starttime=s",
"endtime=s", "month=s",
"config=s", "dbconfig=s",
);
# "duration=s",
if ( !GetOptions( $optref, @options ) ) {
pod2usage( -msg => "Version $VERSION\n", -verbose => 0, -exitval => 1 );
}
return;
}
__END__
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Application Documentation
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#{{{
=head1 NAME
make_email - generates an HPR Community News recording invitation email
=head1 VERSION
This documentation refers to make_email version 0.2.7
=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 -dbconf=$HOME/HPR/.hpr_livedb.cfg -date=2022-12-27
=head1 OPTIONS
=over 8
=item B<-help>
Prints a brief help message describing the usage of the program, and then exits.
=item B<-documentation> B<-man>
Prints the entire embedded documentation for the program, then exits.
Another way to see the full documentation use:
B<perldoc ./make_email>
=item B<-debug=N>
Enables debugging mode when N > 0 (zero is the default, no debugging output).
The levels are:
Values are:
=over 4
=item 1
Reports all of the settings taken from the configuration file, the provided
command line options or their default values. The report is generated early on
in the processing of these values. Use B<-debug=2> for information about the
next stages.
=item 2
Reports the following (as well as the data for level 1):
=over 4
=item .
Details of the start date chosen
=item .
Details of the year, name of month, readable date, and recording start and end
times.
=item .
The subject line chosen for the email.
=item .
The date of the show being searched for in the database.
=item .
The number of the show found in the database.
=back
=back
=item B<-month=DATE>
Defines the month for which the email will be generated using a date in that
month. Normally (without this option) the current month is chosen and the date
of recording computed within it. The month specified here is provided as
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
script computes the next scheduled date based on the algorithm "DAY_OF_WEEK
before the first Monday of the next month" (where DAY_OF_WEEK is the value
defined in the configuration file as B<dayname>) starting from the current
date or the start of the month given in the B<-month=DATE> option. If for any
reason a different date is required then this may be specified via this
option.
The recording date should be given as an ISO8601 date (such as 2014-03-08).
=item B<-start=START_TIME>
The default start time is defined in the configuration file, but if it is
necessary to change it, this option can be used to do it. The B<START_TIME>
value must be a valid B<HH:MM> time specification.
A change to the start time in the configuration file also implies that the end
time should change. If the B<-start=START_TIME> option is present but
B<-end=END_TIME> is not, then the end time is computed by adding a number of
hours to the start time this number is defined in the configuration file as
B<duration>.
=item B<-end=END_TIME>
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<-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.
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
from the current date or the start of the month (and year) given in the
B<-month=DATE> option.
It uses the recording date (B<-date=DATE> option) to access the MySQL database
to find the date on which the show will be released. It does that so the notes
on that show can be viewed by the volunteers recording the show. These notes
are expanded to be usable during the recording, with comments relating to
earlier shows being displayed in full, and any comments missed in the last
recording highlighted. Comments made to shows during the past month can be
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
=item B<Unable to find ...>
The configuration file specified in B<-config=FILE> (or the default file)
could not be found.
=item B<Use only one of -month=MONTH or -date=DATE>
These options are mutually exclusive. See their specifications earlier in this
document.
=item B<Missing start/end time(s)>
One or both of the start and end times is missing, either from the configuration file or
from the command line options.
=item B<Missing template file ...>
The template file specified in the configuration file could not be found.
=item B<Various database messages>
The program can generate warning messages from the database.
=item B<Invalid -date=DATE option '...'>
An invalid date has been supplied via this option.
=item B<Date is in the past '...'>
The date specified in B<-date=DATE> is in the past.
=item B<Invalid -month=DATE option '...'>
An invalid date has been supplied via this option.
=item B<Date is in the past '...'>
The month specified in B<-month=DATE> is in the past.
=item B<Various Template Toolkit messages>
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
=head2 EMAIL CONFIGURATION
The program obtains the settings it requires for preparing the email from
a configuration file, which by default is called B<.make_email.cfg>. This file
needs to contain the following data:
<email>
server = MUMBLE_SERVER_NAME
port = MUMBLE_PORT
room = NAME_OF_ROOM
dayname = DAY_OF_WEEK_OF_RECORDING
starttime = 18:00:00
endtime = 20:00:00
duration = 02 # hours
template = NAME_OF_TEMPLATE
</email>
=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:
<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.
=head1 DEPENDENCIES
DBI
Date::Calc
Date::Parse
DateTime
DateTime::Format::Duration
DateTime::TimeZone
Getopt::Long
Mail::Mailer
Pod::Usage
Template
=head1 BUGS AND LIMITATIONS
There are no known bugs in this script.
Please report problems to Dave Morriss (Dave.Morriss@gmail.com)
Patches are welcome.
=head1 AUTHOR
Dave Morriss (Dave.Morriss@gmail.com) 2013 - 2024
=head1 LICENCE AND COPYRIGHT
Copyright (c) Dave Morriss (Dave.Morriss@gmail.com). All rights reserved.
This program is free software. You can redistribute it and/or modify it under
the same terms as perl itself.
=cut
#}}}
# [zo to open fold, zc to close]
# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
View Git Blame Copy Permalink