X-Git-Url: http://git.refcnt.org/?p=lugs.git;a=blobdiff_plain;f=lreminder%2Freminder.pl;h=14ea60e811fdebc93890d44a919fbf7bff338303;hp=31ab0739140eda050d5685092e98271baece16a7;hb=HEAD;hpb=3efacbab405d1c178f06280957e4727959cc1175 diff --git a/lreminder/reminder.pl b/lreminder/reminder.pl index 31ab073..14ea60e 100755 --- a/lreminder/reminder.pl +++ b/lreminder/reminder.pl @@ -1,5 +1,5 @@ #!/usr/bin/perl - +# # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or @@ -15,7 +15,7 @@ # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA # # Author: Steven Schubiger -# Last modified: Mon Dec 29 19:06:34 CET 2014 +# Last modified: Wed 09 Jun 2021 01:19:17 PM CEST use strict; use warnings; @@ -25,7 +25,7 @@ use constant false => 0; use DateTime (); use DBI (); -use Encode qw(encode); +use Encode qw(decode encode); use File::Basename (); use File::Spec (); use FindBin qw($Bin); @@ -37,7 +37,7 @@ use Text::Wrap::Smart::XS qw(fuzzy_wrap); use URI (); use WWW::Mechanize (); -my $VERSION = '0.49'; +my $VERSION = '0.53'; #----------------------- # Start of configuration @@ -47,9 +47,12 @@ my $Config = { events_url => 'http://www.lugs.ch/lugs/termine/termine.txt', form_url => 'http://lists.lugs.ch/reminder.cgi', mail_from => 'reminder@lugs.ch', + mail_admin => 'stsc@refcnt.org', dbase_name => '', dbase_user => '', dbase_pass => '', + sleep_secs => 300, + max_tries => 48, }; #--------------------- @@ -89,11 +92,48 @@ sub getopts sub fetch_and_write_events { my $mech = WWW::Mechanize->new; - my $http = $mech->get($Config->{events_url}); - open(my $fh, '>', $file) or die "Cannot open $file for writing: $!\n"; - print {$fh} $http->content; - close($fh); + my ($http, $retry, $tries); + $http = undef; + + do { + $retry = false; + $tries++; + eval { + $http = $mech->get($Config->{events_url}); + } or do { + warn "[${\scalar localtime}] $@"; + $retry = ($tries < $Config->{max_tries}) ? true : false; + sleep $Config->{sleep_secs} if $retry; + }; + } while ($retry); + + if (defined $http) { + open(my $fh, '>', $file) or die "Cannot open $file for writing: $!\n"; + print {$fh} $http->content; + close($fh); + } + else { + my $script = File::Basename::basename($0); + warn "[${\scalar localtime}] $script not entirely run, no http content\n"; + my $message = <<"MSG"; +hello, + +This is lreminder [<$Config->{mail_from}>]. + +Could not run $script entirely, no http content. +Please re-run manually with `$0 --run' today. + +thanks, +MSG + sendmail( + From => $Config->{mail_from}, + To => $Config->{mail_admin}, + Subject => 'LUGS Reminder - warning: timeout', + Message => $message, + ) or die "Cannot send mail: $Mail::Sendmail::error"; + exit; + } } sub init @@ -200,11 +240,13 @@ ${\info_string()} MSG if ($run) { + $title = decode('UTF-8', $title); sendmail( - From => $Config->{mail_from}, - To => $mail_subscriber, - Subject => encode('MIME-Q', "LUGS Reminder - $title"), - Message => $message, + From => $Config->{mail_from}, + To => $mail_subscriber, + Subject => encode('MIME-Q', "LUGS Reminder - $title"), + Message => $message, + 'Content-Type' => 'text/plain; charset="UTF-8"', ) or die "Cannot send mail: $Mail::Sendmail::error"; } elsif ($test) { @@ -236,7 +278,7 @@ sub info_string my $modified = localtime((stat($0))[9]); $modified =~ s/(?<=\b) (?:\d{2}\:?){3} (?=\b)//x; - $modified =~ s/\s+/ /g; + $modified =~ s/\s{2,}/ /g; my $info = <<"EOT"; --