head	1.47;
access;
symbols
	AS_CUI_0_6_5:1.47
	AS_CUI_0_6_4:1.36
	AS_CUI_0_6_3:1.30
	AS_CUI_0_6_2:1.26
	AS_CUI_0_6_1:1.21
	AS_CUI_0_6_0:1.19
	AS_CUI_0_5_6:1.17
	AS_CUI_0_5_5:1.11
	AS_CUI_0_5_4:1.8
	AS_CUI_0_5_3:1.6
	AS_CUI_0_5_2:1.4
	AS_CUI_0_5_1:1.2;
locks; strict;
comment	@# @;


1.47
date	2003.02.27.15.57.40;	author thl;	state Exp;
branches;
next	1.46;

1.46
date	2003.02.27.15.56.14;	author thl;	state Exp;
branches;
next	1.45;

1.45
date	2003.02.27.15.49.17;	author thl;	state Exp;
branches;
next	1.44;

1.44
date	2003.02.27.15.38.37;	author thl;	state Exp;
branches;
next	1.43;

1.43
date	2003.02.27.15.36.55;	author thl;	state Exp;
branches;
next	1.42;

1.42
date	2003.02.27.15.27.38;	author thl;	state Exp;
branches;
next	1.41;

1.41
date	2003.02.27.15.26.45;	author thl;	state Exp;
branches;
next	1.40;

1.40
date	2003.02.27.13.27.35;	author thl;	state Exp;
branches;
next	1.39;

1.39
date	2003.02.27.13.23.44;	author thl;	state Exp;
branches;
next	1.38;

1.38
date	2003.02.27.13.04.48;	author thl;	state Exp;
branches;
next	1.37;

1.37
date	2003.02.26.09.21.46;	author thl;	state Exp;
branches;
next	1.36;

1.36
date	2003.02.25.15.27.16;	author thl;	state Exp;
branches;
next	1.35;

1.35
date	2003.02.25.15.26.49;	author thl;	state Exp;
branches;
next	1.34;

1.34
date	2003.02.25.12.39.19;	author thl;	state Exp;
branches;
next	1.33;

1.33
date	2003.02.25.12.37.06;	author thl;	state Exp;
branches;
next	1.32;

1.32
date	2003.02.25.08.32.23;	author thl;	state Exp;
branches;
next	1.31;

1.31
date	2003.02.25.08.07.01;	author thl;	state Exp;
branches;
next	1.30;

1.30
date	2003.02.25.07.30.00;	author thl;	state Exp;
branches;
next	1.29;

1.29
date	2003.02.24.15.49.53;	author thl;	state Exp;
branches;
next	1.28;

1.28
date	2003.02.24.15.46.50;	author thl;	state Exp;
branches;
next	1.27;

1.27
date	2003.02.20.14.32.31;	author rse;	state Exp;
branches;
next	1.26;

1.26
date	2003.02.20.13.58.35;	author thl;	state Exp;
branches;
next	1.25;

1.25
date	2003.02.20.13.53.48;	author thl;	state Exp;
branches;
next	1.24;

1.24
date	2003.02.20.13.38.00;	author thl;	state Exp;
branches;
next	1.23;

1.23
date	2003.02.20.13.28.06;	author thl;	state Exp;
branches;
next	1.22;

1.22
date	2003.02.20.09.52.15;	author thl;	state Exp;
branches;
next	1.21;

1.21
date	2003.02.13.16.21.44;	author thl;	state Exp;
branches;
next	1.20;

1.20
date	2003.02.13.12.55.41;	author thl;	state Exp;
branches;
next	1.19;

1.19
date	2003.02.03.13.40.12;	author thl;	state Exp;
branches;
next	1.18;

1.18
date	2003.02.03.13.39.25;	author thl;	state Exp;
branches;
next	1.17;

1.17
date	2002.12.19.15.17.07;	author thl;	state Exp;
branches;
next	1.16;

1.16
date	2002.12.19.15.16.53;	author thl;	state Exp;
branches;
next	1.15;

1.15
date	2002.12.19.14.04.56;	author thl;	state Exp;
branches;
next	1.14;

1.14
date	2002.12.19.12.32.03;	author thl;	state Exp;
branches;
next	1.13;

1.13
date	2002.12.19.10.40.35;	author thl;	state Exp;
branches;
next	1.12;

1.12
date	2002.12.19.09.51.48;	author thl;	state Exp;
branches;
next	1.11;

1.11
date	2002.12.18.16.29.56;	author rse;	state Exp;
branches;
next	1.10;

1.10
date	2002.12.18.15.58.27;	author rse;	state Exp;
branches;
next	1.9;

1.9
date	2002.12.18.15.50.16;	author rse;	state Exp;
branches;
next	1.8;

1.8
date	2002.12.18.15.15.06;	author thl;	state Exp;
branches;
next	1.7;

1.7
date	2002.12.18.15.14.30;	author thl;	state Exp;
branches;
next	1.6;

1.6
date	2002.12.18.14.34.48;	author thl;	state Exp;
branches;
next	1.5;

1.5
date	2002.12.18.14.34.26;	author thl;	state Exp;
branches;
next	1.4;

1.4
date	2002.12.18.12.46.12;	author thl;	state Exp;
branches;
next	1.3;

1.3
date	2002.12.18.12.43.41;	author thl;	state Exp;
branches;
next	1.2;

1.2
date	2002.12.18.11.19.53;	author rse;	state Exp;
branches;
next	1.1;

1.1
date	2002.12.18.11.18.20;	author rse;	state Exp;
branches;
next	;


desc
@@


1.47
log
@flush pending changes
@
text
@#!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 POSIX;          # OpenPKG >= perl-5.8.0, possibly sooner
use Getopt::Long;   # OpenPKG >= perl-5.6.1
use Time::Local;    # 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-cui";
my $progvers = "0.6.5";

#   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 $lockinfo     = {};
my $accounts     = [];
my $events       = {};
my $matrixdata   = {};
$matrixdata->{"progname"} = $progname;
$matrixdata->{"progvers"} = $progvers;

#   exception handling support
$SIG{__DIE__} = sub {
    my ($err) = @@_;
    $err =~ s|\s+at\s+.*||s if (not $opt_verbose);
    my $txt = "$err ". ($! ? "($!)" : "");
    print STDERR "$progname:ERROR: $txt\n";
    &unlinklock();
    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);
}

#   locking
$lockinfo = &readlock();
if (defined $lockinfo) {
    my $b = 0;
    printf STDERR "$progname:ERROR: LOCK DETECTED! Additional information about the lock";
    foreach my $k (sort keys %{$lockinfo}) {
        printf STDERR ": " unless ($b);
        printf STDERR ", " if ($b);
        printf STDERR "%s=%s", &quote($k), &quote($lockinfo->{$k});
        $b = 1;
    };
    printf STDERR " is not available." unless ($b);
    printf STDERR "\n";
    exit(1);
}
$lockinfo = {
    "date"     => &day(@@localruntime),
    "time"     => &now(@@localruntime),
    "user"     => $runtimecfg->{"user"},
    "nodename" => [ POSIX::uname() ]->[1],
    "pid"      => $$,
    "uid"      => $<,
    "pwname"   => [ getpwuid($<) ]->[$1],
    "text"     => $progname . " (" . $progvers . ")"
};
&writelock();

#   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();
}
&unlinklock();
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 lock file
#
sub readlock {
    my $rv = undef;
    my $file = "lock";
    my $path;
    my $io;

    #   in general, no access to the file is no reason to die; just return no data
    ($path, $io) = &openfile($file, "x");
    return $rv if (not $io);

    ($path, $io) = &openfile($file, "r");
    $rv = &file2hashandclose($path, $io);
    return $rv;
}

#
#   Write lock file
#
sub writelock {
    my $file = "lock";
    my $path;
    my $io;

    ($path, $io) = &openfile($file, "w");
    &hash2fileandclose($io, $lockinfo);
}

#
#   Unlink lock file
#
sub unlinklock {
    my $file = "lock";
    my $path;
    my $io;

    #   in general, no access to the file is no reason to die; just return
    ($path, $io) = &openfile($file, "x");
    return if (not $io);

    close($io);
    unlink $path;
}

#
#   Read rc file
#
sub readrc {
    my $rv = undef;
    my $file = "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($file, "x");
        return $rv if (not $io);
    }

    ($path, $io) = &openfile($file, "r");
    $rv = &file2hashandclose($path, $io);
    return $rv;
}

#
#   Write rc file
#
sub writerc {
    my $file = "rc";
    my $path;
    my $io;

    ($path, $io) = &openfile($file, "w");
    &hash2fileandclose($io, $runtimecfg);
}

#
#   Read content of a file into a hash and close file
#
sub file2hashandclose {
    my ($path, $io) = @@_;
    my $rv = {};
    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";
        }

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

#
#   Write content of a hash into a file and close file
#
sub hash2fileandclose {
    my ($io, $iv) = @@_;
    my $var;
    my $val;
    foreach my $k (sort keys %{$iv}) {
        $var = &quote($k);
        $val = &quote($iv->{$k});
        print $io "$var $val\n";
    }
    &closefile($io);
}

#
#   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/);
        setevent($events, $event);
        $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}" ne "$events->{$b}->{date}") {
        return "$events->{$a}->{date}" cmp "$events->{$b}->{date}";
    }
    # by begin time
    if ("$events->{$a}->{begin}" ne "$events->{$b}->{begin}") {
        return "$events->{$a}->{begin}" cmp "$events->{$b}->{begin}";
    }
    # by line number which was seen when read, new entries to the end
    if ("$events->{$a}->{line}" eq "+") {
        return  1;
    }
    if ("$events->{$b}->{line}" eq "+") {
        return -1;
    }
    if ("$events->{$a}->{line}" ne "$events->{$b}->{line}") {
        return "$events->{$a}->{line}" cmp "$events->{$b}->{line}";
    }
    # by uuid
    return "$a" cmp "$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
    &writerc();

    #   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
    my $event = {
        "account"  => "/example/account",
        "remark"   => "guess what this is"
    };
    &newevent($event);
    ($path, $io) = &openfile("events", "w");
    &writeevents();
    &closefile($io);
}

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

    #   time calculation and sanity check
    my ($begin, $end, $amount) = &splittimespec($timespec);
    die "unexpected begin \"$begin\" found.\n"   if (not &isvalidhhmm($begin));
    die "unexpected end \"$end\" found.\n"       if (not &isvalidhhmm($end));
    die "unexpected amount \"$amount\" found.\n" if (not &isvalidhhmm($amount));

    #   preset
    my $event = {
        "begin"    => $begin,
        "end"      => $end,
        "amount"   => $amount,
        "account"  => $account,
        "remark"   => $remark
    };
    &newevent($event);
}

#
#   create an new event from scratch or paste in data from optional given event
#
sub newevent {
    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"}   || &calcamount($paste->{"begin"}, $paste->{"end"}) || "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 roundtime {
    my ($time, $precision) = @@_;
    $precision = "00:15" if (not defined $precision);
    $precision = &hhmm2sec($precision);

    $time = &hhmm2sec($time);
    $time = int(($time + ($precision / 2)) / $precision) * $precision;
    $time = &sec2hhmm($time);
    return $time;
}
sub inctime {
    my ($time, $step) = @@_;
    if (not defined $step) {
        if ($time eq &roundtime($time)) {
            $step = "00:15";
        }
        else {
            $step = "00:01";
        }
    }
    $step = &hhmm2sec($step);
    $time = &hhmm2sec($time);
    $time += $step;
    $time = &sec2hhmm($time);
    return $time;
}
sub dectime {
    my ($time, $step) = @@_;
    if (not defined $step) {
        if ($time eq &roundtime($time)) {
            $step = "00:15";
        }
        else {
            $step = "00:01";
        }
    }
    $step = &hhmm2sec($step);
    $time = &hhmm2sec($time);
    $time -= $step;
    $time = &sec2hhmm($time);
    return $time;
}

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;
}

sub yyyymmdd2sec {
    my ($yyyymmdd) = (@@_);
    my $rv = undef;
    $yyyymmdd = &day() if (not &isvalidyyyymmdd($yyyymmdd));
    $yyyymmdd =~ m|^(.*)-(.*)-(.*)$|;
    my ($year, $month, $mday) = ($1, $2, $3);
    $month--;
    $rv = timegm("00", "00", "00", $mday, $month, $year);
    return $rv;
}

sub sec2yyyymmdd {
    my ($sec) = (@@_);
    my $rv = undef;
    $rv = &day(localtime($sec));
    return $rv;
}

sub incdate {
    my ($date, $step) = @@_;
    $step = (24 * 60 * 60) if (not defined $step);
    $date = &yyyymmdd2sec($date);
    $date += $step;
    $date = &sec2yyyymmdd($date);
    return $date;
}

sub decdate {
    my ($date, $step) = @@_;
    $step = (24 * 60 * 60) if (not defined $step);
    $date = &yyyymmdd2sec($date);
    $date -= $step;
    $date = &sec2yyyymmdd($date);
    return $date;
}

#
#   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"  => 88, "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;

    #   mark virgin
    $matrixdata->{"dirty"}     = 0;

    #   fill in callbacks
    $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 = &newevent($paste);
        &matrixinsertafter($dr, $event->{uuid}, "N");
        $matrixdata->{"dirty"} = 1;
    };
    $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 = &newevent($paste);
        &matrixinsertrowat($dr, $event->{uuid}, "N");
        $matrixdata->{"dirty"} = 1;
    };
    $matrixdata->{"deletedelete"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
        my $event = &matrixrow2event($dr);
        push @@{$matrixdata->{"undobuffer"}}, $event;
        $matrixdata->{"dirty"} = 1;
        return &matrixdeleterow($dr);
    };
    $matrixdata->{"undo"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
        my $paste = pop @@{$matrixdata->{"undobuffer"}};
        if (defined $paste) {
            my $event = &newevent($paste);
            &matrixinsertrowat($dr, $event->{uuid}, "U");
            $matrixdata->{"dirty"} = 1;
            return 1;
        }
        return 0;
    };
    $matrixdata->{"completeaccount"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr, $pattern) = (@@_);
        $matrixdata->{"dirty"} = 1;
        return &completeaccount($pattern);
    };
    $matrixdata->{"completedate"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr, $text) = (@@_);
        $matrixdata->{"dirty"} = 1;
        return &anydate2yyyymmdd($text);
    };
    $matrixdata->{"completetime"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr, $text) = (@@_);
        $matrixdata->{"dirty"} = 1;
        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"};
            $matrixdata->{"dirty"} = 1;
            return 1;
        }
        elsif ($matrixdata->{"clipboardtype"} eq "line") {
            my $event = &newevent($matrixdata->{"clipboard"});
            &matrixinsertafter($dr, $event->{uuid}, "N");
            $matrixdata->{"dirty"} = 1;
            return 1;
        }
        return 0;
    };
    $matrixdata->{"Paste"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
        if ($matrixdata->{"clipboardtype"} eq "line") {
            my $event = &newevent($matrixdata->{"clipboard"});
            &matrixinsertrowat($dr, $event->{uuid}, "N");
            $matrixdata->{"dirty"} = 1;
            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)$/) {
            $text = &now();
        }
        elsif ($k =~ m/^(amount)$/) {
            my $event = &matrixrow2event($dr);
            $event->{amount} = "";
            &processeventfields($event, qw/amount/);
            $text = $event->{amount};
        }
        if (defined $text and ($matrixdata->{"CD.$dc.$dr"}->{"Data"} ne $text)) {
            $matrixdata->{"CD.$dc.$dr"}->{"Data"} = $text;
            $matrixdata->{"dirty"} = 1;
            return 1;
        }
        return 0;
    };
    $matrixdata->{"recalculatetime"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
        my $k = $matrixdata->{"CH.$dc"}->{"Keyname"};
        my $text = undef;
        if ($k =~ m/^(begin|end|amount)$/) {
            my $event = &matrixrow2event($dr);
            $event->{$k} = "";
            &processeventfields($event, qw/amount end begin/);
            $text = $event->{$k};
        }
        if (defined $text and ($matrixdata->{"CD.$dc.$dr"}->{"Data"} ne $text)) {
            $matrixdata->{"CD.$dc.$dr"}->{"Data"} = $text;
            $matrixdata->{"dirty"} = 1;
            return 1;
        }
        return 0;
    };
    $matrixdata->{"roundtime"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
        my $k = $matrixdata->{"CH.$dc"}->{"Keyname"};
        my $text = undef;
        if ($k =~ m/^(begin|end|amount)$/) {
            my $event = &matrixrow2event($dr);
            $text = &roundtime($event->{$k});
            $text = "24:00" if ($text eq "00:00" and $k =~ /^(end|amount)$/);
        }
        if (defined $text and ($matrixdata->{"CD.$dc.$dr"}->{"Data"} ne $text)) {
            $matrixdata->{"CD.$dc.$dr"}->{"Data"} = $text;
            $matrixdata->{"dirty"} = 1;
            return 1;
        }
        return 0;
    };
    $matrixdata->{"incdatetime"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
        my $k = $matrixdata->{"CH.$dc"}->{"Keyname"};
        my $text = undef;
        if ($k =~ m/^(date)$/) {
            my $event = &matrixrow2event($dr);
            $text = &incdate($event->{$k});
        }
        elsif ($k =~ m/^(begin|end|amount)$/) {
            my $event = &matrixrow2event($dr);
            $text = $event->{$k};
            $text = "00:00" if ($text eq "24:00");
            $text = &inctime($text);
            $text = "24:00" if ($text eq "00:00" and $k =~ /^(end|amount)$/);
        }
        if (defined $text and ($matrixdata->{"CD.$dc.$dr"}->{"Data"} ne $text)) {
            $matrixdata->{"CD.$dc.$dr"}->{"Data"} = $text;
            $matrixdata->{"dirty"} = 1;
            return 1;
        }
        return 0;
    };
    $matrixdata->{"decdatetime"} = sub {
        my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
        my $k = $matrixdata->{"CH.$dc"}->{"Keyname"};
        my $text = undef;
        if ($k =~ m/^(date)$/) {
            my $event = &matrixrow2event($dr);
            $text = &decdate($event->{$k});
        }
        elsif ($k =~ m/^(begin|end|amount)$/) {
            my $event = &matrixrow2event($dr);
            $text = $event->{$k};
            $text = "00:00" if ($text eq "24:00");
            $text = &dectime($text);
            $text = "24:00" if ($text eq "00:00" and $k =~ /^(end|amount)$/);
        }
        if (defined $text and ($matrixdata->{"CD.$dc.$dr"}->{"Data"} ne $text)) {
            $matrixdata->{"CD.$dc.$dr"}->{"Data"} = $text;
            $matrixdata->{"dirty"} = 1;
            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"};
            $matrixdata->{"dirty"} = 1;
            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"};
            $matrixdata->{"dirty"} = 1;
            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
            $matrixdata->{"dirty"} = 1;
            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;
            $matrixdata->{"dirty"} = 1;
            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};
                    $matrixdata->{"dirty"} = 1;
                    $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};
                    $matrixdata->{"dirty"} = 1;
                    $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};
                    $matrixdata->{"dirty"} = 1;
                    $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;
            $matrixdata->{"dirty"} = 1;
            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
            $matrixdata->{"dirty"} = 1;
            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;
}
@


1.46
log
@double size of remark field. DANGER: this increases the probability for
user to get lost if screenwidth is smaller than a single column, so keep
issue pending in 00TODO. It has been successfully tested that save, quit
and exit still work in that particular situation.
@
text
@d43 1
a43 1
my $progvers = "0.6.4";
@


1.45
log
@cosmetics
@
text
@d1265 1
a1265 1
    $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++;
@


1.44
log
@do not lock for read-only short-circuit dispatch, so move code
@
text
@d77 1
a77 1
    print STDERR "ERROR: $txt\n";
d155 1
a155 1
    printf STDERR "LOCK DETECTED! Additional information about the lock";
@


1.43
log
@properly unlock when dying, too
@
text
@d142 9
a176 9

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

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


1.42
log
@create and use &writerc()
@
text
@d78 1
d155 1
a155 1
    exit 1;
d175 1
a175 1
    exit 0;
a243 1

@


1.41
log
@add locking support
@
text
@d502 1
a502 1
    my $rv = {};
d519 12
d967 1
a967 2
    ($path, $io) = &openfile("rc", "w");
    &hash2fileandclose($io, $runtimecfg);
@


1.40
log
@migrate setup to use &newevent() as well
@
text
@d31 1
d65 1
d141 27
d244 1
d450 46
@


1.39
log
@migrate &cuinewevent() to &newevent() and consolidate CLI/CUI usage
@
text
@d889 5
d895 1
a895 6
    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";
@


1.38
log
@split off file/hash read/write from readrc
@
text
@d905 6
d912 6
a917 39
    my  $uuid     = &newuuid();
    my  $line     = "+";
    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
d919 1
a919 1
    return $uuid;
d923 1
a923 1
#   create an new cui event from scratch or paste in data from optional given event
d925 1
a925 1
sub cuinewevent {
d1238 1
a1238 1
        my $event = &cuinewevent($paste);
d1281 1
a1281 1
        my $event = &cuinewevent($paste);
d1296 1
a1296 1
            my $event = &cuinewevent($paste);
d1350 1
a1350 1
            my $event = &cuinewevent($matrixdata->{"clipboard"});
d1360 1
a1360 1
            my $event = &cuinewevent($matrixdata->{"clipboard"});
@


1.37
log
@apply rse convenience patch
@
text
@d426 2
a427 1
    my $rc = {};
d433 2
a434 4
        ($path, $io) = &openfile("rc", "x");
        if (not $io) {
            return $rc;
        }
d437 11
a447 1
    ($path, $io) = &openfile("rc", "r");
d484 1
a484 1
        $rc->{$var} = $val;
d487 2
d490 13
a502 1
    return $rc;
a878 2
    my $quote = '"';
    my $backslash = '\\';
d880 1
a880 6
    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);
@


1.36
log
@flush pending changes
@
text
@d947 1
a947 1
        "amount"   => $paste->{"amount"}   || "08:00",
@


1.35
log
@new feature "+"/"-" on date fields increment/decrement value
@
text
@d42 1
a42 1
my $progvers = "0.6.3";
@


1.34
log
@bugfix missing conversion of precision would appear on input
@
text
@d32 1
d1124 36
d1434 1
a1434 1
    $matrixdata->{"inctime"} = sub {
d1438 5
a1442 1
        if ($k =~ m/^(begin|end|amount)$/) {
d1456 1
a1456 1
    $matrixdata->{"dectime"} = sub {
d1460 5
a1464 1
        if ($k =~ m/^(begin|end|amount)$/) {
@


1.33
log
@new feature "+"/"-" on time fields increment/decrement value
@
text
@d1043 2
a1044 1
    $precision = &hhmm2sec("00:15") if (not defined $precision);
@


1.32
log
@new feature "~" on time fields rounds time
@
text
@d1050 32
d1387 36
@


1.31
log
@new feature "=" on time fields recalculates time
@
text
@d1041 9
d1340 16
@


1.30
log
@flush pending changes
@
text
@d1322 17
@


1.29
log
@flag dirty on change only
@
text
@d41 1
a41 1
my $progvers = "0.6.2";
@


1.28
log
@implement useful "." handling on amount field
@
text
@d1315 1
a1315 1
        if (defined $text) {
@


1.27
log
@the beast is known as as-cui :-)
@
text
@d1306 1
a1306 1
        elsif ($k =~ m/^(begin|end|amount)$/) {
d1308 6
@


1.26
log
@flush pending changes
@
text
@d40 1
a40 1
my $progname = "as";
@


1.25
log
@cosmetics (name/vers was not listed during initialization)
@
text
@d41 1
a41 1
my $progvers = "0.6.1";
@


1.24
log
@fix crc32 getting lost after "save"
@
text
@d66 2
d1126 1
a1126 3
    #   fill in global information
    $matrixdata->{"progname"}  = $progname;
    $matrixdata->{"progvers"}  = $progvers;
@


1.23
log
@introduce dirty handling, view in status, recognize when quit; cursor stays away from movement mode
@
text
@d664 1
@


1.22
log
@add &statusline(); view program name and version
@
text
@d1126 1
d1171 1
d1214 1
d1220 1
d1229 1
d1236 1
d1241 1
d1246 1
d1277 1
d1283 1
d1293 1
d1310 1
d1320 1
d1330 1
d1468 1
d1502 1
d1527 1
d1560 1
d1593 1
d1623 1
d1638 1
@


1.21
log
@flush pending changes
@
text
@d1123 5
@


1.20
log
@revamp sorting from number to strings and document criteria
@
text
@d41 1
a41 1
my $progvers = "0.6.0";
@


1.19
log
@handle negative seconds and day overflow
@
text
@d698 2
a699 2
    if (%{$events}->{$a}->{date} != %{$events}->{$b}->{date}) {
        return %{$events}->{$a}->{date} <=> %{$events}->{$b}->{date};
d702 2
a703 2
    if (%{$events}->{$a}->{begin} != %{$events}->{$b}->{begin}) {
        return %{$events}->{$a}->{begin} <=> %{$events}->{$b}->{begin};
d705 2
a706 2
    # by line with commandline entries to the end
    if (%{$events}->{$a}->{line} eq "commandline") {
d709 1
a709 1
    if (%{$events}->{$b}->{line} eq "commandline") {
d712 2
a713 2
    if (%{$events}->{$a}->{line} != %{$events}->{$b}->{line}) {
        return %{$events}->{$a}->{line} <=> %{$events}->{$b}->{line};
d715 2
a716 2
    # fallback to uuid
    return $a <=> $b;
d887 1
a887 1
    my  $line     = "cli";
@


1.18
log
@implement version 0.6 data format
@
text
@d1050 2
a1051 1
    my $rv = undef;
d1055 1
a1055 2
    $rv = sprintf("%02d:%02d", $hour, $min);
    return $rv;
@


1.17
log
@flush pending changes
@
text
@d41 1
a41 1
my $progvers = "0.5.6";
d263 1
a263 1
    if ($input =~ m/^[2-9][0-9]{3}([0][1-9]|[1][0-2])([0][1-9]|[12][0-9]|[3][01])$/) {
d680 3
a682 1
#   quote
d685 7
a691 17
    my ($arg) = (@@_);
    my $q = quotemeta $arg;
    $q =~ s|^(\\ )+||;        #remove escaped leading spaces
    $q =~ s|(\\ )+$||;        #remove escaped trailing spaces
    $q =~ s|\\([.:/=-])|\1|g; #do not escape dots, colons, slashes, equal signs and dashes (list could be larger)

    #   do not escape spaces but if one or more spaces exist put quotes around the wholly string
    if ($q =~ s|\\ | |g) {
        $q = "\"" . $q . "\"";
    }

    #   handle the empty string
    if ($q eq "") {
        $q = '""';
    }
    return $q;
}
d896 3
a977 2
    #f ($timespec =~ m/^(([^-]+)?-([^=]+)?)?=?(.*)$/) { #( begin? - end? )? =? amount*
    #perl -e '$t = "-03:00="; $t =~ m/^(([^-]+)?-([^=]+)?)?=?(.*)$/; print "$2 - $3 = $4\n";'
a979 18
        if    (($begin ne '') && ($end ne '') && ($amount eq '')) {
            $begin  = &anytime2hhmm($begin);
            $end    = &anytime2hhmm($end);
            $amount = &sec2hhmm(&hhmm2sec($end) - &hhmm2sec($begin));
        }
        elsif (($begin ne '') && ($end eq '') && ($amount ne '')) {
            $begin  = &anytime2hhmm($begin);
            $amount = &anytime2hhmm($amount);
            $end    = &sec2hhmm(&hhmm2sec($begin) + &hhmm2sec($amount));
        }
        elsif (($begin eq '') && ($end ne '') && ($amount ne '')) {
            $end    = &anytime2hhmm($end);
            $amount = &anytime2hhmm($amount);
            $begin  = &sec2hhmm(&hhmm2sec($end) - &hhmm2sec($amount));
        }
        $begin  = "00:00" if ($begin  eq '');
        $end    = "24:00" if ($end    eq '');
        $amount = "00:00" if ($amount eq '');
d987 52
d1065 1
a1065 1
    $rv = sprintf("%04d%02d%02d", $year, $month, $day);
d1102 1
a1102 1
    $label = "date"    ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Date"    , "Labelhide" => 0, "Widthmin"  =>  8, "Widthmax"  =>  8, "Width"  =>  8, "Widthweight" =>  0, "Colgap" => 1, "Colhide" => 0, "Coljump" => 1, "Coleditable" => 1 }; $matrixdata->{"CK.$label"} = $c; $c++;
d1106 3
a1108 3
    $label = "account" ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Account" , "Labelhide" => 0, "Widthmin"  => 10, "Widthmax"  => 44, "Width"  => 22, "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"  => 22, "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"  => 22, "Widthweight" =>  1, "Colgap" => 1, "Colhide" => 0, "Coljump" => 0, "Coleditable" => 0 }; $matrixdata->{"CK.$label"} = $c; $c++;
d1791 1
a1791 1
    foreach my $f (qw/user uuid crc32 revision date timespec account remark/) {
d1800 1
a1800 6
        if ($f eq "timespec") {
            ($event->{begin}, $event->{end}, $event->{amount}) = &splittimespec($field);
        }
        else {
            $event->{$f} = $field;
        }
d1818 1
a1818 1
    foreach my $f (qw/user uuid crc32 revision date timespec account remark/) {
a1819 6
        if ($f eq "timespec") {
            $fielddata = &formattimespec($event->{begin}, $event->{end}, $event->{amount});
        }
        else {
            $fielddata = $event->{$f};
        }
d1821 1
a1821 1
        $ln .= &quote($fielddata);
d1903 1
a1903 2
            my $timespec = &formattimespec($event->{begin}, $event->{end}, $event->{amount});
            ($begin, my $end, my $amount) = &splittimespec($timespec);
d1914 1
a1914 2
            my $timespec = &formattimespec($event->{begin}, $event->{end}, $event->{amount});
            (my $begin, $end, my $amount) = &splittimespec($timespec);
d1925 1
a1925 2
            my $timespec = &formattimespec($event->{begin}, $event->{end}, $event->{amount});
            (my $begin, my $end, $amount) = &splittimespec($timespec);
@


1.16
log
@add save; add quit
@
text
@d41 1
a41 1
my $progvers = "0.5.5";
@


1.15
log
@resolve name/lookup problem for initial sort criteria
@
text
@d177 10
a186 4
    &events2matrix();
    &as_cui_matrix::ascui($matrixdata, $opt_verbose);
    &matrix2events();
    &writeevents();
@


1.14
log
@time completion in bash sucks so throw it away
@
text
@d1288 5
a1292 1
    $matrixdata->{"Sortorder"} = ["4", "5", "6"] if (not defined $matrixdata->{"Sortorder"});
@


1.13
log
@support cell copying from prev/succ row
@
text
@a239 37
    elsif ($opt_complete eq 'time') {
        my ($begin, $end, $amount) = &splittimespec($arg);
        my $input = $arg;
        my $output = $begin . "-" . $end . "=" . $amount;

        #   Brain-Dead GNU Bash Completion Wor(l)d Breaking Feature
        #   ...
        #   see also: GNU Bash 2.05b, bashline.c, line 208,
        #             variable "bash_completer_word_break_characters"
        my $breakers = quotemeta(" \t\n\"'\@@><=;|&(:");
        my ($prefix, $input_rem, $output_rem) = &splitme($input, $output);
        sub splitme {
            my ($in, $out) = @@_;
            my ($pre, $in_rem, $out_rem) = ("", "", "");
            my $min = (length($in) < length($out) ? length($in) : length($out));
            my $i;
            for ($i = 0; $i < $min; $i++) {
                last if (substr($in, $i, 1) ne substr($out, $i, $1));
                $pre .= substr($in, $i, 1);
            }
            $in_rem  = substr($in, $i);
            $out_rem = substr($out, $i);
            return ($pre, $in_rem, $out_rem);
        }
        if ($input !~ m|[$breakers]|s) {
            # nop
        }
        elsif ($prefix =~ m|[$breakers]|s and $input_rem !~ m|[$breakers]|s) {
            my $prefix_rem = $prefix;
            $prefix_rem =~ s|^.*[$breakers]||s;
            $output = $prefix_rem . $output_rem;
        }
        else {
            $output = "";
        }
    print "$output\n";
    }
d241 1
a241 1
        die "invalid completion type \"$opt_complete\" (has to be 'account' or 'time')";
@


1.12
log
@support setting jump destinations
@
text
@d1100 13
a1112 13
    $label = "status"  ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "#"       , "Labelhide" => 0, "Widthmin"  =>  1, "Widthmax"  =>  1, "Width"  =>  1, "Widthweight" =>  0, "Colgap" => 1, "Colhide" => 0, "Coljump" => 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 }; $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 }; $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 }; $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 }; $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 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "date"    ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Date"    , "Labelhide" => 0, "Widthmin"  =>  8, "Widthmax"  =>  8, "Width"  =>  8, "Widthweight" =>  0, "Colgap" => 1, "Colhide" => 0, "Coljump" => 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 }; $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 }; $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 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "account" ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Account" , "Labelhide" => 0, "Widthmin"  => 10, "Widthmax"  => 44, "Width"  => 22, "Widthweight" => 10, "Colgap" => 1, "Colhide" => 0, "Coljump" => 1 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "remark"  ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Remark"  , "Labelhide" => 0, "Widthmin"  => 10, "Widthmax"  => 44, "Width"  => 22, "Widthweight" =>  5, "Colgap" => 1, "Colhide" => 0, "Coljump" => 0 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "error"   ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Error"   , "Labelhide" => 0, "Widthmin"  => 10, "Widthmax"  => 44, "Width"  => 22, "Widthweight" =>  1, "Colgap" => 1, "Colhide" => 0, "Coljump" => 0 }; $matrixdata->{"CK.$label"} = $c; $c++;
d1298 18
@


1.11
log
@flush pending changes
@
text
@d1100 13
a1112 13
    $label = "status"  ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "#"       , "Labelhide" => 0, "Widthmin"  =>  1, "Widthmax"  =>  1, "Width"  =>  1, "Widthweight" =>  0, "Colgap" => 1, "Colhide" => 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 }; $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 }; $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 }; $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 }; $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 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "date"    ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Date"    , "Labelhide" => 0, "Widthmin"  =>  8, "Widthmax"  =>  8, "Width"  =>  8, "Widthweight" =>  0, "Colgap" => 1, "Colhide" => 0 }; $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 }; $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 }; $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 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "account" ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Account" , "Labelhide" => 0, "Widthmin"  => 10, "Widthmax"  => 44, "Width"  => 22, "Widthweight" => 10, "Colgap" => 1, "Colhide" => 0 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "remark"  ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Remark"  , "Labelhide" => 0, "Widthmin"  => 10, "Widthmax"  => 44, "Width"  => 22, "Widthweight" =>  5, "Colgap" => 1, "Colhide" => 0 }; $matrixdata->{"CK.$label"} = $c; $c++;
    $label = "error"   ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "Error"   , "Labelhide" => 0, "Widthmin"  => 10, "Widthmax"  => 44, "Width"  => 22, "Widthweight" =>  1, "Colgap" => 1, "Colhide" => 0 }; $matrixdata->{"CK.$label"} = $c; $c++;
@


1.10
log
@cosmetics :-)
@
text
@d41 1
a41 1
my $progvers = "0.5.4";
@


1.9
log
@fix comment, fill last line 100%
@
text
@d25 1
a25 1
##  as.pl: Unix Command-Line Client
d29 6
a34 6
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
d36 1
a36 1
require "as-cui-matrix.pm"; #part of AS-CUI
d59 1
a59 1
my @@localruntime = localtime(time);
@


1.8
log
@flush pending changes
@
text
@d96 1
a96 1
# post-process parsed options
@


1.7
log
@&today was renamed to &day
@
text
@d41 1
a41 1
my $progvers = "0.5.3";
@


1.6
log
@flush pending changes
@
text
@d1140 1
a1140 1
            $date = &today();
d1183 1
a1183 1
            $date = &today();
@


1.5
log
@Transfer documentation fragments from code to POD
Allow F1/Help to read and display an as-cui.help file which can be created from POD
Remove unnecessary checks for $editcell in &keybinder as it's head is a short circuit
@
text
@d41 1
a41 1
my $progvers = "0.5.2";
@


1.4
log
@flush pending changes
@
text
@d1120 1
a1120 5
    #   "R" event was just read in and no status was ever computed
    #   " " event is good
    #   "E" event has one or more errors
    #   "M" event was modified (crc32 fails)
    #   "N" event is new
@


1.3
log
@modules was renamed
@
text
@d41 1
a41 1
my $progvers = "0.5.1";
@


1.2
log
@flush pending changes
@
text
@d178 1
a178 1
    &matrix::ascui($matrixdata, $opt_verbose);
@


1.1
log
@polish for initial release
@
text
@d41 1
a41 1
my $progvers = "0.5.0";
@