head 1.45;
access;
symbols
AS_CUI_0_5_0:1.44
AS_AFTER_RESTRUCTURING:1.24;
locks; strict;
comment @# @;
1.45
date 2002.12.18.11.18.20; author rse; state dead;
branches;
next 1.44;
1.44
date 2002.12.17.13.47.50; author thl; state Exp;
branches;
next 1.43;
1.43
date 2002.12.17.13.39.18; author thl; state Exp;
branches;
next 1.42;
1.42
date 2002.12.17.10.50.00; author thl; state Exp;
branches;
next 1.41;
1.41
date 2002.12.11.14.02.08; author thl; state Exp;
branches;
next 1.40;
1.40
date 2002.12.11.13.31.50; author thl; state Exp;
branches;
next 1.39;
1.39
date 2002.12.11.11.12.30; author thl; state Exp;
branches;
next 1.38;
1.38
date 2002.12.10.15.05.33; author thl; state Exp;
branches;
next 1.37;
1.37
date 2002.12.10.14.09.27; author thl; state Exp;
branches;
next 1.36;
1.36
date 2002.12.10.10.26.36; author thl; state Exp;
branches;
next 1.35;
1.35
date 2002.12.05.14.04.57; author thl; state Exp;
branches;
next 1.34;
1.34
date 2002.12.04.14.58.53; author thl; state Exp;
branches;
next 1.33;
1.33
date 2002.12.04.14.19.13; author thl; state Exp;
branches;
next 1.32;
1.32
date 2002.12.04.13.42.02; author thl; state Exp;
branches;
next 1.31;
1.31
date 2002.12.04.12.11.30; author thl; state Exp;
branches;
next 1.30;
1.30
date 2002.12.04.10.55.39; author thl; state Exp;
branches;
next 1.29;
1.29
date 2002.12.04.09.56.42; author thl; state Exp;
branches;
next 1.28;
1.28
date 2002.12.03.19.21.11; author thl; state Exp;
branches;
next 1.27;
1.27
date 2002.12.03.10.33.50; author thl; state Exp;
branches;
next 1.26;
1.26
date 2002.12.03.09.38.11; author thl; state Exp;
branches;
next 1.25;
1.25
date 2002.12.02.13.46.27; author thl; state Exp;
branches;
next 1.24;
1.24
date 2002.11.27.15.53.11; author thl; state Exp;
branches;
next 1.23;
1.23
date 2002.11.27.14.34.04; author thl; state Exp;
branches;
next 1.22;
1.22
date 2002.11.27.13.02.41; author thl; state Exp;
branches;
next 1.21;
1.21
date 2002.11.26.15.44.21; author thl; state Exp;
branches;
next 1.20;
1.20
date 2002.10.31.16.33.42; author thl; state Exp;
branches;
next 1.19;
1.19
date 2002.10.31.16.28.55; author thl; state Exp;
branches;
next 1.18;
1.18
date 2002.10.31.16.20.34; author thl; state Exp;
branches;
next 1.17;
1.17
date 2002.10.31.16.02.45; author thl; state Exp;
branches;
next 1.16;
1.16
date 2002.10.31.13.51.35; author rse; state Exp;
branches;
next 1.15;
1.15
date 2002.10.31.10.23.36; author thl; state Exp;
branches;
next 1.14;
1.14
date 2002.10.31.09.29.52; author thl; state Exp;
branches;
next 1.13;
1.13
date 2002.10.31.08.51.08; author thl; state Exp;
branches;
next 1.12;
1.12
date 2002.10.30.16.48.16; author thl; state Exp;
branches;
next 1.11;
1.11
date 2002.10.30.16.20.21; author thl; state Exp;
branches;
next 1.10;
1.10
date 2002.10.30.14.02.19; author thl; state Exp;
branches;
next 1.9;
1.9
date 2002.10.30.10.38.21; author thl; state Exp;
branches;
next 1.8;
1.8
date 2002.10.24.15.09.56; author thl; state Exp;
branches;
next 1.7;
1.7
date 2002.10.24.12.23.55; author thl; state Exp;
branches;
next 1.6;
1.6
date 2002.10.24.08.26.34; author thl; state Exp;
branches;
next 1.5;
1.5
date 2002.10.23.14.16.31; author thl; state Exp;
branches;
next 1.4;
1.4
date 2002.10.23.09.08.25; author thl; state Exp;
branches;
next 1.3;
1.3
date 2002.10.16.12.37.01; author thl; state Exp;
branches;
next 1.2;
1.2
date 2002.09.26.18.13.19; author rse; state Exp;
branches;
next 1.1;
1.1
date 2002.09.25.15.11.02; author rse; state Exp;
branches;
next ;
desc
@@
1.45
log
@polish for initial release
@
text
@#!/bin/sh -- # -*- perl -*-
eval 'exec perl -S $0 ${1+"$@@"}'
if $running_under_some_shell;
##
## AS -- Accounting System
## Copyright (c) 2002 Cable & Wireless Deutschland
## Copyright (c) 2002 Ralf S. Engelschall
##
## 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 .
##
## as.pl: Unix Command-Line Client
##
require 5.003;
use strict; #OpenPKG perl-5.6.1
use IO; #OpenPKG perl-5.6.1
use Getopt::Long; #OpenPKG perl-5.6.1
use Text::Balanced; #OpenPKG perl-parse-20021016
use Data::UUID; #OpenPKG perl-crypto-20021030
use String::CRC32; #OpenPKG perl-crypto-20021030
use matrix; #part of AS
# program version
my $progname = "as";
my $progvers = "0.1.0";
# data format version
my $datavers = $progvers;
$datavers =~ s/\.[0-9]+$//;
# options
my $opt_complete = '';
my $opt_define = {};
my $opt_verbose = 0;
my $opt_setup = 0;
my $opt_download = 0;
my $opt_update = [];
my $opt_commit = [];
my $opt_help = 0;
my $opt_version = 0;
# preset options
my @@localruntime = localtime(time);
# internal global structures
my $runtimecfg = {};
my $accounts = [];
my $events = {};
my $matrixdata = {};
# exception handling support
$SIG{__DIE__} = sub {
my ($err) = @@_;
$err =~ s|\s+at\s+.*||s if (not $opt_verbose);
my $txt = "$err ". ($! ? "($!)" : "");
print STDERR "ERROR: $txt\n";
exit(1);
};
# verbose message printing
sub verbose {
my ($msg) = @@_;
print STDERR "$msg\n" if ($opt_verbose);
}
# command line parsing
Getopt::Long::Configure("bundling");
my $result = GetOptions(
'C|complete=s' => \$opt_complete,
'D|define=s' => $opt_define, #FIXME -Dfoo=bar works but --define foo=bar does not
'v|verbose' => \$opt_verbose,
's|setup' => \$opt_setup,
'd|download' => \$opt_download,
'u|update:s' => $opt_update,
'c|commit:s' => $opt_commit,
'h|help' => \$opt_help,
'V|version' => \$opt_version
) || die "option parsing failed";
# post-process parsed options
if (($#{$opt_update} >= 0) && ($opt_update->[0] ne "")) {
@@{$opt_update} = split(/,/,join(',',@@{$opt_update}));
}
if (($#{$opt_commit} >= 0) && ($opt_commit->[0] ne "")) {
@@{$opt_commit} = split(/,/,join(',',@@{$opt_commit}));
}
# read and set the runtime configuration options
$runtimecfg = &readrc();
foreach my $var (keys %{$opt_define}) {
$runtimecfg->{$var} = $opt_define->{$var};
}
# fallbacks
if (not defined($runtimecfg->{"user"})) {
$runtimecfg->{"user"} = $ENV{LOGNAME};
}
if (not defined($runtimecfg->{"date"})) {
$runtimecfg->{"date"} = &day(@@localruntime);
}
if (not defined($runtimecfg->{"time"})) {
$runtimecfg->{"time"} = &now(@@localruntime);
}
if (not defined($runtimecfg->{"hist"})) {
$runtimecfg->{"hist"} = 99;
}
# sanity checks on runtime configuration
if (not $runtimecfg->{"user"} =~ m/^[a-z0-9]+$/) {
die "sanity check of runtime configuration \"user\" failed for \"$runtimecfg->{user}\".\n";
}
if (not &isvalidyyyymmdd($runtimecfg->{"date"})) {
die "sanity check of runtime configuration \"date\" failed for \"$runtimecfg->{date}\".\n";
}
if (not &isvalidhhmm($runtimecfg->{"time"})) {
die "sanity check of runtime configuration \"time\" failed for \"$runtimecfg->{time}\".\n";
}
# read in the accounts list
$accounts = &readaccounts();
# short-circuit dispatch
if ($opt_complete ne "") {
&do_complete($ARGV[0]);
exit 0;
}
# read in the events
$events = &readevents();
# dispatch into sub-routines
if ($opt_setup) {
&do_setup;
}
elsif ($opt_download) {
&do_unimplemented;
}
elsif ($#{$opt_update} >= 0) {
&do_unimplemented;
}
elsif ($#{$opt_commit} >= 0) {
&do_unimplemented;
}
elsif ($opt_help) {
print STDOUT "Usage: $progname [options] [arguments]\n" .
"Available options:\n" .
" -D,--define opt-name=opt-value\n" .
" -v,--verbose be chatty\n" .
" -s,--setup setup\n" .
" -d,--download download writeable accounts list from server\n" .
" -u,--update [uuid] update local database with information from server\n" .
" -c,--commit [uuid] commit pending changes to server\n" .
" -h,--help print out this usage page\n" .
" -V,--version print out program version\n";
}
elsif ($opt_version) {
print STDOUT "$progname $progvers\n";
}
elsif ($#ARGV == -1) {
&events2matrix();
&matrix::ascui($matrixdata, $opt_verbose);
&matrix2events();
&writeevents();
}
else {
my $timespec = shift @@ARGV;
if (not defined $timespec) {
die "CLI timespec missing";
}
my $account = shift @@ARGV;
if (not defined $account) {
die "CLI account missing";
}
if (not &isvalidaccount($account)) {
die "CLI invalid account \"$account\"";
}
if ($account =~ m|^(\.[-a-zA-Z0-9]+)+$|) {
$account = &dot2slash($account);
}
my $remark = '';
for my $i (@@ARGV) {
$remark .= $i . " ";
}
$remark =~ s/ $//;
&do_newevent($timespec, $account, $remark);
&writeevents();
}
exit(0);
#
# Command Line Argument Completion Utility
# (see as.bash for context)
#
# testsuite.sh
# echo 000; perl as.pl --complete time -- 22:33
# echo 001; perl as.pl --complete time -- =22:33
# echo 010; perl as.pl --complete time -- -11:22 #defeat leading dash
# echo 011; perl as.pl --complete time -- -11:22=22:33 #defeat leading dash
# echo 100; perl as.pl --complete time -- 00:11-
# echo 101; perl as.pl --complete time -- 00:11-=22:33 #defeat spaces
# echo 110; perl as.pl --complete time -- 00:11-11:22
# echo 111; perl as.pl --complete time -- 00:11-11:22=22:33
#
sub do_complete {
my ($arg) = @@_;
if ($opt_complete eq 'account') {
if ($arg eq '') {
print "/\n" . ".\n";
return;
}
else {
my $pattern = quotemeta($arg);
foreach my $ac (@@{$accounts}) {
if ($ac->{name} =~ m|^$pattern|) {
print "$ac->{name}\n";
}
}
return;
}
}
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";
}
else {
die "invalid completion type \"$opt_complete\" (has to be 'account' or 'time')";
}
}
sub isvalidhhmm {
my ($input) = @@_;
if ($input =~ m/([01][0-9]|2[0-4]):[0-5][0-9](:[0-5][0-9])?$/) {
return 1;
}
return 0;
}
sub isvalidyyyymmdd {
my ($input) = @@_;
if ($input =~ m/^[2-9][0-9]{3}([0][1-9]|[1][0-2])([0][1-9]|[12][0-9]|[3][01])$/) {
return 1;
}
return 0;
}
sub isvaliduser {
my ($user, $status) = (@@_);
return 1 if ($user =~ m|^[a-zA-Z][a-zA-Z0-9]*$|);
$status->{user} = "user" if (defined $status);
return 0;
}
sub isvaliduuid {
my ($uuid, $status) = (@@_);
return 1 if ($uuid =~ m|^[0-9a-fA-F]{8}(-[0-9a-fA-F]{4}){3}-[0-9a-fA-F]{12}$|);
$status->{uuid} = "uuid" if (defined $status);
return 0;
}
sub isvalidcrc32 {
my ($crc32, $status) = (@@_);
return 1 if ($crc32 =~ m|^[0-9a-fA-F]{1,8}$|);
$status->{crc32} = "crc32" if (defined $status);
return 0;
}
sub isvalidrevision {
my ($revision, $status) = (@@_);
return 1 if ($revision =~ m|^[0-9]{1,5}$|);
$status->{revision} = "revision" if (defined $status);
return 0;
}
sub isvaliddate {
my ($date, $status) = (@@_);
return 1 if (&isvalidyyyymmdd($date));
$status->{date} = "date" if (defined $status);
return 0;
}
sub isvalidbegin {
my ($begin, $status) = (@@_);
return 1 if (&isvalidhhmm($begin));
$status->{begin} = "begin" if (defined $status);
return 0;
}
sub isvalidend {
my ($end, $status) = (@@_);
return 1 if (&isvalidhhmm($end));
$status->{end} = "end" if (defined $status);
return 0;
}
sub isvalidamount {
my ($amount, $status) = (@@_);
return 1 if (&isvalidhhmm($amount));
$status->{amount} = "amount" if (defined $status);
return 0;
}
sub isvalidaccount {
my ($account, $status) = (@@_);
if ($account =~ m|^\.|) {
$account = &dot2slash($account);
}
foreach my $element (@@{$accounts}) {
return 1 if ($element->{type} eq "R" and $account =~ m|^$element->{name}$|);
}
$status->{account} = "account" if (defined $status);
return 0;
}
sub isvalidremark {
my ($amount, $status) = (@@_);
return 1;
}
#
# make any input a valid date or wipe it out if no conversion possible
# dot is a valid input and means today
# today is taken from reality unless overridden by using a second optional parameter
#
sub anydate2yyyymmdd {
my ($input, @@localtime) = (@@_);
my $output;
if (&isvalidyyyymmdd($input)) {
$output = $input;
}
elsif ($input =~ m|^\.$|) {
$output = &day(@@localtime);
}
else {
$output = "";
}
return $output;
}
#
# make any input a valid time or wipe it out if no conversion possible
# dot is a valid input and means now
# now is taken from reality unless overridden by using a second optional parameter
#
sub anytime2hhmm {
my ($input, @@localtime) = (@@_);
my $output = "";
if (&isvalidhhmm($input)) {
$output = $input;
}
elsif ($input =~ m|^\.$|) {
$output = &now(@@localtime);
}
elsif ($input =~ m/^([1-9])?(:([0-9]|[0-5][0-9])?)?$/) {
# short
$output = sprintf("%02d:%02d", $1, $3);
}
elsif ($input =~ m/^([0-9]|[1][0-9]|2[0-4])?:([0-9]|[0-5][0-9])?$/) {
# short-hour
$output = sprintf("%02d:%02d", $1, $2);
}
elsif ($input =~ m/^([0-9]*\.[0-9]+|[0-9]+\.)$/) {
# frac-dec
my $f = "0".$1;
$f = int($f * 60 + 0.5);
my $h = $f / 60;
my $m = $f % 60;
$output = sprintf("%02d:%02d", $h, $m);
}
elsif ($input =~ m/^([0-9]*\/[1-9][0-9]*)$/) {
# frac-std
my $f = $1;
$f =~ s|^/|1/|s;
eval "\$f = int(($f) * 60 + 0.5);";
my $h = $f / 60;
my $m = $f % 60;
$output = sprintf("%02d:%02d", $h, $m);
}
elsif ($input =~ m/^0([0-9])$/) {
# force-min
$output = "00:0$1";
}
elsif ($input =~ m/^([1-9][0-9]+)$/) {
# short-min
my $h = int($1 / 60);
my $m = int($1 % 60);
$output = sprintf("%02d:%02d", $h, $m);
}
else {
$output = "";
}
return $output;
}
#
# Read rc file
#
sub readrc {
my $rc = {};
my $path;
my $io;
# in setup mode, no access to the file is no reason to die; just return no data
if ($opt_setup) {
($path, $io) = &openfile("rc", "x");
if (not $io) {
return $rc;
}
}
($path, $io) = &openfile("rc", "r");
my $line = 1;
my $ln;
while (defined($ln = <$io>)) {
$line++;
$ln =~ s|^\s*||s; #strip off leading spaces
$ln =~ s|\s*(#.*)?$||s; #strip off trailing spaces and comments
next if ( $ln =~ m|^\s*$| ); #ignore empty lines
my $remainder = $ln;
my $q = '"';
my $var;
if ($remainder =~ m|^$q|) {
($var, $remainder) = Text::Balanced::extract_delimited($remainder, $q);
$var =~ s|^$q(.*)$q$|$1|;
} else {
$_ = $remainder;
($var, $remainder) = m|^([^\s]*)(.*)$|;
}
$var =~ s|\\(.)|$1|g;
$remainder =~ s|^\s*(.*)$|$1|;
my $val;
if ($remainder =~ m|^$q|) {
($val, $remainder) = Text::Balanced::extract_delimited($remainder, $q);
$val =~ s|^$q(.*)$q$|$1|;
} else {
$_ = $remainder;
($val, $remainder) = m|^([^\s]*)(.*)$|;
}
$val =~ s|\\(.)|$1|g;
$remainder =~ s|^\s*(.*)$|$1|;
if ($remainder ne "") {
die "syntax error in $path, line $line: unexpected data \"$remainder\" found.\n";
}
$rc->{$var} = $val;
}
&closefile($io);
return $rc;
}
#
# Read accounts file
#
sub readaccounts {
my $ac = [];
my $path;
my $io;
# in setup mode, no access to the file is no reason to die; just return no data
if ($opt_setup) {
($path, $io) = &openfile("accounts", "x");
if (not $io) {
return $ac;
}
}
($path, $io) = &openfile("accounts", "r");
my $line = 1;
my $ln;
while (defined($ln = <$io>)) {
$line++;
$ln =~ s|^\s*||s; #strip off leading spaces
$ln =~ s|\s*(#.*)?$||s; #strip off trailing spaces and comments
next if ( $ln =~ m|^\s*$| ); #ignore empty lines
my $remainder = $ln;
my $q = '"';
my $type;
if ($remainder =~ m|^$q|) {
($type, $remainder) = Text::Balanced::extract_delimited($remainder, $q);
$type =~ s|^$q(.*)$q$|$1|;
} else {
$_ = $remainder;
($type, $remainder) = m|^([^\s]*)(.*)$|;
}
$type =~ s|\\(.)|$1|g;
$remainder =~ s|^\s*(.*)$|$1|;
if (($type ne "A") && ($type ne "R")) {
die "syntax error in $path, line $line: unexpected type \"$type\" found.\n";
}
my $name;
if ($remainder =~ m|^$q|) {
($name, $remainder) = Text::Balanced::extract_delimited($remainder, $q);
$name =~ s|^$q(.*)$q$|$1|;
} else {
$_ = $remainder;
($name, $remainder) = m|^([^\s]*)(.*)$|;
}
$name =~ s|\\(.)|$1|g;
$remainder =~ s|^\s*(.*)$|$1|;
if (not $name =~ m|^/[-a-zA-Z0-9/]+[^/]$|) {
die "syntax error in $path, line $line: unexpected name \"$name\" found.\n";
}
my $desc;
if ($remainder =~ m|^$q|) {
($desc, $remainder) = Text::Balanced::extract_delimited($remainder, $q);
$desc =~ s|^$q(.*)$q$|$1|;
} else {
$_ = $remainder;
($desc, $remainder) = m|^([^\s]*)(.*)$|;
}
$desc =~ s|\\(.)|$1|g;
$remainder =~ s|^\s*(.*)$|$1|;
if ($remainder ne "") {
die "syntax error in $path, line $line: unexpected data \"$remainder\" found.\n";
}
my $sname = $name;
$sname .= "/" if ($type ne "R");
my $dname = &slash2dot($sname);
push (@@{$ac}, { type=>$type, name=>$sname, desc=>$desc });
push (@@{$ac}, { type=>$type, name=>$dname, desc=>$desc });
}
&closefile($io);
return $ac;
}
#
# Slash to dot account name conversion
#
sub slash2dot {
my ($sname) = @@_;
$sname =~ s|^/||;
my $dname = '';
foreach my $part (reverse(split(/\//, $sname))) {
$dname .= "." . $part;
}
return $dname;
}
#
# Dot to slash account name conversion
#
sub dot2slash {
my ($dname) = @@_;
$dname =~ s|^.||;
my $sname = '';
foreach my $part (reverse(split(/\./, $dname))) {
$sname .= "/" . $part;
}
return $sname;
}
#
# Complete possible account list based on given pattern
#
sub completeaccount {
my ($pattern) = @@_;
$pattern = quotemeta($pattern);
my $acs = [];
foreach my $ac (@@{$accounts}) {
if ($ac->{name} =~ m|^$pattern|) {
push @@{$acs}, $ac->{name};
}
}
return $acs;
}
#
# Read events file
#
sub readevents {
my $ev = {};
my $path;
my $io;
# in setup mode, no access to the file is no reason to die; just return no data
if ($opt_setup) {
($path, $io) = &openfile("events", "x");
if (not $io) {
return $ev;
}
}
($path, $io) = &openfile("events", "r");
my $line = 1;
my $ln;
while (defined($ln = <$io>)) {
$line++;
my $event = &ln2event($ln, $line);
next unless (defined $event);
&processeventfields($event, qw/status/);
if ($event->{status} eq "E") {
die "syntax error in $path, line $line: $event->{error}\n";
}
&processeventfields($event, qw/user uuid revision date begin end amount account remark status/);
my $uuid = $event->{uuid};
if (defined %{$ev}->{$uuid}) {
die "consistency error in $path, line $line: duplicate uuid \"$uuid\" first seen in line $ev->{$uuid}->{line}.\n";
}
if ($event->{status} eq "E") {
print STDERR "WARNING: bad event in $path, line $line: $event->{error}\n";
}
&setevent($ev, $event);
}
&closefile($io);
return $ev;
}
#
# Write events file
#
sub writeevents {
my $path;
my $io;
($path, $io) = &openfile("events", "w");
my $line = 1;
my $ln;
foreach my $uuid (sort bydateline keys %{$events}) {
$line++;
my $event = &getevent($events, $uuid);
&processeventfields($event, qw/crc32/);
$ln = &event2ln($event);
print $io "$ln\n";
};
&closefile($io);
return;
}
#
#
#
sub formattimespec {
my ($begin, $end, $amount) = (@@_);
return $begin . "-" . $end . "=" . $amount;
}
#
# quote
#
sub quote {
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;
}
#
# sort by date with fallback to begin/line and finally uuid
#
sub bydateline {
# by date
if (%{$events}->{$a}->{date} != %{$events}->{$b}->{date}) {
return %{$events}->{$a}->{date} <=> %{$events}->{$b}->{date};
}
# by begin time
if (%{$events}->{$a}->{begin} != %{$events}->{$b}->{begin}) {
return %{$events}->{$a}->{begin} <=> %{$events}->{$b}->{begin};
}
# by line with commandline entries to the end
if (%{$events}->{$a}->{line} eq "commandline") {
return 1;
}
if (%{$events}->{$b}->{line} eq "commandline") {
return -1;
}
if (%{$events}->{$a}->{line} != %{$events}->{$b}->{line}) {
return %{$events}->{$a}->{line} <=> %{$events}->{$b}->{line};
}
# fallback to uuid
return $a <=> $b;
}
#
# split with support for balanced quotes
#
sub splitq {
my ($ln) = @@_;
my $q = '"';
my $remainder = $ln;
my $field = '';
if ($remainder =~ m|^$q|) {
($field, $remainder) = Text::Balanced::extract_delimited($remainder, $q);
$field =~ s|^$q(.*)$q$|$1|;
} else {
$_ = $remainder;
($field, $remainder) = m|^([^\s]*)(.*)$|;
}
$field =~ s|\\(.)|$1|g;
$remainder =~ s|^[ ]*||;
return $field, $remainder;
}
#
# Calculate CRC32 for an entry referenced by uuid
#
sub calccrc32 {
my ($event) = @@_;
my $crc32 = 0;
foreach my $f (qw/user uuid revision date begin end amount account remark/) {
my $field = $event->{$f};
$field = "" unless (defined $field);
$crc32 = &crc32($field, $crc32);
}
return sprintf("%08x", $crc32);
}
#
# open file and check/set for magic cookie on the first line
#
# INPUT
# $mode = "r" - open for reading and check cookie - die on error
# $mode = "w" - open for writing and set cookie - die on error
# $mode = "x" - test for existance and check cookie
#
# OUTPUT
# $path always returns the full path name of the file
# $io on read/write returns IO::File handle
# $io on existance test returns 0 (no) or 1 (yes)
#
sub openfile {
my ($file, $mode) = @@_;
my $path = "$ENV{HOME}/.as/$file";
my $magic = uc($file);
if ($mode eq "r") {
my $io = new IO::File "<$path";
if (not defined($io)) {
die "unable to open file \"$path\" for reading [hint: did you ever set up using -s?]";
}
my $rc = <$io>;
if (not $rc =~ m/^%!AS-$magic-$datavers$/ ) {
die "file \"$path\" fails magic cookie check for %!AS-$magic-$datavers";
}
return $path, $io;
}
elsif ($mode eq "w") {
# keep a history before overwriting
if (-f $path) {
my $f=".%0" . int(log($runtimecfg->{hist}) / log(10) + 1) . "d";
for(my $i = $runtimecfg->{hist}; $i >= 1; $i--) {
my $s = $i == 1 ? '' : sprintf($f, $i - 1);
my $t = sprintf($f, $i);
rename "$path$s", "$path$t" if (-f "$path$s");
}
}
my $io = new IO::File ">$path";
if (not defined($io)) {
die "unable to open file \"$path\" for writing";
}
my $rc = "%!AS-$magic-$datavers\n";
if (not defined (print $io $rc)) {
die "file \"$path\" fails magic cookie write for %!AS-$magic-$datavers";
}
return $path, $io;
}
elsif ($mode eq "x") {
my $flag = 0;
my $io = new IO::File "<$path";
if (defined($io)) {
my $rc = <$io>;
&closefile($io);
if ($rc =~ m/^%!AS-$magic-$datavers$/ ) {
$flag = 1;
}
}
return $path, $flag;
}
die "INTERNAL: openfile() called with unknown mode \"$mode\"";
}
#
# close file previously opened by openfile()
#
sub closefile {
my ($io) = @@_;
if (defined($io)) {
$io->close();
} else {
die "INTERNAL: closefile() called on undefined file handle\n";
}
return;
}
#
# setup $HOME/.as
#
sub do_setup {
my $path;
my $io;
# try an open just to figure out the path
($path, $io) = &openfile("rc", "x");
$path =~ s|/[^/]*$||;
# create the folder, if it doesn't exist
if (not -d $path) {
mkdir $path, 0750 || die "cannot create directory \"$path\"";
}
# write the "rc" file
my $quote = '"';
my $backslash = '\\';
($path, $io) = &openfile("rc", "w");
foreach my $var (keys %{$runtimecfg}) {
my $val = $runtimecfg->{$var};
$val =~ s/([\\$quote\s])/$backslash$1/g; #FIXME poor man's escaping - hint: try quotemeta()
print $io "$var $quote$val$quote\n";
}
&closefile($io);
# write the "accounts" file
($path, $io) = &openfile("accounts", "w");
print $io "A /example \"an example account\"\n";
print $io "R /example/account \"please get a real account list\"\n";
&closefile($io);
# write the "events" file
($path, $io) = &openfile("events", "w");
print $io "#user 12345678-9abc-def0-1234-56789abcdef0 01234567 00001 20021204 10:00-11:00=01:00 /example/account \"example entry showing complete timespec\" #comment\n";
print $io "#user 12345678-9abc-def0-1234-56789abcdef1 01234567 00001 20021204 10:00-11:00= /example/account \"example entry showing how to calc amount\" #comment\n";
print $io "#user 12345678-9abc-def0-1234-56789abcdef2 01234567 00001 20021204 10:00-=01:00 /example/account \"example entry showing how to calc end\" #comment\n";
print $io "#user 12345678-9abc-def0-1234-56789abcdef3 01234567 00001 20021204 -11:00=01:00 /example/account \"example entry showing how to calc begin\" #comment\n";
print $io "#user 12345678-9abc-def0-1234-56789abcdef4 01234567 00001 20021204 -.=01:00 /example/account \"example entry showing how to calc begin until now\" #comment\n";
print $io "#user 12345678-9abc-def0-1234-56789abcdef5 01234567 00001 20021204 .-=01:00 /example/account \"example entry showing how to calc end upto now\" #comment\n";
&closefile($io);
}
#
# create an new event
#
sub do_newevent {
my ($timespec, $account, $remark) = @@_;
# preset
my $uuid = &newuuid();
my $line = "cli";
my $user = $runtimecfg->{user};
my $crc32 = undef;
my $revision = 0;
my $date = $runtimecfg->{date};
my ($begin,
$end,
$amount) = &splittimespec($timespec);
# sanity check
if (not &isvalidhhmm($begin)) {
die "unexpected begin \"$begin\" found.\n";
}
if (not &isvalidhhmm($end)) {
die "unexpected end \"$end\" found.\n";
}
if (not &isvalidhhmm($amount)) {
die "unexpected amount \"$amount\" found.\n";
}
# create new uuid and store new event in memory
%{$events}->{$uuid} = {
line => $line,
user => $user,
crc32 => $crc32,
revision => $revision,
date => $date,
begin => $begin,
end => $end,
amount => $amount,
account => $account,
remark => $remark,
error => undef
};
return $uuid;
}
#
# create an new cui event from scratch or paste in data from optional given event
#
sub cuinewevent {
my ($paste) = @@_;
my $event = {
"uuid" => $paste->{"uuid"} || &newuuid(),
"line" => $paste->{"line"} || "+",
"user" => $paste->{"user"} || $runtimecfg->{user},
"crc32" => $paste->{"crc32"} || undef,
"revision" => $paste->{"revision"} || 0,
"date" => $paste->{"date"} || $runtimecfg->{date},
"begin" => $paste->{"begin"} || "00:00",
"end" => $paste->{"end"} || "24:00",
"amount" => $paste->{"amount"} || "08:00",
"account" => $paste->{"account"} || "",
"remark" => $paste->{"remark"} || "",
"error" => $paste->{"error"} || undef
};
&setevent($events, $event);
return $event;
}
#
# create uuid and check for uniqness in local database
#
sub newuuid {
my $ug = new Data::UUID;
my $uuidinternal = $ug->create();
my $uuid = lc $ug->to_string($uuidinternal);
if (defined %{$events}->{$uuid}) {
die "consistency error: duplicate uuid \"$uuid\" first seen in line $events->{$uuid}->{line}.\n";
}
return $uuid;
}
#
# splittimespec
#
sub splittimespec {
my ($timespec) = @@_;
my $begin = '00:00';
my $end = '24:00';
my $amount = '';
my $compute = '';
my $beginsec;
my $endsec;
my $amountsec;
#f ($timespec =~ m/^(([^-]+)?-([^=]+)?)?=?(.*)$/) { #( begin? - end? )? =? amount*
#perl -e '$t = "-03:00="; $t =~ m/^(([^-]+)?-([^=]+)?)?=?(.*)$/; print "$2 - $3 = $4\n";'
if ($timespec =~ m/^(([^-]+)?-([^=]+)?)?=?(.*)$/) { #( begin? - end? )? =? amount*
($begin, $end, $amount) = ($2, $3, $4);
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 '');
}
$begin = &anytime2hhmm($begin);
$end = &anytime2hhmm($end);
$amount = &anytime2hhmm($amount);
return $begin, $end, $amount;
}
sub hhmm2sec {
my ($hhmm) = (@@_);
my $rv = undef;
if ($hhmm =~ m/^([0-1]?[0-9]|2[0-4]):([0-5]?[0-9])$/) {
$rv = $1 * 3600 + $2 * 60;
}
return $rv;
}
sub sec2hhmm {
my ($sec) = (@@_);
my $rv = undef;
my $minutes = int($sec / 60);
my $hour = int($minutes / 60);
my $min = int($minutes % 60);
$rv = sprintf("%02d:%02d", $hour, $min);
return $rv;
}
sub day {
my (@@localtime) = (@@_);
my $rv;
@@localtime = (localtime(time)) unless @@localtime;
my ($day, $month, $year) = (@@localtime[3,4,5]);
$month++;
$year += 1900;
$rv = sprintf("%04d%02d%02d", $year, $month, $day);
return $rv;
}
sub now {
my (@@localtime) = (@@_);
my $rv;
@@localtime = (localtime(time)) unless @@localtime;
my ($sec, $min, $hour) = (@@localtime[0,1,2]);
$rv = sprintf("%02d:%02d", $hour, $min);
return $rv;
}
#
# setup $HOME/.as
#
sub do_unimplemented {
die "Sorry, this function is currently not implemented\n";
}
#
# create a data matrix from events
#
sub events2matrix {
my $c;
my $r;
my $label;
# fill in information about column headers (top)
$c = -1;
$label = "status" ; $matrixdata->{"CH.$c"} = { "Keyname" => $label, "Label" => "#" , "Labelhide" => 0, "Widthmin" => 1, "Widthmax" => 1, "Width" => 1, "Widthweight" => 0, "Colgap" => 1, "Colhide" => 0 }; $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++;
$matrixdata->{"Columns"} = $c;
# fill in information about row headers (left) and cell data
$r = -1;
&matrixrowstatus($r, "$r");
$r++;
# "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
foreach my $uuid (keys %{$events}) {
&matrixrowset($r, $uuid, $events->{$uuid}->{status});
$r++;
}
$matrixdata->{"Rows"} = $r;
$matrixdata->{"onanewline"} = sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
my $sc;
my $pred = $dr; #predecessor of new line is current line
my $succ = $dr + 1; #successor of new line is next line
my $date;
$sc = $matrixdata->{"CK.date"};
if ($sc < $matrixdata->{"Columns"} and &isvalidyyyymmdd($matrixdata->{"CD.$sc.$pred"}->{"Data"})) {
$date = $matrixdata->{"CD.$sc.$pred"}->{"Data"};
}
else {
$date = &today();
}
my $begin;
$sc = $matrixdata->{"CK.end"};
if ($sc < $matrixdata->{"Columns"} and &isvalidhhmm($matrixdata->{"CD.$sc.$pred"}->{"Data"})) {
$begin = $matrixdata->{"CD.$sc.$pred"}->{"Data"};
}
else {
$begin = "";
}
my $end;
$sc = $matrixdata->{"CK.begin"};
if ($sc < $matrixdata->{"Columns"} and &isvalidhhmm($matrixdata->{"CD.$sc.$succ"}->{"Data"})) {
$end = $matrixdata->{"CD.$sc.$succ"}->{"Data"};
}
else {
$end = ($begin eq "") ? "" : &now();
}
my $paste = {
"date" => $date,
"begin" => $begin,
"end" => $end,
"amount" => "",
};
my $event = &cuinewevent($paste);
&matrixinsertafter($dr, $event->{uuid}, "N");
};
$matrixdata->{"Onanewline"} = sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
my $sc;
my $pred = $dr - 1; #predecessor of new line is previous line
my $succ = $dr; #successor of new line is current line
my $date;
$sc = $matrixdata->{"CK.date"};
if ($sc < $matrixdata->{"Columns"} and &isvalidyyyymmdd($matrixdata->{"CD.$sc.$pred"}->{"Data"})) {
$date = $matrixdata->{"CD.$sc.$pred"}->{"Data"};
}
else {
$date = &today();
}
my $begin;
$sc = $matrixdata->{"CK.end"};
if ($sc < $matrixdata->{"Columns"} and &isvalidhhmm($matrixdata->{"CD.$sc.$pred"}->{"Data"})) {
$begin = $matrixdata->{"CD.$sc.$pred"}->{"Data"};
}
else {
$begin = "";
}
my $end;
$sc = $matrixdata->{"CK.begin"};
if ($sc < $matrixdata->{"Columns"} and &isvalidhhmm($matrixdata->{"CD.$sc.$succ"}->{"Data"})) {
$end = $matrixdata->{"CD.$sc.$succ"}->{"Data"};
}
else {
$end = ($begin eq "") ? "" : &now();
}
my $paste = {
"date" => $date,
"begin" => $begin,
"end" => $end,
"amount" => "",
};
my $event = &cuinewevent($paste);
&matrixinsertrowat($dr, $event->{uuid}, "N");
};
$matrixdata->{"deletedelete"} = sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
my $event = &matrixrow2event($dr);
push @@{$matrixdata->{"undobuffer"}}, $event;
return &matrixdeleterow($dr);
};
$matrixdata->{"undo"} = sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
my $paste = pop @@{$matrixdata->{"undobuffer"}};
if (defined $paste) {
my $event = &cuinewevent($paste);
&matrixinsertrowat($dr, $event->{uuid}, "U");
return 1;
}
return 0;
};
$matrixdata->{"completeaccount"} = sub {
my ($matrixwidget, $dc, $dr, $vc, $vr, $pattern) = (@@_);
return &completeaccount($pattern);
};
$matrixdata->{"completedate"} = sub {
my ($matrixwidget, $dc, $dr, $vc, $vr, $text) = (@@_);
return &anydate2yyyymmdd($text);
};
$matrixdata->{"completetime"} = sub {
my ($matrixwidget, $dc, $dr, $vc, $vr, $text) = (@@_);
return &anytime2hhmm($text);
};
$matrixdata->{"yankcell"} = sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
if (defined $matrixdata->{"yankrow"}) {
&matrixrowstatus($matrixdata->{"yankrow"})
}
$matrixdata->{"clipboard"} = $matrixdata->{"CD.$dc.$dr"}->{"Data"};
$matrixdata->{"clipboardtype"} = "cell";
$matrixdata->{"yankrow"} = $dr;
&matrixrowstatus($dr, "y");
};
$matrixdata->{"Yankline"} = sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
if (defined $matrixdata->{"yankrow"}) {
&matrixrowstatus($matrixdata->{"yankrow"});
}
my $event = &matrixrow2event($dr);
for my $k (keys %{$event}) {
delete $event->{$k} unless ($k =~ m/^(user|date|begin|end|amount|account|remark)$/);
}
$matrixdata->{"clipboard"} = $event;
$matrixdata->{"clipboardtype"} = "line";
$matrixdata->{"yankrow"} = $dr;
&matrixrowstatus($dr, "Y");
};
$matrixdata->{"paste"} = sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
if ($matrixdata->{"clipboardtype"} eq "cell") {
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixdata->{"clipboard"};
return 1;
}
elsif ($matrixdata->{"clipboardtype"} eq "line") {
my $event = &cuinewevent($matrixdata->{"clipboard"});
&matrixinsertafter($dr, $event->{uuid}, "N");
return 1;
}
return 0;
};
$matrixdata->{"Paste"} = sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
if ($matrixdata->{"clipboardtype"} eq "line") {
my $event = &cuinewevent($matrixdata->{"clipboard"});
&matrixinsertrowat($dr, $event->{uuid}, "N");
return 1;
}
return 0;
};
$matrixdata->{"currentdatetime"} = sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
my $k = $matrixdata->{"CH.$dc"}->{"Keyname"};
my $text = undef;
if ($k =~ m/^(date)$/) {
$text = &day();
}
elsif ($k =~ m/^(begin|end|amount)$/) {
$text = &now();
}
if (defined $text) {
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $text;
return 1;
}
return 0;
};
$matrixdata->{"sort"} = sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
&matrixsort($dr);
};
$matrixdata->{"Sortorder"} = ["4", "5", "6"] if (not defined $matrixdata->{"Sortorder"});
&matrixsort();
}
sub matrixsort {
my $nextrow;
my $r;
my $current = {};
$nextrow = $matrixdata->{"Rows"};
for ($r = 0; $r < $nextrow; $r++) {
my $collect = [];
my $coindex = 0;
foreach my $criteria (@@{$matrixdata->{"Sortorder"}}) {
$collect->[$coindex] = $matrixdata->{"CD.$criteria.$r"}->{"Data"} . " ";
$coindex++;
}
$current->{"$r"} = $collect;
}
# copy the sorted cell data to a new temporary target
my $newmatrixdata = {};
my $targetrow = 0;
my $sourcerow;
foreach my $sourcerow (sort
{
my $result = 0;
my $coindex = 0;
while ($result == 0) {
last if ( (not defined $current->{$a}->[$coindex])
or (not defined $current->{$b}->[$coindex])
);
$result = $current->{$a}->[$coindex] cmp $current->{$b}->[$coindex];
$coindex++
}
return $result;
}
keys %{$current}) {
$newmatrixdata->{"RH.$targetrow"} = $matrixdata->{"RH.$sourcerow"};
for (my $c = 0; $c < $matrixdata->{"Columns"}; $c++) {
$newmatrixdata->{"CD.$c.$targetrow"} = $matrixdata->{"CD.$c.$sourcerow"};
#delete $matrixdata->{"CD.$c.$sourcerow"};
}
$targetrow++;
}
# copy the temporary data back to the original hash
foreach my $element (keys %{$newmatrixdata}) {
$matrixdata->{$element} = $newmatrixdata->{$element};
}
}
sub matrixrowstatus {
my ($r, $status) = (@@_);
my $event = &matrixrow2event($r);
if (defined $status) {
$event->{status} = $status;
}
else {
&processeventfields($event, qw/status/);
$status = $event->{$status};
}
my $label = sprintf("%1s", $status);
$matrixdata->{"RH.$r"} = { "Label" => "$label" , "Labelhide" => 0, "Heightmin" => 1, "Heightmax" => 1, "Height" => 1, "Rowgap" => 0, "Rowhide" => 0 };
}
sub matrixrowset {
my ($r, $uuid, $label) = (@@_);
my $c;
&matrixrowstatus($r, "$label");
$c = $matrixdata->{"CK.uuid"};
$label = sprintf("%36s", $uuid);
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
$matrixwidget->{"VC.$vc.$vr"}->{-text} = $matrixdata->{"CD.$dc.$dr"}->{"Data"}; #view original data = read only
return 0;
}
};
$c = $matrixdata->{"CK.line"};
$label = sprintf("%4s", $events->{$uuid}->{line});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
$matrixwidget->{"VC.$vc.$vr"}->{-text} = $matrixdata->{"CD.$dc.$dr"}->{"Data"}; #view original data = read only
return 0;
}
};
$c = $matrixdata->{"CK.crc32"};
$label = sprintf("%8s", $events->{$uuid}->{crc32});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
$matrixwidget->{"VC.$vc.$vr"}->{-text} = $matrixdata->{"CD.$dc.$dr"}->{"Data"}; #view original data = read only
return 0;
}
};
$c = $matrixdata->{"CK.user"};
$label = sprintf("%s", $events->{$uuid}->{user});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
return 0;
}
};
$c = $matrixdata->{"CK.revision"};
$label = sprintf("%3d", $events->{$uuid}->{revision});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
$matrixwidget->{"VC.$vc.$vr"}->{-text} = $matrixdata->{"CD.$dc.$dr"}->{"Data"}; #view original data = read only
return 0;
}
};
$c = $matrixdata->{"CK.date"};
$label = sprintf("%s", $events->{$uuid}->{date});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
my $text = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
if ($text ne '') {
$text = &anydate2yyyymmdd($text);
}
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $text;
$matrixwidget->{"VC.$vc.$vr"}->{-text} = $text;
return 0;
}
};
$c = $matrixdata->{"CK.begin"};
$label = sprintf("%s", $events->{$uuid}->{begin});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
my $event = &matrixrow2event($dr);
my $text = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
$text = &anytime2hhmm($text) if ($text ne "");
$event->{begin} = $text;
&processeventfields($event, qw/amount end begin/);
my $redrawflag = 0;
foreach my $k (qw/begin end amount/) {
my $kdc = $matrixdata->{"CK.$k"};
if ($matrixdata->{"CD.$kdc.$dr"}->{"Data"} ne $event->{$k}) {
$matrixdata->{"CD.$kdc.$dr"}->{"Data"} = $event->{$k};
$redrawflag = 1;
}
}
if (not $redrawflag) {
$matrixwidget->{"VC.$vc.$vr"}->{-text} = $event->{begin};
}
return $redrawflag;
}
};
$c = $matrixdata->{"CK.end"};
$label = sprintf("%s", $events->{$uuid}->{end});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
my $event = &matrixrow2event($dr);
my $text = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
$text = &anytime2hhmm($text) if ($text ne "");
$event->{end} = $text;
&processeventfields($event, qw/amount end begin/);
my $redrawflag = 0;
foreach my $k (qw/begin end amount/) {
my $kdc = $matrixdata->{"CK.$k"};
if ($matrixdata->{"CD.$kdc.$dr"}->{"Data"} ne $event->{$k}) {
$matrixdata->{"CD.$kdc.$dr"}->{"Data"} = $event->{$k};
$redrawflag = 1;
}
}
if (not $redrawflag) {
$matrixwidget->{"VC.$vc.$vr"}->{-text} = $event->{end};
}
return $redrawflag;
}
};
$c = $matrixdata->{"CK.amount"};
$label = sprintf("%s", $events->{$uuid}->{amount});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
my $event = &matrixrow2event($dr);
my $text = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
$text = &anytime2hhmm($text) if ($text ne "");
$event->{amount} = $text;
&processeventfields($event, qw/amount end begin/);
my $redrawflag = 0;
foreach my $k (qw/begin end amount/) {
my $kdc = $matrixdata->{"CK.$k"};
if ($matrixdata->{"CD.$kdc.$dr"}->{"Data"} ne $event->{$k}) {
$matrixdata->{"CD.$kdc.$dr"}->{"Data"} = $event->{$k};
$redrawflag = 1;
}
}
if (not $redrawflag) {
$matrixwidget->{"VC.$vc.$vr"}->{-text} = $event->{amount};
}
return $redrawflag;
}
};
$c = $matrixdata->{"CK.account"};
$label = sprintf("%s", $events->{$uuid}->{account});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
my $text = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
my $accounts = &completeaccount($text);
if (@@{$accounts} == 1) {
$text = $accounts->[0];
$text = &dot2slash($text) if ($text =~ m/^\./);
}
$matrixwidget->{"VC.$vc.$vr"}->{-text} = $text;
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $text;
return 0;
}
};
$c = $matrixdata->{"CK.remark"};
$label = sprintf("%s", $events->{$uuid}->{remark});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
return 0;
}
};
$c = $matrixdata->{"CK.error"};
$label = sprintf("%s", $events->{$uuid}->{error});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
$matrixwidget->{"VC.$vc.$vr"}->{-text} = $matrixdata->{"CD.$dc.$dr"}->{"Data"}; #view original data = read only
return 0;
}
};
}
sub matrixappend {
my ($uuid, $label) = (@@_);
my $nextrow;
$nextrow = $matrixdata->{"Rows"};
$nextrow = 0 unless(defined $nextrow);
&matrixrowset($nextrow, $uuid, $label);
$nextrow++;
$matrixdata->{"Rows"} = $nextrow;
}
sub matrixinsertafter {
my ($insrow, $uuid, $label) = (@@_);
$insrow++;
return &matrixinsertrowat($insrow, $uuid, $label);
}
sub matrixinsertrowat {
my ($insrow, $uuid, $label) = (@@_);
my $nextrow;
my $lastrow;
$nextrow = $matrixdata->{"Rows"};
$lastrow = $nextrow - 1;
if ($insrow >= $nextrow) {
&matrixappend($uuid, $label);
}
else {
my $targetrow = $nextrow;
my $sourcerow = $lastrow;
while ($sourcerow >= $insrow) {
$matrixdata->{"RH.$targetrow"} = $matrixdata->{"RH.$sourcerow"};
for (my $c = 0; $c < $matrixdata->{"Columns"}; $c++) {
#printf "$targetrow.$c = $sourcerow.$c\n";
$matrixdata->{"CD.$c.$targetrow"} = $matrixdata->{"CD.$c.$sourcerow"};
}
$targetrow--;
$sourcerow--;
}
&matrixrowset($insrow, $uuid, $label);
$nextrow++;
$matrixdata->{"Rows"} = $nextrow;
}
}
#
# removes a row; returns 1 if the row was the trailer
#
sub matrixdeleterow {
my ($delrow) = (@@_);
my $nextrow;
my $lastrow;
$nextrow = $matrixdata->{"Rows"};
$lastrow = $nextrow - 1;
if ($delrow >= $lastrow) {
&matrixshrinkrow();
return 1;
}
else {
my $targetrow = $delrow;
my $sourcerow = $delrow + 1;
while ($sourcerow < $nextrow) {
$matrixdata->{"RH.$targetrow"} = $matrixdata->{"RH.$sourcerow"};
for (my $c = 0; $c < $matrixdata->{"Columns"}; $c++) {
#printf "$targetrow.$c = $sourcerow.$c\n";
$matrixdata->{"CD.$c.$targetrow"} = $matrixdata->{"CD.$c.$sourcerow"};
}
$targetrow++;
$sourcerow++;
}
&matrixshrinkrow();
return 0;
}
}
#
# shrinks the matrix by one row by removing the trailer
#
sub matrixshrinkrow {
my $nextrow;
my $lastrow;
$nextrow = $matrixdata->{"Rows"};
if ($nextrow > 0) {
$lastrow = $nextrow - 1;
delete $matrixdata->{"RH.$lastrow"};
for (my $c = 0; $c < $matrixdata->{"Columns"}; $c++) {
delete $matrixdata->{"CD.$c.$lastrow"};
}
}
$nextrow--;
$matrixdata->{"Rows"} = $nextrow;
}
#
# dump a event for debugging purposes
#
sub dumpevent {
my ($event, $prefix) = (@@_);
$prefix = "dumpevent($event)" unless (defined $prefix);
foreach my $k (keys %{$event}) {
printf STDERR "DEBUG: %s: %8s=%s\n", $prefix, $k, (defined $event->{$k}) ? $event->{$k} : "";
}
}
#
# 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 timespec 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
if ($f eq "timespec") {
($event->{begin}, $event->{end}, $event->{amount}) = &splittimespec($field);
}
else {
$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 timespec account remark/) {
my $fielddata;
if ($f eq "timespec") {
$fielddata = &formattimespec($event->{begin}, $event->{end}, $event->{amount});
}
else {
$fielddata = $event->{$f};
}
$ln .= " " if (defined $ln);
$ln .= "e($fielddata);
}
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";
}
my $timespec = &formattimespec($event->{begin}, $event->{end}, $event->{amount});
($begin, my $end, my $amount) = &splittimespec($timespec);
$event->{begin} = $begin;
}
elsif ($f eq "end") {
my $end = $event->{end};
if (&isvalidend($end)) {
delete $event->{annotation}->{end};
}
else {
$event->{annotation}->{end} = "invalid";
}
my $timespec = &formattimespec($event->{begin}, $event->{end}, $event->{amount});
(my $begin, $end, my $amount) = &splittimespec($timespec);
$event->{end} = $end;
}
elsif ($f eq "amount") {
my $amount = $event->{amount};
if (&isvalidamount($amount)) {
delete $event->{annotation}->{amount};
}
else {
$event->{annotation}->{amount} = "invalid";
}
my $timespec = &formattimespec($event->{begin}, $event->{end}, $event->{amount});
(my $begin, my $end, $amount) = &splittimespec($timespec);
$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.44
log
@Remove lots of debugging stuff.
@
text
@@
1.43
log
@cosmetic changes only
- replace tabs with spaces
- align blocks on four char boundaries
- make sure all functions are executed with & prefix
@
text
@a786 1
#&dumpevent($event, "calccrc32()");
a789 1
#printf STDERR "DEBUG: calccrc32() crc32=%08x, event->{%s}=\"%s\"\n", $crc32, $f, $field;
a791 1
#printf STDERR "DEBUG: calccrc32() crc32=%08x <-----\n", $crc32;
a1013 1
#printf STDERR "DEBUG: splittimespec(\"%s\")\n", $timespec;
a1017 1
#printf STDERR "DEBUG: into begin=\"%s\", end=\"%s\", amount=\"%s\"\n", $begin, $end, $amount;
a1018 1
#printf STDERR "DEBUG: amount missing\n";
a1023 1
#printf STDERR "DEBUG: end missing\n";
a1028 1
#printf STDERR "DEBUG: begin missing\n";
a1030 1
#printf STDERR "DEBUG: end=%s (%d), amount=%s (%d)\n", $end, &hhmm2sec($end), $amount, &hhmm2sec($amount);
a1057 1
#printf STDERR "DEBUG: minutes=%d, hour=%d, min=%d\n", $minutes, $hour, $min;
a1259 1
&dumpevent($event, "mlelstv");
a1350 1
#printf STDERR "DEBUG: move CD.$c.$sourcerow %s to CD.$c.$targetrow\n", $matrixdata->{"CD.$c.$sourcerow"};
a1358 1
#printf STDERR "DEBUG: copy back element=$element\n";
a1578 1
#printf STDERR "DEBUG: accounts=%s\n", @@{$accounts};
a1579 1
#printf STDERR "DEBUG: single hit %s\n", $accounts->[0];
a1582 1
#printf STDERR "DEBUG: account text is %s\n", $text;
a1900 1
#printf STDERR "DEBUG: timespec=\"%s\"\n", $timespec;
a1912 1
#printf STDERR "DEBUG: timespec=\"%s\"\n", $timespec;
a1924 1
#printf STDERR "DEBUG: timespec=\"%s\"\n", $timespec;
@
1.42
log
@lots of work to unify internal processing of cli and cui
properly distinguish naming between single event and all events
add &isvalid(user|uuid|crc32|revision|date|begin|end|amount|account|remark) check functions
&completeaccount now escapes special characters using quotemeta
&readevents rewritten to use new cli/cui-unified functions
"e used more consequently; does no longer escape dots; handels empty strings
&bydateline no longer compares (sorts) by "end"
&calccrc32 runs a loop but hardcoded fields; single event makes uuid no longer special
&cuinewevent properly supports fractional pasting with fallback to default for each key
Blurcallbacks rewritten to support single event
fixed name/column lookup problem providing and using Keyname and CK.Label lookups
status now kept in event and events; supported by &matrixrowstatus
error supports multiple annotations
&event2ln and &ln2event convert from single event to plain text lines
&getevent and &setevent convert from single event to events
&matrixrow2event converts a matrix row to single event
&matrix2events rewritten to use new cli/cui-unified functions
added &dumpevent for debugging
"onanewline" and "Onanewline" now prefills date
@
text
@d67 1
a67 1
# exception handling support
d191 1
a191 1
if (not isvalidaccount($account)) {
d195 1
a195 1
$account = dot2slash($account);
d211 1
a211 1
#
d217 1
a217 1
# echo 100; perl as.pl --complete time -- 00:11-
d219 1
a219 1
# echo 110; perl as.pl --complete time -- 00:11-11:22
d244 1
a244 1
d247 1
a247 1
# see also: GNU Bash 2.05b, bashline.c, line 208,
d359 1
a359 1
$account = dot2slash($account);
d382 1
a382 1
if (isvalidyyyymmdd($input)) {
d403 1
a403 1
if (isvalidhhmm($input)) {
d465 1
a465 1
d475 1
a475 1
my $quote = '"';
d478 3
a480 3
if ($remainder =~ m|^$quote|) {
($var, $remainder) = Text::Balanced::extract_delimited($remainder, $quote);
$var =~ s|^$quote(.*)$quote$|$1|;
d489 3
a491 3
if ($remainder =~ m|^$quote|) {
($val, $remainder) = Text::Balanced::extract_delimited($remainder, $quote);
$val =~ s|^$quote(.*)$quote$|$1|;
d525 1
a525 1
d535 1
a535 1
my $quote = '"';
d538 3
a540 3
if ($remainder =~ m|^$quote|) {
($type, $remainder) = Text::Balanced::extract_delimited($remainder, $quote);
$type =~ s|^$quote(.*)$quote$|$1|;
d552 3
a554 3
if ($remainder =~ m|^$quote|) {
($name, $remainder) = Text::Balanced::extract_delimited($remainder, $quote);
$name =~ s|^$quote(.*)$quote$|$1|;
d566 3
a568 3
if ($remainder =~ m|^$quote|) {
($desc, $remainder) = Text::Balanced::extract_delimited($remainder, $quote);
$desc =~ s|^$quote(.*)$quote$|$1|;
d582 1
a582 1
my $dname = slash2dot($sname);
d649 1
a649 1
d658 1
a658 1
d764 1
a764 1
my $quote = '"';
d768 3
a770 3
if ($remainder =~ m|^$quote|) {
($field, $remainder) = Text::Balanced::extract_delimited($remainder, $quote);
$field =~ s|^$quote(.*)$quote$|$1|;
d902 1
a902 1
closefile($io);
d908 1
a908 1
closefile($io);
d918 1
a918 1
closefile($io);
d939 1
a939 1
if (not isvalidhhmm($begin)) {
d943 1
a943 1
if (not isvalidhhmm($end)) {
d947 1
a947 1
if (not isvalidhhmm($amount)) {
d987 1
a987 1
setevent($events, $event);
d1150 1
a1150 1
if ($sc < $matrixdata->{"Columns"} and isvalidyyyymmdd($matrixdata->{"CD.$sc.$pred"}->{"Data"})) {
d1159 1
a1159 1
if ($sc < $matrixdata->{"Columns"} and isvalidhhmm($matrixdata->{"CD.$sc.$pred"}->{"Data"})) {
d1168 1
a1168 1
if ($sc < $matrixdata->{"Columns"} and isvalidhhmm($matrixdata->{"CD.$sc.$succ"}->{"Data"})) {
d1193 1
a1193 1
if ($sc < $matrixdata->{"Columns"} and isvalidyyyymmdd($matrixdata->{"CD.$sc.$pred"}->{"Data"})) {
d1202 1
a1202 1
if ($sc < $matrixdata->{"Columns"} and isvalidhhmm($matrixdata->{"CD.$sc.$pred"}->{"Data"})) {
d1211 1
a1211 1
if ($sc < $matrixdata->{"Columns"} and isvalidhhmm($matrixdata->{"CD.$sc.$succ"}->{"Data"})) {
d1230 1
a1230 1
return matrixdeleterow($dr);
d1319 1
a1319 1
matrixsort($dr);
d1378 1
a1378 1
my $event = matrixrow2event($r);
d1394 1
a1394 1
matrixrowstatus($r, "$label");
d1591 1
a1591 1
my $accounts = completeaccount($text);
d1647 1
a1647 1
return matrixinsertrowat($insrow, $uuid, $label);
d1757 1
a1757 1
my $event = {};
d1762 5
a1766 5
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;
}
d1774 2
a1775 2
# $ln - string representing event
# $line - line number for tracking
d1777 3
a1779 3
# OUTPUT
# undef - input was a empty or whitespace only line
# %event - all data fields; line number tracking and annotations added
d1783 6
a1788 1
my $event = {};
d1790 20
a1809 25
$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 timespec 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
if ($f eq "timespec") {
($event->{begin}, $event->{end}, $event->{amount}) = &splittimespec($field);
}
else {
$event->{$f} = $field;
}
}
return $event;
d1818 2
a1819 2
# OUTPUT
# $ln - string representing event; line number tracking and annotations lost
d1824 4
a1827 4
my $ln = undef;
foreach my $f (qw/user uuid crc32 revision date timespec account remark/) {
my $fielddata;
if ($f eq "timespec") {
d1834 3
a1836 3
$ln .= "e($fielddata);
}
return $ln;
d1840 1
a1840 1
# processevent
d1845 3
a1847 3
foreach my $f (@@fields) {
if ($f eq "status") {
my $status = $event->{status};
d1862 25
a1886 25
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);
d1889 27
a1915 27
}
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";
}
d1920 9
a1928 9
}
elsif ($f eq "end") {
my $end = $event->{end};
if (isvalidend($end)) {
delete $event->{annotation}->{end};
}
else {
$event->{annotation}->{end} = "invalid";
}
d1933 9
a1941 9
}
elsif ($f eq "amount") {
my $amount = $event->{amount};
if (isvalidamount($amount)) {
delete $event->{annotation}->{amount};
}
else {
$event->{annotation}->{amount} = "invalid";
}
d1946 26
a1971 26
}
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;
d1975 1
a1975 1
# transform the given annotations into a single string
d1980 6
a1985 6
my $string = "";
foreach my $f (sort keys %{$annotations}) {
$string .= " " if (defined $string);
$string .= sprintf("%s=%s;", $f, $annotations->{$f});
}
return $string;
d1989 1
a1989 1
# set single event into events hash, copying selected keys and their values
d1993 5
a1997 5
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};
}
d2001 1
a2001 1
# get single event from events hash, copying selected keys and their values
d2005 1
a2005 1
my $event = {};
d2007 4
a2010 4
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};
}
@
1.41
log
@delete/undo with unlimited history stack
@
text
@d177 1
a177 1
&event2matrix();
d179 1
a179 1
&matrix2event();
d282 1
a282 1
sub isvalidaccount {
d285 2
a286 4
foreach my $element (@@{$accounts}) {
if ($element->{type} eq "R" && $input =~ m|^$element->{name}$|) {
return 1;
}
d291 1
a291 1
sub isvalidhhmm {
d294 1
a294 1
if ($input =~ m/([01][0-9]|2[0-4]):[0-5][0-9](:[0-5][0-9])?$/) {
d300 55
a354 2
sub isvalidyyyymmdd {
my ($input) = @@_;
d356 7
a362 2
if ($input =~ m/^[2-9][0-9]{3}([0][1-9]|[1][0-2])([0][1-9]|[12][0-9]|[3][01])$/) {
return 1;
d364 1
d368 5
d380 1
a380 1
my $output = "";
a587 2
#foreach my $element (@@{$ac}) { printf "DEBUG: element=$element, type=$element->{type}, name=$element->{name}, desc=$element->{desc}\n"; } #FIXME DEBUG
d624 1
a654 11
$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 $quote = '"';
my $error = undef;
(my $user, $remainder) = &splitq($remainder);
if (not $user =~ m|^[a-zA-Z][a-zA-Z0-9]*$|) {
die "syntax error in $path, line $line: unexpected user \"$user\" found.\n";
}
d656 6
a661 7
(my $uuid, $remainder) = &splitq($remainder);
if ($uuid eq '.') {
$error .= "new UUID created upon request;";
$uuid = &newuuid();
}
elsif (not $uuid =~ m|^[0-9a-fA-F]{8}(-[0-9a-fA-F]{4}){3}-[0-9a-fA-F]{12}$|) {
die "syntax error in $path, line $line: unexpected uuid \"$uuid\" found.\n";
d664 1
a664 46
(my $crc32, $remainder) = &splitq($remainder);
if (not $crc32 =~ m|^[0-9a-fA-F]{1,8}$|) {
die "syntax error in $path, line $line: unexpected crc32 \"$crc32\" found.\n";
}
(my $revision, $remainder) = &splitq($remainder);
if (not $revision =~ m|^[0-9]{1,5}$|) {
die "syntax error in $path, line $line: unexpected revision \"$revision\" found.\n";
}
(my $date, $remainder) = &splitq($remainder);
$date = &anydate2yyyymmdd($date, $runtimecfg->{"date"});
if (not &isvalidyyyymmdd($date)) {
die "syntax error in $path, line $line: unexpected date \"$date\" found.\n";
}
(my $timespec, $remainder) = &splitq($remainder);
my ($begin, $end, $amount) = &splittimespec($timespec);
$begin = &anytime2hhmm($begin, $runtimecfg->{"time"});
$end = &anytime2hhmm($end, $runtimecfg->{"time"});
$amount = &anytime2hhmm($amount, $runtimecfg->{"time"});
if (not isvalidhhmm($begin)) {
die "syntax error in $path, line $line: unexpected begin \"$begin\" found.\n";
}
if (not isvalidhhmm($end)) {
die "syntax error in $path, line $line: unexpected end \"$end\" found.\n";
}
if (not isvalidhhmm($amount)) {
die "syntax error in $path, line $line: unexpected amount \"$amount\" found.\n";
}
(my $account, $remainder) = &splitq($remainder);
if ($account =~ m|^(\.[-a-zA-Z0-9]+)+$|) {
$account = dot2slash($account);
}
if (not $account =~ m|^(\/[-a-zA-Z0-9]+)+$|) {
die "syntax error in $path, line $line: unexpected account \"$account\" found.\n";
}
(my $remark, $remainder) = &splitq($remainder);
if (not $remainder eq "") {
die "syntax error in $path, line $line: unexpected remainder \"$remainder\" found.\n";
}
d666 1
d671 2
a672 6
if (not isvalidaccount($account)) {
$error .= "invalid account \"$account\";";
}
if (defined $error) {
print STDERR "WARNING: bad event in $path, line $line: $error\n";
d675 1
a675 13
%{$ev}->{$uuid} = {
line => $line,
user => $user,
crc32 => $crc32,
revision => $revision,
date => $date,
begin => $begin,
end => $end,
amount => $amount,
account => $account,
remark => $remark,
error => $error
};
a677 2
#foreach my $element (keys %{$ev}) { printf "DEBUG: element=$element, user=$ev->{$element}->{user}\n"; } #FIXME DEBUG
a689 1
my $crc32;
d693 3
a695 18
# cyclic redundancy check
$crc32 = sprintf("%08x", &calccrc32($uuid));
# create the output line
$ln =
"e(%{$events}->{$uuid}->{user}) . " " .
"e($uuid) . " " .
"e($crc32) . " " .
"e(%{$events}->{$uuid}->{revision}) . " " .
"e(%{$events}->{$uuid}->{date}) . " " .
"e(&formattimespec(
%{$events}->{$uuid}->{begin},
%{$events}->{$uuid}->{end},
%{$events}->{$uuid}->{amount})) . " " .
"e(%{$events}->{$uuid}->{account}) . " " .
"e(%{$events}->{$uuid}->{remark});
d716 3
a718 3
$q =~ s|^(\\ )+||; #remove escaped leading spaces
$q =~ s|(\\ )+$||; #remove escaped trailing spaces
$q =~ s|\\([:/=-])|\1|g; #do not escape colons, slashes, equal signs and dashes (list could be larger)
d720 1
a720 1
#do not escape spaces but if one or more spaces exist put quotes around the wholly string
d724 5
d733 1
a733 1
# sort by date/time with fallback to line number
a743 4
# by end time
if (%{$events}->{$a}->{end} != %{$events}->{$b}->{end}) {
return %{$events}->{$a}->{end} <=> %{$events}->{$b}->{end};
}
d784 1
a784 1
my ($uuid) = @@_;
d787 9
a795 11
$crc32 = crc32(%{$events}->{$uuid}->{user} , $crc32);
$crc32 = crc32($uuid , $crc32);
$crc32 = crc32(%{$events}->{$uuid}->{revision} , $crc32);
$crc32 = crc32(%{$events}->{$uuid}->{date} , $crc32);
$crc32 = crc32(%{$events}->{$uuid}->{begin} , $crc32);
$crc32 = crc32(%{$events}->{$uuid}->{end} , $crc32);
$crc32 = crc32(%{$events}->{$uuid}->{amount} , $crc32);
$crc32 = crc32(%{$events}->{$uuid}->{account} , $crc32);
$crc32 = crc32(%{$events}->{$uuid}->{remark} , $crc32);
return $crc32;
d969 1
a969 1
# create an new cui event
d973 13
a985 9
my $uuid;
# recover existing or create new uuid and fill new event with defaults
if (defined $paste and defined $paste->{"uuid"}) {
$uuid = $paste->{"uuid"};
delete $paste->{"uuid"};
}
else {
$uuid = &newuuid();
d987 2
a988 21
%{$events}->{$uuid} = {
"line" => "+",
"user" => $runtimecfg->{user},
"crc32" => undef,
"revision" => 0,
"date" => $runtimecfg->{date},
"begin" => "00:00",
"end" => "24:00",
"amount" => "08:00",
"account" => "",
"remark" => "",
"error" => undef
};
# for paste operation take over most data
if (defined $paste) {
foreach my $k (%{$paste}) {
$events->{$uuid}->{$k} = $paste->{$k};
}
}
return $uuid;
d1017 3
d1022 3
a1024 1
if (($begin ne '') && ($end ne '') && ($amount eq '')) {
d1030 1
d1036 1
d1039 1
d1067 1
d1102 1
a1102 1
sub event2matrix {
d1110 14
a1123 12
$matrixdata->{"CH.$c"} = { "Label" => "#" , "Labelhide" => 0, "Widthmin" => 1, "Widthmax" => 1, "Width" => 1, "Widthweight" => 0, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "uuid" , "Labelhide" => 0, "Widthmin" => 36, "Widthmax" => 36, "Width" => 36, "Widthweight" => 0, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "line" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 5, "Width" => 4, "Widthweight" => 0, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "user" , "Labelhide" => 0, "Widthmin" => 2, "Widthmax" => 8, "Width" => 8, "Widthweight" => 0, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "rev" , "Labelhide" => 0, "Widthmin" => 1, "Widthmax" => 5, "Width" => 5, "Widthweight" => 0, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "date" , "Labelhide" => 0, "Widthmin" => 8, "Widthmax" => 8, "Width" => 8, "Widthweight" => 0, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "begin" , "Labelhide" => 0, "Widthmin" => 5, "Widthmax" => 5, "Width" => 5, "Widthweight" => 0, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "end" , "Labelhide" => 0, "Widthmin" => 5, "Widthmax" => 5, "Width" => 5, "Widthweight" => 0, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "amnt." , "Labelhide" => 0, "Widthmin" => 5, "Widthmax" => 5, "Width" => 5, "Widthweight" => 0, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "account" , "Labelhide" => 0, "Widthmin" => 10, "Widthmax" => 44, "Width" => 22, "Widthweight" => 10, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "remark" , "Labelhide" => 0, "Widthmin" => 10, "Widthmax" => 44, "Width" => 22, "Widthweight" => 5, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "error" , "Labelhide" => 0, "Widthmin" => 10, "Widthmax" => 44, "Width" => 22, "Widthweight" => 1, "Colgap" => 1, "Colhide" => 0 }; $c++;
d1127 1
a1127 1
matrixrowstatus($r, "$r");
d1130 5
a1134 6
# | line had no error when it was read in and is still untouched
# E line had an error when it was read in and is still untouched
# M line was modified
# N line is new
# D line is marked for deletion
d1136 2
a1137 3
$label = (not defined $events->{$uuid}->{error}) ? "|" : "E";
$c = &matrixrowset($r, $uuid, $label);
$r++;
a1138 3
# fill in global matrix data information
$matrixdata->{"Columns"} = $c;
d1143 4
d1148 8
a1155 1
my $colsearch;
a1156 1
my $pred = $dr;
d1158 3
a1160 5
for ($colsearch = 0; $colsearch < $matrixdata->{"Columns"}; $colsearch++) { #FIXME name/position lookup problem
last if ($matrixdata->{"CH.$colsearch"}->{"Label"} =~ m/^(end)$/);
}
if ($colsearch < $matrixdata->{"Columns"} and isvalidhhmm($matrixdata->{"CD.$colsearch.$pred"}->{"Data"})) {
$begin = $matrixdata->{"CD.$colsearch.$pred"}->{"Data"};
a1165 1
my $succ = $dr + 1;
d1167 3
a1169 5
for ($colsearch = 0; $colsearch < $matrixdata->{"Columns"}; $colsearch++) { #FIXME name/position lookup problem
last if ($matrixdata->{"CH.$colsearch"}->{"Label"} =~ m/^(begin)$/);
}
if ($colsearch < $matrixdata->{"Columns"} and isvalidhhmm($matrixdata->{"CD.$colsearch.$succ"}->{"Data"})) {
$end = $matrixdata->{"CD.$colsearch.$succ"}->{"Data"};
d1176 1
d1181 2
a1182 2
my $uuid = &cuinewevent($paste);
&matrixinsertafter($dr, $uuid, "N");
d1186 1
d1188 11
a1198 1
my $colsearch;
a1199 1
my $pred = $dr - 1;
d1201 3
a1203 5
for ($colsearch = 0; $colsearch < $matrixdata->{"Columns"}; $colsearch++) { #FIXME name/position lookup problem
last if ($matrixdata->{"CH.$colsearch"}->{"Label"} =~ m/^(end)$/);
}
if ($colsearch < $matrixdata->{"Columns"} and isvalidhhmm($matrixdata->{"CD.$colsearch.$pred"}->{"Data"})) {
$begin = $matrixdata->{"CD.$colsearch.$pred"}->{"Data"};
a1208 1
my $succ = $dr;
d1210 3
a1212 5
for ($colsearch = 0; $colsearch < $matrixdata->{"Columns"}; $colsearch++) { #FIXME name/position lookup problem
last if ($matrixdata->{"CH.$colsearch"}->{"Label"} =~ m/^(begin)$/);
}
if ($colsearch < $matrixdata->{"Columns"} and isvalidhhmm($matrixdata->{"CD.$colsearch.$succ"}->{"Data"})) {
$end = $matrixdata->{"CD.$colsearch.$succ"}->{"Data"};
d1218 1
d1223 2
a1224 2
my $uuid = &cuinewevent($paste);
&matrixinsertrowat($dr, $uuid, "N");
d1228 2
a1229 14
push @@{$matrixdata->{"undobuffer"}}, { #FIXME name/position lookup problem
uuid => $matrixdata->{"CD.0.$dr"}->{"Data"},
line => $matrixdata->{"CD.1.$dr"}->{"Data"},
user => $matrixdata->{"CD.2.$dr"}->{"Data"},
rev => $matrixdata->{"CD.3.$dr"}->{"Data"},
date => $matrixdata->{"CD.4.$dr"}->{"Data"},
begin => $matrixdata->{"CD.5.$dr"}->{"Data"},
end => $matrixdata->{"CD.6.$dr"}->{"Data"},
amount => $matrixdata->{"CD.7.$dr"}->{"Data"},
account => $matrixdata->{"CD.8.$dr"}->{"Data"},
remark => $matrixdata->{"CD.9.$dr"}->{"Data"},
error => $matrixdata->{"CD.10.$dr"}->{"Data"}
};
#printf STDERR "DEBUG: undo buffer = %d\n", qw/@@{$matrixdata->{"undobuffer"}}/;
d1234 4
a1237 5
my $undo = pop @@{$matrixdata->{"undobuffer"}};
if (defined $undo) {
#foreach my $k (keys %{$undo}) { printf STDERR "DEBUG: paste clipboard %s => %s\n", $k, $undo->{$k}; }
my $uuid = &cuinewevent($undo);
&matrixinsertrowat($dr, $uuid, "U");
d1244 1
a1244 1
return completeaccount($pattern);
a1247 1
#printf STDERR "DEBUG: date text=%s\n", $text;
a1251 1
#printf STDERR "DEBUG: time text=%s\n", $text;
d1257 1
a1257 1
matrixrowstatus($matrixdata->{"yankrow"}, " "); #FIXME we need status recovery or recalulation here
d1262 1
a1262 1
matrixrowstatus($dr, "y");
d1267 6
a1272 1
matrixrowstatus($matrixdata->{"yankrow"}, " "); #FIXME we need status recovery or recalulation here
d1274 1
a1274 9
$matrixdata->{"clipboard"} = { #FIXME name/position lookup problem
user => $matrixdata->{"CD.2.$dr"}->{"Data"},
date => $matrixdata->{"CD.4.$dr"}->{"Data"},
begin => $matrixdata->{"CD.5.$dr"}->{"Data"},
end => $matrixdata->{"CD.6.$dr"}->{"Data"},
amount => $matrixdata->{"CD.7.$dr"}->{"Data"},
account => $matrixdata->{"CD.8.$dr"}->{"Data"},
remark => $matrixdata->{"CD.9.$dr"}->{"Data"}
};
a1275 1
#foreach my $k (keys %{$matrixdata->{"clipboard"}}) { printf STDERR "DEBUG: yank clipboard %s => %s\n", $k, $matrixdata->{"clipboard"}->{$k}; }
d1277 1
a1277 1
matrixrowstatus($dr, "Y");
d1286 2
a1287 3
#foreach my $k (keys %{$matrixdata->{"clipboard"}}) { printf STDERR "DEBUG: paste clipboard %s => %s\n", $k, $matrixdata->{"clipboard"}->{$k}; }
my $uuid = &cuinewevent($matrixdata->{"clipboard"});
&matrixinsertafter($dr, $uuid, "N");
d1295 2
a1296 2
my $uuid = &cuinewevent($matrixdata->{"clipboard"});
&matrixinsertrowat($dr, $uuid, "N");
d1303 1
a1303 1
my $datacollabel = $matrixdata->{"CH.$dc"}->{"Label"}; #FIXME name/position lookup problem
d1305 1
a1305 1
if ($datacollabel =~ m/^(date)$/) {
d1308 1
a1308 1
elsif ($datacollabel =~ m/^(begin|end|amnt\.)$/) {
d1377 10
a1386 1
my ($r, $label) = (@@_);
d1393 1
a1393 1
$c = -1;
d1396 1
a1396 1
$c++;
d1409 2
a1410 1
$c++;
d1423 16
a1438 1
$c++;
d1451 2
a1452 1
$c++;
d1465 2
a1466 1
$c++;
a1475 1
#printf STDERR "DEBUG: vorher text=\"%s\"\n", $text;
a1480 1
#printf STDERR "DEBUG: nachher text=\"%s\"\n", $text;
d1484 2
a1485 1
$c++;
d1494 1
d1496 15
a1510 2
if ($text ne '') {
$text = &anytime2hhmm($text);
a1511 2
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $text;
$matrixwidget->{"VC.$vc.$vr"}->{-text} = $text;
d1513 1
a1513 13
my $bc=$dc; #FIXME name/position lookup problem
my $ec=$bc + 1;
my $ac=$ec + 1;
my ($begin, $end, $amount) = &splittimespec(&formattimespec(
$matrixdata->{"CD.$bc.$dr"}->{"Data"},
$matrixdata->{"CD.$ec.$dr"}->{"Data"},
$matrixdata->{"CD.$ac.$dr"}->{"Data"}
));
#printf STDERR "DEBUG1=$begin-$end=$amount\n",
$matrixdata->{"CD.$bc.$dr"}->{"Data"} = $begin;
$matrixdata->{"CD.$ec.$dr"}->{"Data"} = $end;
$matrixdata->{"CD.$ac.$dr"}->{"Data"} = $amount;
return 1;
d1516 2
a1517 1
$c++;
d1526 1
d1528 15
a1542 2
if ($text ne '') {
$text = &anytime2hhmm($text);
a1543 2
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $text;
$matrixwidget->{"VC.$vc.$vr"}->{-text} = $text;
d1545 1
a1545 13
my $bc=$dc - 1; #FIXME name/position lookup problem
my $ec=$bc + 1;
my $ac=$ec + 1;
my ($begin, $end, $amount) = &splittimespec(&formattimespec(
$matrixdata->{"CD.$bc.$dr"}->{"Data"},
$matrixdata->{"CD.$ec.$dr"}->{"Data"},
$matrixdata->{"CD.$ac.$dr"}->{"Data"}
));
#printf STDERR "DEBUG2=$begin-$end=$amount\n",
$matrixdata->{"CD.$bc.$dr"}->{"Data"} = $begin;
$matrixdata->{"CD.$ec.$dr"}->{"Data"} = $end;
$matrixdata->{"CD.$ac.$dr"}->{"Data"} = $amount;
return 1;
d1548 2
a1549 1
$c++;
d1558 1
d1560 15
a1574 2
if ($text ne '') {
$text = &anytime2hhmm($text);
a1575 2
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $text;
$matrixwidget->{"VC.$vc.$vr"}->{-text} = $text;
d1577 1
a1577 13
my $bc=$dc - 2; #FIXME name/position lookup problem
my $ec=$bc + 1;
my $ac=$ec + 1;
my ($begin, $end, $amount) = &splittimespec(&formattimespec(
$matrixdata->{"CD.$bc.$dr"}->{"Data"},
$matrixdata->{"CD.$ec.$dr"}->{"Data"},
$matrixdata->{"CD.$ac.$dr"}->{"Data"}
));
#printf STDERR "DEBUG3=$begin-$end=$amount\n",
$matrixdata->{"CD.$bc.$dr"}->{"Data"} = $begin;
$matrixdata->{"CD.$ec.$dr"}->{"Data"} = $end;
$matrixdata->{"CD.$ac.$dr"}->{"Data"} = $amount;
return 1;
d1580 2
a1581 1
$c++;
d1590 1
a1590 1
my $text = quotemeta($matrixwidget->{"VC.$vc.$vr"}->{-text}); #pull view data into real data
d1604 2
a1605 1
$c++;
d1618 2
a1619 1
$c++;
a1631 2
$c++;
return $c;
d1708 1
a1708 1
# shrinks the matrix by one row my removing the trailer
d1726 11
d1739 1
a1739 2
sub matrix2event {
d1743 1
d1747 2
a1748 12
$c = 0;
$uuid = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{line} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{user} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{revision} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{date} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{begin} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{end} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{amount} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{account} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{remark} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{error} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
d1750 262
@
1.40
log
@handling case where no entries currently exist moved from main to matrixwidget
fixed bug where yank a line does only work on entries that were read in not newly created ones
support for row deletion through matrixdeleterow()
support for shrinking matrix by one row through matrixshrinkrow()
improve initial screen drawing by calling draw method on wholly cui object
d deletes the line visibly, no more mark for deletion
@
text
@d1005 8
a1012 2
# create new uuid and fill new event with defaults
$uuid = &newuuid();
a1029 1
next if ($k =~ m/^(line|crc32|revision|error)$/);
d1255 14
d1270 11
@
1.39
log
@die() handler with log to a file and popup
@
text
@a1170 7
# handle case where no entries currently exist, i.e. reading new/empty events file
if ($r == 0) {
my $uuid = &cuinewevent();
&matrixappend($uuid, "N");
$r++;
}
d1250 1
a1250 1
matrixrowstatus($dr, "D");
d1281 9
a1289 2
my $uuid = $matrixdata->{"CD.0.$dr"}->{"Data"}; #FIXME name/position lookup problem
$matrixdata->{"clipboard"} = { %{$events->{"$uuid"}}};
d1291 1
d1302 1
d1666 48
d1724 12
a1735 14
if ($matrixdata->{"RH.$r"}->{"Label"} ne "D") {
$c = 0;
$uuid = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{line} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{user} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{revision} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{date} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{begin} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{end} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{amount} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{account} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{remark} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{error} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
}
@
1.38
log
@useful prefill of begin/end when [oO]nanewline
@
text
@d71 2
a72 1
print STDERR "$progname:ERROR: $err ". ($! ? "($!)" : "") . "\n";
a176 7
# in CUI mode we do not want STDERR to clutter our screen.
if ($opt_verbose) {
open STDERR, ">>2.log";
}
else {
open STDERR, ">/dev/null";
}
@
1.37
log
@convert accounts DOT to SLASH immediately after selection
@
text
@d1190 33
a1222 1
my $uuid = &cuinewevent();
d1227 32
a1258 1
my $uuid = &cuinewevent();
@
1.36
log
@align date/time syntax checking and completion between readevents() and CUI
syntax checking now uses svalidyyyymmdd() and isvalidhhmm()
completion now uses anydate2yyyymmdd() and anytimetohhmm()
add time calculation when one of begin/end/amount is missing
handle preseletable current "dot" time in day() and now()
use user supplyable current date/time in readevents()
remove outdated createsamplematrixdata()
ignore missing blur callbacks (can't handle error, so don't check for it)
wipe out some debug code
handle KEY_ENTER when entering a edit mode and when leaving edit mode
control focus/ cursor movement when leaving edit mode
remove obsolete CDK research nicedate(), nicetime(), today(), now()
two points off 00TODO
@
text
@d566 14
d1204 1
a1204 7
my $acs = [];
foreach my $ac (@@{$accounts}) {
if ($ac->{name} =~ m|^$pattern|) {
push @@{$acs}, $ac->{name};
}
}
return $acs;
d1519 11
a1529 1
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
@
1.35
log
@yank cell, Yank line, paste cell or paste/Paste line
@
text
@d59 1
a59 3
(my $sec, my $min, my $hour, my $mday, my $mon, my $year, my $wday, my $yday, my $isdst) = localtime(time);
my $yyyymmdd = sprintf "%04s%02s%02s", $year+1900, $mon+1, $mday;
my $hhmm = sprintf "%02s:%02s", $hour, $min;
d111 2
a112 2
if (not defined($runtimecfg->{user})) {
$runtimecfg->{user} = $ENV{LOGNAME};
d114 2
a115 2
if (not defined($runtimecfg->{date})) {
$runtimecfg->{date} = $yyyymmdd;
d117 5
a121 2
if (not defined($runtimecfg->{hist})) {
$runtimecfg->{hist} = 99;
d125 1
a125 1
if (not $runtimecfg->{user} =~ m/^[a-z0-9]+$/) {
d128 1
a128 2
if (not $runtimecfg->{date} =~ m/^[2-9][0-9]{3}([0][1-9]|[1][0-2])([0][1-9]|[12][0-9]|[3][01]$)/) {
d131 3
d299 1
a299 1
sub is24hclocktime {
d308 16
a323 2
sub anytimetohhmm {
my ($input, $now) = (@@_);
d326 20
a345 1
$now = $hhmm unless(defined $now);
d347 1
a347 2
if (is24hclocktime($input)) {
# 24h-clock-time
d351 1
a351 2
# dot
$output = $now;
a352 4
#elsif ($input =~ m|^\.\.$|) {
# # dotdot
# $output = "LAST"; #FIXME
#}
a390 1
d393 1
d533 1
a533 1
#foreach my $element (@@{$ac}) { print "DEBUG: element=$element, type=$element->{type}, name=$element->{name}, desc=$element->{desc}\n"; } #FIXME DEBUG
d618 2
a619 1
if (not $date =~ m/^[2-9][0-9]{3}([0][1-9]|[1][0-2])([0][1-9]|[12][0-9]|[3][01])$/) {
d625 3
d629 1
a629 1
if (not is24hclocktime($begin)) {
d633 1
a633 1
if (not is24hclocktime($end)) {
d637 1
a637 1
if (not is24hclocktime($amount)) {
d682 1
a682 1
#foreach my $element (keys %{$ev}) { print "DEBUG: element=$element, user=$ev->{$element}->{user}\n"; } #FIXME DEBUG
a695 1
my $timespec;
a702 4
$timespec = %{$events}->{$uuid}->{begin} . "-" .
%{$events}->{$uuid}->{end} . "=" .
%{$events}->{$uuid}->{amount};
d710 4
a713 1
"e($timespec) . " " .
d724 8
d961 1
a961 1
if (not is24hclocktime($begin)) {
d965 1
a965 1
if (not is24hclocktime($end)) {
d969 1
a969 1
if (not is24hclocktime($amount)) {
d1052 2
a1053 2
$begin = &anytimetohhmm($begin);
$end = &anytimetohhmm($end);
d1057 2
a1058 2
$begin = &anytimetohhmm($begin);
$amount = &anytimetohhmm($amount);
d1062 2
a1063 2
$end = &anytimetohhmm($end);
$amount = &anytimetohhmm($amount);
d1070 3
a1072 3
$begin = &anytimetohhmm($begin);
$end = &anytimetohhmm($end);
$amount = &anytimetohhmm($amount);
d1095 20
d1198 5
d1205 2
a1206 1
return &anytimetohhmm($text);
d1251 16
d1338 1
d1340 1
a1340 1
"Data" => "$uuid",
d1347 1
d1360 1
d1373 1
d1386 1
d1398 9
a1406 1
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
d1418 20
a1437 1
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
d1449 20
a1468 1
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
d1480 20
a1499 1
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text}; #pull view data into real data
d1512 1
d1525 1
d1538 1
@
1.34
log
@be more forgiving and provide more features on timespec syntax
@
text
@d955 1
a955 1
my ($uuid, $line, $user, $crc32, $revision, $date, $begin, $end, $amount, $account, $remark, $error);
d957 17
d975 4
a978 27
my $c = 0;
$uuid = &newuuid(); $c++; #"uuid"
$line = "cui"; $c++; #"line"
$user = $runtimecfg->{user}; $matrixdata->{"CD.$c.$paste"}->{"Data"}; $c++; #"user"
$crc32 = undef;
$revision = 0; $c++; #"revision"
$date = $matrixdata->{"CD.$c.$paste"}->{"Data"}; $c++; #"date"
$begin = $matrixdata->{"CD.$c.$paste"}->{"Data"}; $c++; #"begin"
$end = $matrixdata->{"CD.$c.$paste"}->{"Data"}; $c++; #"end"
$amount = $matrixdata->{"CD.$c.$paste"}->{"Data"}; $c++; #"amnt."
$account = $matrixdata->{"CD.$c.$paste"}->{"Data"}; $c++; #"account"
$remark = $matrixdata->{"CD.$c.$paste"}->{"Data"}; $c++; #"remark"
$error = undef;
}
else {
$uuid = &newuuid();
$line = "cui";
$user = $runtimecfg->{user};
$crc32 = undef;
$revision = 0;
$date = $runtimecfg->{date};
$begin = "00:00";
$end = "24:00";
$amount = "08:00";
$account = "";
$remark = "";
$error = undef;
a979 15
# 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 => $error
};
d1142 11
a1152 1
$matrixdata->{"yank"} = sub {
d1154 2
a1155 2
if (defined $matrixdata->{"Yank"}) {
matrixrowstatus($matrixdata->{"Yank"}, "|"); #FIXME we need status recovery or recalulation here
d1157 4
a1160 1
$matrixdata->{"Yank"} = $dr;
d1165 6
a1170 2
if (defined $matrixdata->{"Yank"}) {
my $uuid = &cuinewevent($matrixdata->{"Yank"});
d1178 2
a1179 3
my $uuid = &cuinewevent($matrixdata->{"Yank"});
if (defined $matrixdata->{"Yank"}) {
my $uuid = &cuinewevent($matrixdata->{"Yank"});
@
1.33
log
@be more forgiving on CRC32 syntax
@
text
@d894 6
a899 1
print $io "#user 12345678-9abc-def0-1234-56789abcdef0 01234567 00001 20021204 00:00-24:00=08:00 /example/account \"example entry\" #comment\n";
d1022 7
a1028 3
my $begin = '00:00';
my $end = '24:00';
my $amount = '';
d1032 15
d1049 1
a1049 1
$amount = "FIXME" if ($amount eq '');
d1051 14
a1064 3
$begin = anytimetohhmm($begin);
$end = anytimetohhmm($end);
$amount = anytimetohhmm($amount);
d1066 8
a1073 1
return $begin, $end, $amount;
@
1.32
log
@calculate optimal column width and cursor movement based on screen size
@
text
@d578 1
a578 1
if (not $crc32 =~ m|^[0-9a-fA-F]{8}$|) {
@
1.31
log
@allow multiple warnings per event; better quoting and uuid generation for manual events file edit;
@
text
@d1052 12
a1063 12
$matrixdata->{"CH.$c"} = { "Label" => "#" , "Labelhide" => 0, "Widthmin" => 1, "Widthmax" => 1, "Width" => 1, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "uuid" , "Labelhide" => 0, "Widthmin" => 36, "Widthmax" => 36, "Width" => 36, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "line" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 5, "Width" => 4, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "user" , "Labelhide" => 0, "Widthmin" => 2, "Widthmax" => 8, "Width" => 8, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "rev" , "Labelhide" => 0, "Widthmin" => 1, "Widthmax" => 5, "Width" => 5, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "date" , "Labelhide" => 0, "Widthmin" => 8, "Widthmax" => 8, "Width" => 8, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "begin" , "Labelhide" => 0, "Widthmin" => 5, "Widthmax" => 5, "Width" => 5, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "end" , "Labelhide" => 0, "Widthmin" => 5, "Widthmax" => 5, "Width" => 5, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "amnt." , "Labelhide" => 0, "Widthmin" => 5, "Widthmax" => 5, "Width" => 5, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "account" , "Labelhide" => 0, "Widthmin" => 10, "Widthmax" => 44, "Width" => 22, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "remark" , "Labelhide" => 0, "Widthmin" => 10, "Widthmax" => 44, "Width" => 22, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "error" , "Labelhide" => 0, "Widthmin" => 10, "Widthmax" => 44, "Width" => 22, "Colgap" => 1, "Colhide" => 0 }; $c++;
@
1.30
log
@improve setup phase and handle case where no entries currently exist
@
text
@d561 1
a561 1
my $error;
d569 5
a573 1
if (not $uuid =~ m|^[0-9a-fA-F]{8}(-[0-9a-fA-F]{4}){3}-[0-9a-fA-F]{12}$|) {
d625 1
a625 2
$error = "bad event in $path, line $line: invalid account \"$account\"";
print STDERR "WARNING: $error\n";
d627 3
a629 2
else {
$error = undef;
d662 1
a662 1
my $remark;
a666 5
# quoting the remark but don't quote spaces
$remark = quotemeta %{$events}->{$uuid}->{remark};
$remark =~ s|\\ | |g;
$remark = "\"" . $remark . "\"";
d670 4
d676 8
a683 10
%{$events}->{$uuid}->{user} . " " .
$uuid . " " .
$crc32 . " " .
%{$events}->{$uuid}->{revision} . " " .
%{$events}->{$uuid}->{date} . " " .
%{$events}->{$uuid}->{begin} . "-" .
%{$events}->{$uuid}->{end} . "=" .
%{$events}->{$uuid}->{amount} . " " .
%{$events}->{$uuid}->{account} . " " .
$remark;
d689 17
@
1.29
log
@added tab completion for time fields importing code from CDK research
@
text
@d784 1
a784 1
die "unable to open file \"$path\" for reading";
d870 2
a871 5
print $io "R /demo/foo \"Foo is first\"\n"; #FIXME
print $io "A /demo/bar \"Bar is second\"\n";
print $io "R /demo/bar/1 \"Bar sub One\"\n";
print $io "R /demo/bar/2 \"Bar sub Two\"\n";
print $io "R /quus/bar/2 \"Another Two\"\n";
d876 1
a876 5
print $io "thl f81d4fae-7dec-11d0-a765-00a0c91e6bf6 a89b389c 00042 20021001 00:00-24:00=03:00 /sample-org/dep/vacation \"important recreation\" #ERROR: ...\n";
print $io "thl f81d4fae-7dec-11d0-a765-00a0391e6bf6 a89b389c 00042 20021001 00:00-24:00=03:00 /sample-org/dep/vacation \"important recreation\" #ERROR: ...\n";
print $io "ps f81d4fae-7dec-11d0-a765-00a0c81e6bf6 a79b389c 00042 20021001 00:00-24:00=03:00 /sample-org/dep/vacation \"important recreation\" #ERROR: ...\n";
print $io "rse f81d4fae-7dec-11d0-a765-00a8c91e6bf6 a87b389c 00042 20021001 00:00-24:00=03:00 /sample-org/dep/vacation \"important recreation\" #ERROR: ...\n";
print $io "rse f81d4fae-7dec-11d0-a765-01a0c81e6bf6 a89b389c 00042 20021001 00:00-24:00=03:00 /sample-org/dep/vacation \"important recreation\" #ERROR: ...\n";
d1050 1
d1064 7
d1339 1
@
1.28
log
@added tab completion/list box for accounts
@
text
@d306 1
a306 1
my ($input) = @@_;
d309 2
d317 1
a317 5
$output = $hhmm;
}
elsif ($input =~ m|^\.\.$|) {
# dotdot
$output = "LAST"; #FIXME
d319 4
d1090 1
a1090 2
my $accountingers = [];
#printf STDERR "DEBUG: pattern=$pattern\n"; die;
d1093 1
a1093 2
push @@{$accountingers}, $ac->{name};
#printf STDERR "DEBUG: ac->{name}=$ac->{name}\n";
d1096 5
a1100 2
#foreach my $i (@@{$accountingers}) { printf STDERR "DEBUG: i=$i\n" };
return $accountingers;
@
1.27
log
@add yank/paste/Paste support
@
text
@d1086 13
@
1.26
log
@start with a sorted layout
@
text
@d936 2
a937 1
my ($timespec, $account, $remark) = @@_;
d939 29
a967 10
# preset
my $uuid = &newuuid();
my $line = "cui";
my $user = $runtimecfg->{user};
my $crc32 = undef;
my $revision = 0;
my $date = $runtimecfg->{date};
my $begin = "00:00";
my $end = "24:00";
my $amount = "08:00";
d981 1
a981 1
error => undef
d1085 27
@
1.25
log
@support for F7 column show/hide and F8 column sort with primitive dialog
@
text
@d1072 1
a1072 1
#&matrixsort();
@
1.24
log
@F1 help; F9-F12 column resizing
@
text
@d1043 3
a1045 3
$label = (not defined $events->{$uuid}->{error}) ? "|" : "E";
$c = &matrixrowset($r, $uuid, $label);
$r++;
d1049 2
a1050 2
$matrixdata->{"Columns"} = $c;
$matrixdata->{"Rows"} = $r;
d1066 57
@
1.23
log
@support for F5, mark for deletion; show status info for each line
@
text
@d1019 12
a1030 12
$matrixdata->{"CH.$c"} = { "Label" => "#" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 1, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "uuid" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 36, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "line" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 4, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "user" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 8, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "rev" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 5, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "date" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 8, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "begin" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 5, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "end" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 5, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "amnt." , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 5, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "account" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 45, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "remark" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 36, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "error" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 36, "Colgap" => 1, "Colhide" => 0 }; $c++;
@
1.22
log
@support for F3/F4; work like vi-o/On a new line
@
text
@d206 1
d559 1
d619 5
a623 1
print STDERR "WARNING: bad event in $path, line $line: invalid account \"$account\"\n";
d627 12
a638 5
line=>$line,
user=>$user, crc32=>$crc32, revision=>$revision,
date=>$date, begin=>$begin, end=>$end, amount=>$amount,
account=>$account, remark=>$remark
};
d892 2
a893 1
my $line = "commandline";
a894 1
my $uuid = undef;
a915 1
$uuid = &newuuid();
d917 31
a947 11
line =>$line,
user =>$user,
crc32 =>$crc32,
revision =>$revision,
date =>$date,
begin =>$begin,
end =>$end,
amount =>$amount,
account =>$account,
remark =>$remark
};
d949 15
a963 1
&writeevents();
d1019 1
a1019 1
$matrixdata->{"CH.$c"} = { "Label" => "FIXME" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 4, "Colgap" => 1, "Colhide" => 0 }; $c++;
d1021 3
a1023 2
$matrixdata->{"CH.$c"} = { "Label" => "user" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 9, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "rev" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 3, "Colgap" => 1, "Colhide" => 0 }; $c++;
d1028 3
a1030 2
$matrixdata->{"CH.$c"} = { "Label" => "account" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 43, "Colgap" => 1, "Colhide" => 0 }; $c++;
$matrixdata->{"CH.$c"} = { "Label" => "remark" , "Labelhide" => 0, "Widthmin" => 3, "Widthmax" => 99, "Width" => 70, "Colgap" => 1, "Colhide" => 0 }; $c++;
d1034 1
a1034 1
$matrixdata->{"RH.$r"} = { "Label" => "$r" , "Labelhide" => 0, "Heightmin" => 1, "Heightmax" => 1, "Height" => 1, "Rowgap" => 0, "Rowhide" => 0 }; $r++;
d1036 6
d1043 1
a1043 2
#$label = sprintf("% 3s.", $events->{$uuid}->{line});
$label = sprintf("% 3s.", $r);
d1054 3
a1056 18
# create new uuid and store new event in memory
my $uuid = &newuuid();
%{$events}->{$uuid} = {
line => "+",
user => "thl",
crc32 => "crc",
revision => 3,
date => "12345678",
begin => "00:01",
end => "23:59",
amount => "01:23",
account => "/foo",
remark => "important"
};
&matrixinsertafter($dr, $uuid, "++");
};
d1059 8
d1068 3
a1070 16
# create new uuid and store new event in memory
my $uuid = &newuuid();
%{$events}->{$uuid} = {
line => "+",
user => "thl",
crc32 => "crc",
revision => 3,
date => "12345678",
begin => "00:01",
end => "23:59",
amount => "01:23",
account => "/foo",
remark => "important"
};
&matrixinsertrowat($dr, $uuid, "++");
};
d1077 1
a1077 1
$matrixdata->{"RH.$r"} = { "Label" => "$label" , "Labelhide" => 0, "Heightmin" => 1, "Heightmax" => 1, "Height" => 1, "Rowgap" => 0, "Rowhide" => 0 };
a1083 1
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
d1087 13
a1099 2
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
#$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
a1107 1
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
d1111 1
a1111 2
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
#$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
a1119 1
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
d1123 1
a1123 2
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
#$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
a1131 1
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
d1135 1
a1135 2
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
a1143 1
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
d1147 1
a1147 2
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
a1155 1
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
d1159 1
a1159 2
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
a1167 1
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
d1171 1
a1171 2
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
a1179 1
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
d1183 1
a1183 2
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
#$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
a1191 1
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
d1195 13
a1207 2
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
#$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
d1267 14
a1280 10
$c = 0;
$uuid = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{user} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{revision} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{date} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{begin} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{end} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{amount} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{account} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
$events->{$uuid}->{remark} = $matrixdata->{"CD.$c.$r"}->{"Data"}; $c++;
@
1.21
log
@cui matrix editor
@
text
@d902 22
a923 1
# create uuid and check for uniqness in local database
d930 1
a930 11
# 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
};
&writeevents();
return;
d989 3
a991 130
$c = -1;
$label = sprintf("%4d", $r);
$matrixdata->{"RH.$r"} = { "Label" => "$label" , "Labelhide" => 0, "Heightmin" => 1, "Heightmax" => 1, "Height" => 1, "Rowgap" => 0, "Rowhide" => 0 };
$c++;
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$uuid",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
#$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
}
};
$c++;
$label = sprintf("%s", $events->{$uuid}->{user});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
#$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
}
};
$c++;
$label = sprintf("%3d", $events->{$uuid}->{revision});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
#$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
}
};
$c++;
$label = sprintf("%s", $events->{$uuid}->{date});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
}
};
$c++;
$label = sprintf("%s", $events->{$uuid}->{begin});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
}
};
$c++;
$label = sprintf("%s", $events->{$uuid}->{end});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
}
};
$c++;
$label = sprintf("%s", $events->{$uuid}->{amount});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
}
};
$c++;
$label = sprintf("%s", $events->{$uuid}->{account});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
#$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
}
};
$c++;
$label = sprintf("%s", $events->{$uuid}->{remark});
$matrixdata->{"CD.$c.$r"} = {
"Data" => "$label",
"Focuscallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Focuscallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
},
"Blurcallback" => sub {
my ($matrixwidget, $dc, $dr, $vc, $vr) = (@@_);
#print STDERR "DEBUG: CD-Blurcallback got vc/vr=$vc/$vr, dc/dr=$dc/$dr\n";
#$matrixdata->{"CD.$dc.$dr"}->{"Data"} = $matrixwidget->{"VC.$vc.$vr"}->{-text};
}
};
$c++;
d998 217
@
1.20
log
@remove copy/paste error; add more sanity checks
@
text
@d37 1
d67 1
d172 13
d188 1
a188 1
die "timespec missing";
d192 1
a192 1
die "account missing";
d195 1
a195 1
die "invalid account \"$account\"";
d205 1
a205 1
do_newevent($timespec, $account, $remark);
d949 189
@
1.19
log
@short-circuit dispatch
@
text
@d576 1
a576 1
if (not is24hclocktime($begin)) {
d580 1
a580 1
if (not is24hclocktime($begin)) {
d873 13
@
1.18
log
@sanity checks
@
text
@d60 1
a60 1
my $hhmm = sprintf "%02s%02s", $hour, $min;
d133 6
d143 1
a143 4
if ($opt_complete ne "") {
&do_complete($ARGV[0]);
}
elsif ($opt_setup) {
@
1.17
log
@implement time syntaxes and align with manual
@
text
@d169 3
d173 6
d266 11
d283 1
a283 1
return 0
d596 4
@
1.16
log
@flush our first cut for Bash bashing
@
text
@d60 1
a198 1
my @@reply = ();
a200 1
# completion of account argument
d205 6
a210 4
my $pattern = quotemeta($arg);
foreach my $ac (@@{$accounts}) {
if ($ac->{name} =~ m|^$pattern|) {
push(@@reply, $ac->{name});
d212 1
d216 35
a250 2
my ($begin, $end, $amount) = &splittimespec($arg, 1);
push(@@reply, $begin . "-" . $end . "=" . $amount);
d255 9
a263 1
print join("\n", @@reply)."\n";
d267 1
a267 1
my ($input, $bashme) = @@_;
d270 2
a271 3
# completion of time argument
if ($input =~ m/([0-9]|[01][0-9]|2[0-4]):[0-9]|[0-5][0-9](:[0-9]|[0-5][0-9])?$/) {
# given notation is already in 24h-clock-time notation
d275 2
a276 2
# now
$output = "NOW"; #FIXME
d279 1
a279 1
# end of last entry
d282 10
a291 2
elsif ($input =~ m|^(\d*\.\d*)$|) {
# hours in decimal fractional notation
d296 1
a296 1
$output = sprintf("%d:%02d", $h, $m);
d298 2
a299 2
elsif ($input =~ m|^(\d*\/[1-9]\d*)$|) {
# hours in standard fractional notation
d305 1
a305 1
$output = sprintf("%d:%02d", $h, $m);
d307 12
a318 63
elsif ($input =~ m|^0(\d)$|) {
# special case for entering minute notation with leading zero
$output = "0:0$1";
}
elsif ($input =~ m|^0(:0?)?$|) {
# special case for entering minute notation with only zero or clock notation
$output = "0:01";
}
elsif ($input =~ m|^(\d+:[0-5])$|) {
# special case for entering full notation with abbreviated minutes
$output = "${1}0";
}
elsif ($input =~ m|^:(\d+)$|) {
# special case for entering minute notation with abbreviated clock notation
my $h = int($1 / 60 + 0.5);
my $m = int($1 % 60 + 0.5);
$output = sprintf("%d:%02d", $h, $m);
}
elsif ($input =~ m|^[1-9]$|) {
# direct hour notation
$output = sprintf("%02d:00", $input);
}
elsif ($input =~ m|^[1-9]\d+$|) {
my $h = int($input / 60 + 0.5);
my $m = int($input % 60 + 0.5);
$output = sprintf("%d:%02d", $h, $m);
}
# 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"
if ($bashme) {
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 = "";
}
open(FP, ">/tmp/log");
print FP "input=<$input>\n";
print FP "output=<$output>\n";
close(FP);
d547 1
a547 1
my ($begin, $end, $amount) = &splittimespec($timespec, 0);
d549 1
a549 1
if (not $begin =~ m/([0-9]|[01][0-9]|2[0-4])((:[0-9]|[0-5][0-9])(:[0-9]|[0-5][0-9])?)?$/) {
d553 1
a553 1
if (not $end =~ m/([0-9]|[01][0-9]|2[0-4])((:[0-9]|[0-5][0-9])(:[0-9]|[0-5][0-9])?)?$/) {
d557 1
a557 1
if (not $amount =~ m/([0-9]|[01][0-9]|2[0-4])((:[0-9]|[0-5][0-9])(:[0-9]|[0-5][0-9])?)?$/) {
d845 1
a845 1
$amount) = &splittimespec($timespec, 0);
d871 1
a871 1
my ($timespec, $bashme) = @@_;
d882 4
a885 3
$begin = anytimetohhmm($begin, $bashme);
$end = anytimetohhmm($end, $bashme);
$amount = anytimetohhmm($amount, $bashme);
@
1.15
log
@bydateline
@
text
@d214 1
a214 1
my ($begin, $end, $amount) = &splittimespec($arg);
d224 2
a225 2
my ($arg) = @@_;
my @@reply = ();
d228 1
a228 1
if ($arg =~ m/([0-9]|[01][0-9]|2[0-4]):[0-9]|[0-5][0-9](:[0-9]|[0-5][0-9])?$/) {
d230 1
a230 1
push(@@reply, $arg);
d232 1
a232 1
elsif ($arg =~ m|^\.$|) {
d234 1
a234 1
push(@@reply, "NOW"); #FIXME
d236 1
a236 1
elsif ($arg =~ m|^\.\.$|) {
d238 1
a238 1
push(@@reply, "LAST"); #FIXME
d240 1
a240 1
elsif ($arg =~ m|^(\d*\.\d*)$|) {
d246 1
a246 1
push(@@reply, sprintf("%d:%02d", $h, $m));
d248 1
a248 1
elsif ($arg =~ m|^(\d*\/[1-9]\d*)$|) {
d255 1
a255 1
push(@@reply, sprintf("%d:%02d", $h, $m));
d257 1
a257 1
elsif ($arg =~ m|^0(\d)$|) {
d259 1
a259 1
push(@@reply, "0:0$1");
d261 1
a261 1
elsif ($arg =~ m|^0(:0?)?$|) {
d263 1
a263 3
for (my $i = 1; $i < 10; $i++) {
push(@@reply, "0:0$i");
}
d265 1
a265 1
elsif ($arg =~ m|^(\d+:[0-5])$|) {
d267 1
a267 1
push(@@reply, "${1}0");
d269 1
a269 1
elsif ($arg =~ m|^:(\d+)$|) {
d273 1
a273 1
push(@@reply, sprintf("%d:%02d", $h, $m));
d275 1
a275 1
elsif ($arg =~ m|^[1-9]$|) {
d277 1
a277 1
push(@@reply, sprintf("%02d:00", $arg));
d279 44
a322 13
elsif ($arg =~ m|^[1-9]\d+$|) {
my $h = int($arg / 60 + 0.5);
my $m = int($arg % 60 + 0.5);
push(@@reply, sprintf("%d:%02d", $h, $m));
}
#if ($arg =~ m|^.+[:=]|) {
# # FIXME: brain-dead bash completion feature/bug
# for (my $i = 0; $i <= $#reply; $i++) {
# $reply[$i] =~ s|^.*[:=](.*)$|$1|sg;
# }
#}
#return join("\n", @@reply)."\n"; FIXME
return join(" ", @@reply);
a323 1
d548 1
a548 1
my ($begin, $end, $amount) = &splittimespec($timespec);
d846 1
a846 1
$amount) = &splittimespec($timespec);
d872 1
a872 1
my ($timespec) = @@_;
d883 3
a885 3
$begin = anytimetohhmm($begin);
$end = anytimetohhmm($end);
$amount = anytimetohhmm($amount);
@
1.14
log
@slash2dot; dot2slash; accept dot in events file; remove DEBUG traces
@
text
@d576 1
a576 1
foreach my $uuid (keys %{$events}) {
d604 30
@
1.13
log
@calccrc32; keep a history before overwriting
@
text
@d169 3
a213 1
#print "DEBUG: trace#14 arg=\"$arg\"\n";
a214 1
#print "DEBUG: trace#16 begin=$begin; end=$end; amount=$amount\n";
a226 1
#print "DEBUG: trace#120 arg=\"$arg\"\n";
d428 1
a428 5
my $dname = '';
$name =~ s|^/||;
foreach my $part (reverse(split(/\//, $name))) {
$dname .= "." . $part;
}
d440 28
d535 3
a818 1
#print "DEBUG: trace#100 splittimespec(\"$timespec\")\n";
a827 1
#print "DEBUG: trace#101 begin=$begin; end=$end; amount=$amount\n";
@
1.12
log
@creating crc32
@
text
@d116 3
d558 1
a558 11
$crc32 = 0;
$crc32 = crc32(%{$events}->{$uuid}->{user} , $crc32);
$crc32 = crc32($uuid , $crc32);
$crc32 = crc32(%{$events}->{$uuid}->{revision} , $crc32);
$crc32 = crc32(%{$events}->{$uuid}->{date} , $crc32);
$crc32 = crc32(%{$events}->{$uuid}->{begin} , $crc32);
$crc32 = crc32(%{$events}->{$uuid}->{end} , $crc32);
$crc32 = crc32(%{$events}->{$uuid}->{amount} , $crc32);
$crc32 = crc32(%{$events}->{$uuid}->{account} , $crc32);
$crc32 = crc32($remark , $crc32);
$crc32 = sprintf("%08x", $crc32);
d573 1
a573 2
#print $io "$ln\n";
print "$ln\n";
d602 20
d652 9
@
1.11
log
@writeevents; do_newevent; splittimespec
@
text
@d36 1
a548 3
# cyclic redundancy check FIXME
$crc32 = "00000000";
d554 13
d579 3
a581 1
print $io "$ln\n";
@
1.10
log
@readevents
@
text
@d31 5
a35 4
use strict;
use IO;
use Getopt::Long;
use Text::Balanced;
a130 2
#for my $i (@@ARGV) { print "ARG=***$i***\n"; }; print "ARGV=---$ARGV---\n"; #FIXME DEBUG
d162 10
d207 4
a210 16
#print "DEBUG: trace#14 arg=\"$arg\"\n";
if ($arg =~ m/^(([^-]+)?-([^=]+)?)?=?(.*)$/) { #( begin? - end? )? =? amount*
my ($begin, $end, $amount) = ($2, $3, $4);
$begin = "00:00" if ($begin eq "");
$end = "24:00" if ($end eq "");
$amount = "CALC" if ($amount eq "");
#print "DEBUG: trace#15 begin=$begin; end=$end; amount=$amount\n";
$begin = anytimetohhmm($begin);
$end = anytimetohhmm($end);
$amount = anytimetohhmm($amount);
#print "DEBUG: trace#16 begin=$begin; end=$end; amount=$amount\n";
push(@@reply, $begin . "-" . $end . "=" . $amount);
}
else {
die "FIXME";
}
d222 1
d224 1
a224 1
if ($arg =~ m/([0-9]|[01][0-9]|2[0-4])((:[0-9]|[0-5][0-9])(:[0-9]|[0-5][0-9])?)?$/) {
d275 1
a275 1
push(@@reply, "$arg:00");
d491 3
a493 1
(my $begin, $remainder) = &splitq($remainder);
a497 1
(my $end, $remainder) = &splitq($remainder);
a501 1
(my $amount, $remainder) = &splitq($remainder);
d534 41
d704 5
a708 5
print $io "thl f81d4fae-7dec-11d0-a765-00a0c91e6bf6 a89b389c 00042 20021001 00:00 24:00 03:00 /sample-org/dep/vacation \"important recreation\" #ERROR: ...\n";
print $io "thl f81d4fae-7dec-11d0-a765-00a0391e6bf6 a89b389c 00042 20021001 00:00 24:00 03:00 /sample-org/dep/vacation \"important recreation\" #ERROR: ...\n";
print $io "ps f81d4fae-7dec-11d0-a765-00a0c81e6bf6 a79b389c 00042 20021001 00:00 24:00 03:00 /sample-org/dep/vacation \"important recreation\" #ERROR: ...\n";
print $io "rse f81d4fae-7dec-11d0-a765-00a8c91e6bf6 a87b389c 00042 20021001 00:00 24:00 03:00 /sample-org/dep/vacation \"important recreation\" #ERROR: ...\n";
print $io "rse f81d4fae-7dec-11d0-a765-01a0c81e6bf6 a89b389c 00042 20021001 00:00 24:00 03:00 /sample-org/dep/vacation \"important recreation\" #ERROR: ...\n";
d710 60
@
1.9
log
@implement time-spec shell completion
@
text
@d62 1
d120 1
a120 1
if (not $runtimecfg->{date} =~ m/^[2-9][0-9]{3}([0][1-9]|[1][0-2])([0][1-9]|[12][0-9]|[3][01])/) { #FIXME not yet perfect
d127 3
d199 3
a201 3
if ($arg =~ m/^(([^-]+)?-([^=]+)?)?=?(.*)$/) { #( start? - end? )? =? amount*
my ($start, $end, $amount) = ($2, $3, $4);
$start = "00:00" if ($start eq "");
d204 2
a205 2
#print "DEBUG: trace#15 start=$start; end=$end; amount=$amount\n";
$start = anytimetohhmm($start);
d208 2
a209 2
#print "DEBUG: trace#16 start=$start; end=$end; amount=$amount\n";
push(@@reply, $start . "-" . $end . "=" . $amount);
d442 116
d661 9
@
1.8
log
@user/date are defines only; implemented simple sanity check
@
text
@d166 10
d178 2
a185 1
my @@reply = ();
a191 1
print join("\n", @@reply)."\n";
d194 12
a205 5
# completion of time argument
my @@reply = ();
if ($arg =~ m|^\d+:[0-5][0-9]$|) {
# given notation is already standard notation
push(@@reply, $arg);
d207 2
a208 7
elsif ($arg =~ m|^(\d*\.\d*)$|) {
# hours in decimal fractional notation
my $f = "0".$1;
$f = int($f * 60 + 0.5);
my $h = $f / 60;
my $m = $f % 60;
push(@@reply, sprintf("%d:%02d", $h, $m));
a209 45
elsif ($arg =~ m|^(\d*\/[1-9]\d*)$|) {
# hours in standard fractional notation
my $f = $1;
$f =~ s|^/|1/|s;
eval "\$f = int(($f) * 60 + 0.5);";
my $h = $f / 60;
my $m = $f % 60;
push(@@reply, sprintf("%d:%02d", $h, $m));
}
elsif ($arg =~ m|^0(\d)$|) {
# special case for entering minute notation with leading zero
push(@@reply, "0:0$1");
}
elsif ($arg =~ m|^0(:0?)?$|) {
# special case for entering minute notation with only zero or clock notation
for (my $i = 1; $i < 10; $i++) {
push(@@reply, "0:0$i");
}
}
elsif ($arg =~ m|^(\d+:[0-5])$|) {
# special case for entering full notation with abbreviated minutes
push(@@reply, "${1}0");
}
elsif ($arg =~ m|^:(\d+)$|) {
# special case for entering minute notation with abbreviated clock notation
my $h = int($1 / 60 + 0.5);
my $m = int($1 % 60 + 0.5);
push(@@reply, sprintf("%d:%02d", $h, $m));
}
elsif ($arg =~ m|^[1-9]$|) {
# direct hour notation
push(@@reply, "$arg:00");
}
elsif ($arg =~ m|^[1-9]\d+$|) {
my $h = int($arg / 60 + 0.5);
my $m = int($arg % 60 + 0.5);
push(@@reply, sprintf("%d:%02d", $h, $m));
}
if ($arg =~ m|^.+[:=]|) {
# FIXME: brain-dead bash completion feature/bug
for (my $i = 0; $i <= $#reply; $i++) {
$reply[$i] =~ s|^.*[:=](.*)$|$1|sg;
}
}
print join("\n", @@reply)."\n";
d214 74
@
1.7
log
@readaccounts() and accounts command line completion working
@
text
@d45 1
a45 1
my $opt_complete = "";
d55 4
a94 1
#print "DEBUG: opt_update=$opt_update->[0], $opt_update->[1] $#{$opt_update}\n"; #FIXME DEBUG
a98 1
#print "DEBUG: opt_commit=$opt_commit->[0], $opt_commit->[1] $#{$opt_commit}\n"; #FIXME DEBUG
d105 18
@
1.6
log
@add -duc option parsing
@
text
@d45 1
a45 1
my $opt_complete = 0;
d57 1
d76 1
a76 1
'C|complete=s' => $opt_complete,
d91 1
a91 1
print "DEBUG: opt_update=$opt_update->[0], $opt_update->[1] $#{$opt_update}\n";
d96 1
a96 1
print "DEBUG: opt_commit=$opt_commit->[0], $opt_commit->[1] $#{$opt_commit}\n";
d98 1
a98 1
#set the runtime configuration options
d103 4
d109 2
a110 2
if ($opt_complete) {
&do_complete;
d139 1
d147 1
a147 4
if (($#ARGV+1) != 1) {
die "expected exactly 1 argument";
}
my $arg = $ARGV[0];
a153 22
my $ac_file = "$ENV{HOME}/.as/accounts";
my @@ac_list = ();
if (-f $ac_file) {
my $io = new IO::File "<$ac_file"
|| die "unable to open file \"$ac_file\" with available accounts";
my $ac;
while (defined($ac = <$io>)) {
next if ($ac =~ m|^\s*#.*$| or $ac =~ m|^\s*$|);
$ac =~ s|\s*\n$||s;
$ac =~ s|\s*#.*$||s;
push(@@ac_list, $ac);
push(@@ac_list, "/".$ac);
my $ac_rev = '';
foreach my $ac_part (reverse(split(/\//, $ac))) {
$ac_rev .= $ac_part . ".";
}
$ac_rev =~ s|\.$||s;
push(@@ac_list, $ac_rev);
push(@@ac_list, ".".$ac_rev);
}
$io->close();
}
d156 3
a158 3
foreach my $ac (@@ac_list) {
if ($ac =~ m|^$pattern|) {
push(@@reply, $ac);
d230 1
a230 1
# Read file
d237 1
d290 87
d468 1
a468 3
print "val vorher ***$val***\n";
$val =~ s/([\\$quote\s])/$backslash$1/g; #FIXME poor man's escaping
print "val nachher ***$val***\n";
d471 10
@
1.5
log
@implemented -s option
@
text
@d49 3
d79 3
d86 11
d110 9
d125 3
d406 6
@
1.4
log
@implemented -D and -v options
@
text
@d45 1
d48 2
d51 3
a53 4
my $opt_help = 0;
my $opt_complete = "";
my $opt_commit = 0;
my $opt_queue = 1;
d72 1
d75 3
a77 4
'V|version' => \$opt_version,
'C|complete=s' => \$opt_complete,
'c|commit' => \$opt_commit,
'q|queue' => \$opt_queue,
d81 1
a81 1
my $runtimecfg = &readrc();
d86 6
a91 3
#FIXME debugging a specific function
foreach my $var (keys %{$runtimecfg}) {
print "$var = ***$runtimecfg->{$var}***\n";
d93 1
a93 5
print "opt_verbose=$opt_verbose\n";
exit;
# dispatch into sub-routines
if ($opt_help) {
d96 3
a98 1
" -V,--version print out program version\n" .
d100 1
a100 4
" -v,--verbose enable verbose run-time mode\n" .
" -C,--complete=TYPE complete account or time strings\n" .
" -c,--commit commit accounting immediately\n" .
" -q,--queue queue accounting only\n";
a104 6
elsif ($opt_complete) {
&do_complete();
}
elsif ($opt_queue) {
&do_queue();
}
d224 11
a234 1
my ($path, $io) = &openfile("rc");
d279 11
a289 1
# open file and check for magic cookie on the first line
d292 1
a292 1
my ($file) = @@_;
d294 4
a297 1
my $path = "$ENV{HOME}/.as/$file";
a301 3
# check first line for magic cookie
my $magic = uc($file);
a305 1
d307 25
d338 9
a346 1
my ($io) = @@_;
d348 27
a374 6
if (defined($io)) {
$io->close();
} else {
print "WARNING: closefile() called on undefined file handle - ignored\n";
}
return;
d376 1
@
1.3
log
@readrc()
@
text
@d45 2
a48 1
my $opt_verbose = 0;
d70 2
a72 2
'h|help' => \$opt_help,
'v|verbose' => \$opt_verbose,
d78 6
d85 2
a86 3
my $rc = &readrc();
foreach my $var (keys %{$rc}) {
print "$var = ***$rc->{$var}***\n";
d88 1
@
1.2
log
@- add more documentation
- add licenses
@
text
@d32 1
d34 1
a34 1
use IO;
d38 5
a42 1
my $progvers = "0.0.1";
d77 7
d218 84
@
1.1
log
@add first cut for command line client
@
text
@d5 23
a27 3
## as -- AS Command-Line Client
## Copyright (c) 2002 Cable & Wireless Germany
## Copyright (c) 2002 Ralf S. Engelschall
@