From: Jan Büren Date: Thu, 30 May 2013 11:38:24 +0000 (+0200) Subject: Merge branch 'master' of github.com:kivitendo/kivitendo-erp X-Git-Tag: release-3.1.0beta1~401 X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/commitdiff_plain/82053b457be3de2ee5285dc13633222f4d30802c?hp=82c4717d48bbdb8d30c9671e71ecb0d6d8eac963 Merge branch 'master' of github.com:kivitendo/kivitendo-erp Conflicts: SL/DB/MetaSetup/Default.pm locale/de/all --- diff --git a/SL/AM.pm b/SL/AM.pm index 85080e8a1..4934d866c 100644 --- a/SL/AM.pm +++ b/SL/AM.pm @@ -40,6 +40,7 @@ package AM; use Carp; use Data::Dumper; use Encode; +use List::MoreUtils qw(any); use SL::DBUtils; use strict; @@ -207,14 +208,15 @@ sub save_account { # connect to database, turn off AutoCommit my $dbh = $form->dbconnect_noauto($myconfig); - # sanity check, can't have AR with AR_... - if ($form->{AR} || $form->{AP} || $form->{IC}) { - map { delete $form->{$_} } - qw(AR_amount AR_tax AR_paid AP_amount AP_tax AP_paid IC_sale IC_cogs IC_taxpart IC_income IC_expense IC_taxservice); + for (qw(AR_include_in_dropdown AP_include_in_dropdown summary_account)) { + $form->{$form->{$_}} = $form->{$_} if $form->{$_}; } - for (qw(AR_include_in_dropdown AP_include_in_dropdown)) { - $form->{$form->{$_}} = $form->{$_} if $form->{$_}; + # sanity check, can't have AR with AR_... + if ($form->{AR} || $form->{AP} || $form->{IC}) { + if (any { $form->{$_} } qw(AR_amount AR_tax AR_paid AP_amount AP_tax AP_paid IC_sale IC_cogs IC_taxpart IC_income IC_expense IC_taxservice)) { + $form->error($::locale->text('It is not allowed that a summary account occurs in a drop-down menu!')); + } } $form->{link} = ""; @@ -1060,10 +1062,6 @@ sub save_defaults { my %accnos; map { ($accnos{$_}) = split(m/--/, $form->{$_}) } qw(inventory_accno income_accno expense_accno fxgain_accno fxloss_accno ar_paid_accno); - $form->{curr} =~ s/ //g; - my @currencies = grep { $_ ne '' } split m/:/, $form->{curr}; - my $currency = join ':', @currencies; - # these defaults are database wide my $query = @@ -1087,7 +1085,6 @@ sub save_defaults { assemblynumber = ?, sdonumber = ?, pdonumber = ?, - curr = ?, businessnumber = ?, weightunit = ?, language_id = ?|; @@ -1100,11 +1097,24 @@ sub save_defaults { $form->{articlenumber}, $form->{servicenumber}, $form->{assemblynumber}, $form->{sdonumber}, $form->{pdonumber}, - $currency, $form->{businessnumber}, $form->{weightunit}, conv_i($form->{language_id})); do_query($form, $dbh, $query, @values); + $main::lxdebug->message(0, "es gibt rowcount: " . $form->{rowcount}); + + for my $i (1..$form->{rowcount}) { + if ($form->{"curr_$i"} ne $form->{"old_curr_$i"}) { + $query = qq|UPDATE currencies SET name = ? WHERE name = ?|; + do_query($form, $dbh, $query, $form->{"curr_$i"}, $form->{"old_curr_$i"}); + } + } + + if (length($form->{new_curr}) > 0) { + $query = qq|INSERT INTO currencies (name) VALUES (?)|; + do_query($form, $dbh, $query, $form->{new_curr}); + } + $dbh->commit(); $main::lxdebug->leave_sub(); @@ -1118,7 +1128,7 @@ sub save_preferences { my $dbh = $form->get_standard_dbh($myconfig); - my ($currency, $businessnumber) = selectrow_query($form, $dbh, qq|SELECT curr, businessnumber FROM defaults|); + my ($businessnumber) = selectrow_query($form, $dbh, qq|SELECT businessnumber FROM defaults|); # update name my $query = qq|UPDATE employee SET name = ? WHERE login = ?|; @@ -1126,10 +1136,6 @@ sub save_preferences { my $rc = $dbh->commit(); - # save first currency in myconfig - $currency =~ s/:.*//; - $form->{currency} = $currency; - $form->{businessnumber} = $businessnumber; $myconfig = User->new(login => $form->{login}); @@ -1286,6 +1292,15 @@ sub defaultaccounts { } $sth->finish; + + #Get currencies: + $query = qq|SELECT name AS curr FROM currencies ORDER BY id|; + $form->{CURRENCIES} = selectall_hashref_query($form, $dbh, $query); + + #Which of them is the default currency? + $query = qq|SELECT name AS defaultcurrency FROM currencies WHERE id = (SELECT currency_id FROM defaults LIMIT 1);|; + ($form->{defaultcurrency}) = selectrow_query($form, $dbh, $query); + $dbh->disconnect; $main::lxdebug->leave_sub(); diff --git a/SL/AP.pm b/SL/AP.pm index 53c1d2f5d..bc5a36202 100644 --- a/SL/AP.pm +++ b/SL/AP.pm @@ -55,7 +55,6 @@ sub post_transaction { my $exchangerate = 0; $form->{defaultcurrency} = $form->get_default_currency($myconfig); - delete $form->{currency} unless $form->{defaultcurrency}; ($null, $form->{department_id}) = split(/--/, $form->{department}); @@ -185,7 +184,7 @@ sub post_transaction { $query = qq|UPDATE ap SET invnumber = ?, transdate = ?, ordnumber = ?, vendor_id = ?, taxincluded = ?, amount = ?, duedate = ?, paid = ?, netamount = ?, - curr = ?, notes = ?, department_id = ?, storno = ?, storno_id = ?, + currency_id = (SELECT id FROM currencies WHERE name = ?), notes = ?, department_id = ?, storno = ?, storno_id = ?, globalproject_id = ?, direct_debit = ? WHERE id = ?|; @values = ($form->{invnumber}, conv_date($form->{transdate}), @@ -666,7 +665,6 @@ sub post_payment { $form->{exchangerate} = $form->format_amount($myconfig, $form->{exchangerate}); $form->{defaultcurrency} = $form->get_default_currency($myconfig); - delete $form->{currency} unless $form->{defaultcurrency}; # Get the AP accno. $query = diff --git a/SL/AR.pm b/SL/AR.pm index 5ec2b1850..b6a7376e1 100644 --- a/SL/AR.pm +++ b/SL/AR.pm @@ -56,7 +56,6 @@ sub post_transaction { my $dbh = $provided_dbh ? $provided_dbh : $form->dbconnect_noauto($myconfig); $form->{defaultcurrency} = $form->get_default_currency($myconfig); - delete $form->{currency} unless $form->{defaultcurrency}; # set exchangerate $form->{exchangerate} = ($form->{currency} eq $form->{defaultcurrency}) ? 1 : @@ -135,8 +134,8 @@ sub post_transaction { } else { $query = qq|SELECT nextval('glid')|; ($form->{id}) = selectrow_query($form, $dbh, $query); - $query = qq|INSERT INTO ar (id, invnumber, employee_id) VALUES (?, 'dummy', ?)|; - do_query($form, $dbh, $query, $form->{id}, $form->{employee_id}); + $query = qq|INSERT INTO ar (id, invnumber, employee_id, currency_id) VALUES (?, 'dummy', ?, (SELECT id FROM currencies WHERE name=?))|; + do_query($form, $dbh, $query, $form->{id}, $form->{employee_id}, $form->{currency}); $form->{invnumber} = $form->update_defaults($myconfig, "invnumber", $dbh) unless $form->{invnumber}; } } @@ -156,12 +155,12 @@ sub post_transaction { qq|UPDATE ar set invnumber = ?, ordnumber = ?, transdate = ?, customer_id = ?, taxincluded = ?, amount = ?, duedate = ?, paid = ?, - netamount = ?, curr = ?, notes = ?, department_id = ?, + netamount = ?, notes = ?, department_id = ?, employee_id = ?, storno = ?, storno_id = ?, globalproject_id = ?, direct_debit = ? WHERE id = ?|; my @values = ($form->{invnumber}, $form->{ordnumber}, conv_date($form->{transdate}), conv_i($form->{customer_id}), $form->{taxincluded} ? 't' : 'f', $form->{amount}, - conv_date($form->{duedate}), $form->{paid}, $form->{netamount}, $form->{currency}, $form->{notes}, conv_i($form->{department_id}), + conv_date($form->{duedate}), $form->{paid}, $form->{netamount}, $form->{notes}, conv_i($form->{department_id}), conv_i($form->{employee_id}), $form->{storno} ? 't' : 'f', $form->{storno_id}, conv_i($form->{globalproject_id}), $form->{direct_debit} ? 't' : 'f', conv_i($form->{id})); do_query($form, $dbh, $query, @values); @@ -427,7 +426,6 @@ sub post_payment { $form->{exchangerate} = $form->format_amount($myconfig, $form->{exchangerate}); $form->{defaultcurrency} = $form->get_default_currency($myconfig); - delete $form->{currency} unless $form->{defaultcurrency}; # Get the AR accno (which is normally done by Form::create_links()). $query = diff --git a/SL/CP.pm b/SL/CP.pm index 18673c215..29ac35ab0 100644 --- a/SL/CP.pm +++ b/SL/CP.pm @@ -93,10 +93,9 @@ sub paymentaccounts { } $sth->finish; - # get currencies and closedto - $query = qq|SELECT curr, closedto FROM defaults|; - ($form->{currencies}, $form->{closedto}) = - selectrow_query($form, $dbh, $query); + # get closedto + $query = qq|SELECT closedto FROM defaults|; + ($form->{closedto}) = selectrow_query($form, $dbh, $query); $dbh->disconnect; @@ -150,9 +149,10 @@ sub get_openinvoices { my $arap = $form->{arap} eq "ar" ? "ar" : "ap"; my $query = - qq|SELECT a.id, a.invnumber, a.transdate, a.amount, a.paid, a.curr | . + qq|SELECT a.id, a.invnumber, a.transdate, a.amount, a.paid, cu.name AS curr | . qq|FROM $arap a | . - qq|WHERE (a.${vc}_id = ?) AND (COALESCE(a.curr, '') = ?) AND NOT (a.amount = a.paid)| . + qq|LEFT JOIN currencies cu ON (cu.id=a.currency_id)| . + qq|WHERE (a.${vc}_id = ?) AND cu.name = ? AND NOT (a.amount = a.paid)| . qq|ORDER BY a.id|; my $sth = prepare_execute_query($form, $dbh, $query, conv_i($form->{"${vc}_id"}), @@ -174,7 +174,7 @@ sub get_openinvoices { SELECT COUNT(*) FROM $arap WHERE (${vc}_id = ?) - AND (COALESCE(curr, '') <> ?) + AND ((SELECT cu.name FROM currencies cu WHERE cu.id=${arap}.currency_id) <> ?) AND (amount <> paid) SQL ($form->{openinvoices_other_currencies}) = selectfirst_array_query($form, $dbh, $query, conv_i($form->{"${vc}_id"}), "$form->{currency}"); @@ -250,7 +250,7 @@ sub process_payment { qq|SELECT $buysell | . qq|FROM exchangerate e | . qq|JOIN ${arap} a ON (a.transdate = e.transdate) | . - qq|WHERE (e.curr = ?) AND (a.id = ?)|; + qq|WHERE (e.currency_id = (SELECT id FROM currencies WHERE name = ?)) AND (a.id = ?)|; my ($exchangerate) = selectrow_query($form, $dbh, $query, $form->{currency}, $form->{"id_$i"}); diff --git a/SL/CT.pm b/SL/CT.pm index 02a5522f6..66b3e25b7 100644 --- a/SL/CT.pm +++ b/SL/CT.pm @@ -68,11 +68,12 @@ sub get_tuple { my $ref = $sth->fetchrow_hashref("NAME_lc"); map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; - # remove any trailing whitespace - $form->{curr} =~ s/\s*$//; + #get name of currency instead of id: + $query = qq|SELECT name AS curr FROM currencies WHERE id=?|; + ($form->{curr}) = selectrow_query($form, $dbh, $query, conv_i($form->{currency_id})); - $sth->finish; if ( $form->{salesman_id} ) { my $query = qq|SELECT ct.name AS salesman | . @@ -275,7 +276,7 @@ sub save_customer { $query = qq|SELECT nextval('id')|; ($form->{id}) = selectrow_query($form, $dbh, $query); - $query = qq|INSERT INTO customer (id, name) VALUES (?, '')|; + $query = qq|INSERT INTO customer (id, name, currency_id) VALUES (?, '', (SELECT currency_id FROM defaults))|; do_query($form, $dbh, $query, $form->{id}); } @@ -319,7 +320,7 @@ sub save_customer { qq|user_password = ?, | . qq|c_vendor_id = ?, | . qq|klass = ?, | . - qq|curr = ?, | . + qq|currency_id = (SELECT id FROM currencies WHERE name = ?), | . qq|taxincluded_checked = ? | . qq|WHERE id = ?|; my @values = ( @@ -362,7 +363,7 @@ sub save_customer { $form->{user_password}, $form->{c_vendor_id}, conv_i($form->{klass}), - substr($form->{currency}, 0, 3), + $form->{currency}, $form->{taxincluded_checked} ne '' ? $form->{taxincluded_checked} : undef, $form->{id} ); @@ -422,7 +423,7 @@ sub save_vendor { $query = qq|SELECT nextval('id')|; ($form->{id}) = selectrow_query($form, $dbh, $query); - $query = qq|INSERT INTO vendor (id, name) VALUES (?, '')|; + $query = qq|INSERT INTO vendor (id, name, currency_id) VALUES (?, '', (SELECT currency_id FROM defaults))|; do_query($form, $dbh, $query, $form->{id}); my $vendornumber = SL::TransNumber->new(type => 'vendor', @@ -471,7 +472,7 @@ sub save_vendor { qq| username = ?, | . qq| user_password = ?, | . qq| v_customer_id = ?, | . - qq| curr = ? | . + qq| currency_id = (SELECT id FROM currencies WHERE name = ?) | . qq|WHERE id = ?|; my @values = ( $form->{vendornumber}, @@ -511,7 +512,7 @@ sub save_vendor { $form->{username}, $form->{user_password}, $form->{v_customer_id}, - substr($form->{currency}, 0, 3), + $form->{currency}, $form->{id} ); do_query($form, $dbh, $query, @values); diff --git a/SL/CVar.pm b/SL/CVar.pm index 0a91c59f6..02456cb0b 100644 --- a/SL/CVar.pm +++ b/SL/CVar.pm @@ -2,12 +2,13 @@ package CVar; use strict; +use List::MoreUtils qw(any); use List::Util qw(first); use Scalar::Util qw(blessed); use Data::Dumper; use SL::DBUtils; -use SL::MoreCommon qw(any listify); +use SL::MoreCommon qw(listify); sub get_configs { $main::lxdebug->enter_sub(); diff --git a/SL/Controller/CsvImport/Base.pm b/SL/Controller/CsvImport/Base.pm index 7f4326a07..db6dc4d87 100644 --- a/SL/Controller/CsvImport/Base.pm +++ b/SL/Controller/CsvImport/Base.pm @@ -5,6 +5,7 @@ use strict; use List::MoreUtils qw(pairwise); use SL::Helper::Csv; +use SL::DB::Currency; use SL::DB::Customer; use SL::DB::Language; use SL::DB::PaymentTerm; @@ -16,7 +17,7 @@ use parent qw(Rose::Object); use Rose::Object::MakeMethods::Generic ( scalar => [ qw(controller file csv test_run save_with_cascade) ], - 'scalar --get_set_init' => [ qw(profile displayable_columns existing_objects class manager_class cvar_columns all_cvar_configs all_languages payment_terms_by all_vc vc_by) ], + 'scalar --get_set_init' => [ qw(profile displayable_columns existing_objects class manager_class cvar_columns all_cvar_configs all_languages payment_terms_by all_currencies default_currency_id all_vc vc_by) ], ); sub run { @@ -139,6 +140,18 @@ sub init_all_languages { return SL::DB::Manager::Language->get_all; } +sub init_all_currencies { + my ($self) = @_; + + return SL::DB::Manager::Currency->get_all; +} + +sub init_default_currency_id { + my ($self) = @_; + + return SL::DB::Default->get->currency_id; +} + sub init_payment_terms_by { my ($self) = @_; diff --git a/SL/Controller/CsvImport/CustomerVendor.pm b/SL/Controller/CsvImport/CustomerVendor.pm index 96eb69691..47964936e 100644 --- a/SL/Controller/CsvImport/CustomerVendor.pm +++ b/SL/Controller/CsvImport/CustomerVendor.pm @@ -13,7 +13,7 @@ use parent qw(SL::Controller::CsvImport::Base); use Rose::Object::MakeMethods::Generic ( - 'scalar --get_set_init' => [ qw(table languages_by businesses_by) ], + 'scalar --get_set_init' => [ qw(table languages_by businesses_by currencies_by) ], ); sub init_table { @@ -44,6 +44,12 @@ sub init_languages_by { return { map { my $col = $_; ( $col => { map { ( $_->$col => $_ ) } @{ $self->all_languages } } ) } qw(id description article_code) }; } +sub init_currencies_by { + my ($self) = @_; + + return { map { my $col = $_; ( $col => { map { ( $_->$col => $_ ) } @{ $self->all_currencies } } ) } qw(id name) }; +} + sub check_objects { my ($self) = @_; @@ -65,6 +71,7 @@ sub check_objects { $self->check_language($entry); $self->check_business($entry); $self->check_payment($entry); + $self->check_currency($entry); $self->handle_cvars($entry); next if @{ $entry->{errors} }; @@ -155,6 +162,36 @@ sub check_language { return 1; } +sub check_currency { + my ($self, $entry) = @_; + + my $object = $entry->{object}; + + # Check whether or not currency ID is valid. + if ($object->currency_id && !$self->currencies_by->{id}->{ $object->currency_id }) { + push @{ $entry->{errors} }, $::locale->text('Error: Invalid currency'); + return 0; + } + + # Map name to ID if given. + if (!$object->currency_id && $entry->{raw_data}->{currency}) { + my $currency = $self->currencies_by->{name}->{ $entry->{raw_data}->{currency} }; + if (!$currency) { + push @{ $entry->{errors} }, $::locale->text('Error: Invalid currency'); + return 0; + } + + $object->currency_id($currency->id); + } + + # Set default currency if none was given. + $object->currency_id($self->default_currency_id) if !$object->currency_id; + + $entry->{raw_data}->{currency_id} = $object->currency_id; + + return 1; +} + sub check_business { my ($self, $entry) = @_; @@ -253,6 +290,8 @@ sub setup_displayable_columns { { name => 'contact', description => $::locale->text('Contact') }, { name => 'country', description => $::locale->text('Country') }, { name => 'creditlimit', description => $::locale->text('Credit Limit') }, + { name => 'currency', description => $::locale->text('Currency') }, + { name => 'currency_id', description => $::locale->text('Currency (database ID)') }, { name => 'customernumber', description => $::locale->text('Customer Number') }, { name => 'department_1', description => $::locale->text('Department 1') }, { name => 'department_2', description => $::locale->text('Department 2') }, diff --git a/SL/Controller/DeliveryPlan.pm b/SL/Controller/DeliveryPlan.pm index 33bede6a0..00adfc9f5 100644 --- a/SL/Controller/DeliveryPlan.pm +++ b/SL/Controller/DeliveryPlan.pm @@ -8,7 +8,7 @@ use SL::DB::OrderItem; use SL::Controller::Helper::GetModels; use SL::Controller::Helper::Paginated; use SL::Controller::Helper::Sorted; -use SL::Controller::Helper::ParseFilter; +use SL::Controller::Helper::Filtered; use SL::Controller::Helper::ReportGenerator; use SL::Locale::String; @@ -18,10 +18,12 @@ use Rose::Object::MakeMethods::Generic ( __PACKAGE__->run_before(sub { $::auth->assert('sales_order_edit'); }); -__PACKAGE__->get_models_url_params('flat_filter'); +__PACKAGE__->make_filtered( + MODEL => 'OrderItem', + LAUNDER_TO => 'filter' +); __PACKAGE__->make_paginated( MODEL => 'OrderItem', - PAGINATE_ARGS => 'db_args', ONLY => [ qw(list) ], ); @@ -42,110 +44,91 @@ __PACKAGE__->make_sorted( customer => t8('Customer'), ); -sub action_list { - my ($self) = @_; - - $self->db_args($self->setup_for_list(filter => $::form->{filter})); - $self->flat_filter({ map { $_->{key} => $_->{value} } $::form->flatten_variables('filter') }); - $self->make_filter_summary; - - $self->prepare_report; - - my $orderitems = $self->get_models(%{ $self->db_args }); - - $self->report_generator_list_objects(report => $self->{report}, objects => $orderitems); -} - -# private functions - -sub setup_for_list { - my ($self, %params) = @_; - $self->{filter} = {}; - my %args = ( - parse_filter( - $self->_pre_parse_filter($::form->{filter}, $self->{filter}), - with_objects => [ 'order', 'order.customer', 'part' ], - launder_to => $self->{filter}, - ), - ); - - $args{query} = [ @{ $args{query} || [] }, - ( - 'order.customer_id' => { gt => 0 }, - 'order.closed' => 0, - or => [ 'order.quotation' => 0, 'order.quotation' => undef ], - - # filter by shipped_qty < qty, read from innermost to outermost - 'id' => [ \" - -- 3. resolve the desired information about those - SELECT oi.id FROM ( - -- 2. slice only part, orderitem and both quantities from it - SELECT parts_id, trans_id, qty, SUM(doi_qty) AS doi_qty FROM ( - -- 1. join orderitems and deliverorder items via record_links. - -- also add customer data to filter for sales_orders - SELECT oi.parts_id, oi.trans_id, oi.id, oi.qty, doi.qty AS doi_qty - FROM orderitems oi, oe, record_links rl, delivery_order_items doi - WHERE - oe.id = oi.trans_id AND - oe.customer_id IS NOT NULL AND - (oe.quotation = 'f' OR oe.quotation IS NULL) AND - NOT oe.closed AND - rl.from_id = oe.id AND - rl.from_id = oi.trans_id AND - oe.id = oi.trans_id AND - rl.from_table = 'oe' AND - rl.to_table = 'delivery_orders' AND - rl.to_id = doi.delivery_order_id AND - oi.parts_id = doi.parts_id - ) tuples GROUP BY parts_id, trans_id, qty - ) partials - LEFT JOIN orderitems oi ON partials.parts_id = oi.parts_id AND partials.trans_id = oi.trans_id - WHERE oi.qty > doi_qty - - UNION ALL - - -- 4. since the join over record_links fails for sales_orders wihtout any delivery order - -- retrieve those without record_links at all - SELECT oi.id FROM orderitems oi, oe +my $delivery_plan_query = [ + 'order.customer_id' => { gt => 0 }, + 'order.closed' => 0, + or => [ 'order.quotation' => 0, 'order.quotation' => undef ], + + # filter by shipped_qty < qty, read from innermost to outermost + 'id' => [ \" + -- 3. resolve the desired information about those + SELECT oi.id FROM ( + -- 2. slice only part, orderitem and both quantities from it + SELECT parts_id, trans_id, qty, SUM(doi_qty) AS doi_qty FROM ( + -- 1. join orderitems and deliverorder items via record_links. + -- also add customer data to filter for sales_orders + SELECT oi.parts_id, oi.trans_id, oi.id, oi.qty, doi.qty AS doi_qty + FROM orderitems oi, oe, record_links rl, delivery_order_items doi WHERE oe.id = oi.trans_id AND oe.customer_id IS NOT NULL AND (oe.quotation = 'f' OR oe.quotation IS NULL) AND NOT oe.closed AND - oi.trans_id NOT IN ( - SELECT from_id - FROM record_links rl - WHERE - rl.from_table ='oe' AND - rl.to_table = 'delivery_orders' - ) - - UNION ALL - - -- 5. In case someone deleted a line of the delivery_order there will be a record_link (4 fails) - -- but there won't be a delivery_order_items to find (3 fails too). Search for orphaned orderitems this way - SELECT oi.id FROM orderitems AS oi, oe, record_links AS rl - WHERE + rl.from_id = oe.id AND + rl.from_id = oi.trans_id AND + oe.id = oi.trans_id AND rl.from_table = 'oe' AND rl.to_table = 'delivery_orders' AND + rl.to_id = doi.delivery_order_id AND + oi.parts_id = doi.parts_id + ) tuples GROUP BY parts_id, trans_id, qty + ) partials + LEFT JOIN orderitems oi ON partials.parts_id = oi.parts_id AND partials.trans_id = oi.trans_id + WHERE oi.qty > doi_qty + + UNION ALL + + -- 4. since the join over record_links fails for sales_orders wihtout any delivery order + -- retrieve those without record_links at all + SELECT oi.id FROM orderitems oi, oe + WHERE + oe.id = oi.trans_id AND + oe.customer_id IS NOT NULL AND + (oe.quotation = 'f' OR oe.quotation IS NULL) AND + NOT oe.closed AND + oi.trans_id NOT IN ( + SELECT from_id + FROM record_links rl + WHERE + rl.from_table ='oe' AND + rl.to_table = 'delivery_orders' + ) - oi.trans_id = rl.from_id AND - oi.parts_id NOT IN ( - SELECT doi.parts_id FROM delivery_order_items AS doi WHERE doi.delivery_order_id = rl.to_id - ) AND + UNION ALL - oe.id = oi.trans_id AND + -- 5. In case someone deleted a line of the delivery_order there will be a record_link (4 fails) + -- but there won't be a delivery_order_items to find (3 fails too). Search for orphaned orderitems this way + SELECT oi.id FROM orderitems AS oi, oe, record_links AS rl + WHERE + rl.from_table = 'oe' AND + rl.to_table = 'delivery_orders' AND - oe.customer_id IS NOT NULL AND - (oe.quotation = 'f' OR oe.quotation IS NULL) AND - NOT oe.closed - " ], - ) - ]; + oi.trans_id = rl.from_id AND + oi.parts_id NOT IN ( + SELECT doi.parts_id FROM delivery_order_items AS doi WHERE doi.delivery_order_id = rl.to_id + ) AND - return \%args; + oe.id = oi.trans_id AND + + oe.customer_id IS NOT NULL AND + (oe.quotation = 'f' OR oe.quotation IS NULL) AND + NOT oe.closed + " ], +]; + +sub action_list { + my ($self) = @_; + + $self->make_filter_summary; + + my $orderitems = $self->get_models(query => $delivery_plan_query, with_objects => [ 'order', 'order.customer', 'part' ]); + + $self->prepare_report; + $self->report_generator_list_objects(report => $self->{report}, objects => $orderitems); } +# private functions +# sub prepare_report { my ($self) = @_; @@ -209,14 +192,15 @@ sub make_filter_summary { [ $filter->{order}{customer}{"customernumber:substr::ilike"}, $::locale->text('Customer Number') ], ); - my @flags = ( - [ $filter->{part}{type}{part}, $::locale->text('Parts') ], - [ $filter->{part}{type}{service}, $::locale->text('Services') ], - [ $filter->{part}{type}{assembly}, $::locale->text('Assemblies') ], + my %flags = ( + part => $::locale->text('Parts'), + service => $::locale->text('Services'), + assembly => $::locale->text('Assemblies'), ); + my @flags = map { $flags{$_} } @{ $filter->{part}{type} || [] }; for (@flags) { - push @filter_strings, "$_->[1]" if $_->[0]; + push @filter_strings, $_ if $_; } for (@filters) { push @filter_strings, "$_->[1]: $_->[0]" if $_->[0]; @@ -248,45 +232,4 @@ sub link_to { } } -# unfortunately ParseFilter can't handle compount filters. -# so we clone the original filter (still need that for serializing) -# rip out the options we know an replace them with the compound options. -# ParseFilter will take care of the prefixing then. -sub _pre_parse_filter { - my ($self, $orig_filter, $launder_to) = @_; - - return undef unless $orig_filter; - - my $filter = clone($orig_filter); - if ($filter->{part} && $filter->{part}{type}) { - $launder_to->{part}{type} = delete $filter->{part}{type}; - my @part_filters = grep $_, map { - $launder_to->{part}{type}{$_} ? SL::DB::Manager::Part->type_filter($_) : () - } qw(part service assembly); - - push @{ $filter->{and} }, or => [ @part_filters ] if @part_filters; - } - - for my $op (qw(le ge)) { - if ($filter->{"reqdate:date::$op"}) { - $launder_to->{"reqdate_date__$op"} = delete $filter->{"reqdate:date::$op"}; - my $parsed_date = DateTime->from_lxoffice($launder_to->{"reqdate_date__$op"}); - push @{ $filter->{and} }, or => [ - 'reqdate' => { $op => $parsed_date }, - and => [ - 'reqdate' => undef, - 'order.reqdate' => { $op => $parsed_date }, - ] - ] if $parsed_date; - } - } - - if (my $style = delete $filter->{searchstyle}) { - $self->{searchstyle} = $style; - $launder_to->{searchstyle} = $style; - } - - return $filter; -} - 1; diff --git a/SL/Controller/Helper/Filtered.pm b/SL/Controller/Helper/Filtered.pm new file mode 100644 index 000000000..d248bf6f3 --- /dev/null +++ b/SL/Controller/Helper/Filtered.pm @@ -0,0 +1,310 @@ +package SL::Controller::Helper::Filtered; + +use strict; + +use Exporter qw(import); +use SL::Controller::Helper::ParseFilter (); +use List::MoreUtils qw(uniq); +our @EXPORT = qw(make_filtered get_filter_spec get_current_filter_params disable_filtering _save_current_filter_params _callback_handler_for_filtered _get_models_handler_for_filtered); + +use constant PRIV => '__filteredhelper_priv'; + +my %controller_filter_spec; + +sub make_filtered { + my ($class, %specs) = @_; + + $specs{MODEL} //= $class->controller_name; + $specs{MODEL} =~ s{ ^ SL::DB:: (?: .* :: )? }{}x; + $specs{FORM_PARAMS} //= 'filter'; + $specs{LAUNDER_TO} = '__INPLACE__' unless exists $specs{LAUNDER_TO}; + $specs{ONLY} //= []; + $specs{ONLY} = [ $specs{ONLY} ] if !ref $specs{ONLY}; + $specs{ONLY_MAP} = @{ $specs{ONLY} } ? { map { ($_ => 1) } @{ $specs{ONLY} } } : { '__ALL__' => 1 }; + + $controller_filter_spec{$class} = \%specs; + + my %hook_params = @{ $specs{ONLY} } ? ( only => $specs{ONLY} ) : (); + $class->run_before('_save_current_filter_params', %hook_params); + + SL::Controller::Helper::GetModels::register_get_models_handlers( + $class, + callback => '_callback_handler_for_filtered', + get_models => '_get_models_handler_for_filtered', + ONLY => $specs{ONLY}, + ); + + # $::lxdebug->dump(0, "CONSPEC", \%specs); +} + +sub get_filter_spec { + my ($class_or_self) = @_; + + return $controller_filter_spec{ref($class_or_self) || $class_or_self}; +} + +sub get_current_filter_params { + my ($self) = @_; + + return %{ _priv($self)->{filter_params} } if _priv($self)->{filter_params}; + + require Carp; + Carp::confess('It seems a GetModels plugin tries to access filter params before they got calculated. Make sure your make_filtered call comes first.'); +} + +sub _make_current_filter_params { + my ($self, %params) = @_; + + my $spec = $self->get_filter_spec; + my $filter = $params{filter} // _priv($self)->{filter} // {}, + my %filter_args = _get_filter_args($self, $spec); + my %parse_filter_args = ( + class => "SL::DB::Manager::$spec->{MODEL}", + with_objects => $params{with_objects}, + ); + my $laundered; + if ($spec->{LAUNDER_TO} eq '__INPLACE__') { + + } elsif ($spec->{LAUNDER_TO}) { + $laundered = {}; + $parse_filter_args{launder_to} = $laundered; + } else { + $parse_filter_args{no_launder} = 1; + } + + my %calculated_params = SL::Controller::Helper::ParseFilter::parse_filter($filter, %parse_filter_args); + + $calculated_params{query} = [ + @{ $calculated_params{query} || [] }, + @{ $filter_args{query} || [] }, + @{ $params{query} || [] }, + ]; + + $calculated_params{with_objects} = [ + uniq + @{ $calculated_params{with_objects} || [] }, + @{ $filter_args{with_objects} || [] }, + @{ $params{with_objects} || [] }, + ]; + + if ($laundered) { + if ($self->can($spec->{LAUNDER_TO})) { + $self->${\ $spec->{LAUNDER_TO} }($laundered); + } else { + $self->{$spec->{LAUNDER_TO}} = $laundered; + } + } + + # $::lxdebug->dump(0, "get_current_filter_params: ", \%calculated_params); + + _priv($self)->{filter_params} = \%calculated_params; + + return %calculated_params; +} + +sub disable_filtering { + my ($self) = @_; + _priv($self)->{disabled} = 1; +} + +# +# private functions +# + +sub _get_filter_args { + my ($self, $spec) = @_; + + $spec ||= $self->get_filter_spec; + + my %filter_args = ref($spec->{FILTER_ARGS}) eq 'CODE' ? %{ $spec->{FILTER_ARGS}->($self) } + : $spec->{FILTER_ARGS} ? do { my $sub = $spec->{FILTER_ARGS}; %{ $self->$sub() } } + : (); +} + +sub _save_current_filter_params { + my ($self) = @_; + + return if !_is_enabled($self); + + my $filter_spec = $self->get_filter_spec; + $self->{PRIV()}{filter} = $::form->{ $filter_spec->{FORM_PARAMS} }; + + # $::lxdebug->message(0, "saving current filter params to " . $self->{PRIV()}->{page} . ' / ' . $self->{PRIV()}->{per_page}); +} + +sub _callback_handler_for_filtered { + my ($self, %params) = @_; + my $priv = _priv($self); + + if (_is_enabled($self) && $priv->{filter}) { + my $filter_spec = $self->get_filter_spec; + my ($flattened) = SL::Controller::Helper::ParseFilter::flatten($priv->{filter}, undef, $filter_spec->{FORM_PARAMS}); + %params = (%params, @$flattened); + } + + # $::lxdebug->dump(0, "CB handler for filtered; params after flatten:", \%params); + + return %params; +} + +sub _get_models_handler_for_filtered { + my ($self, %params) = @_; + my $spec = $self->get_filter_spec; + + # $::lxdebug->dump(0, "params in get_models_for_filtered", \%params); + + my %filter_params; + %filter_params = _make_current_filter_params($self, %params) if _is_enabled($self); + + # $::lxdebug->dump(0, "GM handler for filtered; params nach modif (is_enabled? " . _is_enabled($self) . ")", \%params); + + return (%params, %filter_params); +} + +sub _priv { + my ($self) = @_; + $self->{PRIV()} ||= {}; + return $self->{PRIV()}; +} + +sub _is_enabled { + my ($self) = @_; + return !_priv($self)->{disabled} && ($self->get_filter_spec->{ONLY_MAP}->{$self->action_name} || $self->get_filter_spec->{ONLY_MAP}->{'__ALL__'}); +} + + +1; + +__END__ + +=pod + +=encoding utf8 + +=head1 NAME + +SL::Controller::Helper::Filtered - A helper for semi-automatic handling +of filtered lists of database models in a controller + +=head1 SYNOPSIS + +In a controller: + + use SL::Controller::Helper::GetModels; + use SL::Controller::Helper::Filtered; + + __PACKAGE__->make_filter( + MODEL => 'Part', + ONLY => [ qw(list) ], + FORM_PARAMS => [ qw(filter) ], + ); + + sub action_list { + my ($self) = @_; + + my $filtered_models = $self->get_models(%addition_filters); + $self->render('controller/list', ENTRIES => $filtered_models); + } + + +=head1 OVERVIEW + +This helper module enables use of the L +methods in conjunction with the L style of +plugins. Additional filters can be defined in the database models and filtering +can be reduced to a minimum of work. + +This plugin can be combined with L and +L for filtered, sorted and paginated lists. + +The controller has to provive information where to look for filter information +at compile time. This call is L. + +The underlying functionality that enables the use of more than just +the paginate helper is provided by the controller helper +C. See the documentation for L for +more information on it. + +=head1 PACKAGE FUNCTIONS + +=over 4 + +=item C + +This function must be called by a controller at compile time. It is +uesd to set the various parameters required for this helper to do its +magic. + +Careful: If you want to use this in conjunction with +L, you need to call C first, +or the paginating will not get all the relevant information to estimate the +number of pages correctly. To ensure this does not happen, this module will +croak when it detects such a scenario. + +The hash C<%filter_spec> can include the following parameters: + +=over 4 + +=item * C + +Optional. A string: the name of the Rose database model that is used +as a default in certain cases. If this parameter is missing then it is +derived from the controller's package (e.g. for the controller +C the C would default to +C). + +=item * C + +Optional. Indicates a key in C<$::form> to be used as filter. + +Defaults to the values C if missing. + +=item * C + +Option. Indicates a target for laundered filter arguments in the controller. +Can be set to C to disable laundering, and can be set to method named or +hash keys of the controller. In the latter case the laundered structure will be +put there. + +Defaults to inplace laundering which is not normally settable. + +=item * C + +Optional. An array reference containing a list of action names for +which the paginate parameters should be saved. If missing or empty then +all actions invoked on the controller are monitored. + +=back + +=back + +=head1 INSTANCE FUNCTIONS + +These functions are called on a controller instance. + +=over 4 + +=item C + +Returns a hash to be used in manager C calls or to be passed on to +GetModels. Will only work if the get_models chain has been called at least +once, because only then the full parameters can get parsed and stored. Will +croak otherwise. + +=item C + +Disable filtering for the duration of the current action. Can be used +when using the attribute C to L does not +cover all cases. + +=back + +=head1 BUGS + +Nothing here yet. + +=head1 AUTHOR + +Sven Schöling Es.schoeling@linet-services.deE + +=cut diff --git a/SL/Controller/Helper/GetModels.pm b/SL/Controller/Helper/GetModels.pm index e35365717..8e2ede133 100644 --- a/SL/Controller/Helper/GetModels.pm +++ b/SL/Controller/Helper/GetModels.pm @@ -7,7 +7,7 @@ our @EXPORT = qw(get_models_url_params get_callback get_models); use constant PRIV => '__getmodelshelperpriv'; -my %registered_handlers = ( callback => [], get_models => [] ); +my $registered_handlers = {}; sub register_get_models_handlers { my ($class, %additional_handlers) = @_; @@ -18,7 +18,8 @@ sub register_get_models_handlers { $class->run_before(sub { $_[0]->{PRIV()} = { current_action => $_[1] }; }, %hook_params); - map { push @{ $registered_handlers{$_} }, $additional_handlers{$_} if $additional_handlers{$_} } keys %registered_handlers; + my $handlers = _registered_handlers($class); + map { push @{ $handlers->{$_} }, $additional_handlers{$_} if $additional_handlers{$_} } keys %$handlers; } sub get_models_url_params { @@ -34,7 +35,7 @@ sub get_models_url_params { ); }; - push @{ $registered_handlers{callback} }, $callback; + push @{ _registered_handlers($class)->{callback} }, $callback; } sub get_callback { @@ -48,9 +49,8 @@ sub get_callback { sub get_models { my ($self, %override_params) = @_; - my %default_params = _run_handlers($self, 'get_models'); + my %params = _run_handlers($self, 'get_models', %override_params); - my %params = (%default_params, %override_params); my $model = delete($params{model}) || die "No 'model' to work on"; return "SL::DB::Manager::${model}"->get_all(%params); @@ -63,7 +63,7 @@ sub get_models { sub _run_handlers { my ($self, $handler_type, %params) = @_; - foreach my $sub (@{ $registered_handlers{$handler_type} }) { + foreach my $sub (@{ _registered_handlers(ref $self)->{$handler_type} }) { if (ref $sub eq 'CODE') { %params = $sub->($self, %params); } elsif ($self->can($sub)) { @@ -76,6 +76,10 @@ sub _run_handlers { return %params; } +sub _registered_handlers { + $registered_handlers->{$_[0]} //= { callback => [], get_models => [] } +} + 1; __END__ diff --git a/SL/Controller/Helper/Paginated.pm b/SL/Controller/Helper/Paginated.pm index 15997b8e9..25c4efa09 100644 --- a/SL/Controller/Helper/Paginated.pm +++ b/SL/Controller/Helper/Paginated.pm @@ -18,6 +18,7 @@ sub make_paginated { $specs{MODEL} =~ s{ ^ SL::DB:: (?: .* :: )? }{}x; $specs{PER_PAGE} ||= "SL::DB::Manager::$specs{MODEL}"->default_objects_per_page; $specs{FORM_PARAMS} ||= [ qw(page per_page) ]; + $specs{PAGINATE_ARGS} ||= '__FILTER__'; $specs{ONLY} ||= []; $specs{ONLY} = [ $specs{ONLY} ] if !ref $specs{ONLY}; $specs{ONLY_MAP} = @{ $specs{ONLY} } ? { map { ($_ => 1) } @{ $specs{ONLY} } } : { '__ALL__' => 1 }; @@ -57,9 +58,13 @@ sub get_current_paginate_params { per_page => ($params{per_page} * 1) || $spec->{PER_PAGE}, ); - my %paginate_args = ref($spec->{PAGINATE_ARGS}) eq 'CODE' ? %{ $spec->{PAGINATE_ARGS}->($self) } - : $spec->{PAGINATE_ARGS} ? do { my $sub = $spec->{PAGINATE_ARGS}; %{ $self->$sub() } } - : (); + # try to use Filtered if available and nothing else is configured, but don't + # blow up if the controller does not use Filtered + my %paginate_args = ref($spec->{PAGINATE_ARGS}) eq 'CODE' ? %{ $spec->{PAGINATE_ARGS}->($self) } + : $spec->{PAGINATE_ARGS} eq '__FILTER__' + && $self->can('get_current_filter_params') ? $self->get_current_filter_params + : $spec->{PAGINATE_ARGS} ne '__FILTER__' ? do { my $sub = $spec->{PAGINATE_ARGS}; %{ $self->$sub() } } + : (); my $calculated_params = "SL::DB::Manager::$spec->{MODEL}"->paginate(%paginate_params, args => \%paginate_args); # $::lxdebug->dump(0, "get_current_paginate_params: ", $calculated_params); diff --git a/SL/Controller/Helper/ParseFilter.pm b/SL/Controller/Helper/ParseFilter.pm index 3bf1b6595..ee5a740d1 100644 --- a/SL/Controller/Helper/ParseFilter.pm +++ b/SL/Controller/Helper/ParseFilter.pm @@ -8,6 +8,7 @@ our @EXPORT = qw(parse_filter); use DateTime; use SL::Helper::DateTime; use List::MoreUtils qw(uniq); +use SL::MoreCommon qw(listify); use Data::Dumper; my %filters = ( @@ -33,10 +34,15 @@ sub parse_filter { my ($filter, %params) = @_; my $hint_objects = $params{with_objects} || []; + my $auto_objects = []; - my ($flattened, $objects) = _pre_parse($filter, $hint_objects, '', %params); + my ($flattened, $objects) = flatten($filter, $auto_objects, '', %params); - my $query = _parse_filter($flattened, %params); + if ($params{class}) { + $objects = $hint_objects; + } + + my $query = _parse_filter($flattened, $objects, %params); _launder_keys($filter, $params{launder_to}) unless $params{no_launder}; @@ -55,7 +61,7 @@ sub _launder_keys { if ('' eq ref $filter->{$orig}) { $launder_to->{$key} = $filter->{$orig}; } elsif ('ARRAY' eq ref $filter->{$orig}) { - $launder_to->{$key} = [ @{ $filter->{$orig} } ]; + $launder_to->{"${key}_"} = { map { $_ => 1 } @{ $filter->{$orig} } }; } else { $launder_to->{$key} ||= { }; _launder_keys($filter->{$key}, $launder_to->{$key}); @@ -63,7 +69,7 @@ sub _launder_keys { }; } -sub _pre_parse { +sub flatten { my ($filter, $with_objects, $prefix, %params) = @_; return (undef, $with_objects) unless 'HASH' eq ref $filter; @@ -74,7 +80,7 @@ sub _pre_parse { while (my ($key, $value) = each %$filter) { next if !defined $value || $value eq ''; # 0 is fine if ('HASH' eq ref $value) { - my ($query, $more_objects) = _pre_parse($value, $with_objects, _prefix($prefix, $key)); + my ($query, $more_objects) = flatten($value, $with_objects, _prefix($prefix, $key)); push @result, @$query if $query; push @$with_objects, _prefix($prefix, $key), ($more_objects ? @$more_objects : ()); } else { @@ -86,25 +92,97 @@ sub _pre_parse { } sub _parse_filter { - my ($flattened, %params) = @_; + my ($flattened, $with_objects, %params) = @_; return () unless 'ARRAY' eq ref $flattened; - my %sorted = ( @$flattened ); + $flattened = _collapse_indirect_filters($flattened); - my @keys = sort { length($b) <=> length($a) } keys %sorted; - for my $key (@keys) { - next unless $key =~ /^(.*\b)::$/; - $sorted{$1 . '::' . delete $sorted{$key} } = delete $sorted{$1} if $sorted{$1} && $sorted{$key}; - } + my @result; + for (my $i = 0; $i < scalar @$flattened; $i += 2) { + my ($key, $value) = ($flattened->[$i], $flattened->[$i+1]); - my %result; - while (my ($key, $value) = each %sorted) { ($key, $value) = _apply_all($key, $value, qr/\b:(\w+)/, { %filters, %{ $params{filters} || {} } }); ($key, $value) = _apply_all($key, $value, qr/\b::(\w+)/, { %methods, %{ $params{methods} || {} } }); - $result{$key} = $value; + ($key, $value) = _dispatch_custom_filters($params{class}, $with_objects, $key, $value) if $params{class}; + + push @result, $key, $value; + } + return \@result; +} + +sub _dispatch_custom_filters { + my ($class, $with_objects, $key, $value) = @_; + + # the key should by now have no filters left + # if it has, catch it here: + die 'unrecognized filters' if $key =~ /:/; + + my @tokens = split /\./, $key; + my $last_token = pop @tokens; + my $curr_class = $class->object_class; + + for my $token (@tokens) { + eval { + $curr_class = $curr_class->meta->relationship($token)->class; + 1; + } or do { + require Carp; + Carp::croak("Could not resolve the relationship '$token' in '$key' while building the filter request"); + } + } + + my $manager = $curr_class->meta->convention_manager->auto_manager_class_name; + my $obj_path = join '.', @tokens; + my $obj_prefix = join '.', @tokens, ''; + + if ($manager->can('filter')) { + ($key, $value, my $obj) = $manager->filter($last_token, $value, $obj_prefix); + _add_uniq($with_objects, $obj); + } else { + _add_uniq($with_objects, $obj_path); + } + + return ($key, $value); +} + +sub _add_uniq { + my ($array, $what) = @_; + + $array //= []; + $array = [ uniq @$array, listify($what) ]; +} + +sub _collapse_indirect_filters { + my ($flattened) = @_; + + die 'flattened filter array length is uneven, should be possible to use as hash' if @$flattened % 2; + + my (%keys_to_delete, %keys_to_move, @collapsed); + + # search keys matching /::$/; + for (my $i = 0; $i < scalar @$flattened; $i += 2) { + my ($key, $value) = ($flattened->[$i], $flattened->[$i+1]); + + next unless $key =~ /^(.*\b)::$/; + + $keys_to_delete{$key}++; + $keys_to_move{$1} = $1 . '::' . $value; } - return [ %result ]; + + for (my $i = 0; $i < scalar @$flattened; $i += 2) { + my ($key, $value) = ($flattened->[$i], $flattened->[$i+1]); + + if ($keys_to_move{$key}) { + push @collapsed, $keys_to_move{$key}, $value; + next; + } + if (!$keys_to_delete{$key}) { + push @collapsed, $key, $value; + } + } + + return \@collapsed; } sub _prefix { @@ -200,19 +278,6 @@ As a rule all value filters require a single colon and must be placed before match method suffixes, which are appended with 2 colons. See below for a full list of modifiers. -The reason for the method being last is that it is possible to specify the -method in another input. Suppose you want a date input and a separate -before/after/equal select, you can use the following: - - [% L.date_tag('filter.appointed_date:date', ... ) %] - -and later - - [% L.select_tag('filter.appointed_date::', ... ) %] - -The special empty method will be used to set the method for the previous -method-less input. - =back =head1 LAUNDERING @@ -223,15 +288,21 @@ default laundered into underscores, so you can use them like this: [% L.input_tag('filter.price:number::lt', filter.price_number__lt) %] -All of your original entries will stay intactg. If you don't want this to +Also Template has trouble when looking up the contents of arrays, so +these will get copied into a _ suffixed version as hashes: + + [% L.checkbox_tag('filter.ids[]', value=15, checked=filter.ids_.15) %] + +All of your original entries will stay intact. If you don't want this to happen pass C<< no_launder => 1 >> as a parameter. Additionally you can pass a different target for the laundered values with the C parameter. It takes an hashref and will deep copy all values in your filter to the target. So -if you have a filter that looks liek this: +if you have a filter that looks like this: $filter = { 'price:number::lt' => '2,30', - 'closed => '1', + closed => '1', + type => [ 'part', 'assembly' ], } and parse it with @@ -243,9 +314,46 @@ like this: $filter = { 'price_number__lt' => '2,30', - 'closed => '1', + closed => '1', + 'type_' => { part => 1, assembly => 1 }, + } + +=head1 INDIRECT FILTER METHODS + +The reason for the method being last is that it is possible to specify the +method in another input. Suppose you want a date input and a separate +before/after/equal select, you can use the following: + + [% L.date_tag('filter.appointed_date:date', ... ) %] + +and later + + [% L.select_tag('filter.appointed_date:date::', ... ) %] + +The special empty method will be used to set the method for the previous +method-less input. + +=head1 CUSTOM FILTERS FROM OBJECTS + +If the L call contains a parameter C, custom filters will +be honored. Suppose you have added a custom filter 'all' for parts which +expands to search both description and partnumber, the following + + $filter = { + 'part.all:substr::ilike' => 'A1', } +will expand to: + + query => [ + or => [ + part.description => { ilike => '%A1%' }, + part.partnumber => { ilike => '%A1%' }, + ] + ] + +For more abuot custom filters, see L. + =head1 FILTERS (leading with :) The following filters are built in, and can be used. @@ -307,7 +415,7 @@ following will not work as you expect: L.input_tag('customer.name:substr::ilike', ...) L.input_tag('invoice.customer.name:substr::ilike', ...) -This will sarch for orders whoe invoice has the _same_ customer, which matches +This will sarch for orders whose invoice has the _same_ customer, which matches both inputs. This is because tables are aliased by their name and not by their position in with_objects. diff --git a/SL/DB/Currency.pm b/SL/DB/Currency.pm new file mode 100644 index 000000000..14ba066e9 --- /dev/null +++ b/SL/DB/Currency.pm @@ -0,0 +1,13 @@ +# 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::Currency; + +use strict; + +use SL::DB::MetaSetup::Currency; + +# Creates get_all, get_all_count, get_all_iterator, delete_all and update_all. +__PACKAGE__->meta->make_manager_class; + +1; diff --git a/SL/DB/Default.pm b/SL/DB/Default.pm index b71b0f474..4ea7be63f 100644 --- a/SL/DB/Default.pm +++ b/SL/DB/Default.pm @@ -9,8 +9,8 @@ __PACKAGE__->meta->make_manager_class; sub get_default_currency { my $self = shift->get; - my @currencies = grep { $_ } split(/:/, $self->curr || ''); - return $currencies[0] || ''; + return $self->currency->name || '' if $self->currency_id; + return ''; } sub get { diff --git a/SL/DB/Helper/ALL.pm b/SL/DB/Helper/ALL.pm index bff5089b9..f951bf9d0 100644 --- a/SL/DB/Helper/ALL.pm +++ b/SL/DB/Helper/ALL.pm @@ -20,6 +20,7 @@ use SL::DB::Chart; use SL::DB::Contact; use SL::DB::CsvImportProfile; use SL::DB::CsvImportProfileSetting; +use SL::DB::Currency; use SL::DB::CustomVariable; use SL::DB::CustomVariableConfig; use SL::DB::CustomVariableValidity; diff --git a/SL/DB/Helper/Filtered.pm b/SL/DB/Helper/Filtered.pm new file mode 100644 index 000000000..15e098527 --- /dev/null +++ b/SL/DB/Helper/Filtered.pm @@ -0,0 +1,186 @@ +package SL::DB::Helper::Filtered; + +use strict; +use SL::Controller::Helper::ParseFilter (); + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw (filter add_filter_specs); + +my %filter_spec; + +sub filter { + my ($class, $key, $value, $prefix) = @_; + + my $filters = _get_filters($class); + + return ($key, $value) unless $filters->{$key}; + + return $filters->{$key}->($key, $value, $prefix); +} + +sub _get_filters { + my ($class) = @_; + return $filter_spec{$class} ||= {}; +} + +sub add_filter_specs { + my $class = shift; + + my $filters = _get_filters($class); + + while (@_ > 1) { + my $key = shift; + $filters->{$key} = shift; + } +} + +1; + +__END__ + +=encoding utf-8 + +=head1 NAME + +SL::Helper::Sorted - Manager mixin for filtered results. + +=head1 SYNOPSIS + +In the manager: + + use SL::Helper::Filtered; + + __PACKAGE__->add_filter_specs( + custom_filter_name => sub { + my ($key, $value, $prefix) = @_; + # code to handle this + return ($key, $value, $with_objects); + }, + another_filter_name => \&_sub_to_handle_this, + ); + +In consuming code: + + ($key, $value, $with_objects) = $manager_class->filter($key, $value, $prefix); + +=head1 FUNCTIONS + +=over 4 + +=item C + +Adds new filters to this package as key value pairs. The key will be the new +filters name, the value is expected to be a coderef to an implementation of +this filter. See L for details on this. + +You can add multiple filters in one call, but only one filter per key. + +=item C + +Tells the manager to pply custom filters. If none is registered for C<$key>, +returns C<$key, $value>. + +Otherwise the filter code is called. + +=back + +=head1 INTERFACE OF A CUSTOM FILTER + +Lets look at an example of a working filter. Suppose your model has a lot of +notes fields, and you need to search in all of them. A working filter would be: + + __PACKAGE__->add_filter_specs( + all_notes => sub { + my ($key, $value, $prefix) = @_; + + return or => [ + $prefix . notes1 => $value, + $prefix . notes2 => $value, + ]; + } + ); + +If someone filters for C, your +filter will get called with: + + ->filter('all_notes', { ilike => '%telephone%' }, '') + +and the result will be: + + or => [ + notes1 => { notes1 => '%telephone%' }, + notes2 => { notes1 => '%telephone%' }, + ] + +The prefix is to make sure this also works when called on submodels: + + C + +will pass C as prefix so that the resulting query will be: + + or => [ + customer.notes1 => { notes1 => '%telephone%' }, + customer.notes2 => { notes1 => '%telephone%' }, + ] + +which is pretty much what you would expect. + +As a final touch consider a filter that needs to search somewhere else to work, +like this one: + + __PACKAGE__->add_filter_specs( + name => sub { + my ($key, $value, $prefix) = @_; + + return $prefix . person.name => $value, + $prefix . 'person'; + }, + }; + +Now you can search for C in your model without ever knowing that the real +name lies in the table C. Unfortunately Rose has to know about it to +get the joins right, and so you need to tell it to include C into its +C. That's the reason for the third return value. + + +To summarize: + +=over 4 + +=item * + +You will get passed the name of your filter as C<$key> stripped of all filters +and escapes. + +=item * + +You will get passed the C<$value> processed with all filters and escapes. + +=item * + +You will get passed a C<$prefix> that can be prepended to all database columns +to make sense to Rose. + +=item * + +You are expeceted to return exactly one key and one value. That can mean you +have to encapsulate your arguments into C<< or => [] >> or C<< and => [] >> blocks. + +=item * + +If your filter needs relationships that are not always loaded, you need to +return them in C style. If you need to return more than one, use +an arrayref. + +=back + +=head1 BUGS + +None yet. + +=head1 AUTHOR + +Sven Schöling Es.schoeling@linet-services.deE + +=cut diff --git a/SL/DB/Helper/FlattenToForm.pm b/SL/DB/Helper/FlattenToForm.pm index d5805b0c0..c2d8a5fe9 100644 --- a/SL/DB/Helper/FlattenToForm.pm +++ b/SL/DB/Helper/FlattenToForm.pm @@ -14,11 +14,11 @@ sub flatten_to_form { my $vc = $self->can('customer_id') && $self->customer_id ? 'customer' : 'vendor'; - _copy($self, $form, '', '', 0, qw(id type taxzone_id ordnumber quonumber invnumber donumber cusordnumber taxincluded shippingpoint shipvia notes intnotes curr cp_id + _copy($self, $form, '', '', 0, qw(id type taxzone_id ordnumber quonumber invnumber donumber cusordnumber taxincluded shippingpoint shipvia notes intnotes cp_id employee_id salesman_id closed department_id language_id payment_id delivery_customer_id delivery_vendor_id shipto_id proforma globalproject_id delivered transaction_description container_type accepted_by_customer invoice terms storno storno_id dunning_config_id orddate quodate reqdate gldate duedate deliverydate datepaid transdate)); - $form->{currency} = $form->{curr}; # curr is called currency in almost all forms + $form->{currency} = $form->{curr} = $self->currency_id ? $self->currency->name || '' : ''; if (_has($self, 'transdate')) { my $transdate_idx = ref($self) eq 'SL::DB::Order' ? ($self->quotation ? 'quodate' : 'orddate') diff --git a/SL/DB/Helper/Mappings.pm b/SL/DB/Helper/Mappings.pm index cc4d2abe1..f0b8be9af 100644 --- a/SL/DB/Helper/Mappings.pm +++ b/SL/DB/Helper/Mappings.pm @@ -55,6 +55,7 @@ my %lxoffice_package_names = ( csv_import_reports => 'csv_import_report', csv_import_report_rows => 'csv_import_report_row', csv_import_report_status => 'csv_import_report_status', + currencies => 'currency', custom_variable_configs => 'custom_variable_config', custom_variables => 'custom_variable', custom_variables_validity => 'custom_variable_validity', diff --git a/SL/DB/Helper/PriceTaxCalculator.pm b/SL/DB/Helper/PriceTaxCalculator.pm index 0801299fb..73613f89d 100644 --- a/SL/DB/Helper/PriceTaxCalculator.pm +++ b/SL/DB/Helper/PriceTaxCalculator.pm @@ -53,8 +53,9 @@ sub calculate_prices_and_taxes { sub _get_exchangerate { my ($self, $data, %params) = @_; - if (($self->curr || '') ne SL::DB::Default->get_default_currency) { - $data->{exchangerate} = $::form->check_exchangerate(\%::myconfig, $self->curr, $self->transdate, $data->{is_sales} ? 'buy' : 'sell'); + my $currency = $self->currency_id ? $self->currency->name || '' : ''; + if ($currency ne SL::DB::Default->get_default_currency) { + $data->{exchangerate} = $::form->check_exchangerate(\%::myconfig, $currency, $self->transdate, $data->{is_sales} ? 'buy' : 'sell'); $data->{exchangerate} ||= $params{exchangerate}; } $data->{exchangerate} ||= 1; diff --git a/SL/DB/Invoice.pm b/SL/DB/Invoice.pm index 09c7f86e7..d93de711a 100644 --- a/SL/DB/Invoice.pm +++ b/SL/DB/Invoice.pm @@ -98,9 +98,9 @@ sub new_from { my $terms = $source->can('payment_id') && $source->payment_id ? $source->payment_terms->terms_netto : 0; - my %args = ( map({ ( $_ => $source->$_ ) } qw(customer_id taxincluded shippingpoint shipvia notes intnotes curr salesman_id cusordnumber ordnumber quonumber + my %args = ( map({ ( $_ => $source->$_ ) } qw(customer_id taxincluded shippingpoint shipvia notes intnotes salesman_id cusordnumber ordnumber quonumber department_id cp_id language_id payment_id delivery_customer_id delivery_vendor_id taxzone_id shipto_id - globalproject_id transaction_description)), + globalproject_id transaction_description currency_id)), transdate => DateTime->today_local, gldate => DateTime->today_local, duedate => DateTime->today_local->add(days => $terms * 1), diff --git a/SL/DB/Manager/OrderItem.pm b/SL/DB/Manager/OrderItem.pm index e908b6b1f..e964f4ff3 100644 --- a/SL/DB/Manager/OrderItem.pm +++ b/SL/DB/Manager/OrderItem.pm @@ -5,12 +5,27 @@ use strict; use SL::DB::Helper::Manager; use base qw(SL::DB::Helper::Manager); +use SL::DB::Helper::Filtered; use SL::DB::Helper::Paginated; use SL::DB::Helper::Sorted; sub object_class { 'SL::DB::OrderItem' } __PACKAGE__->make_manager_methods; +__PACKAGE__->add_filter_specs( + reqdate => sub { + my ($key, $value, $prefix) = @_; + + return or => [ + $prefix . reqdate => $value, + and => [ + $prefix . reqdate => undef, + $prefix . 'order.reqdate' => $value, + ] + ], $prefix . 'order'; + }, +); + sub _sort_spec { return ( columns => { delivery_date => [ 'deliverydate', ], diff --git a/SL/DB/Manager/Part.pm b/SL/DB/Manager/Part.pm index 6c781a9fe..e23834625 100644 --- a/SL/DB/Manager/Part.pm +++ b/SL/DB/Manager/Part.pm @@ -3,6 +3,9 @@ package SL::DB::Manager::Part; use strict; use SL::DB::Helper::Manager; +use SL::DB::Helper::Sorted; +use SL::DB::Helper::Paginated; +use SL::DB::Helper::Filtered; use base qw(SL::DB::Helper::Manager); use Carp; @@ -12,31 +15,49 @@ use SL::MoreCommon qw(listify); sub object_class { 'SL::DB::Part' } __PACKAGE__->make_manager_methods; +__PACKAGE__->add_filter_specs( + type => sub { + my ($key, $value, $prefix) = @_; + return __PACKAGE__->type_filter($value, $prefix); + }, + all => sub { + my ($key, $value, $prefix) = @_; + return or => [ map { $prefix . $_ => $value } qw(partnumber description) ] + } +); sub type_filter { - my ($class, $type) = @_; + my ($class, $type, $prefix) = @_; return () unless $type; + $prefix //= ''; + + # this is to make selection like type => { part => 1, service => 1 } work + if ('HASH' eq ref $type) { + $type = grep { $type->{$_} } keys %$type; + } + my @types = listify($type); my @filter; for my $type (@types) { if ($type =~ m/^part/) { - push @filter, (and => [ or => [ assembly => 0, assembly => undef ], - '!inventory_accno_id' => 0, - '!inventory_accno_id' => undef, + push @filter, (and => [ or => [ $prefix . assembly => 0, $prefix . assembly => undef ], + "!${prefix}inventory_accno_id" => 0, + "!${prefix}inventory_accno_id" => undef, ]); } elsif ($type =~ m/^service/) { - push @filter, (and => [ or => [ assembly => 0, assembly => undef ], - or => [ inventory_accno_id => 0, inventory_accno_id => undef ], + push @filter, (and => [ or => [ $prefix . assembly => 0, $prefix . assembly => undef ], + or => [ $prefix . inventory_accno_id => 0, $prefix . inventory_accno_id => undef ], ]); } elsif ($type =~ m/^assembl/) { - push @filter, (assembly => 1); + push @filter, ($prefix . assembly => 1); } } - return @filter ? (or => \@filter) : (); + return @filter > 2 ? (or => \@filter) : + @filter ? @filter : (); } sub get_ordered_qty { diff --git a/SL/DB/MetaSetup/Currency.pm b/SL/DB/MetaSetup/Currency.pm new file mode 100644 index 000000000..705467f03 --- /dev/null +++ b/SL/DB/MetaSetup/Currency.pm @@ -0,0 +1,23 @@ +# This file has been auto-generated. Do not modify it; it will be overwritten +# by rose_auto_create_model.pl automatically. +package SL::DB::Currency; + +use strict; + +use base qw(SL::DB::Object); + +__PACKAGE__->meta->setup( + table => 'currencies', + + columns => [ + id => { type => 'serial', not_null => 1 }, + name => { type => 'text', not_null => 1 }, + ], + + primary_key_columns => [ 'id' ], + + unique_key => [ 'name' ], +); + +1; +; diff --git a/SL/DB/MetaSetup/Customer.pm b/SL/DB/MetaSetup/Customer.pm index 82d808cf9..0bb7cd96b 100644 --- a/SL/DB/MetaSetup/Customer.pm +++ b/SL/DB/MetaSetup/Customer.pm @@ -53,8 +53,8 @@ __PACKAGE__->meta->setup( iban => { type => 'varchar', length => 100 }, bic => { type => 'varchar', length => 100 }, direct_debit => { type => 'boolean', default => 'false' }, - curr => { type => 'text' }, taxincluded_checked => { type => 'boolean' }, + currency_id => { type => 'integer', not_null => 1 }, ], primary_key_columns => [ 'id' ], @@ -67,6 +67,11 @@ __PACKAGE__->meta->setup( key_columns => { business_id => 'id' }, }, + currency => { + class => 'SL::DB::Currency', + key_columns => { currency_id => 'id' }, + }, + language_obj => { class => 'SL::DB::Language', key_columns => { language_id => 'id' }, diff --git a/SL/DB/MetaSetup/Default.pm b/SL/DB/MetaSetup/Default.pm index 8063f9ed5..1fde1bbfa 100644 --- a/SL/DB/MetaSetup/Default.pm +++ b/SL/DB/MetaSetup/Default.pm @@ -20,7 +20,6 @@ __PACKAGE__->meta->setup( weightunit => { type => 'varchar', length => 5 }, businessnumber => { type => 'text' }, version => { type => 'varchar', length => 8 }, - curr => { type => 'text' }, closedto => { type => 'date' }, revtrans => { type => 'boolean', default => 'false' }, ponumber => { type => 'text' }, @@ -70,10 +69,13 @@ __PACKAGE__->meta->setup( assemblynumber => { type => 'text' }, warehouse_id => { type => 'integer' }, bin_id => { type => 'integer' }, + currency_id => { type => 'integer', not_null => 1 }, ], primary_key_columns => [ 'id' ], + allow_inline_column_values => 1, + foreign_keys => [ bin => { class => 'SL::DB::Bin', @@ -83,6 +85,10 @@ __PACKAGE__->meta->setup( warehouse => { class => 'SL::DB::Warehouse', key_columns => { warehouse_id => 'id' }, + + currency => { + class => 'SL::DB::Currency', + key_columns => { currency_id => 'id' }, }, ], ); diff --git a/SL/DB/MetaSetup/DeliveryOrder.pm b/SL/DB/MetaSetup/DeliveryOrder.pm index 523312160..86cdc6406 100644 --- a/SL/DB/MetaSetup/DeliveryOrder.pm +++ b/SL/DB/MetaSetup/DeliveryOrder.pm @@ -39,7 +39,7 @@ __PACKAGE__->meta->setup( taxzone_id => { type => 'integer' }, taxincluded => { type => 'boolean' }, terms => { type => 'integer' }, - curr => { type => 'text' }, + currency_id => { type => 'integer', not_null => 1 }, ], primary_key_columns => [ 'id' ], @@ -52,6 +52,11 @@ __PACKAGE__->meta->setup( key_columns => { cp_id => 'cp_id' }, }, + currency => { + class => 'SL::DB::Currency', + key_columns => { currency_id => 'id' }, + }, + customer => { class => 'SL::DB::Customer', key_columns => { customer_id => 'id' }, diff --git a/SL/DB/MetaSetup/Exchangerate.pm b/SL/DB/MetaSetup/Exchangerate.pm index 44bce842b..ddd09438b 100644 --- a/SL/DB/MetaSetup/Exchangerate.pm +++ b/SL/DB/MetaSetup/Exchangerate.pm @@ -10,18 +10,25 @@ __PACKAGE__->meta->setup( table => 'exchangerate', columns => [ - curr => { type => 'text' }, - transdate => { type => 'date' }, - buy => { type => 'numeric', precision => 5, scale => 15 }, - sell => { type => 'numeric', precision => 5, scale => 15 }, - itime => { type => 'timestamp', default => 'now()' }, - mtime => { type => 'timestamp' }, - id => { type => 'serial', not_null => 1 }, + transdate => { type => 'date' }, + buy => { type => 'numeric', precision => 5, scale => 15 }, + sell => { type => 'numeric', precision => 5, scale => 15 }, + itime => { type => 'timestamp', default => 'now()' }, + mtime => { type => 'timestamp' }, + id => { type => 'serial', not_null => 1 }, + currency_id => { type => 'integer', not_null => 1 }, ], primary_key_columns => [ 'id' ], allow_inline_column_values => 1, + + foreign_keys => [ + currency => { + class => 'SL::DB::Currency', + key_columns => { currency_id => 'id' }, + }, + ], ); 1; diff --git a/SL/DB/MetaSetup/Invoice.pm b/SL/DB/MetaSetup/Invoice.pm index b01b1417d..2a0e50ee2 100644 --- a/SL/DB/MetaSetup/Invoice.pm +++ b/SL/DB/MetaSetup/Invoice.pm @@ -26,7 +26,6 @@ __PACKAGE__->meta->setup( shippingpoint => { type => 'text' }, terms => { type => 'integer', default => '0' }, notes => { type => 'text' }, - curr => { type => 'text' }, ordnumber => { type => 'text' }, employee_id => { type => 'integer' }, quonumber => { type => 'text' }, @@ -57,6 +56,7 @@ __PACKAGE__->meta->setup( donumber => { type => 'text' }, invnumber_for_credit_note => { type => 'text' }, direct_debit => { type => 'boolean', default => 'false' }, + currency_id => { type => 'integer', not_null => 1 }, ], primary_key_columns => [ 'id' ], @@ -69,6 +69,11 @@ __PACKAGE__->meta->setup( key_columns => { cp_id => 'cp_id' }, }, + currency => { + class => 'SL::DB::Currency', + key_columns => { currency_id => 'id' }, + }, + customer => { class => 'SL::DB::Customer', key_columns => { customer_id => 'id' }, diff --git a/SL/DB/MetaSetup/Order.pm b/SL/DB/MetaSetup/Order.pm index f68c276ef..063ca0b0f 100644 --- a/SL/DB/MetaSetup/Order.pm +++ b/SL/DB/MetaSetup/Order.pm @@ -21,7 +21,6 @@ __PACKAGE__->meta->setup( taxincluded => { type => 'boolean' }, shippingpoint => { type => 'text' }, notes => { type => 'text' }, - curr => { type => 'character', length => 3 }, employee_id => { type => 'integer' }, closed => { type => 'boolean', default => 'false' }, quotation => { type => 'boolean', default => 'false' }, @@ -43,9 +42,10 @@ __PACKAGE__->meta->setup( delivered => { type => 'boolean', default => 'false' }, globalproject_id => { type => 'integer' }, salesman_id => { type => 'integer' }, - transaction_description => { type => 'text' }, marge_total => { type => 'numeric', precision => 5, scale => 15 }, marge_percent => { type => 'numeric', precision => 5, scale => 15 }, + transaction_description => { type => 'text' }, + currency_id => { type => 'integer', not_null => 1 }, ], primary_key_columns => [ 'id' ], @@ -58,6 +58,11 @@ __PACKAGE__->meta->setup( key_columns => { cp_id => 'cp_id' }, }, + currency => { + class => 'SL::DB::Currency', + key_columns => { currency_id => 'id' }, + }, + customer => { class => 'SL::DB::Customer', key_columns => { customer_id => 'id' }, diff --git a/SL/DB/MetaSetup/PurchaseInvoice.pm b/SL/DB/MetaSetup/PurchaseInvoice.pm index bee7eb2ae..e484fb933 100644 --- a/SL/DB/MetaSetup/PurchaseInvoice.pm +++ b/SL/DB/MetaSetup/PurchaseInvoice.pm @@ -23,7 +23,6 @@ __PACKAGE__->meta->setup( duedate => { type => 'date' }, invoice => { type => 'boolean', default => 'false' }, ordnumber => { type => 'text' }, - curr => { type => 'text' }, notes => { type => 'text' }, employee_id => { type => 'integer' }, quonumber => { type => 'text' }, @@ -44,6 +43,8 @@ __PACKAGE__->meta->setup( transaction_description => { type => 'text' }, storno_id => { type => 'integer' }, direct_debit => { type => 'boolean', default => 'false' }, + deliverydate => { type => 'date' }, + currency_id => { type => 'integer', not_null => 1 }, ], primary_key_columns => [ 'id' ], @@ -56,6 +57,11 @@ __PACKAGE__->meta->setup( key_columns => { cp_id => 'cp_id' }, }, + currency => { + class => 'SL::DB::Currency', + key_columns => { currency_id => 'id' }, + }, + department => { class => 'SL::DB::Department', key_columns => { department_id => 'id' }, diff --git a/SL/DB/MetaSetup/Vendor.pm b/SL/DB/MetaSetup/Vendor.pm index d8854fab5..14fb4a929 100644 --- a/SL/DB/MetaSetup/Vendor.pm +++ b/SL/DB/MetaSetup/Vendor.pm @@ -52,7 +52,7 @@ __PACKAGE__->meta->setup( iban => { type => 'varchar', length => 100 }, bic => { type => 'varchar', length => 100 }, direct_debit => { type => 'boolean', default => 'false' }, - curr => { type => 'text' }, + currency_id => { type => 'integer', not_null => 1 }, ], primary_key_columns => [ 'id' ], @@ -65,6 +65,11 @@ __PACKAGE__->meta->setup( key_columns => { business_id => 'id' }, }, + currency => { + class => 'SL::DB::Currency', + key_columns => { currency_id => 'id' }, + }, + language_obj => { class => 'SL::DB::Language', key_columns => { language_id => 'id' }, diff --git a/SL/DB/VC.pm b/SL/DB/VC.pm index 44b2dbb09..c41f28788 100644 --- a/SL/DB/VC.pm +++ b/SL/DB/VC.pm @@ -26,7 +26,7 @@ SQL $query = <{id}) = selectrow_query($form, $dbh, $query); - $query = qq|INSERT INTO delivery_orders (id, donumber, employee_id) VALUES (?, '', ?)|; + $query = qq|INSERT INTO delivery_orders (id, donumber, employee_id, currency_id) VALUES (?, '', ?, (SELECT currency_id FROM defaults LIMIT 1))|; do_query($form, $dbh, $query, $form->{id}, conv_i($form->{employee_id})); } @@ -350,7 +350,7 @@ sub save { shippingpoint = ?, shipvia = ?, notes = ?, intnotes = ?, closed = ?, delivered = ?, department_id = ?, language_id = ?, shipto_id = ?, globalproject_id = ?, employee_id = ?, salesman_id = ?, cp_id = ?, transaction_description = ?, - is_sales = ?, taxzone_id = ?, taxincluded = ?, terms = ?, curr = ? + is_sales = ?, taxzone_id = ?, taxincluded = ?, terms = ?, currency_id = (SELECT id FROM currencies WHERE name = ?) WHERE id = ?|; @values = ($form->{donumber}, $form->{ordnumber}, @@ -364,7 +364,7 @@ sub save { conv_i($form->{salesman_id}), conv_i($form->{cp_id}), $form->{transaction_description}, $form->{type} =~ /^sales/ ? 't' : 'f', - conv_i($form->{taxzone_id}), $form->{taxincluded} ? 't' : 'f', conv_i($form->{terms}), substr($form->{currency}, 0, 3), + conv_i($form->{taxzone_id}), $form->{taxincluded} ? 't' : 'f', conv_i($form->{terms}), $form->{currency}, conv_i($form->{id})); do_query($form, $dbh, $query, @values); @@ -618,7 +618,7 @@ sub retrieve { d.description AS department, dord.language_id, dord.shipto_id, dord.globalproject_id, dord.delivered, dord.transaction_description, - dord.taxzone_id, dord.taxincluded, dord.terms, dord.curr AS currency + dord.taxzone_id, dord.taxincluded, dord.terms, (SELECT cu.name FROM currencies cu WHERE cu.id=dord.currency_id) AS currency FROM delivery_orders dord JOIN ${vc} cv ON (dord.${vc}_id = cv.id) LEFT JOIN employee e ON (dord.employee_id = e.id) @@ -640,9 +640,6 @@ sub retrieve { } $sth->finish(); - # remove any trailing whitespace - $form->{currency} =~ s/\s*$//; - $form->{donumber_array} =~ s/\s*$//g; $form->{saved_donumber} = $form->{donumber}; diff --git a/SL/Form.pm b/SL/Form.pm index 018526ac6..77aea90cf 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -138,9 +138,15 @@ sub _flatten_variables_rec { foreach my $idx (0 .. scalar @{ $curr->{$key} } - 1) { my $first_array_entry = 1; - foreach my $hash_key (sort keys %{ $curr->{$key}->[$idx] }) { - push @result, $self->_flatten_variables_rec($curr->{$key}->[$idx], $prefix . $key . ($first_array_entry ? '[+].' : '[].'), $hash_key); - $first_array_entry = 0; + my $element = $curr->{$key}[$idx]; + + if ('HASH' eq ref $element) { + foreach my $hash_key (sort keys %{ $element }) { + push @result, $self->_flatten_variables_rec($element, $prefix . $key . ($first_array_entry ? '[+].' : '[].'), $hash_key); + $first_array_entry = 0; + } + } else { + @result = ({ 'key' => $prefix . $key . ($first_array_entry ? '[+]' : '[]'), 'value' => $element }); } } } @@ -1482,19 +1488,17 @@ sub update_exchangerate { $main::lxdebug->leave_sub(); return; } - $query = qq|SELECT curr FROM defaults|; - - my ($currency) = selectrow_query($self, $dbh, $query); - my ($defaultcurrency) = split m/:/, $currency; + $query = qq|SELECT name AS curr FROM currencies WHERE id=(SELECT currency_id FROM defaults)|; + my ($defaultcurrency) = selectrow_query($self, $dbh, $query); if ($curr eq $defaultcurrency) { $main::lxdebug->leave_sub(); return; } - $query = qq|SELECT e.curr FROM exchangerate e - WHERE e.curr = ? AND e.transdate = ? + $query = qq|SELECT e.currency_id FROM exchangerate e + WHERE e.currency_id = (SELECT cu.id FROM currencies cu WHERE cu.name=?) AND e.transdate = ? FOR UPDATE|; my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate); @@ -1520,12 +1524,12 @@ sub update_exchangerate { if ($sth->fetchrow_array) { $query = qq|UPDATE exchangerate SET $set - WHERE curr = ? + WHERE currency_id = (SELECT id FROM currencies WHERE name = ?) AND transdate = ?|; } else { - $query = qq|INSERT INTO exchangerate (curr, buy, sell, transdate) - VALUES (?, $buy, $sell, ?)|; + $query = qq|INSERT INTO exchangerate (currency_id, buy, sell, transdate) + VALUES ((SELECT id FROM currencies WHERE name = ?), $buy, $sell, ?)|; } $sth->finish; do_query($self, $dbh, $query, $curr, $transdate); @@ -1565,18 +1569,17 @@ sub get_exchangerate { return 1; } - $query = qq|SELECT curr FROM defaults|; + $query = qq|SELECT name AS curr FROM currencies WHERE id = (SELECT currency_id FROM defaults)|; - my ($currency) = selectrow_query($self, $dbh, $query); - my ($defaultcurrency) = split m/:/, $currency; + my ($defaultcurrency) = selectrow_query($self, $dbh, $query); - if ($currency eq $defaultcurrency) { + if ($curr eq $defaultcurrency) { $main::lxdebug->leave_sub(); return 1; } $query = qq|SELECT e.$fld FROM exchangerate e - WHERE e.curr = ? AND e.transdate = ?|; + WHERE e.currency_id = (SELECT id FROM currencies WHERE name = ?) AND e.transdate = ?|; my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate); @@ -1609,7 +1612,7 @@ sub check_exchangerate { my $dbh = $self->get_standard_dbh($myconfig); my $query = qq|SELECT e.$fld FROM exchangerate e - WHERE e.curr = ? AND e.transdate = ?|; + WHERE e.currency_id = (SELECT id FROM currencies WHERE name = ?) AND e.transdate = ?|; my ($exchangerate) = selectrow_query($self, $dbh, $query, $currency, $transdate); @@ -1624,11 +1627,10 @@ sub get_all_currencies { my $self = shift; my $myconfig = shift || \%::myconfig; my $dbh = $self->get_standard_dbh($myconfig); + my @currencies =(); - my $query = qq|SELECT curr FROM defaults|; - - my ($curr) = selectrow_query($self, $dbh, $query); - my @currencies = grep { $_ } map { s/\s//g; $_ } split m/:/, $curr; + my $query = qq|SELECT name FROM currencies|; + my @currencies = map { $_->{name} } selectall_hashref_query($self, $dbh, $query); $main::lxdebug->leave_sub(); @@ -1639,11 +1641,14 @@ sub get_default_currency { $main::lxdebug->enter_sub(); my ($self, $myconfig) = @_; - my @currencies = $self->get_all_currencies($myconfig); + my $dbh = $self->get_standard_dbh($myconfig); + my $query = qq|SELECT name AS curr FROM currencies WHERE id = (SELECT currency_id FROM defaults)|; + + my ($defaultcurrency) = selectrow_query($self, $dbh, $query); $main::lxdebug->leave_sub(); - return $currencies[0]; + return $defaultcurrency; } sub set_payment_options { @@ -2183,9 +2188,7 @@ $main::lxdebug->enter_sub(); $key = "all_currencies" unless ($key); - my $query = qq|SELECT curr AS currency FROM defaults|; - - $self->{$key} = [split(/\:/ , selectfirst_hashref_query($self, $dbh, $query)->{currency})]; + $self->{$key} = [$self->get_all_currencies()]; $main::lxdebug->leave_sub(); } @@ -2696,7 +2699,7 @@ sub create_links { $query = qq|SELECT a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid, - a.duedate, a.ordnumber, a.taxincluded, a.curr AS currency, a.notes, + a.duedate, a.ordnumber, a.taxincluded, (SELECT cu.name FROM currencies cu WHERE cu.id=a.currency_id) AS currency, a.notes, 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} @@ -2714,9 +2717,6 @@ sub create_links { $self->{$key} = $ref->{$key}; } - # remove any trailing whitespace - $self->{currency} =~ s/\s*$//; - my $transdate = "current_date"; if ($self->{transdate}) { $transdate = $dbh->quote($self->{transdate}); @@ -2800,9 +2800,11 @@ sub create_links { } $sth->finish; + #check das: $query = qq|SELECT - d.curr AS currencies, d.closedto, d.revtrans, + 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 FROM defaults d|; @@ -2814,7 +2816,8 @@ sub create_links { # get date $query = qq|SELECT - current_date AS transdate, d.curr AS currencies, d.closedto, d.revtrans, + 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 FROM defaults d|; @@ -2824,7 +2827,7 @@ sub create_links { if ($self->{"$self->{vc}_id"}) { # only setup currency - ($self->{currency}) = split(/:/, $self->{currencies}) if !$self->{currency}; + ($self->{currency}) = $self->{defaultcurrency} if !$self->{currency}; } else { @@ -2849,19 +2852,17 @@ sub lastname_used { my ($arap, $where); $table = $table eq "customer" ? "customer" : "vendor"; - my %column_map = ("a.curr" => "currency", - "a.${table}_id" => "${table}_id", + my %column_map = ("a.${table}_id" => "${table}_id", "a.department_id" => "department_id", "d.description" => "department", "ct.name" => $table, - "ct.curr" => "cv_curr", + "cu.name" => "currency", "current_date + ct.terms" => "duedate", ); if ($self->{type} =~ /delivery_order/) { $arap = 'delivery_orders'; - delete $column_map{"a.curr"}; - delete $column_map{"ct.curr"}; + delete $column_map{"cu.currency"}; } elsif ($self->{type} =~ /_order/) { $arap = 'oe'; @@ -2890,18 +2891,12 @@ sub lastname_used { FROM $arap a LEFT JOIN $table ct ON (a.${table}_id = ct.id) LEFT JOIN department d ON (a.department_id = d.id) + LEFT JOIN currencies cu ON (cu.id=ct.currency_id) WHERE a.id = ?|; my $ref = selectfirst_hashref_query($self, $dbh, $query, $trans_id); map { $self->{$_} = $ref->{$_} } values %column_map; - # remove any trailing whitespace - $self->{currency} =~ s/\s*$// if $self->{currency}; - $self->{cv_curr} =~ s/\s*$// if $self->{cv_curr}; - - # if customer/vendor currency is set use this - $self->{currency} = $self->{cv_curr} if $self->{cv_curr}; - $main::lxdebug->leave_sub(); } diff --git a/SL/Helper/Csv.pm b/SL/Helper/Csv.pm index e48161492..2d454be37 100644 --- a/SL/Helper/Csv.pm +++ b/SL/Helper/Csv.pm @@ -3,6 +3,7 @@ package SL::Helper::Csv; use strict; use warnings; +use version 0.77; use Carp; use IO::File; use Params::Validate qw(:all); @@ -156,11 +157,19 @@ sub _parse_data { push @data, \%hr; } else { last if $self->_csv->eof; - push @errors, [ - $self->_csv->error_input, - $self->_csv->error_diag, - $self->_io->input_line_number, - ]; + # Text::CSV_XS 0.89 added record number to error_diag + if (qv(Text::CSV_XS->VERSION) >= qv('0.89')) { + push @errors, [ + $self->_csv->error_input, + $self->_csv->error_diag, + ]; + } else { + push @errors, [ + $self->_csv->error_input, + $self->_csv->error_diag, + $self->_io->input_line_number, + ]; + } } last if $self->_csv->eof; } diff --git a/SL/IR.pm b/SL/IR.pm index b71555cc7..36f105ebd 100644 --- a/SL/IR.pm +++ b/SL/IR.pm @@ -57,6 +57,7 @@ sub post_invoice { # connect to database, turn off autocommit my $dbh = $provided_dbh ? $provided_dbh : $form->dbconnect_noauto($myconfig); $form->{defaultcurrency} = $form->get_default_currency($myconfig); + my $defaultcurrency = $form->{defaultcurrency}; my $ic_cvar_configs = CVar->get_configs(module => 'IC', dbh => $dbh); @@ -70,18 +71,16 @@ sub post_invoice { my $all_units = AM->retrieve_units($myconfig, $form); +#markierung if (!$payments_only) { if ($form->{id}) { &reverse_invoice($dbh, $form); } else { ($form->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('glid')|); - do_query($form, $dbh, qq|INSERT INTO ap (id, invnumber) VALUES (?, '')|, $form->{id}); + do_query($form, $dbh, qq|INSERT INTO ap (id, invnumber, currency_id) VALUES (?, '', (SELECT id FROM currencies WHERE name=?))|, $form->{id}, $form->{currency}); } } - my ($currencies) = selectfirst_array_query($form, $dbh, qq|SELECT curr FROM defaults|); - my $defaultcurrency = (split m/:/, $currencies)[0]; - if ($form->{currency} eq $defaultcurrency) { $form->{exchangerate} = 1; } else { @@ -686,7 +685,7 @@ sub post_invoice { orddate = ?, quodate = ?, vendor_id = ?, amount = ?, netamount = ?, paid = ?, duedate = ?, invoice = ?, taxzone_id = ?, notes = ?, taxincluded = ?, - intnotes = ?, curr = ?, storno_id = ?, storno = ?, + intnotes = ?, storno_id = ?, storno = ?, cp_id = ?, employee_id = ?, department_id = ?, globalproject_id = ?, direct_debit = ? WHERE id = ?|; @@ -695,7 +694,7 @@ sub post_invoice { conv_date($form->{orddate}), conv_date($form->{quodate}), conv_i($form->{vendor_id}), $amount, $netamount, $form->{paid}, conv_date($form->{duedate}), '1', $taxzone_id, $form->{notes}, $form->{taxincluded} ? 't' : 'f', - $form->{intnotes}, $form->{currency}, conv_i($form->{storno_id}), $form->{storno} ? 't' : 'f', + $form->{intnotes}, conv_i($form->{storno_id}), $form->{storno} ? 't' : 'f', conv_i($form->{cp_id}), conv_i($form->{employee_id}), conv_i($form->{department_id}), conv_i($form->{globalproject_id}), $form->{direct_debit} ? 't' : 'f', @@ -925,8 +924,7 @@ sub retrieve_invoice { (SELECT c.accno FROM chart c WHERE d.income_accno_id = c.id) AS income_accno, (SELECT c.accno FROM chart c WHERE d.expense_accno_id = c.id) AS expense_accno, (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, - d.curr AS currencies + (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno $q_invdate FROM defaults d|; $ref = selectfirst_hashref_query($form, $dbh, $query); @@ -943,15 +941,12 @@ sub retrieve_invoice { $query = qq|SELECT cp_id, invnumber, transdate AS invdate, duedate, orddate, quodate, globalproject_id, ordnumber, quonumber, paid, taxincluded, notes, taxzone_id, storno, gldate, - intnotes, curr AS currency, direct_debit + intnotes, (SELECT cu.name FROM currencies cu WHERE cu.id=ap.currency_id) AS currency, direct_debit FROM ap WHERE id = ?|; $ref = selectfirst_hashref_query($form, $dbh, $query, conv_i($form->{id})); map { $form->{$_} = $ref->{$_} } keys %$ref; - # remove any trailing whitespace - $form->{currency} =~ s/\s*$//; - $form->{exchangerate} = $form->get_exchangerate($dbh, $form->{currency}, $form->{invdate}, "sell"); # get shipto @@ -1093,21 +1088,19 @@ sub get_vendor { v.id AS vendor_id, v.name AS vendor, v.discount as vendor_discount, v.creditlimit, v.terms, v.notes AS intnotes, v.email, v.cc, v.bcc, v.language_id, v.payment_id, - v.street, v.zipcode, v.city, v.country, v.taxzone_id, v.curr, v.direct_debit, + v.street, v.zipcode, v.city, v.country, v.taxzone_id, cu.name AS curr, v.direct_debit, $duedate + COALESCE(pt.terms_netto, 0) AS duedate, b.description AS business FROM vendor v LEFT JOIN business b ON (b.id = v.business_id) LEFT JOIN payment_terms pt ON (v.payment_id = pt.id) + LEFT JOIN currencies cu ON (v.currency_id = cu.id) WHERE 1=1 $where|; my $ref = selectfirst_hashref_query($form, $dbh, $query, @values); map { $params->{$_} = $ref->{$_} } keys %$ref; - # remove any trailing whitespace - $form->{curr} =~ s/\s*$//; - - # use vendor currency if not empty - $form->{currency} = $form->{curr} if $form->{curr}; + # use vendor currency + $form->{currency} = $form->{curr}; $params->{creditremaining} = $params->{creditlimit}; @@ -1118,7 +1111,7 @@ sub get_vendor { $query = qq|SELECT o.amount, (SELECT e.sell FROM exchangerate e - WHERE (e.curr = o.curr) + WHERE (e.currency_id = o.currency_id) AND (e.transdate = o.transdate)) AS exch FROM oe o WHERE (o.vendor_id = ?) AND (o.quotation = '0') AND (o.closed = '0')|; @@ -1393,9 +1386,10 @@ sub vendor_details { # fax and phone and email as vendor* my $query = qq|SELECT ct.*, cp.*, ct.notes as vendornotes, phone as vendorphone, fax as vendorfax, email as vendoremail, - ct.curr AS currency + cu.name AS currency FROM vendor ct LEFT JOIN contacts cp ON (ct.id = cp.cp_cv_id) + LEFT JOIN currencies cu ON (ct.currency_id = cu.id) WHERE (ct.id = ?) $contact ORDER BY cp.cp_id LIMIT 1|; @@ -1412,8 +1406,6 @@ sub vendor_details { } map { $form->{$_} = $ref->{$_} } keys %$ref; - # remove any trailing whitespace - $form->{currency} =~ s/\s*$// if ($form->{currency}); my $custom_variables = CVar->get_custom_variables('dbh' => $dbh, 'module' => 'CT', diff --git a/SL/IS.pm b/SL/IS.pm index 785cda9db..8f91a2360 100644 --- a/SL/IS.pm +++ b/SL/IS.pm @@ -458,9 +458,10 @@ sub customer_details { my $query = qq|SELECT ct.*, cp.*, ct.notes as customernotes, ct.phone AS customerphone, ct.fax AS customerfax, ct.email AS customeremail, - ct.curr AS currency + cu.name AS currency FROM customer ct LEFT JOIN contacts cp on ct.id = cp.cp_cv_id + LEFT JOIN currencies cu ON (ct.currency_id = cu.id) WHERE (ct.id = ?) $where ORDER BY cp.cp_id LIMIT 1|; @@ -478,9 +479,6 @@ sub customer_details { map { $form->{$_} = $ref->{$_} } keys %$ref; - # remove any trailing whitespace - $form->{currency} =~ s/\s*$// if ($form->{currency}); - if ($form->{delivery_customer_id}) { $query = qq|SELECT *, notes as customernotes @@ -536,6 +534,8 @@ sub post_invoice { } $form->{defaultcurrency} = $form->get_default_currency($myconfig); + my $defaultcurrency = $form->{defaultcurrency}; + # Seit neuestem wird die department_id schon übergeben UND $form->department nicht mehr # korrekt zusammengebaut. Sehr wahrscheinlich beim Umstieg auf T8 kaputt gegangen # Ich lass den Code von 2005 erstmal noch stehen ;-) jb 03-2011 @@ -556,8 +556,8 @@ sub post_invoice { $query = qq|SELECT nextval('glid')|; ($form->{"id"}) = selectrow_query($form, $dbh, $query); - $query = qq|INSERT INTO ar (id, invnumber) VALUES (?, ?)|; - do_query($form, $dbh, $query, $form->{"id"}, $form->{"id"}); + $query = qq|INSERT INTO ar (id, invnumber, currency_id) VALUES (?, ?, (SELECT id FROM currencies WHERE name=?))|; + do_query($form, $dbh, $query, $form->{"id"}, $form->{"id"}, $form->{currency}); if (!$form->{invnumber}) { $form->{invnumber} = @@ -570,9 +570,6 @@ sub post_invoice { my ($netamount, $invoicediff) = (0, 0); my ($amount, $linetotal, $lastincomeaccno); - my ($currencies) = selectfirst_array_query($form, $dbh, qq|SELECT curr FROM defaults|); - my $defaultcurrency = (split m/:/, $currencies)[0]; - if ($form->{currency} eq $defaultcurrency) { $form->{exchangerate} = 1; } else { @@ -1085,7 +1082,8 @@ sub post_invoice { amount = ?, netamount = ?, paid = ?, duedate = ?, deliverydate = ?, invoice = ?, shippingpoint = ?, shipvia = ?, terms = ?, notes = ?, intnotes = ?, - curr = ?, department_id = ?, payment_id = ?, taxincluded = ?, + currency_id = (SELECT id FROM currencies WHERE name = ?), + department_id = ?, payment_id = ?, taxincluded = ?, type = ?, language_id = ?, taxzone_id = ?, shipto_id = ?, employee_id = ?, salesman_id = ?, storno_id = ?, storno = ?, cp_id = ?, marge_total = ?, marge_percent = ?, @@ -1559,8 +1557,7 @@ sub retrieve_invoice { (SELECT c.accno FROM chart c WHERE d.income_accno_id = c.id) AS income_accno, (SELECT c.accno FROM chart c WHERE d.expense_accno_id = c.id) AS expense_accno, (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, - d.curr AS currencies + (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno ${query_transdate} FROM defaults d|; @@ -1579,7 +1576,7 @@ sub retrieve_invoice { a.orddate, a.quodate, a.globalproject_id, a.transdate AS invdate, a.deliverydate, a.paid, a.storno, a.gldate, a.shippingpoint, a.shipvia, a.terms, a.notes, a.intnotes, a.taxzone_id, - a.duedate, a.taxincluded, a.curr AS currency, a.shipto_id, a.cp_id, + a.duedate, a.taxincluded, (SELECT cu.name FROM currencies cu WHERE cu.id=a.currency_id) AS currency, a.shipto_id, a.cp_id, a.employee_id, a.salesman_id, a.payment_id, a.language_id, a.delivery_customer_id, a.delivery_vendor_id, a.type, a.transaction_description, a.donumber, a.invnumber_for_credit_note, @@ -1591,9 +1588,6 @@ sub retrieve_invoice { $ref = selectfirst_hashref_query($form, $dbh, $query, $id); map { $form->{$_} = $ref->{$_} } keys %{ $ref }; - # remove any trailing whitespace - $form->{currency} =~ s/\s*$//; - $form->{exchangerate} = $form->get_exchangerate($dbh, $form->{currency}, $form->{invdate}, "buy"); # get shipto @@ -1758,13 +1752,14 @@ sub get_customer { c.id AS customer_id, c.name AS customer, c.discount as customer_discount, c.creditlimit, c.terms, c.email, c.cc, c.bcc, c.language_id, c.payment_id, c.street, c.zipcode, c.city, c.country, - c.notes AS intnotes, c.klass as customer_klass, c.taxzone_id, c.salesman_id, c.curr, + c.notes AS intnotes, c.klass as customer_klass, c.taxzone_id, c.salesman_id, cu.name AS curr, c.taxincluded_checked, c.direct_debit, $duedate + COALESCE(pt.terms_netto, 0) AS duedate, b.discount AS tradediscount, b.description AS business FROM customer c LEFT JOIN business b ON (b.id = c.business_id) LEFT JOIN payment_terms pt ON ($payment_id (c.payment_id = pt.id)) + LEFT JOIN currencies cu ON (c.currency_id=cu.id) WHERE c.id = ?|; push @values, $cid; $ref = selectfirst_hashref_query($form, $dbh, $query, @values); @@ -1773,11 +1768,8 @@ sub get_customer { map { $form->{$_} = $ref->{$_} } keys %$ref; - # remove any trailing whitespace - $form->{curr} =~ s/\s*$//; - - # use customer currency if not empty - $form->{currency} = $form->{curr} if $form->{curr}; + # use customer currency + $form->{currency} = $form->{curr}; $query = qq|SELECT sum(amount - paid) AS dunning_amount @@ -1806,7 +1798,7 @@ sub get_customer { $query = qq|SELECT o.amount, (SELECT e.buy FROM exchangerate e - WHERE e.curr = o.curr + WHERE e.currency_id = o.currency_id AND e.transdate = o.transdate) FROM oe o WHERE o.customer_id = ? diff --git a/SL/InstanceConfiguration.pm b/SL/InstanceConfiguration.pm index 59d4035a4..d9b7129a7 100644 --- a/SL/InstanceConfiguration.pm +++ b/SL/InstanceConfiguration.pm @@ -15,9 +15,9 @@ sub init { $self->{data} = selectfirst_hashref_query($::form, $::form->get_standard_dbh, qq|SELECT * FROM defaults|); - my $curr = $self->{data}->{curr} || ''; - $curr =~ s/\s+//g; - $self->{currencies} = [ split m/:/, $curr ]; + #To get all currencies and the default currency: + ($self->{data}->{curr}) = selectrow_query($::form, $::form->get_standard_dbh, qq|SELECT name AS curr FROM currencies WHERE id = (SELECT currency_id FROM defaults)|); + $self->{currencies} = [ map { $_->{name} } selectall_hashref_query($::form, $::form->get_standard_dbh, qq|SELECT name FROM currencies ORDER BY id|) ]; return $self; } @@ -25,13 +25,13 @@ sub init { sub get_default_currency { my ($self) = @_; - return ($self->get_currencies)[0]; + return $self->{data}->{curr}; } sub get_currencies { my ($self) = @_; - return $self->{currencies} ? @{ $self->{currencies} } : (); + return @{ $self->{currencies} }; } sub get_accounting_method { diff --git a/SL/MoreCommon.pm b/SL/MoreCommon.pm index dfc5a7d80..41cac3c08 100644 --- a/SL/MoreCommon.pm +++ b/SL/MoreCommon.pm @@ -3,7 +3,7 @@ package SL::MoreCommon; require Exporter; our @ISA = qw(Exporter); -our @EXPORT = qw(save_form restore_form compare_numbers any cross); +our @EXPORT = qw(save_form restore_form compare_numbers cross); our @EXPORT_OK = qw(ary_union ary_intersect ary_diff listify ary_to_hash uri_encode uri_decode); use List::MoreUtils qw(zip); @@ -76,15 +76,6 @@ sub compare_numbers { return $a <=> $b; } -sub any (&@) { - my $f = shift; - return if ! @_; - for (@_) { - return 1 if $f->(); - } - return 0; -} - sub cross(&\@\@) { my $op = shift; use vars qw/@A @B/; diff --git a/SL/OE.pm b/SL/OE.pm index 7302088ae..f18cb0651 100644 --- a/SL/OE.pm +++ b/SL/OE.pm @@ -91,7 +91,7 @@ sub transactions { qq|JOIN $vc ct ON (o.${vc}_id = ct.id) | . qq|LEFT JOIN employee e ON (o.employee_id = e.id) | . qq|LEFT JOIN employee s ON (o.salesman_id = s.id) | . - qq|LEFT JOIN exchangerate ex ON (ex.curr = o.curr | . + qq|LEFT JOIN exchangerate ex ON (ex.currency_id = o.currency_id | . qq| AND ex.transdate = o.transdate) | . qq|LEFT JOIN project pr ON (o.globalproject_id = pr.id) | . qq|$periodic_invoices_joins | . @@ -311,7 +311,7 @@ sub save { $query = qq|SELECT nextval('id')|; ($form->{id}) = selectrow_query($form, $dbh, $query); - $query = qq|INSERT INTO oe (id, ordnumber, employee_id) VALUES (?, '', ?)|; + $query = qq|INSERT INTO oe (id, ordnumber, employee_id, currency_id) VALUES (?, '', ?, (SELECT currency_id FROM defaults))|; do_query($form, $dbh, $query, $form->{id}, $form->{employee_id}); } @@ -494,7 +494,7 @@ sub save { qq|UPDATE oe SET ordnumber = ?, quonumber = ?, cusordnumber = ?, transdate = ?, vendor_id = ?, customer_id = ?, amount = ?, netamount = ?, reqdate = ?, taxincluded = ?, - shippingpoint = ?, shipvia = ?, notes = ?, intnotes = ?, curr = ?, closed = ?, + shippingpoint = ?, shipvia = ?, notes = ?, intnotes = ?, currency_id = (SELECT id FROM currencies WHERE name=?), closed = ?, delivered = ?, proforma = ?, quotation = ?, department_id = ?, language_id = ?, taxzone_id = ?, shipto_id = ?, payment_id = ?, delivery_vendor_id = ?, delivery_customer_id = ?, globalproject_id = ?, employee_id = ?, salesman_id = ?, cp_id = ?, transaction_description = ?, marge_total = ?, marge_percent = ? @@ -506,7 +506,7 @@ sub save { $amount, $netamount, conv_date($reqdate), $form->{taxincluded} ? 't' : 'f', $form->{shippingpoint}, $form->{shipvia}, $form->{notes}, $form->{intnotes}, - substr($form->{currency}, 0, 3), $form->{closed} ? 't' : 'f', + $form->{currency}, $form->{closed} ? 't' : 'f', $form->{delivered} ? "t" : "f", $form->{proforma} ? 't' : 'f', $quotation, conv_i($form->{department_id}), conv_i($form->{language_id}), conv_i($form->{taxzone_id}), @@ -759,14 +759,13 @@ sub retrieve { (SELECT c.accno FROM chart c WHERE d.income_accno_id = c.id) AS income_accno, (SELECT c.accno FROM chart c WHERE d.expense_accno_id = c.id) AS expense_accno, (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, - d.curr AS currencies + (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno $query_add FROM defaults d|; my $ref = selectfirst_hashref_query($form, $dbh, $query); map { $form->{$_} = $ref->{$_} } keys %$ref; - ($form->{currency}) = split(/:/, $form->{currencies}) unless ($form->{currency}); + $form->{currency} = $form->get_default_currency($myconfig); # set reqdate if this is an invoice->order conversion. If someone knows a better check to ensure # we come from invoices, feel free. @@ -785,7 +784,7 @@ sub retrieve { $query = qq|SELECT o.cp_id, o.ordnumber, o.transdate, o.reqdate, o.taxincluded, o.shippingpoint, o.shipvia, o.notes, o.intnotes, - o.curr AS currency, e.name AS employee, o.employee_id, o.salesman_id, + (SELECT cu.name FROM currencies cu WHERE cu.id=o.currency_id) AS currency, e.name AS employee, o.employee_id, o.salesman_id, o.${vc}_id, cv.name AS ${vc}, o.amount AS invtotal, o.closed, o.reqdate, o.quonumber, o.department_id, o.cusordnumber, d.description AS department, o.payment_id, o.language_id, o.taxzone_id, @@ -807,9 +806,6 @@ sub retrieve { if ($ref) { map { $form->{$_} = $ref->{$_} } keys %$ref; - # remove any trailing whitespace - $form->{currency} =~ s/\s*$//; - $form->{saved_xyznumber} = $form->{$form->{type} =~ /_quotation$/ ? "quonumber" : "ordnumber"}; # set all entries for multiple ids blank that yield different information diff --git a/SL/Presenter/Tag.pm b/SL/Presenter/Tag.pm index 9ead2f24a..e5690e79d 100644 --- a/SL/Presenter/Tag.pm +++ b/SL/Presenter/Tag.pm @@ -19,6 +19,15 @@ sub _call_on { return $object->$method(@params); } +{ # This will give you an id for identifying html tags and such. + # It's guaranteed to be unique unless you exceed 10 mio calls per request. + # Do not use these id's to store information across requests. +my $_id_sequence = int rand 1e7; +sub _id { + return ( $_id_sequence = ($_id_sequence + 1) % 1e7 ); +} +} + sub stringify_attributes { my ($self, %params) = @_; @@ -68,6 +77,7 @@ sub man_days_tag { sub name_to_id { my ($self, $name) = @_; + $name =~ s/\[\+?\]/ _id() /ge; # give constructs with [] or [+] unique ids $name =~ s/[^\w_]/_/g; $name =~ s/_+/_/g; diff --git a/SL/RP.pm b/SL/RP.pm index 65cb30295..095f7581c 100644 --- a/SL/RP.pm +++ b/SL/RP.pm @@ -1238,7 +1238,7 @@ sub aging { "duedate", invoice, ${arap}.id, date_part('days', now() - duedate) as overduedays, (SELECT $buysell FROM exchangerate - WHERE (${arap}.curr = exchangerate.curr) + WHERE (${arap}.currency_id = exchangerate.currency_id) AND (exchangerate.transdate = ${arap}.transdate)) AS exchangerate FROM ${arap}, ${ct} WHERE ((paid != amount) OR (datepaid > (date $todate) AND datepaid is not null)) diff --git a/SL/Template/Plugin/L.pm b/SL/Template/Plugin/L.pm index 5ef07b75b..3e157a366 100644 --- a/SL/Template/Plugin/L.pm +++ b/SL/Template/Plugin/L.pm @@ -390,8 +390,10 @@ JAVASCRIPT my $filter = ".filter(function(idx) { return this.substr(0, " . length($params{with}) . ") == '$params{with}'; })"; $filter .= ".map(function(idx, str) { return str.replace('$params{with}_', ''); })"; + my $params_js = $params{params} ? qq| + ($params{params})| : ''; + $stop_event = < on odd and C on even entries. +=item C + +An optional JavaScript string that is evaluated before sending the +POST request. The result must be a string that is appended to the URL. + =back Example: diff --git a/SL/User.pm b/SL/User.pm index 46c35bf41..e11fda4ce 100644 --- a/SL/User.pm +++ b/SL/User.pm @@ -398,6 +398,8 @@ sub dbcreate { do_query($form, $dbh, $query, $form->{profit_determination}); $query = "UPDATE defaults SET inventory_system = ?"; do_query($form, $dbh, $query, $form->{inventory_system}); + $query = "UPDATE defaults SET curr = ?"; + do_query($form, $dbh, $query, $form->{defaultcurrency}); $dbh->disconnect; diff --git a/bin/mozilla/admin.pl b/bin/mozilla/admin.pl index 7f0b80de8..84c8b0699 100755 --- a/bin/mozilla/admin.pl +++ b/bin/mozilla/admin.pl @@ -780,6 +780,7 @@ sub dbcreate { my $locale = $main::locale; $form->isblank("db", $locale->text('Dataset missing!')); + $form->isblank("defaultcurrency", $locale->text('Default currency missing!')); User->dbcreate(\%$form); diff --git a/bin/mozilla/cp.pl b/bin/mozilla/cp.pl index a70c32eeb..b9aed484a 100644 --- a/bin/mozilla/cp.pl +++ b/bin/mozilla/cp.pl @@ -109,10 +109,9 @@ sub payment { # geben und hier reinparsen, oder besser multibox oder html auslagern? # Antwort: form->currency wird mit oldcurrency oder curr[0] überschrieben # Wofür macht das Sinn? - @curr = split(/:/, $form->{currencies}); - chomp $curr[0]; + @curr = $form->get_all_currencies(); $form->{defaultcurrency} = $form->{currency} = $form->{oldcurrency} = - $curr[0]; + $form->get_default_currency(\%myconfig); # Entsprechend präventiv die Auswahlliste für Währungen # auch mit value= zusammenbauen (s.a. oben bugfix 1771) diff --git a/bin/mozilla/ic.pl b/bin/mozilla/ic.pl index 5269d09fc..04257ce97 100644 --- a/bin/mozilla/ic.pl +++ b/bin/mozilla/ic.pl @@ -1489,8 +1489,7 @@ sub link_part { IC->create_links("IC", \%myconfig, \%$form); # currencies - map({ $form->{selectcurrency} .= "