Revision 29795499
Von Sven Schöling vor etwa 17 Jahren hinzugefügt
| SL/Form.pm | ||
|---|---|---|
| 49 | 49 |
use SL::User; |
| 50 | 50 |
use SL::Common; |
| 51 | 51 |
use CGI; |
| 52 |
use List::Util qw(max min sum); |
|
| 52 | 53 |
|
| 53 | 54 |
my $standard_dbh; |
| 54 | 55 |
|
| ... | ... | |
| 98 | 99 |
if (($line eq $boundary) || ($line eq "$boundary\r")) {
|
| 99 | 100 |
$params{$name} =~ s|\r?\n$|| if $name;
|
| 100 | 101 |
|
| 101 |
undef $name, $filename; |
|
| 102 |
undef $name; |
|
| 103 |
undef $filename; |
|
| 102 | 104 |
|
| 103 | 105 |
$headers_done = 0; |
| 104 | 106 |
$content_type = "text/plain"; |
| ... | ... | |
| 331 | 333 |
$main::lxdebug->leave_sub(); |
| 332 | 334 |
} |
| 333 | 335 |
|
| 336 |
# calculates the number of rows in a textarea based on the content and column number |
|
| 337 |
# can be capped with maxrows |
|
| 334 | 338 |
sub numtextrows {
|
| 335 | 339 |
$main::lxdebug->enter_sub(); |
| 336 |
|
|
| 337 | 340 |
my ($self, $str, $cols, $maxrows) = @_; |
| 338 | 341 |
|
| 339 |
my $rows = 0; |
|
| 340 |
|
|
| 341 |
map { $rows += int(((length) - 2) / $cols) + 1 } split /\r/, $str;
|
|
| 342 |
|
|
| 343 |
$maxrows = $rows unless defined $maxrows; |
|
| 342 |
my $rows = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str;
|
|
| 343 |
$maxrows ||= $rows; |
|
| 344 | 344 |
|
| 345 | 345 |
$main::lxdebug->leave_sub(); |
| 346 |
|
|
| 347 |
return ($rows > $maxrows) ? $maxrows : $rows; |
|
| 346 |
return min $rows, $maxrows; |
|
| 348 | 347 |
} |
| 349 | 348 |
|
| 350 | 349 |
sub dberror {
|
| ... | ... | |
| 1206 | 1205 |
$main::lxdebug->enter_sub(); |
| 1207 | 1206 |
|
| 1208 | 1207 |
my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_; |
| 1209 |
|
|
| 1208 |
my ($query); |
|
| 1210 | 1209 |
# some sanity check for currency |
| 1211 | 1210 |
if ($curr eq '') {
|
| 1212 | 1211 |
$main::lxdebug->leave_sub(); |
| 1213 | 1212 |
return; |
| 1214 | 1213 |
} |
| 1215 |
my $query = qq|SELECT curr FROM defaults|;
|
|
| 1214 |
$query = qq|SELECT curr FROM defaults|; |
|
| 1216 | 1215 |
|
| 1217 | 1216 |
my ($currency) = selectrow_query($self, $dbh, $query); |
| 1218 | 1217 |
my ($defaultcurrency) = split m/:/, $currency; |
| ... | ... | |
| 1223 | 1222 |
return; |
| 1224 | 1223 |
} |
| 1225 | 1224 |
|
| 1226 |
my $query = qq|SELECT e.curr FROM exchangerate e
|
|
| 1225 |
$query = qq|SELECT e.curr FROM exchangerate e |
|
| 1227 | 1226 |
WHERE e.curr = ? AND e.transdate = ? |
| 1228 | 1227 |
FOR UPDATE|; |
| 1229 | 1228 |
my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate); |
| ... | ... | |
| 1288 | 1287 |
$main::lxdebug->enter_sub(); |
| 1289 | 1288 |
|
| 1290 | 1289 |
my ($self, $dbh, $curr, $transdate, $fld) = @_; |
| 1290 |
my ($query); |
|
| 1291 | 1291 |
|
| 1292 | 1292 |
unless ($transdate) {
|
| 1293 | 1293 |
$main::lxdebug->leave_sub(); |
| 1294 | 1294 |
return 1; |
| 1295 | 1295 |
} |
| 1296 | 1296 |
|
| 1297 |
my $query = qq|SELECT curr FROM defaults|;
|
|
| 1297 |
$query = qq|SELECT curr FROM defaults|; |
|
| 1298 | 1298 |
|
| 1299 | 1299 |
my ($currency) = selectrow_query($self, $dbh, $query); |
| 1300 | 1300 |
my ($defaultcurrency) = split m/:/, $currency; |
| ... | ... | |
| 1304 | 1304 |
return 1; |
| 1305 | 1305 |
} |
| 1306 | 1306 |
|
| 1307 |
my $query = qq|SELECT e.$fld FROM exchangerate e
|
|
| 1307 |
$query = qq|SELECT e.$fld FROM exchangerate e |
|
| 1308 | 1308 |
WHERE e.curr = ? AND e.transdate = ?|; |
| 1309 | 1309 |
my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate); |
| 1310 | 1310 |
|
| ... | ... | |
| 2500 | 2500 |
|
| 2501 | 2501 |
my @ndx = (); |
| 2502 | 2502 |
|
| 2503 |
map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } }
|
|
| 2504 |
(1 .. $count); |
|
| 2503 |
map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } 1 .. $count;
|
|
| 2505 | 2504 |
|
| 2506 | 2505 |
my $i = 0; |
| 2507 | 2506 |
|
| ... | ... | |
| 2587 | 2586 |
my $formnames = $self->{printed};
|
| 2588 | 2587 |
my $emailforms = $self->{emailed};
|
| 2589 | 2588 |
|
| 2590 |
my $query = qq|DELETE FROM status
|
|
| 2589 |
$query = qq|DELETE FROM status |
|
| 2591 | 2590 |
WHERE (formname = ?) AND (trans_id = ?)|; |
| 2592 | 2591 |
do_query($self, $dbh, $query, $self->{formname}, $self->{id});
|
| 2593 | 2592 |
|
Auch abrufbar als: Unified diff
Verbesserungen am Tag Script.
Ausserdem Merge der Revisionen 5239 5259 5340 5341 5342 und 5343.