#! perl
# Author : Johan Vromans
# Created On : Thu Jul 14 12:54:08 2005
# Last Modified By: Johan Vromans
# Last Modified On: Fri May 18 20:55:27 2012
# Update Count : 228
# Status : Unknown, Use with caution!
use utf8;
package main;
our $cfg;
our $dbh;
our $app;
package EB::Shell;
use strict;
use warnings;
use EB;
my $bky; # current boekjaar (if set)
use base qw(EB::Shell::DeLuxe);
sub new {
my $class = shift;
$class = ref($class) || $class;
my $opts = UNIVERSAL::isa($_[0], 'HASH') ? shift : { @_ };
if ( $opts->{command} && $ARGV[0] eq "import" ) {
$dbh->connectdb(1);
}
else {
_plug_cmds();
}
# User defined stuff.
my $pkg = $cfg->val(qw(shell userdefs), undef);
if ( $pkg ) {
$pkg =~ s/::/\//g;
$pkg .= ".pm";
eval { require $pkg };
die($@) if $@;
}
else {
eval {
local $SIG{__WARN__};
local $SIG{__DIE__};
require EB::Shell::Userdefs;
};
die($@) if $@ && $@ !~ /can't locate eb.shell.userdefs\.pm in \@inc/i;
}
my $self = $class->SUPER::new($opts);
if ( $self->{interactive} ) {
$self->term->Attribs->{completion_function} = sub { $self->eb_complete(@_) };
}
if ( defined $self->{boekjaar} ) {
$self->do_boekjaar($self->{boekjaar});
}
$self;
}
sub prompt {
my $t = $cfg->val(qw(database name));
$t =~ s/^eekboek_//;
$t = shift->{prompt} . " [$t";
$t .= ":$bky" if defined $bky;
$t . "] ";
}
sub default {
undef;
}
sub intro {
my $self = $_[0];
if ( $self->{interactive} ) {
do_database();
bky_msg();
}
undef;
}
sub outro { undef }
sub postcmd {
shift;
if ( $dbh->in_transaction ) {
warn("%"._T("Openstaande transactie is teruggedraaid")."\n");
$dbh->rollback;
}
shift
}
sub bky_msg {
my $sth = $dbh->sql_exec("SELECT bky_code".
" FROM Boekjaren".
" WHERE bky_end < ?".
" AND NOT bky_opened IS NULL".
" AND bky_closed IS NULL".
" ORDER BY bky_begin",
defined $bky ?
$dbh->lookup($bky, qw(Boekjaren bky_code bky_begin)) :
$dbh->adm("begin"));
while ( my $rr = $sth->fetchrow_arrayref ) {
warn("!".__x("Pas op! Boekjaar {bky} is nog niet afgesloten.",
bky => $rr->[0])."\n");
}
}
my $dbk_pat;
my $dbk_i_pat;
my $dbk_v_pat;
my $dbk_bkm_pat;
sub eb_complete {
my ($self, $word, $line, $pos) = @_;
my $i = index($line, ' ');
#warn "\nCompleting '$word' in '$line' (pos $pos, space $i)\n";
my $pre = substr($line, 0, $pos);
#warn "\n[$pre][", substr($line, $pos), "]\n";
select(STDERR); $| = 1; select(STDOUT);
# Some ReadLiners put the terminal in raw mode...
my $nl = "\r\n";
if ( $i < 0 || $i > $pos-1 || $pre =~ /^help\s+$/ ) {
my @words = $self->completions;
if ( $pre =~ /^help\s+$/ ) {
push( @words,
$self->{cm}->{rapporten},
$self->{cm}->{periodes});
}
my @a = grep { /^$word/ } @words;
if ( @a ) {
return $a[0] if @a == 1;
print STDERR ( $nl, join(" ", @a), $nl,
# Re-prompt. We'll lose the ornaments,
# but it's better than nothing (I hope).
$self->prompt, "$line" );
}
return;
}
if ( $word =~ /^\d+$/ ) {
my $sth = $dbh->sql_exec("SELECT acc_id,acc_desc from Accounts".
" WHERE CAST(acc_id AS text) LIKE ?".
" ORDER BY acc_id", "$word%");
my $rr = $sth->fetchrow_arrayref;
return () unless $rr;
my ($w, $d) = @$rr;
$rr = $sth->fetchrow_arrayref;
return ($w) unless $rr;
printf STDERR ($nl."%9d %s".$nl, $w, $d);
while ( $rr ) {
printf STDERR ("%9d %s".$nl, @$rr);
$rr = $sth->fetchrow_arrayref;
}
print STDERR ("$line");
return ();
}
my $t;
if ( ($word =~ /^[[:alpha:]]/ || $word eq "?")
&& (($pre =~ /^\s*(?:$dbk_bkm_pat).*\s(crd|deb)\s+$/ and $t = $1)
|| ($pre =~ /^\s*(?:$dbk_i_pat)(?::\S+)?(?:\s+[0-9---]+)?\s*$/ and $t = "deb")
|| ($pre =~ /^\s*(?:$dbk_v_pat)(?::\S+)?(?:\s+[0-9---]+)?\s*$/ and $t = "crd"))) {
$word = "" if $word eq "?";
my $sth = $dbh->sql_exec("SELECT rel_code,rel_desc from Relaties".
" WHERE rel_code LIKE ?".
" AND " . ($t eq "deb" ? "" : "NOT ") . "rel_debcrd".
" ORDER BY rel_code", "$word%");
my $rr = $sth->fetchrow_arrayref;
return () unless $rr;
my ($w, $d) = @$rr;
$rr = $sth->fetchrow_arrayref;
if ( !$rr && $word ne "" ) {
return ($w);
}
printf STDERR ($nl." %s %s".$nl, $w, $d);
while ( $rr ) {
printf STDERR (" %s %s".$nl, @$rr);
$rr = $sth->fetchrow_arrayref;
}
print STDERR ("$line");
return ();
}
#warn "\n[$pre][", substr($line, $pos), "]\n";
return ();
}
sub parseline {
my ($self, $line) = @_;
$line =~ s/\\\s*$//;
$line =~ s/;\s*$//;
my ($cmd, @args) = $self->SUPER::parseline($line);
if ( $cmd =~ /^(.+):(\S+)$/ ) {
$cmd = $1;
unshift(@args, "--nr=$2");
}
($cmd, @args);
}
################ Subroutines ################
use EB;
# Plug in some commands dynamically.
sub _plug_cmds {
foreach my $dbk_type ( 1 .. scalar(@{DBKTYPES()})-1 ) {
my $dbk = lc(_T(DBKTYPES->[$dbk_type]));
no strict 'refs';
undef &{"help_$dbk"};
*{"help_$dbk"} = sub {
my $self = shift;
$self->_help($dbk_type);
};
}
my $sth = $dbh->sql_exec("SELECT dbk_id,dbk_desc,dbk_type FROM Dagboeken");
my $rr;
while ( $rr = $sth->fetchrow_arrayref ) {
my ($dbk_id, $dbk_desc, $dbk_type) = @$rr;
no strict 'refs';
my $dbk = lc(_T($dbk_desc)); #### TODO: _T ???
$dbk =~ s/\s+/_/g;
undef &{"do_$dbk"} if defined &{"do_$dbk"};
*{"do_$dbk"} = sub {
my $self = shift;
$self->_add($dbk_id, @_);
};
undef &{"help_$dbk"};
*{"help_$dbk"} = sub {
my $self = shift;
$self->_help($dbk_type);
};
if ( $dbk_type == DBKTYPE_INKOOP ) {
$dbk_v_pat .= lc($dbk_desc)."|";
$dbk_pat .= lc($dbk_desc)."|";
}
elsif ( $dbk_type == DBKTYPE_VERKOOP ) {
$dbk_i_pat .= lc($dbk_desc)."|";
$dbk_pat .= lc($dbk_desc)."|";
}
else {
$dbk_bkm_pat .= lc($dbk_desc)."|";
$dbk_pat .= lc($dbk_desc)."|";
}
}
# Opening (adm_...) commands.
require EB::Tools::Opening;
foreach my $adm ( @{EB::Tools::Opening->commands} ) {
my $cmd = $adm;
$cmd =~ s/^set_//;
no strict 'refs';
undef &{"do_adm_$cmd"} if defined &{"do_adm_$cmd"};
*{"do_adm_$cmd"} = sub {
(shift->{o} ||= EB::Tools::Opening->new)->$adm(@_);
};
my $help = "help_$cmd";
undef &{"help_adm_$cmd"};
*{"help_adm_$cmd"} = sub {
my $self = shift;
($self->{o} ||= EB::Tools::Opening->new)->can($help)
? $self->{o}->$help() : $self->{o}->shellhelp($cmd);
};
}
foreach ($dbk_pat, $dbk_i_pat, $dbk_v_pat, $dbk_bkm_pat) {
chop if $_;
}
}
sub _forget_cmds {
# Delete daybook-associated shell functions.
my $t = "|".join( "|", @{ $dbh->tablesdb } )."|";
if ( $t =~ /\|dagboeken\|/i ) {
my $sth = $dbh->sql_exec("SELECT dbk_desc FROM Dagboeken");
my $rr;
while ( $rr = $sth->fetchrow_arrayref ) {
my ($dbk_desc) = @$rr;
no strict 'refs';
my $dbk = lc(_T($dbk_desc)); #### TODO: _T ???
$dbk =~ s/\s+/_/g;
undef &{"do_$dbk"} if defined &{"do_$dbk"};
}
}
}
sub _help {
my ($self, $dbk_type) = @_;
my $text = __x("Toevoegen boekstuk in een dagboek van type {type}",
type => DBKTYPES->[$dbk_type]) . ".\n\n";
if ( $dbk_type == DBKTYPE_INKOOP ) {
$text .= _T( <<EOS );
<dagboek>[:nr] [ <datum> ] <boekstukomschrijving> <crediteur>
gevolgd door een of meer:
<boekstukregelomschrijving> <bedrag> <rekening>
Controle van het totale boekstukbedrag kan met de optie --totaal=<bedrag>.
De laatste <rekening> mag worden weggelaten.
EOS
}
elsif ( $dbk_type == DBKTYPE_VERKOOP ) {
$text .= _T( <<EOS );
<dagboek>[:nr] [ <datum> ] <boekstukomschrijving> <debiteur>
gevolgd door een of meer
<boekstukregelomschrijving> <bedrag> <rekening>
Controle van het totale boekstukbedrag kan met de optie --totaal=<bedrag>.
De laatste <rekening> mag worden weggelaten.
EOS
}
elsif ( $dbk_type == DBKTYPE_BANK || $dbk_type == DBKTYPE_KAS
|| $dbk_type == DBKTYPE_MEMORIAAL
) {
$text .= _T( <<EOS );
<dagboek>[:nr] [ <datum> ] <boekstukomschrijving>
gevolgd door een of meer:
crd [ <datum> ] <relatie> <bedrag> (betaling van crediteur)
deb [ <datum> ] <relatie> <bedrag> (betaling van debiteur)
std [ <datum> ] <omschrijving> <bedrag> <rekening> (vrije boeking)
Controle van het eindsaldo kan met de optie --saldo=<bedrag>.
Controle van het totale boekstukbedrag kan met de optie --totaal=<bedrag>.
Voor deelbetalingen of betalingen met afwijkend bedrag kan in plaats van de
<relatie> het boekstuknummer worden opgegeven.
EOS
}
$text;
}
sub clionly {
my ( $self, $cmd ) = @_;
warn("?".__x("Opdracht \"{cmd}\" is niet beschikbaar.", cmd => $cmd)."\n");
undef;
}
################ Service ################
sub argcnt($$;$) {
my ($cnt, $min, $max) = @_;
$max = $min unless defined $max;
return 1 if $cnt >= $min && $cnt <= $max;
warn("?"._T("Te weinig argumenten voor deze opdracht")."\n") if $cnt < $min;
warn("?"._T("Te veel argumenten voor deze opdracht")."\n") if $cnt > $max;
undef;
}
################ Global toggles ################
sub _state {
my ($cur, $state) = @_;
return !$cur unless defined($state);
my $on = _T("aan");
my $off = _T("uit");
return 1 if $state =~ /^$on|1$/i;
return 0 if $state =~ /^$off|0$/i;
return !$cur;
}
sub do_trace {
my ($self, @args) = @_;
my $opts = { quiet => 0 };
return unless
parse_args(\@args,
[ 'quiet!' ],
$opts);
return unless argcnt(@args, 0, 1);
my $state = shift(@args);
$self->{trace} = _state($self->{trace}, $state);
if ( $dbh ) {
$dbh->trace($self->{trace});
}
return "" if $opts->{quiet};
__x("SQL Trace: {state}", state => uc($self->{trace} ? _T("aan") : _T("uit")));
}
sub do_journal {
my ($self, @args) = @_;
my $opts = { quiet => 0 };
return unless
parse_args(\@args,
[ 'quiet!' ],
$opts);
return unless argcnt(@args, 0, 1);
my $state = shift(@args);
$self->{journal} = _state($self->{journal}, $state);
return "" if $opts->{quiet};
__x("Journal: {state}", state => uc($self->{journal} ? _T("aan") : _T("uit")));
}
sub do_confirm {
my ($self, @args) = @_;
my $opts = { quiet => 0 };
return unless
parse_args(\@args,
[ 'quiet!' ],
$opts);
return unless argcnt(@args, 0, 1);
my $state = shift(@args);
$self->{confirm} = _state($self->{confirm}, $state);
return "" if $opts->{quiet};
__x("Bevestiging: {state}", state => uc($self->{confirm} ? _T("aan") : _T("uit")));
}
sub do_database {
my ($self, @args) = @_;
return unless argcnt(scalar(@args), 0);
__x("Database: {db}", db => $cfg->val(qw(database name)));
}
sub help_database {
_T(<<EOD);
Toont de naam van de huidige database.
database
EOD
}
################ Bookings ################
my $bsk; # current/last boekstuk
sub _add {
my ($self, $dagboek, @args) = @_;
my $dagboek_type = $dbh->lookup($dagboek, qw(Dagboeken dbk_id dbk_type =));
my $action;
if ( $dagboek_type == DBKTYPE_INKOOP
|| $dagboek_type == DBKTYPE_VERKOOP ) {
require EB::Booking::IV;
$action = EB::Booking::IV->new;
}
elsif ( $dagboek_type == DBKTYPE_BANK
|| $dagboek_type == DBKTYPE_KAS
|| $dagboek_type == DBKTYPE_MEMORIAAL) {
require EB::Booking::BKM;
$action = EB::Booking::BKM->new;
}
else {
die("?".__x("Onbekend of verkeerd dagboek: {dbk} [{type}]",
dbk => $dagboek, type => $dagboek_type)."\n");
}
my $opts = { dagboek => $dagboek,
dagboek_type => $dagboek_type,
d_boekjaar => $bky || $dbh->adm("bky"),
journal => $self->{journal},
totaal => undef,
ref => undef,
verbose => $self->{verbose},
confirm => $self->{confirm},
};
my $args = \@args;
return unless
parse_args($args,
[ __xt('cmo:boeking:boekstuk|nr').'=s' => \$opts->{boekstuk},
__xt('cmo:boeking:boekjaar').'=s' => \$opts->{boekjaar},
__xt('cmo:boeking:journal|journaal').'!' => \$opts->{journal},
__xt('cmo:boeking:totaal').'=s' => \$opts->{totaal},
__xt('cmo:boeking:ref').'=s' => \$opts->{ref},
__xt('cmo:boeking:confirm').'!' => \$opts->{confirm},
( $dagboek_type == DBKTYPE_BANK
|| $dagboek_type == DBKTYPE_KAS )
? ( __xt('cmo:boeking:saldo').'=s' => \$opts->{saldo},
__xt('cmo:boeking:beginsaldo').'=s' => \$opts->{beginsaldo} )
: (),
], $opts);
$opts->{boekjaar} = $opts->{d_boekjaar} unless defined $opts->{boekjaar};
$bsk = $action->perform($args, $opts);
$bsk ? $bsk =~ /^\w+:\d+/ ? __x("Geboekt: {bsk}", bsk => $bsk) : $bsk : "";
}
################ Reports ################
sub do_journaal {
my ($self, @args) = @_;
my $b = $bsk;
my $opts = { _cmd => "journaal",
detail => 1,
d_boekjaar => $bky || $dbh->adm("bky"),
};
require EB::Report::Journal;
require EB::Report::GenBase;
return unless
parse_args(\@args,
[ __xt('cmo:journaal:detail|details').'!' => \$opts->{journal},
__xt('cmo:journaal:totaal') => sub { $opts->{detail} = 0 },
__xt('cmo:journaal:boekjaar').'=s' => \$opts->{boekjaar},
__xt('cmo:journaal:periode').'=s' => sub { periode_arg($opts, "periode", $_[1]) },
EB::Report::GenBase->backend_options(EB::Report::Journal::, $opts),
], $opts);
# print STDERR Dumper($opts), "\n";
$b = shift(@args) if @args;
undef $b if $b && lc($b) eq "all";
$opts->{select} = $b;
EB::Report::Journal->new->journal($opts);
undef;
}
sub help_journaal {
_T( <<EOS );
Overzicht journaalposten.
journaal all Alle posten
journaal <id> Alleen boekstuknummer met dit id
journaal <dagboek> Alle journaalposten van dit dagboek
journaal <dagboek>:<n> Boekstuk <n> van dit dagboek
journaal Journaalposten van de laatste boeking
Opties
--[no]detail Mate van detail, standaard is met details
--totaal Alleen het totaal (detail = 0)
--periode=XXX Alleen over deze periode
Zie verder "help rapporten" voor algemene informatie over aan te maken
rapporten.
EOS
}
sub do_balans {
my ($self, @args) = @_;
my $opts = { d_boekjaar => $bky || $dbh->adm("bky"),
};
require EB::Report::Balres;
require EB::Report::GenBase;
return unless
parse_args(\@args,
[ 'detail=i',
'verdicht',
'opening',
'boekjaar=s',
'per=s' => sub { date_arg($opts, @_) },
EB::Report::GenBase->backend_options(EB::Report::Balres::, $opts),
], $opts);
return unless argcnt(@args, 0);
if ( $opts->{opening} && $opts->{per} ) {
warn("?"._T("Openingsbalans kent geen einddatum")."\n");
return;
}
EB::Report::Balres->new->balans($opts);
undef;
}
sub help_balans {
_T( <<EOS );
Toont de balansrekening.
Opties:
<geen> Balans op grootboekrekening
--verdicht Verdicht, gedetailleerd
--detail=<n> Verdicht, mate van detail <n> = 0, 1 of 2
--per=<datum> Selecteer einddatum
--boekjaar=<code> Selecteer boekjaar
--opening Toon openingsbalans
Zie verder "help rapporten" voor algemene informatie over aan te maken
rapporten.
EOS
}
sub do_result {
my ($self, @args) = @_;
my $opts = { d_boekjaar => $bky || $dbh->adm("bky"),
};
require EB::Report::Balres;
require EB::Report::GenBase;
return unless
parse_args(\@args,
[ 'detail=i',
'verdicht',
'boekjaar=s',
'periode=s' => sub { periode_arg($opts, @_) },
EB::Report::GenBase->backend_options(EB::Report::Balres::, $opts),
], $opts);
return unless argcnt(@args, 0);
EB::Report::Balres->new->result($opts);
undef;
}
sub help_result {
_T( <<EOS );
Toont de resultatenrekening.
Opties:
<geen> Overzicht op grootboekrekening
--verdicht Verdicht, gedetailleerd
--detail=<n> Verdicht, mate van detail <n> = 0,1,2
--periode=<periode> Selecteer periode
--boekjaar=<code> Selecteer boekjaar
Zie verder "help rapporten" voor algemene informatie over aan te maken
rapporten.
EOS
}
sub do_proefensaldibalans {
my ($self, @args) = @_;
my $opts = { d_boekjaar => $bky || $dbh->adm("bky"),
};
require EB::Report::Proof;
require EB::Report::GenBase;
return unless
parse_args(\@args,
[ 'detail=i',
'verdicht',
'boekjaar=s',
'per=s' => sub { date_arg($opts, @_) },
EB::Report::GenBase->backend_options(EB::Report::Proof::, $opts),
], $opts);
warn("?"._T("Te veel argumenten voor deze opdracht")."\n"), return if @args;
EB::Report::Proof->new->proefensaldibalans($opts);
undef;
}
sub help_proefensaldibalans {
_T( <<EOS );
Toont de Proef- en Saldibalans.
Opties:
<geen> Proef- en Saldibalans op grootboekrekening
--verdicht Verdicht, gedetailleerd (hetzelfde als --detail=2)
--detail=<n> Verdicht, mate van detail <n> = 0,1,2
--per=<datum> Selecteer einddatum
--boekjaar=<code> Selecteer boekjaar
Zie verder "help rapporten" voor algemene informatie over aan te maken
rapporten.
EOS
}
sub do_grootboek {
my ($self, @args) = @_;
my $opts = { detail => 2,
d_boekjaar => $bky || $dbh->adm("bky"),
};
require EB::Report::Grootboek;
require EB::Report::GenBase;
return unless
parse_args(\@args,
[ 'detail=i',
'periode=s' => sub { periode_arg($opts, @_) },
'boekjaar=s',
EB::Report::GenBase->backend_options(EB::Report::Grootboek::, $opts),
], $opts);
my $fail;
my ($max_hvd, $max_vrd);
my @accts;
while ( @args ) {
$_ = shift(@args);
if ( /^\d+$/ ) {
# Check for (Hoofd)Verdichtingen.
$max_hvd ||= $dbh->do
( "SELECT MAX(vdi_id) FROM Verdichtingen ".
"WHERE vdi_struct IS NULL")->[0];
$max_vrd ||= $dbh->do
( "SELECT MAX(vdi_id) FROM Verdichtingen ".
"WHERE NOT vdi_struct IS NULL")->[0];
if ( $_ < $max_hvd ) {
my $sth = $dbh->sql_exec
( "SELECT acc_id FROM Accounts ".
"WHERE acc_struct IN ".
" ( SELECT vdi_id FROM Verdichtingen ".
" WHERE vdi_struct = ? ) ".
"ORDER BY acc_id DESC", $_ );
while ( my $rr = $sth->fetch ) {
unshift( @accts, $rr->[0] );
}
}
elsif ( $_ < $max_vrd ) {
my $sth = $dbh->sql_exec
( "SELECT acc_id from Accounts ".
"WHERE acc_struct = ? ".
"ORDER BY acc_id DESC", $_ );
while ( my $rr = $sth->fetch ) {
unshift( @accts, $rr->[0] );
}
}
# Assume ordinary account number.
elsif ( $dbh->lookup( $_, qw(Accounts acc_id acc_id) ) ) {
push( @accts, $_ );
}
else {
warn("?".__x("Onbekend rekeningnummer: {acct}",
acct => $_)."\n");
$fail++;
}
next;
}
warn("?".__x("Ongeldig rekeningnummer: {acct}",
acct => $_)."\n");
$fail++;
}
return if $fail;
$opts->{select} = join( ",", @accts ) if @accts;
EB::Report::Grootboek->new->perform($opts);
undef;
}
sub help_grootboek {
_T( <<EOS );
Toont het Grootboek, of een selectie daaruit.
grootboek [ <nr> ... ]
Opties:
--detail=<n> Mate van detail, <n>=0,1,2 (standaard is 2)
--periode=<periode> Alleen over deze periode
Naast rekeningnummers kunnen ook nummers van verdichtingen en
hoofdverdichtingen worden opgegeven.
Zie verder "help rapporten" voor algemene informatie over aan te maken
rapporten.
EOS
}
sub do_dagboeken {
my ($self, @args) = @_;
my $rr;
my $sth = $dbh->sql_exec("SELECT dbk_id, dbk_desc, dbk_type, dbk_acc_id".
" FROM Dagboeken".
" ORDER BY dbk_id");
my $fmt = "%2s %-16s %-12s %5s\n";
my $text = sprintf($fmt, _T("Nr"), _T("Naam"), _T("Type"), _T("Rekening"));
while ( $rr = $sth->fetchrow_arrayref ) {
my ($dbk_id, $dbk_desc, $dbk_type, $dbk_acct) = @$rr;
$dbk_acct ||= _T("n.v.t.");
$text .= sprintf($fmt, $dbk_id, $dbk_desc, DBKTYPES->[$dbk_type], $dbk_acct);
}
$text;
}
sub help_dagboeken {
_T( <<EOS );
Toont een lijstje van beschikbare dagboeken.
dagboeken
EOS
}
# do_btwaangifte and help_btwaangifte are dynamically plugged in (or not).
sub do_btwaangifte {
my ($self, @args) = @_;
my $opts = { d_boekjaar => $bky || $dbh->adm("bky"),
close => 0,
};
require EB::Report::BTWAangifte;
require EB::Report::GenBase;
return unless
parse_args(\@args,
[ "boekjaar=s",
'periode=s' => sub { periode_arg($opts, @_) },
"definitief" => sub { $opts->{close} = 1 },
EB::Report::GenBase->backend_options(EB::Report::BTWAangifte::, $opts),
"noreport",
"noround",
], $opts)
or goto &help_btwaangifte;
if ( @args && lc($args[-1]) eq "definitief" ) {
$opts->{close} = 1;
pop(@args);
}
warn("?"._T("Te veel argumenten voor deze opdracht")."\n"), return
if @args > ($opts->{periode} ? 0 : 1);
$opts->{compat_periode} = $args[0] if @args;
warn("?"._T("Deze administratie voert geen BTW")."\n"), return
unless $dbh->does_btw;
EB::Report::BTWAangifte->new($opts)->perform($opts);
undef;
}
sub help_btwaangifte {
_T( <<EOS );
Toont de BTW aangifte.
btwaangifte [ <opties> ] [ <aangifteperiode> ]
Aangifteperiode kan zijn:
j jaar Het gehele jaar
k1 k2 k3 k4 1e/2e/3e/4e kwartaal (ook: q1, ...)
1 2 3 ... Maand (op nummer)
jan feb ... Maand (korte naam)
januari ... Maand (lange naam)
Standaard is de eerstvolgende periode waarover nog geen aangifte is
gedaan.
Opties:
--definitief De BTW periode wordt afgesloten. Er zijn geen
boekingen in deze periode meer mogelijk.
--periode=<periode> Selecteer aangifteperiode. Dit kan niet samen
met --boekjaar, en evenmin met de bovenvermelde
methode van periode-specificatie.
--boekjaar=<code> Selecteer boekjaar
--noreport Geen rapportage. Dit is enkel zinvol samen
met --definitief om de afgesloten BTW periode
aan te passen.
--noround Alle bedragen zonder af te ronden.
Zie verder "help rapporten" voor algemene informatie over aan te maken
rapporten.
EOS
}
sub do_debiteuren {
my ($self, @args) = @_;
my $opts = { d_boekjaar => $bky || $dbh->adm("bky"),
};
require EB::Report::Debcrd;
require EB::Report::GenBase;
return unless
parse_args(\@args,
[ "boekjaar=s",
EB::Report::GenBase->backend_options(EB::Report::Debcrd::, $opts),
'periode=s' => sub { periode_arg($opts, @_) },
'openstaand',
], $opts);
EB::Report::Debcrd->new->debiteuren(\@args, $opts);
}
sub help_debiteuren {
_T( <<EOS );
Toont een overzicht van boekingen op debiteuren.
debiteuren [ <opties> ] [ <relatiecodes> ... ]
Opties:
--periode <periode> Periode
--boekjaar=<code> Selecteer boekjaar
--openstaand Alleen met openstaande posten
Zie verder "help rapporten" voor algemene informatie over aan te maken
rapporten.
EOS
}
sub do_crediteuren {
my ($self, @args) = @_;
my $opts = { d_boekjaar => $bky || $dbh->adm("bky"),
};
require EB::Report::Debcrd;
require EB::Report::GenBase;
return unless
parse_args(\@args,
[ "boekjaar=s",
EB::Report::GenBase->backend_options(EB::Report::Debcrd::, $opts),
'periode=s' => sub { periode_arg($opts, @_) },
'openstaand',
], $opts);
EB::Report::Debcrd->new->crediteuren(\@args, $opts);
}
sub help_crediteuren {
_T( <<EOS );
Toont een overzicht van boekingen op crediteuren.
crediteuren [ <opties> ] [ <relatiecode> ... ]
Opties:
--periode=<periode> Periode
--boekjaar=<code> Selecteer boekjaar
--openstaand Alleen met openstaande posten
Zie verder "help rapporten" voor algemene informatie over aan te maken
rapporten.
EOS
}
sub do_openstaand {
my ($self, @args) = @_;
my $opts = { d_boekjaar => $bky || $dbh->adm("bky"),
};
require EB::Report::Open;
require EB::Report::GenBase;
return unless
parse_args(\@args,
[ "boekjaar=s",
EB::Report::GenBase->backend_options(EB::Report::Open::, $opts),
'per=s' => sub { date_arg($opts, @_) },
'deb|debiteuren',
'crd|crediteuren',
], $opts);
return unless argcnt(@args, 0, 1);
EB::Report::Open->new->perform($opts, \@args);
}
sub help_openstaand {
_T( <<EOS );
Toont een overzicht van openstaande posten.
openstaand [ <opties> ] [ <relatie> ]
Opties:
--per=<datum> Einddatum
--boekjaar=<code> Selecteer boekjaar
--deb --debiteuren Alleen debiteuren
--crd --crediteuren Alleen crediteuren
Zie verder "help rapporten" voor algemene informatie over aan te maken
rapporten.
EOS
}
sub help_rapporten {
_T( <<EOS );
Alle rapport-producerende opdrachten kennen de volgende opties:
--per=<datum> De einddatum voor de rapportage.
(Niet voor elke opdracht relevant.)
Zie "help periodes" voor details.
--periode=<periode> De periode waarover de rapportage moet
plaatsvinden. (Niet voor elke opdracht relevant.)
Zie "help periodes" voor details.
--output=<bestand> Produceer het rapport in dit bestand
Uitvoertype is afhankelijk van bestandsextensie,
bv. xx.html levert HTML, xx.txt een tekstbestand,
xx.csv een CSV, etc.
--gen-<type> Forceer uitvoertype (html, csv, text, ...)
Afhankelijk van de beschikbare uitvoertypes zijn
ook de kortere opties --html, --csv en --text
mogelijk.
(Let op: --gen-XXX, niet --gen=XXX)
--page=<size> Paginagrootte voor tekstrapporten.
EOS
}
sub help_periodes {
_T( <<EOS );
De volgende periode-aanduidingen zijn mogelijk. Indien het jaartal ontbreekt,
wordt het huidige boekjaar verondersteld.
2005-04-01 - 2005-07-31
01-04-2005 - 31-07-2005
01-04 - 31-07-2005
01-04 - 31-07
1 april 2005 - 31 juli 2005 (en varianten)
1 apr 2005 - 31 jul 2005 (en varianten)
apr - jul
k2 (tweede kwartaal)
april 2003 (01-04-2003 - 30-04-2003)
april (01-04 - 30-04 boekjaar)
m4 (vierde maand)
jaar (gehele boekjaar)
EOS
}
################ Schema ################
sub do_schema {
my ( $self, @args ) = @_;
my $opts = {
};
goto &help_schema unless @args >= 2;
my $cmd = shift(@args);
require EB::Tools::Schema;
if ( $cmd eq 'gbk' ) {
goto &help_schema
unless @args % 4 == 0 || @args % 4 == 1; # weird, but okay
my $fail;
for ( my $i = 0; $i < @args; $i += 4 ) {
unless ( $args[$i] =~ /^[[:digit:]]+$/i ) {
warn("?".__x("Ongeldig of ontbrekend rekeningnummer: {x}",
x => $args[$i])."\n");
$fail++;
}
next if $i+1 >= @args;
unless ( $args[$i+1] =~ /^[dc]!?|[kon]$/i ) {
warn("?".__x("Ongeldige of ontbrekende type specificatie: {x}",
x => $args[$i+1])."\n");
$fail++;
}
unless ( $args[$i+3] =~ /^[[:digit:]]+$/i ) {
warn("?".__x("Ongeldige of ontbrekende verdichting: {x}",
x => $args[$i])."\n");
$fail++;
}
}
goto &help_schema if $fail;
EB::Tools::Schema->new->add_gbk( @args, $opts );
}
else {
goto &help_schema;
}
}
sub help_schema {
_T( <<EOS );
Onderhoud van het schema. Deze opdracht kent sub-opdrachten:
schema <opdracht> [ <opties> ] <argumenten>
Aanmaken grootboekrekening
schema gbk <rekening> [ <type> <omschrijving> <verdichting> ]
<rekening> de gewenste grootboekrekening
<type> D/C voor Debet / Credit
K/O/N voor Kosten / Omzet / Neutraal
Eventueel gevolgd door ! als deze
balansrekening vast staat aan één kant
<omschrijving> De omschrijving van deze grootboekrekening
<verdichting> De verdichting waaronder deze rekening valt
Wanneer enkel een nummer wordt opgegeven dan worden de gegevens
van de betreffende grootboekrekening getoond.
EOS
}
################ Relations ################
sub do_relatie {
my ($self, @args) = @_;
my $opts = {
};
return unless
parse_args(\@args,
[ __xt("cmo:relatie:dagboek").'=s' => \$opts->{dagboek},
$dbh->does_btw
? ( __xt("cmo:relatie:btw").'=s' => \$opts->{btw} )
: (),
], $opts)
or goto &help_relatie;
warn("?"._T("Ongeldig aantal argumenten voor deze opdracht")."\n"), return if @args % 3;
require EB::Relation;
while ( @args ) {
my @a = splice(@args, 0, 3);
my $res = EB::Relation->new->add(@a, $opts);
warn("$res\n") if $res;
}
}
sub help_relatie {
my $ret = _T( <<EOS );
Aanmaken een of meer nieuwe relaties.
relatie [ <opties> ] { <code> <omschrijving> <rekening> } ...
Opties:
--dagboek=<dagboek> Selecteer dagboek voor deze relatie
EOS
$ret .= _T( <<EOS ) if $dbh->does_btw;
--btw=<type> BTW type: normaal, verlegd, intra, extra
*** BTW type 'verlegd' wordt nog niet ondersteund ***
*** BTW type 'intra' wordt nog niet geheel ondersteund ***
EOS
$ret;
}
################ Im/export ################
sub do_export {
my ($self, @args) = @_;
my $opts = { single => 0,
explicit => 0,
totals => 1,
};
return unless
parse_args(\@args,
[ 'dir=s',
'file|output=s',
'boekjaar=s',
'titel=s',
'xaf=s',
'single',
'explicit',
'totals!',
], $opts)
or goto &help_export;
my $t = 0;
$t++ if defined($opts->{dir});
$t++ if defined($opts->{file});
$t++ if defined($opts->{xaf});
if ( $t > 1 ) {
warn("?"._T("Opties --dir, --file en --xaf sluiten elkaar uit")."\n");
return;
}
if ( $t != 1 ) {
warn("?"._T("Specificeer --dir, --file of --xaf")."\n");
return;
}
return unless argcnt(@args, 0);
check_open(1);
if ( $opts->{xaf} ) {
require EB::Export::XAF;
# XAF bevat altijd maar één boekjaar.
$opts->{boekjaar} ||= $bky;
EB::Export::XAF->export($opts);
}
else {
if ( $opts->{boekjaar} ) {
warn("?"._T("Optie --boekjaar wordt niet ondersteund door deze export")."\n");
return;
}
$opts->{desc} = delete $opts->{titel};
require EB::Export;
EB::Export->export($opts);
}
return;
}
sub help_export {
_T( <<EOS );
Exporteert de complete administratie.
export [ <opties> ]
Opties:
--file=<bestand> Selecteer uitvoerbestand
--dir=<directory> Selecteer uitvoerdirectory
--xaf=<bestand> Export XML Auditfile Financieel
--boekjaar=<code> Selecteer boekjaar (alleen met --xaf)
Er moet een --file, --dir of een --xaf optie worden opgegeven.
De XAF export exporteert altijd één enkel boekjaar. Voor de andere
exports wordt altijd de gehele administratie geëxporteerd.
Eventueel bestaande files worden overschreven.
EOS
}
sub do_import {
my ($self, @args) = @_;
return $self->clionly("import") if $app;
my $opts = { clean => 1,
};
return unless
parse_args(\@args,
[ 'dir=s',
'file=s',
'clean!',
], $opts);
if ( defined($opts->{dir}) && defined($opts->{file}) ) {
warn("?"._T("Opties --dir en --file sluiten elkaar uit")."\n");
return;
}
if ( !defined($opts->{dir}) && !defined($opts->{file}) ) {
warn("?"._T("Specificeer --dir of --file")."\n");
return;
}
return unless argcnt(scalar(@args), 0);
if ( $opts->{clean} && !$dbh->feature("import") ) {
warn("?".__x("Database type {drv} ondersteunt niet het import commando. Gebruik de --import command line optie.",
drv => $dbh->driverdb)."\n");
return;
}
require EB::Import;
EB::Import->do_import($self, $opts);
return;
}
sub help_import {
_T( <<EOS );
Importeert een complete, geëxporteerde administratie.
import [ <opties> ]
Opties:
--file=<bestand> Selecteer exportbestand
--dir=<directory> Selecteer exportdirectory
Er moet of een --file of een --dir optie worden opgegeven.
LET OP: IMPORT VERVANGT DE COMPLETE ADMINISTRATIE!
Deze opdracht wordt niet door alle database systemen ondersteund.
Deze opdracht is alleen in de command line versie beschikbaar.
EOS
}
sub do_include {
my ($self, @args) = @_;
my $opts = { optional => 0,
};
return unless
parse_args(\@args,
[ 'optional|optioneel',
], $opts);
return unless argcnt(scalar(@args), 1);
my $file = shift(@args);
# Note: no :encoding, this is handled by the input loop.
if ( open(my $fd, '<', $file) ) {
$self->attach_file($fd);
}
elsif ( !$opts->{optional} ) {
die("$file: $!\n");
}
""
}
sub help_include {
_T( <<EOS );
Leest opdrachten uit een bestand.
include [ <opties> ] <bestand>
Opties:
--optioneel Het bestand mag ontbreken. De opdracht
wordt dan verder genegeerd.
EOS
}
################ Miscellaneous ################
sub do_boekjaar {
my ($self, @args) = @_;
return unless argcnt(@args, 1);
my $b = $dbh->lookup($args[0], qw(Boekjaren bky_code bky_name));
warn("?".__x("Onbekend boekjaar: {code}", code => $args[0])."\n"), return unless defined $b;
$bky = $args[0];
bky_msg();
__x("Boekjaar voor deze sessie: {bky} ({desc})", bky => $bky, desc => $b);
}
sub help_boekjaar {
_T( <<EOS );
Gebruik voor navolgende opdrachten het opgegeven boekjaar.
boekjaar <code>
EOS
}
sub do_dump_schema {
my ($self, @args) = @_;
_T( <<EOS );
Deze opdracht is vervallen. Gebruik in plaats daarvan "export".
EOS
}
sub do_verwijder {
my ($self, @args) = @_;
my $b = $bsk;
my $opts = { d_boekjaar => $bky || $dbh->adm("bky"),
};
return unless
parse_args(\@args,
[ 'boekjaar=s',
], $opts);
$opts->{boekjaar} = $opts->{d_boekjaar} unless defined $opts->{boekjaar};
require EB::Booking::Delete;
require EB::Booking::Decode;
@args = ($bsk) if $bsk && !@args;
return _T("Gaarne een boekstuk") unless @args == 1;
my $cmd;
my $id = shift(@args);
if ( $self->{interactive} ) {
(my $xid, my $id, my $err) = $dbh->bskid($id, $opts->{boekjaar});
unless ( defined($id) ) {
warn("?".$err."\n");
return;
}
$cmd = EB::Booking::Decode->decode($id, { boekjaar => $opts->{boekjaar}, trail => 1, bsknr => 1, single => 1 });
}
my $res = EB::Booking::Delete->new->perform($id, $opts);
if ( $res && $self->{interactive} && $res !~ /^[?!]/ ) { # no error
$self->term->addhistory($cmd);
}
$res;
}
sub help_verwijder {
_T( <<EOS );
Verwijdert een boekstuk. Het boekstuk mag niet in gebruik zijn.
verwijder [ <opties> ] <boekstuk>
Opties:
--boekjaar=<code> Selekteer boekjaar
Het verwijderde boekstuk wordt in de commando-historie geplaatst.
Met een pijltje-omhoog kan dit worden teruggehaald en na eventuele
wijziging opnieuw ingevoerd.
EOS
}
sub do_toon {
my ($self, @args) = @_;
my $b = $bsk;
my $opts = { verbose => 0,
bsknr => 1,
d_boekjaar => $bky || $dbh->adm("bky"),
};
return unless
parse_args(\@args,
[ 'btw!',
'bsknr!',
'bky!',
'totaal!',
'boekjaar=s',
'verbose!',
'trace!',
], $opts);
$opts->{trail} = !$opts->{verbose};
$opts->{boekjaar} = $opts->{d_boekjaar} unless defined $opts->{boekjaar};
require EB::Booking::Decode;
@args = ($bsk) if $bsk && !@args;
return _T("Gaarne een boekstuk") unless @args == 1;
my ($id, $dbs, $err) = $dbh->bskid(shift(@args), $opts->{boekjaar});
unless ( defined($id) ) {
warn("?".$err."\n");
return;
}
my $res = EB::Booking::Decode->decode($id, $opts);
if ( $self->{interactive} && $res !~ /^[?!]/ && $opts->{trail} ) { # no error
my $t = $res;
$t =~ s/\s+\\\s+/ /g;
$self->term->addhistory($t);
}
$res;
}
sub help_toon {
_T( <<EOS );
Toont een boekstuk in tekst- of commando-vorm.
toon [ <opties> ] <boekstuk>
Opties:
--boekjaar=<code> Selekteer boekjaar
--verbose Toon in uitgebreide (tekst) vorm
--btw Vermeld altijd BTW codes
--bsknr Vermeld altijd het boekstuknummer (default)
Het getoonde boekstuk wordt in de commando-historie geplaatst.
Met een pijltje-omhoog kan dit worden teruggehaald en na eventuele
wijziging opnieuw ingevoerd.
EOS
}
sub do_jaareinde {
my ($self, @args) = @_;
my $opts = { d_boekjaar => $bky,
};
return unless
parse_args(\@args,
[ 'boekjaar=s',
'definitief',
'verwijder',
'eb=s',
], $opts);
return _T("Opties \"definitief\" en \"verwijder\" sluiten elkaar uit")
if $opts->{definitief} && $opts->{verwijder};
return unless argcnt(@args, 0);
require EB::Tools::Einde;
EB::Tools::Einde->new->perform(\@args, $opts);
}
sub help_jaareinde {
_T( <<EOS );
Sluit het boekjaar af. De BTW rekeningen worden afgeboekt, en de
winst of het verlies wordt verrekend met de daartoe aangewezen
balansrekening.
Deze opdracht genereert twee rapporten: een journaal van de
afboekingen en een overzicht van eventuele openstaande posten. Indien
gewenst kan een bestand worden aangemaakt met openingsopdrachten voor
het volgende boekjaar.
jaareinde [ <opties> ]
Opties:
--boekjaar=<code> Sluit het opgegeven boekjaar af.
--definitief Sluit het boekjaar definitief af. Er zijn
dan geen boekingen meer mogelijk.
--verwijder Verwijder een niet-definitieve jaarafsluiting.
--eb=<bestand> Schrijf openingsopdrachten in dit bestand.
EOS
}
sub do_sql {
my ($self, @args) = @_;
return $self->clionly("sql") if $app;
$dbh->isql(@args);
undef;
}
sub help_sql {
_T( <<EOS );
Voer een SQL opdracht uit via de database driver. Met het gebruik
hiervan vervalt alle garantie op correcte financiële resultaten.
sql [ <opdracht> ]
Deze opdracht is alleen in de command line versie beschikbaar.
EOS
}
################ Argument parsing ################
use Getopt::Long;
sub parse_args {
my ($args, $ctl, $opts) = @_;
local(*ARGV) = $args;
Getopt::Long::Configure("prefix_pattern=--");
my $ret = GetOptions($opts, @$ctl);
$ret;
}
=begin maybelater
sub parse_args2 {
my ( $argv, $c, $opts ) = @_;
my @resarg;
my $ok = -1;
my $pfx = "cmo:" . $opts->{_cmd} . ":";
my @ctl = @$c;
my %ctl;
while ( my $ctl = shift(@ctl) ) {
my $dest;
my $needvalue = 0;
my $negate = 0;
if ( $ctl =~ /^(.*)=[is]$/ ) {
$ctl = $1;
$needvalue = 1;
}
elsif ( $ctl =~ /^(.*)!$/ ) {
$ctl = $1;
$negate = 1;
}
foreach ( split( /\|/, $ctl ) ) {
$dest ||= @ctl && ref($ctl[0]) ? shift(@ctl) : \($opts->{$_});
die("?".__x("Ongeldige optiespecificatie \"{opt}\"",
opt => $ctl), "\n"), return -1
unless /^[-\w]+$/;
$ctl{__xt($pfx.$_)} = [ $dest, $needvalue ];
$ctl{__xt($pfx."no".$_)} = [ $dest, -1 ] if $negate;
}
}
# print STDERR Dumper(\%ctl), "\n";
my $i = 0;
while ( $i < @$argv ) {
my $opt = $argv->[$i++];
unless ( $opt =~ /^--(.+)/ ) {
push( @resarg, $opt );
next;
}
$opt = $1;
my $has_value;
if ( $opt =~ /^(.*?)=(.*)/ ) {
$opt = $1;
$has_value = $2;
}
my $ctl;
unless ( $ctl = $ctl{$opt} ) {
die("?".__x("Onbekende optie: \"{opt}\"", opt => $opt)."\n");
$ok = 0;
next;
}
my $value = 1;
if ( $ctl->[1] < 0 ) { # negate
$value = 0;
}
elsif ( $ctl->[1] > 0 ) { # need value
if ( defined $has_value ) {
$value = $has_value;
}
elsif ( $i < @$argv && $argv->[$i] !~ /^--/ ) {
$value = $argv->[$i++];
}
else {
die("?".__x("Optie \"{opt}\" moet een waarde krijgen.", opt => $opt), "\n");
$ok = 0;
next;
}
}
elsif ( defined $has_value ) {
die("?".__x("Optie \"{opt}\" neemt geen waarde.", opt => $opt), "\n");
$ok = 0;
next;
}
my $dest = $ctl->[0];
if ( ref($dest) eq 'SCALAR' ) {
$$dest = $value;
}
elsif ( ref($dest) eq 'CODE' ) {
$dest->( $opt, $value );
}
else {
die("?".__x("Optie \"{opt}\" oeps {ref}.",
opt => $opt, ref => $dest), "\n");
$ok = 0;
}
}
# Copy remaining arguments.
@$argv = @resarg;
# Weed out undefined entries in $opts.
while ( my($k,$v) = each(%$opts) ) {
delete $opts->{$k} unless defined $v;
}
return $ok;
}
=cut
sub periode_arg {
my ($opts, $name, $value) = @_;
if ( my $p = parse_date_range($value, substr($dbh->adm("begin"),0,4)) ) {
$opts->{$name} = $p;
}
else {
die("?".__x("Ongeldige periode-aanduiding: {per}",
per => $value)."\n");
}
}
sub date_arg {
my ($opts, $name, $value) = @_;
if ( my $p = parse_date($value, substr($dbh->adm("begin"),0,4)) ) {
$opts->{$name} = $p;
}
else {
die("?".__x("Ongeldige datum: {per}",
per => $value)."\n");
}
}
sub check_open {
my ($self, $open) = @_;
$open = 1 unless defined($open);
if ( $open && !$dbh->adm_open ) {
die("?"._T("De administratie is nog niet geopend")."\n");
}
elsif ( !$open && $dbh->adm_open ) {
die("?"._T("De administratie is reeds geopend")."\n");
}
1;
}
sub check_busy {
my ($self, $busy) = @_;
$busy = 1 unless defined($busy);
if ( $busy && !$dbh->adm_busy ) {
die("?"._T("De administratie is nog niet in gebruik")."\n");
}
elsif ( !$busy && $dbh->adm_busy ) {
die("?"._T("De administratie is reeds in gebruik")."\n");
}
1;
}
1;