#!perl
##
##  AS -- Accounting System
##  Copyright (c) 2002 Cable & Wireless Deutschland <http://www.cw.com/de/>
##  Copyright (c) 2002 Ralf S. Engelschall <rse@engelschall.com>
##
##  This file is part of AS, an accounting system which can be
##  found at http://as.is.eu.cw.com/
##
##  This program is free software; you can redistribute it and/or
##  modify it under the terms of the GNU General Public License
##  as published by the Free Software Foundation; either version
##  2.0 of the License, or (at your option) any later version.
##
##  This program is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
##  General Public License for more details.
##
##  You should have received a copy of the GNU General Public License
##  along with this program; if not, write to the Free Software
##  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
##  USA, or contact The OSSP Project <ossp@ossp.org>.
##
##  as-cui: Unix Command-Line Client
##

require 5.003;
use strict;         # OpenPKG >= perl-5.6.1
use IO;             # OpenPKG >= perl-5.6.1
use Getopt::Long;   # OpenPKG >= perl-5.6.1
use Text::Balanced; # OpenPKG >= perl-parse-20021016
use Data::UUID;     # OpenPKG >= perl-crypto-20021030
use String::CRC32;  # OpenPKG >= perl-crypto-20021030

require "as-cui-matrix.pm";
import as_cui_matrix;

#   program version
my $progname = "as";
my $progvers = "0.6.0";

#   data format version
my $datavers = $progvers;
   $datavers =~ s/\.[0-9]+$//;

#   options
my $opt_complete = '';
my $opt_define   = {};
my $opt_verbose  = 0;
my $opt_setup    = 0;
my $opt_download = 0;
my $opt_update   = [];
my $opt_commit   = [];
my $opt_help     = 0;
my $opt_version  = 0;

#   preset options
my @localruntime = localtime(time());

#   internal global structures
my $runtimecfg   = {};
my $accounts     = [];
my $events       = {};
my $matrixdata   = {};

#   exception handling support
$SIG{__DIE__} = sub {
    my ($err) = @_;
    $err =~ s|\s+at\s+.*||s if (not $opt_verbose);
    my $txt = "$err ". ($! ? "($!)" : "");
    print STDERR "ERROR: $txt\n";
    exit(1);
};

#   verbose message printing
sub verbose {
    my ($msg) = @_;
    print STDERR "$msg\n" if ($opt_verbose);
}

#   command line parsing
Getopt::Long::Configure("bundling");
my $result = GetOptions(
    'C|complete=s'  => \$opt_complete,
    'D|define=s'    =>  $opt_define,   #FIXME -Dfoo=bar works but --define foo=bar does not
    'v|verbose'     => \$opt_verbose,
    's|setup'       => \$opt_setup,
    'd|download'    => \$opt_download,
    'u|update:s'    =>  $opt_update,
    'c|commit:s'    =>  $opt_commit,
    'h|help'        => \$opt_help,
    'V|version'     => \$opt_version
) || die "option parsing failed";

#   post-process parsed options
if (($#{$opt_update} >= 0) && ($opt_update->[0] ne "")) {
    @{$opt_update} = split(/,/,join(',',@{$opt_update}));
}

if (($#{$opt_commit} >= 0) && ($opt_commit->[0] ne "")) {
    @{$opt_commit} = split(/,/,join(',',@{$opt_commit}));
}

#   read and set the runtime configuration options
$runtimecfg = &readrc();
foreach my $var (keys %{$opt_define}) {
    $runtimecfg->{$var} = $opt_define->{$var};
}

#   fallbacks
if (not defined($runtimecfg->{"user"})) {
    $runtimecfg->{"user"} = $ENV{LOGNAME};
}
if (not defined($runtimecfg->{"date"})) {
    $runtimecfg->{"date"} = &day(@localruntime);
}
if (not defined($runtimecfg->{"time"})) {
    $runtimecfg->{"time"} = &now(@localruntime);
}
if (not defined($runtimecfg->{"hist"})) {
    $runtimecfg->{"hist"} = 99;
}

#   sanity checks on runtime configuration
if (not $runtimecfg->{"user"} =~ m/^[a-z0-9]+$/) {
    die "sanity check of runtime configuration \"user\" failed for \"$runtimecfg->{user}\".\n";
}
if (not &isvalidyyyymmdd($runtimecfg->{"date"})) {
    die "sanity check of runtime configuration \"date\" failed for \"$runtimecfg->{date}\".\n";
}
if (not &isvalidhhmm($runtimecfg->{"time"})) {
    die "sanity check of runtime configuration \"time\" failed for \"$runtimecfg->{time}\".\n";
}

#   read in the accounts list
$accounts = &readaccounts();

#   short-circuit dispatch
if ($opt_complete ne "") {
    &do_complete($ARGV[0]);
    exit 0;
}

#   read in the events
$events = &readevents();

#   dispatch into sub-routines
if ($opt_setup) {
    &do_setup;
}
elsif ($opt_download) {
    &do_unimplemented;
}
elsif ($#{$opt_update} >= 0) {
    &do_unimplemented;
}
elsif ($#{$opt_commit} >= 0) {
    &do_unimplemented;
}
elsif ($opt_help) {
    print STDOUT "Usage: $progname [options] [arguments]\n" .
                 "Available options:\n" .
                 " -D,--define        opt-name=opt-value\n" .
                 " -v,--verbose       be chatty\n" .
                 " -s,--setup         setup\n" .
                 " -d,--download      download writeable accounts list from server\n" .
                 " -u,--update [uuid] update local database with information from server\n" .
                 " -c,--commit [uuid] commit pending changes to server\n" .
                 " -h,--help          print out this usage page\n" .
                 " -V,--version       print out program version\n";
}
elsif ($opt_version) {
    print STDOUT "$progname $progvers\n";
}
elsif ($#ARGV == -1) {
    #   in CUI mode we do not want STDERR to clutter our screen.
    ($opt_verbose && open STDERR, ">>2.log") || (open STDERR, ">/dev/null");
    &as_cui_matrix::ascuinew($matrixdata, $opt_verbose);
    my $rc;
    do {
        &events2matrix();
        $rc = &as_cui_matrix::ascuido();
        &matrix2events();
        &writeevents() if ($rc =~ m/^(save|exit)$/);
    } while (not $rc =~ m/^(exit|quit)$/);
}
else {
    my $timespec = shift @ARGV;
    if (not defined $timespec) {
        die "CLI timespec missing";
    }
    my $account  = shift @ARGV;
    if (not defined $account) {
        die "CLI account missing";
    }
    if (not &isvalidaccount($account)) {
        die "CLI invalid account \"$account\"";
    }
    if ($account =~ m|^(\.[-a-zA-Z0-9]+)+$|) {
        $account = &dot2slash($account);
    }
    my $remark   = '';
    for my $i (@ARGV) {
        $remark .= $i . " ";
    }
    $remark =~ s/ $//;
    &do_newevent($timespec, $account, $remark);
    &writeevents();
}

exit(0);

#
#   Command Line Argument Completion Utility
#   (see as.bash for context)
#
#   testsuite.sh
#   echo 000; perl as.pl --complete time --             22:33
#   echo 001; perl as.pl --complete time --            =22:33
#   echo 010; perl as.pl --complete time --      -11:22         #defeat leading dash
#   echo 011; perl as.pl --complete time --      -11:22=22:33   #defeat leading dash
#   echo 100; perl as.pl --complete time -- 00:11-
#   echo 101; perl as.pl --complete time -- 00:11-=22:33        #defeat spaces
#   echo 110; perl as.pl --complete time -- 00:11-11:22
#   echo 111; perl as.pl --complete time -- 00:11-11:22=22:33
#
sub do_complete {
    my ($arg) = @_;

    if ($opt_complete eq 'account') {
        if ($arg eq '') {
            print "/\n" . ".\n";
            return;
        }
        else {
            my $pattern = quotemeta($arg);
            foreach my $ac (@{$accounts}) {
                if ($ac->{name} =~ m|^$pattern|) {
                    print "$ac->{name}\n";
                }
            }
            return;
        }
    }
    else {
        die "invalid completion type \"$opt_complete\" (has to be 'account')";
    }
}

sub isvalidhhmm {
    my ($input) = @_;

    if ($input =~ m/([01][0-9]|2[0-4]):[0-5][0-9](:[0-5][0-9])?$/) {
        return 1;
    }
    return 0;
}

sub isvalidyyyymmdd {
    my ($input) = @_;

    if ($input =~ m/^[2-9][0-9]{3}-([0][1-9]|[1][0-2])-([0][1-9]|[12][0-9]|[3][01])$/) {
        return 1;
    }
    return 0;
}

sub isvaliduser {
    my ($user, $status) = (@_);
    return 1 if ($user =~ m|^[a-zA-Z][a-zA-Z0-9]*$|);
    $status->{user} = "user" if (defined $status);
    return 0;
}

sub isvaliduuid {
    my ($uuid, $status) = (@_);
    return 1 if ($uuid =~ m|^[0-9a-fA-F]{8}(-[0-9a-fA-F]{4}){3}-[0-9a-fA-F]{12}$|);
    $status->{uuid} = "uuid" if (defined $status);
    return 0;
}

sub isvalidcrc32 {
    my ($crc32, $status) = (@_);
    return 1 if ($crc32 =~ m|^[0-9a-fA-F]{1,8}$|);
    $status->{crc32} = "crc32" if (defined $status);
    return 0;
}

sub isvalidrevision {
    my ($revision, $status) = (@_);
    return 1 if ($revision =~ m|^[0-9]{1,5}$|);
    $status->{revision} = "revision" if (defined $status);
    return 0;
}

sub isvaliddate {
    my ($date, $status) = (@_);
    return 1 if (&isvalidyyyymmdd($date));
    $status->{date} = "date" if (defined $status);
    return 0;
}

sub isvalidbegin {
    my ($begin, $status) = (@_);
    return 1 if (&isvalidhhmm($begin));
    $status->{begin} = "begin" if (defined $status);
    return 0;
}

sub isvalidend {
    my ($end, $status) = (@_);
    return 1 if (&isvalidhhmm($end));
    $status->{end} = "end" if (defined $status);
    return 0;
}

sub isvalidamount {
    my ($amount, $status) = (@_);
    return 1 if (&isvalidhhmm($amount));
    $status->{amount} = "amount" if (defined $status);
    return 0;
}

sub isvalidaccount {
    my ($account, $status) = (@_);
    if ($account =~ m|^\.|) {
        $account = &dot2slash($account);
    }
    foreach my $element (@{$accounts}) {
        return 1 if ($element->{type} eq "R" and $account =~ m|^$element->{name}$|);
    }
    $status->{account} = "account" if (defined $status);
    return 0;
}

sub isvalidremark {
    my ($amount, $status) = (@_);
    return 1;
}

#
#   make any input a valid date or wipe it out if no conversion possible
#   dot is a valid input and means today
#   today is taken from reality unless overridden by using a second optional parameter
#
sub anydate2yyyymmdd {
    my ($input, @localtime) = (@_);
    my $output;

    if (&isvalidyyyymmdd($input)) {
        $output = $input;
    }
    elsif ($input =~ m|^\.$|) {
        $output = &day(@localtime);
    }
    else {
        $output = "";
    }
    return $output;
}

#
#   make any input a valid time or wipe it out if no conversion possible
#   dot is a valid input and means now
#   now is taken from reality unless overridden by using a second optional parameter
#
sub anytime2hhmm {
    my ($input, @localtime) = (@_);
    my $output = "";

    if (&isvalidhhmm($input)) {
        $output = $input;
    }
    elsif ($input =~ m|^\.$|) {
        $output = &now(@localtime);
    }
    elsif ($input =~ m/^([1-9])?(:([0-9]|[0-5][0-9])?)?$/) {
        #   short
        $output = sprintf("%02d:%02d", $1, $3);
    }
    elsif ($input =~ m/^([0-9]|[1][0-9]|2[0-4])?:([0-9]|[0-5][0-9])?$/) {
        #   short-hour
        $output = sprintf("%02d:%02d", $1, $2);
    }
    elsif ($input =~ m/^([0-9]*\.[0-9]+|[0-9]+\.)$/) {
        #    frac-dec
        my $f = "0".$1;
        $f = int($f * 60 + 0.5);
        my $h = $f / 60;
        my $m = $f % 60;
        $output = sprintf("%02d:%02d", $h, $m);
    }
    elsif ($input =~ m/^([0-9]*\/[1-9][0-9]*)$/) {
        #    frac-std
        my $f = $1;
        $f =~ s|^/|1/|s;
        eval "\$f = int(($f) * 60 + 0.5);";
        my $h = $f / 60;
        my $m = $f % 60;
        $output = sprintf("%02d:%02d", $h, $m);
    }
    elsif ($input =~ m/^0([0-9])$/) {
        #   force-min
        $output = "00:0$1";
    }
    elsif ($input =~ m/^([1-9][0-9]+)$/) {
        #   short-min
        my $h = int($1 / 60);
        my $m = int($1 % 60);
        $output = sprintf("%02d:%02d", $h, $m);
    }
    else {
        $output = "";
    }
    return $output;
}

#
#   Read rc file
#
sub readrc {
    my $rc = {};
    my $path;
    my $io;

    #   in setup mode, no access to the file is no reason to die; just return no data
    if ($opt_setup) {
        ($path, $io) = &openfile("rc", "x");
        if (not $io) {
            return $rc;
        }
    }

    ($path, $io) = &openfile("rc", "r");
    my $line = 1;
    my $ln;
    while (defined($ln = <$io>)) {
        $line++;
        $ln =~ s|^\s*||s;            #strip off leading spaces
        $ln =~ s|\s*(#.*)?$||s;      #strip off trailing spaces and comments
        next if ( $ln =~ m|^\s*$| ); #ignore empty lines
        my $remainder = $ln;
        my $q = '"';

        my $var;
        if ($remainder =~ m|^$q|) {
            ($var, $remainder) = Text::Balanced::extract_delimited($remainder, $q);
            $var =~ s|^$q(.*)$q$|$1|;
        } else {
            $_ = $remainder;
            ($var, $remainder) = m|^([^\s]*)(.*)$|;
        }
        $var =~ s|\\(.)|$1|g;
        $remainder =~ s|^\s*(.*)$|$1|;

        my $val;
        if ($remainder =~ m|^$q|) {
            ($val, $remainder) = Text::Balanced::extract_delimited($remainder, $q);
            $val =~ s|^$q(.*)$q$|$1|;
        } else {
            $_ = $remainder;
            ($val, $remainder) = m|^([^\s]*)(.*)$|;
        }
        $val =~ s|\\(.)|$1|g;
        $remainder =~ s|^\s*(.*)$|$1|;

        if ($remainder ne "") {
            die "syntax error in $path, line $line: unexpected data \"$remainder\" found.\n";
        }

        $rc->{$var} = $val;
    }
    &closefile($io);

    return $rc;
}

#
#   Read accounts file
#
sub readaccounts {
    my $ac = [];
    my $path;
    my $io;

    #   in setup mode, no access to the file is no reason to die; just return no data
    if ($opt_setup) {
        ($path, $io) = &openfile("accounts", "x");
        if (not $io) {
            return $ac;
        }
    }

    ($path, $io) = &openfile("accounts", "r");
    my $line = 1;
    my $ln;
    while (defined($ln = <$io>)) {
        $line++;
        $ln =~ s|^\s*||s;            #strip off leading spaces
        $ln =~ s|\s*(#.*)?$||s;      #strip off trailing spaces and comments
        next if ( $ln =~ m|^\s*$| ); #ignore empty lines
        my $remainder = $ln;
        my $q = '"';

        my $type;
        if ($remainder =~ m|^$q|) {
            ($type, $remainder) = Text::Balanced::extract_delimited($remainder, $q);
            $type =~ s|^$q(.*)$q$|$1|;
        } else {
            $_ = $remainder;
            ($type, $remainder) = m|^([^\s]*)(.*)$|;
        }
        $type =~ s|\\(.)|$1|g;
        $remainder =~ s|^\s*(.*)$|$1|;
        if (($type ne "A") && ($type ne "R")) {
            die "syntax error in $path, line $line: unexpected type \"$type\" found.\n";
        }

        my $name;
        if ($remainder =~ m|^$q|) {
            ($name, $remainder) = Text::Balanced::extract_delimited($remainder, $q);
            $name =~ s|^$q(.*)$q$|$1|;
        } else {
            $_ = $remainder;
            ($name, $remainder) = m|^([^\s]*)(.*)$|;
        }
        $name =~ s|\\(.)|$1|g;
        $remainder =~ s|^\s*(.*)$|$1|;
        if (not $name =~ m|^/[-a-zA-Z0-9/]+[^/]$|) {
            die "syntax error in $path, line $line: unexpected name \"$name\" found.\n";
        }

        my $desc;
        if ($remainder =~ m|^$q|) {
            ($desc, $remainder) = Text::Balanced::extract_delimited($remainder, $q);
            $desc =~ s|^$q(.*)$q$|$1|;
        } else {
            $_ = $remainder;
            ($desc, $remainder) = m|^([^\s]*)(.*)$|;
        }
        $desc =~ s|\\(.)|$1|g;
        $remainder =~ s|^\s*(.*)$|$1|;

        if ($remainder ne "") {
            die "syntax error in $path, line $line: unexpected data \"$remainder\" found.\n";
        }

        my $sname = $name;
        $sname .= "/" if ($type ne "R");
        my $dname = &slash2dot($sname);
        push (@{$ac}, { type=>$type, name=>$sname, desc=>$desc });
        push (@{$ac}, { type=>$type, name=>$dname, desc=>$desc });

    }
    &closefile($io);
    return $ac;
}

#
#   Slash to dot account name conversion
#
sub slash2dot {
    my ($sname) = @_;

    $sname =~ s|^/||;
    my $dname = '';
    foreach my $part (reverse(split(/\//, $sname))) {
        $dname .= "." . $part;
    }
    return $dname;
}

#
#   Dot to slash account name conversion
#
sub dot2slash {
    my ($dname) = @_;

    $dname =~ s|^.||;
    my $sname = '';
    foreach my $part (reverse(split(/\./, $dname))) {
        $sname .= "/" . $part;
    }
    return $sname;
}

#
#   Complete possible account list based on given pattern
#
sub completeaccount {
    my ($pattern) = @_;
    $pattern = quotemeta($pattern);
    my $acs = [];
    foreach my $ac (@{$accounts}) {
        if ($ac->{name} =~ m|^$pattern|) {
            push @{$acs}, $ac->{name};
        }
    }
    return $acs;
}

#
#   Read events file
#
sub readevents {
    my $ev = {};
    my $path;
    my $io;

    #   in setup mode, no access to the file is no reason to die; just return no data
    if ($opt_setup) {
        ($path, $io) = &openfile("events", "x");
        if (not $io) {
            return $ev;
        }
    }

    ($path, $io) = &openfile("events", "r");
    my $line = 1;
    my $ln;
    while (defined($ln = <$io>)) {
        $line++;

        my $event = &ln2event($ln, $line);
        next unless (defined $event);

        &processeventfields($event, qw/status/);
        if ($event->{status} eq "E") {
            die "syntax error in $path, line $line: $event->{error}\n";
        }

        &processeventfields($event, qw/user uuid revision date begin end amount account remark status/);

        my $uuid = $event->{uuid};
        if (defined %{$ev}->{$uuid}) {
            die "consistency error in $path, line $line: duplicate uuid \"$uuid\" first seen in line $ev->{$uuid}->{line}.\n";
        }

        if ($event->{status} eq "E") {
            print STDERR "WARNING: bad event in $path, line $line: $event->{error}\n";
        }

        &setevent($ev, $event);
    }
    &closefile($io);
    return $ev;
}

#
#   Write events file
#
sub writeevents {
    my $path;
    my $io;

    ($path, $io) = &openfile("events", "w");
    my $line = 1;
    my $ln;
    foreach my $uuid (sort bydateline keys %{$events}) {
        $line++;
        my $event = &getevent($events, $uuid);
        &processeventfields($event, qw/crc32/);
        $ln = &event2ln($event);
        print $io "$ln\n";
        };
    &closefile($io);
    return;
}

#
#
#
sub formattimespec {
    my ($begin, $end, $amount) = (@_);
    return $begin . "-" .  $end . "=" . $amount;
}

#
#   optional quoting
#   if arg is not empty and contains neither backslash, doublequote nor whitespace keep verbatim
#   otherwise escape backslash and doublequotes with backslash and put doublequotes around result
#
sub quote {
    my ($q) = (@_);

    return $q unless $q =~ m/[\\"\s]/ || $q eq '';

    $q =~ s/([\\"])/\\$1/g;
    return '"' . $q . '"';
}                                                                                                                       

#
#   sort by date with fallback to begin/line and finally uuid
#
sub bydateline {
    # by date
    if (%{$events}->{$a}->{date} != %{$events}->{$b}->{date}) {
        return %{$events}->{$a}->{date} <=> %{$events}->{$b}->{date};
    }
    # by begin time
    if (%{$events}->{$a}->{begin} != %{$events}->{$b}->{begin}) {
        return %{$events}->{$a}->{begin} <=> %{$events}->{$b}->{begin};
    }
    # by line with commandline entries to the end
    if (%{$events}->{$a}->{line} eq "commandline") {
        return  1;
    }
    if (%{$events}->{$b}->{line} eq "commandline") {
        return -1;
    }
    if (%{$events}->{$a}->{line} != %{$events}->{$b}->{line}) {
        return %{$events}->{$a}->{line} <=> %{$events}->{$b}->{line};
    }
    # fallback to uuid
    return $a <=> $b;
}

#
#   split with support for balanced quotes
#
sub splitq {
    my ($ln) = @_;

    my $q = '"';
    my $remainder = $ln;
    my $field = '';

    if ($remainder =~ m|^$q|) {
        ($field, $remainder) = Text::Balanced::extract_delimited($remainder, $q);
        $field =~ s|^$q(.*)$q$|$1|;
    } else {
        $_ = $remainder;
        ($field, $remainder) = m|^([^\s]*)(.*)$|;
    }
    $field =~ s|\\(.)|$1|g;
    $remainder =~ s|^[ ]*||;
    return $field, $remainder;
}

#
#   Calculate CRC32 for an entry referenced by uuid
#
sub calccrc32 {
    my ($event) = @_;

    my $crc32 = 0;
    foreach my $f (qw/user uuid revision date begin end amount account remark/) {
        my $field = $event->{$f};
        $field = "" unless (defined $field);
        $crc32 = &crc32($field, $crc32);
    }
    return sprintf("%08x", $crc32);
}

#
#   open file and check/set for magic cookie on the first line
#
#   INPUT
#   $mode = "r" - open for reading and check cookie - die on error
#   $mode = "w" - open for writing and set cookie - die on error
#   $mode = "x" - test for existance and check cookie
#
#   OUTPUT
#   $path always returns the full path name of the file
#   $io   on read/write returns IO::File handle
#   $io   on existance test returns 0 (no) or 1 (yes)
#
sub openfile {
    my ($file, $mode) = @_;

    my $path = "$ENV{HOME}/.as/$file";
    my $magic = uc($file);

    if    ($mode eq "r") {
        my $io = new IO::File "<$path";
        if (not defined($io)) {
            die "unable to open file \"$path\" for reading [hint: did you ever set up using -s?]";
        }
        my $rc = <$io>;
        if (not $rc =~ m/^%!AS-$magic-$datavers$/ ) {
            die "file \"$path\" fails magic cookie check for %!AS-$magic-$datavers";
        }
        return $path, $io;
    }
    elsif ($mode eq "w") {
        #   keep a history before overwriting
        if (-f $path) {
            my $f=".%0" . int(log($runtimecfg->{hist}) / log(10) + 1) . "d";
            for(my $i = $runtimecfg->{hist}; $i >= 1; $i--) {
                my $s = $i == 1 ? '' : sprintf($f, $i - 1);
                my $t =                sprintf($f, $i);
                rename "$path$s", "$path$t" if (-f "$path$s");
            }
        }
        my $io = new IO::File ">$path";
        if (not defined($io)) {
            die "unable to open file \"$path\" for writing";
        }
        my $rc = "%!AS-$magic-$datavers\n";
        if (not defined (print $io $rc)) {
            die "file \"$path\" fails magic cookie write for %!AS-$magic-$datavers";
        }
        return $path, $io;
    }
    elsif ($mode eq "x") {
        my $flag = 0;
        my $io = new IO::File "<$path";
        if (defined($io)) {
            my $rc = <$io>;
            &closefile($io);
            if ($rc =~ m/^%!AS-$magic-$datavers$/ ) {
                $flag = 1;
            }
        }
        return $path, $flag;
    }
    die "INTERNAL: openfile() called with unknown mode \"$mode\"";
}

#
#   close file previously opened by openfile()
#
sub closefile {
    my ($io) = @_;

    if (defined($io)) {
        $io->close();
    } else {
        die "INTERNAL: closefile() called on undefined file handle\n";
    }
    return;
}

#
#   setup $HOME/.as
#
sub do_setup {
    my $path;
    my $io;

    #   try an open just to figure out the path
    ($path, $io) = &openfile("rc", "x");
    $path =~ s|/[^/]*$||;

    #   create the folder, if it doesn't exist
    if (not -d $path) {
        mkdir $path, 0750 || die "cannot create directory \"$path\"";
    }

    #   write the "rc" file
    my $quote = '"';
    my $backslash = '\\';
    ($path, $io) = &openfile("rc", "w");
    foreach my $var (keys %{$runtimecfg}) {
        my $val = $runtimecfg->{$var};
        $val =~ s/([\\$quote\s])/$backslash$1/g;  #FIXME poor man's escaping - hint: try quotemeta()
        print $io "$var $quote$val$quote\n";
    }
    &closefile($io);

    #   write the "accounts" file
    ($path, $io) = &openfile("accounts", "w");
    print $io "A /example         \"an example account\"\n";
    print $io "R /example/account \"please get a real account list\"\n";
    &closefile($io);

    #   write the "events" file
    ($path, $io) = &openfile("events", "w");
    print $io "#user 12345678-9abc-def0-1234-56789abcdef0 01234567 00001 20021204 10:00-11:00=01:00 /example/account \"example entry showing complete timespec\"           #comment\n";
    print $io "#user 12345678-9abc-def0-1234-56789abcdef1 01234567 00001 20021204 10:00-11:00=      /example/account \"example entry showing how to calc amount\"          #comment\n";
    print $io "#user 12345678-9abc-def0-1234-56789abcdef2 01234567 00001 20021204 10:00-=01:00      /example/account \"example entry showing how to calc end\"             #comment\n";
    print $io "#user 12345678-9abc-def0-1234-56789abcdef3 01234567 00001 20021204 -11:00=01:00      /example/account \"example entry showing how to calc begin\"           #comment\n";
    print $io "#user 12345678-9abc-def0-1234-56789abcdef4 01234567 00001 20021204 -.=01:00          /example/account \"example entry showing how to calc begin until now\" #comment\n";
    print $io "#user 12345678-9abc-def0-1234-56789abcdef5 01234567 00001 20021204 .-=01:00          /example/account \"example entry showing how to calc end upto now\"    #comment\n";
    &closefile($io);
}

#
#   create an new event
#
sub do_newevent {
    my ($timespec, $account, $remark) = @_;

    #   preset
    my  $uuid     = &newuuid();
    my  $line     = "cli";
    my  $user     = $runtimecfg->{user};
    my  $crc32    = undef;
    my  $revision = 0;
    my  $date     = $runtimecfg->{date};
    my ($begin,
        $end,
        $amount)  = &splittimespec($timespec);

    #   time calculation
    ($begin, $end, $amount) = &calctime($begin, $end, $amount);

    #   sanity check
    if (not &isvalidhhmm($begin)) {
        die "unexpected begin \"$begin\" found.\n";
    }

    if (not &isvalidhhmm($end)) {
        die "unexpected end \"$end\" found.\n";
    }

    if (not &isvalidhhmm($amount)) {
        die "unexpected amount \"$amount\" found.\n";
    }

    #   create new uuid and store new event in memory
    %{$events}->{$uuid} = {
        line     => $line,
        user     => $user,
        crc32    => $crc32,
        revision => $revision,
        date     => $date,
        begin    => $begin,
        end      => $end,
        amount   => $amount,
        account  => $account,
        remark   => $remark,
        error    => undef
    };
    return $uuid;
}

#
#   create an new cui event from scratch or paste in data from optional given event
#
sub cuinewevent {
    my ($paste) = @_;
    my $event = {
        "uuid"     => $paste->{"uuid"}     || &newuuid(),
        "line"     => $paste->{"line"}     || "+",
        "user"     => $paste->{"user"}     || $runtimecfg->{user},
        "crc32"    => $paste->{"crc32"}    || undef,
        "revision" => $paste->{"revision"} || 0,
        "date"     => $paste->{"date"}     || $runtimecfg->{date},
        "begin"    => $paste->{"begin"}    || "00:00",
        "end"      => $paste->{"end"}      || "24:00",
        "amount"   => $paste->{"amount"}   || "08:00",
        "account"  => $paste->{"account"}  || "",
        "remark"   => $paste->{"remark"}   || "",
        "error"    => $paste->{"error"}    || undef
    };
    &setevent($events, $event);
    return $event;
}

#
#   create uuid and check for uniqness in local database
#
sub newuuid {
    my $ug = new Data::UUID;
    my $uuidinternal = $ug->create();
    my $uuid = lc $ug->to_string($uuidinternal);
    if (defined %{$events}->{$uuid}) {
        die "consistency error: duplicate uuid \"$uuid\" first seen in line $events->{$uuid}->{line}.\n";
    }
    return $uuid;
}

#
#   splittimespec
#
sub splittimespec {
    my ($timespec) = @_;
    my $begin   = '00:00';
    my $end     = '24:00';
    my $amount  = '';
    my $compute = '';
    my $beginsec;
    my $endsec;
    my $amountsec;

    if ($timespec =~ m/^(([^-]+)?-([^=]+)?)?=?(.*)$/) { #( begin? - end? )? =? amount*
        ($begin, $end, $amount) = ($2, $3, $4);
    }
    $begin  = &anytime2hhmm($begin);
    $end    = &anytime2hhmm($end);
    $amount = &anytime2hhmm($amount);
    return $begin, $end, $amount;
}

#
#   calculate missing time only if exactly two valid times are given
#
sub calctime {
    my ($begin, $end, $amount) = @_;

    if ((not &isvalidhhmm($begin)) && &isvalidhhmm($end) && &isvalidhhmm($amount)) {
        $begin = &calcbegin($end, $amount);
    }
    if (&isvalidhhmm($begin) && (not &isvalidhhmm($end)) && &isvalidhhmm($amount)) {
        $end = &calcend($begin, $amount);
    }
    if (&isvalidhhmm($begin) && &isvalidhhmm($end) && (not &isvalidhhmm($amount))) {
        $amount = &calcamount($begin, $end);
    }
    return $begin, $end, $amount;
}

sub calcbegin {
    my ($end, $amount) = @_;
    my $begin = '';

    if (($end ne '') && ($amount ne '')) {
        $end    = &anytime2hhmm($end);
        $amount = &anytime2hhmm($amount);
        $begin  = &sec2hhmm(&hhmm2sec($end) - &hhmm2sec($amount));
    }
    return $begin;
}
sub calcend {
    my ($begin, $amount) = @_;
    my $end = '';

    if (($begin ne '') && ($amount ne '')) {
        $begin  = &anytime2hhmm($begin);
        $amount = &anytime2hhmm($amount);
        $end    = &sec2hhmm(&hhmm2sec($begin) + &hhmm2sec($amount));
    }
    return $end;
}
sub calcamount {
    my ($begin, $end) = @_;
    my $amount = '';

    if (($begin ne '') && ($end ne '')) {
        $begin  = &anytime2hhmm($begin);
        $end    = &anytime2hhmm($end);
        $amount = &sec2hhmm(&hhmm2sec($end) - &hhmm2sec($begin));
    }
    return $amount;
}

sub hhmm2sec {
    my ($hhmm) = (@_);
    my $rv = undef;
    if ($hhmm =~ m/^([0-1]?[0-9]|2[0-4]):([0-5]?[0-9])$/) {
        $rv = $1 * 3600 + $2 * 60;
    }
    return $rv;
}

sub sec2hhmm {
    my ($sec) = (@_);
    $sec %= 86400; #sec/day
    $sec = 86400 - $sec if ($sec < 0);
    my $minutes = int($sec / 60);
    my $hour = int($minutes / 60);
    my $min  = int($minutes % 60);
    return sprintf("%02d:%02d", $hour, $min);
}

sub day {
    my (@localtime) = (@_);
    my $rv;
    @localtime = (localtime(time)) unless @localtime;
    my ($day, $month, $year) = (@localtime[3,4,5]);
    $month++;
    $year += 1900;
    $rv = sprintf("%04d-%02d-%02d", $year, $month, $day);
    return $rv;
}

sub now {
    my (@localtime) = (@_);
    my $rv;
    @localtime = (localtime(time)) unless @localtime;
    my ($sec, $min, $hour) = (@localtime[0,1,2]);
    $rv = sprintf("%02d:%02d", $hour, $min);
    return $rv;
}

#
#   setup $HOME/.as
#
sub do_unimplemented {
    die "Sorry, this function is currently not implemented\n";
}

#
#   create a data matrix from events
#
sub events2matrix {

    my $c;
    my $r;
    my $label;

    #   fill in information about column headers (top)
    $c = -1;
    $label = "status"  ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "#"       , "Labelhide" => 0, "Widthmin"  =>  1, "Widthmax"  =>  1, "Width"  =>  1, "Widthweight" =>  0, "Colgap" => 1, "Colhide" => 0, "Coljump" => 0, "Coleditable" => 0 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "uuid"    ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "UUID"    , "Labelhide" => 0, "Widthmin"  => 36, "Widthmax"  => 36, "Width"  => 36, "Widthweight" =>  0, "Colgap" => 1, "Colhide" => 0, "Coljump" => 0, "Coleditable" => 0 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "line"    ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Line"    , "Labelhide" => 0, "Widthmin"  =>  3, "Widthmax"  =>  5, "Width"  =>  4, "Widthweight" =>  0, "Colgap" => 1, "Colhide" => 0, "Coljump" => 0, "Coleditable" => 0 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "user"    ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "User"    , "Labelhide" => 0, "Widthmin"  =>  2, "Widthmax"  =>  8, "Width"  =>  8, "Widthweight" =>  0, "Colgap" => 1, "Colhide" => 0, "Coljump" => 0, "Coleditable" => 1 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "crc32"   ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "CRC"     , "Labelhide" => 0, "Widthmin"  =>  8, "Widthmax"  =>  8, "Width"  =>  8, "Widthweight" =>  0, "Colgap" => 1, "Colhide" => 0, "Coljump" => 0, "Coleditable" => 0 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "revision"; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Rev."    , "Labelhide" => 0, "Widthmin"  =>  1, "Widthmax"  =>  5, "Width"  =>  5, "Widthweight" =>  0, "Colgap" => 1, "Colhide" => 0, "Coljump" => 0, "Coleditable" => 0 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "date"    ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Date"    , "Labelhide" => 0, "Widthmin"  =>  8, "Widthmax"  => 10, "Width"  => 10, "Widthweight" =>  0, "Colgap" => 1, "Colhide" => 0, "Coljump" => 1, "Coleditable" => 1 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "begin"   ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Begin"   , "Labelhide" => 0, "Widthmin"  =>  5, "Widthmax"  =>  5, "Width"  =>  5, "Widthweight" =>  0, "Colgap" => 1, "Colhide" => 0, "Coljump" => 1, "Coleditable" => 1 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "end"     ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "End"     , "Labelhide" => 0, "Widthmin"  =>  5, "Widthmax"  =>  5, "Width"  =>  5, "Widthweight" =>  0, "Colgap" => 1, "Colhide" => 0, "Coljump" => 1, "Coleditable" => 1 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "amount"  ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Amnt."   , "Labelhide" => 0, "Widthmin"  =>  5, "Widthmax"  =>  5, "Width"  =>  5, "Widthweight" =>  0, "Colgap" => 1, "Colhide" => 0, "Coljump" => 1, "Coleditable" => 1 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "account" ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Account" , "Labelhide" => 0, "Widthmin"  => 10, "Widthmax"  => 44, "Width"  => 21, "Widthweight" => 10, "Colgap" => 1, "Colhide" => 0, "Coljump" => 1, "Coleditable" => 1 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "remark"  ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Remark"  , "Labelhide" => 0, "Widthmin"  => 10, "Widthmax"  => 44, "Width"  => 21, "Widthweight" =>  5, "Colgap" => 1, "Colhide" => 0, "Coljump" => 0, "Coleditable" => 1 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "error"   ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Error"   , "Labelhide" => 0, "Widthmin"  => 10, "Widthmax"  => 44, "Width"  => 21, "Widthweight" =>  1, "Colgap" => 1, "Colhide" => 0, "Coljump" => 0, "Coleditable" => 0 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $matrixdata->{"Columns"}   = $c;

    #   fill in information about row headers (left) and cell data
    $r = -1;
    &matrixrowstatus($r, "$r");
    $r++;

    #   fill in status
    foreach my $uuid (keys %{$events}) {
        &matrixrowset($r, $uuid, $events->{$uuid}->{status});
        $r++;
    }
    $matrixdata->{"Rows"}      = $r;

    $matrixdata->{"onanewline"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        my $sc;

        my $pred = $dr;     #predecessor of new line is current line
        my $succ = $dr + 1; #successor of new line is next line

        my $date;
        $sc = $matrixdata->{"CK.date"};
        if ($sc < $matrixdata->{"Columns"} and &isvalidyyyymmdd($matrixdata->{"CD.$sc.$pred"}->{"Data"})) {
            $date = $matrixdata->{"CD.$sc.$pred"}->{"Data"};
        }
        else {
            $date = &day();
        }

        my $begin;
        $sc = $matrixdata->{"CK.end"};
        if ($sc < $matrixdata->{"Columns"} and &isvalidhhmm($matrixdata->{"CD.$sc.$pred"}->{"Data"})) {
            $begin = $matrixdata->{"CD.$sc.$pred"}->{"Data"};
        }
        else {
            $begin = "";
        }

        my $end;
        $sc = $matrixdata->{"CK.begin"};
        if ($sc < $matrixdata->{"Columns"} and &isvalidhhmm($matrixdata->{"CD.$sc.$succ"}->{"Data"})) {
            $end = $matrixdata->{"CD.$sc.$succ"}->{"Data"};
        }
        else {
            $end = ($begin eq "") ? "" : &now();
        }

        my $paste = {
            "date"     => $date,
            "begin"    => $begin,
            "end"      => $end,
            "amount"   => "",
        };
        my $event = &cuinewevent($paste);
        &matrixinsertafter($dr, $event->{uuid}, "N");
    };
    $matrixdata->{"Onanewline"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        my $sc;

        my $pred = $dr - 1; #predecessor of new line is previous line
        my $succ = $dr;     #successor of new line is current line

        my $date;
        $sc = $matrixdata->{"CK.date"};
        if ($sc < $matrixdata->{"Columns"} and &isvalidyyyymmdd($matrixdata->{"CD.$sc.$pred"}->{"Data"})) {
            $date = $matrixdata->{"CD.$sc.$pred"}->{"Data"};
        }
        else {
            $date = &day();
        }

        my $begin;
        $sc = $matrixdata->{"CK.end"};
        if ($sc < $matrixdata->{"Columns"} and &isvalidhhmm($matrixdata->{"CD.$sc.$pred"}->{"Data"})) {
            $begin = $matrixdata->{"CD.$sc.$pred"}->{"Data"};
        }
        else {
            $begin = "";
        }

        my $end;
        $sc = $matrixdata->{"CK.begin"};
        if ($sc < $matrixdata->{"Columns"} and &isvalidhhmm($matrixdata->{"CD.$sc.$succ"}->{"Data"})) {
            $end = $matrixdata->{"CD.$sc.$succ"}->{"Data"};
        }
        else {
            $end = ($begin eq "") ? "" : &now();
        }
        my $paste = {
            "date"     => $date,
            "begin"    => $begin,
            "end"      => $end,
            "amount"   => "",
        };
        my $event = &cuinewevent($paste);
        &matrixinsertrowat($dr, $event->{uuid}, "N");
    };
    $matrixdata->{"deletedelete"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        my $event = &matrixrow2event($dr);
        push @{$matrixdata->{"undobuffer"}}, $event;
        return &matrixdeleterow($dr);
    };
    $matrixdata->{"undo"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        my $paste = pop @{$matrixdata->{"undobuffer"}};
        if (defined $paste) {
            my $event = &cuinewevent($paste);
            &matrixinsertrowat($dr, $event->{uuid}, "U");
            return 1;
        }
        return 0;
    };
    $matrixdata->{"completeaccount"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr, $pattern) = (@_);
        return &completeaccount($pattern);
    };
    $matrixdata->{"completedate"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr, $text) = (@_);
        return &anydate2yyyymmdd($text);
    };
    $matrixdata->{"completetime"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr, $text) = (@_);
        return &anytime2hhmm($text);
    };
    $matrixdata->{"yankcell"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        if (defined $matrixdata->{"yankrow"}) {
            &matrixrowstatus($matrixdata->{"yankrow"})
        }
        $matrixdata->{"clipboard"} = $matrixdata->{"CD.$dc.$dr"}->{"Data"};
        $matrixdata->{"clipboardtype"} = "cell";
        $matrixdata->{"yankrow"} = $dr;
        &matrixrowstatus($dr, "y");
    };
    $matrixdata->{"Yankline"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        if (defined $matrixdata->{"yankrow"}) {
            &matrixrowstatus($matrixdata->{"yankrow"});
        }
        my $event = &matrixrow2event($dr);
        for my $k (keys %{$event}) {
            delete $event->{$k} unless ($k =~ m/^(user|date|begin|end|amount|account|remark)$/);
        }
        $matrixdata->{"clipboard"} = $event;
        $matrixdata->{"clipboardtype"} = "line";
        $matrixdata->{"yankrow"} = $dr;
        &matrixrowstatus($dr, "Y");
    };
    $matrixdata->{"paste"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        if ($matrixdata->{"clipboardtype"} eq "cell") {
            $matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixdata->{"clipboard"};
            return 1;
        }
        elsif ($matrixdata->{"clipboardtype"} eq "line") {
            my $event = &cuinewevent($matrixdata->{"clipboard"});
            &matrixinsertafter($dr, $event->{uuid}, "N");
            return 1;
        }
        return 0;
    };
    $matrixdata->{"Paste"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        if ($matrixdata->{"clipboardtype"} eq "line") {
            my $event = &cuinewevent($matrixdata->{"clipboard"});
            &matrixinsertrowat($dr, $event->{uuid}, "N");
            return 1;
        }
        return 0;
    };
    $matrixdata->{"currentdatetime"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        my $k = $matrixdata->{"CH.$dc"}->{"Keyname"};
        my $text = undef;
        if ($k =~ m/^(date)$/) {
            $text = &day();
        }
        elsif ($k =~ m/^(begin|end|amount)$/) {
            $text = &now();
        }
        if (defined $text) {
            $matrixdata->{"CD.$dc.$dr"}->{"Data"} = $text;
            return 1;
        }
        return 0;
    };
    $matrixdata->{"copycellfromprevrow"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        my $drsource = $dr - 1;
        if ($matrixdata->{"CH.$dc"}->{"Coleditable"} and $drsource >= 0) {
            $matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixdata->{"CD.$dc.$drsource"}->{"Data"};
            return 1;
        }
        return 0;
    };
    $matrixdata->{"copycellfromsuccrow"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        my $drsource = $dr + 1;
        if ($matrixdata->{"CH.$dc"}->{"Coleditable"} and $drsource < $matrixdata->{"Rows"}) {
            $matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixdata->{"CD.$dc.$drsource"}->{"Data"};
            return 1;
        }
        return 0;
    };
    $matrixdata->{"sort"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        &matrixsort($dr);
    };

    $matrixdata->{"Sortorder"} = [
        $matrixdata->{"CK.date"},
        $matrixdata->{"CK.begin"},
        $matrixdata->{"CK.line"}
        ] if (not defined $matrixdata->{"Sortorder"});
    &matrixsort();
}

sub matrixsort {
    my $nextrow;
    my $r;
    my $current = {};

    $nextrow = $matrixdata->{"Rows"};
    for ($r = 0; $r < $nextrow; $r++) {
        my $collect = [];
        my $coindex = 0;
        foreach my $criteria (@{$matrixdata->{"Sortorder"}}) {
            $collect->[$coindex] = $matrixdata->{"CD.$criteria.$r"}->{"Data"} . " ";
            $coindex++;
        }
        $current->{"$r"} = $collect;
    }

    #   copy the sorted cell data to a new temporary target
    my $newmatrixdata = {};
    my $targetrow = 0;
    my $sourcerow;
    foreach my $sourcerow (sort
    {
        my $result = 0;
        my $coindex = 0;
        while ($result == 0) {
            last if (   (not defined $current->{$a}->[$coindex])
                     or (not defined $current->{$b}->[$coindex])
                       );
            $result = $current->{$a}->[$coindex] cmp $current->{$b}->[$coindex];
            $coindex++
        }
        return $result;
    }
    keys %{$current}) {
        $newmatrixdata->{"RH.$targetrow"} = $matrixdata->{"RH.$sourcerow"};
        for (my $c = 0; $c < $matrixdata->{"Columns"}; $c++) {
            $newmatrixdata->{"CD.$c.$targetrow"} = $matrixdata->{"CD.$c.$sourcerow"};
            #delete $matrixdata->{"CD.$c.$sourcerow"};
        }
        $targetrow++;
    }

    #   copy the temporary data back to the original hash
    foreach my $element (keys %{$newmatrixdata}) {
        $matrixdata->{$element} = $newmatrixdata->{$element};
    }
}

sub matrixrowstatus {
    my ($r, $status) = (@_);
    my $event = &matrixrow2event($r);
    if (defined $status) {
        $event->{status} = $status;
    }
    else {
        &processeventfields($event, qw/status/);
        $status = $event->{$status};
    }
    my $label = sprintf("%1s", $status);
    $matrixdata->{"RH.$r"} = { "Label" => "$label"  , "Labelhide" => 0, "Heightmin" => 1, "Heightmax" =>  1, "Height" =>  1, "Rowgap" => 0, "Rowhide" => 0 };
}

sub matrixrowset {
    my ($r, $uuid, $label) = (@_);
    my $c;

    &matrixrowstatus($r, "$label");

    $c = $matrixdata->{"CK.uuid"};
    $label = sprintf("%36s", $uuid);
    $matrixdata->{"CD.$c.$r"} = {
        "Data" => "$label",
        "Focuscallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        },
        "Blurcallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
            $matrixwidget->{"VC.$vc.$vr"}->{-text} = $matrixdata->{"CD.$dc.$dr"}->{"Data"}; #view original data = read only
            return 0;
        }
    };

    $c = $matrixdata->{"CK.line"};
    $label = sprintf("%4s", $events->{$uuid}->{line});
    $matrixdata->{"CD.$c.$r"} = {
        "Data" => "$label",
        "Focuscallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        },
        "Blurcallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
            $matrixwidget->{"VC.$vc.$vr"}->{-text} = $matrixdata->{"CD.$dc.$dr"}->{"Data"}; #view original data = read only
            return 0;
        }
    };

    $c = $matrixdata->{"CK.crc32"};
    $label = sprintf("%8s", $events->{$uuid}->{crc32});
    $matrixdata->{"CD.$c.$r"} = {
        "Data" => "$label",
        "Focuscallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        },
        "Blurcallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
            $matrixwidget->{"VC.$vc.$vr"}->{-text} = $matrixdata->{"CD.$dc.$dr"}->{"Data"}; #view original data = read only
            return 0;
        }
    };

    $c = $matrixdata->{"CK.user"};
    $label = sprintf("%s", $events->{$uuid}->{user});
    $matrixdata->{"CD.$c.$r"} = {
        "Data" => "$label",
        "Focuscallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        },
        "Blurcallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
            $matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
            return 0;
        }
    };

    $c = $matrixdata->{"CK.revision"};
    $label = sprintf("%3d", $events->{$uuid}->{revision});
    $matrixdata->{"CD.$c.$r"} = {
        "Data" => "$label",
        "Focuscallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        },
        "Blurcallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
            $matrixwidget->{"VC.$vc.$vr"}->{-text} = $matrixdata->{"CD.$dc.$dr"}->{"Data"}; #view original data = read only
            return 0;
        }
    };

    $c = $matrixdata->{"CK.date"};
    $label = sprintf("%s", $events->{$uuid}->{date});
    $matrixdata->{"CD.$c.$r"} = {
        "Data" => "$label",
        "Focuscallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        },
        "Blurcallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
            my $text = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
            if ($text ne '') {
                $text = &anydate2yyyymmdd($text);
            }
            $matrixdata->{"CD.$dc.$dr"}->{"Data"} = $text;
            $matrixwidget->{"VC.$vc.$vr"}->{-text} = $text;
            return 0;
        }
    };

    $c = $matrixdata->{"CK.begin"};
    $label = sprintf("%s", $events->{$uuid}->{begin});
    $matrixdata->{"CD.$c.$r"} = {
        "Data" => "$label",
        "Focuscallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        },
        "Blurcallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
            my $event = &matrixrow2event($dr);
            my $text = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
            $text = &anytime2hhmm($text) if ($text ne "");

            $event->{begin} = $text;
            &processeventfields($event, qw/amount end begin/);
            my $redrawflag = 0;
            foreach my $k (qw/begin end amount/) {
                my $kdc = $matrixdata->{"CK.$k"};
                if ($matrixdata->{"CD.$kdc.$dr"}->{"Data"} ne $event->{$k}) {
                    $matrixdata->{"CD.$kdc.$dr"}->{"Data"} = $event->{$k};
                    $redrawflag = 1;
                }
            }

            if (not $redrawflag) {
                $matrixwidget->{"VC.$vc.$vr"}->{-text} = $event->{begin};
            }

            return $redrawflag;
        }
    };

    $c = $matrixdata->{"CK.end"};
    $label = sprintf("%s", $events->{$uuid}->{end});
    $matrixdata->{"CD.$c.$r"} = {
        "Data" => "$label",
        "Focuscallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        },
        "Blurcallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
            my $event = &matrixrow2event($dr);
            my $text = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
            $text = &anytime2hhmm($text) if ($text ne "");

            $event->{end} = $text;
            &processeventfields($event, qw/amount end begin/);
            my $redrawflag = 0;
            foreach my $k (qw/begin end amount/) {
                my $kdc = $matrixdata->{"CK.$k"};
                if ($matrixdata->{"CD.$kdc.$dr"}->{"Data"} ne $event->{$k}) {
                    $matrixdata->{"CD.$kdc.$dr"}->{"Data"} = $event->{$k};
                    $redrawflag = 1;
                }
            }

            if (not $redrawflag) {
                $matrixwidget->{"VC.$vc.$vr"}->{-text} = $event->{end};
            }

            return $redrawflag;
        }
    };

    $c = $matrixdata->{"CK.amount"};
    $label = sprintf("%s", $events->{$uuid}->{amount});
    $matrixdata->{"CD.$c.$r"} = {
        "Data" => "$label",
        "Focuscallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        },
        "Blurcallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
            my $event = &matrixrow2event($dr);
            my $text = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
            $text = &anytime2hhmm($text) if ($text ne "");

            $event->{amount} = $text;
            &processeventfields($event, qw/amount end begin/);
            my $redrawflag = 0;
            foreach my $k (qw/begin end amount/) {
                my $kdc = $matrixdata->{"CK.$k"};
                if ($matrixdata->{"CD.$kdc.$dr"}->{"Data"} ne $event->{$k}) {
                    $matrixdata->{"CD.$kdc.$dr"}->{"Data"} = $event->{$k};
                    $redrawflag = 1;
                }
            }

            if (not $redrawflag) {
                $matrixwidget->{"VC.$vc.$vr"}->{-text} = $event->{amount};
            }

            return $redrawflag;
        }
    };

    $c = $matrixdata->{"CK.account"};
    $label = sprintf("%s", $events->{$uuid}->{account});
    $matrixdata->{"CD.$c.$r"} = {
        "Data" => "$label",
        "Focuscallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        },
        "Blurcallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
            my $text = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
            my $accounts = &completeaccount($text);
            if (@{$accounts} == 1) {
                $text = $accounts->[0];
                $text = &dot2slash($text) if ($text =~ m/^\./);
            }
            $matrixwidget->{"VC.$vc.$vr"}->{-text} = $text;
            $matrixdata->{"CD.$dc.$dr"}->{"Data"} = $text;
            return 0;
        }
    };

    $c = $matrixdata->{"CK.remark"};
    $label = sprintf("%s", $events->{$uuid}->{remark});
    $matrixdata->{"CD.$c.$r"} = {
        "Data" => "$label",
        "Focuscallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        },
        "Blurcallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
            $matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
            return 0;
        }
    };

    $c = $matrixdata->{"CK.error"};
    $label = sprintf("%s", $events->{$uuid}->{error});
    $matrixdata->{"CD.$c.$r"} = {
        "Data" => "$label",
        "Focuscallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
        },
        "Blurcallback" => sub {
            my ($matrixwidget, $dc, $dr, $vc, $vr) = (@_);
            $matrixwidget->{"VC.$vc.$vr"}->{-text} = $matrixdata->{"CD.$dc.$dr"}->{"Data"}; #view original data = read only
            return 0;
        }
    };
}

sub matrixappend {
    my ($uuid, $label) = (@_);
    my $nextrow;
    $nextrow = $matrixdata->{"Rows"};
    $nextrow = 0 unless(defined $nextrow);
    &matrixrowset($nextrow, $uuid, $label);
    $nextrow++;
    $matrixdata->{"Rows"} = $nextrow;
}

sub matrixinsertafter {
    my ($insrow, $uuid, $label) = (@_);
    $insrow++;
    return &matrixinsertrowat($insrow, $uuid, $label);
}

sub matrixinsertrowat {
    my ($insrow, $uuid, $label) = (@_);
    my $nextrow;
    my $lastrow;
    $nextrow = $matrixdata->{"Rows"};
    $lastrow = $nextrow - 1;
    if ($insrow >= $nextrow) {
        &matrixappend($uuid, $label);
    }
    else {
        my $targetrow = $nextrow;
        my $sourcerow = $lastrow;
        while ($sourcerow >= $insrow) {
            $matrixdata->{"RH.$targetrow"} = $matrixdata->{"RH.$sourcerow"};
            for (my $c = 0; $c < $matrixdata->{"Columns"}; $c++) {
                #printf "$targetrow.$c = $sourcerow.$c\n";
                $matrixdata->{"CD.$c.$targetrow"} = $matrixdata->{"CD.$c.$sourcerow"};
            }
            $targetrow--;
            $sourcerow--;
        }
        &matrixrowset($insrow, $uuid, $label);
        $nextrow++;
        $matrixdata->{"Rows"} = $nextrow;
    }
}

#
#   removes a row; returns 1 if the row was the trailer
#
sub matrixdeleterow {
    my ($delrow) = (@_);
    my $nextrow;
    my $lastrow;
    $nextrow = $matrixdata->{"Rows"};
    $lastrow = $nextrow - 1;
    if ($delrow >= $lastrow) {
        &matrixshrinkrow();
        return 1;
    }
    else {
        my $targetrow = $delrow;
        my $sourcerow = $delrow + 1;
        while ($sourcerow < $nextrow) {
            $matrixdata->{"RH.$targetrow"} = $matrixdata->{"RH.$sourcerow"};
            for (my $c = 0; $c < $matrixdata->{"Columns"}; $c++) {
                #printf "$targetrow.$c = $sourcerow.$c\n";
                $matrixdata->{"CD.$c.$targetrow"} = $matrixdata->{"CD.$c.$sourcerow"};
            }
            $targetrow++;
            $sourcerow++;
        }
        &matrixshrinkrow();
        return 0;
    }
}

#
#   shrinks the matrix by one row by removing the trailer
#
sub matrixshrinkrow {
    my $nextrow;
    my $lastrow;
    $nextrow = $matrixdata->{"Rows"};
    if ($nextrow > 0) {
        $lastrow = $nextrow - 1;
        delete $matrixdata->{"RH.$lastrow"};
        for (my $c = 0; $c < $matrixdata->{"Columns"}; $c++) {
            delete $matrixdata->{"CD.$c.$lastrow"};
        }
    }
    $nextrow--;
    $matrixdata->{"Rows"} = $nextrow;
}

#
#   dump a event for debugging purposes
#
sub dumpevent {
    my ($event, $prefix) = (@_);
    $prefix = "dumpevent($event)" unless (defined $prefix);
    foreach my $k (keys %{$event}) {
        printf STDERR "DEBUG: %s: %8s=%s\n", $prefix, $k, (defined $event->{$k}) ? $event->{$k} : "<UNDEF>";
    }
}

#
#   pull out events from data matrix
#
sub matrix2events {
    my $c;
    my $r;
    my $uuid;
    my $event;

    $events = {};
    for ($r = 0; $r <$matrixdata->{"Rows"}; $r++) {
        $event = &matrixrow2event($r);
        &setevent($events, $event);
    }
}

#
#   pull out a row and transform into an event
#
sub matrixrow2event {
    my ($r) = (@_);
    my $event = {};

    for (my $c = 0; $c < $matrixdata->{"Columns"}; $c++) {
        my $k = $matrixdata->{"CH.$c"}->{"Keyname"};
        next unless ($k =~ m/^(status|uuid|line|user|revision|date|begin|end|amount|account|remark|error)$/);
        my $field = $matrixdata->{"CD.$c.$r"}->{"Data"};
        $field =~ s|^\s*||s;   #strip off leading spaces from the field
        $field =~ s|\s*$||s;   #strip off trailing spaces from the field
        $event->{$k} = $field;
    }
    return $event;
}

#
#   transform a line into an event
#
#   INPUT
#   $ln - string representing event
#   $line - line number for tracking
#
#   OUTPUT
#   undef - input was a empty or whitespace only line
#   %event - all data fields; line number tracking and annotations added
#
sub ln2event {
    my ($ln, $line) = (@_);
    my $event = {};

    $ln =~ s|^\s*||s;   #strip off leading spaces from the wholly line
    $ln =~ s|#.*?$||s;  #strip off comments
    $ln =~ s|\s*$||s;   #strip off trailing spaces from the wholly line
    return undef if ( $ln =~ m|^\s*$| ); #ignore empty lines

    my $remainder = $ln;
    $event->{status} = "R";
    $event->{line} = $line;
    foreach my $f (qw/user uuid crc32 revision date begin end amount account remark/) {
        my $field;
        ($field, $remainder) = &splitq($remainder);
        if (not defined $field) {
            $event->{annotation}->{$f} = "undefined";
            last;
        }
        $field =~ s|^\s*||s;   #strip off leading spaces from the field
        $field =~ s|\s*$||s;   #strip off trailing spaces from the field
        $event->{$f} = $field;
    }
    return $event;
}

#
#   transform an event into a line
#
#   INPUT
#   %event - all data fields; line number tracking and annotations ignored
#
#    OUTPUT
#    $ln - string representing event; line number tracking and annotations lost
#
sub event2ln {
    my ($event) = (@_);

    my $ln = undef;
    foreach my $f (qw/user uuid crc32 revision date begin end amount account remark/) {
        my $fielddata;
        $ln .= " " if (defined $ln);
        $ln .= &quote($event->{$f});
    }
    return $ln;
}

#
#    processevent
#
sub processeventfields {
    my ($event, @fields) = (@_);

    foreach my $f (@fields) {
        if    ($f eq "status") {
            my $status = $event->{status};
            $status = " " if (not defined $status or $status eq "R");
            my $error = &annotations2string($event->{annotation});
            if (defined $error and $error ne "") {
                $event->{error}  = $error;
                $status = "E";
            }
            else {
                delete $event->{error};
                if ($event->{crc32} ne &calccrc32($event)) {
                    $status = "M";
                }
            }
            $event->{status} = $status;
        }
        elsif ($f eq "uuid") {
            my $uuid = $event->{uuid};
            if ($uuid eq '.') {
                $uuid = &newuuid();
                $event->{uuid} = $uuid;
                $event->{annotation}->{uuid} = "new";
            }
            if (&isvaliduuid($uuid)) {
                delete $event->{annotation}->{uuid};
            }
            else {
                $event->{annotation}->{uuid} = "invalid";
            }
        }
        elsif ($f eq "user") {
            my $user = $event->{user};
            if (&isvaliduser($user)) {
                delete $event->{annotation}->{user};
            }
            else {
                $event->{annotation}->{user} = "invalid";
            }
        }
        elsif ($f eq "crc32") {
            my $crc32 = &calccrc32($event);
            $event->{crc32} = $crc32;
            delete $event->{annotation}->{crc32};
        }
        elsif ($f eq "revision") {
            my $revision = $event->{revision};
            if (&isvalidrevision($revision)) {
                delete $event->{annotation}->{revision};
            }
            else {
                $event->{annotation}->{revision} = "invalid";
            }
        }
        elsif ($f eq "date") {
            my $date = $event->{date};
            if (&isvaliddate($date)) {
                delete $event->{annotation}->{date};
            }
            else {
                $event->{annotation}->{date} = "invalid";
            }
        }
        elsif ($f eq "begin") {
            my $begin = $event->{begin};
            if (&isvalidbegin($begin)) {
                delete $event->{annotation}->{begin};
            }
            else {
                $event->{annotation}->{begin} = "invalid";
            }
            ($begin, my $end, my $amount) = &calctime($begin, $event->{end}, $event->{amount});
            $event->{begin} = $begin;
        }
        elsif ($f eq "end") {
            my $end = $event->{end};
            if (&isvalidend($end)) {
                delete $event->{annotation}->{end};
            }
            else {
                $event->{annotation}->{end} = "invalid";
            }
            (my $begin, $end, my $amount) = &calctime($event->{begin}, $end, $event->{amount});
            $event->{end} = $end;
        }
        elsif ($f eq "amount") {
            my $amount = $event->{amount};
            if (&isvalidamount($amount)) {
                delete $event->{annotation}->{amount};
            }
            else {
                $event->{annotation}->{amount} = "invalid";
            }
            (my $begin, my $end, $amount) = &calctime($event->{begin}, $event->{end}, $amount);
            $event->{amount} = $amount;
        }
        elsif ($f eq "account") {
            my $account = $event->{account};
            if ($account =~ m|^\.|) {
                $account = &dot2slash($event->{account});
            }
            if (&isvalidaccount($account)) {
                $event->{account} = $account;
                delete $event->{annotation}->{account};
            }
            else {
                $event->{annotation}->{account} = "invalid";
            }
        }
        elsif ($f eq "remark") {
            my $remark = $event->{remark};
            if (&isvalidremark($remark)) {
                $event->{annotation}->{remark};
            }
            else {
                $event->{annotation}->{remark} = "invalid";
            }
        }
    }
    $event->{error} = &annotations2string($event->{annotation});
    return;
}

#
#    transform the given annotations into a single string
#
sub annotations2string {
    my ($annotations) = (@_);

    my $string = "";
    foreach my $f (sort keys %{$annotations}) {
        $string .= " " if (defined $string);
        $string .= sprintf("%s=%s;", $f, $annotations->{$f});
    }
    return $string;
}

#
#    set single event into events hash, copying selected keys and their values
#
sub setevent {
    my ($ev, $event) = (@_);
    my $uuid = $event->{uuid};
    foreach my $k (keys %{$event}) {
        next unless ($k =~ m/^(line|status|user|crc32|revision|date|begin|end|amount|account|remark|error)$/);
        %{$ev}->{$uuid}->{$k} = $event->{$k};
    }
}

#
#    get single event from events hash, copying selected keys and their values
#
sub getevent {
    my ($ev, $uuid) = (@_);
    my $event = {};
    $event->{uuid} = $uuid;
    foreach my $k (keys %{$ev->{$uuid}}) {
        next unless ($k =~ m/^(line|status|user|crc32|revision|date|begin|end|amount|account|remark|error)$/);
        $event->{$k} = %{$ev}->{$uuid}->{$k};
    }
    return $event;
}
