2024-06-04 16:35:44 +01:00
|
|
|
#!/usr/bin/env perl
|
|
|
|
#===============================================================================
|
|
|
|
#
|
|
|
|
# FILE: make_email
|
|
|
|
#
|
2025-03-31 21:59:14 +01:00
|
|
|
# USAGE: ./make_email [-debug=N] [-month=DATE] [-date=DATE]
|
|
|
|
# [-start=START_TIME] [-end=END_TIME] [-output[=FILE]]
|
|
|
|
# [-config=FILE]
|
2024-06-04 16:35:44 +01:00
|
|
|
#
|
2025-03-31 21:59:14 +01:00
|
|
|
# DESCRIPTION: Make an invitation email for the next Community News
|
2024-06-04 16:35:44 +01:00
|
|
|
# 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
|
2025-03-31 21:59:14 +01:00
|
|
|
# current month (Friday before the first Monday of the month
|
2024-06-04 16:35:44 +01:00
|
|
|
# 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
|
2025-03-31 21:59:14 +01:00
|
|
|
# -month=DATE option, though this is rarely used. Use a date of
|
2024-06-04 16:35:44 +01:00
|
|
|
# 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.
|
|
|
|
#
|
|
|
|
# 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
|
2025-03-31 21:59:14 +01:00
|
|
|
# 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.
|
2024-06-04 16:35:44 +01:00
|
|
|
#
|
|
|
|
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
|
2025-03-31 21:59:14 +01:00
|
|
|
# VERSION: 0.3.3
|
2024-06-04 16:35:44 +01:00
|
|
|
# CREATED: 2013-10-28 20:35:22
|
2025-03-31 21:59:14 +01:00
|
|
|
# REVISION: 2025-02-28 14:40:28
|
2024-06-04 16:35:44 +01:00
|
|
|
#
|
|
|
|
#===============================================================================
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
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 );
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
use Getopt::Long;
|
|
|
|
use Pod::Usage;
|
|
|
|
|
|
|
|
use Config::General;
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
use File::Copy;
|
|
|
|
|
2024-06-04 16:35:44 +01:00
|
|
|
use Date::Parse;
|
|
|
|
|
|
|
|
use DateTime;
|
|
|
|
use DateTime::TimeZone;
|
|
|
|
use DateTime::Format::Duration;
|
|
|
|
|
|
|
|
use Date::Calc qw{:all};
|
|
|
|
|
|
|
|
use Template;
|
|
|
|
|
|
|
|
use DBI;
|
|
|
|
|
|
|
|
use Data::Dumper;
|
|
|
|
|
|
|
|
#
|
|
|
|
# Version number (manually incremented)
|
|
|
|
#
|
2025-03-31 21:59:14 +01:00
|
|
|
our $VERSION = '0.3.3';
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
#
|
|
|
|
# Script name
|
|
|
|
#
|
|
|
|
( my $PROG = $0 ) =~ s|.*/||mx;
|
|
|
|
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
# Declarations
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
#
|
|
|
|
# Constants and other declarations
|
|
|
|
#
|
2025-03-31 21:59:14 +01:00
|
|
|
( my $basedir = abs_path($0) ) =~ s|/?[^/]*$||mx;
|
|
|
|
my $configfile = "$basedir/.${PROG}.cfg";
|
2024-06-04 16:35:44 +01:00
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
my ( $dbh, $sth1, $h1, $h2, $rv );
|
|
|
|
my ( %recdates, $rdfh );
|
|
|
|
|
|
|
|
#
|
|
|
|
# Run in the script's directory
|
|
|
|
#
|
|
|
|
chdir($basedir);
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
#
|
|
|
|
# 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',
|
|
|
|
#}}}
|
|
|
|
);
|
|
|
|
|
|
|
|
#
|
|
|
|
# Defaults for options
|
|
|
|
#
|
|
|
|
my $DEF_DEBUG = 0;
|
|
|
|
|
|
|
|
#
|
|
|
|
# Options and arguments
|
|
|
|
#
|
|
|
|
my %options;
|
|
|
|
Options( \%options );
|
|
|
|
|
|
|
|
#
|
|
|
|
# Default help
|
|
|
|
#
|
|
|
|
pod2usage( -msg => "$PROG version $VERSION\n", -verbose => 0, -exitval => 1 )
|
|
|
|
if ( $options{'help'} );
|
|
|
|
|
|
|
|
#
|
2025-03-31 21:59:14 +01:00
|
|
|
# Full documentation if requested with -doc[umentation] or -man
|
2024-06-04 16:35:44 +01:00
|
|
|
#
|
|
|
|
pod2usage(
|
|
|
|
-msg => "$PROG version $VERSION\n",
|
|
|
|
-verbose => 2,
|
|
|
|
-exitval => 1,
|
|
|
|
) if ( $options{'documentation'} );
|
|
|
|
|
|
|
|
#
|
|
|
|
# Collect options
|
|
|
|
#
|
2025-03-31 21:59:14 +01:00
|
|
|
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};
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
my $cfgfile
|
2025-03-31 21:59:14 +01:00
|
|
|
= ( defined( $options{config} ) ? $options{config} : $configfile );
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
#
|
|
|
|
# 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));
|
|
|
|
|
|
|
|
#-------------------------------------------------------------------------------
|
2025-03-31 21:59:14 +01:00
|
|
|
# Load configuration data
|
2024-06-04 16:35:44 +01:00
|
|
|
#-------------------------------------------------------------------------------
|
2025-03-31 21:59:14 +01:00
|
|
|
my $conf = Config::General->new(
|
2024-06-04 16:35:44 +01:00
|
|
|
-ConfigFile => $cfgfile,
|
|
|
|
-InterPolateVars => 1,
|
|
|
|
-ExtendedAccess => 1
|
|
|
|
);
|
|
|
|
my %config = $conf->getall();
|
2025-03-31 21:59:14 +01:00
|
|
|
_debug( $DEBUG >= 2, '%config: ' . Dumper( \%config ) );
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
#
|
2025-03-31 21:59:14 +01:00
|
|
|
# Configuration file values for the email text with defaults and/or checks
|
2024-06-04 16:35:44 +01:00
|
|
|
#
|
|
|
|
my $server = $config{email}->{server} // 'chatter.skyehaven.net';
|
|
|
|
my $port = $config{email}->{port} // 64738;
|
|
|
|
my $room = $config{email}->{room} // 'Hacker Public Radio';
|
2025-03-31 21:59:14 +01:00
|
|
|
my $duration = $config{email}->{duration} // 2; # Hours
|
|
|
|
my $dayname = $config{email}->{dayname} // 'Friday';
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
#
|
|
|
|
# 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 );
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
#
|
|
|
|
# The template from the configuration file
|
|
|
|
#
|
2024-06-04 16:35:44 +01:00
|
|
|
my $template = $config{email}->{template};
|
|
|
|
die "Missing template file $template\n" unless (-e $template);
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
#
|
|
|
|
# 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);
|
|
|
|
}
|
|
|
|
|
2024-06-04 16:35:44 +01:00
|
|
|
_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
|
2025-03-31 21:59:14 +01:00
|
|
|
# 2025-02-22: Converted to SQLite
|
2024-06-04 16:35:44 +01:00
|
|
|
#-------------------------------------------------------------------------------
|
2025-03-31 21:59:14 +01:00
|
|
|
my $dbname = $config{database}->{name};
|
2024-06-04 16:35:44 +01:00
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
$dbh = DBI->connect( "DBI:SQLite:dbname=$dbname",
|
|
|
|
"", "", { AutoCommit => 1 } );
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
#
|
|
|
|
# Enable client-side UTF8
|
|
|
|
#
|
2025-03-31 21:59:14 +01:00
|
|
|
$dbh->{sqlite_unicode} = 1;
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
#
|
|
|
|
# Date and time values using Date::Calc format
|
|
|
|
#
|
|
|
|
my @today = Today();
|
|
|
|
my @startdate;
|
|
|
|
my @startmonth;
|
|
|
|
my @reviewdate;
|
2025-03-31 21:59:14 +01:00
|
|
|
my $monday = 1; # Day of week number 1-7, Monday-Sunday
|
2024-06-04 16:35:44 +01:00
|
|
|
my $offset = day_offset($dayname)->{offset};
|
|
|
|
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
# Work out the start date from the -date=DATE option, the -month=DATE option
|
|
|
|
# or the current date.
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
#
|
2025-03-31 21:59:14 +01:00
|
|
|
# If there's a -date=DATE option then it'll be an override for the start date
|
2024-06-04 16:35:44 +01:00
|
|
|
# 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
|
2025-03-31 21:59:14 +01:00
|
|
|
# of the month then backing up two days to the desired day - default
|
|
|
|
# Friday).
|
2024-06-04 16:35:44 +01:00
|
|
|
#
|
|
|
|
@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] ) {
|
2025-03-31 21:59:14 +01:00
|
|
|
# Same month
|
2024-06-04 16:35:44 +01:00
|
|
|
@reviewdate = @startdate;
|
|
|
|
}
|
|
|
|
else {
|
2025-03-31 21:59:14 +01:00
|
|
|
# Previous month - backup 1 month
|
2024-06-04 16:35:44 +01:00
|
|
|
@reviewdate = Add_Delta_YM( @startdate, 0, -1 );
|
|
|
|
}
|
|
|
|
|
|
|
|
_debug($DEBUG >= 2, '@reviewdate: ' . join(',',@reviewdate));
|
|
|
|
|
|
|
|
#
|
|
|
|
# Transfer Date::Calc values into hashes for initialising DateTime objects so
|
2025-03-31 21:59:14 +01:00
|
|
|
# we can play time zone games. (Note: %dtargs is a hash and we're using hash
|
|
|
|
# slicing to initialise it).
|
2024-06-04 16:35:44 +01:00
|
|
|
#
|
|
|
|
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
|
|
|
|
#
|
2025-03-31 21:59:14 +01:00
|
|
|
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)"),
|
2024-06-04 16:35:44 +01:00
|
|
|
);
|
|
|
|
|
|
|
|
_debug($DEBUG >= 2,
|
|
|
|
"\$year: $year",
|
2025-03-31 21:59:14 +01:00
|
|
|
"\$monthno: $monthno",
|
2024-06-04 16:35:44 +01:00
|
|
|
"\$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" );
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
# 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/ );
|
2024-06-04 16:35:44 +01:00
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
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";
|
|
|
|
}
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
#
|
|
|
|
# Build an array of timezone data for the template
|
|
|
|
#
|
|
|
|
my @timezones;
|
|
|
|
for my $tz (@zones) {
|
2025-03-31 21:59:14 +01:00
|
|
|
push( @timezones, storeTZ( $dtstart, $dtend, $tz ) );
|
2024-06-04 16:35:44 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
# 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.
|
2025-03-31 21:59:14 +01:00
|
|
|
# TODO: If this search fails (because in future Community News shows will not
|
|
|
|
# be reserved), then the date needs to be computed.
|
2024-06-04 16:35:44 +01:00
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
my $isodate = $dtstart->ymd;
|
2025-03-31 21:59:14 +01:00
|
|
|
#$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
|
|
|
|
#});
|
2024-06-04 16:35:44 +01:00
|
|
|
$sth1 = $dbh->prepare(q{
|
|
|
|
SELECT id FROM eps
|
|
|
|
WHERE date > ?
|
2025-03-31 21:59:14 +01:00
|
|
|
AND strftime("%u", date) = '1'
|
2024-06-04 16:35:44 +01:00
|
|
|
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;
|
|
|
|
}
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
my $episode = $h1->{id};
|
2024-06-04 16:35:44 +01:00
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
_debug( $DEBUG >= 2, "\$episode (slot): $episode" );
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
$sth1->finish;
|
|
|
|
$dbh->disconnect;
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
# 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 ) );
|
|
|
|
}
|
|
|
|
|
2024-06-04 16:35:44 +01:00
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
# Fill the template
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
my $tt = Template->new(
|
|
|
|
{ ABSOLUTE => 1,
|
|
|
|
ENCODING => 'utf8',
|
|
|
|
}
|
|
|
|
);
|
|
|
|
|
|
|
|
my $vars = {
|
|
|
|
server => $server,
|
|
|
|
port => $port,
|
|
|
|
room => $room,
|
2025-03-31 21:59:14 +01:00
|
|
|
subject => $subject,
|
2024-06-04 16:35:44 +01:00
|
|
|
timezones => \@timezones,
|
|
|
|
utc => {
|
|
|
|
days => $days,
|
|
|
|
month => $monthname,
|
|
|
|
year => $year,
|
|
|
|
date => $nicedate,
|
|
|
|
start => $starttime,
|
|
|
|
end => $endtime,
|
|
|
|
},
|
2025-03-31 21:59:14 +01:00
|
|
|
episode => $episode, # show number
|
2024-06-04 16:35:44 +01:00
|
|
|
};
|
|
|
|
|
|
|
|
my $document;
|
|
|
|
$tt->process( $template,
|
|
|
|
$vars, \$document, { binmode => ':utf8' } )
|
|
|
|
|| die $tt->error(), "\n";
|
|
|
|
|
|
|
|
#
|
2025-03-31 21:59:14 +01:00
|
|
|
# Write to the output file
|
2024-06-04 16:35:44 +01:00
|
|
|
#
|
2025-03-31 21:59:14 +01:00
|
|
|
print $outfh $document;
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
#
|
2025-03-31 21:59:14 +01:00
|
|
|
# Report the output file name if there is one
|
2024-06-04 16:35:44 +01:00
|
|
|
#
|
2025-03-31 21:59:14 +01:00
|
|
|
if ($outfile) {
|
|
|
|
say "Output is in $outfile";
|
2024-06-04 16:35:44 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
exit;
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
#=== 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";
|
|
|
|
}
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
#=== 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, "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, "Server", coalesce($server,'undef');
|
|
|
|
printf $fmt, "Port", coalesce($port,'undef');
|
|
|
|
printf $fmt, "Room", coalesce($room,'undef');
|
|
|
|
printf $fmt, "Template", coalesce($template,'undef');
|
2025-03-31 21:59:14 +01:00
|
|
|
printf $fmt, "Recording date file", coalesce($recdatefile,'undef');
|
2024-06-04 16:35:44 +01:00
|
|
|
print "D> ----\n";
|
|
|
|
}
|
|
|
|
|
|
|
|
#=== 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 );
|
|
|
|
}
|
|
|
|
|
|
|
|
#
|
2025-03-31 21:59:14 +01:00
|
|
|
# Apply any day offset
|
2024-06-04 16:35:44 +01:00
|
|
|
#
|
|
|
|
@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)
|
2025-03-31 21:59:14 +01:00
|
|
|
# RETURNS: Reference to a hash containing the timezone name and start and
|
|
|
|
# end times
|
2024-06-04 16:35:44 +01:00
|
|
|
# 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: day_offset
|
|
|
|
# PURPOSE: Given a day name computes day attributes including the
|
2025-03-31 21:59:14 +01:00
|
|
|
# (negative) offset in days from the target release day (Monday)
|
|
|
|
# to the recording date.
|
2024-06-04 16:35:44 +01:00
|
|
|
# PARAMETERS: $dayname Name of a day of the week
|
2025-03-31 21:59:14 +01:00
|
|
|
# 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.
|
2024-06-04 16:35:44 +01:00
|
|
|
# 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 = (
|
2025-03-31 21:59:14 +01:00
|
|
|
"help", "documentation|man",
|
|
|
|
"debug=i", "date=s",
|
|
|
|
"starttime=s", "endtime=s",
|
|
|
|
"month=s", "output:s",
|
|
|
|
"config=s",
|
2024-06-04 16:35:44 +01:00
|
|
|
);
|
2025-03-31 21:59:14 +01:00
|
|
|
# "mail!", "fromaddress=s", "toaddress=s", "duration=s",
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
if ( !GetOptions( $optref, @options ) ) {
|
|
|
|
pod2usage( -msg => "Version $VERSION\n", -verbose => 0, -exitval => 1 );
|
|
|
|
}
|
|
|
|
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
|
|
__END__
|
|
|
|
|
|
|
|
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
|
# Application Documentation
|
|
|
|
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
|
#{{{
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
make_email - generates the text of an HPR Community News recording invitation
|
|
|
|
email
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
=head1 VERSION
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
This documentation refers to make_email version 0.3.3
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
|
|
|
|
=head1 USAGE
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
make_email [-help] [-documentation] [-debug=N] [-month=DATE] [-date=DATE]
|
|
|
|
[-start=START_TIME] [-end=END_TIME] [-config=FILE]
|
2024-06-04 16:35:44 +01:00
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
./make_email -date=2022-12-27
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
=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:
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
perldoc ./make_email
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
=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<-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.
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
=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
|
|
|
|
|
2024-06-04 16:35:44 +01:00
|
|
|
=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>.
|
|
|
|
|
|
|
|
=back
|
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
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.
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
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.
|
|
|
|
|
|
|
|
=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.
|
|
|
|
|
|
|
|
=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
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
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:
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
<database>
|
|
|
|
name = DBNAME
|
|
|
|
</database>
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
=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.
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
=head1 DEPENDENCIES
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
Config::General
|
|
|
|
Cwd
|
2024-06-04 16:35:44 +01:00
|
|
|
DBI
|
2025-03-31 21:59:14 +01:00
|
|
|
Data::Dumper
|
2024-06-04 16:35:44 +01:00
|
|
|
Date::Calc
|
|
|
|
Date::Parse
|
|
|
|
DateTime
|
|
|
|
DateTime::Format::Duration
|
|
|
|
DateTime::TimeZone
|
2025-03-31 21:59:14 +01:00
|
|
|
File::Copy
|
2024-06-04 16:35:44 +01:00
|
|
|
Getopt::Long
|
|
|
|
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
|
|
|
|
|
2025-03-31 21:59:14 +01:00
|
|
|
Dave Morriss (Dave.Morriss@gmail.com) 2013 - 2025
|
2024-06-04 16:35:44 +01:00
|
|
|
|
|
|
|
=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
|