UNB/ CS/ David Bremner/ software/ hacks/ karmma.pl

# this ugly hack is by David Bremner, bremner@unb.ca
# it is hereby placed in the Public Domain, while I still can.
# This is really broken with respect to any changes other than 
# to the timers. If you delete a task, it will not go away.
# This may corrupt your files, turn your family pet against you,
# and give you an unpleasant smell. Don't say I didn't warn you.
# $Id: karmma.pl 5570 2006-08-20 19:22:06Z bremner $

# Release 0.1

use Data::ICal;
use Data::Dumper;
use Date::ICal;
use Net::SFTP::Foreign;
use Net::SFTP::Foreign::Util qw( fx2txt );
use Net::SFTP::Foreign::Constants qw( :status );

use Config::Auto;
use File::Temp;
use File::Slurp qw(read_file write_file);

use Getopt::Std;

use strict;

our $opt_Z;


# add a new method without subclassing. Whee, try that in Java
package Data::ICal::Entry;
sub prop{
  my $self=shift;
  my $prop=shift;
  my $ref=$self->property($prop);
  if ($ref){
    return $ref->[0]->value;
  } else {
    return undef;
package main;

sub round {
    my($number) = shift;
    return int($number + .5);

my $config=Config::Auto::parse();

print STDERR "Connecting to ",$config->{remotehost},"\n";
my $sftp = Net::SFTP::Foreign->new($config->{remotehost},debug=>0) || die("sftp: $!");

my $MF = new File::Temp;

my $LC = new File::Temp;

my $localcopy=$LC->filename;

print STDERR "Fetching  ",$config->{remotefile},"\n";
my $status=$sftp->get($config->{remotefile},$localcopy);

if (!defined($status)) {
  die "fetch failed: ",$sftp->status;

my $remotedata=read_file($localcopy);

# this assuming Eunuchs line endings
$remotedata=~ s/\n\s*\n/\n/gs;
print STDERR "parsing remote data...";

my $remotecal=Data::ICal->new( data=>$remotedata) ||die "parsing $!";
print STDERR "done\n";

my $localfile=$config->{localfile} || die("no localfile specified");
my $remotefile=$config->{remotefile} || die("no remotefile specified");

my $caldata="";
open LF, "$localfile" || die "$!";

while(<LF>) {
  next if m/^\s*$/;
  $caldata .= $_;

print STDERR "parsing local data...";
my $localcal = Data::ICal->new( data=>$caldata) ||die "parsing $!";
print STDERR "done.\n";

my %evhash=();
my $evcount=0;
my $updatecount=0;
my @tasks=();
my %total=();
my %taskhash=();
my $zerohour=$opt_Z;

foreach my $entry (@{$localcal->entries}, @{$remotecal->entries}){
  next if ($zerohour && $entry->ical_entry_type eq 'VEVENT');
  if ( $entry->ical_entry_type eq 'VEVENT'){
    my $uid=$entry->prop('uid');
    if (!defined($evhash{$uid})){
      my $parent=$entry->prop('related-to');


      $total{$parent} += $entry->prop('x-kde-karm-duration');
  } elsif ($entry->ical_entry_type eq 'VTODO'){
    my $uid=$entry->prop('uid');

    if (defined($taskhash{$uid})){
      # note, that in the current version (3.4.2) of karm, the 
      # last modified time is the same for every task. So this is bogus-ish
      my $t1=new Date::ICal($taskhash{$uid}->prop('last-modified'));
      my $t2=new Date::ICal($entry->prop('last-modified'));
      $taskhash{$uid}=$entry if ( $t1->compare($t2) <0);
    } else {

  } else {
    die ("Unexpected iCal entry ". $entry->ical_entry_type);

printf STDERR "%d/%d unique events found\n",scalar(keys %evhash),$evcount;
print STDERR $updatecount." tasks updated\n";

print $MF '
PRODID:-//K Desktop Environment//NONSGML libkcal 3.2//EN

foreach my $taskid (keys %taskhash){
  my $task=$taskhash{$taskid};
  my $tot=round($total{$taskid}/60);

  my $str=$task->as_string;
   # this is a grotesque hack
  $str=~ s/^X-KDE-KARM-TOTALSESSIONTIME:.*$/X-KDE-karm-totalSessionTime: 0/m;
  $str=~ s/^X-KDE-KARM-TOTALTASKTIME:.*$/X-KDE-karm-totalTaskTime: $tot/m;
  print  $MF $str;

foreach my $eventid (keys %evhash){
  my $str=$evhash{$eventid}->as_string;
  $str=~ s/^x-kde-karm-duration/X-KDE-karm-duration/im;
  print $MF $str;

print $MF '

my $merged=read_file($MF->filename) || die "reading merged file";

print STDERR "backing up remote file\n";
my $status = $sftp->do_rename($remotefile,$remotefile. "." .time) ;
die fx2txt($status) if ($status != SSH2_FX_OK);

print STDERR "uploading merged file\n";
$sftp->put($MF->filename,$remotefile) || die "upload $!";

print STDERR "backing up local file\n";
rename($localfile, $localfile . ".bak") || die "local backup $!";

print STDERR "updating local file\n";
write_file($localfile,$merged) || die "local update $!";