Revision 07d71c33
Von Stephan Köhler vor fast 19 Jahren hinzugefügt
| SL/PE.pm | ||
|---|---|---|
| 35 | 35 |
|
| 36 | 36 |
package PE; |
| 37 | 37 |
|
| 38 |
use Data::Dumper; |
|
| 39 |
|
|
| 38 | 40 |
sub projects {
|
| 39 | 41 |
$main::lxdebug->enter_sub(); |
| 40 | 42 |
|
| ... | ... | |
| 290 | 292 |
$main::lxdebug->leave_sub(); |
| 291 | 293 |
} |
| 292 | 294 |
|
| 295 |
########################## |
|
| 296 |
# get pricegroups from database |
|
| 297 |
# |
|
| 298 |
sub pricegroups {
|
|
| 299 |
$main::lxdebug->enter_sub(); |
|
| 300 |
|
|
| 301 |
my ($self, $myconfig, $form) = @_; |
|
| 302 |
|
|
| 303 |
my $var; |
|
| 304 |
|
|
| 305 |
# connect to database |
|
| 306 |
my $dbh = $form->dbconnect($myconfig); |
|
| 307 |
|
|
| 308 |
my $sortorder = ($form->{sort}) ? $form->{sort} : "pricegroup";
|
|
| 309 |
|
|
| 310 |
my $query = qq|SELECT g.id, g.pricegroup |
|
| 311 |
FROM pricegroup g|; |
|
| 312 |
|
|
| 313 |
my $where = "1 = 1"; |
|
| 314 |
|
|
| 315 |
if ($form->{pricegroup}) {
|
|
| 316 |
$var = $form->like(lc $form->{pricegroup});
|
|
| 317 |
$where .= " AND lower(g.pricegroup) LIKE '$var'"; |
|
| 318 |
} |
|
| 319 |
$query .= qq| |
|
| 320 |
WHERE $where |
|
| 321 |
ORDER BY $sortorder|; |
|
| 322 |
|
|
| 323 |
if ($form->{status} eq 'orphaned') {
|
|
| 324 |
$query = qq|SELECT pg.* |
|
| 325 |
FROM pricegroup pg |
|
| 326 |
LEFT JOIN prices p ON (p.pricegroup_id = pg.id) |
|
| 327 |
WHERE $where |
|
| 328 |
EXCEPT |
|
| 329 |
SELECT pg.* |
|
| 330 |
FROM pricegroup pg |
|
| 331 |
JOIN prices p ON (p.pricegroup_id = pg.id) |
|
| 332 |
WHERE $where |
|
| 333 |
ORDER BY $sortorder|; |
|
| 334 |
} |
|
| 335 |
print STDERR "asdfasdf-$query\n"; |
|
| 336 |
|
|
| 337 |
$sth = $dbh->prepare($query); |
|
| 338 |
$sth->execute || $form->dberror($query); |
|
| 339 |
|
|
| 340 |
my $i = 0; |
|
| 341 |
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
|
| 342 |
push @{ $form->{item_list} }, $ref;
|
|
| 343 |
$i++; |
|
| 344 |
} |
|
| 345 |
|
|
| 346 |
$sth->finish; |
|
| 347 |
$dbh->disconnect; |
|
| 348 |
|
|
| 349 |
$main::lxdebug->leave_sub(); |
|
| 350 |
|
|
| 351 |
return $i; |
|
| 352 |
} |
|
| 353 |
######################## |
|
| 354 |
# save pricegruop to database |
|
| 355 |
# |
|
| 356 |
sub save_pricegroup {
|
|
| 357 |
$main::lxdebug->enter_sub(); |
|
| 358 |
|
|
| 359 |
my ($self, $myconfig, $form) = @_; |
|
| 360 |
|
|
| 361 |
# connect to database |
|
| 362 |
my $dbh = $form->dbconnect($myconfig); |
|
| 363 |
|
|
| 364 |
map { $form->{$_} =~ s/\'/\'\'/g } (pricegroup);
|
|
| 365 |
|
|
| 366 |
$form->{discount} /= 100;
|
|
| 367 |
|
|
| 368 |
if ($form->{id}) {
|
|
| 369 |
$query = qq|UPDATE pricegroup SET |
|
| 370 |
pricegroup = '$form->{pricegroup}'
|
|
| 371 |
WHERE id = $form->{id}|;
|
|
| 372 |
} else {
|
|
| 373 |
$query = qq|INSERT INTO pricegroup |
|
| 374 |
(pricegroup) |
|
| 375 |
VALUES ('$form->{pricegroup}')|;
|
|
| 376 |
} |
|
| 377 |
$dbh->do($query) || $form->dberror($query); |
|
| 378 |
|
|
| 379 |
$dbh->disconnect; |
|
| 380 |
|
|
| 381 |
$main::lxdebug->leave_sub(); |
|
| 382 |
} |
|
| 383 |
############################ |
|
| 384 |
# get one pricegroup from database |
|
| 385 |
# |
|
| 386 |
sub get_pricegroup {
|
|
| 387 |
$main::lxdebug->enter_sub(); |
|
| 388 |
print STDERR "PE.pm-get_pricegroup\n"; |
|
| 389 |
my ($self, $myconfig, $form) = @_; |
|
| 390 |
|
|
| 391 |
# connect to database |
|
| 392 |
my $dbh = $form->dbconnect($myconfig); |
|
| 393 |
|
|
| 394 |
my $query = qq|SELECT p.id, p.pricegroup |
|
| 395 |
FROM pricegroup p |
|
| 396 |
WHERE p.id = $form->{id}|;
|
|
| 397 |
my $sth = $dbh->prepare($query); |
|
| 398 |
$sth->execute || $form->dberror($query); |
|
| 399 |
|
|
| 400 |
my $ref = $sth->fetchrow_hashref(NAME_lc); |
|
| 401 |
|
|
| 402 |
map { $form->{$_} = $ref->{$_} } keys %$ref;
|
|
| 403 |
|
|
| 404 |
$sth->finish; |
|
| 405 |
|
|
| 406 |
# check if it is orphaned |
|
| 407 |
$query = qq|SELECT count(*) |
|
| 408 |
FROM prices p |
|
| 409 |
WHERE p.pricegroup_id = $form->{id}|;
|
|
| 410 |
$sth = $dbh->prepare($query); |
|
| 411 |
$sth->execute || $form->dberror($query); |
|
| 412 |
|
|
| 413 |
($form->{orphaned}) = $sth->fetchrow_array;
|
|
| 414 |
$form->{orphaned} = !$form->{orphaned};
|
|
| 415 |
|
|
| 416 |
$sth->finish; |
|
| 417 |
|
|
| 418 |
$dbh->disconnect; |
|
| 419 |
#print (STDERR " ", Dumper($form)); |
|
| 420 |
$main::lxdebug->leave_sub(); |
|
| 421 |
} |
|
| 422 |
|
|
| 293 | 423 |
1; |
| 294 | 424 |
|
Auch abrufbar als: Unified diff
Merge von 599-602,605,614,615 aus unstable: Preisgruppen Teil 1
--Preisgruppenerweiterung auf Basis von Andres Patch - Thanks
-Preisgruppenverwaltung
-Preiseingabe der Preisgruppen in Masken Waren,etc.
-Auswahl der Preisgruppen in den Verkaufsmasken
-Erweiterung Datenbankschema
-Übersetzungen für Preisgruppen
-Bugfix Preisgruppen, in der Warenmaske zeigte er eine Preisgruppe a
"Gruppe 1" als "Gruppe" an
-Anpassung locale
--Fehler bei negativen Umsaetzen behoben
--Fehler beim Speichern von Rechnungen und Angeboten/Auftraegen wenn keine Preisgruppen vorhanden
--Fehler bei Drucken und Buchen und Preisgruppen behoben, Preisgruppen Quelltext ein wenig modifiziert