fix FSF address
[kivitendo-erp.git] / SL / IC.pm
1 #=====================================================================
2 # LX-Office ERP
3 # Copyright (C) 2004
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
6 #
7 #=====================================================================
8 # SQL-Ledger Accounting
9 # Copyright (C) 2001
10 #
11 #  Author: Dieter Simader
12 #   Email: dsimader@sql-ledger.org
13 #     Web: http://www.sql-ledger.org
14 #
15 #  Contributors:
16 #
17 # This program is free software; you can redistribute it and/or modify
18 # it under the terms of the GNU General Public License as published by
19 # the Free Software Foundation; either version 2 of the License, or
20 # (at your option) any later version.
21 #
22 # This program is distributed in the hope that it will be useful,
23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
25 # GNU General Public License for more details.
26 # You should have received a copy of the GNU General Public License
27 # along with this program; if not, write to the Free Software
28 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
29 # MA 02110-1335, USA.
30 #======================================================================
31 #
32 # Inventory Control backend
33 #
34 #======================================================================
35
36 package IC;
37
38 use Data::Dumper;
39 use List::MoreUtils qw(all any uniq);
40 use YAML;
41
42 use SL::CVar;
43 use SL::DBUtils;
44 use SL::HTML::Restrict;
45 use SL::TransNumber;
46 use SL::Util qw(trim);
47 use SL::DB;
48 use Carp;
49
50 use strict;
51
52 sub get_pricegroups {
53   $main::lxdebug->enter_sub();
54
55   my ($self, $myconfig, $form) = @_;
56
57   my $dbh = $form->get_standard_dbh;
58
59   # get pricegroups
60   my $query = qq|SELECT id, pricegroup FROM pricegroup ORDER BY lower(pricegroup)|;
61   my $pricegroups = selectall_hashref_query($form, $dbh, $query);
62
63   my $i = 1;
64   foreach my $pg (@{ $pricegroups }) {
65     $form->{"price_$i"}         = $form->format_amount($myconfig, $form->{"price_$i"}, -2);
66     $form->{"pricegroup_id_$i"} = "$pg->{id}";
67     $form->{"pricegroup_$i"}    = "$pg->{pricegroup}";
68     $i++;
69   }
70
71   #correct rows
72   $form->{price_rows} = $i - 1;
73
74   $main::lxdebug->leave_sub();
75
76   return $pricegroups;
77 }
78
79 sub retrieve_buchungsgruppen {
80   $main::lxdebug->enter_sub();
81
82   my ($self, $myconfig, $form) = @_;
83
84   my ($query, $sth);
85
86   my $dbh = $form->get_standard_dbh;
87
88   # get buchungsgruppen
89   $query = qq|SELECT id, description FROM buchungsgruppen ORDER BY sortkey|;
90   $form->{BUCHUNGSGRUPPEN} = selectall_hashref_query($form, $dbh, $query);
91
92   $main::lxdebug->leave_sub();
93 }
94
95 sub assembly_item {
96   $main::lxdebug->enter_sub();
97
98   my ($self, $myconfig, $form) = @_;
99
100   my $i = $form->{assembly_rows};
101   my $var;
102   my $where = qq|1 = 1|;
103   my @values;
104
105   my %columns = ("partnumber" => "p", "description" => "p", "partsgroup" => "pg");
106
107   while (my ($column, $table) = each(%columns)) {
108     next unless ($form->{"${column}_$i"});
109     $where .= qq| AND ${table}.${column} ILIKE ?|;
110     push(@values, like($form->{"${column}_$i"}));
111   }
112
113   if ($form->{id}) {
114     $where .= qq| AND NOT (p.id = ?)|;
115     push(@values, conv_i($form->{id}));
116   }
117
118   # Search for part ID overrides all other criteria.
119   if ($form->{"id_${i}"}) {
120     $where  = qq|p.id = ?|;
121     @values = ($form->{"id_${i}"});
122   }
123
124   if ($form->{partnumber}) {
125     $where .= qq| ORDER BY p.partnumber|;
126   } else {
127     $where .= qq| ORDER BY p.description|;
128   }
129
130   my $query =
131     qq|SELECT p.id, p.partnumber, p.description, p.sellprice,
132        p.weight, p.onhand, p.unit, pg.partsgroup, p.lastcost,
133        p.price_factor_id, pfac.factor AS price_factor, p.notes as longdescription
134        FROM parts p
135        LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
136        LEFT JOIN price_factors pfac ON pfac.id = p.price_factor_id
137        WHERE $where|;
138   $form->{item_list} = selectall_hashref_query($form, SL::DB->client->dbh, $query, @values);
139
140   $main::lxdebug->leave_sub();
141 }
142
143 #
144 # Report for Wares.
145 # Warning, deep magic ahead.
146 # This function gets all parts from the database according to the filters specified
147 #
148 # specials:
149 #   sort revers  - sorting field + direction
150 #   top100
151 #
152 # simple filter strings (every one of those also has a column flag prefixed with 'l_' associated):
153 #   partnumber ean description partsgroup microfiche drawing
154 #
155 # column flags:
156 #   l_partnumber l_description l_listprice l_sellprice l_lastcost l_priceupdate l_weight l_unit l_rop l_image l_drawing l_microfiche l_partsgroup
157 #
158 # exclusives:
159 #   itemstatus  = active | onhand | short | obsolete | orphaned
160 #   searchitems = part | assembly | service
161 #
162 # joining filters:
163 #   make model                               - makemodel
164 #   serialnumber transdatefrom transdateto   - invoice/orderitems
165 #
166 # binary flags:
167 #   bought sold onorder ordered rfq quoted   - aggreg joins with invoices/orders
168 #   l_linetotal l_subtotal                   - aggreg joins to display totals (complicated) - NOT IMPLEMENTED here, implementation at frontend
169 #   l_soldtotal                              - aggreg join to display total of sold quantity
170 #   onhand                                   - as above, but masking the simple itemstatus results (doh!)
171 #   short                                    - NOT IMPLEMENTED as form filter, only as itemstatus option
172 #   l_serialnumber                           - belonges to serialnumber filter
173 #   l_deliverydate                           - displays deliverydate is sold etc. flags are active
174 #   l_soldtotal                              - aggreg join to display total of sold quantity, works as long as there's no bullshit in soldtotal
175 #
176 # not working:
177 #   onhand                                   - as above, but masking the simple itemstatus results (doh!)
178 #   warehouse onhand
179 #   search by overrides of description
180 #
181 # disabled sanity checks and changes:
182 #  - searchitems = assembly will no longer disable bought
183 #  - searchitems = service  will no longer disable make and model, although services don't have make/model, it doesn't break the query
184 #  - itemstatus  = orphaned will no longer disable onhand short bought sold onorder ordered rfq quoted transdate[from|to]
185 #  - itemstatus  = obsolete will no longer disable onhand, short
186 #  - allow sorting by ean
187 #  - serialnumber filter also works if l_serialnumber isn't ticked
188 #  - sorting will now change sorting if the requested sorting column isn't checked and doesn't get checked as a side effect
189 #
190 sub all_parts {
191   $main::lxdebug->enter_sub();
192
193   my ($self, $myconfig, $form) = @_;
194   my $dbh = $form->get_standard_dbh($myconfig);
195
196   $form->{parts}     = +{ };
197   $form->{soldtotal} = undef if $form->{l_soldtotal}; # security fix. top100 insists on putting strings in there...
198
199   my @simple_filters       = qw(partnumber ean description partsgroup microfiche drawing onhand);
200   my @project_filters      = qw(projectnumber projectdescription);
201   my @makemodel_filters    = qw(make model);
202   my @invoice_oi_filters   = qw(serialnumber soldtotal);
203   my @apoe_filters         = qw(transdate);
204   my @like_filters         = (@simple_filters, @invoice_oi_filters);
205   my @all_columns          = (@simple_filters, @makemodel_filters, @apoe_filters, @project_filters, qw(serialnumber));
206   my @simple_l_switches    = (@all_columns, qw(notes listprice sellprice lastcost priceupdate weight unit rop image shop insertdate));
207   my @oe_flags             = qw(bought sold onorder ordered rfq quoted);
208   my @qsooqr_flags         = qw(invnumber ordnumber quonumber trans_id name module qty);
209   my @deliverydate_flags   = qw(deliverydate);
210 #  my @other_flags          = qw(onhand); # ToDO: implement these
211 #  my @inactive_flags       = qw(l_subtotal short l_linetotal);
212
213   my @select_tokens = qw(id factor);
214   my @where_tokens  = qw(1=1);
215   my @group_tokens  = ();
216   my @bind_vars     = ();
217   my %joins_needed  = ();
218
219   my %joins = (
220     partsgroup => 'LEFT JOIN partsgroup pg      ON (pg.id       = p.partsgroup_id)',
221     makemodel  => 'LEFT JOIN makemodel mm       ON (mm.parts_id = p.id)',
222     pfac       => 'LEFT JOIN price_factors pfac ON (pfac.id     = p.price_factor_id)',
223     invoice_oi =>
224       q|LEFT JOIN (
225          SELECT parts_id, description, serialnumber, trans_id, unit, sellprice, qty,          assemblyitem,         deliverydate, 'invoice'    AS ioi, project_id, id FROM invoice UNION
226          SELECT parts_id, description, serialnumber, trans_id, unit, sellprice, qty, FALSE AS assemblyitem, NULL AS deliverydate, 'orderitems' AS ioi, project_id, id FROM orderitems
227        ) AS ioi ON ioi.parts_id = p.id|,
228     apoe       =>
229       q|LEFT JOIN (
230          SELECT id, transdate, 'ir' AS module, ordnumber, quonumber,         invnumber, FALSE AS quotation, NULL AS customer_id,         vendor_id,    NULL AS deliverydate, globalproject_id, 'invoice'    AS ioi FROM ap UNION
231          SELECT id, transdate, 'is' AS module, ordnumber, quonumber,         invnumber, FALSE AS quotation,         customer_id, NULL AS vendor_id,            deliverydate, globalproject_id, 'invoice'    AS ioi FROM ar UNION
232          SELECT id, transdate, 'oe' AS module, ordnumber, quonumber, NULL AS invnumber,          quotation,         customer_id,         vendor_id, reqdate AS deliverydate, globalproject_id, 'orderitems' AS ioi FROM oe
233        ) AS apoe ON ((ioi.trans_id = apoe.id) AND (ioi.ioi = apoe.ioi))|,
234     cv         =>
235       q|LEFT JOIN (
236            SELECT id, name, 'customer' AS cv FROM customer UNION
237            SELECT id, name, 'vendor'   AS cv FROM vendor
238          ) AS cv ON cv.id = apoe.customer_id OR cv.id = apoe.vendor_id|,
239     mv         => 'LEFT JOIN vendor AS mv ON mv.id = mm.make',
240     project    => 'LEFT JOIN project AS pj ON pj.id = COALESCE(ioi.project_id, apoe.globalproject_id)',
241   );
242   my @join_order = qw(partsgroup makemodel mv invoice_oi apoe cv pfac project);
243
244   my %table_prefix = (
245      deliverydate => 'apoe.', serialnumber => 'ioi.',
246      transdate    => 'apoe.', trans_id     => 'ioi.',
247      module       => 'apoe.', name         => 'cv.',
248      ordnumber    => 'apoe.', make         => 'mm.',
249      quonumber    => 'apoe.', model        => 'mm.',
250      invnumber    => 'apoe.', partsgroup   => 'pg.',
251      lastcost     => 'p.',  , soldtotal    => ' ',
252      factor       => 'pfac.', projectnumber => 'pj.',
253      'SUM(ioi.qty)' => ' ',   projectdescription => 'pj.',
254      description  => 'p.',
255      qty          => 'ioi.',
256      serialnumber => 'ioi.',
257      quotation    => 'apoe.',
258      cv           => 'cv.',
259      "ioi.id"     => ' ',
260      "ioi.ioi"    => ' ',
261   );
262
263   # if the join condition in these blocks are met, the column
264   # of the scecified table will gently override (coalesce actually) the original value
265   # use it to conditionally coalesce values from subtables
266   my @column_override = (
267     #  column name,   prefix,  joins_needed,  nick name (in case column is named like another)
268     [ 'description',  'ioi.',  'invoice_oi'  ],
269     [ 'deliverydate', 'ioi.',  'invoice_oi'  ],
270     [ 'transdate',    'apoe.', 'apoe'        ],
271     [ 'unit',         'ioi.',  'invoice_oi'  ],
272     [ 'sellprice',    'ioi.',  'invoice_oi'  ],
273   );
274
275   # careful with renames. these are HARD, and any filters done on the original column will break
276   my %renamed_columns = (
277     'factor'       => 'price_factor',
278     'SUM(ioi.qty)' => 'soldtotal',
279     'ioi.id'       => 'ioi_id',
280     'ioi.ioi'      => 'ioi',
281     'projectdescription' => 'projectdescription',
282     'insertdate'   => 'insertdate',
283   );
284
285   my %real_column = (
286     projectdescription => 'description',
287     insertdate         => 'itime::DATE',
288   );
289
290   if (($form->{searchitems} eq 'assembly') && $form->{l_lastcost}) {
291     @simple_l_switches = grep { $_ ne 'lastcost' } @simple_l_switches;
292   }
293
294   my $make_token_builder = sub {
295     my $joins_needed = shift;
296     sub {
297       my ($nick, $alias) = @_;
298       my ($col) = $real_column{$nick} || $nick;
299       my @coalesce_tokens =
300         map  { ($_->[1] || 'p.') . $_->[0] }
301         grep { !$_->[2] || $joins_needed->{$_->[2]} }
302         grep { ($_->[3] || $_->[0]) eq $nick }
303         @column_override, [ $col, $table_prefix{$nick}, undef , $nick ];
304
305       my $coalesce = scalar @coalesce_tokens > 1;
306       return ($coalesce
307         ? sprintf 'COALESCE(%s)', join ', ', @coalesce_tokens
308         : shift                              @coalesce_tokens)
309         . ($alias && ($coalesce || $renamed_columns{$nick})
310         ?  " AS " . ($renamed_columns{$nick} || $nick)
311         : '');
312     }
313   };
314
315   #===== switches and simple filters ========#
316
317   # special case transdate
318   if (grep { trim($form->{$_}) } qw(transdatefrom transdateto)) {
319     $form->{"l_transdate"} = 1;
320     push @select_tokens, 'transdate';
321     for (qw(transdatefrom transdateto)) {
322       my $value = trim($form->{$_});
323       next unless $value;
324       push @where_tokens, sprintf "transdate %s ?", /from$/ ? '>=' : '<=';
325       push @bind_vars,    $value;
326     }
327   }
328
329   # special case smart search
330   if ($form->{all}) {
331     $form->{"l_$_"} = 1 for qw(partnumber description unit sellprice lastcost cvar_packaging linetotal);
332     push @where_tokens, "p.partnumber ILIKE ? OR p.description ILIKE ?";
333     push @bind_vars,    (like($form->{all})) x 2;
334   }
335
336   # special case insertdate
337   if (grep { trim($form->{$_}) } qw(insertdatefrom insertdateto)) {
338     $form->{"l_insertdate"} = 1;
339     push @select_tokens, 'insertdate';
340
341     my $token_builder = $make_token_builder->();
342     my $token = $token_builder->('insertdate');
343
344     for (qw(insertdatefrom insertdateto)) {
345       my $value = trim($form->{$_});
346       next unless $value;
347       push @where_tokens, sprintf "$token %s ?", /from$/ ? '>=' : '<=';
348       push @bind_vars,    $value;
349     }
350   }
351
352   if ($form->{"partsgroup_id"}) {
353     $form->{"l_partsgroup"} = '1'; # show the column
354     push @where_tokens, "pg.id = ?";
355     push @bind_vars, $form->{"partsgroup_id"};
356   }
357
358   if ($form->{shop} ne '') {
359     $form->{l_shop} = '1'; # show the column
360     if ($form->{shop} eq '0' || $form->{shop} eq 'f') {
361       push @where_tokens, 'NOT p.shop';
362       $form->{shop} = 'f';
363     } else {
364       push @where_tokens, 'p.shop';
365     }
366   }
367
368   foreach (@like_filters) {
369     next unless $form->{$_};
370     $form->{"l_$_"} = '1'; # show the column
371     push @where_tokens, "$table_prefix{$_}$_ ILIKE ?";
372     push @bind_vars,    like($form->{$_});
373   }
374
375   foreach (@simple_l_switches) {
376     next unless $form->{"l_$_"};
377     push @select_tokens, $_;
378   }
379
380   for ($form->{searchitems}) {
381     push @where_tokens, "p.part_type = 'part'"     if /part/;
382     push @where_tokens, "p.part_type = 'service'"  if /service/;
383     push @where_tokens, "p.part_type = 'assembly'" if /assembly/;
384   }
385
386   for ($form->{itemstatus}) {
387     push @where_tokens, 'p.id NOT IN
388         (SELECT DISTINCT parts_id FROM invoice UNION
389          SELECT DISTINCT parts_id FROM assembly UNION
390          SELECT DISTINCT parts_id FROM orderitems)'    if /orphaned/;
391     push @where_tokens, 'p.onhand = 0'                 if /orphaned/;
392     push @where_tokens, 'NOT p.obsolete'               if /active/;
393     push @where_tokens, '    p.obsolete',              if /obsolete/;
394     push @where_tokens, 'p.onhand > 0',                if /onhand/;
395     push @where_tokens, 'p.onhand < p.rop',            if /short/;
396   }
397
398   my $q_assembly_lastcost =
399     qq|(SELECT SUM(a_lc.qty * p_lc.lastcost / COALESCE(pfac_lc.factor, 1))
400         FROM assembly a_lc
401         LEFT JOIN parts p_lc            ON (a_lc.parts_id        = p_lc.id)
402         LEFT JOIN price_factors pfac_lc ON (p_lc.price_factor_id = pfac_lc.id)
403         WHERE (a_lc.id = p.id)) AS lastcost|;
404   $table_prefix{$q_assembly_lastcost} = ' ';
405
406   # special case makemodel search
407   # all_parts is based upon the assumption that every parameter is named like the column it represents
408   # unfortunately make would have to match vendor.name which is already taken for vendor.name in bsooqr mode.
409   # fortunately makemodel doesn't need to be displayed later, so adding a special clause to where_token is sufficient.
410   if ($form->{make}) {
411     push @where_tokens, 'mv.name ILIKE ?';
412     push @bind_vars, like($form->{make});
413   }
414   if ($form->{model}) {
415     push @where_tokens, 'mm.model ILIKE ?';
416     push @bind_vars, like($form->{model});
417   }
418
419   # special case: sorting by partnumber
420   # since partnumbers are expected to be prefixed integers, a special sorting is implemented sorting first lexically by prefix and then by suffix.
421   # and yes, that expression is designed to hold that array of regexes only once, so the map is kinda messy, sorry about that.
422   # ToDO: implement proper functional sorting
423   # Nette Idee von Sven, gibt aber Probleme wenn die Artikelnummern groesser als 32bit sind. Korrekt waere es, dass Sort-Natural-Modul zu nehmen
424   # Ich lass das mal hier drin, damit die Idee erhalten bleibt jb 28.5.2009 bug 1018
425   #$form->{sort} = join ', ', map { push @select_tokens, $_; ($table_prefix{$_} = "substring(partnumber,'[") . $_ } qw|^[:digit:]]+') [:digit:]]+')::INTEGER|
426   #  if $form->{sort} eq 'partnumber';
427
428   #my $order_clause = " ORDER BY $form->{sort} $sort_order";
429
430   my $limit_clause;
431   $limit_clause = " LIMIT 100"                   if $form->{top100};
432   $limit_clause = " LIMIT " . $form->{limit} * 1 if $form->{limit} * 1;
433
434   #=== joins and complicated filters ========#
435
436   my $bsooqr        = any { $form->{$_} } @oe_flags;
437   my @bsooqr_tokens = ();
438
439   push @select_tokens, @qsooqr_flags, 'quotation', 'cv', 'ioi.id', 'ioi.ioi'  if $bsooqr;
440   push @select_tokens, @deliverydate_flags                                    if $bsooqr && $form->{l_deliverydate};
441   push @select_tokens, $q_assembly_lastcost                                   if ($form->{searchitems} eq 'assembly') && $form->{l_lastcost};
442   push @bsooqr_tokens, q|module = 'ir' AND NOT ioi.assemblyitem|              if $form->{bought};
443   push @bsooqr_tokens, q|module = 'is' AND NOT ioi.assemblyitem|              if $form->{sold};
444   push @bsooqr_tokens, q|module = 'oe' AND NOT quotation AND cv = 'customer'| if $form->{ordered};
445   push @bsooqr_tokens, q|module = 'oe' AND NOT quotation AND cv = 'vendor'|   if $form->{onorder};
446   push @bsooqr_tokens, q|module = 'oe' AND     quotation AND cv = 'customer'| if $form->{quoted};
447   push @bsooqr_tokens, q|module = 'oe' AND     quotation AND cv = 'vendor'|   if $form->{rfq};
448   push @where_tokens, join ' OR ', map { "($_)" } @bsooqr_tokens              if $bsooqr;
449
450   $joins_needed{partsgroup}  = 1;
451   $joins_needed{pfac}        = 1;
452   $joins_needed{project}     = 1 if grep { $form->{$_} || $form->{"l_$_"} } @project_filters;
453   $joins_needed{makemodel}   = 1 if grep { $form->{$_} || $form->{"l_$_"} } @makemodel_filters;
454   $joins_needed{mv}          = 1 if $joins_needed{makemodel};
455   $joins_needed{cv}          = 1 if $bsooqr;
456   $joins_needed{apoe}        = 1 if $joins_needed{project} || $joins_needed{cv}   || grep { $form->{$_} || $form->{"l_$_"} } @apoe_filters;
457   $joins_needed{invoice_oi}  = 1 if $joins_needed{project} || $joins_needed{apoe} || grep { $form->{$_} || $form->{"l_$_"} } @invoice_oi_filters;
458
459   # special case for description search.
460   # up in the simple filter section the description filter got interpreted as something like: WHERE description ILIKE '%$form->{description}%'
461   # now we'd like to search also for the masked description entered in orderitems and invoice, so...
462   # find the old entries in of @where_tokens and @bind_vars, and adjust them
463   if ($joins_needed{invoice_oi}) {
464     for (my ($wi, $bi) = (0)x2; $wi <= $#where_tokens; $bi++ if $where_tokens[$wi++] =~ /\?/) {
465       next unless $where_tokens[$wi] =~ /\bdescription ILIKE/;
466       splice @where_tokens, $wi, 1, 'p.description ILIKE ? OR ioi.description ILIKE ?';
467       splice @bind_vars,    $bi, 0, $bind_vars[$bi];
468       last;
469     }
470   }
471
472   # now the master trick: soldtotal.
473   if ($form->{l_soldtotal}) {
474     push @where_tokens, 'NOT ioi.qty = 0';
475     push @group_tokens, @select_tokens;
476      map { s/.*\sAS\s+//si } @group_tokens;
477     push @select_tokens, 'SUM(ioi.qty)';
478   }
479
480   #============= build query ================#
481
482   my $token_builder = $make_token_builder->(\%joins_needed);
483
484   my @sort_cols    = (@simple_filters, qw(id priceupdate onhand invnumber ordnumber quonumber name serialnumber soldtotal deliverydate insertdate shop));
485      $form->{sort} = 'id' unless grep { $form->{"l_$_"} } grep { $form->{sort} eq $_ } @sort_cols; # sort by id if unknown or invisible column
486   my $sort_order   = ($form->{revers} ? ' DESC' : ' ASC');
487   my $order_clause = " ORDER BY " . $token_builder->($form->{sort}) . ($form->{revers} ? ' DESC' : ' ASC');
488
489   my $select_clause = join ', ',    map { $token_builder->($_, 1) } @select_tokens;
490   my $join_clause   = join ' ',     @joins{ grep $joins_needed{$_}, @join_order };
491   my $where_clause  = join ' AND ', map { "($_)" } @where_tokens;
492   my $group_clause  = @group_tokens ? ' GROUP BY ' . join ', ',    map { $token_builder->($_) } @group_tokens : '';
493
494   my %oe_flag_to_cvar = (
495     bought   => 'invoice',
496     sold     => 'invoice',
497     onorder  => 'orderitems',
498     ordered  => 'orderitems',
499     rfq      => 'orderitems',
500     quoted   => 'orderitems',
501   );
502
503   my ($cvar_where, @cvar_values) = CVar->build_filter_query(
504     module         => 'IC',
505     trans_id_field => $bsooqr ? 'ioi.id': 'p.id',
506     filter         => $form,
507     sub_module     => $bsooqr ? [ uniq grep { $oe_flag_to_cvar{$form->{$_}} } @oe_flags ] : undef,
508   );
509
510   if ($cvar_where) {
511     $where_clause .= qq| AND ($cvar_where)|;
512     push @bind_vars, @cvar_values;
513   }
514
515   my $query = <<"  SQL";
516     SELECT DISTINCT $select_clause
517     FROM parts p
518     $join_clause
519     WHERE $where_clause
520     $group_clause
521     $order_clause
522     $limit_clause
523   SQL
524
525   $form->{parts} = selectall_hashref_query($form, $dbh, $query, @bind_vars);
526
527   map { $_->{onhand} *= 1 } @{ $form->{parts} };
528
529   # fix qty sign in ap. those are saved negative
530   if ($bsooqr && $form->{bought}) {
531     for my $row (@{ $form->{parts} }) {
532       $row->{qty} *= -1 if $row->{module} eq 'ir';
533     }
534   }
535
536   # post processing for assembly parts lists (bom)
537   # for each part get the assembly parts and add them into the partlist.
538   my @assemblies;
539   if ($form->{searchitems} eq 'assembly' && $form->{bom}) {
540     $query =
541       qq|SELECT p.id, p.partnumber, p.description, a.qty AS onhand,
542            p.unit, p.notes, p.itime::DATE as insertdate,
543            p.sellprice, p.listprice, p.lastcost,
544            p.rop, p.weight, p.priceupdate,
545            p.image, p.drawing, p.microfiche,
546            pfac.factor
547          FROM parts p
548          INNER JOIN assembly a ON (p.id = a.parts_id)
549          $joins{pfac}
550          WHERE a.id = ?|;
551     my $sth = prepare_query($form, $dbh, $query);
552
553     foreach my $item (@{ $form->{parts} }) {
554       push(@assemblies, $item);
555       do_statement($form, $sth, $query, conv_i($item->{id}));
556
557       while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
558         $ref->{assemblyitem} = 1;
559         map { $ref->{$_} /= $ref->{factor} || 1 } qw(sellprice listprice lastcost);
560         push(@assemblies, $ref);
561       }
562       $sth->finish;
563     }
564
565     # copy assemblies to $form->{parts}
566     $form->{parts} = \@assemblies;
567   }
568
569   if ($form->{l_pricegroups} ) {
570     my $query = <<SQL;
571        SELECT parts_id, price, pricegroup_id
572        FROM prices
573        WHERE parts_id = ?
574 SQL
575
576     my $sth = prepare_query($form, $dbh, $query);
577
578     foreach my $part (@{ $form->{parts} }) {
579       do_statement($form, $sth, $query, conv_i($part->{id}));
580
581       while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
582         $part->{"pricegroup_$ref->{pricegroup_id}"} = $ref->{price};
583       }
584       $sth->finish;
585     }
586   };
587
588
589   $main::lxdebug->leave_sub();
590
591   return @{ $form->{parts} };
592 }
593
594 sub _create_filter_for_priceupdate {
595   $main::lxdebug->enter_sub();
596
597   my $self     = shift;
598   my $myconfig = \%main::myconfig;
599   my $form     = $main::form;
600
601   my @where_values;
602   my $where = '1 = 1';
603
604   foreach my $item (qw(partnumber drawing microfiche make model pg.partsgroup)) {
605     my $column = $item;
606     $column =~ s/.*\.//;
607     next unless ($form->{$column});
608
609     $where .= qq| AND $item ILIKE ?|;
610     push(@where_values, like($form->{$column}));
611   }
612
613   foreach my $item (qw(description serialnumber)) {
614     next unless ($form->{$item});
615
616     $where .= qq| AND (${item} ILIKE ?)|;
617     push(@where_values, like($form->{$item}));
618   }
619
620
621   # items which were never bought, sold or on an order
622   if ($form->{itemstatus} eq 'orphaned') {
623     $where .=
624       qq| AND (p.onhand = 0)
625           AND p.id NOT IN
626             (
627               SELECT DISTINCT parts_id FROM invoice
628               UNION
629               SELECT DISTINCT parts_id FROM assembly
630               UNION
631               SELECT DISTINCT parts_id FROM orderitems
632             )|;
633
634   } elsif ($form->{itemstatus} eq 'active') {
635     $where .= qq| AND p.obsolete = '0'|;
636
637   } elsif ($form->{itemstatus} eq 'obsolete') {
638     $where .= qq| AND p.obsolete = '1'|;
639
640   } elsif ($form->{itemstatus} eq 'onhand') {
641     $where .= qq| AND p.onhand > 0|;
642
643   } elsif ($form->{itemstatus} eq 'short') {
644     $where .= qq| AND p.onhand < p.rop|;
645
646   }
647
648   foreach my $column (qw(make model)) {
649     next unless ($form->{$column});
650     $where .= qq| AND p.id IN (SELECT DISTINCT parts_id FROM makemodel WHERE $column ILIKE ?|;
651     push(@where_values, like($form->{$column}));
652   }
653
654   $main::lxdebug->leave_sub();
655
656   return ($where, @where_values);
657 }
658
659 sub get_num_matches_for_priceupdate {
660   $main::lxdebug->enter_sub();
661
662   my $self     = shift;
663
664   my $myconfig = \%main::myconfig;
665   my $form     = $main::form;
666
667   my $dbh      = $form->get_standard_dbh($myconfig);
668
669   my ($where, @where_values) = $self->_create_filter_for_priceupdate();
670
671   my $num_updated = 0;
672   my $query;
673
674   for my $column (qw(sellprice listprice)) {
675     next if ($form->{$column} eq "");
676
677     $query =
678       qq|SELECT COUNT(*)
679          FROM parts
680          WHERE id IN
681            (SELECT p.id
682             FROM parts p
683             LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
684             WHERE $where)|;
685     my ($result)  = selectfirst_array_query($form, $dbh, $query, @where_values);
686     $num_updated += $result if (0 <= $result);
687   }
688
689   $query =
690     qq|SELECT COUNT(*)
691        FROM prices
692        WHERE parts_id IN
693          (SELECT p.id
694           FROM parts p
695           LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
696           WHERE $where) AND (pricegroup_id = ?)|;
697   my $sth = prepare_query($form, $dbh, $query);
698
699   for my $i (1 .. $form->{price_rows}) {
700     next if ($form->{"price_$i"} eq "");
701
702     my ($result)  = do_statement($form, $sth, $query, @where_values, conv_i($form->{"pricegroup_id_$i"}));
703     $num_updated += $result if (0 <= $result);
704   }
705   $sth->finish();
706
707   $main::lxdebug->leave_sub();
708
709   return $num_updated;
710 }
711
712 sub update_prices {
713   my ($self, $myconfig, $form) = @_;
714   $main::lxdebug->enter_sub();
715
716   my $num_updated = SL::DB->client->with_transaction(\&_update_prices, $self, $myconfig, $form);
717
718   $main::lxdebug->leave_sub();
719   return $num_updated;
720 }
721
722 sub _update_prices {
723   my ($self, $myconfig, $form) = @_;
724
725   my ($where, @where_values) = $self->_create_filter_for_priceupdate();
726   my $num_updated = 0;
727
728   # connect to database
729   my $dbh = SL::DB->client->dbh;
730
731   for my $column (qw(sellprice listprice)) {
732     next if ($form->{$column} eq "");
733
734     my $value = $form->parse_amount($myconfig, $form->{$column});
735     my $operator = '+';
736
737     if ($form->{"${column}_type"} eq "percent") {
738       $value = ($value / 100) + 1;
739       $operator = '*';
740     }
741
742     my $query =
743       qq|UPDATE parts SET $column = $column $operator ?
744          WHERE id IN
745            (SELECT p.id
746             FROM parts p
747             LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
748             WHERE $where)|;
749     my $result    = do_query($form, $dbh, $query, $value, @where_values);
750     $num_updated += $result if (0 <= $result);
751   }
752
753   my $q_add =
754     qq|UPDATE prices SET price = price + ?
755        WHERE parts_id IN
756          (SELECT p.id
757           FROM parts p
758           LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
759           WHERE $where) AND (pricegroup_id = ?)|;
760   my $sth_add = prepare_query($form, $dbh, $q_add);
761
762   my $q_multiply =
763     qq|UPDATE prices SET price = price * ?
764        WHERE parts_id IN
765          (SELECT p.id
766           FROM parts p
767           LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
768           WHERE $where) AND (pricegroup_id = ?)|;
769   my $sth_multiply = prepare_query($form, $dbh, $q_multiply);
770
771   for my $i (1 .. $form->{price_rows}) {
772     next if ($form->{"price_$i"} eq "");
773
774     my $value = $form->parse_amount($myconfig, $form->{"price_$i"});
775     my $result;
776
777     if ($form->{"pricegroup_type_$i"} eq "percent") {
778       $result = do_statement($form, $sth_multiply, $q_multiply, ($value / 100) + 1, @where_values, conv_i($form->{"pricegroup_id_$i"}));
779     } else {
780       $result = do_statement($form, $sth_add, $q_add, $value, @where_values, conv_i($form->{"pricegroup_id_$i"}));
781     }
782
783     $num_updated += $result if (0 <= $result);
784   }
785
786   $sth_add->finish();
787   $sth_multiply->finish();
788
789   return $num_updated;
790 }
791
792 # get partnumber, description, unit, sellprice and soldtotal with choice through $sortorder for Top100
793 sub get_parts {
794   $main::lxdebug->enter_sub();
795
796   my ($self, $myconfig, $form, $sortorder) = @_;
797   my $dbh   = $form->get_standard_dbh;
798   my $order = qq| p.partnumber|;
799   my $where = qq|1 = 1|;
800   my @values;
801
802   if ($sortorder eq "all") {
803     $where .= qq| AND (partnumber ILIKE ?) AND (description ILIKE ?)|;
804     push(@values, like($form->{partnumber}), like($form->{description}));
805
806   } elsif ($sortorder eq "partnumber") {
807     $where .= qq| AND (partnumber ILIKE ?)|;
808     push(@values, like($form->{partnumber}));
809
810   } elsif ($sortorder eq "description") {
811     $where .= qq| AND (description ILIKE ?)|;
812     push(@values, like($form->{description}));
813     $order = "description";
814
815   }
816
817   my $query =
818     qq|SELECT id, partnumber, description, unit, sellprice
819        FROM parts
820        WHERE $where ORDER BY $order|;
821
822   my $sth = prepare_execute_query($form, $dbh, $query, @values);
823
824   my $j = 0;
825   while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
826     if (($ref->{partnumber} eq "*") && ($ref->{description} eq "")) {
827       next;
828     }
829
830     $j++;
831     $form->{"id_$j"}          = $ref->{id};
832     $form->{"partnumber_$j"}  = $ref->{partnumber};
833     $form->{"description_$j"} = $ref->{description};
834     $form->{"unit_$j"}        = $ref->{unit};
835     $form->{"sellprice_$j"}   = $ref->{sellprice};
836     $form->{"soldtotal_$j"}   = get_soldtotal($dbh, $ref->{id});
837   }    #while
838   $form->{rows} = $j;
839   $sth->finish;
840
841   $main::lxdebug->leave_sub();
842
843   return $self;
844 }    #end get_parts()
845
846 # gets sum of sold part with part_id
847 sub get_soldtotal {
848   $main::lxdebug->enter_sub();
849
850   my ($dbh, $id) = @_;
851
852   my $query = qq|SELECT sum(qty) FROM invoice WHERE parts_id = ?|;
853   my ($sum) = selectrow_query($main::form, $dbh, $query, conv_i($id));
854   $sum ||= 0;
855
856   $main::lxdebug->leave_sub();
857
858   return $sum;
859 }    #end get_soldtotal
860
861 sub follow_account_chain {
862   $main::lxdebug->enter_sub(2);
863
864   my ($self, $form, $dbh, $transdate, $accno_id, $accno) = @_;
865
866   my @visited_accno_ids = ($accno_id);
867
868   my ($query, $sth);
869
870   $form->{ACCOUNT_CHAIN_BY_ID} ||= {
871     map { $_->{id} => $_ }
872       selectall_hashref_query($form, $dbh, <<SQL, $transdate) };
873     SELECT c.id, c.new_chart_id, date(?) >= c.valid_from AS is_valid, cnew.accno
874     FROM chart c
875     LEFT JOIN chart cnew ON c.new_chart_id = cnew.id
876     WHERE NOT c.new_chart_id IS NULL AND (c.new_chart_id > 0)
877 SQL
878
879   while (1) {
880     my $ref = $form->{ACCOUNT_CHAIN_BY_ID}->{$accno_id};
881     last unless ($ref && $ref->{"is_valid"} &&
882                  !grep({ $_ == $ref->{"new_chart_id"} } @visited_accno_ids));
883     $accno_id = $ref->{"new_chart_id"};
884     $accno = $ref->{"accno"};
885     push(@visited_accno_ids, $accno_id);
886   }
887
888   $main::lxdebug->leave_sub(2);
889
890   return ($accno_id, $accno);
891 }
892
893 sub retrieve_accounts {
894   $main::lxdebug->enter_sub;
895
896   my $self     = shift;
897   my $myconfig = shift;
898   my $form     = shift;
899   my $dbh      = $form->get_standard_dbh;
900   my %args     = @_;     # index => part_id
901
902   $form->{taxzone_id} *= 1;
903
904   return unless grep $_, values %args; # shortfuse if no part_id supplied
905
906   # transdate madness.
907   my $transdate = "";
908   if ($form->{type} eq "invoice" or $form->{type} eq "credit_note") {
909     # use deliverydate for sales and purchase invoice, if it exists
910     # also use deliverydate for credit notes
911     if (!$form->{deliverydate}) {
912       $transdate = $form->{invdate};
913     } else {
914       $transdate = $form->{deliverydate};
915     }
916   } elsif ($form->{script} eq 'ir.pl') {
917     # when a purchase invoice is opened from the report of purchase invoices
918     # $form->{type} isn't set, but $form->{script} is, not sure why this is or
919     # whether this distinction matters in some other scenario. Otherwise one
920     # could probably take out this elsif and add a
921     # " or $form->{script} eq 'ir.pl' "
922     # to the above if-statement
923     if (!$form->{deliverydate}) {
924       $transdate = $form->{invdate};
925     } else {
926       $transdate = $form->{deliverydate};
927     }
928   } elsif (($form->{type} eq "credit_note") and $form->{deliverydate}) {
929     # if credit_note has a deliverydate, use this instead of invdate
930     # useful for credit_notes of invoices from an old period with different tax
931     # if there is no deliverydate then invdate is used, old default (see next elsif)
932     # Falls hier der Stichtag für Steuern anders bestimmt wird,
933     # entsprechend auch bei Taxkeys.pm anpassen
934     $transdate = $form->{deliverydate};
935   } elsif (($form->{type} eq "credit_note") || ($form->{script} eq 'ir.pl')) {
936     $transdate = $form->{invdate};
937   } else {
938     $transdate = $form->{transdate};
939   }
940
941   if ($transdate eq "") {
942     $transdate = DateTime->today_local->to_lxoffice;
943   } else {
944     $transdate = $dbh->quote($transdate);
945   }
946   #/transdate
947   my $inc_exp = $form->{"vc"} eq "customer" ? "income_accno_id" : "expense_accno_id";
948
949   my @part_ids = grep { $_ } values %args;
950   my $in       = join ',', ('?') x @part_ids;
951
952   my %accno_by_part = map { $_->{id} => $_ }
953     selectall_hashref_query($form, $dbh, <<SQL, @part_ids);
954     SELECT
955       p.id, p.part_type,
956       bg.inventory_accno_id,
957       tc.income_accno_id AS income_accno_id,
958       tc.expense_accno_id AS expense_accno_id,
959       c1.accno AS inventory_accno,
960       c2.accno AS income_accno,
961       c3.accno AS expense_accno
962     FROM parts p
963     LEFT JOIN buchungsgruppen bg ON p.buchungsgruppen_id = bg.id
964     LEFT JOIN taxzone_charts tc on bg.id = tc.buchungsgruppen_id
965     LEFT JOIN chart c1 ON bg.inventory_accno_id = c1.id
966     LEFT JOIN chart c2 ON tc.income_accno_id = c2.id
967     LEFT JOIN chart c3 ON tc.expense_accno_id = c3.id
968     WHERE
969     tc.taxzone_id = '$form->{taxzone_id}'
970     and
971     p.id IN ($in)
972 SQL
973
974   my $sth_tax = prepare_query($::form, $dbh, <<SQL);
975     SELECT c.accno, t.taxdescription AS description, t.rate, t.taxnumber
976     FROM tax t
977     LEFT JOIN chart c ON c.id = t.chart_id
978     WHERE t.id IN
979       (SELECT tk.tax_id
980        FROM taxkeys tk
981        WHERE tk.chart_id = ? AND startdate <= ?
982        ORDER BY startdate DESC LIMIT 1)
983 SQL
984
985   while (my ($index => $part_id) = each %args) {
986     my $ref = $accno_by_part{$part_id} or next;
987
988     $ref->{"inventory_accno_id"} = undef unless $ref->{"part_type"} eq 'part';
989
990     my %accounts;
991     for my $type (qw(inventory income expense)) {
992       next unless $ref->{"${type}_accno_id"};
993       ($accounts{"${type}_accno_id"}, $accounts{"${type}_accno"}) =
994         $self->follow_account_chain($form, $dbh, $transdate, $ref->{"${type}_accno_id"}, $ref->{"${type}_accno"});
995     }
996
997     $form->{"${_}_accno_$index"} = $accounts{"${_}_accno"} for qw(inventory income expense);
998
999     $sth_tax->execute($accounts{$inc_exp}, quote_db_date($transdate));
1000     $ref = $sth_tax->fetchrow_hashref or next;
1001
1002     $form->{"taxaccounts_$index"} = $ref->{"accno"};
1003     $form->{"taxaccounts"} .= "$ref->{accno} "if $form->{"taxaccounts"} !~ /$ref->{accno}/;
1004
1005     $form->{"$ref->{accno}_${_}"} = $ref->{$_} for qw(rate description taxnumber);
1006   }
1007
1008   $sth_tax->finish;
1009
1010   $::lxdebug->leave_sub;
1011 }
1012
1013 sub get_basic_part_info {
1014   $main::lxdebug->enter_sub();
1015
1016   my $self     = shift;
1017   my %params   = @_;
1018
1019   Common::check_params(\%params, qw(id));
1020
1021   my @ids      = 'ARRAY' eq ref $params{id} ? @{ $params{id} } : ($params{id});
1022
1023   if (!scalar @ids) {
1024     $main::lxdebug->leave_sub();
1025     return ();
1026   }
1027
1028   my $myconfig = \%main::myconfig;
1029   my $form     = $main::form;
1030
1031   my $dbh      = $form->get_standard_dbh($myconfig);
1032
1033   my $query    = qq|SELECT * FROM parts WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
1034
1035   my $info     = selectall_hashref_query($form, $dbh, $query, map { conv_i($_) } @ids);
1036
1037   if ('' eq ref $params{id}) {
1038     $info = $info->[0] || { };
1039
1040     $main::lxdebug->leave_sub();
1041     return $info;
1042   }
1043
1044   my %info_map = map { $_->{id} => $_ } @{ $info };
1045
1046   $main::lxdebug->leave_sub();
1047
1048   return %info_map;
1049 }
1050
1051 sub prepare_parts_for_printing {
1052   $main::lxdebug->enter_sub();
1053
1054   my $self     = shift;
1055   my %params   = @_;
1056
1057   my $myconfig = $params{myconfig} || \%main::myconfig;
1058   my $form     = $params{form}     || $main::form;
1059
1060   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
1061
1062   my $prefix   = $params{prefix} || 'id_';
1063   my $rowcount = defined $params{rowcount} ? $params{rowcount} : $form->{rowcount};
1064
1065   my @part_ids = keys %{ { map { $_ => 1 } grep { $_ } map { $form->{"${prefix}${_}"} } (1 .. $rowcount) } };
1066
1067   if (!@part_ids) {
1068     $main::lxdebug->leave_sub();
1069     return;
1070   }
1071
1072   my $placeholders = join ', ', ('?') x scalar(@part_ids);
1073   my $query        = qq|SELECT mm.parts_id, mm.model, mm.lastcost, v.name AS make
1074                         FROM makemodel mm
1075                         LEFT JOIN vendor v ON (mm.make = v.id)
1076                         WHERE mm.parts_id IN ($placeholders)|;
1077
1078   my %makemodel    = ();
1079
1080   my $sth          = prepare_execute_query($form, $dbh, $query, @part_ids);
1081
1082   while (my $ref = $sth->fetchrow_hashref()) {
1083     $makemodel{$ref->{parts_id}} ||= [];
1084     push @{ $makemodel{$ref->{parts_id}} }, $ref;
1085   }
1086
1087   $sth->finish();
1088
1089   my @columns = qw(ean image microfiche drawing);
1090
1091   $query      = qq|SELECT id, | . join(', ', @columns) . qq|
1092                    FROM parts
1093                    WHERE id IN ($placeholders)|;
1094
1095   my %data    = selectall_as_map($form, $dbh, $query, 'id', \@columns, @part_ids);
1096
1097   my %template_arrays;
1098   map { $template_arrays{$_} = [] } (qw(make model), @columns);
1099
1100   foreach my $i (1 .. $rowcount) {
1101     my $id = $form->{"${prefix}${i}"};
1102
1103     next if (!$id);
1104
1105     foreach (@columns) {
1106       push @{ $template_arrays{$_} }, $data{$id}->{$_};
1107     }
1108
1109     push @{ $template_arrays{make} },  [];
1110     push @{ $template_arrays{model} }, [];
1111
1112     next if (!$makemodel{$id});
1113
1114     foreach my $ref (@{ $makemodel{$id} }) {
1115       map { push @{ $template_arrays{$_}->[-1] }, $ref->{$_} } qw(make model);
1116     }
1117   }
1118
1119   my $parts = SL::DB::Manager::Part->get_all(query => [ id => \@part_ids ]);
1120   my %parts_by_id = map { $_->id => $_ } @$parts;
1121
1122   for my $i (1..$rowcount) {
1123     my $id = $form->{"${prefix}${i}"};
1124     next unless $id;
1125
1126     push @{ $template_arrays{part_type} },  $parts_by_id{$id}->type;
1127   }
1128
1129   return %template_arrays;
1130   $main::lxdebug->leave_sub();
1131 }
1132
1133 sub normalize_text_blocks {
1134   $main::lxdebug->enter_sub();
1135
1136   my $self     = shift;
1137   my %params   = @_;
1138
1139   my $form     = $params{form}     || $main::form;
1140
1141   # check if feature is enabled (select normalize_part_descriptions from defaults)
1142   return unless ($::instance_conf->get_normalize_part_descriptions);
1143
1144   foreach (qw(description notes)) {
1145     $form->{$_} =~ s/\s+$//s;
1146     $form->{$_} =~ s/^\s+//s;
1147     $form->{$_} =~ s/ {2,}/ /g;
1148   }
1149    $main::lxdebug->leave_sub();
1150 }
1151
1152
1153 1;