#! /usr/bin/perl -w
use strict;

no warnings "numeric";

# Copyright (C) 2006-2021 Arne Wichmann
#
# This little thing is distributed under the GNU General Public License,
# version 2. If you need the license, ask your distributor for it.

# There may be instances of german in the code, if you have problems
# understanding ask me (possibly after trying babelfish) -- aw@saar.de

sub date($);
sub urgentness($;$$);

sub usage() {
print
 "$0 <todo-list>\n\n".
 "Dies bekommt eine ToDo-Liste als Eingabe und gibt sie nach Prioritaet\n".
 "sortiert aus. Das Format der ToDo-Liste ist in dieser Datei unter\n".
 "\"editierbar:\" dokumentiert, eine Beispieldatei mit mehr Dokumentation\n".
 "ist unter https://www.saar.de/~aw/src/beispieltodo zu finden.\n";
 exit 0;
}

if ($ARGV[0]=~/^-[h?]$/) { usage();}

# in meinem X-startup steht folgender schnipsel, mit dem ich dieses script
# bediene:
# mv -f --backup=numbered ~/todo ~/tmp/todo
# perl ~/src/own/todo/uptodo ~/tmp/todo > ~/todo
# $XTERM -ls -n todo -geometry 80x25-90+0 -e vim -S ~/.vim-todo ~/todo&

# ach ja, ~/.vim-todo sieht folgendermaszen aus:
# set sw=1
# set foldmethod=indent
# highlight Folded ctermfg=2 ctermbg=9

# Item:
#   Index (interne Nummer)
#   Name (string, Titel fuer kurze Liste)
#   Kommentar (string, Beschreibungen, Kommentare, etc.)
#   Prerequisiten (list of indices, andere Items, die beendet sein muessen,
#     bevor dieses bearbeitet werden kann)
#   Masteritem (list of indices, andere Items (normalerweise <=1), in deren
#     Kontext dieses zu sehen ist)
#   Startdatum (date)
#   Prioritaet (number, Numerische Prioritaet der Aufgabe)
#   Increment (number, Erhoehung der Prioritaet pro Tag)
#   Deadline (date, Zeitpunkt wo es fertig sein musz)
#   Advarning (time, Ab wann soll die Prioritaet drastisch erhoeht werden)
#   Deadpri (number, Erhoehung der Prioritaet kurz vor der Deadline)
#   Deadinc (number, Erhoehung der Prioritaet kurz vor der Deadline pro Tag)
#   Blocked (date, Prioritaet ist 0 bis zum zeitpunkt)
# 
# Datenbank: 2 Formate: perldumpformat, editierbar
#   TODO - perldumpformat
# 
# editierbar:
#   ^Name
#   ^ +"I"Index; "P"Prerequisiten; "M"Masteritem; "S"Startdatum;
#     "p"Prioritaet; "i"Increment; "Dl"Deadline; "A"Advarning; "Dp"Deadpri;
#     "Di"Deadinc; "b"Blockdatum
#   ^ +Kommentar
# 
#   ^Name
#   ^ +"X"; "s"Includefile
#   ^ +Prioritaet, Increment, Advarning, Deadpri, Deadinc, Prioname

# state - what kind of line was the last line
# c == comment, n == name, p == parameters
my($s)='c';

# index count - the next index we use when we have to fill in an index
# number (it will be increased by 0.5 to indicate an automatically
# generated index number, which will be changed to integer later in the
# code
my($ic)=1;

# %entry contains all ToDo-entries, indexed by index number
# %prio contains all priority-entries, indexed by name
my(%entry,%prio);

# Hauptschleife
my ($name, @param, $comment, $end);
do {{
  $_=<>;
  $end=1 if eof;
  # next if $end;
  unless (/^\s/) {
    $s=~/^[cp]/ || die "Keine 2 Namen hintereinander";
    $name=$_;
    $s='n';
  } else {
    if ($s eq 'n') {
      # we have a name - we now expect a parameter line
      my($specialentry)=0;
      chomp;
      s/\s//g;
      # default indices are non-integer numbers and are changed to integer
      # numbers later - see comment above
      @param=(0.5+$ic++,'','',time,-1,0,0,0,0,0,0,'default');
      for (split(/;/)) {
        if (/^I(.*)$/) {
	  unless (defined($entry{$1})) {
	    $1 || die "zero index is reserved";
	    if ($1!=0 and $1!=int($1)) {
	      $param[13].=" WARNING: non-integer numeric index $1 ".
	        "detected.\n The index of this entry was changed.\n Please".
		" correct any mispointing prerequisites and masteritems.\n";
	      warn "non-integer numeric index $1";
	    } else {
	      $param[0]=$1;
	      $ic--;
	    }
	  } else { 
	    # duplicate indices are a potential problem if other indices
	    # refer to them.
	    $param[13].=" WARNING: duplicate index $1 detected.".
	      " The index of this entry was changed.\n Please correct any ".
	      "mispointing prerequisites and masteritems.\n";
	    warn "duplicate index $1";
	  }
	} 
	if (/^p(.*)$/) { $param[($1==0 and $1 ne '0')?11:4]=$1; }
	/^P(.*)$/ and $param[1]=$1; /^M(.*)$/ and $param[2]=$1;
	/^S(.*)$/ and $param[3]=$1;
	/^i(.*)$/ and $param[5]=$1; /^Dl(.*)$/ and $param[6]=$1;
	/^A(.*)$/ and $param[7]=$1; /^Dp(.*)$/ and $param[8]=$1;
	/^b(.*)$/ and $param[10]=$1; /^Di(.*)$/ and $param[9]=$1;

	/^X/ and $specialentry=1;   /^s/ && die "sourcing not implemented";
      }
      if ($specialentry) {
	$param[0]=0;
	$s='p';
	next;
      }
      $entry{$param[0]}=[@param];
      $entry{$param[0]}[12]=$name;
      $s='p';
    } elsif ($s=~/[pc]/) {
      unless ($param[0]) { # special entry for named priority
	s/\s+//g;
	chomp;
        my(@p)=split(/,/);
	$_=pop(@p);
	$p[2]=86400*$1 if $p[2]=~/(\d+)d/;
	$prio{$_}=[@p];
	$s='c';
	next;
      }
      $entry{$param[0]}[13].=$_;
      $s='c';
    } else { die "Formatfehler"; }
  }
}} until $end; # duplicate errorcondition, should never happen

for (values(%entry)) {
  # undefined priorities should be default - if default is undefined this
  # will just be reevaluated every time we get here
  unless (defined($prio{$_->[11]})) { $_->[11]='default'; }
  # remove obsolete blocking dates
  # hier hatte ich mehrere moegliche mechaniken in verwendung, und eine
  # weitere angedacht - die terminale weisheit, was hier der richtige weg
  # ist, ist mir noch nicht in den kopf gefallen: wenn ich den block
  # einfach wegnehme, nachdem er abgelaufen ist, bekomme ich am termin
  # danach unter umstaenden eine unvermittelt hohe prioritaet. wenn ich die
  # zeit resette, ist der prioritaetsverlust unter umstaenden massiv. eine
  # dritte option waere, die schon gewonnene prioritaet einzufrieren -
  # dafuer mueszte ich unterstuetzungscode schreiben (ich denke an
  # S-<schonverbrauchtesekunden>)
  if (date($_->[10]) < time() and date($_->[10]) > 0) {
    $_->[3]=time() unless $_[3]; # $_[3] is only 0 if explicitly set
    $_->[10]=0;
  }
  # remove nonexistent prerequisites
  $_->[1] || next;
  my($prel)=join(',',map {$entry{$_}?($entry{$_}->[0]):()} split(/,/,$_->[1]));
  # das folgende sollte genau dann zutreffen, wenn ein prerequisit
  # verschwunden ist - das programm geht davon aus, dasz er abgearbeitet
  # wurde, und dasz daher jetzt die prioritaet des postrequisits gesenkt
  # werden kann. das ist etwas haeszlich, aber vielleicht funktioniert es.
  $_->[3]=time() if length($prel) < length($_->[1]);
  $_->[1]=$prel;
}

# find unique indices for indices numbered by default
for my $j (keys(%entry)) {
  int($j) == $j && next;
  my($i)=int($j);
  $i++ while ($entry{$i});
  $entry{$j}[0]=$i;
  $entry{$i}=$entry{$j};
#  # replace all prerequisite entries pointing to the changed item
#  # this should for now only happen for automatically generated warnings
#  # because of duplicated indices
#  for (values(%entry)) {
#    my(@p)=split(/,/,$_->[1]);
#    next unless grep {$j == $_} @p;
#    warn "changed prerequisite in $_ from $j to $i";
#    $_->[1]=join(',',map {($_==$j)?$i:$_} @p);
#  }
  delete($entry{$j}) || die "argh";
}

# output new todo list sorted by urgentness of entries
# format is the same as on input...
print(map {$_->[12]." 0".urgentness($_).";I".$_->[0].";S".$_->[3].
    ($_->[1]&&(";P".$_->[1])).($_->[2]&&(";M".$_->[2])).
    (($_->[4]<0)?"":(";p".$_->[4])).($_->[5]?(";i".$_->[5]):'').
    ($_->[6]?(";Dl".$_->[6]):'').($_->[7]?(";A".$_->[7]):'').
    ($_->[8]?(";Dp".$_->[8]):'').($_->[9]?(";Di".$_->[9]):'').
    ($_->[10]?(";b".$_->[10]):'').
    (($_->[11] eq 'default')?'':(";p".$_->[11]))."\n".
    (($#$_>=13)?($_->[13]):"");}
  (sort { urgentness($b) <=> urgentness($a) } (values(%entry))));

print("Prios\n X\n ".
  join("\n ",map {join(",",@{$prio{$_}}).",$_";} (keys(%prio)))."\n");

exit 0;
# EOF

# this gives the priority of an entry (first parameter). if called
# recursively, the second parameter is the start time of the base entry and
# the third is a string containing all the indices touched in this
# recursion separated by spaces (to check for loops)
sub urgentness($;$$) {
  my($e,$mt,$recursive)=@_;
  my($idx)=$e->[0];
  $recursive='' unless $recursive; # un-undef

  # if we have a blocking date (in the future, hopefully checked before) we
  # have urgentness 0 unless the function is called to calculate
  # prerequisites
  return 0 if $e->[10] and !$recursive;

  # check if we are in a loop in the prerequisite graph
  if ($recursive and $recursive=~/\b$idx\b/) {
    warn "prerequisite graph has loop";
    return 0;
  }

  # time since warning period before deadline
  my($dl)=time()-date($e->[6])+
    ($e->[7]||defined($prio{$e->[11]})&&$prio{$e->[11]}->[2]);
  $dl=0 if ($dl<0 or !$e->[6]);

  $mt=$e->[3] unless $mt; # this is start time - if not $recursive

  local $_;
  # base priority
  $_=($e->[4]>=0)?($e->[4]):(defined($prio{$e->[11]})&&$prio{$e->[11]}->[0]);
  # daily increment
  $_+=(($e->[5]||defined($prio{$e->[11]})&&$prio{$e->[11]}->[1]) *
    int((time()-$mt)/86400));
  # deadline static priority
  $_+=($dl&&($e->[8]||defined($prio{$e->[11]})&&$prio{$e->[11]}->[3]));
  # deadline increment
  $_+=(int($dl/86400) * 
    ($e->[9]||defined($prio{$e->[11]})&&$prio{$e->[11]}->[4]));
  # TODO - masteritems
  # masteritems bekommen 2* prioritaet, dafuer werden die gemasterten items
  # halbiert. die prioritaet des masteritems wird auf die gemasterten
  # verteilt. das masteritem mastert sich selber (d.h. es hat halbe
  # prioritaet + 2* anteilig. wenn ein masteritem nur sich selber mastern
  # wird der master geloescht. prereqs sollten nach masteritems evaluiert
  # werden

  # the sum of the urgentnesses of all entries which have us in their list
  # of prerequisites
  $_+=sum(map {
    (grep {$idx eq $_} (split(/,/,$_->[1]))) &&
      urgentness($_,$mt,$recursive." ".$idx);
  } (values(%entry)));
  # if we have prerequisites we show priority 0
  return 0 if !$recursive and $e->[1] or $_<0;
  # if we have multiple prereq we split our points between all of them
  $_=int($_/((undef)=split(/,/,$e->[1]))) if $e->[1];
  return $_;
}

# sums up the arguments
sub sum(@) {
  my($sum);
  for (@_) { $sum+=$_; }
  return($sum);
}

# convert to unix timeformat
use POSIX;
sub date($) {
  @_=split("-",shift());
  return $_[0] if $#_==0;
  $_[0]-=1900; $_[1]--; $#_=5;
  for (@_) { $_=0 if !defined($_) or $_<0; }
  return(POSIX::mktime(reverse(@_)));
}