X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=c9d5932ea54b7a57c11353620edb07dafd1893e7;hb=177cb111a3514218b8bd7c9221f7b90ce2bdac7e;hp=171b5fff41abd038470074bf5f89ca6fd0a1ba90;hpb=3270e88361efc8ceff21314b489732229f0f98f7;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 171b5fff4..c9d5932ea 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -27,7 +27,8 @@ # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +# MA 02110-1335, USA. #====================================================================== # Utilities for parsing forms # and supporting routines for linking account numbers @@ -62,10 +63,12 @@ use SL::DB::Default; use SL::DB::PaymentTerm; use SL::DB::Vendor; use SL::DO; +use SL::Helper::Flash qw(); use SL::IC; use SL::IS; use SL::Layout::Dispatcher; use SL::Locale; +use SL::Locale::String; use SL::Mailer; use SL::Menu; use SL::MoreCommon qw(uri_encode uri_decode); @@ -74,6 +77,7 @@ use SL::PrefixedNumber; use SL::Request; use SL::Template; use SL::User; +use SL::Util; use SL::X; use Template; use URI; @@ -83,18 +87,6 @@ use SL::DB::Tax; use strict; -my $standard_dbh; - -END { - disconnect_standard_dbh(); -} - -sub disconnect_standard_dbh { - return unless $standard_dbh; - $standard_dbh->disconnect(); - undef $standard_dbh; -} - sub read_version { my ($self) = @_; @@ -467,16 +459,18 @@ sub header { # standard css for all # this should gradually move to the layouts that need it $layout->use_stylesheet("$_.css") for qw( - main menu list_accounts jquery.autocomplete + common main menu list_accounts jquery.autocomplete jquery.multiselect2side ui-lightness/jquery-ui jquery-ui.custom + tooltipster themes/tooltipster-light ); $layout->use_javascript("$_.js") for (qw( jquery jquery-ui jquery.cookie jquery.checkall jquery.download jquery/jquery.form jquery/fixes client_js - common part_selection switchmenuframe autocomplete_part + jquery/jquery.tooltipster.min + common part_selection ), "jquery/ui/i18n/jquery.ui.datepicker-$::myconfig{countrycode}"); $self->{favicon} ||= "favicon.ico"; @@ -536,7 +530,7 @@ sub footer { print $::request->{layout}->post_content; if (my @inline_scripts = $::request->{layout}->javascripts_inline) { - print "\n"; + print "\n"; } print <header; print qq|
$info
|; - ::end_of_request(); - } - - if ($self->{"DEBUG"}) { - $additional_params->{"DEBUG"} = $self->{"DEBUG"}; - } - - if ($additional_params->{"DEBUG"}) { - $additional_params->{"DEBUG"} = - "
DEBUG INFORMATION:
" . $additional_params->{"DEBUG"} . "
"; - } - - if (%main::myconfig) { - $::myconfig{jsc_dateformat} = apply { - s/d+/\%d/gi; - s/m+/\%m/gi; - s/y+/\%Y/gi; - } $::myconfig{"dateformat"}; - $additional_params->{"myconfig"} ||= \%::myconfig; - map { $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys %::myconfig; + $::dispatcher->end_request; } + $additional_params->{AUTH} = $::auth; $additional_params->{INSTANCE_CONF} = $::instance_conf; - - if (my $debug_options = $::lx_office_conf{debug}{options}) { - map { $additional_params->{'DEBUG_' . uc($_)} = $debug_options->{$_} } keys %$debug_options; - } - - if ($main::auth && $main::auth->{RIGHTS} && $main::auth->{RIGHTS}->{$self->{login}}) { - while (my ($key, $value) = each %{ $main::auth->{RIGHTS}->{$self->{login}} }) { - $additional_params->{"AUTH_RIGHTS_" . uc($key)} = $value; - } - } + $additional_params->{LOCALE} = $::locale; + $additional_params->{LXCONFIG} = \%::lx_office_conf; + $additional_params->{LXDEBUG} = $::lxdebug; + $additional_params->{MYCONFIG} = \%::myconfig; $main::lxdebug->leave_sub(); @@ -704,7 +674,7 @@ sub show_generic_error { SL::ClientJS->new ->error($error) ->render(SL::Controller::Base->new); - ::end_of_request(); + $::dispatcher->end_request; } my $add_params = { @@ -712,20 +682,6 @@ sub show_generic_error { 'label_error' => $error, }; - if ($params{action}) { - my @vars; - - map { delete($self->{$_}); } qw(action); - map { push @vars, { "name" => $_, "value" => $self->{$_} } if (!ref($self->{$_})); } keys %{ $self }; - - $add_params->{SHOW_BUTTON} = 1; - $add_params->{BUTTON_LABEL} = $params{label} || $params{action}; - $add_params->{VARIABLES} = \@vars; - - } elsif ($params{back_button}) { - $add_params->{SHOW_BACK_BUTTON} = 1; - } - $self->{title} = $params{title} if $params{title}; $self->header(); @@ -735,7 +691,7 @@ sub show_generic_error { $main::lxdebug->leave_sub(); - ::end_of_request(); + $::dispatcher->end_request; } sub show_generic_information { @@ -755,7 +711,7 @@ sub show_generic_information { $main::lxdebug->leave_sub(); - ::end_of_request(); + $::dispatcher->end_request; } sub _store_redirect_info_in_session { @@ -777,11 +733,12 @@ sub redirect { $self->info($msg); } else { + SL::Helper::Flash::flash_later('info', $msg) if $msg; $self->_store_redirect_info_in_session; print $::form->redirect_header($self->{callback}); } - ::end_of_request(); + $::dispatcher->end_request; $main::lxdebug->leave_sub(); } @@ -807,6 +764,7 @@ sub format_amount { my $force_places = defined $places && $places >= 0; $amount = $self->round_amount($amount, abs $places) if $force_places; + $neg = 0 if $amount == 0; # don't show negative zero $amount = sprintf "%.*f", ($force_places ? $places : 10), abs $amount; # 6 is default for %fa # before the sprintf amount was a number, afterwards it's a string. because of the dynamic nature of perl @@ -823,7 +781,7 @@ sub format_amount { if ($places || $p[1]) { $amount .= $d[0] . ( $p[1] || '' ) - . (0 x (abs($places || 0) - length ($p[1]||''))); # pad the fraction + . (0 x max(abs($places || 0) - length ($p[1]||''), 0)); # pad the fraction } $amount = do { @@ -947,11 +905,24 @@ sub parse_amount { # Make sure no code wich is not a math expression ends up in eval(). return 0 unless $amount =~ /^ [\s \d \( \) \- \+ \* \/ \. ]* $/x; + + # Prevent numbers from being parsed as octals; + $amount =~ s{ (?get_precision || 0.01; + return $self->round_amount( $self->round_amount($amount / $precision, 0) * $precision, $places); + } # We use Perl's knowledge of string representation for # rounding. First, convert the floating point number to a string @@ -960,7 +931,9 @@ sub round_amount { # part. If an overflow occurs then apply that overflow to the part # before the decimal sign as well using integer arithmetic again. - my $amount_str = sprintf '%.*f', $places + 10, abs($amount); + my $int_amount = int(abs $amount); + my $str_places = max(min(10, 16 - length("$int_amount") - $places), $places); + my $amount_str = sprintf '%.*f', $places + $str_places, abs($amount); return $amount unless $amount_str =~ m{^(\d+)\.(\d+)$}; @@ -1119,7 +1092,7 @@ sub parse_template { if ($self->{media} eq 'email') { - my $mail = new Mailer; + my $mail = Mailer->new; map { $mail->{$_} = $self->{$_} } qw(cc bcc subject message version format); @@ -1235,6 +1208,8 @@ sub get_formname_translation { sales_delivery_order => $main::locale->text('Delivery Order'), purchase_delivery_order => $main::locale->text('Delivery Order'), dunning => $main::locale->text('Dunning'), + letter => $main::locale->text('Letter'), + ic_supply => $main::locale->text('Intra-Community supply'), ); $main::lxdebug->leave_sub(); @@ -1249,8 +1224,13 @@ sub get_number_prefix_for_type { (first { $self->{type} eq $_ } qw(invoice credit_note)) ? 'inv' : ($self->{type} =~ /_quotation$/) ? 'quo' : ($self->{type} =~ /_delivery_order$/) ? 'do' + : ($self->{type} =~ /letter/) ? 'letter' : 'ord'; + # better default like this? + # : ($self->{type} =~ /(sales|purcharse)_order/ : 'ord'; + # : 'prefix_undefined'; + $main::lxdebug->leave_sub(); return $prefix; } @@ -1286,6 +1266,9 @@ sub generate_attachment_filename { } elsif ($attachment_filename && $self->{"${prefix}number"}) { $attachment_filename .= "_" . $self->{"${prefix}number"} . $self->get_extension_for_format(); + } elsif ($attachment_filename) { + $attachment_filename .= $self->get_extension_for_format(); + } else { $attachment_filename = ""; } @@ -1381,69 +1364,29 @@ sub datetonum { } # Database routines used throughout +# DB Handling got moved to SL::DB, these are only shims for compatibility sub dbconnect { - $main::lxdebug->enter_sub(2); - - my ($self, $myconfig) = @_; - - # connect to database - my $dbh = SL::DBConnect->connect or $self->dberror; - - # set db options - if ($myconfig->{dboptions}) { - $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions}); - } - - $main::lxdebug->leave_sub(2); - - return $dbh; -} - -sub dbconnect_noauto { - $main::lxdebug->enter_sub(); - - my ($self, $myconfig) = @_; - - # connect to database - my $dbh = SL::DBConnect->connect(SL::DBConnect->get_connect_args(AutoCommit => 0)) or $self->dberror; - - # set db options - if ($myconfig->{dboptions}) { - $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions}); - } - - $main::lxdebug->leave_sub(); - - return $dbh; + SL::DB->client->dbh; } sub get_standard_dbh { - $main::lxdebug->enter_sub(2); - - my $self = shift; - my $myconfig = shift || \%::myconfig; + my $dbh = SL::DB->client->dbh; - if ($standard_dbh && !$standard_dbh->{Active}) { - $main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$standard_dbh is defined but not Active anymore"); - undef $standard_dbh; + if ($dbh && !$dbh->{Active}) { + $main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$dbh is defined but not Active anymore"); + SL::DB->client->dbh(undef); } - $standard_dbh ||= $self->dbconnect_noauto($myconfig); - - $main::lxdebug->leave_sub(2); - - return $standard_dbh; + SL::DB->client->dbh; } -sub set_standard_dbh { - my ($self, $dbh) = @_; - my $old_dbh = $standard_dbh; - $standard_dbh = $dbh; - - return $old_dbh; +sub disconnect_standard_dbh { + SL::DB->client->dbh->rollback; } +# /database + sub date_closed { $main::lxdebug->enter_sub(); @@ -1581,18 +1524,18 @@ sub save_exchangerate { my ($self, $myconfig, $currency, $transdate, $rate, $fld) = @_; - my $dbh = $self->dbconnect($myconfig); - - my ($buy, $sell); + SL::DB->client->with_transaction(sub { + my $dbh = SL::DB->client->dbh; - $buy = $rate if $fld eq 'buy'; - $sell = $rate if $fld eq 'sell'; + my ($buy, $sell); + $buy = $rate if $fld eq 'buy'; + $sell = $rate if $fld eq 'sell'; - $self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell); - - $dbh->disconnect; + $self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell); + 1; + }) or do { die SL::DB->client->error }; $main::lxdebug->leave_sub(); } @@ -1690,36 +1633,20 @@ sub get_default_currency { } sub set_payment_options { - $main::lxdebug->enter_sub(); + my ($self, $myconfig, $transdate, $type) = @_; - my ($self, $myconfig, $transdate) = @_; + my $terms = $self->{payment_id} ? SL::DB::PaymentTerm->new(id => $self->{payment_id})->load : undef; + return if !$terms; - return $main::lxdebug->leave_sub() unless ($self->{payment_id}); + my $is_invoice = $type =~ m{invoice}i; - my $dbh = $self->get_standard_dbh($myconfig); - - my $query = - qq|SELECT p.terms_netto, p.terms_skonto, p.percent_skonto, p.description_long , p.description | . - qq|FROM payment_terms p | . - qq|WHERE p.id = ?|; + $transdate ||= $self->{invdate} || $self->{transdate}; + my $due_date = $self->{duedate} || $self->{reqdate}; - ($self->{terms_netto}, $self->{terms_skonto}, $self->{percent_skonto}, - $self->{payment_terms}, $self->{payment_description}) = - selectrow_query($self, $dbh, $query, $self->{payment_id}); - - if ($transdate eq "") { - if ($self->{invdate}) { - $transdate = $self->{invdate}; - } else { - $transdate = $self->{transdate}; - } - } - - $query = - qq|SELECT ?::date + ?::integer AS netto_date, ?::date + ?::integer AS skonto_date | . - qq|FROM payment_terms|; - ($self->{netto_date}, $self->{skonto_date}) = - selectrow_query($self, $dbh, $query, $transdate, $self->{terms_netto}, $transdate, $self->{terms_skonto}); + $self->{$_} = $terms->$_ for qw(terms_netto terms_skonto percent_skonto); + $self->{payment_description} = $terms->description; + $self->{netto_date} = $terms->calc_date(reference_date => $transdate, due_date => $due_date, terms => 'net')->to_kivitendo; + $self->{skonto_date} = $terms->calc_date(reference_date => $transdate, due_date => $due_date, terms => 'discount')->to_kivitendo; my ($invtotal, $total); my (%amounts, %formatted_amounts); @@ -1749,38 +1676,26 @@ sub set_payment_options { } if ($self->{"language_id"}) { - $query = - qq|SELECT t.translation, l.output_numberformat, l.output_dateformat, l.output_longdates | . - qq|FROM generic_translations t | . - qq|LEFT JOIN language l ON t.language_id = l.id | . - qq|WHERE (t.language_id = ?) - AND (t.translation_id = ?) - AND (t.translation_type = 'SL::DB::PaymentTerm/description_long')|; - my ($description_long, $output_numberformat, $output_dateformat, - $output_longdates) = - selectrow_query($self, $dbh, $query, - $self->{"language_id"}, $self->{"payment_id"}); - - $self->{payment_terms} = $description_long if ($description_long); - - if ($output_dateformat) { + my $language = SL::DB::Language->new(id => $self->{language_id})->load; + + $self->{payment_terms} = $type =~ m{invoice}i ? $terms->translated_attribute('description_long_invoice', $language->id) : undef; + $self->{payment_terms} ||= $terms->translated_attribute('description_long', $language->id); + + if ($language->output_dateformat) { foreach my $key (qw(netto_date skonto_date)) { - $self->{$key} = - $main::locale->reformat_date($myconfig, $self->{$key}, - $output_dateformat, - $output_longdates); + $self->{$key} = $::locale->reformat_date($myconfig, $self->{$key}, $language->output_dateformat, $language->output_longdates); } } - if ($output_numberformat && - ($output_numberformat ne $myconfig->{"numberformat"})) { - my $saved_numberformat = $myconfig->{"numberformat"}; - $myconfig->{"numberformat"} = $output_numberformat; - map { $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) } keys %amounts; - $myconfig->{"numberformat"} = $saved_numberformat; + if ($language->output_numberformat && ($language->output_numberformat ne $myconfig->{numberformat})) { + local $myconfig->{numberformat}; + $myconfig->{"numberformat"} = $language->output_numberformat; + $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) for keys %amounts; } } + $self->{payment_terms} = $self->{payment_terms} || ($is_invoice ? $terms->description_long_invoice : undef) || $terms->description_long; + $self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g; $self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g; $self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g; @@ -1788,13 +1703,15 @@ sub set_payment_options { $self->{payment_terms} =~ s/<%account_number%>/$self->{account_number}/g; $self->{payment_terms} =~ s/<%bank%>/$self->{bank}/g; $self->{payment_terms} =~ s/<%bank_code%>/$self->{bank_code}/g; + $self->{payment_terms} =~ s/<\%bic\%>/$self->{bic}/g; + $self->{payment_terms} =~ s/<\%iban\%>/$self->{iban}/g; + $self->{payment_terms} =~ s/<\%mandate_date_of_signature\%>/$self->{mandate_date_of_signature}/g; + $self->{payment_terms} =~ s/<\%mandator_id\%>/$self->{mandator_id}/g; map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts; $self->{skonto_in_percent} = $formatted_amounts{skonto_in_percent}; - $main::lxdebug->leave_sub(); - } sub get_template_language { @@ -1845,20 +1762,25 @@ sub get_shipto { my $query = qq|SELECT * FROM shipto WHERE shipto_id = ?|; my $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{shipto_id}); map({ $self->{$_} = $ref->{$_} } keys(%$ref)); + + my $cvars = CVar->get_custom_variables( + dbh => $dbh, + module => 'ShipTo', + trans_id => $self->{shipto_id}, + ); + $self->{"shiptocvar_$_->{name}"} = $_->{value} for @{ $cvars }; } $main::lxdebug->leave_sub(); } sub add_shipto { - $main::lxdebug->enter_sub(); - my ($self, $dbh, $id, $module) = @_; my $shipto; my @values; - foreach my $item (qw(name department_1 department_2 street zipcode city country + foreach my $item (qw(name department_1 department_2 street zipcode city country gln contact cp_gender phone fax email)) { if ($self->{"shipto$item"}) { $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"}); @@ -1866,52 +1788,68 @@ sub add_shipto { push(@values, $self->{"shipto${item}"}); } - if ($shipto) { - if ($self->{shipto_id}) { - my $query = qq|UPDATE shipto set - shiptoname = ?, - shiptodepartment_1 = ?, - shiptodepartment_2 = ?, - shiptostreet = ?, - shiptozipcode = ?, - shiptocity = ?, - shiptocountry = ?, - shiptocontact = ?, - shiptocp_gender = ?, - shiptophone = ?, - shiptofax = ?, - shiptoemail = ? - WHERE shipto_id = ?|; - do_query($self, $dbh, $query, @values, $self->{shipto_id}); - } else { - my $query = qq|SELECT * FROM shipto - WHERE shiptoname = ? AND - shiptodepartment_1 = ? AND - shiptodepartment_2 = ? AND - shiptostreet = ? AND - shiptozipcode = ? AND - shiptocity = ? AND - shiptocountry = ? AND - shiptocontact = ? AND - shiptocp_gender = ? AND - shiptophone = ? AND - shiptofax = ? AND - shiptoemail = ? AND - module = ? AND - trans_id = ?|; - my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id); - if(!$insert_check){ - $query = - qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2, - shiptostreet, shiptozipcode, shiptocity, shiptocountry, - shiptocontact, shiptocp_gender, shiptophone, shiptofax, shiptoemail, module) - VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|; - do_query($self, $dbh, $query, $id, @values, $module); - } + return if !$shipto; + + my $shipto_id = $self->{shipto_id}; + + if ($self->{shipto_id}) { + my $query = qq|UPDATE shipto set + shiptoname = ?, + shiptodepartment_1 = ?, + shiptodepartment_2 = ?, + shiptostreet = ?, + shiptozipcode = ?, + shiptocity = ?, + shiptocountry = ?, + shiptogln = ?, + shiptocontact = ?, + shiptocp_gender = ?, + shiptophone = ?, + shiptofax = ?, + shiptoemail = ? + WHERE shipto_id = ?|; + do_query($self, $dbh, $query, @values, $self->{shipto_id}); + } else { + my $query = qq|SELECT * FROM shipto + WHERE shiptoname = ? AND + shiptodepartment_1 = ? AND + shiptodepartment_2 = ? AND + shiptostreet = ? AND + shiptozipcode = ? AND + shiptocity = ? AND + shiptocountry = ? AND + shiptogln = ? AND + shiptocontact = ? AND + shiptocp_gender = ? AND + shiptophone = ? AND + shiptofax = ? AND + shiptoemail = ? AND + module = ? AND + trans_id = ?|; + my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id); + if(!$insert_check){ + my $insert_query = + qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2, + shiptostreet, shiptozipcode, shiptocity, shiptocountry, shiptogln, + shiptocontact, shiptocp_gender, shiptophone, shiptofax, shiptoemail, module) + VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|; + do_query($self, $dbh, $insert_query, $id, @values, $module); + + $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id); } + + $shipto_id = $insert_check->{shipto_id}; } - $main::lxdebug->leave_sub(); + return unless $shipto_id; + + CVar->save_custom_variables( + dbh => $dbh, + module => 'ShipTo', + trans_id => $shipto_id, + variables => $self, + name_prefix => 'shipto', + ); } sub get_employee { @@ -1967,23 +1905,6 @@ sub get_employee_data { $main::lxdebug->leave_sub(); } -sub get_duedate { - $main::lxdebug->enter_sub(); - - my ($self, $myconfig, $reference_date) = @_; - - my $terms = $self->{payment_id} ? SL::DB::PaymentTerm->new(id => $self->{payment_id}) ->load - : $self->{customer_id} ? SL::DB::Customer ->new(id => $self->{customer_id})->load->payment - : $self->{vendor_id} ? SL::DB::Vendor ->new(id => $self->{vendor_id}) ->load->payment - : $self->{invdate} ? undef # no payment terms, therefore invdate == duedate - : croak("Missing field in \$::form: payment_id, customer_id, vendor_id or invdate"); - my $duedate = $terms ? $terms->calc_date(reference_date => $reference_date)->to_kivitendo : undef; - - $main::lxdebug->leave_sub(); - - return $duedate; -} - sub _get_contacts { $main::lxdebug->enter_sub(); @@ -2387,7 +2308,7 @@ sub get_lists { if ($params{contacts} || $params{shipto}) { $vc = 'customer' if $self->{"vc"} eq "customer"; $vc = 'vendor' if $self->{"vc"} eq "vendor"; - die "invalid use of get_lists, need 'vc'"; + die "invalid use of get_lists, need 'vc'" unless $vc; $vc_id = $self->{"${vc}_id"}; } @@ -2430,7 +2351,7 @@ sub get_lists { } if ($params{"salesmen"}) { - $self->_get_employees($dbh, "all_salesmen", $params{"salesmen"}); + $self->_get_employees($dbh, $params{"salesmen"}); } if ($params{"business_types"}) { @@ -2502,10 +2423,10 @@ sub get_name { my $where; if ($self->{customernumber} ne "") { $where = qq|(vc.customernumber ILIKE ?)|; - push(@values, '%' . $self->{customernumber} . '%'); + push(@values, like($self->{customernumber})); } else { $where = qq|(vc.name ILIKE ?)|; - push(@values, '%' . $self->{$table} . '%'); + push(@values, like($self->{$table})); } $query = @@ -2522,7 +2443,7 @@ sub get_name { JOIN $table vc ON (a.${table}_id = vc.id) WHERE NOT (a.amount = a.paid) AND (vc.name ILIKE ?) ORDER BY vc.name~; - push(@values, '%' . $self->{$table} . '%'); + push(@values, like($self->{$table})); } $self->{name_list} = selectall_hashref_query($self, $dbh, $query, @values); @@ -2532,79 +2453,46 @@ sub get_name { return scalar(@{ $self->{name_list} }); } -# the selection sub is used in the AR, AP, IS, IR, DO and OE module -# -sub all_vc { +sub new_lastmtime { $main::lxdebug->enter_sub(); - my ($self, $myconfig, $table, $module) = @_; + my ($self, $table, $provided_dbh) = @_; - my $ref; - my $dbh = $self->get_standard_dbh; + my $dbh = $provided_dbh ? $provided_dbh : $self->get_standard_dbh; + return unless $self->{id}; + croak ("wrong call, no valid table defined") unless $table =~ /^(oe|ar|ap|delivery_orders|parts)$/; - $table = $table eq "customer" ? "customer" : "vendor"; + my $query = "SELECT mtime, itime FROM " . $table . " WHERE id = ?"; + my $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{id}); + $ref->{mtime} ||= $ref->{itime}; + $self->{lastmtime} = $ref->{mtime}; + $main::lxdebug->message(LXDebug->DEBUG2(),"new lastmtime=".$self->{lastmtime}); - # build selection list - # Hotfix für Bug 1837 - Besser wäre es alte Buchungsbelege - # OHNE Auswahlliste (reines Textfeld) zu laden. Hilft aber auch - # nicht für veränderbare Belege (oe, do, ...) - my $obsolete = $self->{id} ? '' : "WHERE NOT obsolete"; - my $query = qq|SELECT count(*) FROM $table $obsolete|; - my ($count) = selectrow_query($self, $dbh, $query); - - if ($count <= $myconfig->{vclimit}) { - $query = qq|SELECT id, name, salesman_id - FROM $table $obsolete - ORDER BY name|; - $self->{"all_$table"} = selectall_hashref_query($self, $dbh, $query); - } - - # get self - $self->get_employee($dbh); - - # setup sales contacts - $query = qq|SELECT e.id, e.name - FROM employee e - WHERE (e.sales = '1') AND (NOT e.id = ?) - ORDER BY name|; - $self->{all_employees} = selectall_hashref_query($self, $dbh, $query, $self->{employee_id}); - - # this is for self - push(@{ $self->{all_employees} }, - { id => $self->{employee_id}, - name => $self->{employee} }); - - # prepare query for departments - $query = qq|SELECT id, description - FROM department - ORDER BY description|; - - $self->{all_departments} = selectall_hashref_query($self, $dbh, $query); - - # get languages - $query = qq|SELECT id, description - FROM language - ORDER BY id|; - - $self->{languages} = selectall_hashref_query($self, $dbh, $query); - - # get printer - $query = qq|SELECT printer_description, id - FROM printers - ORDER BY printer_description|; + $main::lxdebug->leave_sub(); +} - $self->{printers} = selectall_hashref_query($self, $dbh, $query); +sub mtime_ischanged { + my ($self, $table, $option) = @_; - # get payment terms - $query = qq|SELECT id, description - FROM payment_terms - ORDER BY sortkey|; + return unless $self->{id}; + croak ("wrong call, no valid table defined") unless $table =~ /^(oe|ar|ap|delivery_orders|parts)$/; - $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query); + my $query = "SELECT mtime, itime FROM " . $table . " WHERE id = ?"; + my $ref = selectfirst_hashref_query($self, $self->get_standard_dbh, $query, $self->{id}); + $ref->{mtime} ||= $ref->{itime}; - $main::lxdebug->leave_sub(); + if ($self->{lastmtime} && $self->{lastmtime} ne $ref->{mtime} ) { + $self->error(($option eq 'mail') ? + t8("The document has been changed by another user. No mail was sent. Please reopen it in another window and copy the changes to the new window") : + t8("The document has been changed by another user. Please reopen it in another window and copy the changes to the new window") + ); + $::dispatcher->end_request; + } } +# language_payment duplicates some of the functionality of all_vc (language, +# printer, payment_terms), and at least in the case of sales invoices both +# all_vc and language_payment are called when adding new invoices sub language_payment { $main::lxdebug->enter_sub(); @@ -2628,9 +2516,9 @@ sub language_payment { # get payment terms $query = qq|SELECT id, description FROM payment_terms - ORDER BY sortkey|; - - $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query); + WHERE ( obsolete IS FALSE OR id = ? ) + ORDER BY sortkey |; + $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query, $self->{payment_id} || undef); # get buchungsgruppen $query = qq|SELECT id, description @@ -2674,8 +2562,6 @@ sub create_links { $arap = "ap"; } - $self->all_vc($myconfig, $table, $module); - # get last customers or vendors my ($query, $sth, $ref); @@ -2690,15 +2576,8 @@ sub create_links { } # now get the account numbers -# $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id -# FROM chart c, taxkeys tk -# WHERE (c.link LIKE ?) AND (c.id = tk.chart_id) AND tk.id = -# (SELECT id FROM taxkeys WHERE (taxkeys.chart_id = c.id) AND (startdate <= $transdate) ORDER BY startdate DESC LIMIT 1) -# ORDER BY c.accno|; - -# same query as above, but without expensive subquery for each row. about 80% faster $query = qq| - SELECT c.accno, c.description, c.link, c.taxkey_id, tk2.tax_id + SELECT c.accno, c.description, c.link, c.taxkey_id, c.id AS chart_id, tk2.tax_id FROM chart c -- find newest entries in taxkeys INNER JOIN ( @@ -2715,7 +2594,7 @@ sub create_links { $sth = $dbh->prepare($query); - do_statement($self, $sth, $query, '%' . $module . '%'); + do_statement($self, $sth, $query, like($module)); $self->{accounts} = ""; while ($ref = $sth->fetchrow_hashref("NAME_lc")) { @@ -2728,6 +2607,7 @@ sub create_links { push @{ $self->{"${module}_links"}{$key} }, { accno => $ref->{accno}, + chart_id => $ref->{chart_id}, description => $ref->{description}, taxkey => $ref->{taxkey_id}, tax_id => $ref->{tax_id} }; @@ -2756,6 +2636,7 @@ sub create_links { qq|SELECT a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid, a.duedate, a.ordnumber, a.taxincluded, (SELECT cu.name FROM currencies cu WHERE cu.id=a.currency_id) AS currency, a.notes, + a.mtime, a.itime, a.intnotes, a.department_id, a.amount AS oldinvtotal, a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type, a.globalproject_id, ${extra_columns} @@ -2772,14 +2653,15 @@ sub create_links { foreach my $key (keys %$ref) { $self->{$key} = $ref->{$key}; } - + $self->{mtime} ||= $self->{itime}; + $self->{lastmtime} = $self->{mtime}; my $transdate = "current_date"; if ($self->{transdate}) { $transdate = $dbh->quote($self->{transdate}); } # now get the account numbers - $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id + $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, c.id AS chart_id, tk.tax_id FROM chart c LEFT JOIN taxkeys tk ON (tk.chart_id = c.id) WHERE c.link LIKE ? @@ -2788,7 +2670,7 @@ sub create_links { ORDER BY c.accno|; $sth = $dbh->prepare($query); - do_statement($self, $sth, $query, "%$module%"); + do_statement($self, $sth, $query, like($module)); $self->{accounts} = ""; while ($ref = $sth->fetchrow_hashref("NAME_lc")) { @@ -2801,6 +2683,7 @@ sub create_links { push @{ $self->{"${module}_links"}{$key} }, { accno => $ref->{accno}, + chart_id => $ref->{chart_id}, description => $ref->{description}, taxkey => $ref->{taxkey_id}, tax_id => $ref->{tax_id} }; @@ -2815,7 +2698,7 @@ sub create_links { $query = qq|SELECT c.accno, c.description, - a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey, + a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey, a.chart_id, p.projectnumber, t.rate, t.id FROM acc_trans a @@ -2855,7 +2738,9 @@ sub create_links { d.closedto, d.revtrans, (SELECT cu.name FROM currencies cu WHERE cu.id=d.currency_id) AS defaultcurrency, (SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno, - (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno + (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno, + (SELECT c.accno FROM chart c WHERE d.rndgain_accno_id = c.id) AS rndgain_accno, + (SELECT c.accno FROM chart c WHERE d.rndloss_accno_id = c.id) AS rndloss_accno FROM defaults d|; $ref = selectfirst_hashref_query($self, $dbh, $query); map { $self->{$_} = $ref->{$_} } keys %$ref; @@ -2868,7 +2753,9 @@ sub create_links { current_date AS transdate, d.closedto, d.revtrans, (SELECT cu.name FROM currencies cu WHERE cu.id=d.currency_id) AS defaultcurrency, (SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno, - (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno + (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno, + (SELECT c.accno FROM chart c WHERE d.rndgain_accno_id = c.id) AS rndgain_accno, + (SELECT c.accno FROM chart c WHERE d.rndloss_accno_id = c.id) AS rndloss_accno FROM defaults d|; $ref = selectfirst_hashref_query($self, $dbh, $query); map { $self->{$_} = $ref->{$_} } keys %$ref; @@ -2906,7 +2793,6 @@ sub lastname_used { "d.description" => "department", "ct.name" => $table, "cu.name" => "currency", - "current_date + ct.terms" => "duedate", ); if ($self->{type} =~ /delivery_order/) { @@ -2976,22 +2862,6 @@ sub current_date { return $thisdate; } -sub like { - $main::lxdebug->enter_sub(); - - my ($self, $string) = @_; - - if ($string !~ /%/) { - $string = "%$string%"; - } - - $string =~ s/\'/\'\'/g; - - $main::lxdebug->leave_sub(); - - return $string; -} - sub redo_rows { $main::lxdebug->enter_sub(); @@ -3025,52 +2895,52 @@ sub update_status { my ($i, $id); - my $dbh = $self->dbconnect_noauto($myconfig); + SL::DB->client->with_transaction(sub { + my $dbh = SL::DB->client->dbh; - my $query = qq|DELETE FROM status - WHERE (formname = ?) AND (trans_id = ?)|; - my $sth = prepare_query($self, $dbh, $query); + my $query = qq|DELETE FROM status + WHERE (formname = ?) AND (trans_id = ?)|; + my $sth = prepare_query($self, $dbh, $query); - if ($self->{formname} =~ /(check|receipt)/) { - for $i (1 .. $self->{rowcount}) { - do_statement($self, $sth, $query, $self->{formname}, $self->{"id_$i"} * 1); + if ($self->{formname} =~ /(check|receipt)/) { + for $i (1 .. $self->{rowcount}) { + do_statement($self, $sth, $query, $self->{formname}, $self->{"id_$i"} * 1); + } + } else { + do_statement($self, $sth, $query, $self->{formname}, $self->{id}); } - } else { - do_statement($self, $sth, $query, $self->{formname}, $self->{id}); - } - $sth->finish(); + $sth->finish(); - my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; - my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; + my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; + my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; - my %queued = split / /, $self->{queued}; - my @values; + my %queued = split / /, $self->{queued}; + my @values; - if ($self->{formname} =~ /(check|receipt)/) { + if ($self->{formname} =~ /(check|receipt)/) { - # this is a check or receipt, add one entry for each lineitem - my ($accno) = split /--/, $self->{account}; - $query = qq|INSERT INTO status (trans_id, printed, spoolfile, formname, chart_id) - VALUES (?, ?, ?, ?, (SELECT c.id FROM chart c WHERE c.accno = ?))|; - @values = ($printed, $queued{$self->{formname}}, $self->{prinform}, $accno); - $sth = prepare_query($self, $dbh, $query); + # this is a check or receipt, add one entry for each lineitem + my ($accno) = split /--/, $self->{account}; + $query = qq|INSERT INTO status (trans_id, printed, spoolfile, formname, chart_id) + VALUES (?, ?, ?, ?, (SELECT c.id FROM chart c WHERE c.accno = ?))|; + @values = ($printed, $queued{$self->{formname}}, $self->{prinform}, $accno); + $sth = prepare_query($self, $dbh, $query); - for $i (1 .. $self->{rowcount}) { - if ($self->{"checked_$i"}) { - do_statement($self, $sth, $query, $self->{"id_$i"}, @values); + for $i (1 .. $self->{rowcount}) { + if ($self->{"checked_$i"}) { + do_statement($self, $sth, $query, $self->{"id_$i"}, @values); + } } - } - $sth->finish(); - - } else { - $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname) - VALUES (?, ?, ?, ?, ?)|; - do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, - $queued{$self->{formname}}, $self->{formname}); - } + $sth->finish(); - $dbh->commit; - $dbh->disconnect; + } else { + $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname) + VALUES (?, ?, ?, ?, ?)|; + do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, + $queued{$self->{formname}}, $self->{formname}); + } + 1; + }) or do { die SL::DB->client->error }; $main::lxdebug->leave_sub(); } @@ -3156,20 +3026,21 @@ sub save_history { $main::lxdebug->enter_sub(); my $self = shift; - my $dbh = shift || $self->get_standard_dbh; + my $dbh = shift || SL::DB->client->dbh; + SL::DB->client->with_transaction(sub { - if(!exists $self->{employee_id}) { - &get_employee($self, $dbh); - } - - my $query = - qq|INSERT INTO history_erp (trans_id, employee_id, addition, what_done, snumbers) | . - qq|VALUES (?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?)|; - my @values = (conv_i($self->{id}), $self->{login}, - $self->{addition}, $self->{what_done}, "$self->{snumbers}"); - do_query($self, $dbh, $query, @values); + if(!exists $self->{employee_id}) { + &get_employee($self, $dbh); + } - $dbh->commit; + my $query = + qq|INSERT INTO history_erp (trans_id, employee_id, addition, what_done, snumbers) | . + qq|VALUES (?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?)|; + my @values = (conv_i($self->{id}), $self->{login}, + $self->{addition}, $self->{what_done}, "$self->{snumbers}"); + do_query($self, $dbh, $query, @values); + 1; + }) or do { die SL::DB->client->error }; $main::lxdebug->leave_sub(); } @@ -3221,16 +3092,13 @@ sub get_partsgroup { my @values; if ($p->{searchitems} eq 'part') { - $query .= qq|WHERE p.inventory_accno_id > 0|; + $query .= qq|WHERE p.part_type = 'part'|; } if ($p->{searchitems} eq 'service') { - $query .= qq|WHERE p.inventory_accno_id IS NULL|; + $query .= qq|WHERE p.part_type = 'service'|; } if ($p->{searchitems} eq 'assembly') { - $query .= qq|WHERE p.assembly = '1'|; - } - if ($p->{searchitems} eq 'labor') { - $query .= qq|WHERE (p.inventory_accno_id > 0) AND (p.income_accno_id IS NULL)|; + $query .= qq|WHERE p.part_type = 'assembly'|; } $query .= qq|ORDER BY partsgroup|; @@ -3360,10 +3228,17 @@ sub prepare_for_printing { $self->{"employee_${_}"} = $defaults->$_ for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber); } - # Load shipping address from database if shipto_id is set. - if ($self->{shipto_id}) { - my $shipto = SL::DB::Shipto->new(shipto_id => $self->{shipto_id})->load; + # Load shipping address from database. If shipto_id is set then it's + # one from the customer's/vendor's master data. Otherwise look an a + # customized address linking back to the current record. + my $shipto_module = $self->{type} =~ /_delivery_order$/ ? 'DO' + : $self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order/ ? 'OE' + : 'AR'; + my $shipto = $self->{shipto_id} ? SL::DB::Shipto->new(shipto_id => $self->{shipto_id})->load + : SL::DB::Manager::Shipto->get_first(where => [ module => $shipto_module, trans_id => $self->{id} ]); + if ($shipto) { $self->{$_} = $shipto->$_ for grep { m{^shipto} } map { $_->name } @{ $shipto->meta->columns }; + $self->{"shiptocvar_" . $_->config->name} = $_->value_as_text for @{ $shipto->cvars_by_config }; } my $language = $self->{language} ? '_' . $self->{language} : ''; @@ -3495,9 +3370,9 @@ sub calculate_arap { if ( $selected_tax ) { if ( $buysell eq 'sell' ) { - $self->{AR_amounts}{"tax_$i"} = $selected_tax->chart->accno unless $selected_tax->taxkey == 0; + $self->{AR_amounts}{"tax_$i"} = $selected_tax->chart->accno if defined $selected_tax->chart; } else { - $self->{AP_amounts}{"tax_$i"} = $selected_tax->chart->accno unless $selected_tax->taxkey == 0; + $self->{AP_amounts}{"tax_$i"} = $selected_tax->chart->accno if defined $selected_tax->chart; }; $self->{"taxkey_$i"} = $selected_tax->taxkey; @@ -3649,11 +3524,12 @@ sub calculate_tax { my ($self,$amount,$taxrate,$taxincluded,$roundplaces) = @_; - $roundplaces = 2 unless defined $roundplaces; + $roundplaces //= 2; + $taxincluded //= 0; my $tax; - if ($taxincluded *= 1) { + if ($taxincluded) { # calculate tax (unrounded), subtract from amount, round amount and round tax $tax = $amount - ($amount / ($taxrate + 1)); # equivalent to: taxrate * amount / (taxrate + 1) $amount = $self->round_amount($amount - $tax, $roundplaces); @@ -3739,6 +3615,17 @@ Used to override the default favicon. A html page title will be generated from this +=item mtime_ischanged + +Tries to avoid concurrent write operations to records by checking the database mtime with a fetched one. + +Can be used / called with any table, that has itime and mtime attributes. +Valid C names are: oe, ar, ap, delivery_orders, parts. +Can be called wit C