From: Jan Büren Date: Tue, 28 Dec 2010 10:55:57 +0000 (+0100) Subject: Merge branch 'master' of ssh://git-jbueren@lx-office.linet-services.de/~/lx-office-erp X-Git-Tag: release-2.6.2beta1~51^2~9^2~1 X-Git-Url: http://wagnertech.de/git?a=commitdiff_plain;h=6a8787147ad643549eb26cb4f9a373b5b354b8b9;hp=8c6da40329649dd3015da8364e831e0e47155694;p=kivitendo-erp.git Merge branch 'master' of ssh://git-jbueren@lx-office.linet-services.de/~/lx-office-erp --- diff --git a/SL/AccTransCorrections.pm b/SL/AccTransCorrections.pm index ec440f1bb..702cf29c0 100644 --- a/SL/AccTransCorrections.pm +++ b/SL/AccTransCorrections.pm @@ -1,5 +1,6 @@ package AccTransCorrections; +use utf8; use strict; use List::Util qw(first); @@ -129,8 +130,8 @@ sub _prepare_data { delete $entry->{chartlink}; } - # Verknüpfungen zwischen Steuerschlüsseln und zum Zeitpunkt der Transaktion - # gültigen Steuersätze + # Verknüpfungen zwischen Steuerschlüsseln und zum Zeitpunkt der Transaktion + # gültigen Steuersätze my %all_taxes = $self->{taxkeys}->get_full_tax_info('transdate' => $transaction->[0]->{transdate}); my ($trans_type, $previous_non_tax_entry); @@ -184,8 +185,8 @@ sub _prepare_data { } } - # Alle Einträge entfernen, die die Gegenkonten zu Zahlungsein- und - # -ausgängen darstellen. + # Alle Einträge entfernen, die die Gegenkonten zu Zahlungsein- und + # -ausgängen darstellen. foreach my $payment (@{ $data->{payments} }) { my $idx = 0 < $payment->{amount} ? 'debit' : 'credit'; @@ -253,8 +254,8 @@ sub _group_sub_transactions { } # Problemfall: Verkaufsrechnungen, bei denen Buchungen auf Warenbestandskonten -# mit Steuerschlüssel != 0 durchgeführt wurden. Richtig wäre, dass alle -# Steuerschlüssel für solche Warenbestandsbuchungen 0 sind. +# mit Steuerschlüssel != 0 durchgeführt wurden. Richtig wäre, dass alle +# Steuerschlüssel für solche Warenbestandsbuchungen 0 sind. sub _check_trans_invoices_inventory_with_taxkeys { $main::lxdebug->enter_sub(); @@ -289,7 +290,7 @@ sub _check_trans_invoices_inventory_with_taxkeys { } # Problemfall: Verkaufsrechnungen, bei denen Steuern verbucht wurden, obwohl -# kein Steuerschlüssel eingetragen ist. +# kein Steuerschlüssel eingetragen ist. sub _check_missing_taxkeys_in_invoices { $::lxdebug->enter_sub; @@ -331,8 +332,8 @@ sub _check_missing_taxkeys_in_invoices { return $found_broken; } -# Problemfall: Kreditorenbuchungen, bei denen mit Umsatzsteuerschlüsseln -# gebucht wurde und Debitorenbuchungen, bei denen mit Vorsteuerschlüsseln +# Problemfall: Kreditorenbuchungen, bei denen mit Umsatzsteuerschlüsseln +# gebucht wurde und Debitorenbuchungen, bei denen mit Vorsteuerschlüsseln # gebucht wurde. sub _check_trans_ap_ar_wrong_taxkeys { $main::lxdebug->enter_sub(); @@ -360,8 +361,8 @@ sub _check_trans_ap_ar_wrong_taxkeys { } # Problemfall: Splitbuchungen, die mehrere Haben- und Sollkonten ansprechen. -# Aber nur für Debitoren- und Kreditorenbuchungen, weil das bei Einkaufs- und -# Verkaufsrechnungen hingegen völlig normal ist. +# Aber nur für Debitoren- und Kreditorenbuchungen, weil das bei Einkaufs- und +# Verkaufsrechnungen hingegen völlig normal ist. sub _check_trans_split_multiple_credit_and_debit { $main::lxdebug->enter_sub(); @@ -385,7 +386,7 @@ sub _check_trans_split_multiple_credit_and_debit { } # Problemfall: Buchungen, bei denen Steuersummen nicht mit den Summen -# übereinstimmen, die nach ausgewähltem Steuerschlüssel hätten auftreten müssen. +# übereinstimmen, die nach ausgewähltem Steuerschlüssel hätten auftreten müssen. sub _check_trans_wrong_taxkeys { $main::lxdebug->enter_sub(); @@ -510,16 +511,16 @@ sub _check_trans_wrong_taxkeys { return $retval; } -# Inaktiver Code für das Erraten möglicher Verteilungen von -# Steuerschlüsseln. Deaktiviert, weil er exponentiell Zeit -# benötigt. +# Inaktiver Code für das Erraten möglicher Verteilungen von +# Steuerschlüsseln. Deaktiviert, weil er exponentiell Zeit +# benötigt. # if (abs($expected_tax - $data{$side}->{tax_sum}) >= 0.02) { # my @potential_taxkeys = $trans_type eq 'AP' ? (0, 8, 9) : (0, 1, 2, 3); # $main::lxdebug->dump(0, "pota", \@potential_taxkeys); -# # Über alle Kombinationen aus Buchungssätzen und potenziellen Steuerschlüsseln +# # Über alle Kombinationen aus Buchungssätzen und potenziellen Steuerschlüsseln # # iterieren und jeweils die Summe ermitteln. # my $num_entries = scalar @{ $data{$side}->{entries} }; # my @taxkey_indices = (0) x $num_entries; @@ -533,7 +534,7 @@ sub _check_trans_wrong_taxkeys { # while ($num_entries == scalar @taxkey_indices) { # my @tax_cache = (); -# # Berechnen der Steuersumme für die aktuell angenommenen Steuerschlüssel. +# # Berechnen der Steuersumme für die aktuell angenommenen Steuerschlüssel. # my $tax_sum = 0; # foreach my $i (0 .. $num_entries - 1) { # my $taxkey = $potential_taxkeys[$taxkey_indices[$i]]; @@ -543,9 +544,9 @@ sub _check_trans_wrong_taxkeys { # $tax_sum += $tax_cache[$i]; # } -# # Entspricht die Steuersumme mit den aktuell angenommenen Steuerschlüsseln +# # Entspricht die Steuersumme mit den aktuell angenommenen Steuerschlüsseln # # der verbuchten Steuersumme? Wenn ja, dann ist das eine potenzielle -# # Lösung. +# # Lösung. # if (abs($tax_sum - $data{$side}->{tax_sum}) < 0.02) { # push @solutions, { # 'taxkeys' => [ @potential_taxkeys[@taxkey_indices] ], @@ -553,8 +554,8 @@ sub _check_trans_wrong_taxkeys { # } # } -# # Weiterzählen der Steuerschlüsselindices zum Interieren über -# # alle möglichen Kombinationen. +# # Weiterzählen der Steuerschlüsselindices zum Interieren über +# # alle möglichen Kombinationen. # my $i = 0; # while (1) { # $taxkey_indices[$i]++; diff --git a/SL/CA.pm b/SL/CA.pm index 7ef413419..f9dd76d88 100644 --- a/SL/CA.pm +++ b/SL/CA.pm @@ -34,12 +34,13 @@ # #====================================================================== +use utf8; +use strict; + package CA; use Data::Dumper; use SL::DBUtils; -use strict; - sub all_accounts { $main::lxdebug->enter_sub(); @@ -50,16 +51,16 @@ sub all_accounts { # connect to database my $dbh = $form->dbconnect($myconfig); - # bug 1071 Warum sollte bei Erreichen eines neuen Jahres die Kontenübersicht nur noch die + # bug 1071 Warum sollte bei Erreichen eines neuen Jahres die Kontenübersicht nur noch die # bereits bebuchten Konten anzeigen? # Folgende Erweiterung: - # 1.) Gehe zurück bis zu dem Datum an dem die Bücher geschlossen wurden - # 2.) Falls die Bücher noch nie geschlossen wurden, gehe zurück bis zum Bearbeitungsstart + # 1.) Gehe zurück bis zu dem Datum an dem die Bücher geschlossen wurden + # 2.) Falls die Bücher noch nie geschlossen wurden, gehe zurück bis zum Bearbeitungsstart # COALESCE((SELECT closedto FROM defaults),(SELECT itime FROM defaults)) my $closedto_sql = "COALESCE((SELECT closedto FROM defaults),(SELECT itime FROM defaults))"; - if ($form->{method} eq "cash") { # EÜR + if ($form->{method} eq "cash") { # EÜR $acc_cash_where = qq| AND (a.trans_id IN (SELECT id FROM ar WHERE datepaid>= $closedto_sql UNION SELECT id FROM ap WHERE datepaid>= $closedto_sql UNION SELECT id FROM gl WHERE transdate>= $closedto_sql @@ -284,7 +285,7 @@ sub all_transactions { $query = qq|SELECT a.id, a.reference, a.description, ac.transdate, ac.chart_id, | . qq| $false AS invoice, ac.amount, 'gl' as module, | . - qq§(SELECT accno||'--'||rate FROM tax LEFT JOIN chart ON (tax.chart_id=chart.id) WHERE tax.id = (SELECT tax_id FROM taxkeys WHERE taxkey_id = ac.taxkey AND taxkeys.startdate <= ac.transdate ORDER BY taxkeys.startdate DESC LIMIT 1)) AS taxinfo, ac.source || ' ' || ac.memo AS memo § . + qq§(SELECT accno||'--'||rate FROM tax LEFT JOIN chart ON (tax.chart_id=chart.id) WHERE tax.id = (SELECT tax_id FROM taxkeys WHERE taxkey_id = ac.taxkey AND taxkeys.startdate <= ac.transdate ORDER BY taxkeys.startdate DESC LIMIT 1)) AS taxinfo, ac.source || ' ' || ac.memo AS memo § . qq|FROM acc_trans ac, gl a | . $dpt_join . qq|WHERE | . $where . $dpt_where . $project . @@ -296,7 +297,7 @@ sub all_transactions { qq|SELECT a.id, a.invnumber, c.name, ac.transdate, ac.chart_id, | . qq| a.invoice, ac.amount, 'ar' as module, | . - qq§(SELECT accno||'--'||rate FROM tax LEFT JOIN chart ON (tax.chart_id=chart.id) WHERE tax.id = (SELECT tax_id FROM taxkeys WHERE taxkey_id = ac.taxkey AND taxkeys.startdate <= ac.transdate ORDER BY taxkeys.startdate DESC LIMIT 1)) AS taxinfo, ac.source || ' ' || ac.memo AS memo § . + qq§(SELECT accno||'--'||rate FROM tax LEFT JOIN chart ON (tax.chart_id=chart.id) WHERE tax.id = (SELECT tax_id FROM taxkeys WHERE taxkey_id = ac.taxkey AND taxkeys.startdate <= ac.transdate ORDER BY taxkeys.startdate DESC LIMIT 1)) AS taxinfo, ac.source || ' ' || ac.memo AS memo § . qq|FROM acc_trans ac, customer c, ar a | . $dpt_join . qq|WHERE | . $where . $dpt_where . $project . @@ -309,7 +310,7 @@ sub all_transactions { qq|SELECT a.id, a.invnumber, v.name, ac.transdate, ac.chart_id, | . qq| a.invoice, ac.amount, 'ap' as module, | . - qq§(SELECT accno||'--'||rate FROM tax LEFT JOIN chart ON (tax.chart_id=chart.id) WHERE tax.id = (SELECT tax_id FROM taxkeys WHERE taxkey_id = ac.taxkey AND taxkeys.startdate <= ac.transdate ORDER BY taxkeys.startdate DESC LIMIT 1)) AS taxinfo, ac.source || ' ' || ac.memo AS memo § . + qq§(SELECT accno||'--'||rate FROM tax LEFT JOIN chart ON (tax.chart_id=chart.id) WHERE tax.id = (SELECT tax_id FROM taxkeys WHERE taxkey_id = ac.taxkey AND taxkeys.startdate <= ac.transdate ORDER BY taxkeys.startdate DESC LIMIT 1)) AS taxinfo, ac.source || ' ' || ac.memo AS memo § . qq|FROM acc_trans ac, vendor v, ap a | . $dpt_join . qq|WHERE | . $where . $dpt_where . $project . @@ -345,7 +346,7 @@ sub all_transactions { qq|SELECT a.id, a.invnumber, c.name, a.transdate, | . qq| a.invoice, ac.qty * ac.sellprice AS sellprice, 'ar' as module, | . - qq§(SELECT accno||'--'||rate FROM tax LEFT JOIN chart ON (tax.chart_id=chart.id) WHERE tax.id = (SELECT tax_id FROM taxkeys WHERE taxkey_id = ac.taxkey AND taxkeys.startdate <= ac.transdate ORDER BY taxkeys.startdate DESC LIMIT 1)) AS taxinfo § . + qq§(SELECT accno||'--'||rate FROM tax LEFT JOIN chart ON (tax.chart_id=chart.id) WHERE tax.id = (SELECT tax_id FROM taxkeys WHERE taxkey_id = ac.taxkey AND taxkeys.startdate <= ac.transdate ORDER BY taxkeys.startdate DESC LIMIT 1)) AS taxinfo § . qq|FROM ar a | . qq|JOIN invoice ac ON (ac.trans_id = a.id) | . qq|JOIN parts p ON (ac.parts_id = p.id) | . @@ -360,7 +361,7 @@ sub all_transactions { qq|SELECT a.id, a.invnumber, v.name, a.transdate, | . qq| a.invoice, ac.qty * ac.sellprice AS sellprice, 'ap' as module, | . - qq§(SELECT accno||'--'||rate FROM tax LEFT JOIN chart ON (tax.chart_id=chart.id) WHERE tax.id = (SELECT tax_id FROM taxkeys WHERE taxkey_id = ac.taxkey AND taxkeys.startdate <= ac.transdate ORDER BY taxkeys.startdate DESC LIMIT 1)) AS taxinfo § . + qq§(SELECT accno||'--'||rate FROM tax LEFT JOIN chart ON (tax.chart_id=chart.id) WHERE tax.id = (SELECT tax_id FROM taxkeys WHERE taxkey_id = ac.taxkey AND taxkeys.startdate <= ac.transdate ORDER BY taxkeys.startdate DESC LIMIT 1)) AS taxinfo § . qq|FROM ap a | . qq|JOIN invoice ac ON (ac.trans_id = a.id) | . qq|JOIN parts p ON (ac.parts_id = p.id) | . diff --git a/SL/Common.pm b/SL/Common.pm index fae93413b..e7bed372b 100644 --- a/SL/Common.pm +++ b/SL/Common.pm @@ -8,6 +8,9 @@ package Common; +use utf8; +use strict; + use Time::HiRes qw(gettimeofday); use Data::Dumper; @@ -15,8 +18,6 @@ use SL::DBUtils; use vars qw(@db_encodings %db_encoding_to_charset %charset_to_db_encoding); -use strict; - @db_encodings = ( { "label" => "ASCII", "dbencoding" => "SQL_ASCII", "charset" => "ASCII" }, { "label" => "UTF-8 Unicode", "dbencoding" => "UNICODE", "charset" => "UTF-8" }, @@ -286,8 +287,9 @@ sub retrieve_vendor { my $query = qq!SELECT id, name, customernumber, (street || ', ' || zipcode || city) AS address FROM customer ! . - qq!WHERE $filter business_id = (SELECT id FROM business WHERE description = 'Händler') ! . + qq!WHERE $filter business_id = (SELECT id FROM business WHERE description = ?') ! . qq!ORDER BY $order_by $order_dir!; + push @filter_values, $::locale->{iconv_utf8}->convert('Händler'); my $sth = $dbh->prepare($query); $sth->execute(@filter_values) || $form->dberror($query . " (" . join(", ", @filter_values) . ")"); @@ -373,7 +375,7 @@ sub webdav_folder { my $base_path = substr($ENV{'SCRIPT_NAME'}, 1); $base_path =~ s|[^/]+$||; $base_path =~ s|/$||; - # wo kommt der wert für dir her? es wird doch gar nichts übergeben? fix für strict my $dir jb 21.2. + # wo kommt der wert für dir her? es wird doch gar nichts übergeben? fix für strict my $dir jb 21.2. if (opendir my $dir, $path) { foreach my $file (sort { lc $a cmp lc $b } readdir $dir) { next if (($file eq '.') || ($file eq '..')); diff --git a/SL/DATEV.pm b/SL/DATEV.pm index eacda097d..508ed958d 100644 --- a/SL/DATEV.pm +++ b/SL/DATEV.pm @@ -26,7 +26,8 @@ package DATEV; -use List::Util qw(max); +use utf8; +use strict; use SL::DBUtils; use SL::DATEV::KNEFile; @@ -34,10 +35,9 @@ use SL::Taxkeys; use Data::Dumper; use File::Path; +use List::Util qw(max); use Time::HiRes qw(gettimeofday); -use strict; - sub _get_export_path { $main::lxdebug->enter_sub(); @@ -386,6 +386,7 @@ sub _get_transactions { ORDER BY trans_id, acc_trans_id|; my $sth = prepare_execute_query($form, $dbh, $query); + $form->{DATEV} = []; my $counter = 0; while (my $ref = $sth->fetchrow_hashref("NAME_lc")) { @@ -776,14 +777,14 @@ sub kne_buchungsexport { my $taxkey = 0; my $charttax = 0; my ($haben, $soll); - my $iconv = $main::locale->{iconv_iso8859}; - my %umlaute = ($iconv->convert('ä') => 'ae', - $iconv->convert('ö') => 'oe', - $iconv->convert('ü') => 'ue', - $iconv->convert('Ä') => 'Ae', - $iconv->convert('Ö') => 'Oe', - $iconv->convert('Ü') => 'Ue', - $iconv->convert('ß') => 'sz'); + my $iconv = $::locale->{iconv_utf8}; + my %umlaute = ($iconv->convert('ä') => 'ae', + $iconv->convert('ö') => 'oe', + $iconv->convert('ü') => 'ue', + $iconv->convert('Ä') => 'Ae', + $iconv->convert('Ö') => 'Oe', + $iconv->convert('Ü') => 'Ue', + $iconv->convert('ß') => 'sz'); for (my $i = 0; $i < $trans_lines; $i++) { if ($trans_lines == 2) { if (abs($transaction->[$i]->{'amount'}) > abs($umsatz)) { diff --git a/SL/DB/Helpers/Mappings.pm b/SL/DB/Helpers/Mappings.pm index fe7dc86b9..48c486307 100644 --- a/SL/DB/Helpers/Mappings.pm +++ b/SL/DB/Helpers/Mappings.pm @@ -1,5 +1,6 @@ package SL::DB::Helpers::Mappings; +use utf8; use strict; # these will not be managed as Rose::DB models, because they are not normalized, @@ -181,6 +182,6 @@ L =head1 AUTHOR -Sven Schöling +Sven Schöling =cut diff --git a/SL/DB/Order.pm b/SL/DB/Order.pm index 2dd29c33a..739581432 100644 --- a/SL/DB/Order.pm +++ b/SL/DB/Order.pm @@ -1,5 +1,6 @@ package SL::DB::Order; +use utf8; use strict; use SL::RecordLinks; @@ -98,6 +99,6 @@ Nothing here yet. =head1 AUTHOR - Sven Schöling +Sven Schöling =cut diff --git a/SL/DN.pm b/SL/DN.pm index 72154c24f..45bc367eb 100644 --- a/SL/DN.pm +++ b/SL/DN.pm @@ -288,7 +288,7 @@ sub save_dunning { (SELECT SUM(fee) FROM dunning_config WHERE dunning_level <= (SELECT dunning_level FROM dunning_config WHERE id = ?)), - (SELECT (amount - paid) * (current_date - transdate) FROM ar WHERE id = ?) + (SELECT (amount - paid) * (current_date - duedate) FROM ar WHERE id = ?) * (SELECT interest_rate FROM dunning_config WHERE id = ?) / 360, current_date, diff --git a/SL/InstallationCheck.pm b/SL/InstallationCheck.pm index d8d058bc5..15db0cb70 100644 --- a/SL/InstallationCheck.pm +++ b/SL/InstallationCheck.pm @@ -18,7 +18,6 @@ BEGIN { { name => "DBD::Pg", version => '1.49', url => "http://search.cpan.org/~dbdpg/" }, { name => "Email::Address", url => "http://search.cpan.org/~rjbs/" }, { name => "FCGI", url => "http://search.cpan.org/~mstrout/" }, - { name => "IO::Wrap", version => '2.110', url => "http://search.cpan.org/~dskoll/" }, { name => "List::MoreUtils", version => '0.21', url => "http://search.cpan.org/~vparseval/" }, { name => "PDF::API2", version => '2.000', url => "http://search.cpan.org/~areibens/" }, { name => "Template", version => '2.18', url => "http://search.cpan.org/~abw/" }, diff --git a/SL/Locale.pm b/SL/Locale.pm index 4fde61654..1f0c9f33d 100644 --- a/SL/Locale.pm +++ b/SL/Locale.pm @@ -109,6 +109,7 @@ sub _init { $self->{iconv_english} = SL::Iconv->new('ASCII', $db_charset); $self->{iconv_iso8859} = SL::Iconv->new('ISO-8859-15', $db_charset); $self->{iconv_to_iso8859} = SL::Iconv->new($db_charset, 'ISO-8859-15'); + $self->{iconv_utf8} = SL::Iconv->new('UTF-8', $db_charset); $self->_read_special_chars_file($country); @@ -480,4 +481,19 @@ sub with_raw_io { $self->{raw_io_active} = 0; } +sub set_numberformat_wo_thousands_separator { + my $self = shift; + my $myconfig = shift || \%::myconfig; + + $self->{saved_numberformat} = $myconfig->{numberformat}; + $myconfig->{numberformat} =~ s/^1[,\.]/1/; +} + +sub restore_numberformat { + my $self = shift; + my $myconfig = shift || \%::myconfig; + + $myconfig->{numberformat} = $self->{saved_numberformat} if $self->{saved_numberformat}; +} + 1; diff --git a/SL/RP.pm b/SL/RP.pm index 99595c166..41cd39041 100644 --- a/SL/RP.pm +++ b/SL/RP.pm @@ -49,12 +49,21 @@ use strict; # - subdescription # - proper testing for heading charts # - transmission from $form to TMPL realm is not as clear as i'd like + +sub get_openbalance_date { + my ($closedto, $target) = map { $::locale->parse_date_to_object(\%::myconfig, $_) } @_; + + $closedto->subtract(years => 1) while ($target - $closedto)->is_negative; + $closedto->add(days => 1); + return $::locale->format_date(\%::myconfig, $closedto); +} + sub balance_sheet { $main::lxdebug->enter_sub(); my $myconfig = \%main::myconfig; my $form = $main::form; - my $dbh = $form->get_standard_dbh($myconfig); + my $dbh = $::form->get_standard_dbh; my $last_period = 0; my @categories = qw(A C L Q); @@ -64,12 +73,21 @@ sub balance_sheet { $form->{period} = $form->{this_period} = conv_dateq($form->{asofdate}); } - get_accounts($dbh, $last_period, "", $form->{asofdate}, $form, \@categories); + # get end of financial year and convert to Date format + my ($closedto) = selectfirst_arrayref_query($form, $dbh, 'SELECT closedto FROM defaults'); + + # get date of last opening balance + my $startdate = get_openbalance_date($closedto, $form->{asofdate}); + + get_accounts($dbh, $last_period, $startdate, $form->{asofdate}, $form, \@categories); # if there are any compare dates if ($form->{compareasofdate}) { $last_period = 1; - get_accounts($dbh, $last_period, "", $form->{compareasofdate}, $form, \@categories); + + $startdate = get_openbalance_date($closedto, $form->{compareasofdate}); + + get_accounts($dbh, $last_period, $startdate, $form->{compareasofdate}, $form, \@categories); $form->{last_period} = conv_dateq($form->{compareasofdate}); } @@ -118,7 +136,6 @@ sub balance_sheet { next if ($period eq 'last' && !$last_period); # only add assets $row->{$period} *= $ml; - $form->{total}{$category}{$period} += $row->{$period}; # if ($row->{charttype} eq 'A') { # why?? } push @{ $TMPL_DATA->{$category} }, $row; @@ -138,12 +155,11 @@ sub balance_sheet { for my $period (qw(this last)) { next if ($period eq 'last' && !$last_period); - $form->{E}{$period} = $form->{total}{A}{$period} - $form->{total}{L}{$period} - $form->{total}{Q}{$period}; - $form->{total}{Q}{$period} += $form->{E}{$period}; - $TMPL_DATA->{total}{Q}{$period} = $form->{total}{Q}{$period}; - $TMPL_DATA->{total}{$period} = $form->{total}{L}{$period} + $form->{total}{Q}{$period}; + $form->{E}{$period} = $TMPL_DATA->{total}{A}{$period} - $TMPL_DATA->{total}{L}{$period} - $TMPL_DATA->{total}{Q}{$period}; + $TMPL_DATA->{total}{Q}{$period} += $form->{E}{$period}; + $TMPL_DATA->{total}{$period} = $TMPL_DATA->{total}{L}{$period} + $TMPL_DATA->{total}{Q}{$period}; } - + $form->{E}{description}='nicht verbuchter Gewinn/Verlust'; push @{ $TMPL_DATA->{Q} }, $form->{E}; $main::lxdebug->leave_sub(); @@ -1186,11 +1202,11 @@ sub aging { if ($form->{review_of_aging_list}) { if ($form->{review_of_aging_list} =~ m "-"){ my @period = split(/-/, $form->{review_of_aging_list}); - $review_of_aging_list = " AND $period[0] < date_part('days', now() - duedate) + $review_of_aging_list = " AND $period[0] < date_part('days', now() - duedate) AND date_part('days', now() - duedate) < $period[1]"; } else { $form->{review_of_aging_list} =~ s/[^0-9]//g; - $review_of_aging_list = " AND $form->{review_of_aging_list} < date_part('days', now() - duedate)"; + $review_of_aging_list = " AND $form->{review_of_aging_list} < date_part('days', now() - duedate)"; } } diff --git a/SL/RecordLinks.pm b/SL/RecordLinks.pm index 54a068357..cef2c4df0 100644 --- a/SL/RecordLinks.pm +++ b/SL/RecordLinks.pm @@ -1,12 +1,13 @@ package RecordLinks; +use utf8; +use strict; + use SL::Common; use SL::DBUtils; use Data::Dumper; use List::Util qw(reduce); -use strict; - sub create_links { $main::lxdebug->enter_sub(); @@ -243,8 +244,8 @@ SL::RecordLinks - Verlinkung von Lx-Office Objekten. Transitive RecordLinks mit get_links_via. -get_links_via erwartet den zusätzlichen parameter via. via ist ein -hashref mit den jeweils optionalen Einträgen table und id, die sich +get_links_via erwartet den zusätzlichen parameter via. via ist ein +hashref mit den jeweils optionalen Einträgen table und id, die sich genauso verhalten wie die from/to_table/id werte der get_links funktion. Alternativ kann via auch ein Array dieser Hashes sein: @@ -267,9 +268,9 @@ Alternativ kann via auch ein Array dieser Hashes sein: ], ) -Die Einträge in einem via-Array werden exakt in dieser Reihenfolge -benutzt und sind nicht optional. Da obige Beispiel würde also die -Verknüpfung: +Die Einträge in einem via-Array werden exakt in dieser Reihenfolge +benutzt und sind nicht optional. Da obige Beispiel würde also die +Verknüpfung: oe:11 -> ar:12 -> is:13 -> do:14 diff --git a/SL/ReportGenerator.pm b/SL/ReportGenerator.pm index f02f56875..2b37e78f5 100644 --- a/SL/ReportGenerator.pm +++ b/SL/ReportGenerator.pm @@ -1,7 +1,6 @@ package SL::ReportGenerator; use Data::Dumper; -use IO::Wrap; use List::Util qw(max); use Text::CSV_XS; #use PDF::API2; # these two eat up to .75s on startup. only load them if we actually need them @@ -688,11 +687,10 @@ sub _print_content { } sub unescape_string { - my $self = shift; - my $text = shift; + my ($self, $text, $do_iconv) = @_; - $text = $main::locale->unquote_special_chars('HTML', $text); - $text = $::locale->{iconv}->convert($text); + $text = $main::locale->unquote_special_chars('HTML', $text); + $text = $::locale->{iconv}->convert($text) if $do_iconv; return $text; } @@ -718,12 +716,15 @@ sub generate_csv_content { 'quote_char' => $quote_char, 'eol' => $eol, }); - my $stdout = wraphandle(\*STDOUT); my @visible_columns = $self->get_visible_columns('CSV'); + my $stdout; + open $stdout, '>-'; + binmode $stdout, ':encoding(utf8)' if $::locale->is_utf8; + if ($opts->{headers}) { if (!$self->{custom_headers}) { - $csv->print($stdout, [ map { $self->unescape_string($self->{columns}->{$_}->{text}) } @visible_columns ]); + $csv->print($stdout, [ map { $self->unescape_string($self->{columns}->{$_}->{text}, 1) } @visible_columns ]); } else { foreach my $row (@{ $self->{custom_headers} }) { diff --git a/SL/Template/LaTeX.pm b/SL/Template/LaTeX.pm index 4bfef01f7..d1c208018 100644 --- a/SL/Template/LaTeX.pm +++ b/SL/Template/LaTeX.pm @@ -4,6 +4,8 @@ use parent qw(SL::Template::Simple); use strict; +use Cwd; + sub new { my $type = shift; @@ -290,11 +292,12 @@ sub _force_mandatory_packages { my $self = shift; my $lines = shift; - my (%used_packages, $document_start_line); + my (%used_packages, $document_start_line, $last_usepackage_line); foreach my $i (0 .. scalar @{ $lines } - 1) { if ($lines->[$i] =~ m/\\usepackage[^\{]*{(.*?)}/) { $used_packages{$1} = 1; + $last_usepackage_line = $i; } elsif ($lines->[$i] =~ m/\\begin{document}/) { $document_start_line = $i; @@ -303,11 +306,14 @@ sub _force_mandatory_packages { } } - $document_start_line = scalar @{ $lines } - 1 if (!defined $document_start_line); + my $insertion_point = defined($document_start_line) ? $document_start_line + : defined($last_usepackage_line) ? $last_usepackage_line + : scalar @{ $lines } - 1; - if (!$used_packages{textcomp}) { - splice @{ $lines }, $document_start_line, 0, "\\usepackage{textcomp}\n"; - $document_start_line++; + foreach my $package (qw(textcomp)) { + next if $used_packages{$package}; + splice @{ $lines }, $insertion_point, 0, "\\usepackage{${package}}\n"; + $insertion_point++; } } @@ -374,11 +380,14 @@ sub convert_to_postscript { $form->{tmpfile} =~ s/\Q$userspath\E\///g; my $latex = $self->_get_latex_path(); + my $old_home = $ENV{HOME}; + $ENV{HOME} = $userspath =~ m|^/| ? $userspath : getcwd() . "/" . $userspath; for (my $run = 1; $run <= 2; $run++) { system("${latex} --interaction=nonstopmode $form->{tmpfile} " . "> $form->{tmpfile}.err"); if ($?) { + $ENV{HOME} = $old_home; $self->{"error"} = $form->cleanup(); $self->cleanup(); return 0; @@ -388,6 +397,8 @@ sub convert_to_postscript { $form->{tmpfile} =~ s/tex$/dvi/; system("dvips $form->{tmpfile} -o -q > /dev/null"); + $ENV{HOME} = $old_home; + if ($?) { $self->{"error"} = "dvips : $!"; $self->cleanup(); @@ -415,17 +426,21 @@ sub convert_to_pdf { $form->{tmpfile} =~ s/\Q$userspath\E\///g; my $latex = $self->_get_latex_path(); + my $old_home = $ENV{HOME}; + $ENV{HOME} = $userspath =~ m|^/| ? $userspath : getcwd() . "/" . $userspath; for (my $run = 1; $run <= 2; $run++) { system("${latex} --interaction=nonstopmode $form->{tmpfile} " . "> $form->{tmpfile}.err"); if ($?) { + $ENV{HOME} = $old_home; $self->{"error"} = $form->cleanup(); $self->cleanup(); return 0; } } + $ENV{HOME} = $old_home; $form->{tmpfile} =~ s/tex$/pdf/; $self->cleanup(); diff --git a/SL/Template/Plugin/JavaScript.pm b/SL/Template/Plugin/JavaScript.pm index 01e5104fa..241ea0ea3 100644 --- a/SL/Template/Plugin/JavaScript.pm +++ b/SL/Template/Plugin/JavaScript.pm @@ -6,21 +6,139 @@ use Template::Plugin; use strict; sub new { - my $class = shift; - my $context = shift; + my ($class, $context, @args) = @_; - bless { }, $class; + return bless { + CONTEXT => $context, + }, $class; } +# +# public interface +# + sub escape { my $self = shift; my $text = shift; + $text =~ s|\\|\\\\|g; $text =~ s|\"|\\\"|g; + $text =~ s|\n|\\n|g; return $text; } +sub replace_with { + return _replace_helper('replaceWith', @_); +} + +sub replace_html_with { + return _replace_helper('html', @_); +} + +# +# private methods +# + +sub _context { + die 'not an accessor' if @_ > 1; + return $_[0]->{CONTEXT}; +} + +sub _replace_helper { + my ($method, $self, $selector, $template, $locals) = @_; + + $template .= '.html' unless $template =~ m/\.html$/; + my $html = $self->escape($self->_context->process($template, %{ $locals || { } })); + my $code = < + +Returns C<$value> escaped for inclusion in a JavaScript string. The +value is not wrapped in quotes. Example: + + + +=item C + +Returns code replacing the DOM elements matched by C<$selector> with +the content rendered by Template's I directive applied to +C<$template>. C<%locals> are passed as local parameters to I. + +Uses jQuery's C function. Requires jQuery to be loaded. + +Example: + +
TODO:
+
    +
  • First item
    • +
  • Second item
    • +
  • Another item
    • +
+ + + + + +=item C + +Returns code replacing the inner HTML of the DOM elements matched by +C<$selector> with the content rendered by Template's I +directive applied to C<$template>. C<%locals> are passed as local +parameters to I. + +Uses jQuery's C function. Requires jQuery to be loaded. + +
TODO:
+
    +
  • First item
    • +
  • Second item
    • +
  • Another item
    • +
+ + + + + +=back + +=head1 BUGS + +Nothing here yet. + +=head1 AUTHOR + +Moritz Bunkus Em.bunkus@linet-services.deE + +=cut diff --git a/SL/Template/Plugin/L.pm b/SL/Template/Plugin/L.pm index d1ecdbd8c..9995722e1 100644 --- a/SL/Template/Plugin/L.pm +++ b/SL/Template/Plugin/L.pm @@ -2,6 +2,8 @@ package SL::Template::Plugin::L; use base qw( Template::Plugin ); use Template::Plugin; +use List::MoreUtils qw(apply); +use List::Util qw(max); use strict; @@ -19,15 +21,27 @@ sub _H { return $::locale->quote_special_chars('HTML', $string); } +sub _J { + my $string = "" . shift; + $string =~ s/\"/\\\"/g; + return $string; +} + sub _hashify { return (@_ && (ref($_[0]) eq 'HASH')) ? %{ $_[0] } : @_; } sub new { - my $class = shift; - my $context = shift; + my ($class, $context, @args) = @_; + + return bless { + CONTEXT => $context, + }, $class; +} - return bless { }, $class; +sub _context { + die 'not an accessor' if @_ > 1; + return $_[0]->{CONTEXT}; } sub name_to_id { @@ -41,13 +55,14 @@ sub name_to_id { } sub attributes { - my $self = shift; - my %options = _hashify(@_); + my ($self, @slurp) = @_; + my %options = _hashify(@slurp); my @result = (); while (my ($name, $value) = each %options) { next unless $name; - $value ||= ''; + next if $name eq 'disabled' && !$value; + $value = '' if !defined($value); push @result, _H($name) . '="' . _H($value) . '"'; } @@ -55,12 +70,10 @@ sub attributes { } sub html_tag { - my $self = shift; - my $tag = shift; - my $content = shift; - my $attributes = $self->attributes(@_); + my ($self, $tag, $content, @slurp) = @_; + my $attributes = $self->attributes(@slurp); - return "<${tag}${attributes}/>" unless $content; + return "<${tag}${attributes}/>" unless defined($content); return "<${tag}${attributes}>${content}"; } @@ -71,17 +84,48 @@ sub select_tag { my %attributes = _hashify(@_); $attributes{id} ||= $self->name_to_id($name); + $options_str = $self->options_for_select($options_str) if ref $options_str; return $self->html_tag('select', $options_str, %attributes, name => $name); } +sub textarea_tag { + my ($self, $name, $content, @slurp) = @_; + my %attributes = _hashify(@slurp); + + $attributes{id} ||= $self->name_to_id($name); + $content = $content ? _H($content) : ''; + + return $self->html_tag('textarea', $content, %attributes, name => $name); +} + sub checkbox_tag { + my ($self, $name, @slurp) = @_; + my %attributes = _hashify(@slurp); + + $attributes{id} ||= $self->name_to_id($name); + $attributes{value} = 1 unless defined $attributes{value}; + my $label = delete $attributes{label}; + + if ($attributes{checked}) { + $attributes{checked} = 'checked'; + } else { + delete $attributes{checked}; + } + + my $code = $self->html_tag('input', undef, %attributes, name => $name, type => 'checkbox'); + $code .= $self->html_tag('label', $label, for => $attributes{id}) if $label; + + return $code; +} + +sub radio_button_tag { my $self = shift; my $name = shift; my %attributes = _hashify(@_); - $attributes{id} ||= $self->name_to_id($name); $attributes{value} = 1 unless defined $attributes{value}; + $attributes{id} ||= $self->name_to_id($name . "_" . $attributes{value}); my $label = delete $attributes{label}; if ($attributes{checked}) { @@ -90,17 +134,15 @@ sub checkbox_tag { delete $attributes{checked}; } - my $code = $self->html_tag('input', undef, %attributes, name => $name, type => 'checkbox'); + my $code = $self->html_tag('input', undef, %attributes, name => $name, type => 'radio'); $code .= $self->html_tag('label', $label, for => $attributes{id}) if $label; return $code; } sub input_tag { - my $self = shift; - my $name = shift; - my $value = shift; - my %attributes = _hashify(@_); + my ($self, $name, $value, @slurp) = @_; + my %attributes = _hashify(@slurp); $attributes{id} ||= $self->name_to_id($name); $attributes{type} ||= 'text'; @@ -108,32 +150,88 @@ sub input_tag { return $self->html_tag('input', undef, %attributes, name => $name, value => $value); } +sub hidden_tag { + return shift->input_tag(@_, type => 'hidden'); +} + +sub div_tag { + my ($self, $content, @slurp) = @_; + return $self->html_tag('div', $content, @slurp); +} + +sub ul_tag { + my ($self, $content, @slurp) = @_; + return $self->html_tag('ul', $content, @slurp); +} + +sub li_tag { + my ($self, $content, @slurp) = @_; + return $self->html_tag('li', $content, @slurp); +} + +sub link { + my ($self, $href, $content, @slurp) = @_; + my %params = _hashify(@slurp); + + $href ||= '#'; + + return $self->html_tag('a', $content, %params, href => $href); +} + +sub submit_tag { + my ($self, $name, $value, @slurp) = @_; + my %attributes = _hashify(@slurp); + + $attributes{onclick} = "if (confirm('" . delete($attributes{confirm}) . "')) return true; else return false;" if $attributes{confirm}; + + return $self->input_tag($name, $value, %attributes, type => 'submit', class => 'submit'); +} + +sub button_tag { + my ($self, $onclick, $value, @slurp) = @_; + my %attributes = _hashify(@slurp); + + return $self->input_tag(undef, $value, %attributes, type => 'button', onclick => $onclick); +} + sub options_for_select { - my $self = shift; - my $collection = shift; - my %options = _hashify(@_); + my $self = shift; + my $collection = shift; + my %options = _hashify(@_); - my $value_key = $options{value} || 'id'; - my $title_key = $options{title} || $value_key; + my $value_key = $options{value} || 'id'; + my $title_key = $options{title} || $value_key; - my @elements = (); - push @elements, [ undef, $options{empty_title} || '' ] if $options{with_empty}; + my $value_sub = $options{value_sub}; + my $title_sub = $options{title_sub}; - if ($collection && (ref $collection eq 'ARRAY')) { - foreach my $element (@{ $collection }) { - my @result = !ref $element ? ( $element, $element ) - : ref $element eq 'ARRAY' ? ( $element->[0], $element->[1] ) - : ref $element eq 'HASH' ? ( $element->{$value_key}, $element->{$title_key} ) - : ( $element->$value_key, $element->$title_key ); + my $value_title_sub = $options{value_title_sub}; - push @elements, \@result; - } - } + my %selected = map { ( $_ => 1 ) } @{ ref($options{default}) eq 'ARRAY' ? $options{default} : $options{default} ? [ $options{default} ] : [] }; + + my $access = sub { + my ($element, $index, $key, $sub) = @_; + my $ref = ref $element; + return $sub ? $sub->($element) + : !$ref ? $element + : $ref eq 'ARRAY' ? $element->[$index] + : $ref eq 'HASH' ? $element->{$key} + : $element->$key; + }; + + my @elements = (); + push @elements, [ undef, $options{empty_title} || '' ] if $options{with_empty}; + push @elements, map [ + $value_title_sub ? $value_title_sub->($_) : ( + $access->($_, 0, $value_key, $value_sub), + $access->($_, 1, $title_key, $title_sub), + ) + ], @{ $collection } if $collection && ref $collection eq 'ARRAY'; my $code = ''; foreach my $result (@elements) { my %attributes = ( value => $result->[0] ); - $attributes{selected} = 'selected' if $options{default} && ($options{default} eq ($result->[0] || '')); + $attributes{selected} = 'selected' if $selected{ $result->[0] || '' }; $code .= $self->html_tag('option', _H($result->[1]), %attributes); } @@ -146,15 +244,35 @@ sub javascript { return $self->html_tag('script', $data, type => 'text/javascript'); } +sub stylesheet_tag { + my $self = shift; + my $code = ''; + + foreach my $file (@_) { + $file .= '.css' unless $file =~ m/\.css$/; + $file = "css/${file}" unless $file =~ m|/|; + + $code .= qq||; + } + + return $code; +} + sub date_tag { my ($self, $name, $value, @slurp) = @_; my %params = _hashify(@slurp); my $name_e = _H($name); my $seq = _tag_id(); + my $datefmt = apply { + s/d+/\%d/gi; + s/m+/\%m/gi; + s/y+/\%Y/gi; + } $::myconfig{"dateformat"}; $params{cal_align} ||= 'BR'; $self->input_tag($name, $value, + id => $name_e, size => 11, title => _H($::myconfig{dateformat}), onBlur => 'check_right_date_format(this)', @@ -167,10 +285,123 @@ sub date_tag { %params, ) . $self->javascript( - "Calendar.setup({ inputField: '$name_e', ifFormat: '$::myconfig{jsc_dateformat}', align: '$params{cal_align}', button: 'trigger$seq' });" + "Calendar.setup({ inputField: '$name_e', ifFormat: '$datefmt', align: '$params{cal_align}', button: 'trigger$seq' });" ) : ''); } +sub javascript_tag { + my $self = shift; + my $code = ''; + + foreach my $file (@_) { + $file .= '.js' unless $file =~ m/\.js$/; + $file = "js/${file}" unless $file =~ m|/|; + + $code .= qq||; + } + + return $code; +} + +sub tabbed { + my ($self, $tabs, @slurp) = @_; + my %params = _hashify(@slurp); + my $id = $params{id} || 'tab_' . _tag_id(); + + $params{selected} *= 1; + + die 'L.tabbed needs an arrayred of tabs for first argument' + unless ref $tabs eq 'ARRAY'; + + my (@header, @blocks); + for my $i (0..$#$tabs) { + my $tab = $tabs->[$i]; + + next if $tab eq ''; + + my $selected = $params{selected} == $i; + my $tab_id = "__tab_id_$i"; + push @header, $self->li_tag( + $self->link('', $tab->{name}, rel => $tab_id), + ($selected ? (class => 'selected') : ()) + ); + push @blocks, $self->div_tag($tab->{data}, + id => $tab_id, class => 'tabcontent'); + } + + return '' unless @header; + return $self->ul_tag( + join('', @header), id => $id, class => 'shadetabs' + ) . + $self->div_tag( + join('', @blocks), class => 'tabcontentstyle' + ) . + $self->javascript( + qq|var $id = new ddtabcontent("$id");$id.setpersist(true);| . + qq|$id.setselectedClassTarget("link");$id.init();| + ); +} + +sub tab { + my ($self, $name, $src, @slurp) = @_; + my %params = _hashify(@slurp); + + $params{method} ||= 'process'; + + return () if defined $params{if} && !$params{if}; + + my $data; + if ($params{method} eq 'raw') { + $data = $src; + } elsif ($params{method} eq 'process') { + $data = $self->_context->process($src, %{ $params{args} || {} }); + } else { + die "unknown tag method '$params{method}'"; + } + + return () unless $data; + + return +{ name => $name, data => $data }; +} + +sub areainput_tag { + my ($self, $name, $value, @slurp) = @_; + my %attributes = _hashify(@slurp); + + my $rows = delete $attributes{rows} || 1; + my $min = delete $attributes{min_rows} || 1; + + return $rows > 1 + ? $self->textarea_tag($name, $value, %attributes, rows => max $rows, $min) + : $self->input_tag($name, $value, %attributes); +} + +sub multiselect2side { + my ($self, $id, @slurp) = @_; + my %params = _hashify(@slurp); + + $params{labelsx} = "\"" . _J($params{labelsx} || $::locale->text('Available')) . "\""; + $params{labeldx} = "\"" . _J($params{labeldx} || $::locale->text('Selected')) . "\""; + $params{moveOptions} = 'false'; + + my $vars = join(', ', map { "${_}: " . $params{$_} } keys %params); + my $code = < + \$().ready(function() { + \$('#${id}').multiselect2side({ ${vars} }); + }); + +EOCODE + + return $code; +} + +sub dump { + my $self = shift; + require Data::Dumper; + return '
' . Data::Dumper::Dumper(@_) . '
'; +} + 1; __END__ @@ -233,8 +464,10 @@ Creates a HTML 'select' tag named C<$name> with the contents C<$options_string> and with arbitrary HTML attributes from C<%attributes>. The tag's C defaults to C. -The $options_string is usually created by the C -function. +The C<$options_string> is usually created by the +L function. If C<$options_string> is an array +reference then it will be passed to L +automatically. =item C @@ -242,6 +475,29 @@ Creates a HTML 'input type=text' tag named C<$name> with the value C<$value> and with arbitrary HTML attributes from C<%attributes>. The tag's C defaults to C. +=item C + +Creates a HTML 'input type=hidden' tag named C<$name> with the value +C<$value> and with arbitrary HTML attributes from C<%attributes>. The +tag's C defaults to C. + +=item C + +Creates a HTML 'input type=submit class=submit' tag named C<$name> with the +value C<$value> and with arbitrary HTML attributes from C<%attributes>. The +tag's C defaults to C. + +If C<$attributes{confirm}> is set then a JavaScript popup dialog will +be added via the C handler asking the question given with +C<$attributes{confirm}>. If request is only submitted if the user +clicks the dialog's ok/yes button. + +=item C + +Creates a HTML 'textarea' tag named C<$name> with the content +C<$value> and with arbitrary HTML attributes from C<%attributes>. The +tag's C defaults to C. + =item C Creates a HTML 'input type=checkbox' tag named C<$name> with arbitrary @@ -252,7 +508,37 @@ If C<%attributes> contains a key C