SL/PE.pm

   1 #=====================================================================
   2 # LX-Office ERP
   3 # Copyright (C) 2004
   4 # Based on SQL-Ledger Version 2.1.9
   5 # Web http://www.lx-office.org
   6 #
   7 #=====================================================================
   8 # SQL-Ledger Accounting
   9 # Copyright (C) 1998-2002
  10 #
  11 #  Author: Dieter Simader
  12 #   Email: dsimader@sql-ledger.org
  13 #     Web: http://www.sql-ledger.org
  14 #
  15 #  Contributors:
  16 #
  17 # This program is free software; you can redistribute it and/or modify
  18 # it under the terms of the GNU General Public License as published by
  19 # the Free Software Foundation; either version 2 of the License, or
  20 # (at your option) any later version.
  21 #
  22 # This program is distributed in the hope that it will be useful,
  23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  25 # GNU General Public License for more details.
  26 # You should have received a copy of the GNU General Public License
  27 # along with this program; if not, write to the Free Software
  28 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  29 #======================================================================
  30 #
  31 # Partsgroups and pricegroups
  32 #
  33 #======================================================================
  34
  35 package PE;
  36
  37 use Data::Dumper;
  38
  39 use SL::DBUtils;
  40
  41 use strict;
  42
  43 sub partsgroups {
  44   $main::lxdebug->enter_sub();
  45
  46   my ($self, $myconfig, $form) = @_;
  47
  48   # connect to database
  49   my $dbh = $form->dbconnect($myconfig);
  50
  51   my ($where, @values);
  52
  53   if ($form->{partsgroup}) {
  54     $where .= qq| AND partsgroup ILIKE ?|;
  55     push(@values, '%' . $form->{partsgroup} . '%');
  56   }
  57
  58   if ($form->{status} eq 'orphaned') {
  59     $where .=
  60       qq| AND id NOT IN | .
  61       qq|  (SELECT DISTINCT partsgroup_id FROM parts | .
  62       qq|   WHERE NOT partsgroup_id ISNULL) |;
  63   }
  64
  65   substr($where, 0, 4) = "WHERE " if ($where);
  66
  67   my $sortorder = $form->{sort} ? $form->{sort} : "partsgroup";
  68   $sortorder =~ s/[^a-z_]//g;
  69
  70   my $query =
  71     qq|SELECT id, partsgroup FROM partsgroup | .
  72     $where .
  73     qq|ORDER BY $sortorder|;
  74
  75   $form->{item_list} = selectall_hashref_query($form, $dbh, $query, @values);
  76
  77   $dbh->disconnect;
  78
  79   $main::lxdebug->leave_sub();
  80
  81   return scalar(@{ $form->{item_list} });
  82 }
  83
  84 sub save_partsgroup {
  85   $main::lxdebug->enter_sub();
  86
  87   my ($self, $myconfig, $form) = @_;
  88
  89   # connect to database
  90   my $dbh = $form->dbconnect($myconfig);
  91
  92   $form->{discount} /= 100;
  93
  94   my @values = ($form->{partsgroup});
  95   my $query;
  96
  97   if ($form->{id}) {
  98     $query = qq|UPDATE partsgroup SET partsgroup = ? WHERE id = ?|;
  99                 push(@values, $form->{id});
 100   } else {
 101     $query = qq|INSERT INTO partsgroup (partsgroup) VALUES (?)|;
 102   }
 103   do_query($form, $dbh, $query, @values);
 104
 105   $dbh->disconnect;
 106
 107   $main::lxdebug->leave_sub();
 108 }
 109
 110 sub get_partsgroup {
 111   $main::lxdebug->enter_sub();
 112
 113   my ($self, $myconfig, $form) = @_;
 114
 115   # connect to database
 116   my $dbh = $form->dbconnect($myconfig);
 117
 118   my $query =
 119     qq|SELECT pg.*, | .
 120     qq|(SELECT COUNT(*) FROM parts WHERE partsgroup_id = ?) = 0 AS orphaned | .
 121     qq|FROM partsgroup pg | .
 122     qq|WHERE pg.id = ?|;
 123   my $sth = prepare_execute_query($form, $dbh, $query, $form->{id},
 124                                   $form->{id});
 125   my $ref = $sth->fetchrow_hashref("NAME_lc");
 126
 127   map({ $form->{$_} = $ref->{$_} } keys(%{$ref}));
 128   $sth->finish;
 129
 130   $dbh->disconnect;
 131
 132   $main::lxdebug->leave_sub();
 133 }
 134
 135 sub delete_tuple {
 136   $main::lxdebug->enter_sub();
 137
 138   my ($self, $myconfig, $form) = @_;
 139
 140   # connect to database
 141   my $dbh = $form->dbconnect($myconfig);
 142
 143   my $table = $form->{type} eq "pricegroup" ? "pricegroup" : "partsgroup";
 144
 145   my $query = qq|DELETE FROM $table WHERE id = ?|;
 146   do_query($form, $dbh, $query, $form->{id});
 147
 148   $dbh->disconnect;
 149
 150   $main::lxdebug->leave_sub();
 151 }
 152
 153 ##########################
 154 # get pricegroups from database
 155 #
 156 sub pricegroups {
 157   $main::lxdebug->enter_sub();
 158
 159   my ($self, $myconfig, $form) = @_;
 160
 161   # connect to database
 162   my $dbh = $form->dbconnect($myconfig);
 163
 164   my ($where, @values);
 165
 166   if ($form->{pricegroup}) {
 167     $where .= qq| AND pricegroup ILIKE ?|;
 168     push(@values, '%' . $form->{pricegroup} . '%');
 169   }
 170
 171   if ($form->{status} eq 'orphaned') {
 172     my $first = 1;
 173
 174     $where .= qq| AND id NOT IN (|;
 175     foreach my $table (qw(invoice orderitems prices rmaitems)) {
 176       $where .= "UNION " unless ($first);
 177       $first = 0;
 178       $where .=
 179         qq|SELECT DISTINCT pricegroup_id FROM $table | .
 180         qq|WHERE NOT pricegroup_id ISNULL |;
 181     }
 182     $where .= qq|) |;
 183   }
 184
 185   substr($where, 0, 4) = "WHERE " if ($where);
 186
 187   my $sortorder = $form->{sort} ? $form->{sort} : "pricegroup";
 188   $sortorder =~ s/[^a-z_]//g;
 189
 190   my $query =
 191     qq|SELECT id, pricegroup FROM pricegroup | .
 192     $where .
 193     qq|ORDER BY $sortorder|;
 194
 195   $form->{item_list} = selectall_hashref_query($form, $dbh, $query, @values);
 196
 197   $dbh->disconnect;
 198
 199   $main::lxdebug->leave_sub();
 200
 201   return scalar(@{ $form->{item_list} });
 202 }
 203
 204 ########################
 205 # save pricegruop to database
 206 #
 207 sub save_pricegroup {
 208   $main::lxdebug->enter_sub();
 209
 210   my ($self, $myconfig, $form) = @_;
 211
 212   # connect to database
 213   my $dbh = $form->dbconnect($myconfig);
 214   my $query;
 215
 216   $form->{discount} /= 100;
 217
 218   my @values = ($form->{pricegroup});
 219
 220   if ($form->{id}) {
 221     $query = qq|UPDATE pricegroup SET pricegroup = ? WHERE id = ? |;
 222                 push(@values, $form->{id});
 223   } else {
 224     $query = qq|INSERT INTO pricegroup (pricegroup) VALUES (?)|;
 225   }
 226   do_query($form, $dbh, $query, @values);
 227
 228   $dbh->disconnect;
 229
 230   $main::lxdebug->leave_sub();
 231 }
 232
 233 ############################
 234 # get one pricegroup from database
 235 #
 236 sub get_pricegroup {
 237   $main::lxdebug->enter_sub();
 238
 239   my ($self, $myconfig, $form) = @_;
 240
 241   # connect to database
 242   my $dbh = $form->dbconnect($myconfig);
 243
 244   my $query = qq|SELECT id, pricegroup FROM pricegroup WHERE id = ?|;
 245   my $sth = prepare_execute_query($form, $dbh, $query, $form->{id});
 246   my $ref = $sth->fetchrow_hashref("NAME_lc");
 247
 248   map({ $form->{$_} = $ref->{$_} } keys(%{$ref}));
 249
 250   $sth->finish;
 251
 252   my $first = 1;
 253
 254   my @values = ();
 255   $query = qq|SELECT |;
 256   foreach my $table (qw(invoice orderitems prices rmaitems)) {
 257     $query .= " + " unless ($first);
 258     $first = 0;
 259     $query .= qq|(SELECT COUNT(*) FROM $table WHERE pricegroup_id = ?) |;
 260     push(@values, $form->{id});
 261   }
 262
 263   ($form->{orphaned}) = selectrow_query($form, $dbh, $query, @values);
 264   $form->{orphaned} = !$form->{orphaned};
 265
 266   $dbh->disconnect;
 267
 268   $main::lxdebug->leave_sub();
 269 }
 270
 271 1;
 272