1579 lines
44 KiB
Plaintext
1579 lines
44 KiB
Plaintext
|
#!/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
|