X-Git-Url: http://git.refcnt.org/?p=lugs.git;a=blobdiff_plain;f=lreminder%2Freminder.pl;h=eb9d79461e22a221c1d4de2e6fb4ffdfcb32a5e0;hp=81d898ef98f75362215bcc0e298381a3175324c1;hb=990582d3ffc09369b8f85b6b8e37a3959778f34e;hpb=7297bad447c8eb7feaf9946506f5a337443cfe55 diff --git a/lreminder/reminder.pl b/lreminder/reminder.pl index 81d898e..eb9d794 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: Wed Jul 16 16:17:32 CEST 2014 +# Last modified: Fri Jan 8 12:43:13 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.45'; +my $VERSION = '0.51'; #----------------------- # Start of configuration @@ -50,6 +50,8 @@ my $Config = { dbase_name => '', dbase_user => '', dbase_pass => '', + sleep_secs => 300, + max_tries => 48, }; #--------------------- @@ -57,7 +59,7 @@ my $Config = { #--------------------- my $dbh = DBI->connect("dbi:mysql(RaiseError=>1):$Config->{dbase_name}", $Config->{dbase_user}, $Config->{dbase_pass}); -my $file = (URI->new($Config->{events_url})->path_segments)[-1]; +my $file = File::Spec->catfile('tmp', (URI->new($Config->{events_url})->path_segments)[-1]); my ($test, $run) = (false, false); @@ -89,11 +91,31 @@ 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 { + warn "[${\scalar localtime}] ${\File::Basename::basename($0)} not entirely run, no http content\n"; + exit; + } } sub init @@ -110,11 +132,8 @@ sub init rewrite => '$TEXT - $HREF', fields => [ qw(location more) ], } ], - 'br' => [ { - rewrite => '', - fields => [ qw(more) ], - } ], }, + purge_tags => [ qw(location responsible more) ], strip_text => [ 'mailto:' ], }); unlink $file; @@ -189,7 +208,7 @@ sub send_mail my $month_name = $month_names{$month}; -my $message = (<