From: Holger Lindemann Date: Fri, 3 Jun 2011 06:28:18 +0000 (+0200) Subject: Merge branch 'master' of git@lx-office.linet-services.de:lx-office-erp X-Git-Tag: release-2.6.3~25 X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/commitdiff_plain/de0f9532013c861dae78aa01b9633284d1ceee7c?hp=ed4960f5286bfd51c1cf5117ac11c406fce789d4 Merge branch 'master' of git@lx-office.linet-services.de:lx-office-erp --- diff --git a/SL/AM.pm b/SL/AM.pm index a4db43992..4f5b9718f 100644 --- a/SL/AM.pm +++ b/SL/AM.pm @@ -199,6 +199,9 @@ sub get_account { sub save_account { $main::lxdebug->enter_sub(); + # TODO: it should be forbidden to change an account to a heading if there + # have been bookings to this account in the past + my ($self, $myconfig, $form) = @_; # connect to database, turn off AutoCommit @@ -242,7 +245,23 @@ sub save_account { my @values; + if ($form->{id}) { + + # if charttype is heading make sure certain values are empty + # specifically, if charttype is changed from an existing account, empty the + # fields unnecessary for headings, so that e.g. heading doesn't appear in + # drop-down menues due to still having a valid "link" entry + + if ( $form->{charttype} eq 'H' ) { + $form->{link} = ''; + $form->{pos_bwa} = ''; + $form->{pos_bilanz} = ''; + $form->{pos_eur} = ''; + $form->{new_chart_id} = ''; + $form->{valid_from} = ''; + }; + $query = qq|UPDATE chart SET accno = ?, description = ?, @@ -272,6 +291,7 @@ sub save_account { $form->{id}, ); + } do_query($form, $dbh, $query, @values); @@ -880,7 +900,7 @@ sub delete_language { # connect to database my $dbh = $form->dbconnect_noauto($myconfig); - foreach my $table (qw(translation_payment_terms units_language)) { + foreach my $table (qw(generic_translations units_language)) { $query = qq|DELETE FROM $table WHERE language_id = ?|; do_query($form, $dbh, $query, $form->{"id"}); } @@ -1124,160 +1144,6 @@ sub swap_sortkeys { $main::lxdebug->leave_sub(); } -sub payment { - $main::lxdebug->enter_sub(); - - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->dbconnect($myconfig); - - my $query = qq|SELECT * FROM payment_terms ORDER BY sortkey|; - - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - $form->{ALL} = []; - while (my $ref = $sth->fetchrow_hashref("NAME_lc")) { - push @{ $form->{ALL} }, $ref; - } - - $sth->finish; - $dbh->disconnect; - - $main::lxdebug->leave_sub(); -} - -sub get_payment { - $main::lxdebug->enter_sub(); - - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->dbconnect($myconfig); - - my $query = qq|SELECT * FROM payment_terms WHERE id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{"id"}) || $form->dberror($query . " ($form->{id})"); - - my $ref = $sth->fetchrow_hashref("NAME_lc"); - map { $form->{$_} = $ref->{$_} } keys %$ref; - $sth->finish(); - - $query = - qq|SELECT t.language_id, t.description_long, l.description AS language | . - qq|FROM translation_payment_terms t | . - qq|LEFT JOIN language l ON t.language_id = l.id | . - qq|WHERE t.payment_terms_id = ? | . - qq|UNION | . - qq|SELECT l.id AS language_id, NULL AS description_long, | . - qq| l.description AS language | . - qq|FROM language l|; - $sth = $dbh->prepare($query); - $sth->execute($form->{"id"}) || $form->dberror($query . " ($form->{id})"); - - my %mapping; - while (my $ref = $sth->fetchrow_hashref("NAME_lc")) { - $mapping{ $ref->{"language_id"} } = $ref - unless (defined($mapping{ $ref->{"language_id"} })); - } - $sth->finish; - - $form->{"TRANSLATION"} = [sort({ $a->{"language"} cmp $b->{"language"} } - values(%mapping))]; - - $dbh->disconnect; - - $main::lxdebug->leave_sub(); -} - -sub save_payment { - $main::lxdebug->enter_sub(); - - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->dbconnect_noauto($myconfig); - - my $query; - - if (!$form->{id}) { - $query = qq|SELECT nextval('id'), COALESCE(MAX(sortkey) + 1, 1) | . - qq|FROM payment_terms|; - my $sortkey; - ($form->{id}, $sortkey) = selectrow_query($form, $dbh, $query); - - $query = qq|INSERT INTO payment_terms (id, sortkey) VALUES (?, ?)|; - do_query($form, $dbh, $query, $form->{id}, $sortkey); - - } else { - $query = - qq|DELETE FROM translation_payment_terms | . - qq|WHERE payment_terms_id = ?|; - do_query($form, $dbh, $query, $form->{"id"}); - } - - $query = qq|UPDATE payment_terms SET - description = ?, description_long = ?, - terms_netto = ?, terms_skonto = ?, - percent_skonto = ? - WHERE id = ?|; - my @values = ($form->{description}, $form->{description_long}, - $form->{terms_netto} * 1, $form->{terms_skonto} * 1, - $form->{percent_skonto} * 1, - $form->{id}); - do_query($form, $dbh, $query, @values); - - $query = qq|SELECT id FROM language|; - my @language_ids; - my $sth = $dbh->prepare($query); - $sth->execute() || $form->dberror($query); - - while (my ($id) = $sth->fetchrow_array()) { - push(@language_ids, $id); - } - $sth->finish(); - - $query = - qq|INSERT INTO translation_payment_terms | . - qq|(language_id, payment_terms_id, description_long) | . - qq|VALUES (?, ?, ?)|; - $sth = $dbh->prepare($query); - - foreach my $language_id (@language_ids) { - do_statement($form, $sth, $query, $language_id, $form->{"id"}, - $form->{"description_long_${language_id}"}); - } - $sth->finish(); - - $dbh->commit(); - $dbh->disconnect; - - $main::lxdebug->leave_sub(); -} - -sub delete_payment { - $main::lxdebug->enter_sub(); - - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->dbconnect_noauto($myconfig); - - my $query = - qq|DELETE FROM translation_payment_terms WHERE payment_terms_id = ?|; - do_query($form, $dbh, $query, $form->{"id"}); - - $query = qq|DELETE FROM payment_terms WHERE id = ?|; - do_query($form, $dbh, $query, $form->{"id"}); - - $dbh->commit(); - $dbh->disconnect; - - $main::lxdebug->leave_sub(); -} - - sub prepare_template_filename { $main::lxdebug->enter_sub(); @@ -2007,43 +1873,6 @@ sub save_units { $main::lxdebug->leave_sub(); } -sub swap_units { - $main::lxdebug->enter_sub(); - - my ($self, $myconfig, $form, $dir, $name_1) = @_; - - my $dbh = $form->dbconnect_noauto($myconfig); - - my $query; - - $query = qq|SELECT sortkey FROM units WHERE name = ?|; - my ($sortkey_1) = selectrow_query($form, $dbh, $query, $name_1); - - $query = - qq|SELECT sortkey FROM units | . - qq|WHERE sortkey | . ($dir eq "down" ? ">" : "<") . qq| ? | . - qq|ORDER BY sortkey | . ($dir eq "down" ? "ASC" : "DESC") . qq| LIMIT 1|; - my ($sortkey_2) = selectrow_query($form, $dbh, $query, $sortkey_1); - - if (defined($sortkey_1)) { - $query = qq|SELECT name FROM units WHERE sortkey = ${sortkey_2}|; - my ($name_2) = selectrow_query($form, $dbh, $query); - - if (defined($name_2)) { - $query = qq|UPDATE units SET sortkey = ? WHERE name = ?|; - my $sth = $dbh->prepare($query); - - do_statement($form, $sth, $query, $sortkey_1, $name_2); - do_statement($form, $sth, $query, $sortkey_2, $name_1); - } - } - - $dbh->commit(); - $dbh->disconnect(); - - $main::lxdebug->leave_sub(); -} - sub taxes { $main::lxdebug->enter_sub(); diff --git a/SL/Auth.pm b/SL/Auth.pm index 3b14def5d..98c36d3b7 100644 --- a/SL/Auth.pm +++ b/SL/Auth.pm @@ -46,7 +46,9 @@ sub reset { } sub get_user_dbh { - my ($self, $login) = @_; + my ($self, $login, %params) = @_; + my $may_fail = delete $params{may_fail}; + my %user = $self->read_user($login); my $dbh = SL::DBConnect->connect( $user{dbconnect}, @@ -56,9 +58,13 @@ sub get_user_dbh { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 0 } - ) or $::form->dberror; + ); + + if (!$may_fail && !$dbh) { + $::form->error($::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr); + } - if ($user{dboptions}) { + if ($user{dboptions} && $dbh) { $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions}); } @@ -256,7 +262,7 @@ sub create_database { my $encoding = $Common::charset_to_db_encoding{$charset}; $encoding ||= 'UNICODE'; - my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => $charset =~ m/^utf-?8$/i }); + my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) }); if (!$dbh) { $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr); @@ -430,29 +436,30 @@ sub get_user_id { } sub delete_user { - $main::lxdebug->enter_sub(); + $::lxdebug->enter_sub; my $self = shift; my $login = shift; - my $form = $main::form; - - my $dbh = $self->dbconnect(); + my $u_dbh = $self->get_user_dbh($login, may_fail => 1); + my $dbh = $self->dbconnect; $dbh->begin_work; my $query = qq|SELECT id FROM auth."user" WHERE login = ?|; - my ($id) = selectrow_query($form, $dbh, $query, $login); + my ($id) = selectrow_query($::form, $dbh, $query, $login); - $dbh->rollback and return $main::lxdebug->leave_sub() if (!$id); + $dbh->rollback and return $::lxdebug->leave_sub if (!$id); - do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id); - do_query($form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id); + do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id); + do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id); + do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh; - $dbh->commit(); + $dbh->commit; + $u_dbh->commit if $u_dbh; - $main::lxdebug->leave_sub(); + $::lxdebug->leave_sub; } # -------------------------------------- @@ -598,52 +605,33 @@ sub _create_session_id { } sub create_or_refresh_session { - $main::lxdebug->enter_sub(); - - my $self = shift; - - $session_id ||= $self->_create_session_id(); - - my ($form, $dbh, $query, $sth, $id); - - $form = $main::form; - $dbh = $self->dbconnect(); - - $dbh->begin_work; - do_query($::form, $dbh, qq|LOCK auth.session_content|); - - $query = qq|SELECT id FROM auth.session WHERE id = ?|; - - ($id) = selectrow_query($form, $dbh, $query, $session_id); - - if ($id) { - do_query($form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id); - - } else { - do_query($form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR}); - - } - - $self->save_session($dbh); - - $dbh->commit(); - - $main::lxdebug->leave_sub(); + $session_id ||= shift->_create_session_id; } sub save_session { + $::lxdebug->enter_sub; my $self = shift; my $provided_dbh = shift; my $dbh = $provided_dbh || $self->dbconnect(1); - return unless $dbh; + $::lxdebug->leave_sub && return unless $dbh && $session_id; $dbh->begin_work unless $provided_dbh; do_query($::form, $dbh, qq|LOCK auth.session_content|); do_query($::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id); + my $query = qq|SELECT id FROM auth.session WHERE id = ?|; + + my ($id) = selectrow_query($::form, $dbh, $query, $session_id); + + if ($id) { + do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id); + } else { + do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR}); + } + if (%{ $self->{SESSION} }) { my $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)|; my $sth = prepare_query($::form, $dbh, $query); @@ -656,6 +644,7 @@ sub save_session { } $dbh->commit() unless $provided_dbh; + $::lxdebug->leave_sub; } sub set_session_value { @@ -712,7 +701,6 @@ sub create_unique_sesion_value { $self->{unique_counter}++; $value = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef, - no_auto => !$params{auto_restore}, data => $value, }; @@ -1104,41 +1092,32 @@ sub check_right { } sub assert { - $main::lxdebug->enter_sub(2); - - my $self = shift; - my $right = shift; - my $dont_abort = shift; - - my $form = $main::form; + $::lxdebug->enter_sub(2); + my ($self, $right, $dont_abort) = @_; - if ($self->check_right($form->{login}, $right)) { - $main::lxdebug->leave_sub(2); + if ($self->check_right($::myconfig{login}, $right)) { + $::lxdebug->leave_sub(2); return 1; } if (!$dont_abort) { - delete $form->{title}; - $form->show_generic_error($main::locale->text("You do not have the permissions to access this function.")); + delete $::form->{title}; + $::form->show_generic_error($::locale->text("You do not have the permissions to access this function.")); } - $main::lxdebug->leave_sub(2); + $::lxdebug->leave_sub(2); return 0; } sub load_rights_for_user { - $main::lxdebug->enter_sub(); - - my $self = shift; - my $login = shift; - - my $form = $main::form; - my $dbh = $self->dbconnect(); + $::lxdebug->enter_sub; + my ($self, $login) = @_; + my $dbh = $self->dbconnect; my ($query, $sth, $row, $rights); - $rights = {}; + $rights = { map { $_ => 0 } all_rights() }; $query = qq|SELECT gr."right", gr.granted @@ -1149,16 +1128,14 @@ sub load_rights_for_user { LEFT JOIN auth."user" u ON (ug.user_id = u.id) WHERE u.login = ?)|; - $sth = prepare_execute_query($form, $dbh, $query, $login); + $sth = prepare_execute_query($::form, $dbh, $query, $login); while ($row = $sth->fetchrow_hashref()) { $rights->{$row->{right}} |= $row->{granted}; } $sth->finish(); - map({ $rights->{$_} = 0 unless (defined $rights->{$_}); } SL::Auth::all_rights()); - - $main::lxdebug->leave_sub(); + $::lxdebug->leave_sub; return $rights; } @@ -1200,11 +1177,6 @@ If C<$params{expiration}> is set then it is interpreted as a number of seconds after which the value is removed from the session. It will never expire if that parameter is falsish. -If C<$params{auto_restore}> is trueish then the value will be copied -into C<$::form> upon the next request automatically. It defaults to -C and has therefore different behaviour than -L. - Returns the key created in the session. =item C diff --git a/SL/BackgroundJob/CreatePeriodicInvoices.pm b/SL/BackgroundJob/CreatePeriodicInvoices.pm index 559fd0299..0bbea2d86 100644 --- a/SL/BackgroundJob/CreatePeriodicInvoices.pm +++ b/SL/BackgroundJob/CreatePeriodicInvoices.pm @@ -22,7 +22,7 @@ sub run { my $self = shift; $self->{db_obj} = shift; - my $configs = SL::DB::Manager::PeriodicInvoicesConfig->get_all(where => [ active => 1 ]); + my $configs = SL::DB::Manager::PeriodicInvoicesConfig->get_all(query => [ active => 1 ]); foreach my $config (@{ $configs }) { my $new_end_date = $config->handle_automatic_extension; diff --git a/SL/Common.pm b/SL/Common.pm index dae75322f..c0bca0195 100644 --- a/SL/Common.pm +++ b/SL/Common.pm @@ -372,9 +372,8 @@ sub webdav_folder { mkdir_with_parents($path); } else { - my $base_path = substr($ENV{'SCRIPT_NAME'}, 1); + my $base_path = $ENV{'SCRIPT_NAME'}; $base_path =~ s|[^/]+$||; - $base_path =~ s|/$||; # wo kommt der wert für dir her? es wird doch gar nichts übergeben? fix für strict my $dir jb 21.2. if (opendir my $dir, $path) { foreach my $file (sort { lc $a cmp lc $b } readdir $dir) { @@ -390,7 +389,7 @@ sub webdav_folder { push @{ $form->{WEBDAV} }, { 'name' => $fname, - 'link' => "$base_path/$file", + 'link' => $base_path . $file, 'type' => $is_directory ? $main::locale->text('Directory') : $main::locale->text('File'), }; } diff --git a/SL/Controller/CustomVariableConfig.pm b/SL/Controller/CustomVariableConfig.pm new file mode 100644 index 000000000..0c47799de --- /dev/null +++ b/SL/Controller/CustomVariableConfig.pm @@ -0,0 +1,36 @@ +package SL::Controller::CustomVariableConfig; + +use strict; + +use parent qw(SL::Controller::Base); + +use SL::DB::CustomVariableConfig; + +__PACKAGE__->run_before('check_auth'); + +# +# actions +# + +sub action_reorder { + my ($self) = @_; + + my @ids = @{ $::form->{cvarcfg_id} || [] }; + my $result = SL::DB::CustomVariableConfig->new->db->do_transaction(sub { + foreach my $idx (0 .. scalar(@ids) - 1) { + SL::DB::CustomVariableConfig->new(id => $ids[$idx])->load->update_attributes(sortkey => $idx + 1); + } + }); + + $self->render(type => 'js', inline => '1;'); +} + +# +# filters +# + +sub check_auth { + $::auth->assert('config'); +} + +1; diff --git a/SL/Controller/DebugMenu.pm b/SL/Controller/DebugMenu.pm new file mode 100644 index 000000000..0e536760a --- /dev/null +++ b/SL/Controller/DebugMenu.pm @@ -0,0 +1,24 @@ +package SL::Controller::DebugMenu; + +use strict; +use parent qw(SL::Controller::Base); + +# safety +__PACKAGE__->run_before(sub { die 'not allowed in config' unless $::lx_office_conf{debug}{show_debug_menu}; }); + +sub action_reload { + my ($self, %params) = @_; + + print $::cgi->redirect('controller.pl?action=FrameHeader/header'); + exit; +} + +sub action_toggle { + my ($self, %params) = @_; + + $::lxdebug->level_by_name($::form->{level}, !$::lxdebug->level_by_name($::form->{level})); + print $::cgi->redirect('controller.pl?action=FrameHeader/header'); + return; +} + +1; diff --git a/SL/Controller/FrameHeader.pm b/SL/Controller/FrameHeader.pm new file mode 100644 index 000000000..855350c73 --- /dev/null +++ b/SL/Controller/FrameHeader.pm @@ -0,0 +1,17 @@ +package SL::Controller::FrameHeader; + +use strict; +use parent qw(SL::Controller::Base); + +sub action_header { + my ($self) = @_; + + delete $::form->{stylesheet}; + $::form->use_stylesheet('frame_header/header.css'); + $self->render('menu/header', + now => DateTime->now_local, + is_fastcgi => scalar($::dispatcher->interface_type =~ /fastcgi/i), + is_links => scalar($ENV{HTTP_USER_AGENT} =~ /links/i)); +} + +1; diff --git a/SL/Controller/PaymentTerm.pm b/SL/Controller/PaymentTerm.pm new file mode 100644 index 000000000..55401ba13 --- /dev/null +++ b/SL/Controller/PaymentTerm.pm @@ -0,0 +1,127 @@ +package SL::Controller::PaymentTerm; + +use strict; + +use parent qw(SL::Controller::Base); + +use SL::DB::PaymentTerm; +use SL::DB::Language; +use SL::Helper::Flash; + +use Rose::Object::MakeMethods::Generic +( + scalar => [ qw(payment_term languages) ], +); + +__PACKAGE__->run_before('check_auth'); +__PACKAGE__->run_before('load_payment_term', only => [ qw( edit update destroy move_up move_down) ]); +__PACKAGE__->run_before('load_languages', only => [ qw(new list edit create update) ]); + +# +# actions +# + +sub action_list { + my ($self) = @_; + + $self->render('payment_term/list', + title => $::locale->text('Payment terms'), + PAYMENT_TERMS => SL::DB::Manager::PaymentTerm->get_all_sorted); +} + +sub action_new { + my ($self) = @_; + + $self->{payment_term} = SL::DB::PaymentTerm->new; + $self->render('payment_term/form', title => $::locale->text('Create a new payment term')); +} + +sub action_edit { + my ($self) = @_; + $self->render('payment_term/form', title => $::locale->text('Edit payment term')); +} + +sub action_create { + my ($self) = @_; + + $self->{payment_term} = SL::DB::PaymentTerm->new; + $self->create_or_update; +} + +sub action_update { + my ($self) = @_; + $self->create_or_update; +} + +sub action_destroy { + my ($self) = @_; + + if (eval { $self->{payment_term}->delete; 1; }) { + flash_later('info', $::locale->text('The payment term has been deleted.')); + } else { + flash_later('error', $::locale->text('The payment term is in use and cannot be deleted.')); + } + + $self->redirect_to(action => 'list'); +} + +sub action_reorder { + my ($self) = @_; + + my @ids = @{ $::form->{payment_term_id} || [] }; + my $result = SL::DB::PaymentTerm->new->db->do_transaction(sub { + foreach my $idx (0 .. scalar(@ids) - 1) { + SL::DB::PaymentTerm->new(id => $ids[$idx])->load->update_attributes(sortkey => $idx + 1); + } + }); + + $self->render(type => 'js', inline => '1;'); +} + +# +# filters +# + +sub check_auth { + $::auth->assert('config'); +} + +# +# helpers +# + +sub create_or_update { + my $self = shift; + my $is_new = !$self->{payment_term}->id; + my $params = delete($::form->{payment_term}) || { }; + + $self->{payment_term}->assign_attributes(%{ $params }); + + my @errors = $self->{payment_term}->validate; + + if (@errors) { + flash('error', @errors); + $self->render('payment_term/form', title => $is_new ? $::locale->text('Create a new payment term') : $::locale->text('Edit payment term')); + return; + } + + $self->{payment_term}->save; + foreach my $language (@{ $self->{languages} }) { + $self->{payment_term}->save_attribute_translation('description_long', $language, $::form->{"translation_" . $language->id}); + } + + flash_later('info', $is_new ? $::locale->text('The payment term has been created.') : $::locale->text('The payment term has been saved.')); + $self->redirect_to(action => 'list'); +} + +sub load_payment_term { + my ($self) = @_; + $self->{payment_term} = SL::DB::PaymentTerm->new(id => $::form->{id})->load; +} + +sub load_languages { + my ($self) = @_; + $self->{languages} = SL::DB::Manager::Language->get_all_sorted; +} + +1; diff --git a/SL/Controller/PriceFactor.pm b/SL/Controller/PriceFactor.pm new file mode 100644 index 000000000..31f0e46f1 --- /dev/null +++ b/SL/Controller/PriceFactor.pm @@ -0,0 +1,36 @@ +package SL::Controller::PriceFactor; + +use strict; + +use parent qw(SL::Controller::Base); + +use SL::DB::PriceFactor; + +__PACKAGE__->run_before('check_auth'); + +# +# actions +# + +sub action_reorder { + my ($self) = @_; + + my @ids = @{ $::form->{price_factor_id} || [] }; + my $result = SL::DB::PriceFactor->new->db->do_transaction(sub { + foreach my $idx (0 .. scalar(@ids) - 1) { + SL::DB::PriceFactor->new(id => $ids[$idx])->load->update_attributes(sortkey => $idx + 1); + } + }); + + $self->render(type => 'js', inline => '1;'); +} + +# +# filters +# + +sub check_auth { + $::auth->assert('config'); +} + +1; diff --git a/SL/Controller/Unit.pm b/SL/Controller/Unit.pm new file mode 100644 index 000000000..018a7b387 --- /dev/null +++ b/SL/Controller/Unit.pm @@ -0,0 +1,36 @@ +package SL::Controller::Unit; + +use strict; + +use parent qw(SL::Controller::Base); + +use SL::DB::Unit; + +__PACKAGE__->run_before('check_auth'); + +# +# actions +# + +sub action_reorder { + my ($self) = @_; + + my @ids = @{ $::form->{unit_id} || [] }; + my $result = SL::DB::Unit->new->db->do_transaction(sub { + foreach my $idx (0 .. scalar(@ids) - 1) { + SL::DB::Unit->new(id => $ids[$idx])->load->update_attributes(sortkey => $idx + 1); + } + }); + + $self->render(type => 'js', inline => '1;'); +} + +# +# filters +# + +sub check_auth { + $::auth->assert('config'); +} + +1; diff --git a/SL/Controller/Warehouse.pm b/SL/Controller/Warehouse.pm new file mode 100644 index 000000000..a7b059c89 --- /dev/null +++ b/SL/Controller/Warehouse.pm @@ -0,0 +1,36 @@ +package SL::Controller::Warehouse; + +use strict; + +use parent qw(SL::Controller::Base); + +use SL::DB::Warehouse; + +__PACKAGE__->run_before('check_auth'); + +# +# actions +# + +sub action_reorder { + my ($self) = @_; + + my @ids = @{ $::form->{warehouse_id} || [] }; + my $result = SL::DB::Warehouse->new->db->do_transaction(sub { + foreach my $idx (0 .. scalar(@ids) - 1) { + SL::DB::Warehouse->new(id => $ids[$idx])->load->update_attributes(sortkey => $idx + 1); + } + }); + + $self->render(type => 'js', inline => '1;'); +} + +# +# filters +# + +sub check_auth { + $::auth->assert('config'); +} + +1; diff --git a/SL/DATEV.pm b/SL/DATEV.pm index 775d4dff7..e3cecef11 100644 --- a/SL/DATEV.pm +++ b/SL/DATEV.pm @@ -401,7 +401,7 @@ sub _get_transactions { my $firstrun = 1; my $subcent = abs($count) < 0.02; - while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.001)) { + while (abs($count) > 0.01 || $firstrun || ($subcent && abs($count) > 0.005)) { my $ref2 = $sth->fetchrow_hashref("NAME_lc"); last unless ($ref2); diff --git a/SL/DB/Chart.pm b/SL/DB/Chart.pm index bda45128c..70019c6fb 100644 --- a/SL/DB/Chart.pm +++ b/SL/DB/Chart.pm @@ -17,7 +17,7 @@ __PACKAGE__->meta->initialize; sub get_active_taxkey { my ($self, $date) = @_; $date ||= DateTime->today_local; - return SL::DB::Manager::TaxKey->get_all(where => [ and => [ chart_id => $self->id, + return SL::DB::Manager::TaxKey->get_all(query => [ and => [ chart_id => $self->id, startdate => { le => $date } ] ], sort_by => "startdate DESC")->[0]; } diff --git a/SL/DB/Helper/ActsAsList.pm b/SL/DB/Helper/ActsAsList.pm new file mode 100644 index 000000000..a6450533d --- /dev/null +++ b/SL/DB/Helper/ActsAsList.pm @@ -0,0 +1,152 @@ +package SL::DB::Helper::ActsAsList; + +use strict; + +use parent qw(Exporter); +our @EXPORT = qw(move_position_up move_position_down); + +use Carp; + +sub import { + my ($class, @params) = @_; + my $importing = caller(); + + $importing->before_save( sub { SL::DB::Helper::ActsAsList::set_position(@_) }); + $importing->before_delete(sub { SL::DB::Helper::ActsAsList::remove_position(@_) }); + + # Use 'goto' so that Exporter knows which module to import into via + # 'caller()'. + goto &Exporter::import; +} + +# +# Exported functions +# + +sub move_position_up { + my ($self) = @_; + do_move($self, 'up'); +} + +sub move_position_down { + my ($self) = @_; + do_move($self, 'down'); +} + +# +# Helper functions +# + +sub set_position { + my ($self) = @_; + my $column = column_name($self); + + if (!defined $self->$column) { + my $max_position = $self->db->dbh->selectrow_arrayref(qq|SELECT COALESCE(max(${column}), 0) FROM | . $self->meta->table)->[0]; + $self->$column($max_position + 1); + } + + return 1; +} + +sub remove_position { + my ($self) = @_; + my $column = column_name($self); + + $self->load; + if (defined $self->$column) { + $self->_get_manager_class->update_all(set => { $column => \"${column} - 1" }, + where => [ $column => { gt => $self->$column } ]); + } + + return 1; +} + +sub do_move { + my ($self, $direction) = @_; + my $column = column_name($self); + + croak "Object has not been saved yet" unless $self->id; + croak "No position set yet" unless defined $self->$column; + + my ($comp_sql, $comp_rdbo, $min_max, $plus_minus) = $direction eq 'up' ? ('<', 'ge', 'max', '+') : ('>', 'le', 'min', '-'); + + my $new_position = $self->db->dbh->selectrow_arrayref(qq|SELECT ${min_max}(${column}) FROM | . $self->meta->table . qq| WHERE ${column} ${comp_sql} | . $self->$column)->[0]; + + return undef unless defined $new_position; + + $self->_get_manager_class->update_all(set => { $column => $self->$column }, + where => [ $column => $new_position ]); + $self->update_attributes($column => $new_position); +} + +sub column_name { + my ($self) = @_; + return $self->can('sortkey') ? 'sortkey' : 'position'; +} + +1; +__END__ + +=pod + +=encoding utf8 + +=head1 NAME + +SL::DB::Helper::ActsAsList - Mixin for managing ordered items by a +column I or I + +=head1 SYNOPSIS + + package SL::DB::SomeObject; + use SL::DB::Helper::ActsAsList; + + package SL::Controller::SomeController; + ... + # Assign a position automatically + $obj = SL::DB::SomeObject->new(description => 'bla'); + $obj->save; + + # Move items up and down + $obj = SL::DB::SomeOBject->new(id => 1)->load; + $obj->move_position_up; + $obj->move_position_down; + + # Adjust all remaining positions automatically + $obj->delete + +This mixin assumes that the mixing package's table contains a column +called C or C (for legacy tables). This column is +set automatically upon saving the object if it hasn't been set +already. If it hasn't then it will be set to the maximum position used +in the table plus one. + +When the object is deleted all positions greater than the object's old +position are decreased by one. + +=head1 FUNCTIONS + +=over 4 + +=item C + +Swaps the object with the object one step above the current one +regarding their sort order by exchanging their C values. + +=item C + +Swaps the object with the object one step below the current one +regarding their sort order by exchanging their C values. + +=back + +=head1 BUGS + +Nothing here yet. + +=head1 AUTHOR + +Moritz Bunkus Em.bunkus@linet-services.deE + +=cut diff --git a/SL/DB/Helper/Attr.pm b/SL/DB/Helper/Attr.pm index 463bfd654..94b53dd7f 100644 --- a/SL/DB/Helper/Attr.pm +++ b/SL/DB/Helper/Attr.pm @@ -30,7 +30,7 @@ sub make { sub _make_by_type { my ($package, $name, $type) = @_; _as_number ($package, $name, places => -2) if $type =~ /numeric | real | float/xi; - _as_percent($package, $name, places => 0) if $type =~ /numeric | real | float/xi; + _as_percent($package, $name, places => 2) if $type =~ /numeric | real | float/xi; _as_number ($package, $name, places => 0) if $type =~ /int/xi; _as_date ($package, $name) if $type =~ /date | timestamp/xi; } diff --git a/SL/DB/Helper/TransNumberGenerator.pm b/SL/DB/Helper/TransNumberGenerator.pm index c060a2f5d..050526841 100644 --- a/SL/DB/Helper/TransNumberGenerator.pm +++ b/SL/DB/Helper/TransNumberGenerator.pm @@ -93,7 +93,7 @@ SL::DB::Helper::TransNumberGenerator - A mixin for creating unique record number =over 4 -=item C +=item C Generates a new unique record number for the mixing class. Each record type (invoices, sales quotations, purchase orders etc) has its own @@ -147,7 +147,7 @@ and return a value. If it fails then it is due to exceptions. =item C -Calls and returns L with the parameters +Calls and returns with the parameters C and C. C<%params> is passed to it as well. diff --git a/SL/DB/Helper/TranslatedAttributes.pm b/SL/DB/Helper/TranslatedAttributes.pm new file mode 100644 index 000000000..2c3857c7a --- /dev/null +++ b/SL/DB/Helper/TranslatedAttributes.pm @@ -0,0 +1,131 @@ +package SL::DB::Helper::TranslatedAttributes; + +use strict; + +use SL::DB::GenericTranslation; + +use parent qw(Exporter); +our @EXPORT = qw(translated_attribute save_attribute_translation); + +use Carp; + +sub translated_attribute { + my ($self, $attribute, $language_id, $verbatim) = @_; + + $language_id = _check($self, $attribute, $language_id, $verbatim); + my $translation_obj = _find_translation($self, $attribute, $language_id, 0); + my $translation = $translation_obj ? $translation_obj->translation : ''; + + return $translation if $verbatim || $translation; + + $translation_obj = _find_translation($self, $attribute, undef, 0); + $translation = $translation_obj ? $translation_obj->translation : ''; + + return $translation || $self->$attribute; +} + +sub save_attribute_translation { + my ($self, $attribute, $language_id, $value) = @_; + + $language_id = _check($self, $attribute, $language_id); + + return _find_translation($self, $attribute, $language_id, 1)->update_attributes(translation => $value); +} + +sub _check { + my ($self, $attribute, $language_id, $verbatim) = @_; + + croak "Invalid attribute '${attribute}'" unless $self->can($attribute); + croak "Object has not been saved yet" unless $self->id || $verbatim; + + return (ref($language_id) eq 'SL::DB::Language' ? $language_id->id : $language_id) || undef; +} + +sub _find_translation { + my ($self, $attribute, $language_id, $new_if_not_found) = @_; + + my %params = (language_id => $language_id, + translation_type => ref($self). '/' . $attribute, + translation_id => $self->id); + + return SL::DB::Manager::GenericTranslation->find_by(%params) || ($new_if_not_found ? SL::DB::GenericTranslation->new(%params) : undef); +} + +1; + +__END__ + +=encoding utf8 + +=head1 NAME + +SL::DB::Helper::TranslatedAttributes - Mixin for retrieving and saving +translations for certain model attributes in the table +I + +=head1 SYNOPSIS + +Declaration: + + package SL::DB::SomeObject; + use SL::DB::Helper::Translated; + +Usage: + + my $object = SL::DB::SomeObject->new(id => $::form->{id})->load; + my $language = SL::DB::Manager::Language->find_by(description => 'Deutsch'); + print "Untranslated name: " . $object->name . " translated: " . $object->translated_attribute('name', $language) . "\n"; + + print "Now saving new value\n"; + my $save_ok = $object->save_attribute_translation('name', $language, 'Lieferung frei Haus'); + +=head1 FUNCTIONS + +=over 4 + +=item C + +Returns the translation stored for the attribute C<$attribute> and the +language C<$language_id> (either an ID or an instance of +L). + +If C<$verbatim> is falsish and either no translation exists for +C<$language_id> or if C<$language_id> is undefined then the default +translation is looked up. + +If C<$verbatim> is falsish and neither translation exists then the +value of C<< $self->$attribute >> is returned. + +Requires that C<$self> has a primary ID column named C and that +the object has been saved. + +=item C + +Saves the translation C<$value> for the attribute C<$attribute> and +the language C<$language_id> (either an ID or an instance of +L). + +If C<$language_id> is undefined then the default translation will be +saved. + +Requires that C<$self> has a primary ID column named C and that +the object has been saved. + +Returns the same value as C. + +=back + +=head1 EXPORTS + +This mixin exports the functions L and +L. + +=head1 BUGS + +Nothing here yet. + +=head1 AUTHOR + +Moritz Bunkus Em.bunkus@linet-services.deE + +=cut diff --git a/SL/DB/Language.pm b/SL/DB/Language.pm index abfdebce0..3248f386c 100644 --- a/SL/DB/Language.pm +++ b/SL/DB/Language.pm @@ -1,13 +1,8 @@ -# This file has been auto-generated only because it didn't exist. -# Feel free to modify it at will; it will not be overwritten automatically. - package SL::DB::Language; use strict; use SL::DB::MetaSetup::Language; - -# Creates get_all, get_all_count, get_all_iterator, delete_all and update_all. -__PACKAGE__->meta->make_manager_class; +use SL::DB::Manager::Language; 1; diff --git a/SL/DB/Manager/BackgroundJob.pm b/SL/DB/Manager/BackgroundJob.pm index 1429a7856..96af86312 100644 --- a/SL/DB/Manager/BackgroundJob.pm +++ b/SL/DB/Manager/BackgroundJob.pm @@ -29,7 +29,7 @@ sub get_all_need_to_run { next_run_at => undef, next_run_at => { le => $now } ] ]); - return $class->get_all(where => [ or => [ @interval_args, @once_args ] ]); + return $class->get_all(query => [ or => [ @interval_args, @once_args ] ]); } 1; diff --git a/SL/DB/Manager/Language.pm b/SL/DB/Manager/Language.pm new file mode 100644 index 000000000..db0d29a72 --- /dev/null +++ b/SL/DB/Manager/Language.pm @@ -0,0 +1,21 @@ +package SL::DB::Manager::Language; + +use strict; + +use SL::DB::Helper::Manager; +use base qw(SL::DB::Helper::Manager); + +use SL::DB::Helper::Sorted; + +sub object_class { 'SL::DB::Language' } + +__PACKAGE__->make_manager_methods; + +sub _sort_spec { + return ( default => [ 'description', 1 ], + columns => { SIMPLE => 'ALL', + map { ( $_ => "lower(language.${_})" ) } qw(description template_code article_code), + }); +} + +1; diff --git a/SL/DB/Manager/PaymentTerm.pm b/SL/DB/Manager/PaymentTerm.pm new file mode 100644 index 000000000..abe6837fa --- /dev/null +++ b/SL/DB/Manager/PaymentTerm.pm @@ -0,0 +1,21 @@ +package SL::DB::Manager::PaymentTerm; + +use strict; + +use SL::DB::Helper::Manager; +use base qw(SL::DB::Helper::Manager); + +use SL::DB::Helper::Sorted; + +sub object_class { 'SL::DB::PaymentTerm' } + +__PACKAGE__->make_manager_methods; + +sub _sort_spec { + return ( default => [ 'sortkey', 1 ], + columns => { SIMPLE => 'ALL', + map { ( $_ => "lower(payment_terms.${_})" ) } qw(description description_long), + }); +} + +1; diff --git a/SL/DB/MetaSetup/Unit.pm b/SL/DB/MetaSetup/Unit.pm index c22946283..6e05737df 100644 --- a/SL/DB/MetaSetup/Unit.pm +++ b/SL/DB/MetaSetup/Unit.pm @@ -15,10 +15,13 @@ __PACKAGE__->meta->setup( factor => { type => 'numeric', precision => 5, scale => 20 }, type => { type => 'varchar', length => 20 }, sortkey => { type => 'integer', not_null => 1 }, + id => { type => 'serial', not_null => 1 }, ], primary_key_columns => [ 'name' ], + unique_key => [ 'id' ], + foreign_keys => [ unit => { class => 'SL::DB::Unit', diff --git a/SL/DB/Object.pm b/SL/DB/Object.pm old mode 100644 new mode 100755 index 71e0a3939..a80640cad --- a/SL/DB/Object.pm +++ b/SL/DB/Object.pm @@ -9,6 +9,7 @@ use SL::DB; use SL::DB::Helper::Attr; use SL::DB::Helper::Metadata; use SL::DB::Helper::Manager; +use SL::DB::Object::Hooks; use base qw(Rose::DB::Object); @@ -84,6 +85,57 @@ sub call_sub { return $self->$sub(@_); } +sub call_sub_if { + my $self = shift; + my $sub = shift; + my $check = shift; + + $check = $check->($self) if ref($check) eq 'CODE'; + + return $check ? $self->$sub(@_) : $self; +} + +# These three functions cannot sit in SL::DB::Object::Hooks because +# mixins don't deal well with super classes (SUPER is the current +# package's super class, not $self's). +sub load { + my ($self, @args) = @_; + + SL::DB::Object::Hooks::run_hooks($self, 'before_load'); + my $result = $self->SUPER::load(@args); + SL::DB::Object::Hooks::run_hooks($self, 'after_load', $result); + + return $result; +} + +sub save { + my ($self, @args) = @_; + + my $result; + my $worker = sub { + SL::DB::Object::Hooks::run_hooks($self, 'before_save'); + $result = $self->SUPER::save(@args); + SL::DB::Object::Hooks::run_hooks($self, 'after_save', $result); + }; + + $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker); + return $result; +} + +sub delete { + my ($self, @args) = @_; + + my $result; + my $worker = sub { + SL::DB::Object::Hooks::run_hooks($self, 'before_delete'); + $result = $self->SUPER::delete(@args); + SL::DB::Object::Hooks::run_hooks($self, 'after_delete', $result); + }; + + $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker); + return $result; +} + 1; __END__ @@ -145,6 +197,16 @@ name is a composite, e.g. my $chart_id = $buchungsgruppe->call_sub(($is_sales ? "income" : "expense") . "_accno_id_${taxzone_id}"); +=item C + +Calls the sub C<$name> on C<$self> with the arguments C<@args> if +C<$check> is trueish. If C<$check> is a code reference then it will be +called with C<$self> as the only argument and its result determines +whether or not C<$name> is called. + +Returns the sub's result if the check is positive and C<$self> +otherwise. + =back =head1 AUTHOR diff --git a/SL/DB/Object/Hooks.pm b/SL/DB/Object/Hooks.pm new file mode 100644 index 000000000..e47951407 --- /dev/null +++ b/SL/DB/Object/Hooks.pm @@ -0,0 +1,143 @@ +package SL::DB::Object::Hooks; + +use strict; + +use SL::X; + +use parent qw(Exporter); +our @EXPORT = qw(before_load after_load + before_save after_save + before_delete after_delete); + +my %hooks; + +# Adding hooks + +sub before_save { + _add_hook('before_save', @_); +} + +sub after_save { + _add_hook('after_save', @_); +} + +sub before_load { + _add_hook('before_load', @_); +} + +sub after_load { + _add_hook('after_load', @_); +} + +sub before_delete { + _add_hook('before_delete', @_); +} + +sub after_delete { + _add_hook('after_delete', @_); +} + +# Running hooks + +sub run_hooks { + my ($object, $when, @args) = @_; + + foreach my $sub (@{ ( $hooks{$when} || { })->{ ref($object) } || [ ] }) { + my $result = ref($sub) eq 'CODE' ? $sub->($object, @args) : $object->call_sub($sub, @args); + die SL::X::DBHookError->new( + hook => (ref($sub) eq 'CODE' ? '' : $sub), + when => $when, + object => $object, + ) if !$result; + } +} + +# Internals + +sub _add_hook { + my ($when, $class, $sub_name, $code) = @_; + $hooks{$when} ||= { }; + $hooks{$when}->{$class} ||= [ ]; + push @{ $hooks{$when}->{$class} }, $sub_name; +} + +1; +__END__ + +=pod + +=encoding utf8 + +=head1 NAME + +SL::DB::Object::Hooks - Hooks that are run before/after a +load/save/delete + +=head1 SYNOPSIS + +Hooks are functions that are called before or after an object is +loaded, saved or deleted. The package defines the hooks, and those +hooks themselves are run as instance methods. + +Hooks are run in the order they're added. + +Hooks must return a trueish value in order to continue processing. If +any hook returns a falsish value then an exception (instance of +C) is thrown. However, C usually +runs the hooks from within a transaction, catches the exception and +only returns falsish in error cases. + +=head1 FUNCTIONS + +=over 4 + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +Adds a new hook that is called at the appropriate time. C<$sub> can be +either a name of an existing sub or a code reference. If it is a code +reference then the then-current C<$self> will be passed as the first +argument. + +C hooks are called without arguments. + +C hooks are called with a single argument: the result of the +C or C operation. + +=item C + +Runs all hooks for the object C<$object> that are defined for +C<$when>. C<$when> is the same as one of the C or +C function names above. + +An exception of C is thrown if any of the hooks +returns a falsish value. + +This function is supposed to be called by L, +L or L. + +=back + +=head1 EXPORTS + +This mixin exports the functions L, L, +L, L, L, L. + +=head1 BUGS + +Nothing here yet. + +=head1 AUTHOR + +Moritz Bunkus Em.bunkus@linet-services.deE + +=cut diff --git a/SL/DB/PaymentTerm.pm b/SL/DB/PaymentTerm.pm index b525910e9..3630a7094 100644 --- a/SL/DB/PaymentTerm.pm +++ b/SL/DB/PaymentTerm.pm @@ -1,13 +1,20 @@ -# This file has been auto-generated only because it didn't exist. -# Feel free to modify it at will; it will not be overwritten automatically. - package SL::DB::PaymentTerm; use strict; use SL::DB::MetaSetup::PaymentTerm; +use SL::DB::Manager::PaymentTerm; +use SL::DB::Helper::ActsAsList; +use SL::DB::Helper::TranslatedAttributes; + +sub validate { + my ($self) = @_; + + my @errors; + push @errors, $::locale->text('The description is missing.') if !$self->description; + push @errors, $::locale->text('The long description is missing.') if !$self->description_long; -# Creates get_all, get_all_count, get_all_iterator, delete_all and update_all. -__PACKAGE__->meta->make_manager_class; + return @errors; +} 1; diff --git a/SL/DBConnect.pm b/SL/DBConnect.pm index fbcf1d5a1..4e084502a 100644 --- a/SL/DBConnect.pm +++ b/SL/DBConnect.pm @@ -12,7 +12,7 @@ sub connect { require Log::Log4perl; require DBIx::Log4perl; - my $filename = $LXDebug::file_name; + my $filename = $::lxdebug->file; my $config = $::lx_office_conf{debug}->{dbix_log4perl_config}; $config =~ s/LXDEBUGFILE/${filename}/g; diff --git a/SL/DO.pm b/SL/DO.pm index f39196323..841f454db 100644 --- a/SL/DO.pm +++ b/SL/DO.pm @@ -831,6 +831,7 @@ sub order_details { push @{ $form->{TEMPLATE_ARRAYS}{description} }, $form->{"description_$i"}; push @{ $form->{TEMPLATE_ARRAYS}{longdescription} }, $form->{"longdescription_$i"}; push @{ $form->{TEMPLATE_ARRAYS}{qty} }, $form->format_amount($myconfig, $form->{"qty_$i"}); + push @{ $form->{TEMPLATE_ARRAYS}{qty_nofmt} }, $form->{"qty_$i"}; push @{ $form->{TEMPLATE_ARRAYS}{unit} }, $form->{"unit_$i"}; push @{ $form->{TEMPLATE_ARRAYS}{partnotes} }, $form->{"partnotes_$i"}; push @{ $form->{TEMPLATE_ARRAYS}{serialnumber} }, $form->{"serialnumber_$i"}; @@ -883,6 +884,7 @@ sub order_details { push @{ $form->{TEMPLATE_ARRAYS}{si_chargenumber}[$position-1] }, $si->{chargenumber}; push @{ $form->{TEMPLATE_ARRAYS}{si_bestbefore}[$position-1] }, $si->{bestbefore}; push @{ $form->{TEMPLATE_ARRAYS}{si_qty}[$position-1] }, $form->format_amount($myconfig, $si->{qty} * 1); + push @{ $form->{TEMPLATE_ARRAYS}{si_qty_nofmt}[$position-1] }, $si->{qty} * 1; push @{ $form->{TEMPLATE_ARRAYS}{si_unit}[$position-1] }, $si->{unit}; } } diff --git a/SL/Dispatcher.pm b/SL/Dispatcher.pm index 909433ebd..df8cc8344 100644 --- a/SL/Dispatcher.pm +++ b/SL/Dispatcher.pm @@ -19,6 +19,7 @@ use SL::Locale; use SL::Common; use SL::Form; use SL::Helper::DateTime; +use SL::Template::Plugin::HTMLFixes; use List::Util qw(first); use File::Basename; @@ -51,7 +52,6 @@ sub pre_request_checks { show_error('login/auth_db_unreachable'); } } - $::auth->expire_sessions; } sub show_error { @@ -188,7 +188,7 @@ sub handle_request { $::form->error($::locale->text('System currently down for maintenance!')) if -e ($::lx_office_conf{paths}->{userspath} . "/nologin") && $script ne 'admin'; - if ($script eq 'login' or $script eq 'admin' or $script eq 'kopf') { + if ($script eq 'login' or $script eq 'admin') { $::form->{titlebar} = "Lx-Office " . $::locale->text('Version') . " $::form->{version}"; ::run($session_result); @@ -231,12 +231,14 @@ sub handle_request { }; # cleanup + $::auth->expire_session_keys->save_session; + $::auth->expire_sessions; + $::auth->reset; + $::locale = undef; $::form = undef; $::myconfig = (); Form::disconnect_standard_dbh; - $::auth->expire_session_keys->save_session; - $::auth->reset; $::lxdebug->end_request; $::lxdebug->leave_sub; diff --git a/SL/Drafts.pm b/SL/Drafts.pm index 891775bc0..4a29b1925 100644 --- a/SL/Drafts.pm +++ b/SL/Drafts.pm @@ -45,7 +45,8 @@ sub save { my ($dbh, $sth, $query, %saved, $dumped); - $dbh = $form->dbconnect_noauto($myconfig); + $dbh = $form->get_standard_dbh; + $dbh->begin_work; my ($module, $submodule) = $self->get_module($form); @@ -72,7 +73,6 @@ sub save { do_query($form, $dbh, $query, $draft_description, $dumped, $form->{login}, $draft_id); $dbh->commit(); - $dbh->disconnect(); $form->{draft_id} = $draft_id; $form->{draft_description} = $draft_description; @@ -87,7 +87,7 @@ sub load { my ($dbh, $sth, $query, @values); - $dbh = $form->dbconnect($myconfig); + $dbh = $form->get_standard_dbh; $query = qq|SELECT id, description, form FROM drafts WHERE id = ?|; @@ -98,8 +98,6 @@ sub load { } $sth->finish(); - $dbh->disconnect(); - $main::lxdebug->leave_sub(); return @values; @@ -114,13 +112,11 @@ sub remove { my ($dbh, $sth, $query); - $dbh = $form->dbconnect($myconfig); + $dbh = $form->get_standard_dbh; $query = qq|DELETE FROM drafts WHERE id IN (| . join(", ", map { "?" } @draft_ids) . qq|)|; do_query($form, $dbh, $query, @draft_ids); - $dbh->disconnect(); - $main::lxdebug->leave_sub(); } diff --git a/SL/Form.pm b/SL/Form.pm index b3a3e23df..582d2aff8 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -640,6 +640,18 @@ sub create_http_response { return $output; } +sub use_stylesheet { + my $self = shift; + + $self->{stylesheet} = [ $self->{stylesheet} ] unless ref $self->{stylesheet} eq 'ARRAY'; + $self->{stylesheet} = [ grep { -f } + map { m:^css/: ? $_ : "css/$_" } + grep { $_ } + (@{ $self->{stylesheet} }, @_) + ]; + + return @{ $self->{stylesheet} }; +} sub header { $::lxdebug->enter_sub; @@ -662,8 +674,7 @@ sub header { push @header, ""; } - push @header, "" - for grep { -f "css/$_" } apply { s|.*/|| } $self->{stylesheet}, $self->{stylesheets}; + push @header, map { qq|| } $self->use_stylesheet; push @header, "" if $self->{landscape}; push @header, "" if -f $self->{favicon}; @@ -779,13 +790,6 @@ sub _prepare_html_template { $language = "de" unless ($language); if (-f "templates/webpages/${file}.html") { - if ((-f ".developer") && ((stat("templates/webpages/${file}.html"))[9] > (stat("locale/${language}/all"))[9])) { - my $info = "Developer information: templates/webpages/${file}.html is newer than the translation file locale/${language}/all.\n" . - "Please re-run 'locales.pl' in 'locale/${language}'."; - print(qq|
$info
|); - ::end_of_request(); - } - $file = "templates/webpages/${file}.html"; } else { @@ -1160,7 +1164,7 @@ sub parse_amount { if ( ($myconfig->{numberformat} eq '1.000,00') || ($myconfig->{numberformat} eq '1000,00')) { $amount =~ s/\.//g; - $amount =~ s/,/\./; + $amount =~ s/,/\./g; } if ($myconfig->{numberformat} eq "1'000.00") { @@ -1171,7 +1175,9 @@ sub parse_amount { $main::lxdebug->leave_sub(2); - return ($amount * 1); + # Make sure no code wich is not a math expression ends up in eval(). + return 0 unless $amount =~ /^ [\s \d \( \) \- \+ \* \/ \. ]* $/x; + return scalar(eval($amount)) * 1 ; } sub round_amount { @@ -1637,7 +1643,24 @@ sub date_closed { my $dbh = $self->dbconnect($myconfig); my $query = "SELECT 1 FROM defaults WHERE ? < closedto"; - my $sth = prepare_execute_query($self, $dbh, $query, $date); + my $sth = prepare_execute_query($self, $dbh, $query, conv_date($date)); + + # Falls $date = '' - Fehlermeldung aus der Datenbank. Ich denke, + # es ist sicher ein conv_date vorher IMMER auszuführen. + # Testfälle ohne definiertes closedto: + # Leere Datumseingabe i.O. + # SELECT 1 FROM defaults WHERE '' < closedto + # normale Zahlungsbuchung über Rechnungsmaske i.O. + # SELECT 1 FROM defaults WHERE '10.05.2011' < closedto + # Testfälle mit definiertem closedto (30.04.2011): + # Leere Datumseingabe i.O. + # SELECT 1 FROM defaults WHERE '' < closedto + # normale Buchung im geschloßenem Zeitraum i.O. + # SELECT 1 FROM defaults WHERE '21.04.2011' < closedto + # Fehlermeldung: Es können keine Zahlungen für abgeschlossene Bücher gebucht werden! + # normale Buchung in aktiver Buchungsperiode i.O. + # SELECT 1 FROM defaults WHERE '01.05.2011' < closedto + my ($closed) = $sth->fetchrow_array; $main::lxdebug->leave_sub(); @@ -1852,12 +1875,12 @@ sub set_payment_options { my $dbh = $self->get_standard_dbh($myconfig); my $query = - qq|SELECT p.terms_netto, p.terms_skonto, p.percent_skonto, p.description_long | . + 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 = ?|; ($self->{terms_netto}, $self->{terms_skonto}, $self->{percent_skonto}, - $self->{payment_terms}) = + $self->{payment_terms}, $self->{payment_description}) = selectrow_query($self, $dbh, $query, $self->{payment_id}); if ($transdate eq "") { @@ -1904,10 +1927,12 @@ sub set_payment_options { if ($self->{"language_id"}) { $query = - qq|SELECT t.description_long, l.output_numberformat, l.output_dateformat, l.output_longdates | . - qq|FROM translation_payment_terms t | . + 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.payment_terms_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, @@ -2381,7 +2406,7 @@ $main::lxdebug->enter_sub(); $key = "all_payments" unless ($key); - my $query = qq|SELECT * FROM payment_terms ORDER BY id|; + my $query = qq|SELECT * FROM payment_terms ORDER BY sortkey|; $self->{$key} = selectall_hashref_query($self, $dbh, $query); @@ -3800,7 +3825,7 @@ Examples: =head2 C
Generates a general purpose http/html header and includes most of the scripts -ans stylesheets needed. +and stylesheets needed. Stylesheets can be added with L. Only one header will be generated. If the method was already called in this request it will not output anything and return undef. Also if no @@ -3820,9 +3845,8 @@ default to 3 seconds and the refering url. =item stylesheet -=item stylesheets - -If these are arrayrefs the contents will be inlined into the header. +Either a scalar or an array ref. Will be inlined into the header. Add +stylesheets with the L function. =item landscape diff --git a/SL/IC.pm b/SL/IC.pm index b6007d9dc..bbf475310 100644 --- a/SL/IC.pm +++ b/SL/IC.pm @@ -40,6 +40,7 @@ use YAML; use SL::CVar; use SL::DBUtils; +use SL::TransNumber; use strict; @@ -311,6 +312,11 @@ sub save { my $priceupdate = ', priceupdate = current_date'; if ($form->{id}) { + my $trans_number = SL::TransNumber->new(type => $form->{item}, dbh => $dbh, number => $form->{partnumber}, id => $form->{id}); + if (!$trans_number->is_unique) { + $::lxdebug->leave_sub; + return 3; + } # get old price $query = qq|SELECT sellprice, weight FROM parts WHERE id = ?|; @@ -346,23 +352,19 @@ sub save { $priceupdate = '' if (all { $previous_values->{$_} == $form->{$_} } qw(sellprice lastcost listprice)); } else { - my ($count) = selectrow_query($form, $dbh, qq|SELECT COUNT(*) FROM parts WHERE partnumber = ?|, $form->{partnumber}); - if ($count) { - $main::lxdebug->leave_sub(); + my $trans_number = SL::TransNumber->new(type => $form->{item}, dbh => $dbh, number => $form->{partnumber}, save => 1); + + if ($form->{partnumber} && !$trans_number->is_unique) { + $::lxdebug->leave_sub; return 3; } + $form->{partnumber} = $trans_number->create_unique; + ($form->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('id')|); - do_query($form, $dbh, qq|INSERT INTO parts (id, partnumber, unit) VALUES (?, '', '')|, $form->{id}); + do_query($form, $dbh, qq|INSERT INTO parts (id, partnumber, unit) VALUES (?, ?, '')|, $form->{id}, $form->{partnumber}); $form->{orphaned} = 1; - if ($form->{partnumber} eq "" && $form->{"item"} eq "service") { - $form->{partnumber} = $form->update_defaults($myconfig, "servicenumber"); - } - if ($form->{partnumber} eq "" && $form->{"item"} ne "service") { - $form->{partnumber} = $form->update_defaults($myconfig, "articlenumber"); - } - } my $partsgroup_id = 0; @@ -502,7 +504,7 @@ sub save { if (($form->{"make_$i"}) || ($form->{"model_$i"})) { #hli $value = $form->parse_amount($myconfig, $form->{"lastcost_$i"}); - if ($value == $form->{"old_lastcost_$i"}) + if ($value == $form->parse_amount($myconfig, $form->{"old_lastcost_$i"})) { if ($form->{"lastupdate_$i"} eq "") { $lastupdate = 'now()'; @@ -1663,7 +1665,7 @@ sub prepare_parts_for_printing { } my $placeholders = join ', ', ('?') x scalar(@part_ids); - my $query = qq|SELECT mm.parts_id, mm.model, v.name AS make + my $query = qq|SELECT mm.parts_id, mm.model, mm.lastcost, v.name AS make FROM makemodel mm LEFT JOIN vendor v ON (mm.make = v.id) WHERE mm.parts_id IN ($placeholders)|; diff --git a/SL/IR.pm b/SL/IR.pm index 83921779a..86b1323fd 100644 --- a/SL/IR.pm +++ b/SL/IR.pm @@ -158,8 +158,10 @@ sub post_invoice { $linetotal = $form->round_amount($form->{"sellprice_$i"} * $form->{"qty_$i"} / $price_factor, 2); if ($form->{taxincluded}) { + $taxamount = $linetotal * ($taxrate / (1 + $taxrate)); $form->{"sellprice_$i"} = $form->{"sellprice_$i"} * (1 / (1 + $taxrate)); + } else { $taxamount = $linetotal * $taxrate; } @@ -380,11 +382,41 @@ sub post_invoice { $invoicediff += $paiddiff; $expensediff += $paiddiff; - ######## this only applies to tax included +######## this only applies to tax included + + # in the sales invoice case rounding errors only have to be corrected for + # income accounts, it is enough to add the total rounding error to one of + # the income accounts, with the one assigned to the last row being used + # (lastinventoryaccno) + + # in the purchase invoice case rounding errors may be split between + # inventory accounts and expense accounts. After rounding, an error of 1 + # cent is introduced if the total rounding error exceeds 0.005. The total + # error is made up of $invoicediff and $expensediff, however, so if both + # values are below 0.005, but add up to a total >= 0.005, correcting + # lastinventoryaccno and lastexpenseaccno separately has no effect after + # rounding. This caused bug 1579. Therefore when the combined total exceeds + # 0.005, but neither do individually, the account with the larger value + # shall receive the total rounding error, and the next time it is rounded + # the 1 cent correction will be introduced. $form->{amount}{ $form->{id} }{$lastinventoryaccno} -= $invoicediff if $lastinventoryaccno; $form->{amount}{ $form->{id} }{$lastexpenseaccno} -= $expensediff if $lastexpenseaccno; + if ( (abs($expensediff)+abs($invoicediff)) >= 0.005 and abs($expensediff) < 0.005 and abs($invoicediff) < 0.005 ) { + + # in total the rounding error adds up to 1 cent effectively, correct the + # larger of the two numbers + + if ( abs($form->{amount}{ $form->{id} }{$lastinventoryaccno}) > abs($form->{amount}{ $form->{id} }{$lastexpenseaccno}) ) { + # $invoicediff has already been deducted, now also deduct expensediff + $form->{amount}{ $form->{id} }{$lastinventoryaccno} -= $expensediff; + } else { + # expensediff has already been deducted, now also deduct invoicediff + $form->{amount}{ $form->{id} }{$lastexpenseaccno} -= $invoicediff; + }; + }; + } else { $amount = $form->round_amount($netamount * $form->{exchangerate}, 2); $paiddiff = $amount - $netamount * $form->{exchangerate}; @@ -405,21 +437,22 @@ sub post_invoice { $form->{paid} = $form->round_amount($form->{paid} * $form->{exchangerate} + $paiddiff, 2) if $form->{paid} != 0; - # update exchangerate +# update exchangerate $form->update_exchangerate($dbh, $form->{currency}, $form->{invdate}, 0, $form->{exchangerate}) if ($form->{currency} ne $defaultcurrency) && !$exchangerate; - # record acc_trans transactions +# record acc_trans transactions foreach my $trans_id (keys %{ $form->{amount} }) { foreach my $accno (keys %{ $form->{amount}{$trans_id} }) { $form->{amount}{$trans_id}{$accno} = $form->round_amount($form->{amount}{$trans_id}{$accno}, 2); + next if $payments_only || !$form->{amount}{$trans_id}{$accno}; $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, taxkey, project_id) VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?, - (SELECT taxkey_id FROM chart WHERE accno = ?), ?)|; + (SELECT taxkey_id FROM chart WHERE accno = ?), ?)|; @values = ($trans_id, $accno, $form->{amount}{$trans_id}{$accno}, conv_date($form->{invdate}), $accno, $project_id); do_query($form, $dbh, $query, @values); diff --git a/SL/IS.pm b/SL/IS.pm index a94035598..689c779be 100644 --- a/SL/IS.pm +++ b/SL/IS.pm @@ -59,7 +59,7 @@ sub invoice_details { $form->{duedate} ||= $form->{invdate}; # connect to database - my $dbh = $form->dbconnect($myconfig); + my $dbh = $form->get_standard_dbh; my $sth; my $query = qq|SELECT date | . conv_dateq($form->{duedate}) . qq| - date | . conv_dateq($form->{invdate}) . qq| AS terms|; @@ -201,9 +201,11 @@ sub invoice_details { push @{ $form->{TEMPLATE_ARRAYS}->{description} }, $form->{"description_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{longdescription} }, $form->{"longdescription_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{qty} }, $form->format_amount($myconfig, $form->{"qty_$i"}); + push @{ $form->{TEMPLATE_ARRAYS}->{qty_nofmt} }, $form->{"qty_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{unit} }, $form->{"unit_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{deliverydate_oe} }, $form->{"reqdate_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{sellprice} }, $form->{"sellprice_$i"}; + push @{ $form->{TEMPLATE_ARRAYS}->{sellprice_nofmt} }, $form->parse_amount($myconfig, $form->{"sellprice_$i"}); push @{ $form->{TEMPLATE_ARRAYS}->{ordnumber_oe} }, $form->{"ordnumber_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{transdate_oe} }, $form->{"transdate_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{invnumber} }, $form->{"invnumber"}; @@ -241,12 +243,14 @@ sub invoice_details { my $nodiscount_linetotal = $form->round_amount($form->{"qty_$i"} * $sellprice / $price_factor->{factor}, 2); $form->{"netprice_$i"} = $form->round_amount($form->{"qty_$i"} ? ($linetotal / $form->{"qty_$i"}) : 0, 2); - push @{ $form->{TEMPLATE_ARRAYS}->{netprice} }, ($form->{"netprice_$i"} != 0) ? $form->format_amount($myconfig, $form->{"netprice_$i"}, $decimalplaces) : ''; + push @{ $form->{TEMPLATE_ARRAYS}->{netprice} }, ($form->{"netprice_$i"} != 0) ? $form->format_amount($myconfig, $form->{"netprice_$i"}, $decimalplaces) : ''; + push @{ $form->{TEMPLATE_ARRAYS}->{netprice_nofmt} }, ($form->{"netprice_$i"} != 0) ? $form->{"netprice_$i"} : ''; $linetotal = ($linetotal != 0) ? $linetotal : ''; - push @{ $form->{TEMPLATE_ARRAYS}->{discount} }, ($discount != 0) ? $form->format_amount($myconfig, $discount * -1, 2) : ''; - push @{ $form->{TEMPLATE_ARRAYS}->{p_discount} }, $form->{"discount_$i"}; + push @{ $form->{TEMPLATE_ARRAYS}->{discount} }, ($discount != 0) ? $form->format_amount($myconfig, $discount * -1, 2) : ''; + push @{ $form->{TEMPLATE_ARRAYS}->{discount_nofmt} }, ($discount != 0) ? $discount * -1 : ''; + push @{ $form->{TEMPLATE_ARRAYS}->{p_discount} }, $form->{"discount_$i"}; $form->{total} += $linetotal; $form->{nodiscount_total} += $nodiscount_linetotal; @@ -258,8 +262,10 @@ sub invoice_details { } if ($form->{"subtotal_$i"} && $subtotal_header && ($subtotal_header != $i)) { - push @{ $form->{TEMPLATE_ARRAYS}->{discount_sub} }, $form->format_amount($myconfig, $discount_subtotal, 2); - push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_sub} }, $form->format_amount($myconfig, $nodiscount_subtotal, 2); + push @{ $form->{TEMPLATE_ARRAYS}->{discount_sub} }, $form->format_amount($myconfig, $discount_subtotal, 2); + push @{ $form->{TEMPLATE_ARRAYS}->{discount_sub_nofmt} }, $discount_subtotal; + push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_sub} }, $form->format_amount($myconfig, $nodiscount_subtotal, 2); + push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_sub_nofmt} }, $nodiscount_subtotal; $discount_subtotal = 0; $nodiscount_subtotal = 0; @@ -274,11 +280,13 @@ sub invoice_details { $nodiscount += $linetotal; } - push @{ $form->{TEMPLATE_ARRAYS}->{linetotal} }, $form->format_amount($myconfig, $linetotal, 2); - push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_linetotal} }, $form->format_amount($myconfig, $nodiscount_linetotal, 2); + push @{ $form->{TEMPLATE_ARRAYS}->{linetotal} }, $form->format_amount($myconfig, $linetotal, 2); + push @{ $form->{TEMPLATE_ARRAYS}->{linetotal_nofmt} }, $linetotal_exact; + push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_linetotal} }, $form->format_amount($myconfig, $nodiscount_linetotal, 2); + push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_linetotal_nofmt} }, $nodiscount_linetotal; - push(@{ $form->{TEMPLATE_ARRAYS}->{projectnumber} }, $projectnumbers{$form->{"project_id_$i"}}); - push(@{ $form->{TEMPLATE_ARRAYS}->{projectdescription} }, $projectdescriptions{$form->{"project_id_$i"}}); + push(@{ $form->{TEMPLATE_ARRAYS}->{projectnumber} }, $projectnumbers{$form->{"project_id_$i"}}); + push(@{ $form->{TEMPLATE_ARRAYS}->{projectdescription} }, $projectdescriptions{$form->{"project_id_$i"}}); @taxaccounts = split(/ /, $form->{"taxaccounts_$i"}); $taxrate = 0; @@ -368,8 +376,11 @@ sub invoice_details { $tax += $taxamount = $form->round_amount($taxaccounts{$item}, 2); push(@{ $form->{TEMPLATE_ARRAYS}->{taxbase} }, $form->format_amount($myconfig, $taxbase{$item}, 2)); + push(@{ $form->{TEMPLATE_ARRAYS}->{taxbase_nofmt} }, $taxbase{$item}); push(@{ $form->{TEMPLATE_ARRAYS}->{tax} }, $form->format_amount($myconfig, $taxamount, 2)); + push(@{ $form->{TEMPLATE_ARRAYS}->{tax_nofmt} }, $taxamount ); push(@{ $form->{TEMPLATE_ARRAYS}->{taxrate} }, $form->format_amount($myconfig, $form->{"${item}_rate"} * 100)); + push(@{ $form->{TEMPLATE_ARRAYS}->{taxrate_nofmt} }, $form->{"${item}_rate"} * 100); push(@{ $form->{TEMPLATE_ARRAYS}->{taxdescription} }, $form->{"${item}_description"} . q{ } . 100 * $form->{"${item}_rate"} . q{%}); push(@{ $form->{TEMPLATE_ARRAYS}->{taxnumber} }, $form->{"${item}_taxnumber"}); } @@ -388,10 +399,12 @@ sub invoice_details { } } if($form->{taxincluded}) { - $form->{subtotal} = $form->format_amount($myconfig, $form->{total} - $tax, 2); + $form->{subtotal} = $form->format_amount($myconfig, $form->{total} - $tax, 2); + $form->{subtotal_nofmt} = $form->{total} - $tax; } else { - $form->{subtotal} = $form->format_amount($myconfig, $form->{total}, 2); + $form->{subtotal} = $form->format_amount($myconfig, $form->{total}, 2); + $form->{subtotal_nofmt} = $form->{total}; } $form->{nodiscount_subtotal} = $form->format_amount($myconfig, $form->{nodiscount_total}, 2); @@ -409,8 +422,6 @@ sub invoice_details { $form->{username} = $myconfig->{name}; - $dbh->disconnect; - $main::lxdebug->leave_sub(); } @@ -434,7 +445,7 @@ sub customer_details { my ($self, $myconfig, $form, @wanted_vars) = @_; # connect to database - my $dbh = $form->dbconnect($myconfig); + my $dbh = $form->get_standard_dbh; my $language_id = $form->{language_id}; @@ -505,8 +516,6 @@ sub customer_details { 'allow_fallback' => 1); - $dbh->disconnect; - $main::lxdebug->leave_sub(); } @@ -1134,7 +1143,8 @@ sub post_payment { my ($self, $myconfig, $form, $locale) = @_; # connect to database, turn off autocommit - my $dbh = $form->dbconnect_noauto($myconfig); + my $dbh = $form->get_standard_dbh; + $dbh->begin_work; my (%payments, $old_form, $row, $item, $query, %keep_vars); @@ -1189,7 +1199,6 @@ sub post_payment { restore_form($old_form); my $rc = $dbh->commit(); - $dbh->disconnect(); $main::lxdebug->leave_sub(); @@ -1369,7 +1378,8 @@ sub delete_invoice { my ($self, $myconfig, $form) = @_; # connect to database - my $dbh = $form->dbconnect_noauto($myconfig); + my $dbh = $form->get_standard_dbh; + $dbh->begin_work; &reverse_invoice($dbh, $form); @@ -1399,7 +1409,6 @@ sub delete_invoice { do_query($form, $dbh, qq|DELETE FROM status WHERE trans_id = ?|, @values); my $rc = $dbh->commit; - $dbh->disconnect; if ($rc) { my $spool = $::lx_office_conf{paths}->{spool}; @@ -1749,7 +1758,7 @@ sub retrieve_item { my ($self, $myconfig, $form) = @_; # connect to database - my $dbh = $form->dbconnect($myconfig); + my $dbh = $form->get_standard_dbh; my $i = $form->{rowcount}; @@ -1960,8 +1969,6 @@ sub retrieve_item { map { $item->{"ic_cvar_" . $_->{name} } = $_->{value} } @{ $custom_variables }; } - $dbh->disconnect; - $main::lxdebug->leave_sub(); } @@ -1977,7 +1984,7 @@ sub get_pricegroups_for_parts { my ($self, $myconfig, $form) = @_; - my $dbh = $form->dbconnect($myconfig); + my $dbh = $form->get_standard_dbh; $form->{"PRICES"} = {}; @@ -2041,27 +2048,27 @@ sub get_pricegroups_for_parts { } my $query = - qq|SELECT + qq|SELECT + 0 as pricegroup_id, + sellprice AS default_sellprice, + '' AS pricegroup, + sellprice AS price, + 'selected' AS selected + FROM parts + WHERE id = ? + UNION ALL + SELECT pricegroup_id, - (SELECT p.sellprice FROM parts p WHERE p.id = ?) AS default_sellprice, - (SELECT pg.pricegroup FROM pricegroup pg WHERE id = pricegroup_id) AS pricegroup, + parts.sellprice AS default_sellprice, + pricegroup.pricegroup, price, '' AS selected FROM prices + LEFT JOIN parts ON parts.id = parts_id + LEFT JOIN pricegroup ON pricegroup.id = pricegroup_id WHERE parts_id = ? - - UNION - - SELECT - 0 as pricegroup_id, - (SELECT sellprice FROM parts WHERE id = ?) AS default_sellprice, - '' AS pricegroup, - (SELECT DISTINCT sellprice FROM parts where id = ?) AS price, - 'selected' AS selected - FROM prices - ORDER BY pricegroup|; - my @values = (conv_i($id), conv_i($id), conv_i($id), conv_i($id)); + my @values = (conv_i($id), conv_i($id)); my $pkq = prepare_execute_query($form, $dbh, $query, @values); while (my $pkr = $pkq->fetchrow_hashref('NAME_lc')) { @@ -2125,7 +2132,7 @@ sub get_pricegroups_for_parts { $pkr->{selected} = ' selected'; } } elsif ( ($form->parse_amount($myconfig, $price_new) - != $form->parse_amount($myconfig, $form->{"sellprice_$i"})) + != $form->parse_amount($myconfig, $form->{"sellprice_$i"})) and ($price_new ne 0) and defined $price_new) { # sellprice has changed # when loading existing invoices $price_new is NULL @@ -2153,8 +2160,6 @@ sub get_pricegroups_for_parts { $pkq->finish; } - $dbh->disconnect; - $main::lxdebug->leave_sub(); } @@ -2169,13 +2174,11 @@ sub has_storno { # ToDO: die when this happens and throw an error $main::lxdebug->leave_sub() and return 0 if ($table =~ /\W/); - my $dbh = $form->dbconnect($myconfig); + my $dbh = $form->get_standard_dbh; my $query = qq|SELECT storno FROM $table WHERE storno_id = ?|; my ($result) = selectrow_query($form, $dbh, $query, $form->{id}); - $dbh->disconnect(); - $main::lxdebug->leave_sub(); return $result; @@ -2192,13 +2195,11 @@ sub is_storno { # ToDO: die when this happens and throw an error $main::lxdebug->leave_sub() and return 0 if ($table =~ /\W/); - my $dbh = $form->dbconnect($myconfig); + my $dbh = $form->get_standard_dbh; my $query = qq|SELECT storno FROM $table WHERE id = ?|; my ($result) = selectrow_query($form, $dbh, $query, $id); - $dbh->disconnect(); - $main::lxdebug->leave_sub(); return $result; @@ -2209,13 +2210,11 @@ sub get_standard_accno_current_assets { my ($self, $myconfig, $form) = @_; - my $dbh = $form->dbconnect($myconfig); + my $dbh = $form->get_standard_dbh; my $query = qq| SELECT accno FROM chart WHERE id = (SELECT ar_paid_accno_id FROM defaults)|; my ($result) = selectrow_query($form, $dbh, $query); - $dbh->disconnect(); - $main::lxdebug->leave_sub(); return $result; diff --git a/SL/LXDebug.pm b/SL/LXDebug.pm index b24372445..4e7790791 100644 --- a/SL/LXDebug.pm +++ b/SL/LXDebug.pm @@ -292,4 +292,24 @@ sub want_request_timer { $global_level & REQUEST_TIMER; } +sub file { + @_ == 2 ? $_[0]->{file} = $_[1] : $_[0]->{file}; +} + +sub _by_name { + my ($self, $level) = @_; + my $meth = $self->can(uc $level); + die 'unknown level' unless $meth; + $meth->(); +} + +sub level_by_name { + my ($self, $level, $val) = @_; + if (@_ == 3) { + $global_level |= $self->_by_name($level) if $val; + $global_level &= ~$self->_by_name($level) if !$val; + } + return $global_level & $self->_by_name($level); +} + 1; diff --git a/SL/LxOfficeConf.pm b/SL/LxOfficeConf.pm index 8f44016e6..7690eebda 100644 --- a/SL/LxOfficeConf.pm +++ b/SL/LxOfficeConf.pm @@ -6,11 +6,15 @@ use Config::Std; use Encode; sub read { + my ($class, $file_name) = @_; + read_config 'config/lx_office.conf.default' => %::lx_office_conf; _decode_recursively(\%::lx_office_conf); - if (-f 'config/lx_office.conf') { - read_config 'config/lx_office.conf' => my %local_conf; + $file_name ||= 'config/lx_office.conf'; + + if (-f $file_name) { + read_config $file_name => my %local_conf; _decode_recursively(\%local_conf); _flat_merge(\%::lx_office_conf, \%local_conf); } diff --git a/SL/OE.pm b/SL/OE.pm index 28e3975c3..0fd91a437 100644 --- a/SL/OE.pm +++ b/SL/OE.pm @@ -52,7 +52,7 @@ sub transactions { my ($self, $myconfig, $form) = @_; # connect to database - my $dbh = $form->dbconnect($myconfig); + my $dbh = $form->get_standard_dbh; my $query; my $ordnumber = 'ordnumber'; @@ -226,7 +226,6 @@ SQL } $sth->finish; - $dbh->disconnect; $main::lxdebug->leave_sub(); } @@ -658,7 +657,8 @@ sub delete { my ($self, $myconfig, $form) = @_; # connect to database - my $dbh = $form->dbconnect_noauto($myconfig); + my $dbh = $form->get_standard_dbh; + $dbh->begin_work; # delete spool files my $query = qq|SELECT s.spoolfile FROM status s | . @@ -702,7 +702,6 @@ sub delete { do_query($form, $dbh, $query, @values); my $rc = $dbh->commit; - $dbh->disconnect; if ($rc) { my $spool = $::lx_office_conf{paths}->{spool}; @@ -1034,7 +1033,7 @@ sub order_details { my ($self, $myconfig, $form) = @_; # connect to database - my $dbh = $form->dbconnect($myconfig); + my $dbh = $form->get_standard_dbh; my $query; my @values = (); my $sth; @@ -1161,13 +1160,16 @@ sub order_details { push @{ $form->{TEMPLATE_ARRAYS}->{description} }, $form->{"description_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{longdescription} }, $form->{"longdescription_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{qty} }, $form->format_amount($myconfig, $form->{"qty_$i"}); + push @{ $form->{TEMPLATE_ARRAYS}->{qty_nofmt} }, $form->{"qty_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{ship} }, $form->format_amount($myconfig, $form->{"ship_$i"}); + push @{ $form->{TEMPLATE_ARRAYS}->{ship_nofmt} }, $form->{"ship_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{unit} }, $form->{"unit_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{bin} }, $form->{"bin_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{partnotes} }, $form->{"partnotes_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{serialnumber} }, $form->{"serialnumber_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{reqdate} }, $form->{"reqdate_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{sellprice} }, $form->{"sellprice_$i"}; + push @{ $form->{TEMPLATE_ARRAYS}->{sellprice_nofmt} }, $form->parse_amount($myconfig, $form->{"sellprice_$i"}); push @{ $form->{TEMPLATE_ARRAYS}->{listprice} }, $form->{"listprice_$i"}; push @{ $form->{TEMPLATE_ARRAYS}->{price_factor} }, $price_factor->{formatted_factor}; push @{ $form->{TEMPLATE_ARRAYS}->{price_factor_name} }, $price_factor->{description}; @@ -1185,12 +1187,14 @@ sub order_details { my $nodiscount_linetotal = $form->round_amount($form->{"qty_$i"} * $sellprice / $price_factor->{factor}, 2); $form->{"netprice_$i"} = $form->round_amount($form->{"qty_$i"} ? ($linetotal / $form->{"qty_$i"}) : 0, 2); - push @{ $form->{TEMPLATE_ARRAYS}->{netprice} }, ($form->{"netprice_$i"} != 0) ? $form->format_amount($myconfig, $form->{"netprice_$i"}, $decimalplaces) : ''; + push @{ $form->{TEMPLATE_ARRAYS}->{netprice} }, ($form->{"netprice_$i"} != 0) ? $form->format_amount($myconfig, $form->{"netprice_$i"}, $decimalplaces) : ''; + push @{ $form->{TEMPLATE_ARRAYS}->{netprice_nofmt} }, ($form->{"netprice_$i"} != 0) ? $form->{"netprice_$i"} : ''; $linetotal = ($linetotal != 0) ? $linetotal : ''; - push @{ $form->{TEMPLATE_ARRAYS}->{discount} }, ($discount != 0) ? $form->format_amount($myconfig, $discount * -1, 2) : ''; - push @{ $form->{TEMPLATE_ARRAYS}->{p_discount} }, $form->{"discount_$i"}; + push @{ $form->{TEMPLATE_ARRAYS}->{discount} }, ($discount != 0) ? $form->format_amount($myconfig, $discount * -1, 2) : ''; + push @{ $form->{TEMPLATE_ARRAYS}->{discount_nofmt} }, ($discount != 0) ? $discount * -1 : ''; + push @{ $form->{TEMPLATE_ARRAYS}->{p_discount} }, $form->{"discount_$i"}; $form->{ordtotal} += $linetotal; $form->{nodiscount_total} += $nodiscount_linetotal; @@ -1202,8 +1206,10 @@ sub order_details { } if ($form->{"subtotal_$i"} && $subtotal_header && ($subtotal_header != $i)) { - push @{ $form->{TEMPLATE_ARRAYS}->{discount_sub} }, $form->format_amount($myconfig, $discount_subtotal, 2); - push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_sub} }, $form->format_amount($myconfig, $nodiscount_subtotal, 2); + push @{ $form->{TEMPLATE_ARRAYS}->{discount_sub} }, $form->format_amount($myconfig, $discount_subtotal, 2); + push @{ $form->{TEMPLATE_ARRAYS}->{discount_sub_nofmt} }, $discount_subtotal; + push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_sub} }, $form->format_amount($myconfig, $nodiscount_subtotal, 2); + push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_sub_nofmt} }, $nodiscount_subtotal; $discount_subtotal = 0; $nodiscount_subtotal = 0; @@ -1218,11 +1224,12 @@ sub order_details { $nodiscount += $linetotal; } - push @{ $form->{TEMPLATE_ARRAYS}->{linetotal} }, $form->format_amount($myconfig, $linetotal, 2); - push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_linetotal} }, $form->format_amount($myconfig, $nodiscount_linetotal, 2); - - push(@{ $form->{TEMPLATE_ARRAYS}->{projectnumber} }, $projectnumbers{$form->{"project_id_$i"}}); - push(@{ $form->{TEMPLATE_ARRAYS}->{projectdescription} }, $projectdescriptions{$form->{"project_id_$i"}}); + push @{ $form->{TEMPLATE_ARRAYS}->{linetotal} }, $form->format_amount($myconfig, $linetotal, 2); + push @{ $form->{TEMPLATE_ARRAYS}->{linetotal_nofmt} }, $linetotal_exact; + push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_linetotal} }, $form->format_amount($myconfig, $nodiscount_linetotal, 2); + push @{ $form->{TEMPLATE_ARRAYS}->{nodiscount_linetotal_nofmt} }, $nodiscount_linetotal; + push(@{ $form->{TEMPLATE_ARRAYS}->{projectnumber} }, $projectnumbers{$form->{"project_id_$i"}}); + push(@{ $form->{TEMPLATE_ARRAYS}->{projectdescription} }, $projectdescriptions{$form->{"project_id_$i"}}); my ($taxamount, $taxbase); my $taxrate = 0; @@ -1293,8 +1300,11 @@ sub order_details { $tax += $taxamount = $form->round_amount($taxaccounts{$item}, 2); push(@{ $form->{TEMPLATE_ARRAYS}->{taxbase} }, $form->format_amount($myconfig, $taxbase{$item}, 2)); + push(@{ $form->{TEMPLATE_ARRAYS}->{taxbase_nofmt} }, $taxbase{$item}); push(@{ $form->{TEMPLATE_ARRAYS}->{tax} }, $form->format_amount($myconfig, $taxamount, 2)); + push(@{ $form->{TEMPLATE_ARRAYS}->{tax_nofmt} }, $taxamount); push(@{ $form->{TEMPLATE_ARRAYS}->{taxrate} }, $form->format_amount($myconfig, $form->{"${item}_rate"} * 100)); + push(@{ $form->{TEMPLATE_ARRAYS}->{taxrate_nofmt} }, $form->{"${item}_rate"} * 100); push(@{ $form->{TEMPLATE_ARRAYS}->{taxdescription} }, $form->{"${item}_description"} . q{ } . 100 * $form->{"${item}_rate"} . q{%}); push(@{ $form->{TEMPLATE_ARRAYS}->{taxnumber} }, $form->{"${item}_taxnumber"}); } @@ -1305,9 +1315,11 @@ sub order_details { $form->{yesdiscount} = $form->format_amount($myconfig, $form->{nodiscount_total} - $nodiscount, 2); if($form->{taxincluded}) { - $form->{subtotal} = $form->format_amount($myconfig, $form->{ordtotal} - $tax, 2); + $form->{subtotal} = $form->format_amount($myconfig, $form->{ordtotal} - $tax, 2); + $form->{subtotal_nofmt} = $form->{ordtotal} - $tax; } else { - $form->{subtotal} = $form->format_amount($myconfig, $form->{ordtotal}, 2); + $form->{subtotal} = $form->format_amount($myconfig, $form->{ordtotal}, 2); + $form->{subtotal_nofmt} = $form->{ordtotal}; } $form->{ordtotal} = ($form->{taxincluded}) ? $form->{ordtotal} : $form->{ordtotal} + $tax; diff --git a/SL/SEPA.pm b/SL/SEPA.pm index 9a2978314..32e763cdb 100644 --- a/SL/SEPA.pm +++ b/SL/SEPA.pm @@ -21,7 +21,7 @@ sub retrieve_open_invoices { my $query = qq| - SELECT ${arap}.id, ${arap}.invnumber, ${arap}.${vc}_id, ${arap}.amount AS invoice_amount, ${arap}.invoice, + SELECT ${arap}.id, ${arap}.invnumber, ${arap}.${vc}_id as vc_id, ${arap}.amount AS invoice_amount, ${arap}.invoice, vc.name AS vcname, vc.language_id, ${arap}.duedate as duedate, COALESCE(vc.iban, '') <> '' AND COALESCE(vc.bic, '') <> '' AS vc_bank_info_ok, diff --git a/SL/Template/Plugin/HTMLFixes.pm b/SL/Template/Plugin/HTMLFixes.pm new file mode 100644 index 000000000..32d3c5683 --- /dev/null +++ b/SL/Template/Plugin/HTMLFixes.pm @@ -0,0 +1,29 @@ +package SL::Template::Plugin::HTMLFixes; + +use Template::Plugin::HTML; + +1; + +package Template::Plugin::HTML; + +use strict; + +use Encode; + +# Replacement for Template::Plugin::HTML::url. + +# Strings in Lx-Office are stored in Perl's internal encoding but have +# to be output as UTF-8. A normal regex replace doesn't do that +# creating invalid UTF-8 characters upon URL-unescaping. + +# The only addition is the "Encode::encode()" line. +no warnings 'redefine'; +sub url { + my ($self, $text) = @_; + return undef unless defined $text; + $text = Encode::encode('utf-8-strict', $text) if $::locale && $::locale->is_utf8; + $text =~ s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg; + return $text; +} + +1; diff --git a/SL/Template/Plugin/L.pm b/SL/Template/Plugin/L.pm index 2299a66b1..e0631b863 100644 --- a/SL/Template/Plugin/L.pm +++ b/SL/Template/Plugin/L.pm @@ -106,6 +106,7 @@ sub checkbox_tag { $attributes{id} ||= $self->name_to_id($name); $attributes{value} = 1 unless defined $attributes{value}; my $label = delete $attributes{label}; + my $checkall = delete $attributes{checkall}; if ($attributes{checked}) { $attributes{checked} = 'checked'; @@ -115,6 +116,7 @@ sub checkbox_tag { my $code = $self->html_tag('input', undef, %attributes, name => $name, type => 'checkbox'); $code .= $self->html_tag('label', $label, for => $attributes{id}) if $label; + $code .= $self->javascript(qq|\$('#$attributes{id}').checkall('$checkall');|) if $checkall; return $code; } @@ -396,6 +398,64 @@ EOCODE return $code; } +sub sortable_element { + my ($self, $selector, @slurp) = @_; + my %params = _hashify(@slurp); + + my %attributes = ( distance => 5, + helper => <<'JAVASCRIPT' ); + function(event, ui) { + ui.children().each(function() { + $(this).width($(this).width()); + }); + return ui; + } +JAVASCRIPT + + my $stop_event = ''; + + if ($params{url} && $params{with}) { + my $as = $params{as} || $params{with}; + my $filter = ".filter(function(idx) { return this.substr(0, " . length($params{with}) . ") == '$params{with}'; })"; + $filter .= ".map(function(idx, str) { return str.replace('$params{with}_', ''); })"; + + $stop_event = <*:odd').removeClass('listrow1').removeClass('listrow0').addClass('listrow0'); + \$('${selector}>*:even').removeClass('listrow1').removeClass('listrow0').addClass('listrow1'); +JAVASCRIPT + } + + if ($stop_event) { + $attributes{stop} = < + \$(function() { + \$( "${selector}" ).sortable({ ${attr_str} }) + }); + +JAVASCRIPT + + return $code; +} + sub online_help_tag { my ($self, $tag, @slurp) = @_; my %params = _hashify(@slurp); @@ -520,6 +580,10 @@ If C<%attributes> contains a key C