1 #====================================================================
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
7 #====================================================================
11 use Time::HiRes qw(gettimeofday);
15 use vars qw(@db_encodings %db_encoding_to_charset);
18 { "label" => "ASCII", "dbencoding" => "SQL_ASCII", "charset" => "ASCII" },
19 { "label" => "UTF-8 Unicode", "dbencoding" => "UNICODE", "charset" => "UTF-8" },
20 { "label" => "ISO 8859-1", "dbencoding" => "LATIN1", "charset" => "ISO-8859-1" },
21 { "label" => "ISO 8859-2", "dbencoding" => "LATIN2", "charset" => "ISO-8859-2" },
22 { "label" => "ISO 8859-3", "dbencoding" => "LATIN3", "charset" => "ISO-8859-3" },
23 { "label" => "ISO 8859-4", "dbencoding" => "LATIN4", "charset" => "ISO-8859-4" },
24 { "label" => "ISO 8859-5", "dbencoding" => "LATIN5", "charset" => "ISO-8859-5" },
25 { "label" => "ISO 8859-15", "dbencoding" => "LATIN9", "charset" => "ISO-8859-15" },
26 { "label" => "KOI8-R", "dbencoding" => "KOI8", "charset" => "KOI8-R" },
27 { "label" => "Windows CP1251", "dbencoding" => "WIN", "charset" => "CP1251" },
28 { "label" => "Windows CP866", "dbencoding" => "ALT", "charset" => "CP866" },
31 %db_encoding_to_charset = map { $_->{dbencoding}, $_->{charset} } @db_encodings;
32 %charset_to_db_encoding = map { $_->{charset}, $_->{dbencoding} } @db_encodings;
34 use constant DEFAULT_CHARSET => 'ISO-8859-15';
37 my ($a, $b) = gettimeofday();
38 return "${a}-${b}-${$}";
42 return "/tmp/lx-office-tmp-" . unique_id();
46 $main::lxdebug->enter_sub();
48 my ($self, $myconfig, $form, $order_by, $order_dir) = @_;
50 my $dbh = $form->dbconnect($myconfig);
52 my (@filter_values, $filter);
54 foreach (qw(partnumber description)) {
55 next unless $form->{$_};
57 $filter .= qq| AND ($_ ILIKE ?)|;
58 push @filter_values, '%' . $form->{$_} . '%';
61 if ($form->{no_assemblies}) {
62 $filter .= qq| AND (NOT COALESCE(assembly, 'f'))|;
65 if ($form->{no_services}) {
66 $filter .= qq| AND (COALESCE(inventory_accno_id, 0) > 0)|;
69 substr($filter, 1, 3) = "WHERE" if ($filter);
71 $order_by =~ s/[^a-zA-Z_]//g;
72 $order_dir = $order_dir ? "ASC" : "DESC";
75 qq|SELECT id, partnumber, description | .
76 qq|FROM parts $filter | .
77 qq|ORDER BY $order_by $order_dir|;
78 my $sth = $dbh->prepare($query);
79 $sth->execute(@filter_values) || $form->dberror($query . " (" . join(", ", @filter_values) . ")");
81 while (my $ref = $sth->fetchrow_hashref()) {
82 push(@{$parts}, $ref);
87 $main::lxdebug->leave_sub();
92 sub retrieve_projects {
93 $main::lxdebug->enter_sub();
95 my ($self, $myconfig, $form, $order_by, $order_dir) = @_;
97 my $dbh = $form->dbconnect($myconfig);
99 my (@filter_values, $filter);
100 if ($form->{"projectnumber"}) {
101 $filter .= qq| AND (projectnumber ILIKE ?)|;
102 push(@filter_values, '%' . $form->{"projectnumber"} . '%');
104 if ($form->{"description"}) {
105 $filter .= qq| AND (description ILIKE ?)|;
106 push(@filter_values, '%' . $form->{"description"} . '%');
108 substr($filter, 1, 3) = "WHERE" if ($filter);
110 $order_by =~ s/[^a-zA-Z_]//g;
111 $order_dir = $order_dir ? "ASC" : "DESC";
114 qq|SELECT id, projectnumber, description | .
115 qq|FROM project $filter | .
116 qq|ORDER BY $order_by $order_dir|;
117 my $sth = $dbh->prepare($query);
118 $sth->execute(@filter_values) || $form->dberror($query . " (" . join(", ", @filter_values) . ")");
120 while (my $ref = $sth->fetchrow_hashref()) {
121 push(@{$projects}, $ref);
126 $main::lxdebug->leave_sub();
131 sub retrieve_employees {
132 $main::lxdebug->enter_sub();
134 my ($self, $myconfig, $form, $order_by, $order_dir) = @_;
136 my $dbh = $form->dbconnect($myconfig);
138 my (@filter_values, $filter);
139 if ($form->{"name"}) {
140 $filter .= qq| AND (name ILIKE ?)|;
141 push(@filter_values, '%' . $form->{"name"} . '%');
143 substr($filter, 1, 3) = "WHERE" if ($filter);
145 $order_by =~ s/[^a-zA-Z_]//g;
146 $order_dir = $order_dir ? "ASC" : "DESC";
149 qq|SELECT id, name | .
150 qq|FROM employee $filter | .
151 qq|ORDER BY $order_by $order_dir|;
152 my $sth = $dbh->prepare($query);
153 $sth->execute(@filter_values) || $form->dberror($query . " (" . join(", ", @filter_values) . ")");
155 while (my $ref = $sth->fetchrow_hashref()) {
156 push(@{$employees}, $ref);
161 $main::lxdebug->leave_sub();
166 sub retrieve_customers_or_vendors {
167 $main::lxdebug->enter_sub();
169 my ($self, $myconfig, $form, $order_by, $order_dir, $is_vendor, $allow_both) = @_;
171 my $dbh = $form->dbconnect($myconfig);
173 my (@filter_values, $filter);
174 if ($form->{"name"}) {
175 $filter .= " AND (TABLE.name ILIKE ?)";
176 push(@filter_values, '%' . $form->{"name"} . '%');
178 if (!$form->{"obsolete"}) {
179 $filter .= " AND NOT TABLE.obsolete";
181 substr($filter, 1, 3) = "WHERE" if ($filter);
183 $order_by =~ s/[^a-zA-Z_]//g;
184 $order_dir = $order_dir ? "ASC" : "DESC";
186 my (@queries, @query_parameters);
188 if ($allow_both || !$is_vendor) {
189 my $c_filter = $filter;
190 $c_filter =~ s/TABLE/c/g;
191 push(@queries, qq|SELECT
192 c.id, c.name, 0 AS customer_is_vendor,
193 c.street, c.zipcode, c.city,
194 ct.cp_greeting, ct.cp_title, ct.cp_givenname, ct.cp_name
196 LEFT JOIN contacts ct ON (c.id = ct.cp_cv_id)
198 push(@query_parameters, @filter_values);
201 if ($allow_both || $is_vendor) {
202 my $v_filter = $filter;
203 $v_filter =~ s/TABLE/v/g;
204 push(@queries, qq|SELECT
205 v.id, v.name, 1 AS customer_is_vendor,
206 v.street, v.zipcode, v.city,
207 ct.cp_greeting, ct.cp_title, ct.cp_givenname, ct.cp_name
209 LEFT JOIN contacts ct ON (v.id = ct.cp_cv_id)
211 push(@query_parameters, @filter_values);
214 my $query = join(" UNION ", @queries) . " ORDER BY $order_by $order_dir";
215 my $sth = $dbh->prepare($query);
216 $sth->execute(@query_parameters) || $form->dberror($query . " (" . join(", ", @query_parameters) . ")");
218 while (my $ref = $sth->fetchrow_hashref()) {
219 push(@{$customers}, $ref);
224 $main::lxdebug->leave_sub();
229 sub retrieve_delivery_customer {
230 $main::lxdebug->enter_sub();
232 my ($self, $myconfig, $form, $order_by, $order_dir) = @_;
234 my $dbh = $form->dbconnect($myconfig);
236 my (@filter_values, $filter);
237 if ($form->{"name"}) {
238 $filter .= qq| (name ILIKE ?) AND|;
239 push(@filter_values, '%' . $form->{"name"} . '%');
242 $order_by =~ s/[^a-zA-Z_]//g;
243 $order_dir = $order_dir ? "ASC" : "DESC";
246 qq!SELECT id, name, customernumber, (street || ', ' || zipcode || city) AS address ! .
248 qq!WHERE $filter business_id = (SELECT id FROM business WHERE description = 'Endkunde') ! .
249 qq!ORDER BY $order_by $order_dir!;
250 my $sth = $dbh->prepare($query);
251 $sth->execute(@filter_values) ||
252 $form->dberror($query . " (" . join(", ", @filter_values) . ")");
253 my $delivery_customers = [];
254 while (my $ref = $sth->fetchrow_hashref()) {
255 push(@{$delivery_customers}, $ref);
260 $main::lxdebug->leave_sub();
262 return $delivery_customers;
265 sub retrieve_vendor {
266 $main::lxdebug->enter_sub();
268 my ($self, $myconfig, $form, $order_by, $order_dir) = @_;
270 my $dbh = $form->dbconnect($myconfig);
272 my (@filter_values, $filter);
273 if ($form->{"name"}) {
274 $filter .= qq| (name ILIKE ?) AND|;
275 push(@filter_values, '%' . $form->{"name"} . '%');
278 $order_by =~ s/[^a-zA-Z_]//g;
279 $order_dir = $order_dir ? "ASC" : "DESC";
282 qq!SELECT id, name, customernumber, (street || ', ' || zipcode || city) AS address FROM customer ! .
283 qq!WHERE $filter business_id = (SELECT id FROM business WHERE description = 'HƤndler') ! .
284 qq!ORDER BY $order_by $order_dir!;
285 my $sth = $dbh->prepare($query);
286 $sth->execute(@filter_values) ||
287 $form->dberror($query . " (" . join(", ", @filter_values) . ")");
289 while (my $ref = $sth->fetchrow_hashref()) {
290 push(@{$vendors}, $ref);
295 $main::lxdebug->leave_sub();
300 sub mkdir_with_parents {
301 $main::lxdebug->enter_sub();
303 my ($full_path) = @_;
307 $full_path =~ s|/+|/|;
309 foreach my $part (split(m|/|, $full_path)) {
310 $path .= "/" if ($path);
313 die("Could not create directory '$path' because a file exists with " .
314 "the same name.\n") if (-f $path);
317 mkdir($path, 0770) || die("Could not create the directory '$path'. " .
322 $main::lxdebug->leave_sub();
326 $main::lxdebug->enter_sub();
330 return $main::lxdebug->leave_sub()
331 unless ($main::webdav && $form->{id});
335 $form->{WEBDAV} = [];
337 if ($form->{type} eq "sales_quotation") {
338 ($path, $number) = ("angebote", $form->{quonumber});
339 } elsif ($form->{type} eq "sales_order") {
340 ($path, $number) = ("bestellungen", $form->{ordnumber});
341 } elsif ($form->{type} eq "request_quotation") {
342 ($path, $number) = ("anfragen", $form->{quonumber});
343 } elsif ($form->{type} eq "purchase_order") {
344 ($path, $number) = ("lieferantenbestellungen", $form->{ordnumber});
345 } elsif ($form->{type} eq "credit_note") {
346 ($path, $number) = ("gutschriften", $form->{invnumber});
347 } elsif ($form->{vc} eq "customer") {
348 ($path, $number) = ("rechnungen", $form->{invnumber});
350 ($path, $number) = ("einkaufsrechnungen", $form->{invnumber});
353 return $main::lxdebug->leave_sub() unless ($path && $number);
355 $number =~ s|[/\\]|_|g;
357 $path = "webdav/${path}/${number}";
360 mkdir_with_parents($path);
363 my $base_path = substr($ENV{'SCRIPT_NAME'}, 1);
364 $base_path =~ s|[^/]+$||;
365 $base_path =~ s|/$||;
367 if (opendir $dir, $path) {
368 foreach my $file (sort { lc $a cmp lc $b } readdir $dir) {
369 next if (($file eq '.') || ($file eq '..'));
374 my $is_directory = -d "$path/$file";
376 $file = join('/', map { $form->escape($_) } grep { $_ } split m|/+|, "$path/$file");
377 $file .= '/' if ($is_directory);
379 push @{ $form->{WEBDAV} }, {
381 'link' => ($ENV{"HTTPS"} ? "https://" : "http://") . $ENV{'SERVER_NAME'} . "/$base_path/$file",
382 'type' => $is_directory ? $main::locale->text('Directory') : $main::locale->text('File'),
390 $main::lxdebug->leave_sub();
394 $main::lxdebug->enter_sub();
396 my ($self, $myconfig, $form, $vc, $vc_id) = @_;
398 $vc = $vc eq "customer" ? "customer" : "vendor";
400 my $dbh = $form->dbconnect($myconfig);
407 pt.description AS payment_terms,
408 b.description AS business,
409 l.description AS language
411 LEFT JOIN payment_terms pt ON (vc.payment_id = pt.id)
412 LEFT JOIN business b ON (vc.business_id = b.id)
413 LEFT JOIN language l ON (vc.language_id = l.id)
415 my $ref = selectfirst_hashref_query($form, $dbh, $query, $vc_id);
419 $main::lxdebug->leave_sub();
423 map { $form->{$_} = $ref->{$_} } keys %{ $ref };
425 map { $form->{$_} = $form->format_amount($myconfig, $form->{$_} * 1) } qw(discount creditlimit);
427 $query = qq|SELECT * FROM shipto WHERE (trans_id = ?)|;
428 $form->{SHIPTO} = selectall_hashref_query($form, $dbh, $query, $vc_id);
430 $query = qq|SELECT * FROM contacts WHERE (cp_cv_id = ?)|;
431 $form->{CONTACTS} = selectall_hashref_query($form, $dbh, $query, $vc_id);
435 $main::lxdebug->leave_sub();
440 sub get_shipto_by_id {
441 $main::lxdebug->enter_sub();
443 my ($self, $myconfig, $form, $shipto_id, $prefix) = @_;
447 my $dbh = $form->dbconnect($myconfig);
449 my $query = qq|SELECT * FROM shipto WHERE shipto_id = ?|;
450 my $ref = selectfirst_hashref_query($form, $dbh, $query, $shipto_id);
452 map { $form->{"${prefix}${_}"} = $ref->{$_} } keys %{ $ref } if $ref;
456 $main::lxdebug->leave_sub();
459 sub save_email_status {
460 $main::lxdebug->enter_sub();
462 my ($self, $myconfig, $form) = @_;
464 my ($table, $query, $dbh);
466 if ($form->{script} eq 'oe.pl') {
469 } elsif ($form->{script} eq 'is.pl') {
472 } elsif ($form->{script} eq 'ir.pl') {
477 return $main::lxdebug->leave_sub() if (!$form->{id} || !$table || !$form->{formname});
479 $dbh = $form->get_standard_dbh($myconfig);
481 my ($intnotes) = selectrow_query($form, $dbh, qq|SELECT intnotes FROM $table WHERE id = ?|, $form->{id});
483 $intnotes =~ s|\r||g;
484 $intnotes =~ s|\n$||;
486 $intnotes .= "\n\n" if ($intnotes);
488 my $cc = $main::locale->text('Cc') . ": $form->{cc}\n" if $form->{cc};
489 my $bcc = $main::locale->text('Bcc') . ": $form->{bcc}\n" if $form->{bcc};
490 my $now = scalar localtime;
492 $intnotes .= $main::locale->text('[email]') . "\n"
493 . $main::locale->text('Date') . ": $now\n"
494 . $main::locale->text('To (email)') . ": $form->{email}\n"
496 . $main::locale->text('Subject') . ": $form->{subject}\n\n"
497 . $main::locale->text('Message') . ": $form->{message}";
499 $intnotes =~ s|\r||g;
501 do_query($form, $dbh, qq|UPDATE $table SET intnotes = ? WHERE id = ?|, $intnotes, $form->{id});
503 $form->save_status($dbh);
507 $main::lxdebug->leave_sub();
513 foreach my $key (@_) {
514 if ((ref $key eq '') && !defined $params->{$key}) {
515 my $subroutine = (caller(1))[3];
516 $main::form->error($main::locale->text("Missing parameter #1 in call to sub #2.", $key, $subroutine));
518 } elsif (ref $key eq 'ARRAY') {
520 foreach $subkey (@{ $key }) {
521 if (defined $params->{$subkey}) {
528 my $subroutine = (caller(1))[3];
529 $main::form->error($main::locale->text("Missing parameter (at least one of #1) in call to sub #2.", join(', ', @{ $key }), $subroutine));
538 foreach my $key (@_) {
539 if ((ref $key eq '') && !exists $params->{$key}) {
540 my $subroutine = (caller(1))[3];
541 $main::form->error($main::locale->text("Missing parameter #1 in call to sub #2.", $key, $subroutine));
543 } elsif (ref $key eq 'ARRAY') {
545 foreach $subkey (@{ $key }) {
546 if (exists $params->{$subkey}) {
553 my $subroutine = (caller(1))[3];
554 $main::form->error($main::locale->text("Missing parameter (at least one of #1) in call to sub #2.", join(', ', @{ $key }), $subroutine));