/usr/share/perl5/EB/Booking/Delete.pm is in eekboek 2.00.03-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 | #! perl
package main;
our $dbh;
our $spp;
our $config;
package EB::Booking::Delete;
# RCS Id : $Id: Delete.pm,v 1.13 2008/02/13 15:19:19 jv Exp $
# Author : Johan Vromans
# Created On : Mon Sep 19 22:19:05 2005
# Last Modified By: Johan Vromans
# Last Modified On: Wed Feb 13 16:13:19 2008
# Update Count : 85
# Status : Unknown, Use with caution!
################ Common stuff ################
use strict;
use warnings;
our $VERSION = sprintf "%d.%03d", q$Revision: 1.13 $ =~ /(\d+)/g;
use EB;
use base qw(EB::Booking);
sub new {
return bless {};
}
sub perform {
my ($self, $id, $opts) = @_;
my $sth;
my $rr;
my $orig = $id;
my $bky = $self->{bky} ||= $opts->{boekjaar} || $dbh->adm("bky");
my ($bsk, $dbsk, $err) = $dbh->bskid($id, $bky);
die("?$err\n") unless defined $bsk;
my $does_btw = $dbh->does_btw;
my ($dd) = @{$dbh->do("SELECT bsk_date".
" FROM Boekstukken".
" WHERE bsk_id = ?", $bsk)};
my ($begin, $end);
return unless ($begin, $end) = $self->begindate;
return unless $self->in_bky($dd, $begin, $end);
if ( $does_btw && $dbh->adm("btwbegin") && $dd lt $dbh->adm("btwbegin") ) {
my $r = $dbh->do("SELECT COUNT(*)".
" from Boekstukregels, Boekstukken".
" WHERE bsr_bsk_id = bsk_id".
" AND bsr_bsk_id = ?".
" AND ( bsr_btw_class != 0 OR bsr_btw_id != 0 )".
" LIMIT 1",
$bsk);
if ( $r && $r->[0] ) {
warn("?"._T("Deze boeking valt in de periode waarover al BTW aangifte is gedaan en kan niet meer worden verwijderd")."\n");
return;
}
}
# Check if this boekstuk is used by others. This can only be the
# case if has been paid.
my ($amt, $open, $dbk) = @{$dbh->do("SELECT bsk_amount,bsk_open,bsk_dbk_id".
" FROM Boekstukken".
" WHERE bsk_id = ?", $bsk)};
if ( defined($open) && $amt != $open ) {
# It has been paid. Show the user the list of bookstukken.
$sth = $dbh->sql_exec("SELECT dbk_desc, bsk_nr".
" FROM Boekstukken,Boekstukregels,Dagboeken".
" WHERE bsk_id = bsr_bsk_id".
" AND bsk_dbk_id = dbk_id".
" AND bsr_paid = ?", $bsk);
$rr = $sth->fetchall_arrayref;
if ( $rr ) {
my $t = "";
foreach ( @$rr ) {
$t .= join(":", @$_) . " ";
}
chomp($t);
return "?".__x("Boekstuk {bsk} is in gebruik door {lst}",
bsk => $dbsk, lst => $t)."\n";
}
}
# Collect list of affected boekstukken.
$sth = $dbh->sql_exec("SELECT bsr_paid,bsr_amount".
" FROM Boekstukregels".
" WHERE bsr_paid IS NOT NULL AND bsr_bsk_id = ?", $bsk);
$rr = $sth->fetchall_arrayref;
my @bsk; my @amt;
if ( $rr ) {
foreach ( @$rr ) {
push(@bsk, $_->[0]);
push(@amt, $_->[1]);
}
}
eval {
$dbh->begin_work;
# Adjust saldi grootboekrekeningen.
# Hoewel in veel gevallen niet nodig, is het toch noodzakelijk i.v.m.
# de saldi van bankrekeningen.
$sth = $dbh->sql_exec("SELECT jnl_acc_id, jnl_amount".
" FROM Journal".
" WHERE jnl_bsk_id = ? AND jnl_bsr_seq > 0", $bsk);
while ( my $rr = $sth->fetchrow_arrayref ) {
$dbh->upd_account($rr->[0], -$rr->[1]);
}
# Delete journal entries.
$dbh->sql_exec("DELETE FROM Journal".
" WHERE jnl_bsk_id = ?", $bsk)->finish;
# Clear 'paid' info.
$dbh->sql_exec("UPDATE Boekstukken".
" SET bsk_open = bsk_open - ?".
" WHERE bsk_id = ?", shift(@amt), $_)->finish
foreach @bsk;
# Delete boekstukregels.
$dbh->sql_exec("DELETE FROM Boekstukregels".
" WHERE bsr_bsk_id = ?", $bsk)->finish;
# Delete boekstuk.
$dbh->sql_exec("DELETE FROM Boekstukken".
" WHERE bsk_id = ?", $bsk)->finish;
# # Adjust saldi van boekingen na deze.
# $dbh->sql_exec("UPDATE Boekstukken".
# " SET bsk_saldo = bsk_saldo - ?".
# " WHERE bsk_saldo IS NOT NULL AND".
# " bsk_dbk_id = ? AND bsk_id > ?",
# $amt, $dbk, $bsk)->finish;
# If we get here, all went okay.
$dbh->commit;
};
if ( $@ ) {
# It didn't work. Shouldn't happen.
warn("?".$@);
$dbh->rollback;
return "?".__x("Boekstuk {bsk} niet verwijderd",
bsk => $dbsk)."\n";
}
return __x("Boekstuk {bsk} verwijderd",
bsk => $dbsk)."\n";
}
1;
|