File Coverage

blib/lib/EB/Report/Journal.pm
Criterion Covered Total %
statement 42 128 32.8
branch 0 72 0.0
condition 0 56 0.0
subroutine 14 24 58.3
pod 0 2 0.0
total 56 282 19.8


line stmt bran cond sub pod time code
1             #! perl
2              
3             # Author : Johan Vromans
4             # Created On : Sat Jun 11 13:44:43 2005
5             # Last Modified By: Johan Vromans
6             # Last Modified On: Fri Jun 8 22:38:39 2012
7             # Update Count : 340
8             # Status : Unknown, Use with caution!
9              
10             ################ Common stuff ################
11              
12             package main;
13              
14             our $cfg;
15             our $dbh;
16              
17             package EB::Report::Journal;
18              
19 1     1   4 use strict;
  1         1  
  1         20  
20 1     1   3 use warnings;
  1         1  
  1         18  
21              
22 1     1   3 use EB;
  1         1  
  1         146  
23 1     1   3 use EB::Format;
  1         1  
  1         89  
24 1     1   350 use EB::Booking; # for dcfromtd()
  1         2  
  1         64  
25 1     1   335 use EB::Report::GenBase;
  1         1  
  1         1037  
26              
27             sub new {
28 0     0 0   bless {}, shift;
29             }
30              
31             sub journal {
32 0     0 0   my ($self, $opts) = @_;
33              
34 0           my $nr = $opts->{select};
35 0   0       my $pfx = $opts->{postfix} || "";
36 0           my $detail = $opts->{detail};
37              
38 0 0         my $extra_btw_info = $cfg->val(qw(journal btwxinfo), $dbh->does_btw ? 1 : 0);
39              
40 0           $opts->{STYLE} = "journaal";
41             $opts->{LAYOUT} =
42 0 0         [ { name => "date", title => _T("Datum"), width => $date_width, },
43             { name => "desc", title => _T("Boekstuk/Grootboek"), width => 30, },
44             { name => "acct", title => _T("Rek"), width => 5, align => ">", },
45             { name => "deb", title => _T("Debet"), width => $amount_width, align => ">", },
46             { name => "crd", title => _T("Credit"), width => $amount_width, align => ">", },
47             $extra_btw_info ?
48             ({ name => "btw", title => _T("BTW \%"), width => $amount_width, align => ">", },
49             { name => "btg", title => _T("Tarief"), width => 10, }) : (),
50             { name => "bsk", title => _T("Boekstuk/regel"), width => 30, },
51             { name => "rel", title => _T("Relatie"), width => 10, },
52             ];
53              
54 0           my $rep = EB::Report::GenBase->backend($self, $opts);
55 0           my $per = $rep->{periode};
56 0 0         if ( my $t = $cfg->val(qw(internal now), 0) ) {
57 0 0         $per->[1] = $t if $t lt $per->[1];
58             }
59              
60             # Sort order (boekstukken).
61 0           my $so = join(", ",
62             "jnl_date", # date
63             "jnl_dbk_id", # dagboek
64             "bsk_nr", # boekstuk
65             "CASE WHEN jnl_seq = 0 THEN 0 ELSE 1 END",# bsr 0 eerst
66             "sign(jnl_amount) DESC", # debet eerst
67             "jnl_acc_id", # rekeningnummer
68             "jnl_amount DESC", # grootste bedragen vooraan
69             "jnl_type",
70             "jnl_seq"); # if all else fails
71              
72 0           $rep->start(_T("Journaal"));
73              
74 0           my $sth;
75 0 0         if ( $nr ) {
76 0 0         if ( $nr =~ /^([[:alpha:]].*):(\d+)$/ ) {
    0          
77 0           my $rr = $dbh->do("SELECT dbk_desc, dbk_id".
78             " FROM Dagboeken".
79             " WHERE dbk_desc ILIKE ?",
80             $1);
81 0 0         unless ( $rr ) {
82 0           warn("?".__x("Onbekend dagboek: {dbk}", dbk => $1)."\n");
83 0           return;
84             }
85 0 0         $sth = $dbh->sql_exec("SELECT jnl_date, jnl_bsr_date, jnl_dbk_id, jnl_bsk_id, bsk_nr, jnl_bsr_seq, jnl_seq, ".
    0          
86             "jnl_type, jnl_acc_id, jnl_amount, jnl_damount, jnl_desc, jnl_rel, jnl_bsk_ref".
87             " FROM Journal, Boekstukken, Dagboeken".
88             " WHERE bsk_nr = ?".
89             " AND dbk_id = ?".
90             " AND jnl_bsk_id = bsk_id".
91             " AND jnl_dbk_id = dbk_id".
92             ($per ? " AND jnl_date >= ? AND jnl_date <= ?" : "").
93             " ORDER BY ".$so,
94             $2, $rr->[1], $per ? @$per : ());
95 0   0       $pfx ||= __x("Boekstuk {nr}", nr => "$rr->[0]:$2");
96             }
97             elsif ( $nr =~ /^([[:alpha:]].*)$/ ) {
98 0           my $rr = $dbh->do("SELECT dbk_desc, dbk_id".
99             " FROM Dagboeken".
100             " WHERE dbk_desc ILIKE ?",
101             $1);
102 0 0         unless ( $rr ) {
103 0           warn("?".__x("Onbekend dagboek: {dbk}", dbk => $1)."\n");
104 0           return;
105             }
106 0 0         $sth = $dbh->sql_exec("SELECT jnl_date, jnl_bsr_date, jnl_dbk_id, jnl_bsk_id, bsk_nr, jnl_bsr_seq, jnl_seq, ".
    0          
107             "jnl_type, jnl_acc_id, jnl_amount, jnl_damount, jnl_desc, jnl_rel, jnl_bsk_ref".
108             " FROM Journal, Boekstukken, Dagboeken".
109             " WHERE dbk_id = ?".
110             " AND jnl_bsk_id = bsk_id".
111             " AND jnl_dbk_id = dbk_id".
112             ($per ? " AND jnl_date >= ? AND jnl_date <= ?" : "").
113             " ORDER BY ".$so,
114             $rr->[1], $per ? @$per : ());
115 0   0       $pfx ||= __x("Dagboek {nr}", nr => $rr->[0]);
116             }
117             else {
118 0 0         $sth = $dbh->sql_exec("SELECT jnl_date, jnl_bsr_date, jnl_dbk_id, jnl_bsk_id, bsk_nr, jnl_bsr_seq, jnl_seq, ".
    0          
119             "jnl_type, jnl_acc_id, jnl_amount, jnl_damount, jnl_desc, jnl_rel".
120             " FROM Journal, Boekstukken".
121             " WHERE jnl_bsk_id = ?".
122             " AND jnl_bsk_id = bsk_id".
123             ($per ? " AND jnl_date >= ? AND jnl_date <= ?" : "").
124             " ORDER BY ".$so,,
125             $nr, $per ? @$per : ());
126 0   0       $pfx ||= __x("Boekstuk {nr}", nr => $nr);
127             }
128             }
129             else {
130 0 0         $sth = $dbh->sql_exec("SELECT jnl_date, jnl_bsr_date, jnl_dbk_id, jnl_bsk_id, bsk_nr, jnl_bsr_seq, jnl_seq, ".
    0          
131             "jnl_type, jnl_acc_id, jnl_amount, jnl_damount, jnl_desc, jnl_rel, jnl_bsk_ref".
132             " FROM Journal, Boekstukken".
133             " WHERE jnl_bsk_id = bsk_id".
134             ($per ? " AND jnl_date >= ? AND jnl_date <= ?" : "").
135             " ORDER BY ".$so,
136             $per ? @$per : ());
137             }
138 0           my $rr;
139 0           my $nl = 0;
140 0           my $totd = my $totc = 0;
141              
142 0           while ( $rr = $sth->fetchrow_arrayref ) {
143 0           my ($jnl_date, $jnl_bsr_date, $jnl_dbk_id, $jnl_bsk_id, $bsk_nr,
144             $jnl_bsr_seq, $jnl_seq, $jnl_type, $jnl_acc_id,
145             $jnl_amount, $jnl_damount, $jnl_desc, $jnl_rel, $jnl_bsk_ref) = @$rr;
146              
147 0 0         my $iv = _dbk_type($jnl_dbk_id) == DBKTYPE_INKOOP ? 'c'
    0          
148             : _dbk_type($jnl_dbk_id) == DBKTYPE_VERKOOP ? 'd' : '';
149              
150 0 0         if ( $jnl_seq == 0 ) {
151 0 0         $nl++, next unless $detail;
152 0           my $t = $jnl_rel;
153 0 0 0       if ( $t && $jnl_bsk_ref ) {
154 0           $t .= ":" . $jnl_bsk_ref;
155             }
156 0 0 0       if ( $iv && $cfg->val(qw(internal noxrel), 0) ) {
157 0           undef $t;
158             }
159 0           $rep->add({ _style => $iv.'head',
160             date => datefmt($jnl_bsr_date),
161             desc => join(":", _dbk_desc($jnl_dbk_id), $bsk_nr),
162             bsk => $jnl_desc,
163             rel => $t,
164             });
165 0           next;
166             }
167              
168 0           my ($deb, $crd) = EB::Booking::dcfromtd($jnl_amount, $jnl_damount);
169 0           $totd += $deb;
170 0           $totc += $crd;
171 0 0         next unless $detail;
172 0           my $t = $jnl_rel;
173 0 0 0       if ( $t && $jnl_bsk_ref ) {
174 0           $t .= ":" . $jnl_bsk_ref;
175             }
176 0 0         if ( $t ) {
177 0 0         $iv = _acc_type($jnl_acc_id) ? 'd' : 'c';
178             }
179             else {
180 0           $iv = '';
181             }
182              
183 0           my $btw_perc = "";
184 0           my $btw_tg = "";
185 0 0 0       if ( $extra_btw_info > 1
      0        
      0        
186             || ( $extra_btw_info && defined($jnl_type) && $jnl_type == 0 ) ) {
187 0           my $res = $dbh->do( "SELECT bsr_btw_id, bsr_btw_class FROM Boekstukregels".
188             " WHERE bsr_bsk_id = ? AND bsr_nr = ?",
189             $jnl_bsk_id, $jnl_bsr_seq );
190 0 0 0       if ( defined($res) && defined($res->[0])
      0        
      0        
191             && defined($res->[1])
192             && $res->[1] & BTWKLASSE_BTW_BIT ) {
193 0           my $btw_id = $res->[0];
194 0           $res = $dbh->do( "SELECT btw_perc, btw_tariefgroep".
195             " FROM BTWTabel".
196             " WHERE btw_id = ?",
197             $btw_id );
198 0           $btw_perc = btwfmt( $res->[0] );
199 0           $btw_tg = BTWTARIEVEN->[$res->[1]];
200             }
201             }
202              
203              
204 0 0 0       $rep->add({ _style => $iv.'data',
    0 0        
    0          
    0          
205             date => datefmt($jnl_bsr_date),
206             desc => _acc_desc($jnl_acc_id),
207             acct => $jnl_acc_id,
208             ($deb || defined $jnl_damount) ? (deb => numfmt($deb)) : (),
209             ($crd || defined $jnl_damount) ? (crd => numfmt($crd)) : (),
210             bsk => $jnl_desc,
211             $jnl_rel ? ( rel => $t ) : (),
212             $extra_btw_info ? ( btw => $btw_perc, btg => $btw_tg ) : (),
213             });
214             }
215 0           $rep->add({ _style => 'total',
216             desc => __x("Totaal {pfx}", pfx => $pfx),
217             deb => numfmt($totd),
218             crd => numfmt($totc),
219             });
220 0           $rep->finish;
221             }
222              
223             my %dbk_desc;
224             sub _dbk_desc {
225 0   0 0     $dbk_desc{$_[0]} ||= $dbh->lookup($_[0],
226             qw(Dagboeken dbk_id dbk_desc =));
227             }
228              
229             my %dbk_type;
230             sub _dbk_type {
231 0   0 0     $dbk_type{$_[0]} ||= $dbh->lookup($_[0],
232             qw(Dagboeken dbk_id dbk_type =));
233             }
234              
235             my %acc_desc;
236             sub _acc_desc {
237 0 0   0     return '' unless $_[0];
238 0   0       $acc_desc{$_[0]} ||= $dbh->lookup($_[0],
239             qw(Accounts acc_id acc_desc =));
240             }
241              
242             my %acc_type;
243             sub _acc_type {
244 0 0   0     return '' unless $_[0];
245 0   0       $acc_type{$_[0]} ||= $dbh->lookup($_[0],
246             qw(Accounts acc_id acc_debcrd =));
247             }
248              
249             package EB::Report::Journal::Text;
250              
251 1     1   5 use EB;
  1         2  
  1         188  
252 1     1   5 use base qw(EB::Report::Reporter::Text);
  1         1  
  1         418  
253 1     1   5 use strict;
  1         1  
  1         102  
254              
255             sub new {
256 0     0     my ($class, $opts) = @_;
257 0           $class->SUPER::new($opts->{STYLE}, $opts->{LAYOUT});
258             }
259              
260             # Style mods.
261              
262             sub style {
263 0     0     my ($self, $row, $cell) = @_;
264              
265 0           my $style_data = {
266             _style => { skip_after => 1,
267             cancel_skip => 1,
268             },
269             desc => { indent => 2 },
270             bsk => { indent => 2 },
271             };
272              
273 0           my $stylesheet = {
274             data => $style_data,
275             cdata => $style_data,
276             ddata => $style_data,
277             total => {
278             _style => { line_before => 1 },
279             # desc => { excess => 2 },
280             },
281             };
282              
283 0 0         $cell = "_style" unless defined($cell);
284 0           return $stylesheet->{$row}->{$cell};
285             }
286              
287             package EB::Report::Journal::Html;
288              
289 1     1   4 use EB;
  1         1  
  1         168  
290 1     1   4 use base qw(EB::Report::Reporter::Html);
  1         1  
  1         400  
291 1     1   4 use strict;
  1         1  
  1         50  
292              
293             sub new {
294 0     0     my ($class, $opts) = @_;
295 0           $class->SUPER::new($opts->{STYLE}, $opts->{LAYOUT});
296             }
297              
298             package EB::Report::Journal::Csv;
299              
300 1     1   3 use EB;
  1         1  
  1         161  
301 1     1   4 use base qw(EB::Report::Reporter::Csv);
  1         0  
  1         397  
302              
303             sub new {
304 0     0     my ($class, $opts) = @_;
305 0           $class->SUPER::new($opts->{STYLE}, $opts->{LAYOUT});
306             }
307              
308             1;
309