X-Git-Url: http://git.refcnt.org/?p=lugs.git;a=blobdiff_plain;f=lreminder%2Freminder.pl;h=31ab0739140eda050d5685092e98271baece16a7;hp=4ecc1552b0df69aeaba085b3a6e3e24e2d8f6954;hb=3efacbab405d1c178f06280957e4727959cc1175;hpb=ccc598769eee96b90f5b3205ba9c43554214d508 diff --git a/lreminder/reminder.pl b/lreminder/reminder.pl index 4ecc155..31ab073 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: Mon Jan 13 22:07:51 CET 2014 +# Last modified: Mon Dec 29 19:06:34 CET 2014 use strict; use warnings; @@ -34,9 +34,10 @@ use Hook::Output::File (); use LUGS::Events::Parser (); use Mail::Sendmail qw(sendmail); use Text::Wrap::Smart::XS qw(fuzzy_wrap); +use URI (); use WWW::Mechanize (); -my $VERSION = '0.43'; +my $VERSION = '0.49'; #----------------------- # Start of configuration @@ -56,7 +57,7 @@ my $Config = { #--------------------- my $dbh = DBI->connect("dbi:mysql(RaiseError=>1):$Config->{dbase_name}", $Config->{dbase_user}, $Config->{dbase_pass}); -my $file = File::Basename::basename($Config->{events_url}); +my $file = File::Spec->catfile('tmp', (URI->new($Config->{events_url})->path_segments)[-1]); my ($test, $run) = (false, false); @@ -90,7 +91,7 @@ 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: $!\n"; + open(my $fh, '>', $file) or die "Cannot open $file for writing: $!\n"; print {$fh} $http->content; close($fh); } @@ -109,11 +110,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; @@ -188,7 +186,7 @@ sub send_mail my $month_name = $month_names{$month}; -my $message = (< $mail_subscriber, Subject => encode('MIME-Q', "LUGS Reminder - $title"), Message => $message, - ) or die $Mail::Sendmail::error; + ) or die "Cannot send mail: $Mail::Sendmail::error"; } elsif ($test) { printf "[%s] <$mail_subscriber> ($color)\n", scalar localtime; @@ -240,7 +238,7 @@ sub info_string $modified =~ s/(?<=\b) (?:\d{2}\:?){3} (?=\b)//x; $modified =~ s/\s+/ /g; - my $info = <