X-Git-Url: http://git.refcnt.org/?p=lugs.git;a=blobdiff_plain;f=lreminder%2Freminder.pl;h=f4ed20934b9f4a9df452a933a207c1df5d5cfce9;hp=2568006071e31f87da94f7b049509b58114f658f;hb=0556494dfa26407c9e3481bcfb90bd32581ab41c;hpb=111b21b123bff372f7beb84e3152f22ac362e504 diff --git a/lreminder/reminder.pl b/lreminder/reminder.pl index 2568006..f4ed209 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 Dec 4 21:18:20 CET 2013 +# Last modified: Fri Jul 25 16:51:43 CEST 2014 use strict; use warnings; @@ -23,6 +23,7 @@ use lib qw(lib); use constant true => 1; use constant false => 0; +use DateTime (); use DBI (); use Encode qw(encode); use File::Basename (); @@ -33,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.42'; +my $VERSION = '0.47'; #----------------------- # Start of configuration @@ -55,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); @@ -89,14 +91,14 @@ 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); } sub init { - my ($parser, $month_days, $current) = @_; + my ($parser) = @_; $$parser = LUGS::Events::Parser->new($file, { filter_html => true, @@ -113,31 +115,16 @@ sub init fields => [ qw(more) ], } ], }, + purge_tags => [ qw(location responsible more) ], strip_text => [ 'mailto:' ], }); unlink $file; - - %$month_days = ( - 1 => 31, 7 => 31, - 2 => 28, 8 => 31, - 3 => 31, 9 => 30, - 4 => 30, 10 => 31, - 5 => 31, 11 => 30, - 6 => 30, 12 => 31, - ); - - %$current = do { - my @time = (localtime)[3..5]; - $time[1]++; - $time[2] += 1900; - map { $_ => shift @time } qw(day month year); - }; } sub process_events { - my ($parser, %month_days, %current); - init(\$parser, \%month_days, \%current); + my $parser; + init(\$parser); while (my $event = $parser->next_event) { my %event = ( @@ -161,24 +148,15 @@ sub process_events my $subscriptions = $sth{subscriptions}->fetchrow_hashref; next unless $subscriptions->{$event{color}}; - my %notify = %current; + my $notify = DateTime->now(time_zone => 'Europe/Zurich'); $subscriber->{notify} ||= 0; - my $day = $current{day} + $subscriber->{notify}; - my $days_in_month = $month_days{$current{month}}; - - if ($day > $days_in_month) { - $notify{day} = $day - $days_in_month; - $notify{month}++; - } - else { - $notify{day} += $subscriber->{notify}; - } + $notify->add(days => $subscriber->{notify}); - if ($event{year} == $notify{year} - && $event{month} == $notify{month} - && $event{day} == $notify{day} + if ($event{year} == $notify->year + && $event{month} == $notify->month + && $event{day} == $notify->day ) { send_mail($event, $subscriber->{mail}); } @@ -231,7 +209,7 @@ MSG To => $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;