#!/usr/bin/perl

# This script will produce formatted text output suitable for use by geektool.
# It pulls a reasonable set of "current" tasks from your org files.
# This includes:
# last tasks
# tasks due today
# tasks with a warning date in the past
# and all tasks have one of a (configurable) set of TODO keywords.

# It does NOT handle SCHEDULED dates.

# The tasks will be sorted thus:
# First come late tasks, sorted by deadline.
# Then come due tasks
# Then come upcoming tasks that are within the warning period.
# Then come non-dated tasks sorted by priority.

# The code is probably not very efficient,
# but this script is WAY faster than using emacs in batch mode.
# Q: Why did I write this?
# A: Why use a howizter to kill a fly?

use Date::Calc qw(Add_Delta_YMD Delta_Days Today);

# CUSTOMIZATION PART

# This is where your org files live.
$orgdir = '/Users/fil/Dropbox/org';
# The TODO keywords you want to search for in the TODO list, each separated by |.
$taskRE = 'ACTIVE|REVIEW|WIP';
# The TODO keywords that are acceptable in the agenda, |-separated.
$agendaRE = 'REVIEW|TODO|ACTIVE|WAIT|SOMEDAY|OPEN|WIP|PAUSED';
# Set this to 0 to show all subtasks that match.
$hiddensubtasks = 1;

# OKAY; YOU CAN STOP CUSTOMIZING NOW.  REALLY.

# Don't touch the the rest of this script.
@files = ();
$line = '';
$category = '';
@output = ();
@mname = ( '', 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug',
	   'Sep', 'Oct', 'Nov', 'Dec' );

# a diagnostic routine.
sub burp {
  my ($msg, $i) = @_;
  $i =~ s/\n/|/msgo;
  print "$msg\n--------------------\n$i\n=============================\n";
}

# Given year/month/day, return 1/0 if the date is/isn't earlier than today.
@today = Today();		# cache the value of Today to save time.
sub pastDue {
  return ( Delta_Days(@_, @today) >= 0 ) ? 1 : 0;
}

# Convert an org date into a date that sums the deadline with the warning period.
sub calcstartdate {
  my ($year, $month, $day, $warning) = @_;
  my @delta = ( 0, 0, 0 );
  if ( $warning =~ m/\-(\d+)([dwmy])/ ) {
    my $wN = $1;
    my $wT = $2;
    if    ( $wT eq "d" ) { $delta[2] = -$wN; }
    elsif ( $wT eq "w" ) { $delta[2] = -$wN * 7; }
    elsif ( $wT eq "m" ) { $delta[1] = -$wN; }
    else                 { $delta[0] = -$wN; }
  }
  @delta = Add_Delta_YMD ($year, $month, $day, @delta);
  return "$delta[0] $delta[1] $delta[2]";
}

# Read an org file, filtering out only the lines that interest us.
# Return a list of lines of interest.
# It also merges deadlines with tasks.
# It also calculates & includes the first day of the warning period, if any.
# Ditto for categories: it assumes that any task after a category statement,
# and before the next category statement, belongs to the first category.
# Also, rm asterisks in favour of an integer level.
# This simplifies things for later.
# Also, reformat the priority for easier handling later.
sub readf {
  my $f = shift;		# file to process given as argument.
  my @b = ();
  my $cat = $f;
  $cat =~ s/\.org$//;		# default category is suffixless filename.
  open F, "$orgdir/$f";
  while (my $l = <F>) {
    chomp $l;			# remove the final newline.
    my $level;
    if ( $l =~ s/^(\*+)/$level=length($1);'';/e ) {
      # The default priority is '_' which is lexically after A/B/C.
      # This way a simple lexical sort with do the right thing.
      # <space> comes before A/B/C, which would screw up lexical sorting.
      my $p = '_';
      my $k = '';
      # Save the priority & remove it from the task.
      $l =~ s/\[\#(A|B|C)\]/$p=$1;'';/e;
      # Save the keyword & remove it from the task.
      $l =~ s/^\s*($taskRE|$agendaRE)\s+/$k=$1;'';/e;
      # Rebuild the line is a easier to process form for later.
      push @b, "$cat\n$level\n$p\n$k\n$l\n";
    } elsif ( $l =~ m/^:CATEGORY: (.+)$/ ) {
      # If we've found a new category, note it for subsequent tasks.
      $cat = $1;
    } elsif ( $l =~ m/^DEADLINE: \<(\d{4})-(\d{2})-(\d{2}) ...(.*)\>/ ) {
      # We've found a deadline.
      # First add the start of the warning period (a "start date" of sorts).
      $b[$#b] .= calcstartdate ($1, $2, $3, $4) . "\n";
      my $tmp = "$1 $2 $3\n";
      $tmp =~ s/ 0/ /g;		# ugly hack to clean up the dates.
      # Also save the actual due date.
      $b[$#b] .= $tmp;
    }
  }
  close F;
  return @b;
}

# This is used by sort()
# $a and $b are provided by sort().
# Dates are in a YYYY MM DD form, so that lexical ordering is the same as
# numeric ordering.
# i.e. I don't have to convert strings to numbers to do the sort.
sub sorttasks {
  my ($ca, $la, $pa, $ka, $ta, $das, $dae) = split ( /\n/, $a );
  my ($cb, $lb, $pb, $kb, $tb, $dbs, $dbe) = split ( /\n/, $b );

  if ($dae) {
    if ($dbe) {			# $a & $b both have due dates.
      my $x = $dae cmp $dbe;
      return $x if $x;		# i.e. if $x != 0.
      # still here? the end dates are the same. Check priorities.
      $x = $pa cmp $pb;
      return $x if $x;
      # still here? the priorities were the same. Check category name.
      return $ca cmp $cb;
    }
    else {	     # $a has a due date but $b doesn't.
      # always put dated tasks ahead of nondated tasks.
      return -1;
    }
  } else {			# $a has no due date.
    if ($dbe) {			# $b has a due date.
      # always put dated tasks ahead of nondated tasks.
      return 1;
    } else {			# neither $a nor $b have due dates.
      # Try sorting by priority.
      my $x = $pa cmp $pb;
      return $x if $x;
      # still here? priorities were the same. try category names.
      return $ca cmp $cb;
    }
  }
}

# This weeds out subtasks (i.e. only main tasks will be printed).
# Turn it off by setting $hiddensubtasks to 0.
# The order of tasks in the task list is the same as they appeared in org
# files. We can use that fact to expedite the selection.
sub hidesubtasks {
  return @_ if !$hiddensubtasks;
  my @l = @_;
  my @l2 = ();
  my $level = 100;		# some arb LOW level we'll never reach.
  my $category = '';
  for my $i (@l) {
    # Parse the task.
    my ($c, $l, $p, $k, $d, $s, $e) = split ( /\n/, $i );
    if ($c eq $category) {	# if same category as prev task, and
      if ($l <= $level) {	# if level is higher than that of prev task,
	# keep this item (and remember its level for future comparisons).
	$level = $l;
	push @l2, $i;
      }
    }
    else {			# if we've found a new category,
      # remember category & level for future comparisons, and keep the item.
      $level = $l;
      $category = $c;
      push @l2, $i;
    }
  }
  return @l2;			# this list omits the 'hidden' tasks.
}

# MAIN PROCESSING

# get all the org files
opendir D, $orgdir;
@files = grep { /\.org$/ } readdir(D);
closedir D;

# Gather up all the potential items.
for my $file (@files) {
  push @output, (readf($file));
}

# Go thru the list of potentials, deciding what to do with each item.
{ my @l = ();
  for my $i (@output) {
    # Split the item into fields.
    my ($category, $level, $priority, $keyword, $description, $start, $end) =
      split ( /\n/, $i );

    # This is how we check
    # If there's a duedate, or a startdate,
    # and either date has past,
    # and if the keyword is in $agendaRE, then keep the item.
    # If there's no date,
    # and if the keyword is in $taskRE, then keep the item.
    # All other items are omitted.

    if ( ( $end && pastDue ( split ( ' ', $end ) ) ) &&
	 $keyword =~ m/$agendaRE/ ) {
      push @l, $i;
    }
    elsif ( ( $start && pastDue ( split ( ' ', $start ) ) ) &&
	 $keyword =~ m/$agendaRE/ ) {
      push @l, $i;
    }
    elsif ( !$start && !$end && $keyword =~ m/$taskRE/ ) {
      push @l, $i;
    }
  }
  # Now we remove subtasks (if needed) and sort the items.
  @output = sort sorttasks hidesubtasks(@l);
}

# Pretty-print the results.
for my $i (@output) {
  my ($category, $level, $priority, $keyword, $description, $start, $end) =
    split ( /\n/, $i );

  if ( $end ) {			# clean up the due date.
    my ($y, $m, $d) = split ( / /, $end);
    $end = sprintf "%s %02d", $mname[$m], $d;
  }
  printf "%13s %s %6s %s\n",
    $category, $priority, $end, $description;
}
