=head1 NAME
-SL::BackgroundJob::TelfTests - pluggable self testing
+SL::BackgroundJob::SelfTest - pluggable self testing
=head1 SYNOPSIS
- use SL::BackgroundJob::SelfTests;
- SL::BackgroundJob::SelfTests->new->run;;
+ use SL::BackgroundJob::SelfTest;
+ SL::BackgroundJob::SelfTest->new->run;;
=head1 DESCRIPTION
AND a.transdate >= ? and a.transdate <= ?|;
my ($summe_stornobuchungen_ap) = selectfirst_array_query($::form, $self->dbh, $query, $self->fromdate, $self->todate);
- $self->tester->ok($summe_stornobuchungen_ap == 0, 'Summe aller Einkaufsrechnungen (stornos + stronierte) soll 0 sein');
- $self->tester->ok($summe_stornobuchungen_ar == 0, 'Summe aller Verkaufsrechnungen (stornos + stronierte) soll 0 sein');
+ $self->tester->ok($summe_stornobuchungen_ap == 0, 'Summe aller Einkaufsrechnungen (stornos + stornierte) soll 0 sein');
+ $self->tester->ok($summe_stornobuchungen_ar == 0, 'Summe aller Verkaufsrechnungen (stornos + stornierte) soll 0 sein');
$self->tester->diag("Summe Einkaufsrechnungen (ar): $summe_stornobuchungen_ar") if $summe_stornobuchungen_ar;
$self->tester->diag("Summe Einkaufsrechnungen (ap): $summe_stornobuchungen_ap") if $summe_stornobuchungen_ap;
}
=head1 AUTHOR
-Geoffrey Richardsom E<lt>information@richardsonbueren.deE<gt>
-Jan Büren E<lt>information@richardsonbueren.deE<gt>
+G. Richardson E<lt>information@richardson-bueren.deE<gt>
+Jan Büren E<lt>information@richardson-bueren.deE<gt>
Sven Schoeling E<lt>s.schoeling@linet-services.deE<gt>
=cut
sub _before_save_set_partnumber {
my ($self) = @_;
- $self->create_trans_number if $self->partnumber eq '';
+ $self->create_trans_number if !$self->partnumber;
return 1;
}
if (@quote_chars) {
if ($char eq $quote_chars[-1]) {
pop(@quote_chars);
+ } elsif (length $quote_chars[-1] > 1
+ && substr($_, $i, length $quote_chars[-1]) eq $quote_chars[-1]) {
+ $i += length $quote_chars[-1] - 1;
+ $char = $quote_chars[-1];
+ pop(@quote_chars);
}
$query .= $char;
} else {
+ my ($tag, $tag_end);
if (($char eq "'") || ($char eq "\"")) {
push(@quote_chars, $char);
+ } elsif ($char eq '$' # start of dollar quoting
+ && ($tag_end = index($_, '$', $i + 1)) > -1 # ends on same line
+ && (do { $tag = substr($_, $i + 1, $tag_end - $i - 1); 1 }) # extract tag
+ && $tag =~ /^ (?= [A-Za-z_] [A-Za-z0-9_]* | ) $/x) { # tag is identifier
+ push @quote_chars, $char = '$' . $tag . '$';
+ $i = $tag_end;
} elsif ($char eq ";") {
# Query is complete. Send it.
$main::lxdebug->enter_sub(2);
my ($self, $myconfig, $amount, $places, $dash) = @_;
- $dash ||= '';
+ $amount ||= 0;
+ $dash ||= '';
+ my $neg = $amount < 0;
+ my $force_places = defined $places && $places >= 0;
- if ($amount eq "") {
- $amount = 0;
- }
-
- $amount *= 1;
-
- # Hey watch out! The amount can be an exponential term like 1.13686837721616e-13
+ $amount = $self->round_amount($amount, abs $places) if $force_places;
+ $amount = sprintf "%.*f", ($force_places ? $places : 10), abs $amount; # 6 is default for %fa
- my $neg = ($amount =~ s/^-//);
- my $exp = ($amount =~ m/[e]/) ? 1 : 0;
+ # before the sprintf amount was a number, afterwards it's a string. because of the dynamic nature of perl
+ # this is easy to confuse, so keep in mind: before this comment no s///, m//, concat or other strong ops on
+ # $amount. after this comment no +,-,*,/,abs. it will only introduce subtle bugs.
- if (defined($places) && ($places ne '')) {
- if (not $exp) {
- if ($places < 0) {
- $amount *= 1;
- $places *= -1;
-
- if ($amount =~ /\.(\d+)/) {
- my $actual_places = length $1;
- $places = $actual_places if $actual_places > $places;
- }
- }
- }
- $amount = $self->round_amount($amount, $places);
- }
+ $amount =~ s/0*$//; # cull trailing 0s
my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars
- my @p = split(/\./, $amount); # split amount at decimal point
-
- $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters
+ my @p = split(/\./, $amount); # split amount at decimal point
+ $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters
$amount = $p[0];
- $amount .= $d[0].($p[1]||'').(0 x ($places - length ($p[1]||''))) if ($places || $p[1] ne '');
+ if ($places || $p[1]) {
+ $amount .= $d[0]
+ . ( $p[1] || '' )
+ . (0 x (abs($places || 0) - length ($p[1]||''))); # pad the fraction
+ }
$amount = do {
($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) :
($neg ? "-$amount" : "$amount" ) ;
};
-
$main::lxdebug->leave_sub(2);
return $amount;
}
try{\r
var shortRef = this.submenuGroups[parentId]; \r
\r
+ if( shortRef.style.visible == 'hidden' )\r
+ {\r
+ shortRef.style.display = 'none';\r
+ return;\r
+ }\r
+ else\r
+ shortRef.style.display = 'block';\r
+ \r
var depth = this.menuItems[parentId].depth;\r
var dir = this.menuItemObj.submenuType[depth];\r
if(dir=='top'){ \r
--- /dev/null
+-- @tag: record_links_post_delete_triggers
+-- @description: Datenbankkonsistenz nach dem löschen von Belegen
+-- @depends: release_2_7_0
+-- @encoding: utf8
+
+-- When deleting records record_links weren't cleaned up until now
+-- This wasn't rally a problem apart from the fact that record_links slowly grew
+-- but deleting records was seldom enough to not matter
+-- Unfortunately delivery_plan decides if an order need to be displayed by the
+-- number of record_links, which generates false negatives.
+-- so, first clean up the database, and after that create triggers to
+-- clean up automatically
+
+DELETE FROM record_links WHERE from_table = 'oe' AND from_id NOT IN (SELECT id FROM oe);
+DELETE FROM record_links WHERE to_table = 'oe' AND to_id NOT IN (SELECT id FROM oe);
+
+DELETE FROM record_links WHERE from_table = 'delivery_orders' AND from_id NOT IN (SELECT id FROM delivery_orders);
+DELETE FROM record_links WHERE to_table = 'delivery_orders' AND to_id NOT IN (SELECT id FROM delivery_orders);
+
+DELETE FROM record_links WHERE from_table = 'ar' AND from_id NOT IN (SELECT id FROM ar);
+DELETE FROM record_links WHERE to_table = 'ar' AND to_id NOT IN (SELECT id FROM ar);
+
+DELETE FROM record_links WHERE from_table = 'ap' AND from_id NOT IN (SELECT id FROM ap);
+DELETE FROM record_links WHERE to_table = 'ap' AND to_id NOT IN (SELECT id FROM ap);
+
+CREATE OR REPLACE FUNCTION clean_up_record_links_before_oe_delete() RETURNS trigger AS $$
+ BEGIN
+ DELETE FROM record_links
+ WHERE (from_table = 'oe' AND from_id = OLD.id)
+ OR (to_table = 'oe' AND to_id = OLD.id);
+ END;
+$$ LANGUAGE plpgsql;
+
+CREATE OR REPLACE FUNCTION clean_up_record_links_before_delivery_orders_delete() RETURNS trigger AS $$
+ BEGIN
+ DELETE FROM record_links
+ WHERE (from_table = 'delivery_orders' AND from_id = OLD.id)
+ OR (to_table = 'delivery_orders' AND to_id = OLD.id);
+ END;
+$$ LANGUAGE plpgsql;
+
+CREATE OR REPLACE FUNCTION clean_up_record_links_before_ar_delete() RETURNS trigger AS $$
+ BEGIN
+ DELETE FROM record_links
+ WHERE (from_table = 'ar' AND from_id = OLD.id)
+ OR (to_table = 'ar' AND to_id = OLD.id);
+ END;
+$$ LANGUAGE plpgsql;
+
+CREATE OR REPLACE FUNCTION clean_up_record_links_before_ap_delete() RETURNS trigger AS $$
+ BEGIN
+ DELETE FROM record_links
+ WHERE (from_table = 'ap' AND from_id = OLD.id)
+ OR (to_table = 'ap' AND to_id = OLD.id);
+ END;
+$$ LANGUAGE plpgsql;
+
+CREATE TRIGGER before_delete_oe_trigger
+BEFORE DELETE ON oe FOR EACH ROW EXECUTE
+PROCEDURE clean_up_record_links_before_oe_delete();
+
+CREATE TRIGGER before_delete_delivery_orders_trigger
+BEFORE DELETE ON delivery_orders FOR EACH ROW EXECUTE
+PROCEDURE clean_up_record_links_before_delivery_orders_delete();
+
+CREATE TRIGGER before_delete_ar_trigger
+BEFORE DELETE ON ar FOR EACH ROW EXECUTE
+PROCEDURE clean_up_record_links_before_ar_delete();
+
+CREATE TRIGGER before_delete_ap_trigger
+BEFORE DELETE ON ap FOR EACH ROW EXECUTE
+PROCEDURE clean_up_record_links_before_ap_delete();
is($::form->format_amount($config, 1000000000.1234, 2), '1,000,000,000.12', 'format 1000000000.1234 (numberformat: 1,000.00)');
is($::form->format_amount($config, -1000000000.1234, 2), '-1,000,000,000.12', 'format -1000000000.1234 (numberformat: 1,000.00)');
+# negative places
+
+is($::form->format_amount($config, 1.00045, -2), '1.00045', 'negative places');
+is($::form->format_amount($config, 1.00045, -5), '1.00045', 'negative places 2');
+is($::form->format_amount($config, 1, -2), '1.00', 'negative places 3');
+
+# bugs amd edge cases
+
+is($::form->format_amount({ numberformat => '1.000,00' }, 0.00005), '0,00005', 'messing with small numbers and no precision');
+is($::form->format_amount({ numberformat => '1.000,00' }, undef), '0', 'undef');
+is($::form->format_amount({ numberformat => '1.000,00' }, ''), '0', 'empty string');
+is($::form->format_amount({ numberformat => '1.000,00' }, undef, 2), '0,00', 'undef with precision');
+is($::form->format_amount({ numberformat => '1.000,00' }, '', 2), '0,00', 'empty string with prcesion');
+
+is($::form->format_amount($config, 0.545, 0), '1', 'rounding up with precision 0');
+is($::form->format_amount($config, -0.545, 0), '-1', 'neg rounding up with precision 0');
+
+is($::form->format_amount($config, 1.00), '1', 'autotrim to 0 places');
+
+
+# dash stuff
+
+$config->{numberformat} = '1.000,00';
+
+is($::form->format_amount($config, -350, 2, '-'), '(350,00)', 'dash -');
+
+
done_testing;
1;