ttm

#!/usr/bin/perl -w
#
# ttm -- tiny task manager
#
# Copyright (c) 1999 Adam Spiers <adam@spiers.net>. All rights
# reserved. This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Minor additions and enchancements by Jesse Becker <hawson@gmail.com> 2006-2009
#


require 5.004;
use strict;

my $VERSION = '0.64-4';

use Getopt::Std;
use Text::Abbrev;
use Fcntl qw{:DEFAULT :flock};
use MLDBM qw{GDBM_File Storable};
use Time::Local;
use Date::Manip;
use Data::Dumper;
use Sys::Hostname;
use File::Basename;

my $hostname = hostname;
$hostname =~ s/\..*//;

# Where shall we store the task database?
my $ttmdir   = "$ENV{HOME}/.ttm";
# What shall we call the GDBM file in this directory?
my $dbm_file = "tasks_$hostname.gdbm";

my $logfile="$ttmdir/ttm.log";

my @priorities = (
     # priority   ,  text  ,                          Age in days
    [ 'emergency'  , 'do it NOW!',                         0 ],
    [ 'critical'   , 'action needed TODAY',                1 ],
    [ 'urgent'     , 'action needed today or tomorrow',    4 ],
    [ 'important'  , 'action needed within a few days',   10 ],
    [ 'sooner'     , 'action needed within a week',       17 ],
    [ 'later'      , 'action needed within a few weeks',  28 ],
    [ 'sometime'   , 'action needed within a few months', 65 ],
    [ 'eventually' , 'whenever, dude',                    90 ],
    [ 'CFT'        , 'dogwash priority',                 180 ],
);

# What priority do tasks get sorted with if no priority specified?
my $default_priority = 4;

# Default lowest priority (threshold) shown
my $default_threshold = 5;

# Maximum task id
my $max_task_id = 999;

# Which editor shall we use?
my $editor  = $ENV{VISUAL} || $ENV{EDITOR} || 'vim';
#my $editor_options = '-c i';
#$editor .= " $editor_options";

# Calculate terminal width.
my $columns = $ENV{COLUMNS} || 80;

#----------------------------------------------------------------------------#
# You shouldn't have to hack around with anything below here, unless you
# really want to (in which case, let me know what you do).
#----------------------------------------------------------------------------#

BEGIN {
sub debug {
    my $message=shift;
    my $state=shift;

    $state=$ENV{DEBUG} if !defined($state);

    return if !$state;

    chomp $message;
    print STDERR "$message\n"
}
}


my %opts = ();
my %tasks = ();

if (@ARGV and $ARGV[0] =~ /^-[^dfh]/) {
  unshift @ARGV, 'list';
}

getopts('d:f:h', \%opts);

if ($opts{h}) {
  usage();
  exit 1;
}

my $full_path = $opts{f} || "$ttmdir/$dbm_file";

check_ttmdir($full_path);
read_in_tasks($full_path);

my %actions = ();
abbrev \%actions, qw/list grep
                     add new
                     change
                     edit
                     modify
                     resolve complete finish
                     kill delete remove
                     categories
                     priorities
                    /;

# import/export can't be abbreviated
$actions{$_} = $_ for qw/import export/;

# Synonyms
foreach (keys %actions) {
  $actions{$_} =~ s/remove|delete/kill/i;
  $actions{$_} =~ s/new/add/i;
  $actions{$_} =~ s/finish|complete/resolve/i;
  $actions{$_} =~ s/change/alter/i;
}  

my $action;

if (@ARGV == 0) {
  $action = 'list';
}
else {
  if ($ARGV[0] =~ /^[a-z]+$/) {
    if (exists $actions{$ARGV[0]}) {
      $action = $actions{+shift};
    }
    else {
      $action = 'list';
    }
  }
  else {
    $action = 'list';
  }
}

# Another synonyms
if ($action eq 'grep') {
  $action = 'list';
  unshift @ARGV, '-g', pop(@ARGV);
}

if ($action eq 'list') {
  if (@ARGV == 1 and $ARGV[0] =~ /^\d+$/) {
    display_task($ARGV[0]);
  }
  else {
    my %list_opts = ();
    getopts('Aag:s:t:v', \%list_opts);
    display_task_list(\%list_opts, @ARGV);
  }
}
elsif ($action eq 'add') {
#  usage() if @ARGV;
  add_task(@ARGV);
}
elsif ($action eq 'edit') {
  usage() unless @ARGV == 1;
  edit_task($ARGV[0]);
}
elsif ($action eq 'modify') {
  usage() unless @ARGV == 1 or @ARGV == 2;
  modify_task_status(@ARGV);
}
elsif ($action eq 'resolve') {
  usage() unless @ARGV == 1;
  resolve_task($ARGV[0]);
}
elsif ($action eq 'kill') {
  usage() unless @ARGV == 1;
  kill_task($ARGV[0]);
}
elsif ($action eq 'categories') {
  list_categories();
}
elsif ($action eq 'priorities') {
  list_priorities();
}
elsif ($action eq 'import') {
  import_from_text_files();
}
elsif ($action eq 'export') {
  export_to_text_files();
}
elsif ($action eq 'alter') {
    print "Stub for altering fields on the command line.\n";
}
else {
  bug();
}

untie %tasks;
release_lock();

exit 0;


#----------------------------------------------------------------------------#
# subroutines follow ...
#----------------------------------------------------------------------------#

sub usage {
  print <<USAGE;
ttm $VERSION, (c) 1999 Adam Spiers <adam\@spiers.net>
    updates 2006-2009,2014 by Jesse Becker <hawson\@gmail.com>

Usage: ttm [ -d <dir> ] <action> <params>
Actions (except import and export) may be abbreviated unambiguously, and are:
   list [-f <file>] [-a|-A] [-v] [-d <days>] [-s <status regexp>] [-t <threshold>] [<categories>]
                  -- list unblocked, unresolved, neglected tasks (by category)
                      `-A' shows all tasks regardless of status/priority
                      `-a' shows all unresolved tasks regardless of priority
                      `-d' limits results to the previous X days.
                      `-s' shows tasks matching the specified status regexp
                      `-t' specifies a priority threshold (default 5)
                      `-v' inverts the sense of category matching
   list/edit <id> -- display/edit a single task
   add            -- add a new task
   modify <id> <new status> }_ change a task's status 
   resolve <id>             }  (new status can be abbreviated)
   kill <id>      -- kill a task (normally you should use resolve instead)
   grep <regexp>  -- grep all tasks for regexp (actually an alias for
                     `list -a -g <regexp>', hence all list options work too)
   categories     -- list all existing categories
   priorities     -- list all priorities
   import/export  -- import/export from/to text files to/from GDBM
`list' may be omitted altogether, unless `-d' is being used.
The -f option indicates a file other than $ttmdir/$dbm_file
USAGE

  exit 0;
}

sub bug {
  die <<'EOF';
Congratulations, you have found a bug in ttm.  

/Please/ e-mail <hawson@gmail.com> explaining exactly how you achieved
this, so that he can fix it.
EOF

}

#----------------------------------------------------------------------------#
# file access
#----------------------------------------------------------------------------#

sub read_in_tasks {
  my ($full_path) = @_;
  debug("Reading in tasks from [$full_path]");
  set_lock();

  tie %tasks, 'MLDBM', "$full_path", O_CREAT | O_RDWR, 0640
    or die "Couldn't open $full_path: $!\n";
}

sub read_in_task_from_text_file {
  my ($id) = @_;

  debug("Opening [$ttmdir/$id]");
  open(TASK, "$ttmdir/$id") or die "Couldn't open $ttmdir/$id: $!\n";

  my %task = ();

  # Read in headers
  while (<TASK>) {
    chomp;

    # Header/text munging...
    my ($header, $text);
    if ( ($header, $text) = /^([\w ]+?):\s*(.*)$/ ) {
      $header =~ s/^\s*(.+)\s*$/$1/;
      $text   =~ s/^\s*//;
      $text   =~ s/\s*$//;
      debug("Header=[$header], Text=[$text]");

      die "`body' not allowed as header\n" if $header eq 'body';

      # Special handling for various fields
      $text = ucfirst($text) if $header eq "categories";
      if ($header =~ /(date due|creation date)/) {
        # Convert to sec. since epoch if not already in that form
        if ($text  !~ /^\d+$/) {
            $text=UnixDate($text,"%s");
        }
      }

      $task{$header} = $text;
      next;
    }

    last if /^-/;
  }

  # Read in body
  {
    local $/ = undef;
    $task{body} = <TASK> || '';
  }

  close(TASK);
  
  # Check for missing, chanaged fields
  if (!exists $task{dependency}) {
    $task{dependency} = ();
  }
  

  $tasks{$id} = \%task;
}

sub write_task_to_text_file {
  my ($id) = @_;

  open(TASK, ">$ttmdir/$id")
    or die "Couldn't open $ttmdir/$id for writing: $!\n";

  my %task = %{$tasks{$id}};

  my $format = "%s: %s\n";

  foreach my $header (core_headers(),
                      grep { is_user_header($_) } keys %task)
  {
        my $value = $task{$header} || '';
        if ($header =~ /(date due|creation date|completion date)/) {
            # Convert to sec. since epoch if not already in that form
            if ($value  =~ /^\d+$/) {
                #my $date=ParseDate($text);
                $value=scalar localtime($value);
            }
        }

        printf TASK $format, $header, $value;
  }

  print TASK '-' x ($columns - 1), "\n";

  my $body = $task{body} || '';
  $body =~ s/\n*\Z/\n/s;
  print TASK $body;
  close(TASK);
}  

sub next_free_id {
  my $next=0;
  foreach my $id (keys %tasks) {
    $next = $id if $next < $id;
  }
  $next ||= 0;

  $next++;

  if ($next >= $max_task_id) {
    $next = 1;
    $next++ while exists $tasks{$next};
  }

  return $next;
}

sub set_lock {
  my ($type) = @_;

  $type ||= 'exclusive';

  my $lock = "$ttmdir/.lock";

  if (! -e $lock) {
    open(LOCK, ">$lock")
      or die "Couldn't open $lock for writing: $!\n";
    close(LOCK) or die "Couldn't close $lock: $!\n";
  }

  open(LOCK, $lock) or die "Couldn't open $lock: $!\n";
  flock(LOCK, (($type eq 'exclusive') ? LOCK_EX : LOCK_SH) | LOCK_NB)
    or die <<EOF;
Another ttm process seems to be changing the task database.
Please terminate it and try again.
EOF
}

sub release_lock {
  close(LOCK);
}

sub check_ttmdir {
  my ($full_path) = @_;
  my $ttmdir = dirname($full_path);
  debug ("Checking on [$ttmdir] directory");
  return if -d $ttmdir;

  if (-e $ttmdir) {
    die "$ttmdir exists but is not a directory.\n";
  }
  else {
    print "$ttmdir does not exist.  Shall I create it for you? ";
    my $reply = <STDIN>;
    if ($reply =~ /y/i) {
      mkdir $ttmdir, 0777   # let's hope the umask is right!
        or die "Couldn't create $ttmdir: $!\n";
    }
    else {
      die "Cannot proceed without task database directory.\n";
    }
  }
}

#----------------------------------------------------------------------------#
# actions
#----------------------------------------------------------------------------#

sub display_task {
  my ($id) = @_;

  check_task_exists($id);

  my $format = "%13s: %s\n";

  printf $format, 'summary', summary($id);
  printf $format, 'priority',
                  priority($id) . " (" . priority($id, 'long') . ")";

  printf $format, 'categories', categories($id);
#  printf $format, 'date due',   date_due($id);
  printf $format, 'status',     status($id);

  my %task = %{$tasks{$id}};
  foreach my $header (grep { is_user_header($_) } keys %task) {
    my $value = $task{$header} || '';
    printf $format, $header, $value;
  }

  print '-' x ($columns - 1), "\n";

  my $body = $task{body} || '';
  $body =~ s/\n*$/\n/s;
  print $body;
}

sub display_task_list {
  my ($opts, @categories) = @_;

  my %grep = ();
  if ($opts->{g}) {
    my $re = ($opts->{g} =~ /[A-Z]/) ? qr/$opts->{g}/ : qr/$opts->{g}/i;
    TASK:
      foreach my $id (keys %tasks) {
        my %task = %{$tasks{$id}};
        foreach my $key (keys %task) {
          if (exists $task{$key} && defined($task{$key}) && $task{$key} =~ /$re/) {
            $grep{$id}++;
            next TASK;
          }
        }
      }
  }

  my ($exclude_status_re, $include_status_re);

  $exclude_status_re
    = qr/(done|resolved|completed?|finish(ed)?|blocked|scheduled)/i;

  if ($opts->{a}) {
    $exclude_status_re = qr/(done|resolved|completed?|finish(ed)?)/i
  }
  else {
    if ($opts->{s}) {
      undef $exclude_status_re;
      $include_status_re = qr/$opts->{s}/i;
    } 
  }

  $opts->{t} ||= $default_threshold;

  my $summary_width=$columns - (3+1+10+3+2+9+1+8+1+8+1);
  my $hformat = "%3s %10.10s.%-3d %-9.9s %-8s %-8.8s %-.$summary_width"."s\n";
  my  $format = "%3d %10.10s.%-3d %-9.9s %-8s %-8.8s %-.$summary_width"."s\n";

  my $out = '';

  $out .= sprintf $hformat, qw/id priority 0 status project catgy summary/;
  $out .= sprintf '-' x ($columns - 1) . "\n";

  my $matches = 0;
  foreach my $id (sort by_priority keys %tasks) {
    if (@categories) {
      next unless (is_in_categories($id, @categories) xor $opts->{v});
    }

    if (! $opts->{A}) {
      next if $exclude_status_re and status($id) =~ $exclude_status_re;
      next if $include_status_re and status($id) !~ $include_status_re;
    }

    if (! $opts->{A} && ! $opts->{a} && ! $opts->{g} && ! @categories) {
      next if dpriority($id) > $opts->{t};
    }

    if ($opts->{g}) {
      next unless exists $grep{$id};
    }

    my $status = lc(status($id));
    if ($status ne 'pending' and $status ne 'resolved' and overdue($id)) {
        $status='OVERDUE';
    }
    
    my @deps = dependencies($id);
    foreach my $dep (@deps) {
        if (!exists $tasks{$dep}){
          warn "Job $id had non-existant dependency: $dep";
        }
        my $dep_status = $tasks{$dep}{status};
        if ( $dep_status !~ qr/(done|resolved?|completed?|finish(ed)?)/i ) {
          $status = "Blck:$dep";
          last;
        }
    }        
        
    $out .= sprintf $format, $id, priority($id), days_old($id), ucfirst($status), projects($id), categories($id), summary($id);
    $matches++;
  }

  if ($matches) {
    print $out;
  }
  else {
    print "no tasks found\n";
  }
}

sub add_task {
  my @inputs=@_;
  my $id = next_free_id();

  my @old_cats = all_categories();

  # Defaults
  my $time=scalar localtime;
  my $due=scalar (localtime (timelocal(localtime) + 86400*2));
  #print STDERR $time,"\n";


  #Default settings for new task
  my %task = (
    summary        => $#_ ? join(' ', @_) :  '',
    priority       => '4',
    categories     => '',
    projects       => '',
    body           => '',
    dependency     => '',
   'creation date' => $time,
   'due date'      => $due,
    id             => $id,
    );
  $tasks{$id} = \%task;
  
  write_task_to_text_file($id);
  
  system "$editor $ttmdir/$id";
  read_in_task_from_text_file($id);
  unlink "$ttmdir/$id";

  my @new_cats = all_categories();

  print "Added new task `" . summary($id) . "' (id $id)\n";
  show_category_changes(\@old_cats, \@new_cats);
}

sub edit_task {
  my ($id) = @_;

  # We trust the editor of choice take care of locking
  check_task_exists($id);
  my @old_cats = all_categories();

  write_task_to_text_file($id);
  system "$editor $ttmdir/$id";
  read_in_task_from_text_file($id);
  unlink "$ttmdir/$id";

  my @new_cats = all_categories();
  show_category_changes(\@old_cats, \@new_cats);
}

sub resolve_task {
  my ($id) = @_;
  check_task_exists($id);
  my %task = %{$tasks{$id}};
  $task{status} = 'resolved';
  $task{'complete date'} = scalar localtime;
  $tasks{$id} = \%task;
  print "Resolved task `" . summary($id) . "' (id $id).\nGood going!\n";
}

sub modify_task_status {
  my ($id, $new_status) = @_;
  $new_status ||= '';

  check_task_exists($id);

  my %status = ();
  abbrev(\%status, qw/resolved complete scheduled blocked attended/);
  $new_status = $status{$new_status} if exists $status{$new_status};

  my %task = %{$tasks{$id}};
  $task{status} = $new_status;
  $tasks{$id} = \%task;
    
  if ($new_status) {
    print "Changed status of task `" . summary($id) . "' (id $id) to `$new_status'.\n";
  }
  else {
    print "Removed status from task `" . summary($id) . "' (id $id).\n";
  }
}

sub kill_task {
  my ($id) = @_;

  check_task_exists($id);
  print "About to kill task `" . summary($id) . "' (id $id).\n";
  print "Are you sure? ";
  my $reply = <STDIN>;
  if ($reply =~ /y/i) {
    my @old_cats = all_categories();
    my $doomed = $tasks{$id};
    print "Deleted task `" . summary($id) . "' (id $id)\n";
    delete $tasks{$id};
    my @new_cats = all_categories();
    show_category_changes(\@old_cats, \@new_cats);
  }
}

sub import_from_text_files {
  opendir(DIR, $ttmdir) or die "Couldn't open $ttmdir: $!\n";
  my @task_ids = grep /^\d+$/, readdir(DIR);
  closedir(DIR);
  undef %tasks;
  foreach my $id (@task_ids) {
    read_in_task_from_text_file($id);
  }
}

sub export_to_text_files {
  foreach my $id (keys %tasks) {
    write_task_to_text_file($id);
  }
}


#----------------------------------------------------------------------------#
# auxiliary routines
#----------------------------------------------------------------------------#

sub core_headers {
  return (qw/summary priority categories projects status/, 'date due', 'creation date');
}

sub is_user_header {
  my ($header) = @_;

  my $re = join '|', core_headers();

  return ($header =~ /^(body|$re)$/i) ? 0 : 1;
}

sub is_in_categories {
  my ($id, @categories) = @_;

  my @categories_task_in = split /,\s*/, categories($id);
  my %categories_task_in = map { lc($_) => 1 } @categories_task_in;

  # Return true if task is in /any/ of the provided categories
  foreach my $category (@categories) {
    return $category if exists $categories_task_in{lc $category};
  }

  return 0;
}

sub show_category_changes {
  my ($old, $new) = @_;

  my %categories = map { $_ => 'old' } @$old;
  foreach my $cat (@$new) {
    $categories{$cat} .= 'new';
  }

  my @cats_added = ();
  my @cats_deleted = ();
  foreach my $cat (keys %categories) {
    my $in = $categories{$cat};
    push @cats_added,   $cat if $in eq 'new';
    push @cats_deleted, $cat if $in eq 'old';
  }
  print "Added ", scalar(@cats_added), " new ",
        (@cats_added == 1 ? 'category' : 'categories'),
        ": ",
        join (', ', @cats_added), "\n"
    if @cats_added;
  print "Deleted ", scalar(@cats_deleted), " new ",
        (@cats_deleted == 1 ? 'category' : 'categories'),
        ": ",
        join (', ', @cats_deleted), "\n"
    if @cats_deleted;
}

sub days_old {
    my ($id) = @_;
    my $now = timelocal(localtime());
    my $create_time = $tasks{$id}{'creation date'} || $now ;
    my $days = ($now - $create_time)/86400;
    $days = 999  if $days > 999;
    debug("  days_old($id): ctime=$create_time now=$now");
    return $days;
}

sub overdue {
    my ($id) = @_;
    my $age = days_old($id);
    my $timelimit = $priorities[$tasks{$id}{priority}][2];
    return ($age > $timelimit) ? 1 : 0;
}

sub priority {
  my ($id, $type) = @_;
  $type ||= 'short';

  my $priority = (defined $tasks{$id}{priority}) ? $tasks{$id}{priority} : '';

  return $priority if $type eq 'numeric';

  return '??'
    unless $priority =~ /^\d+$/
       and defined $priorities[$priority];

  return $priorities[$priority][$type eq 'short' ? 0 : 1];
}
            
sub dpriority {
  my ($id) = @_;
  my $prio = (defined $tasks{$id}{priority}) ? $tasks{$id}{priority} : '';
  return ($prio =~ /^\d+$/) ? $prio : $default_priority;
}

sub summary {
  my ($id) = @_;
  return $tasks{$id}{summary} || '<no summary>';
}

sub status {
  my ($id) = @_;
  return $tasks{$id}{status} || 'NEW';
}

sub projects {
  my ($id) = @_;
  return $tasks{$id}{projects} || '';
}

sub categories {
  my ($id) = @_;
  return $tasks{$id}{categories} || '';
}

sub date_due {
  my ($id) = @_;
  return $tasks{$id}{'date due'} || '';
}

sub all_categories {
  my %categories = ();
  foreach my $id (keys %tasks) {
    $categories{$_}++ foreach split m/,\s*/x, categories($id);
  }
  
  return sort keys %categories;
}

sub list_categories {
  print map { "$_\n" } all_categories();
}

sub list_priorities {
  for (0 .. $#priorities) {
    printf "%3d: %-14s (%s)\n", $_, @{$priorities[$_]}[0, 1];
  }
}

sub by_priority {
  return dpriority($a) <=> dpriority($b)
                       ||
                    $a <=> $b;
}

sub check_task_exists {
  my ($id) = @_;
  die "Task $id doesn't exist\n" unless exists $tasks{$id};
}

sub dependencies {
    my ($id)=@_;
    debug("checking deps on [$id]");
    return unless exists $tasks{$id}{dependency};
    my $deps = $tasks{$id}{dependency};
    return if (!defined $deps or $deps =~ /^\s*$/);
    my @deps =  split ( /(\s*,\s*|\s+)/, $deps);
    return grep (/^\d+$/, @deps);
}