X-Git-Url: http://git.refcnt.org/?p=lugs.git;a=blobdiff_plain;f=lreminder%2Freminder.pl;h=3326424fb9fe427679621e83264dc2b3982b3580;hp=b3658cab2f5dbd85883f0f44ba1b5a55223cfa3c;hb=94de2ec30537b46bd1fcefdebd55bdf731c0e1f3;hpb=817a1f629818f11dce3448304da3eafaebf540c6 diff --git a/lreminder/reminder.pl b/lreminder/reminder.pl index b3658ca..3326424 100755 --- a/lreminder/reminder.pl +++ b/lreminder/reminder.pl @@ -15,7 +15,7 @@ # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA # # Author: Steven Schubiger -# Last modified: Tue Jan 6 14:37:04 CET 2015 +# Last modified: Thu Feb 4 23:21:02 CET 2016 use strict; use warnings; @@ -37,7 +37,7 @@ use Text::Wrap::Smart::XS qw(fuzzy_wrap); use URI (); use WWW::Mechanize (); -my $VERSION = '0.50'; +my $VERSION = '0.52'; #----------------------- # 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