#!/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" <Vorname.Nachname@mail.ser.ver>';
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=<FILE>;
   return $html;
return $html;
}
#-------------------------------------------------------
sub htmlfooter {
   my $datum=&datum;
   return <<"EOT";
<pre class="moz-signature" cols="72">-- 
Erstellt von
$version
am $datum
</pre>
</body>
</html>
EOT
}
#-------------------------------------------------------
sub gettodos {

   my $stand="<!--Stand ".join("/",Today)."-->"; # Wird als Kommentar eingefuegt, damit es auf jeden Fall taeglich eine neue todo-E-Mail gibt
   my $z=<<EOT;
<table>
<tr><th>Prio</th><th>Betreff</th><th>From</th><th>Datum</th></tr>
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<a href="$2">$2</a>$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#<tr>
                    <td class="tab_prio$priocounter">$priocounter</td>
                    <td class="tab_subject$priocounter">$s</td>
                    <td class="tab_from$priocounter"><a href="mailto:$fa">$f</a></td>
                    <td class="tab_date$priocounter">$d</td>
                </tr>#;
      }
      $priocounter++;
      $z.=qq#<tr class="tab_space"><td colspan="4">&nbsp;</td></tr>\n#;
   }
   $z.=qq#</table>$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="&uuml;bermorgen" if ($diffdays == 2);
         my $g1=""; my $g2="";
         if ($diffdays==1) {
            $g1=qq#<span class="bggelb">#;
            $g2=qq#</span>#;
         }
         $counted.=qq#$g1 $msgcount Wiedervorlage$n f&uuml;r den $wvd.$wvm.$wvy ($in).$g2<br>\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&uuml;r den $i ($in).<br>\n#;
      }
   }
   if ($counted) {
      $counted="<p>$counted</p>";
   }
   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;