1 #=====================================================================
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
6 ######################################################################
8 # Stuff that can be used from other modules
10 ######################################################################
20 $main::lxdebug->enter_sub(2);
22 my $form = $main::form;
24 my $script = $form->{script};
28 foreach my $key (@_) {
31 if ($key =~ /(.*?)=(.*)/) {
39 foreach my $var ($form->flatten_variables($key)) {
40 push @parts, E($var->{key}) . '=' . E($var->{value});
45 my $url = "${script}?" . join('&', @parts);
47 $main::lxdebug->leave_sub(2);
52 # -------------------------------------------------------------------------
55 $main::lxdebug->enter_sub();
57 my ($callback_sub, @parts) = @_;
59 my $form = $main::form;
60 my $locale = $main::locale;
62 my $remap_parts_id = 0;
63 if (defined($parts[0]->{parts_id}) && !defined($parts[0]->{id})) {
65 map { $_->{id} = $_->{parts_id}; } @parts;
68 my $remap_partnumber = 0;
69 if (defined($parts[0]->{partnumber}) && !defined($parts[0]->{number})) {
70 $remap_partnumber = 1;
71 map { $_->{number} = $_->{partnumber}; } @parts;
75 if (defined($parts[0]->{chargenumber})) {
77 map { $_->{has_charge} = 1; } @parts;
79 my $has_bestbefore = 0;
80 if (defined($parts[0]->{bestbefore})) {
82 map { $_->{has_bestbefore} = 1; } @parts;
85 if (defined($parts[0]->{ean})) {
87 map { $_->{has_ean} = 1; } @parts;
90 my $old_form = save_form();
93 print $form->parse_html_template("generic/select_part",
95 "old_form" => $old_form,
96 "title" => $locale->text("Select a part"),
97 "nextsub" => "select_part_internal",
98 "callback_sub" => $callback_sub,
99 "has_charge" => $has_charge,
100 "has_bestbefore" => $has_bestbefore,
101 "has_ean" => $has_ean,
102 "remap_parts_id" => $remap_parts_id,
103 "remap_partnumber" => $remap_partnumber });
105 $main::lxdebug->leave_sub();
108 sub select_part_internal {
109 $main::lxdebug->enter_sub();
111 my $form = $main::form;
113 my ($new_item, $callback_sub);
115 my $re = "^new_.*_$form->{selection}\$";
117 foreach (grep /$re/, keys %{ $form }) {
119 $new_key =~ s/^new_//;
120 $new_key =~ s/_\d+$//;
121 $new_item->{$new_key} = $form->{$_};
124 if ($form->{remap_parts_id}) {
125 $new_item->{parts_id} = $new_item->{id};
126 delete $new_item->{id};
129 if ($form->{remap_partnumber}) {
130 $new_item->{partnumber} = $new_item->{number};
131 delete $new_item->{number};
134 $callback_sub = $form->{callback_sub};
136 restore_form($form->{old_form});
138 call_sub($callback_sub, $new_item);
140 $main::lxdebug->leave_sub();
143 sub part_selection_internal {
144 $main::lxdebug->enter_sub();
146 my $form = $main::form;
147 my %myconfig = %main::myconfig;
148 my $locale = $main::locale;
150 my $order_by = "description";
151 $order_by = $form->{"order_by"} if (defined($form->{"order_by"}));
153 $order_dir = $form->{"order_dir"} if (defined($form->{"order_dir"}));
157 foreach my $opt (split m/:/, $form->{options}) {
159 my ($key, $value) = split m/=/, $opt, 2;
160 $options{$key} = $value;
167 map { $form->{$_} = $options{$_} if ($options{$_}) } qw(no_services no_assemblies assemblies click_button);
169 my $parts = Common->retrieve_parts(\%myconfig, $form, $order_by, $order_dir);
172 if (0 == scalar(@{$parts})) {
173 $form->show_generic_information($locale->text("No part was found matching the search parameters."));
174 } elsif (1 == scalar(@{$parts})) {
175 $onload = "part_selected('1')";
178 map { $parts->[$_]->{selected} = $_ ? 0 : 1; } (0..$#{$parts});
180 my $callback = build_std_url('action=part_selection_internal', qw(partnumber description input_partnumber input_description input_partsid),
181 grep({ /^[fl]_/ } keys %{ $form }));
183 my @header_sort = qw(partnumber description);
184 my %header_title = ( "partnumber" => $locale->text("Part Number"),
185 "description" => $locale->text("Part description"),
189 map(+{ "column_title" => $header_title{$_},
191 "callback" => $callback . "order_by=${_}&order_dir=" . ($order_by eq $_ ? 1 - $order_dir : $order_dir),
195 $form->{formname} ||= 'Form';
197 $form->{title} = $locale->text("Select a part");
199 print $form->parse_html_template("generic/part_selection", { "HEADER" => \@header,
201 "onload" => $onload });
203 $main::lxdebug->leave_sub();
206 # -------------------------------------------------------------------------
208 sub delivery_customer_selection {
209 $main::lxdebug->enter_sub();
211 my $form = $main::form;
212 my %myconfig = %main::myconfig;
213 my $locale = $main::locale;
215 my $order_by = "name";
216 $order_by = $form->{"order_by"} if (defined($form->{"order_by"}));
218 $order_dir = $form->{"order_dir"} if (defined($form->{"order_dir"}));
220 my $delivery = Common->retrieve_delivery_customer(\%myconfig, $form, $order_by, $order_dir);
221 map({ $delivery->[$_]->{"selected"} = $_ ? 0 : 1; } (0..$#{$delivery}));
224 if (0 == scalar(@{$delivery})) {
225 $form->show_generic_information($locale->text("No Customer was found matching the search parameters."));
226 } elsif (1 == scalar(@{$delivery})) {
227 $onload = "customer_selected('1')";
230 my $callback = "$form->{script}?action=delivery_customer_selection&";
231 map({ $callback .= "$_=" . $form->escape($form->{$_}) . "&" }
232 (qw(name input_name input_id), grep({ /^[fl]_/ } keys %$form)));
234 my @header_sort = qw(name customernumber address);
235 my %header_title = ( "name" => $locale->text("Name"),
236 "customernumber" => $locale->text("Customer Number"),
237 "address" => $locale->text("Address"),
241 map(+{ "column_title" => $header_title{$_},
243 "callback" => $callback . "order_by=${_}&order_dir=" . ($order_by eq $_ ? 1 - $order_dir : $order_dir),
247 $form->{"title"} = $locale->text("Select a Customer");
249 print $form->parse_html_template("generic/select_delivery_customer", { "HEADER" => \@header,
250 "DELIVERY" => $delivery,
251 "onload" => $onload });
253 $main::lxdebug->leave_sub();
256 # -------------------------------------------------------------------------
258 sub vendor_selection {
259 $main::lxdebug->enter_sub();
261 my $form = $main::form;
262 my %myconfig = %main::myconfig;
263 my $locale = $main::locale;
265 my $order_by = "name";
266 $order_by = $form->{"order_by"} if (defined($form->{"order_by"}));
268 $order_dir = $form->{"order_dir"} if (defined($form->{"order_dir"}));
270 my $vendor = Common->retrieve_vendor(\%myconfig, $form, $order_by, $order_dir);
271 map({ $vendor->[$_]->{"selected"} = $_ ? 0 : 1; } (0..$#{$vendor}));
274 if (0 == scalar(@{$vendor})) {
275 $form->show_generic_information($locale->text("No Vendor was found matching the search parameters."));
276 } elsif (1 == scalar(@{$vendor})) {
277 $onload = "vendor_selected('1')";
280 my $callback = "$form->{script}?action=vendor_selection&";
281 map({ $callback .= "$_=" . $form->escape($form->{$_}) . "&" }
282 (qw(name input_name input_id), grep({ /^[fl]_/ } keys %$form)));
284 my @header_sort = qw(name customernumber address);
285 my %header_title = ( "name" => $locale->text("Name"),
286 "customernumber" => $locale->text("Customer Number"),
287 "address" => $locale->text("Address"),
291 map(+{ "column_title" => $header_title{$_},
293 "callback" => $callback . "order_by=${_}&order_dir=" . ($order_by eq $_ ? 1 - $order_dir : $order_dir),
297 $form->{"title"} = $locale->text("Select a Customer");
299 print $form->parse_html_template("generic/select_vendor", { "HEADER" => \@header,
301 "onload" => $onload });
303 $main::lxdebug->leave_sub();
306 # -------------------------------------------------------------------------
309 $main::lxdebug->enter_sub();
311 my $form = $main::form;
312 my $locale = $main::locale;
314 $form->{formel} =~ s/\r\n//g;
316 my ($variable_string, $formel) = split /###/,$form->{formel};
318 my $onload; # note! this sub is mostly called over a javascript invocation, and it's unlikey that onload is set.
320 foreach my $item (split m/;/, $variable_string) {
321 next unless $item =~ m/^ \s* (\w+) \s* = \s* (\w+) \s* (\w+) \s* $/x;
329 my @header_sort = qw(variable value unit);
331 variable => $locale->text("Variable"),
332 value => $locale->text("Value"),
333 unit => $locale->text("Unit"),
336 column_title => $header_title{$_},
340 $form->{formel} = $formel;
341 $form->{title} = $locale->text("Please enter values");
343 print $form->parse_html_template("generic/calculate_qty", { "HEADER" => \@header,
344 "VARIABLES" => \@variable,
345 "onload" => $onload });
347 $main::lxdebug->leave_sub();
350 # -------------------------------------------------------------------------
352 sub set_longdescription {
353 $main::lxdebug->enter_sub();
355 my $form = $main::form;
356 my $locale = $main::locale;
358 $form->{title} = $locale->text("Enter longdescription");
360 print $form->parse_html_template("generic/set_longdescription");
362 $main::lxdebug->leave_sub();
365 # -------------------------------------------------------------------------
368 return $main::locale->quote_special_chars('HTML', $_[0]);
372 return $main::locale->quote_special_chars('URL@HTML', $_[0]);
376 return $main::form->escape($_[0]);
382 $element =~ s/tabindex\s*=\s*"\d+"//;
387 $main::lxdebug->enter_sub();
389 my ($dateformat, $longformat, @indices) = @_;
391 my $form = $main::form;
392 my %myconfig = %main::myconfig;
393 my $locale = $main::locale;
395 $dateformat = $myconfig{"dateformat"} unless ($dateformat);
397 foreach my $idx (@indices) {
398 if ($form->{TEMPLATE_ARRAYS} && (ref($form->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
399 for (my $i = 0; $i < scalar(@{$form->{TEMPLATE_ARRAYS}->{$idx}}); $i++) {
400 $form->{TEMPLATE_ARRAYS}->{$idx}->[$i] =
401 $locale->reformat_date(\%myconfig, $form->{TEMPLATE_ARRAYS}->{$idx}->[$i],
402 $dateformat, $longformat);
406 next unless (defined($form->{$idx}));
408 if (!ref($form->{$idx})) {
409 $form->{$idx} = $locale->reformat_date(\%myconfig, $form->{$idx},
410 $dateformat, $longformat);
412 } elsif (ref($form->{$idx}) eq "ARRAY") {
413 for (my $i = 0; $i < scalar(@{$form->{$idx}}); $i++) {
414 $form->{$idx}->[$i] =
415 $locale->reformat_date(\%myconfig, $form->{$idx}->[$i],
416 $dateformat, $longformat);
421 $main::lxdebug->leave_sub();
424 sub reformat_numbers {
425 $main::lxdebug->enter_sub();
427 my ($numberformat, $places, @indices) = @_;
429 my $form = $main::form;
430 my %myconfig = %main::myconfig;
432 return $main::lxdebug->leave_sub()
433 if (!$numberformat || ($numberformat eq $myconfig{"numberformat"}));
435 foreach my $idx (@indices) {
436 if ($form->{TEMPLATE_ARRAYS} && (ref($form->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
437 for (my $i = 0; $i < scalar(@{$form->{TEMPLATE_ARRAYS}->{$idx}}); $i++) {
438 $form->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $form->parse_amount(\%myconfig, $form->{TEMPLATE_ARRAYS}->{$idx}->[$i]);
442 next unless (defined($form->{$idx}));
444 if (!ref($form->{$idx})) {
445 $form->{$idx} = $form->parse_amount(\%myconfig, $form->{$idx});
447 } elsif (ref($form->{$idx}) eq "ARRAY") {
448 for (my $i = 0; $i < scalar(@{$form->{$idx}}); $i++) {
449 $form->{$idx}->[$i] =
450 $form->parse_amount(\%myconfig, $form->{$idx}->[$i]);
455 my $saved_numberformat = $myconfig{"numberformat"};
456 $myconfig{"numberformat"} = $numberformat;
458 foreach my $idx (@indices) {
459 if ($form->{TEMPLATE_ARRAYS} && (ref($form->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
460 for (my $i = 0; $i < scalar(@{$form->{TEMPLATE_ARRAYS}->{$idx}}); $i++) {
461 $form->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $form->format_amount(\%myconfig, $form->{TEMPLATE_ARRAYS}->{$idx}->[$i], $places);
465 next unless (defined($form->{$idx}));
467 if (!ref($form->{$idx})) {
468 $form->{$idx} = $form->format_amount(\%myconfig, $form->{$idx}, $places);
470 } elsif (ref($form->{$idx}) eq "ARRAY") {
471 for (my $i = 0; $i < scalar(@{$form->{$idx}}); $i++) {
472 $form->{$idx}->[$i] =
473 $form->format_amount(\%myconfig, $form->{$idx}->[$i], $places);
478 $myconfig{"numberformat"} = $saved_numberformat;
480 $main::lxdebug->leave_sub();
483 # -------------------------------------------------------------------------
486 $main::lxdebug->enter_sub();
488 my $form = $main::form;
489 my %myconfig = %main::myconfig;
490 my $locale = $main::locale;
492 my $dbh = $form->dbconnect(\%myconfig);
493 my ($sort, $sortby) = split(/\-\-/, $form->{order});
494 $sort =~ s/.*\.(.*)/$1/;
496 $form->{title} = $locale->text("History");
498 print $form->parse_html_template( "common/show_history", {
499 "DATEN" => $form->get_history($dbh,$form->{input_name},"",$form->{order}),
500 "SUCCESS" => ($form->get_history($dbh,$form->{input_name}) ne "0"),
502 uc($sort)."BY" => $sortby
506 $main::lxdebug->leave_sub();
509 # -------------------------------------------------------------------------
512 $main::lxdebug->enter_sub();
516 my $form = $main::form;
517 my $locale = $main::locale;
520 $form->error($locale->text("Trying to call a sub without a name"));
523 $name =~ s/[^a-zA-Z0-9_]//g;
525 if (!defined(&{ $name })) {
526 $form->error(sprintf($locale->text("Attempt to call an undefined sub named '%s'"), $name));
534 $main::lxdebug->leave_sub();
537 # -------------------------------------------------------------------------
539 sub show_vc_details {
540 $main::lxdebug->enter_sub();
542 my $form = $main::form;
543 my %myconfig = %main::myconfig;
544 my $locale = $main::locale;
546 $form->{vc} = $form->{vc} eq "customer" ? "customer" : "vendor";
547 $form->isblank("vc_id",
548 $form->{vc} eq "customer" ?
549 $locale->text("No customer has been selected yet.") :
550 $locale->text("No vendor has been selected yet."));
552 Common->get_vc_details(\%myconfig, $form, $form->{vc}, $form->{vc_id});
554 $form->{title} = $form->{vc} eq "customer" ?
555 $locale->text("Customer details") : $locale->text("Vendor details");
557 print $form->parse_html_template("common/show_vc_details", { "is_customer" => $form->{vc} eq "customer" });
559 $main::lxdebug->leave_sub();
562 # -------------------------------------------------------------------------
564 sub retrieve_partunits {
565 $main::lxdebug->enter_sub();
567 my $form = $main::form;
569 my @part_ids = grep { $_ } map { $form->{"id_${_}"} } (1..$form->{rowcount});
572 my %partunits = IO->retrieve_partunits('part_ids' => \@part_ids);
574 foreach my $i (1..$form->{rowcount}) {
575 next unless ($form->{"id_${i}"});
576 $form->{"partunit_${i}"} = $partunits{$form->{"id_${i}"}};
580 $main::lxdebug->leave_sub();
583 # -------------------------------------------------------------------------
585 sub mark_as_paid_common {
586 $main::lxdebug->enter_sub();
588 my ($myconfig, $db_name) = @_;
590 my $form = $main::form;
591 my $locale = $main::locale;
593 if($form->{mark_as_paid}) {
594 my $dbh ||= $form->get_standard_dbh($myconfig);
595 my $query = qq|UPDATE $db_name SET paid = amount, datepaid = current_date WHERE id = ?|;
596 do_query($form, $dbh, $query, $form->{id});
598 $form->redirect($locale->text("Marked as paid"));
601 my $referer = $ENV{HTTP_REFERER};
604 if ($referer =~ /action/) {
605 $referer =~ /^(.*)\?action\=[^\&]*(\&.*)$/;
612 $referer = $script . "?action=mark_as_paid&mark_as_paid=1&id=$form->{id}" . $callback;
615 print qq|<p><b>|.$locale->text('Mark as paid?').qq|</b></p>|;
616 print qq|<input type="button" value="|.$locale->text('yes').qq|" onclick="document.location.href='|.$referer.qq|'"> |;
617 print qq|<input type="button" value="|.$locale->text('no').qq|" onclick="javascript:history.back();">|;
618 print qq|</body></html>|;
621 $main::lxdebug->leave_sub();
624 sub cov_selection_internal {
625 $main::lxdebug->enter_sub();
627 my $form = $main::form;
628 my %myconfig = %main::myconfig;
629 my $locale = $main::locale;
631 my $order_by = "name";
632 $order_by = $form->{"order_by"} if (defined($form->{"order_by"}));
634 $order_dir = $form->{"order_dir"} if (defined($form->{"order_dir"}));
636 my $type = $form->{"is_vendor"} ? $locale->text("vendor") : $locale->text("customer");
638 my $covs = Common->retrieve_customers_or_vendors(\%myconfig, $form, $order_by, $order_dir, $form->{"is_vendor"}, $form->{"allow_both"});
639 map({ $covs->[$_]->{"selected"} = $_ ? 0 : 1; } (0..$#{$covs}));
642 if (0 == scalar(@{$covs})) {
643 $form->show_generic_information(sprintf($locale->text("No %s was found matching the search parameters."), $type));
644 } elsif (1 == scalar(@{$covs})) {
645 $onload = "cov_selected('1')";
648 my $callback = "$form->{script}?action=cov_selection_internal&";
649 map({ $callback .= "$_=" . $form->escape($form->{$_}) . "&" }
650 (qw(name input_name input_id is_vendor allow_both), grep({ /^[fl]_/ } keys %$form)));
652 my @header_sort = qw(name address contact);
653 my %header_title = ( "name" => $locale->text("Name"),
654 "address" => $locale->text("Address"),
655 "contact" => $locale->text("Contact"),
659 map(+{ "column_title" => $header_title{$_},
661 "callback" => $callback . "order_by=${_}&order_dir=" . ($order_by eq $_ ? 1 - $order_dir : $order_dir),
665 foreach my $cov (@{ $covs }) {
666 $cov->{address} = "$cov->{street}, $cov->{zipcode} $cov->{city}";
667 $cov->{address} =~ s{^,}{}x;
668 $cov->{address} =~ s{\ +}{\ }gx;
670 $cov->{contact} = join " ", map { $cov->{$_} } qw(cp_gender cp_title cp_givenname cp_name);
671 $cov->{contact} =~ s{\ +}{\ }gx;
674 $form->{"title"} = $form->{is_vendor} ? $locale->text("Select a vendor") : $locale->text("Select a customer");
676 print($form->parse_html_template("generic/cov_selection", { "HEADER" => \@header,
678 "onload" => $onload }));
680 $main::lxdebug->leave_sub();
684 # Functions to call add routines beneath different reports
687 $main::lxdebug->enter_sub();
689 $main::auth->assert('invoice_edit');
691 my $form = $main::form;
692 my %myconfig = %main::myconfig;
693 my $locale = $main::locale;
695 $form->{script} = 'is.pl';
697 $form->{type} = "invoice";
698 $locale = new Locale "$myconfig{countrycode}", "$script";
700 require "bin/mozilla/$form->{script}";
703 $main::lxdebug->leave_sub();
707 $main::lxdebug->enter_sub();
709 $main::auth->assert('general_ledger');
711 my $form = $main::form;
712 my %myconfig = %main::myconfig;
713 my $locale = $main::locale;
715 $form->{script} = 'ar.pl';
717 $locale = new Locale "$myconfig{countrycode}", "$script";
719 require "bin/mozilla/$form->{script}";
722 $main::lxdebug->leave_sub();
726 $main::lxdebug->enter_sub();
728 $main::auth->assert('invoice_edit');
730 my $form = $main::form;
731 my %myconfig = %main::myconfig;
732 my $locale = $main::locale;
734 $form->{script} = 'ir.pl';
736 $form->{type} = "invoice";
737 $locale = new Locale "$myconfig{countrycode}", "$script";
739 require "bin/mozilla/$form->{script}";
742 $main::lxdebug->leave_sub();
746 $main::lxdebug->enter_sub();
748 $main::auth->assert('general_ledger');
750 my $form = $main::form;
751 my %myconfig = %main::myconfig;
752 my $locale = $main::locale;
754 $form->{script} = 'ap.pl';
756 $locale = new Locale "$myconfig{countrycode}", "$script";
758 require "bin/mozilla/$form->{script}";
761 $main::lxdebug->leave_sub();
765 $main::lxdebug->enter_sub();
767 $main::auth->assert('general_ledger');
769 my $form = $main::form;
770 my %myconfig = %main::myconfig;
771 my $locale = $main::locale;
773 $form->{script} = 'gl.pl';
775 $locale = new Locale "$myconfig{countrycode}", "$script";
777 require "bin/mozilla/$form->{script}";
780 $main::lxdebug->leave_sub();