#!/usr/bin/perl -w # # To-Do-Liste per IMAP-Ordner # Greift auf Mailordner zu, verwaltet To-Do-Prios und erstellt Zusammenfassungsmails # # Arbeitet pro Benutzer, bei mehreren Benutzern muss das Script mehrfach installiert werden. # Hinweis: Das Mailpasswort muss im Klartext im Script gespeichert sein - Sicherheitsproblem! # Hinweis: Die erzeugten Erinnerungsmails sind pures html, ohne Alternativtext. # # Mehr: Siehe http://www.schaarwaechter.de unter Projekte oder direkt unter # http://www.schaarwaechter.de/sp/projekte/mailtodo/wiedervorlage.html # # Danke an Stephan Isringhausen (isy at bgfa dot ruhr-uni-bochum dot de) fuer seine Anregungen! # # misc, 12/06 # 01/07: URLs im Subject werden erkannt und als Link dargestellt. Mailadr ebenfalls als Links. # 10/07: Verzeichnisse in_x_mon eingefuehrt # 02/08: decode_mime_string: Besseres Decode # Folder werden automatisch subscribiert # in_x_mon Mechanismus endlich fertig # todo-E-Mail kommt jetzt jeden Tag 1x neu, auch wenn sich keine Todos geaendert haben # 03/09: Ein use fehlte. # use File::Basename; use Mail::IMAPClient; use DB_File; use Date::Calc qw(:all); &Language(Decode_Language("Deutsch")); use Digest::MD5 qw(md5_hex); use MIME::QuotedPrint; use Encode; use MIME::Base64; ################################################################ ############# Konfiguration ab hier ############################ our $server = "mail.ser.ver"; our $user = "username"; our $password = "password"; our $ownaddress = '"Vorname Nachname" '; our $parentfolder = "INBOX._ToDos"; # Der Basisordner fuer die To-Do-Ordner und WV-Ordner: Nur dieser muss manuell angelegt werden! our $wv_parent = "Wiedervorlage"; # Name des Ordners innerhalb von $parentfolder, in dem die WV-folder angelegt werden. our $max_wv_folders = 15; # ... Tage voraus werden Ordner angelegt our $includeweekends = 1; # 0 = Sa + So exklusive, 1=inkl. our $debug = 1; # 1= Meldungen, 0= Ruhe our $zeigeallewv = 1; # 1=Auch die Langfristigen Wiedervorlagen aus den in_x_mon-Ordnern werden in der todo-E-Mail gezaehlt. 0=eben nicht. ################################################################ # our @todofolders = qw(Prio_01 Prio_02 Prio_03 Prio_04 Prio_05 Prio_06 Prio_07 Prio_08 Prio_09 Prio_10); our @todofolders = qw(Prio_01 Prio_02 Prio_03 Prio_04 Prio_05); # Die letzten beiden Stellen enthalten die Prio! Weitere eintragbar. our @monfolders = qw(in_03_mon in_06_mon in_12_mon); # Ordner fuer Wiedervorlage in x Monaten. Weitere eintragbar nach Schema in_x_mon ############# Konfiguration bis hier ########################### ################################################################ our $version="$0, 1.5, Feb 08, Michael.Schaarwaechter\@ub.uni-dortmund.de"; our $imap; # Fuer die Verbindung our $mailtodoid = "X-mailtodo-ID"; # Die ID anhand der das Programm seine eigenen Mails wiedererkennt our $mailtododue = "X-mailtodo-DUE"; # In diesem Tag steht das Datum der Faelligkeit bei Mails in @monfolders our @folders; our %storedvars; our %todocounter; our $storedvarslocation = dirname($0)."/storedvars.hash"; our $htmlheaderfile = dirname($0)."/htmlheader.txt"; #------------------------------------------------------- sub decode_mime_string { # Danke an http://www.thomas-fahle.de/pub/perl/MIME/MIME_Code.html my $string = $_[0]; if($string=~/=\?([^?]+)\?(.)\?([^?]*)\?=/){ my $charset = $1; my $encoding = $2; my $txt = $3; my $str_before = $`; my $str_after = $'; if ($encoding =~ /b/i) { $txt = decode_base64($txt); $string = ''; $string .= $str_before; if($charset=~/utf/i){ Encode::from_to($txt, $charset,'iso-8859-1'); } $string .= $txt; $string .= $str_after; } elsif ($encoding =~ /Q/i) { $txt = decode_qp($txt);#->import(decode_qp); $txt =~ s/_/ /g; $string = ''; $string .= $str_before; if($charset=~/utf/i){ Encode::from_to($txt, $charset,'iso-8859-1'); } $string .= $txt; $string .= $str_after; } } return $string; } #------------------------------------------------------- sub datum { my $y=(localtime)[5]+1900; my $m=(localtime)[4]+1; my $d=(localtime)[3]; my $hour=(localtime)[2]; my $min=(localtime)[1]; my $sec=(localtime)[0]; $sec="0".$sec if (length($sec)==1); $min="0".$min if (length($min)==1); $hour="0".$hour if (length($hour)==1); $d="0".$d if (length($d)==1); $m="0".$m if (length($m)==1); return $y."/".$m."/".$d."_".$hour.":".$min.":".$sec; } #------------------------------------------------------- sub log { # Gibt Nachricht nur aus wenn debug gesetzt ist. return if (not $debug); my $datum=&datum; print "$datum - $_[0]\n"; } #------------------------------------------------------- sub openconnection { $imap = Mail::IMAPClient->new( Server => $server, User => $user, Password=> $password, ) or die "Cannot connect to $server as $user: $@"; &log("Connected als $user bei $server"); @folders = $imap->folders or die "Could not list folders: $@\n"; if (join("",@folders) !~ m/$parentfolder/) {die "Bitte Ordner $parentfolder manuell anlegen, Script arbeitet sonst nicht!\n";} # print join(" ",@folders); } #------------------------------------------------------- sub closeconnection { $imap->disconnect or warn "Could not disconnect: $@\n"; &log("Disconnected"); } #------------------------------------------------------- sub folderstructure { foreach $i(map {$_="$parentfolder.$_"} @todofolders) { if (join("",@folders) !~ m/$i/) { $imap->create($i) or die "Could not create $i: $@\n"; $imap->subscribe($i) or die "Could not subscribe $i: $@\n"; &log("$i angelegt und subscribiert"); } } if (join("",@folders) !~ m/$parentfolder\.$wv_parent/) { $imap->create("$parentfolder.$wv_parent") or die "Could not create $parentfolder.$wv_parent: $@\n"; &log("$parentfolder.$wv_parent angelegt und subscribiert"); } foreach $i(1..$max_wv_folders) { my ($y,$m,$d)=Add_Delta_Days(Today,$i); next if ( (Day_of_Week($y,$m,$d) >= 6) and (not $includeweekends) ); my $dow=substr(Day_of_Week_Abbreviation(Day_of_Week($y,$m,$d)),0,2); my $f=sprintf("$parentfolder.$wv_parent.%4d-%02d-%02d_%2s",$y,$m,$d,$dow); if (join("",@folders) !~ m/$f/) { $imap->create($f) or die "Could not create $f: $@\n"; $imap->subscribe($f) or die "Could not subscribe $f: $@\n"; &log("$f angelegt und subscribiert"); } } foreach $i(map {$_="$parentfolder.$wv_parent.$_"} @monfolders) { if (join("",@folders) !~ m/$i/) { $imap->create($i) or die "Could not create $i: $@\n"; $imap->subscribe($i) or die "Could not subscribe $i: $@\n"; &log("$i angelegt und subscribiert"); } } @folders = $imap->folders or die "Could not list folders: $@\n"; } #------------------------------------------------------- sub htmlheader { local $/; open FILE,$htmlheaderfile; my $html=; return $html; return $html; } #------------------------------------------------------- sub htmlfooter { my $datum=&datum; return <<"EOT";
-- 
Erstellt von
$version
am $datum
EOT } #------------------------------------------------------- sub gettodos { my $stand=""; # Wird als Kommentar eingefuegt, damit es auf jeden Fall taeglich eine neue todo-E-Mail gibt my $z=< PrioBetreffFromDatum EOT # my @args=("UNSEEN"); # Wir nehmen nur, was kein anderer angefasst hat my @args=("REVERSE DATE","US-ASCII","ALL"); # ("DATE","US-ASCII","ALL") wuerde aelteste zuerst listen $foundprios=0; $priocounter=1; foreach $todofolder(@todofolders) { $imap->select($todofolder) or die "Could not select: $@\n"; $imap->expunge($todofolder) or die "Could not expunge: $@\n"; my @msgs = $imap->sort(@args); warn "Error in search: $@\n" if ($@); # &log(scalar(@msgs)." Nachrichten in $todofolder"); $foundprios++ if (scalar(@msgs)); $todocounter{$todofolder} = scalar(@msgs); foreach $m (@msgs) { my $s = $imap->get_header($m, "Subject"); $s=&decode_mime_string($s); $s=~s#^(.*?)(http://\S+)(.*?)#$1$2$3#gi; my $f = $imap->get_header($m, "From"); $f =~ m/(\S+?@\S+)/; $fa = $1; $fa =~ s#<|>##g; $f=&decode_mime_string($f); if ($f=~m/"/) { $f=~s/.*?"(.*?)".*?/$1/; # Wenn " vorhanden, Namen rausziehen und Rest wegwerfen } my $d = $imap->get_header($m, "Date"); $d =~ s#:\d\d .*$##; $z.=qq# $priocounter $s $f $d #; } $priocounter++; $z.=qq# \n#; } $z.=qq#$stand#; return "" if (not $foundprios); return $z; } #------------------------------------------------------- sub getflags { # Holt die Flags zur uebergebenen msgid im aktuellen Folder # Loescht das Flag \Recent # Gibt geklammerten space-separated String zurück my $msgid=shift; my @flags=$imap->flags($msgid); my $erg=join(" ",@flags); $erg=~s/ *\\Recent *//i; return $erg; } #------------------------------------------------------- sub monatefolder { my ($f)=@_; my @args=("ALL"); my $flags; my $cr=chr(13).chr(10); my $crmailtododue=$cr.$mailtododue; my $newid; $imap->select($f) or die "Could not select: $@\n"; my @msgs = $imap->search(@args); warn "Error in search: $@\n" if ($@); $f=~m/in_(\d+)_mon/; my $plusmonate=$1; if (scalar(@msgs)) { foreach my $msgid(@msgs) { # Alle E-Mails: die ohne unseren Tag taggen, die mit Tag auf Faelligkeit untersuchen my $messagestring=$imap->message_string($msgid); $messagestring=~m/^(.*?)$cr$cr(.*?)$/s; my $messageheader=$1; my $messagebody=$2; if ($messageheader=~m/$crmailtododue: (\d+),(\d+),(\d+)/s) { # Tag erkannt my $moved=0; my ($dy,$dm,$dd)=($1,$2,$3); if (Delta_Days($dy,$dm,$dd,Today)>=0) { # Mail ist schon ueberfaellig -> inbox $flags=&getflags($msgid); $messageheader=~s/$crmailtododue: (\d+),(\d+),(\d+)//; # Tag raus my $newuid = $imap->append_string( "INBOX", $messageheader.$cr.$cr.$messagebody,"(".join(" ",$flags).")") or die "Could not append_string: $@\n"; $imap->delete_message($msgid) or die "Could not delete_message: $@\n"; $imap->expunge($f) or die "Could not expunge: $@\n"; $moved++; &log("Faellige Nachricht $msgid aus $f nach INBOX verschoben als $newuid."); } else { # Mail nicht ueberfaellig: Pruefen ob ein Folder mit dem Faelligkeitsdatum existiert my $ddow=substr(Day_of_Week_Abbreviation(Day_of_Week($dy,$dm,$dd)),0,2); my $df=sprintf("$parentfolder.$wv_parent.%4d-%02d-%02d_%2s",$dy,$dm,$dd,$ddow); if (join("",@folders) =~ m/$df/) { $flags=&getflags($msgid); $messageheader=~s/$crmailtododue: (\d+),(\d+),(\d+)//; # Tag raus $newuid = $imap->append_string( $df, $messageheader.$cr.$cr.$messagebody,"(".join(" ",$flags).")") or die "Could not append_string: $@\n"; $imap->delete_message($msgid) or die "Could not delete_message: $@\n"; $imap->expunge($f) or die "Could not expunge: $@\n"; $moved++; &log("Faellige Nachricht $msgid aus $f nach $df verschoben als $newuid."); } } $dates2show{"$dd.$dm.$dy"}++ if (not $moved); } else { # Kein Tag erkannt $flags=&getflags($msgid); $messageheader.="$crmailtododue: ".join(",",Add_Delta_YM(Today,0,$plusmonate)); $newuid = $imap->append_string( $f, $messageheader.$cr.$cr.$messagebody,"(".join(" ",$flags).")") or die "Could not append_string: $@\n"; $imap->delete_message($msgid) or die "Could not delete_message: $@\n"; $imap->expunge($f) or die "Could not expunge: $@\n"; &log("Neue Nachricht $msgid in $f getagged und als $newuid gespeichert."); $dates2show{join(".",reverse(Add_Delta_YM(Today,0,$plusmonate)))}++; } } } } #------------------------------------------------------- sub wiedervorlage { my @args=("ALL"); my $counted=""; my $msgcount; our %dates2show; # Zwischenspeicher der Termine aus den Monatsfoldern zum Zaehlen. Global, weil &monatefolder das Ding beschickt. Unschoen, ich weiss. my $n; my $diffdays; my $in; foreach $f(@folders) { next if (not $f=~m/$parentfolder\.$wv_parent\./); $f=~m/^$parentfolder\.$wv_parent\.(.*?)_.*?$/; # Tagesfolder? my ($wvy,$wvm,$wvd)=split(/\-/,$1); if ( (not $wvy) or (not $wvm) or (not $wvd) ) { $f=~m/^$parentfolder\.$wv_parent\.in_(\d+)_mon$/; # Monatsfolder? my $monate=$1; if ($monate) { &monatefolder($f); } else { &log("Problem: Ordner $f kann nicht interpretiert werden!"); } next; } ($ty,$tm,$td)=Today; $imap->expunge($f) or die "Could not expunge: $@\n"; $msgcount = $imap->message_count($f); if ($msgcount) { $n=""; $n="n" if ($msgcount > 1); $diffdays=Delta_Days($wvy,$wvm,$wvd, $ty,$tm,$td) * -1; $in="in $diffdays Tagen"; $in="morgen" if ($diffdays == 1); $in="übermorgen" if ($diffdays == 2); my $g1=""; my $g2=""; if ($diffdays==1) { $g1=qq##; $g2=qq##; } $counted.=qq#$g1 $msgcount Wiedervorlage$n für den $wvd.$wvm.$wvy ($in).$g2
\n#; } if (Delta_Days($wvy,$wvm,$wvd, $ty,$tm,$td)>=0) { # Hier gibt es einen Ordner fuer heute oder die Vergangenheit $imap->select($f) or die "Could not select: $@\n"; my @msgs = $imap->search(@args); warn "Error in search: $@\n" if ($@); if (scalar(@msgs)) { my $moved=$imap->move("INBOX", @msgs) or die "Could not move: $@\n"; $imap->expunge; $imap->select(INBOX) or die "Could not select: $@\n"; $imap->delete($f) or die "Could not delete $f: $@\n"; &log("Nachrichten $moved in die INBOX verschoben, abgelaufenen WV-Ordner $f geloescht"); } else { $imap->select(INBOX) or die "Could not select: $@\n"; $imap->delete($f) or die "Could not delete $f: $@\n"; &log("Abgelaufenen WV-Ordner $f ohne Nachrichten geloescht"); } } } if ($zeigeallewv) { foreach $i(sort {Date_to_Days(reverse(split /\./,$a)) <=> Date_to_Days(reverse(split /\./,$b))} keys %dates2show) { ($ty,$tm,$td)=Today; $n=""; $n="n" if ($dates2show{$i} > 1); $diffdays=Delta_Days(reverse(split /\./,$i), $ty,$tm,$td) * -1; $in="in $diffdays Tagen"; $counted.=qq#$dates2show{$i} Wiedervorlage$n für den $i ($in).
\n#; } } if ($counted) { $counted="

$counted

"; } return $counted; } #------------------------------------------------------- sub mailheader { &Language(Decode_Language("English")); my ($year,$month,$day,$hour,$min,$sec) = Today_and_Now; my $dow = substr(Day_of_Week_to_Text(Day_of_Week($year,$month,$day)),0,3); $month = substr(Month_to_Text($month),0,3); my $date = "$dow, $day $month $year $hour:$min:$sec +0100 (CET)"; &Language(Decode_Language("Deutsch")); my $subject="TODO"; my $id=md5_hex(&datum); $storedvars{"inboxmail-id"} = $id; foreach my $i(sort keys %todocounter) { $subject.=" - $todocounter{$i}" } return <<"EOT"; Return-Path: <$ownaddress> Subject: $subject Precedence: bulk X-Mailer: $version To: $ownaddress From: $ownaddress Date: $date Content-Type: text/html; charset=ISO-8859-1 $mailtodoid: $id EOT } #------------------------------------------------------- sub newinboxmail { my $todos=shift; my $wv=shift; my $newtodos=1; my $newwv=1; if ($todos eq $storedvars{"todos"}) { &log("Keine Aenderung bei Todos gefunden"); $newtodos=0; } else { &log("Aenderung bei Todos gefunden"); } if ($wv eq $storedvars{"wv"}) { &log("Keine Aenderung bei Wiedervorlagen gefunden"); $newwv=0; } else { &log("Aenderung bei Wiedervorlagen gefunden"); } $imap->select("INBOX") or die "Could not select: $@\n"; my @args=("ALL"); my @msgs = $imap->search(@args) or &log("Search: Keine Nachrichten."); warn "Error in search: $@\n" if ($@); # &log(scalar(@msgs)." Nachrichten (inkl. geloeschter) in der INBOX"); my $foundthemail=0; foreach $m(@msgs) { my @flags = $imap->flags($m); # or die "Could not flags $m: $@\n"; next if ( join(" ",@flags)=~m/Deleted/ ); my $id = $imap->get_header($m, $mailtodoid); if ($id) { if ($id eq $storedvars{"inboxmail-id"}) { $foundthemail=1; if ($newtodos or $newwv) { $imap->delete_message($m) or die "Could not delete_message: $@\n"; &log("Alte INBOX-Mail mit der ID $m geloescht"); } else { &log("INBOX-Mail ist noch vorhanden"); } } } } return if ((not $newtodos) and (not $newwv) and ($foundthemail)); # Mail ist noch da, es gibt aber keine neuen ToDos oder WV -> nix tun &log("INBOX-Mail ist nicht mehr vorhanden") if (not $foundthemail); my $uid = $imap->append_string( "INBOX", &mailheader.&htmlheader.$todos.$wv.&htmlfooter , '$Label1') or die "Could not append_string: $@\n"; &log("Neue INBOX-Mail erzeugt mit der ID $uid"); $storedvars{"todos"}=$todos; $storedvars{"wv"}=$wv; } #------------------------------------------------------- tie %storedvars, "DB_File", $storedvarslocation or die "Could not open $storedvarslocation: $!"; #if ($debug) { # print Dumper(\%storedvars); #} &openconnection; &folderstructure; &newinboxmail(&gettodos,&wiedervorlage); &closeconnection; untie %storedvars;