1 #=====================================================================
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
7 #=====================================================================
8 # SQL-Ledger Accounting
11 # Author: Dieter Simader
12 # Email: dsimader@sql-ledger.org
13 # Web: http://www.sql-ledger.org
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.
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., 675 Mass Ave, Cambridge, MA 02139, USA.
29 #======================================================================
31 # Administration module
36 #======================================================================
43 $main::lxdebug->enter_sub();
45 my ($self, $myconfig, $form) = @_;
47 $form->{id} = "NULL" unless ($form->{id});
50 my $dbh = $form->dbconnect($myconfig);
52 my $query = qq|SELECT c.accno, c.description, c.charttype, c.gifi_accno,
53 c.category, c.link, c.taxkey_id, c.pos_ustva, c.pos_bwa, c.pos_bilanz,c.pos_eur, c.new_chart_id, c.valid_from
55 WHERE c.id = $form->{id}|;
57 my $sth = $dbh->prepare($query);
58 $sth->execute || $form->dberror($query);
60 my $ref = $sth->fetchrow_hashref(NAME_lc);
62 foreach my $key (keys %$ref) {
63 $form->{"$key"} = $ref->{"$key"};
68 # get default accounts
69 $query = qq|SELECT inventory_accno_id, income_accno_id, expense_accno_id
71 $sth = $dbh->prepare($query);
72 $sth->execute || $form->dberror($query);
74 $ref = $sth->fetchrow_hashref(NAME_lc);
76 map { $form->{$_} = $ref->{$_} } keys %ref;
80 # get taxkeys and description
81 $query = qq|SELECT taxkey, taxdescription
83 $sth = $dbh->prepare($query);
84 $sth->execute || $form->dberror($query);
86 $ref = $sth->fetchrow_hashref(NAME_lc);
88 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
89 push @{ $form->{TAXKEY} }, $ref;
95 $where = " WHERE link='$form->{link}'";
99 $query = qq|SELECT id, accno,description
101 $sth = $dbh->prepare($query);
102 $sth->execute || $form->dberror($query);
104 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
105 push @{ $form->{NEWACCOUNT} }, $ref;
110 # check if we have any transactions
111 $query = qq|SELECT a.trans_id FROM acc_trans a
112 WHERE a.chart_id = $form->{id}|;
113 $sth = $dbh->prepare($query);
114 $sth->execute || $form->dberror($query);
116 ($form->{orphaned}) = $sth->fetchrow_array;
117 $form->{orphaned} = !$form->{orphaned};
120 # check if new account is active
121 $form->{new_chart_valid} = 0;
122 if ($form->{new_chart_id}) {
123 $query = qq|SELECT current_date-valid_from FROM chart
124 WHERE id = $form->{id}|;
125 $sth = $dbh->prepare($query);
126 $sth->execute || $form->dberror($query);
128 my ($count) = $sth->fetchrow_array;
130 $form->{new_chart_valid} = 1;
137 $main::lxdebug->leave_sub();
141 $main::lxdebug->enter_sub();
143 my ($self, $myconfig, $form) = @_;
145 # connect to database, turn off AutoCommit
146 my $dbh = $form->dbconnect_noauto($myconfig);
148 # sanity check, can't have AR with AR_...
149 if ($form->{AR} || $form->{AP} || $form->{IC}) {
150 map { delete $form->{$_} }
151 qw(AR_amount AR_tax AR_paid AP_amount AP_tax AP_paid IC_sale IC_cogs IC_taxpart IC_income IC_expense IC_taxservice CT_tax);
155 foreach my $item ($form->{AR}, $form->{AR_amount},
156 $form->{AR_tax}, $form->{AR_paid},
157 $form->{AP}, $form->{AP_amount},
158 $form->{AP_tax}, $form->{AP_paid},
159 $form->{IC}, $form->{IC_sale},
160 $form->{IC_cogs}, $form->{IC_taxpart},
161 $form->{IC_income}, $form->{IC_expense},
162 $form->{IC_taxservice}, $form->{CT_tax}
164 $form->{link} .= "${item}:" if ($item);
168 # if we have an id then replace the old record
169 $form->{description} =~ s/\'/\'\'/g;
171 # strip blanks from accno
172 map { $form->{$_} =~ s/ //g; } qw(accno);
176 if ($form->{id} eq "NULL") {
180 map({ $form->{$_} = "NULL" unless ($form->{$_}); }
181 qw(pos_ustva pos_bwa pos_bilanz pos_eur new_chart_id));
183 $form->{valid_from} = ($form->{valid_from}) ? "'$form->{valid_from}'" : "NULL";
185 if ($form->{id} && $form->{orphaned}) {
186 $query = qq|UPDATE chart SET
187 accno = '$form->{accno}',
188 description = '$form->{description}',
189 charttype = '$form->{charttype}',
190 gifi_accno = '$form->{gifi_accno}',
191 category = '$form->{category}',
192 link = '$form->{link}',
193 taxkey_id = $form->{taxkey_id},
194 pos_ustva = $form->{pos_ustva},
195 pos_bwa = $form->{pos_bwa},
196 pos_bilanz = $form->{pos_bilanz},
197 pos_eur = $form->{pos_eur},
198 new_chart_id = $form->{new_chart_id},
199 valid_from = $form->{valid_from}
200 WHERE id = $form->{id}|;
201 } elsif ($form->{id} && !$form->{new_chart_valid}) {
202 $query = qq|UPDATE chart SET
203 new_chart_id = $form->{new_chart_id},
204 valid_from = $form->{valid_from}
205 WHERE id = $form->{id}|;
208 $query = qq|INSERT INTO chart
209 (accno, description, charttype, gifi_accno, category, link, taxkey_id, pos_ustva, pos_bwa, pos_bilanz,pos_eur, new_chart_id, valid_from)
210 VALUES ('$form->{accno}', '$form->{description}',
211 '$form->{charttype}', '$form->{gifi_accno}',
212 '$form->{category}', '$form->{link}', $form->{taxkey_id}, $form->{pos_ustva}, $form->{pos_bwa}, $form->{pos_bilanz}, $form->{pos_eur}, $form->{new_chart_id}, $form->{valid_from})|;
214 $dbh->do($query) || $form->dberror($query);
216 if ($form->{IC_taxpart} || $form->{IC_taxservice} || $form->{CT_tax}) {
218 my $chart_id = $form->{id};
220 unless ($form->{id}) {
223 $query = qq|SELECT c.id
225 WHERE c.accno = '$form->{accno}'|;
226 $sth = $dbh->prepare($query);
227 $sth->execute || $form->dberror($query);
229 ($chart_id) = $sth->fetchrow_array;
233 # add account if it doesn't exist in tax
234 $query = qq|SELECT t.chart_id
236 WHERE t.chart_id = $chart_id|;
237 $sth = $dbh->prepare($query);
238 $sth->execute || $form->dberror($query);
240 my ($tax_id) = $sth->fetchrow_array;
243 # add tax if it doesn't exist
245 $query = qq|INSERT INTO tax (chart_id, rate)
246 VALUES ($chart_id, 0)|;
247 $dbh->do($query) || $form->dberror($query);
253 $query = qq|DELETE FROM tax
254 WHERE chart_id = $form->{id}|;
255 $dbh->do($query) || $form->dberror($query);
260 my $rc = $dbh->commit;
263 $main::lxdebug->leave_sub();
269 $main::lxdebug->enter_sub();
271 my ($self, $myconfig, $form) = @_;
273 # connect to database, turn off AutoCommit
274 my $dbh = $form->dbconnect_noauto($myconfig);
276 my $query = qq|SELECT count(*) FROM acc_trans a
277 WHERE a.chart_id = $form->{id}|;
278 my $sth = $dbh->prepare($query);
279 $sth->execute || $form->dberror($query);
281 if ($sth->fetchrow_array) {
284 $main::lxdebug->leave_sub();
289 # delete chart of account record
290 $query = qq|DELETE FROM chart
291 WHERE id = $form->{id}|;
292 $dbh->do($query) || $form->dberror($query);
294 # set inventory_accno_id, income_accno_id, expense_accno_id to defaults
295 $query = qq|UPDATE parts
296 SET inventory_accno_id =
297 (SELECT inventory_accno_id FROM defaults)
298 WHERE inventory_accno_id = $form->{id}|;
299 $dbh->do($query) || $form->dberror($query);
301 $query = qq|UPDATE parts
302 SET income_accno_id =
303 (SELECT income_accno_id FROM defaults)
304 WHERE income_accno_id = $form->{id}|;
305 $dbh->do($query) || $form->dberror($query);
307 $query = qq|UPDATE parts
308 SET expense_accno_id =
309 (SELECT expense_accno_id FROM defaults)
310 WHERE expense_accno_id = $form->{id}|;
311 $dbh->do($query) || $form->dberror($query);
313 foreach my $table (qw(partstax customertax vendortax tax)) {
314 $query = qq|DELETE FROM $table
315 WHERE chart_id = $form->{id}|;
316 $dbh->do($query) || $form->dberror($query);
319 # commit and redirect
320 my $rc = $dbh->commit;
323 $main::lxdebug->leave_sub();
329 $main::lxdebug->enter_sub();
331 my ($self, $myconfig, $form) = @_;
333 # connect to database
334 my $dbh = $form->dbconnect($myconfig);
336 my $query = qq|SELECT accno, description
340 $sth = $dbh->prepare($query);
341 $sth->execute || $form->dberror($query);
343 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
344 push @{ $form->{ALL} }, $ref;
350 $main::lxdebug->leave_sub();
354 $main::lxdebug->enter_sub();
356 my ($self, $myconfig, $form) = @_;
358 # connect to database
359 my $dbh = $form->dbconnect($myconfig);
361 my $query = qq|SELECT g.accno, g.description
363 WHERE g.accno = '$form->{accno}'|;
364 my $sth = $dbh->prepare($query);
365 $sth->execute || $form->dberror($query);
367 my $ref = $sth->fetchrow_hashref(NAME_lc);
369 map { $form->{$_} = $ref->{$_} } keys %$ref;
373 # check for transactions
374 $query = qq|SELECT count(*) FROM acc_trans a, chart c, gifi g
375 WHERE c.gifi_accno = g.accno
376 AND a.chart_id = c.id
377 AND g.accno = '$form->{accno}'|;
378 $sth = $dbh->prepare($query);
379 $sth->execute || $form->dberror($query);
381 ($form->{orphaned}) = $sth->fetchrow_array;
383 $form->{orphaned} = !$form->{orphaned};
387 $main::lxdebug->leave_sub();
391 $main::lxdebug->enter_sub();
393 my ($self, $myconfig, $form) = @_;
395 # connect to database
396 my $dbh = $form->dbconnect($myconfig);
398 $form->{description} =~ s/\'/\'\'/g;
400 # id is the old account number!
402 $query = qq|UPDATE gifi SET
403 accno = '$form->{accno}',
404 description = '$form->{description}'
405 WHERE accno = '$form->{id}'|;
407 $query = qq|INSERT INTO gifi
409 VALUES ('$form->{accno}', '$form->{description}')|;
411 $dbh->do($query) || $form->dberror($query);
415 $main::lxdebug->leave_sub();
419 $main::lxdebug->enter_sub();
421 my ($self, $myconfig, $form) = @_;
423 # connect to database
424 my $dbh = $form->dbconnect($myconfig);
426 # id is the old account number!
427 $query = qq|DELETE FROM gifi
428 WHERE accno = '$form->{id}'|;
429 $dbh->do($query) || $form->dberror($query);
433 $main::lxdebug->leave_sub();
437 $main::lxdebug->enter_sub();
439 my ($self, $myconfig, $form) = @_;
441 # connect to database
442 my $dbh = $form->dbconnect($myconfig);
444 my $query = qq|SELECT id, description
448 $sth = $dbh->prepare($query);
449 $sth->execute || $form->dberror($query);
451 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
452 push @{ $form->{ALL} }, $ref;
458 $main::lxdebug->leave_sub();
462 $main::lxdebug->enter_sub();
464 my ($self, $myconfig, $form) = @_;
466 # connect to database
467 my $dbh = $form->dbconnect($myconfig);
469 my $query = qq|SELECT w.description
471 WHERE w.id = $form->{id}|;
472 my $sth = $dbh->prepare($query);
473 $sth->execute || $form->dberror($query);
475 my $ref = $sth->fetchrow_hashref(NAME_lc);
477 map { $form->{$_} = $ref->{$_} } keys %$ref;
481 # see if it is in use
482 $query = qq|SELECT count(*) FROM inventory i
483 WHERE i.warehouse_id = $form->{id}|;
484 $sth = $dbh->prepare($query);
485 $sth->execute || $form->dberror($query);
487 ($form->{orphaned}) = $sth->fetchrow_array;
488 $form->{orphaned} = !$form->{orphaned};
493 $main::lxdebug->leave_sub();
497 $main::lxdebug->enter_sub();
499 my ($self, $myconfig, $form) = @_;
501 # connect to database
502 my $dbh = $form->dbconnect($myconfig);
504 $form->{description} =~ s/\'/\'\'/g;
507 $query = qq|UPDATE warehouse SET
508 description = '$form->{description}'
509 WHERE id = $form->{id}|;
511 $query = qq|INSERT INTO warehouse
513 VALUES ('$form->{description}')|;
515 $dbh->do($query) || $form->dberror($query);
519 $main::lxdebug->leave_sub();
522 sub delete_warehouse {
523 $main::lxdebug->enter_sub();
525 my ($self, $myconfig, $form) = @_;
527 # connect to database
528 my $dbh = $form->dbconnect($myconfig);
530 $query = qq|DELETE FROM warehouse
531 WHERE id = $form->{id}|;
532 $dbh->do($query) || $form->dberror($query);
536 $main::lxdebug->leave_sub();
540 $main::lxdebug->enter_sub();
542 my ($self, $myconfig, $form) = @_;
544 # connect to database
545 my $dbh = $form->dbconnect($myconfig);
547 my $query = qq|SELECT d.id, d.description, d.role
551 $sth = $dbh->prepare($query);
552 $sth->execute || $form->dberror($query);
554 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
555 push @{ $form->{ALL} }, $ref;
561 $main::lxdebug->leave_sub();
565 $main::lxdebug->enter_sub();
567 my ($self, $myconfig, $form) = @_;
569 # connect to database
570 my $dbh = $form->dbconnect($myconfig);
572 my $query = qq|SELECT d.description, d.role
574 WHERE d.id = $form->{id}|;
575 my $sth = $dbh->prepare($query);
576 $sth->execute || $form->dberror($query);
578 my $ref = $sth->fetchrow_hashref(NAME_lc);
580 map { $form->{$_} = $ref->{$_} } keys %$ref;
584 # see if it is in use
585 $query = qq|SELECT count(*) FROM dpt_trans d
586 WHERE d.department_id = $form->{id}|;
587 $sth = $dbh->prepare($query);
588 $sth->execute || $form->dberror($query);
590 ($form->{orphaned}) = $sth->fetchrow_array;
591 $form->{orphaned} = !$form->{orphaned};
596 $main::lxdebug->leave_sub();
599 sub save_department {
600 $main::lxdebug->enter_sub();
602 my ($self, $myconfig, $form) = @_;
604 # connect to database
605 my $dbh = $form->dbconnect($myconfig);
607 $form->{description} =~ s/\'/\'\'/g;
610 $query = qq|UPDATE department SET
611 description = '$form->{description}',
612 role = '$form->{role}'
613 WHERE id = $form->{id}|;
615 $query = qq|INSERT INTO department
617 VALUES ('$form->{description}', '$form->{role}')|;
619 $dbh->do($query) || $form->dberror($query);
623 $main::lxdebug->leave_sub();
626 sub delete_department {
627 $main::lxdebug->enter_sub();
629 my ($self, $myconfig, $form) = @_;
631 # connect to database
632 my $dbh = $form->dbconnect($myconfig);
634 $query = qq|DELETE FROM department
635 WHERE id = $form->{id}|;
636 $dbh->do($query) || $form->dberror($query);
640 $main::lxdebug->leave_sub();
644 $main::lxdebug->enter_sub();
646 my ($self, $myconfig, $form) = @_;
648 # connect to database
649 my $dbh = $form->dbconnect($myconfig);
651 my $query = qq|SELECT id, lead
655 $sth = $dbh->prepare($query);
656 $sth->execute || $form->dberror($query);
658 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
659 push @{ $form->{ALL} }, $ref;
665 $main::lxdebug->leave_sub();
669 $main::lxdebug->enter_sub();
671 my ($self, $myconfig, $form) = @_;
673 # connect to database
674 my $dbh = $form->dbconnect($myconfig);
677 qq|SELECT l.id, l.lead
679 WHERE l.id = $form->{id}|;
680 my $sth = $dbh->prepare($query);
681 $sth->execute || $form->dberror($query);
683 my $ref = $sth->fetchrow_hashref(NAME_lc);
685 map { $form->{$_} = $ref->{$_} } keys %$ref;
691 $main::lxdebug->leave_sub();
695 $main::lxdebug->enter_sub();
697 my ($self, $myconfig, $form) = @_;
699 # connect to database
700 my $dbh = $form->dbconnect($myconfig);
702 $form->{lead} =~ s/\'/\'\'/g;
704 # id is the old record
706 $query = qq|UPDATE leads SET
707 lead = '$form->{description}'
708 WHERE id = $form->{id}|;
710 $query = qq|INSERT INTO leads
712 VALUES ('$form->{description}')|;
714 $dbh->do($query) || $form->dberror($query);
718 $main::lxdebug->leave_sub();
722 $main::lxdebug->enter_sub();
724 my ($self, $myconfig, $form) = @_;
726 # connect to database
727 my $dbh = $form->dbconnect($myconfig);
729 $query = qq|DELETE FROM leads
730 WHERE id = $form->{id}|;
731 $dbh->do($query) || $form->dberror($query);
735 $main::lxdebug->leave_sub();
739 $main::lxdebug->enter_sub();
741 my ($self, $myconfig, $form) = @_;
743 # connect to database
744 my $dbh = $form->dbconnect($myconfig);
746 my $query = qq|SELECT id, description, discount, customernumberinit, salesman
750 $sth = $dbh->prepare($query);
751 $sth->execute || $form->dberror($query);
753 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
754 push @{ $form->{ALL} }, $ref;
760 $main::lxdebug->leave_sub();
764 $main::lxdebug->enter_sub();
766 my ($self, $myconfig, $form) = @_;
768 # connect to database
769 my $dbh = $form->dbconnect($myconfig);
772 qq|SELECT b.description, b.discount, b.customernumberinit, b.salesman
774 WHERE b.id = $form->{id}|;
775 my $sth = $dbh->prepare($query);
776 $sth->execute || $form->dberror($query);
778 my $ref = $sth->fetchrow_hashref(NAME_lc);
780 map { $form->{$_} = $ref->{$_} } keys %$ref;
786 $main::lxdebug->leave_sub();
790 $main::lxdebug->enter_sub();
792 my ($self, $myconfig, $form) = @_;
794 # connect to database
795 my $dbh = $form->dbconnect($myconfig);
797 $form->{description} =~ s/\'/\'\'/g;
798 $form->{discount} /= 100;
799 $form->{salesman} *= 1;
801 # id is the old record
803 $query = qq|UPDATE business SET
804 description = '$form->{description}',
805 discount = $form->{discount},
806 customernumberinit = '$form->{customernumberinit}',
807 salesman = '$form->{salesman}'
808 WHERE id = $form->{id}|;
810 $query = qq|INSERT INTO business
811 (description, discount, customernumberinit, salesman)
812 VALUES ('$form->{description}', $form->{discount}, '$form->{customernumberinit}', '$form->{salesman}')|;
814 $dbh->do($query) || $form->dberror($query);
818 $main::lxdebug->leave_sub();
821 sub delete_business {
822 $main::lxdebug->enter_sub();
824 my ($self, $myconfig, $form) = @_;
826 # connect to database
827 my $dbh = $form->dbconnect($myconfig);
829 $query = qq|DELETE FROM business
830 WHERE id = $form->{id}|;
831 $dbh->do($query) || $form->dberror($query);
835 $main::lxdebug->leave_sub();
840 $main::lxdebug->enter_sub();
842 my ($self, $myconfig, $form) = @_;
844 # connect to database
845 my $dbh = $form->dbconnect($myconfig);
847 my $query = qq|SELECT id, description, template_code, article_code
851 $sth = $dbh->prepare($query);
852 $sth->execute || $form->dberror($query);
854 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
855 push @{ $form->{ALL} }, $ref;
861 $main::lxdebug->leave_sub();
865 $main::lxdebug->enter_sub();
867 my ($self, $myconfig, $form) = @_;
869 # connect to database
870 my $dbh = $form->dbconnect($myconfig);
873 qq|SELECT l.description, l.template_code, l.article_code
875 WHERE l.id = $form->{id}|;
876 my $sth = $dbh->prepare($query);
877 $sth->execute || $form->dberror($query);
879 my $ref = $sth->fetchrow_hashref(NAME_lc);
881 map { $form->{$_} = $ref->{$_} } keys %$ref;
887 $main::lxdebug->leave_sub();
891 $main::lxdebug->enter_sub();
893 my ($self, $myconfig, $form) = @_;
895 # connect to database
896 my $dbh = $form->dbconnect($myconfig);
898 $form->{description} =~ s/\'/\'\'/g;
899 $form->{article_code} =~ s/\'/\'\'/g;
900 $form->{template_code} =~ s/\'/\'\'/g;
903 # id is the old record
905 $query = qq|UPDATE language SET
906 description = '$form->{description}',
907 template_code = '$form->{template_code}',
908 article_code = '$form->{article_code}'
909 WHERE id = $form->{id}|;
911 $query = qq|INSERT INTO language
912 (description, template_code, article_code)
913 VALUES ('$form->{description}', '$form->{template_code}', '$form->{article_code}')|;
915 $dbh->do($query) || $form->dberror($query);
919 $main::lxdebug->leave_sub();
922 sub delete_language {
923 $main::lxdebug->enter_sub();
925 my ($self, $myconfig, $form) = @_;
927 # connect to database
928 my $dbh = $form->dbconnect($myconfig);
930 $query = qq|DELETE FROM language
931 WHERE id = $form->{id}|;
932 $dbh->do($query) || $form->dberror($query);
936 $main::lxdebug->leave_sub();
941 $main::lxdebug->enter_sub();
943 my ($self, $myconfig, $form) = @_;
945 # connect to database
946 my $dbh = $form->dbconnect($myconfig);
948 my $query = qq|SELECT id, description, inventory_accno_id, (select accno from chart where id=inventory_accno_id) as inventory_accno, income_accno_id_0, (select accno from chart where id=income_accno_id_0) as income_accno_0, expense_accno_id_0, (select accno from chart where id=expense_accno_id_0) as expense_accno_0, income_accno_id_1, (select accno from chart where id=income_accno_id_1) as income_accno_1, expense_accno_id_1, (select accno from chart where id=expense_accno_id_1) as expense_accno_1, income_accno_id_2, (select accno from chart where id=income_accno_id_2) as income_accno_2, expense_accno_id_2, (select accno from chart where id=expense_accno_id_2) as expense_accno_2, income_accno_id_3, (select accno from chart where id=income_accno_id_3) as income_accno_3, expense_accno_id_3, (select accno from chart where id=expense_accno_id_3) as expense_accno_3
952 $sth = $dbh->prepare($query);
953 $sth->execute || $form->dberror($query);
955 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
956 push @{ $form->{ALL} }, $ref;
962 $main::lxdebug->leave_sub();
965 sub get_buchungsgruppe {
966 $main::lxdebug->enter_sub();
968 my ($self, $myconfig, $form) = @_;
970 # connect to database
971 my $dbh = $form->dbconnect($myconfig);
975 qq|SELECT description, inventory_accno_id, (select accno from chart where id=inventory_accno_id) as inventory_accno, income_accno_id_0, (select accno from chart where id=income_accno_id_0) as income_accno_0, expense_accno_id_0, (select accno from chart where id=expense_accno_id_0) as expense_accno_0, income_accno_id_1, (select accno from chart where id=income_accno_id_1) as income_accno_1, expense_accno_id_1, (select accno from chart where id=expense_accno_id_1) as expense_accno_1, income_accno_id_2, (select accno from chart where id=income_accno_id_2) as income_accno_2, expense_accno_id_2, (select accno from chart where id=expense_accno_id_2) as expense_accno_2, income_accno_id_3, (select accno from chart where id=income_accno_id_3) as income_accno_3, expense_accno_id_3, (select accno from chart where id=expense_accno_id_3) as expense_accno_3
977 WHERE id = $form->{id}|;
978 my $sth = $dbh->prepare($query);
979 $sth->execute || $form->dberror($query);
981 my $ref = $sth->fetchrow_hashref(NAME_lc);
983 map { $form->{$_} = $ref->{$_} } keys %$ref;
988 qq|SELECT count(id) as anzahl
990 WHERE buchungsgruppen_id = $form->{id}|;
991 my $sth = $dbh->prepare($query);
992 $sth->execute || $form->dberror($query);
994 my $ref = $sth->fetchrow_hashref(NAME_lc);
995 if (!$ref->{anzahl}) {
996 $form->{orphaned} = 1;
1002 $query = "SELECT inventory_accno_id FROM defaults";
1003 ($form->{"std_inventory_accno_id"}) = $dbh->selectrow_array($query);
1006 $query = qq|SELECT c.accno, c.description, c.link, c.id,
1007 d.inventory_accno_id, d.income_accno_id, d.expense_accno_id
1008 FROM chart c, defaults d
1009 WHERE c.link LIKE '%$module%'
1013 my $sth = $dbh->prepare($query);
1014 $sth->execute || $form->dberror($query);
1015 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1016 foreach my $key (split(/:/, $ref->{link})) {
1017 if (!$form->{"std_inventory_accno_id"} && ($key eq "IC")) {
1018 $form->{"std_inventory_accno_id"} = $ref->{"id"};
1020 if ($key =~ /$module/) {
1021 if ( ($ref->{id} eq $ref->{inventory_accno_id})
1022 || ($ref->{id} eq $ref->{income_accno_id})
1023 || ($ref->{id} eq $ref->{expense_accno_id})) {
1024 push @{ $form->{"${module}_links"}{$key} },
1025 { accno => $ref->{accno},
1026 description => $ref->{description},
1027 selected => "selected",
1030 push @{ $form->{"${module}_links"}{$key} },
1031 { accno => $ref->{accno},
1032 description => $ref->{description},
1044 $main::lxdebug->leave_sub();
1047 sub save_buchungsgruppe {
1048 $main::lxdebug->enter_sub();
1050 my ($self, $myconfig, $form) = @_;
1052 # connect to database
1053 my $dbh = $form->dbconnect($myconfig);
1055 $form->{description} =~ s/\'/\'\'/g;
1058 # id is the old record
1060 $query = qq|UPDATE buchungsgruppen SET
1061 description = '$form->{description}',
1062 inventory_accno_id = '$form->{inventory_accno_id}',
1063 income_accno_id_0 = '$form->{income_accno_id_0}',
1064 expense_accno_id_0 = '$form->{expense_accno_id_0}',
1065 income_accno_id_1 = '$form->{income_accno_id_1}',
1066 expense_accno_id_1 = '$form->{expense_accno_id_1}',
1067 income_accno_id_2 = '$form->{income_accno_id_2}',
1068 expense_accno_id_2 = '$form->{expense_accno_id_2}',
1069 income_accno_id_3 = '$form->{income_accno_id_3}',
1070 expense_accno_id_3 = '$form->{expense_accno_id_3}'
1071 WHERE id = $form->{id}|;
1073 $query = qq|INSERT INTO buchungsgruppen
1074 (description, inventory_accno_id, income_accno_id_0, expense_accno_id_0, income_accno_id_1, expense_accno_id_1, income_accno_id_2, expense_accno_id_2, income_accno_id_3, expense_accno_id_3)
1075 VALUES ('$form->{description}', '$form->{inventory_accno_id}', '$form->{income_accno_id_0}', '$form->{expense_accno_id_0}', '$form->{income_accno_id_1}', '$form->{expense_accno_id_1}', '$form->{income_accno_id_2}', '$form->{expense_accno_id_2}', '$form->{income_accno_id_3}', '$form->{expense_accno_id_3}')|;
1077 $dbh->do($query) || $form->dberror($query);
1081 $main::lxdebug->leave_sub();
1084 sub delete_buchungsgruppe {
1085 $main::lxdebug->enter_sub();
1087 my ($self, $myconfig, $form) = @_;
1089 # connect to database
1090 my $dbh = $form->dbconnect($myconfig);
1092 $query = qq|DELETE FROM buchungsgruppe
1093 WHERE id = $form->{id}|;
1094 $dbh->do($query) || $form->dberror($query);
1098 $main::lxdebug->leave_sub();
1102 $main::lxdebug->enter_sub();
1104 my ($self, $myconfig, $form) = @_;
1106 # connect to database
1107 my $dbh = $form->dbconnect($myconfig);
1109 my $query = qq|SELECT id, printer_description, template_code, printer_command
1113 $sth = $dbh->prepare($query);
1114 $sth->execute || $form->dberror($query);
1116 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1117 push @{ $form->{ALL} }, $ref;
1123 $main::lxdebug->leave_sub();
1127 $main::lxdebug->enter_sub();
1129 my ($self, $myconfig, $form) = @_;
1131 # connect to database
1132 my $dbh = $form->dbconnect($myconfig);
1135 qq|SELECT p.printer_description, p.template_code, p.printer_command
1137 WHERE p.id = $form->{id}|;
1138 my $sth = $dbh->prepare($query);
1139 $sth->execute || $form->dberror($query);
1141 my $ref = $sth->fetchrow_hashref(NAME_lc);
1143 map { $form->{$_} = $ref->{$_} } keys %$ref;
1149 $main::lxdebug->leave_sub();
1153 $main::lxdebug->enter_sub();
1155 my ($self, $myconfig, $form) = @_;
1157 # connect to database
1158 my $dbh = $form->dbconnect($myconfig);
1160 $form->{printer_description} =~ s/\'/\'\'/g;
1161 $form->{printer_command} =~ s/\'/\'\'/g;
1162 $form->{template_code} =~ s/\'/\'\'/g;
1165 # id is the old record
1167 $query = qq|UPDATE printers SET
1168 printer_description = '$form->{printer_description}',
1169 template_code = '$form->{template_code}',
1170 printer_command = '$form->{printer_command}'
1171 WHERE id = $form->{id}|;
1173 $query = qq|INSERT INTO printers
1174 (printer_description, template_code, printer_command)
1175 VALUES ('$form->{printer_description}', '$form->{template_code}', '$form->{printer_command}')|;
1177 $dbh->do($query) || $form->dberror($query);
1181 $main::lxdebug->leave_sub();
1184 sub delete_printer {
1185 $main::lxdebug->enter_sub();
1187 my ($self, $myconfig, $form) = @_;
1189 # connect to database
1190 my $dbh = $form->dbconnect($myconfig);
1192 $query = qq|DELETE FROM printers
1193 WHERE id = $form->{id}|;
1194 $dbh->do($query) || $form->dberror($query);
1198 $main::lxdebug->leave_sub();
1202 $main::lxdebug->enter_sub();
1204 my ($self, $myconfig, $form) = @_;
1206 # connect to database
1207 my $dbh = $form->dbconnect($myconfig);
1209 my $query = qq|SELECT *
1213 $sth = $dbh->prepare($query);
1214 $sth->execute || $form->dberror($query);
1216 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1217 $ref->{percent_skonto} = $form->format_amount($myconfig,($ref->{percent_skonto} * 100));
1218 push @{ $form->{ALL} }, $ref;
1224 $main::lxdebug->leave_sub();
1228 $main::lxdebug->enter_sub();
1230 my ($self, $myconfig, $form) = @_;
1232 # connect to database
1233 my $dbh = $form->dbconnect($myconfig);
1238 WHERE id = $form->{id}|;
1239 my $sth = $dbh->prepare($query);
1240 $sth->execute || $form->dberror($query);
1242 my $ref = $sth->fetchrow_hashref(NAME_lc);
1243 $ref->{percent_skonto} = $form->format_amount($myconfig,($ref->{percent_skonto} * 100));
1245 map { $form->{$_} = $ref->{$_} } keys %$ref;
1251 $main::lxdebug->leave_sub();
1255 $main::lxdebug->enter_sub();
1257 my ($self, $myconfig, $form) = @_;
1259 # connect to database
1260 my $dbh = $form->dbconnect($myconfig);
1262 $form->{description} =~ s/\'/\'\'/g;
1263 $form->{description_long} =~ s/\'/\'\'/g;
1264 $percentskonto = $form->parse_amount($myconfig, $form->{percent_skonto}) /100;
1265 $form->{ranking} *= 1;
1266 $form->{terms_netto} *= 1;
1267 $form->{terms_skonto} *= 1;
1268 $form->{percent_skonto} *= 1;
1272 # id is the old record
1274 $query = qq|UPDATE payment_terms SET
1275 description = '$form->{description}',
1276 ranking = $form->{ranking},
1277 description_long = '$form->{description_long}',
1278 terms_netto = $form->{terms_netto},
1279 terms_skonto = $form->{terms_skonto},
1280 percent_skonto = $percentskonto
1281 WHERE id = $form->{id}|;
1283 $query = qq|INSERT INTO payment_terms
1284 (description, ranking, description_long, terms_netto, terms_skonto, percent_skonto)
1285 VALUES ('$form->{description}', $form->{ranking}, '$form->{description_long}', $form->{terms_netto}, $form->{terms_skonto}, $percentskonto)|;
1287 $dbh->do($query) || $form->dberror($query);
1291 $main::lxdebug->leave_sub();
1294 sub delete_payment {
1295 $main::lxdebug->enter_sub();
1297 my ($self, $myconfig, $form) = @_;
1299 # connect to database
1300 my $dbh = $form->dbconnect($myconfig);
1302 $query = qq|DELETE FROM payment_terms
1303 WHERE id = $form->{id}|;
1304 $dbh->do($query) || $form->dberror($query);
1308 $main::lxdebug->leave_sub();
1312 $main::lxdebug->enter_sub();
1314 my ($self, $myconfig, $form) = @_;
1316 # connect to database
1317 my $dbh = $form->dbconnect($myconfig);
1319 my $query = qq|SELECT code, sictype, description
1323 $sth = $dbh->prepare($query);
1324 $sth->execute || $form->dberror($query);
1326 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1327 push @{ $form->{ALL} }, $ref;
1333 $main::lxdebug->leave_sub();
1337 $main::lxdebug->enter_sub();
1339 my ($self, $myconfig, $form) = @_;
1341 # connect to database
1342 my $dbh = $form->dbconnect($myconfig);
1344 my $query = qq|SELECT s.code, s.sictype, s.description
1346 WHERE s.code = '$form->{code}'|;
1347 my $sth = $dbh->prepare($query);
1348 $sth->execute || $form->dberror($query);
1350 my $ref = $sth->fetchrow_hashref(NAME_lc);
1352 map { $form->{$_} = $ref->{$_} } keys %$ref;
1358 $main::lxdebug->leave_sub();
1362 $main::lxdebug->enter_sub();
1364 my ($self, $myconfig, $form) = @_;
1366 # connect to database
1367 my $dbh = $form->dbconnect($myconfig);
1369 $form->{code} =~ s/\'/\'\'/g;
1370 $form->{description} =~ s/\'/\'\'/g;
1374 $query = qq|UPDATE sic SET
1375 code = '$form->{code}',
1376 sictype = '$form->{sictype}',
1377 description = '$form->{description}'
1378 WHERE code = '$form->{id}'|;
1380 $query = qq|INSERT INTO sic
1381 (code, sictype, description)
1382 VALUES ('$form->{code}', '$form->{sictype}', '$form->{description}')|;
1384 $dbh->do($query) || $form->dberror($query);
1388 $main::lxdebug->leave_sub();
1392 $main::lxdebug->enter_sub();
1394 my ($self, $myconfig, $form) = @_;
1396 # connect to database
1397 my $dbh = $form->dbconnect($myconfig);
1399 $query = qq|DELETE FROM sic
1400 WHERE code = '$form->{code}'|;
1401 $dbh->do($query) || $form->dberror($query);
1405 $main::lxdebug->leave_sub();
1409 $main::lxdebug->enter_sub();
1411 my ($self, $form) = @_;
1413 open(TEMPLATE, "$form->{file}") or $form->error("$form->{file} : $!");
1415 while (<TEMPLATE>) {
1416 $form->{body} .= $_;
1421 $main::lxdebug->leave_sub();
1425 $main::lxdebug->enter_sub();
1427 my ($self, $form) = @_;
1429 open(TEMPLATE, ">$form->{file}") or $form->error("$form->{file} : $!");
1432 $form->{body} =~ s/\r\n/\n/g;
1433 print TEMPLATE $form->{body};
1437 $main::lxdebug->leave_sub();
1440 sub save_preferences {
1441 $main::lxdebug->enter_sub();
1443 my ($self, $myconfig, $form, $memberfile, $userspath, $webdav) = @_;
1445 map { ($form->{$_}) = split(/--/, $form->{$_}) }
1446 qw(inventory_accno income_accno expense_accno fxgain_accno fxloss_accno);
1449 $form->{curr} =~ s/ //g;
1450 map { push(@a, uc pack "A3", $_) if $_ } split(/:/, $form->{curr});
1451 $form->{curr} = join ':', @a;
1453 # connect to database
1454 my $dbh = $form->dbconnect_noauto($myconfig);
1456 # these defaults are database wide
1457 # user specific variables are in myconfig
1459 my $query = qq|UPDATE defaults SET
1460 inventory_accno_id =
1461 (SELECT c.id FROM chart c
1462 WHERE c.accno = '$form->{inventory_accno}'),
1464 (SELECT c.id FROM chart c
1465 WHERE c.accno = '$form->{income_accno}'),
1467 (SELECT c.id FROM chart c
1468 WHERE c.accno = '$form->{expense_accno}'),
1470 (SELECT c.id FROM chart c
1471 WHERE c.accno = '$form->{fxgain_accno}'),
1473 (SELECT c.id FROM chart c
1474 WHERE c.accno = '$form->{fxloss_accno}'),
1475 invnumber = '$form->{invnumber}',
1476 cnnumber = '$form->{cnnumber}',
1477 sonumber = '$form->{sonumber}',
1478 ponumber = '$form->{ponumber}',
1479 sqnumber = '$form->{sqnumber}',
1480 rfqnumber = '$form->{rfqnumber}',
1481 customernumber = '$form->{customernumber}',
1482 vendornumber = '$form->{vendornumber}',
1483 articlenumber = '$form->{articlenumber}',
1484 servicenumber = '$form->{servicenumber}',
1485 yearend = '$form->{yearend}',
1486 curr = '$form->{curr}',
1487 weightunit = '$form->{weightunit}',
1488 businessnumber = '$form->{businessnumber}'
1490 $dbh->do($query) || $form->dberror($query);
1493 my $name = $form->{name};
1494 $name =~ s/\'/\'\'/g;
1495 $query = qq|UPDATE employee
1497 WHERE login = '$form->{login}'|;
1498 $dbh->do($query) || $form->dberror($query);
1500 foreach my $item (split(/ /, $form->{taxaccounts})) {
1501 $query = qq|UPDATE tax
1502 SET rate = | . ($form->{$item} / 100) . qq|,
1503 taxnumber = '$form->{"taxnumber_$item"}'
1504 WHERE chart_id = $item|;
1505 $dbh->do($query) || $form->dberror($query);
1508 my $rc = $dbh->commit;
1511 # save first currency in myconfig
1512 $form->{currency} = substr($form->{curr}, 0, 3);
1514 my $myconfig = new User "$memberfile", "$form->{login}";
1516 foreach my $item (keys %$form) {
1517 $myconfig->{$item} = $form->{$item};
1520 $myconfig->save_member($memberfile, $userspath);
1524 qw(angebote bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen);
1525 foreach $directory (@webdavdirs) {
1526 $file = "webdav/" . $directory . "/webdav-user";
1527 if ($myconfig->{$directory}) {
1528 open(HTACCESS, "$file") or die "cannot open webdav-user $!\n";
1529 while (<HTACCESS>) {
1530 ($login, $password) = split(/:/, $_);
1531 if ($login ne $form->{login}) {
1536 open(HTACCESS, "> $file") or die "cannot open webdav-user $!\n";
1537 $newfile .= $myconfig->{login} . ":" . $myconfig->{password} . "\n";
1538 print(HTACCESS $newfile);
1541 $form->{$directory} = 0;
1542 open(HTACCESS, "$file") or die "cannot open webdav-user $!\n";
1543 while (<HTACCESS>) {
1544 ($login, $password) = split(/:/, $_);
1545 if ($login ne $form->{login}) {
1550 open(HTACCESS, "> $file") or die "cannot open webdav-user $!\n";
1551 print(HTACCESS $newfile);
1557 $main::lxdebug->leave_sub();
1562 sub defaultaccounts {
1563 $main::lxdebug->enter_sub();
1565 my ($self, $myconfig, $form) = @_;
1567 # connect to database
1568 my $dbh = $form->dbconnect($myconfig);
1570 # get defaults from defaults table
1571 my $query = qq|SELECT * FROM defaults|;
1572 my $sth = $dbh->prepare($query);
1573 $sth->execute || $form->dberror($query);
1575 $form->{defaults} = $sth->fetchrow_hashref(NAME_lc);
1576 $form->{defaults}{IC} = $form->{defaults}{inventory_accno_id};
1577 $form->{defaults}{IC_income} = $form->{defaults}{income_accno_id};
1578 $form->{defaults}{IC_expense} = $form->{defaults}{expense_accno_id};
1579 $form->{defaults}{FX_gain} = $form->{defaults}{fxgain_accno_id};
1580 $form->{defaults}{FX_loss} = $form->{defaults}{fxloss_accno_id};
1584 $query = qq|SELECT c.id, c.accno, c.description, c.link
1586 WHERE c.link LIKE '%IC%'
1588 $sth = $dbh->prepare($query);
1589 $sth->execute || $self->dberror($query);
1591 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1592 foreach my $key (split(/:/, $ref->{link})) {
1595 if ($key =~ /cogs/) {
1596 $nkey = "IC_expense";
1598 if ($key =~ /sale/) {
1599 $nkey = "IC_income";
1601 %{ $form->{IC}{$nkey}{ $ref->{accno} } } = (
1603 description => $ref->{description}
1610 $query = qq|SELECT c.id, c.accno, c.description
1612 WHERE c.category = 'I'
1613 AND c.charttype = 'A'
1615 $sth = $dbh->prepare($query);
1616 $sth->execute || $self->dberror($query);
1618 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1619 %{ $form->{IC}{FX_gain}{ $ref->{accno} } } = (
1621 description => $ref->{description}
1626 $query = qq|SELECT c.id, c.accno, c.description
1628 WHERE c.category = 'E'
1629 AND c.charttype = 'A'
1631 $sth = $dbh->prepare($query);
1632 $sth->execute || $self->dberror($query);
1634 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1635 %{ $form->{IC}{FX_loss}{ $ref->{accno} } } = (
1637 description => $ref->{description}
1642 # now get the tax rates and numbers
1643 $query = qq|SELECT c.id, c.accno, c.description,
1644 t.rate * 100 AS rate, t.taxnumber
1646 WHERE c.id = t.chart_id|;
1648 $sth = $dbh->prepare($query);
1649 $sth->execute || $form->dberror($query);
1651 while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1652 $form->{taxrates}{ $ref->{accno} }{id} = $ref->{id};
1653 $form->{taxrates}{ $ref->{accno} }{description} = $ref->{description};
1654 $form->{taxrates}{ $ref->{accno} }{taxnumber} = $ref->{taxnumber}
1655 if $ref->{taxnumber};
1656 $form->{taxrates}{ $ref->{accno} }{rate} = $ref->{rate} if $ref->{rate};
1662 $main::lxdebug->leave_sub();
1666 $main::lxdebug->enter_sub();
1668 my ($self, $myconfig, $form, $userspath) = @_;
1672 my $boundary = time;
1674 "$userspath/$boundary.$myconfig->{dbname}-$form->{dbversion}.sql";
1675 my $out = $form->{OUT};
1676 $form->{OUT} = ">$tmpfile";
1678 if ($form->{media} eq 'email') {
1683 $mail->{to} = qq|"$myconfig->{name}" <$myconfig->{email}>|;
1684 $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|;
1686 "Lx-Office Backup / $myconfig->{dbname}-$form->{dbversion}.sql";
1687 @{ $mail->{attachments} } = ($tmpfile);
1688 $mail->{version} = $form->{version};
1689 $mail->{fileid} = "$boundary.";
1691 $myconfig->{signature} =~ s/\\n/\r\n/g;
1692 $mail->{message} = "--\n$myconfig->{signature}";
1696 open(OUT, "$form->{OUT}") or $form->error("$form->{OUT} : $!");
1698 # get sequences, functions and triggers
1699 open(FH, "sql/lx-office.sql") or $form->error("sql/lx-office.sql : $!");
1712 # Remove DOS and Unix style line endings.
1715 # ignore comments or empty lines
1716 next if /^(--.*|\s+)$/;
1718 for (my $i = 0; $i < length($_); $i++) {
1719 my $char = substr($_, $i, 1);
1721 # Are we inside a string?
1723 if ($char eq $quote_chars[-1]) {
1729 if (($char eq "'") || ($char eq "\"")) {
1730 push(@quote_chars, $char);
1732 } elsif ($char eq ";") {
1734 # Query is complete. Check for triggers and functions.
1735 if ($query =~ /^create\s+function\s+\"?(\w+)\"?/i) {
1736 push(@functions, $query);
1738 } elsif ($query =~ /^create\s+trigger\s+\"?(\w+)\"?/i) {
1739 push(@triggers, $query);
1741 } elsif ($query =~ /^create\s+sequence\s+\"?(\w+)\"?/i) {
1742 push(@sequences, $1);
1744 } elsif ($query =~ /^create\s+table\s+\"?(\w+)\"?/i) {
1745 $tablespecs{$1} = $query;
1747 } elsif ($query =~ /^create\s+index\s+\"?(\w+)\"?/i) {
1748 push(@indices, $query);
1762 # connect to database
1763 my $dbh = $form->dbconnect($myconfig);
1765 # get all the tables
1766 my @tables = $dbh->tables('', '', 'customer', '', { noprefix => 0 });
1768 my $today = scalar localtime;
1770 $myconfig->{dbhost} = 'localhost' unless $myconfig->{dbhost};
1772 print OUT qq|-- Lx-Office Backup
1773 -- Dataset: $myconfig->{dbname}
1774 -- Version: $form->{dbversion}
1775 -- Host: $myconfig->{dbhost}
1776 -- Login: $form->{login}
1777 -- User: $myconfig->{name}
1781 $myconfig->{dboptions};
1785 print OUT "-- DROP Sequences\n";
1787 foreach $item (@sequences) {
1788 print OUT qq|DROP SEQUENCE $item;\n|;
1791 print OUT "-- DROP Triggers\n";
1793 foreach $item (@triggers) {
1794 if ($item =~ /^create\s+trigger\s+\"?(\w+)\"?\s+.*on\s+\"?(\w+)\"?\s+/i) {
1795 print OUT qq|DROP TRIGGER "$1" ON "$2";\n|;
1799 print OUT "-- DROP Functions\n";
1801 foreach $item (@functions) {
1802 if ($item =~ /^create\s+function\s+\"?(\w+)\"?/i) {
1803 print OUT qq|DROP FUNCTION "$1" ();\n|;
1807 foreach $table (@tables) {
1808 if (!($table =~ /^sql_.*/)) {
1809 my $query = qq|SELECT * FROM $table|;
1811 my $sth = $dbh->prepare($query);
1812 $sth->execute || $form->dberror($query);
1814 $query = "INSERT INTO $table (";
1815 map { $query .= qq|$sth->{NAME}->[$_],| }
1816 (0 .. $sth->{NUM_OF_FIELDS} - 1);
1819 $query .= ") VALUES";
1821 if ($tablespecs{$table}) {
1823 print(OUT "DROP TABLE $table;\n");
1824 print(OUT $tablespecs{$table}, ";\n");
1827 print(OUT "DELETE FROM $table;\n");
1829 while (my @arr = $sth->fetchrow_array) {
1832 foreach my $item (@arr) {
1833 if (defined $item) {
1834 $item =~ s/\'/\'\'/g;
1835 $fields .= qq|'$item',|;
1844 print OUT qq|$query $fields;\n|;
1851 # create indices, sequences, functions and triggers
1853 print(OUT "-- CREATE Indices\n");
1854 map({ print(OUT "$_;\n"); } @indices);
1856 print OUT "-- CREATE Sequences\n";
1857 foreach $item (@sequences) {
1858 $query = qq|SELECT last_value FROM $item|;
1859 $sth = $dbh->prepare($query);
1860 $sth->execute || $form->dberror($query);
1861 my ($id) = $sth->fetchrow_array;
1865 CREATE SEQUENCE $item START $id;
1869 print OUT "-- CREATE Functions\n";
1872 map { print(OUT $_, ";\n"); } @functions;
1874 print OUT "-- CREATE Triggers\n";
1877 map { print(OUT $_, ";\n"); } @triggers;
1884 my @args = ("gzip", "$tmpfile");
1885 system(@args) == 0 or $form->error("$args[0] : $?");
1889 if ($form->{media} eq 'email') {
1890 @{ $mail->{attachments} } = ($tmpfile);
1891 $err = $mail->send($out);
1894 if ($form->{media} eq 'file') {
1896 open(IN, "$tmpfile") or $form->error("$tmpfile : $!");
1897 open(OUT, ">-") or $form->error("STDOUT : $!");
1899 print OUT qq|Content-Type: application/x-tar-gzip;
1900 Content-Disposition: attachment; filename="$myconfig->{dbname}-$form->{dbversion}.sql.gz"
1915 $main::lxdebug->leave_sub();
1919 $main::lxdebug->enter_sub();
1921 my ($self, $myconfig, $form) = @_;
1923 my $dbh = $form->dbconnect($myconfig);
1925 my $query = qq|SELECT closedto, revtrans FROM defaults|;
1926 my $sth = $dbh->prepare($query);
1927 $sth->execute || $form->dberror($query);
1929 ($form->{closedto}, $form->{revtrans}) = $sth->fetchrow_array;
1935 $main::lxdebug->leave_sub();
1939 $main::lxdebug->enter_sub();
1941 my ($self, $myconfig, $form) = @_;
1943 my $dbh = $form->dbconnect($myconfig);
1945 if ($form->{revtrans}) {
1947 $query = qq|UPDATE defaults SET closedto = NULL,
1949 } elsif ($form->{closedto}) {
1951 $query = qq|UPDATE defaults SET closedto = '$form->{closedto}',
1955 $query = qq|UPDATE defaults SET closedto = NULL,
1959 # set close in defaults
1960 $dbh->do($query) || $form->dberror($query);
1964 $main::lxdebug->leave_sub();
1968 my ($self, $units, $unit_name, $factor) = @_;
1970 $factor = 1 unless ($factor);
1972 my $unit = $units->{$unit_name};
1974 if (!defined($unit) || !$unit->{"base_unit"} ||
1975 ($unit_name eq $unit->{"base_unit"})) {
1976 return ($unit_name, $factor);
1979 return AM->get_base_unit($units, $unit->{"base_unit"}, $factor * $unit->{"factor"});
1982 sub retrieve_units {
1983 $main::lxdebug->enter_sub();
1985 my ($self, $myconfig, $form, $type, $prefix) = @_;
1987 my $dbh = $form->dbconnect($myconfig);
1989 my $query = "SELECT *, base_unit AS original_base_unit FROM units";
1992 $query .= " WHERE (type = ?)";
1996 my $sth = $dbh->prepare($query);
1997 $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
2000 while (my $ref = $sth->fetchrow_hashref()) {
2001 $units->{$ref->{"name"}} = $ref;
2005 foreach my $unit (keys(%{$units})) {
2006 ($units->{$unit}->{"${prefix}base_unit"}, $units->{$unit}->{"${prefix}factor"}) = AM->get_base_unit($units, $unit);
2011 $main::lxdebug->leave_sub();
2017 $main::lxdebug->enter_sub();
2019 my ($self, $myconfig, $form, $units) = @_;
2021 my $dbh = $form->dbconnect($myconfig);
2023 foreach my $unit (values(%{$units})) {
2024 my $base_unit = $unit->{"original_base_unit"};
2025 while ($base_unit) {
2026 $units->{$base_unit}->{"DEPENDING_UNITS"} = [] unless ($units->{$base_unit}->{"DEPENDING_UNITS"});
2027 push(@{$units->{$base_unit}->{"DEPENDING_UNITS"}}, $unit->{"name"});
2028 $base_unit = $units->{$base_unit}->{"original_base_unit"};
2032 foreach my $unit (values(%{$units})) {
2033 $unit->{"in_use"} = 0;
2034 map({ $_ = $dbh->quote($_); } @{$unit->{"DEPENDING_UNITS"}});
2036 foreach my $table (qw(parts invoice orderitems)) {
2037 my $query = "SELECT COUNT(*) FROM $table WHERE unit ";
2039 if (0 == scalar(@{$unit->{"DEPENDING_UNITS"}})) {
2040 $query .= "= " . $dbh->quote($unit->{"name"});
2042 $query .= "IN (" . $dbh->quote($unit->{"name"}) . "," . join(",", @{$unit->{"DEPENDING_UNITS"}}) . ")";
2045 my ($count) = $dbh->selectrow_array($query);
2046 $form->dberror($query) if ($dbh->err);
2049 $unit->{"in_use"} = 1;
2057 $main::lxdebug->leave_sub();
2060 sub unit_select_data {
2061 $main::lxdebug->enter_sub();
2063 my ($self, $units, $selected, $empty_entry) = @_;
2068 push(@{$select}, { "name" => "", "base_unit" => "", "factor" => "", "selected" => "" });
2071 foreach my $unit (sort({ lc($a) cmp lc($b) } keys(%{$units}))) {
2072 push(@{$select}, { "name" => $unit,
2073 "base_unit" => $units->{$unit}->{"base_unit"},
2074 "factor" => $units->{$unit}->{"factor"},
2075 "selected" => ($unit eq $selected) ? "selected" : "" });
2078 $main::lxdebug->leave_sub();
2083 sub unit_select_html {
2084 $main::lxdebug->enter_sub();
2086 my ($self, $units, $name, $selected, $convertible_into) = @_;
2088 my $select = "<select name=${name}>";
2090 foreach my $unit (sort({ lc($a) cmp lc($b) } keys(%{$units}))) {
2091 if (!$convertible_into ||
2092 ($units->{$convertible_into} &&
2093 ($units->{$convertible_into}->{"base_unit"} eq $units->{$unit}->{"base_unit"}))) {
2094 $select .= "<option" . (($unit eq $selected) ? " selected" : "") . ">${unit}</option>";
2097 $select .= "</select>";
2099 $main::lxdebug->leave_sub();
2105 $main::lxdebug->enter_sub();
2107 my ($self, $myconfig, $form, $name, $base_unit, $factor, $type) = @_;
2109 my $dbh = $form->dbconnect($myconfig);
2111 my $query = "INSERT INTO units (name, base_unit, factor, type) VALUES (?, ?, ?, ?)";
2112 $dbh->do($query, undef, $name, $base_unit, $factor, $type) || $form->dberror($query . " ($name, $base_unit, $factor, $type)");
2115 $main::lxdebug->leave_sub();
2119 $main::lxdebug->enter_sub();
2121 my ($self, $myconfig, $form, $type, $units, $delete_units) = @_;
2123 my $dbh = $form->dbconnect_noauto($myconfig);
2125 my ($base_unit, $unit, $sth, $query);
2127 if ($delete_units && (0 != scalar(@{$delete_units}))) {
2128 $query = "DELETE FROM units WHERE name = ?";
2129 $sth = $dbh->prepare($query);
2130 map({ $sth->execute($_) || $form->dberror($query . " ($_)"); } @{$delete_units});
2134 $query = "UPDATE units SET name = ?, base_unit = ?, factor = ? WHERE name = ?";
2135 $sth = $dbh->prepare($query);
2137 foreach $unit (values(%{$units})) {
2138 $unit->{"depth"} = 0;
2139 my $base_unit = $unit;
2140 while ($base_unit->{"base_unit"}) {
2142 $base_unit = $units->{$base_unit->{"base_unit"}};
2146 foreach $unit (sort({ $a->{"depth"} <=> $b->{"depth"} } values(%{$units}))) {
2147 next if ($unit->{"unchanged_unit"});
2149 my @values = ($unit->{"name"}, $unit->{"base_unit"}, $unit->{"factor"}, $unit->{"old_name"});
2150 $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
2157 $main::lxdebug->leave_sub();