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 use SL::DB;
  41
  42 use strict;
  43
  44 sub partsgroups {
  45   $main::lxdebug->enter_sub();
  46
  47   my ($self, $myconfig, $form) = @_;
  48
  49   # connect to database
  50   my $dbh = SL::DB->client->dbh;
  51
  52   my ($where, @values);
  53
  54   if ($form->{partsgroup}) {
  55     $where .= qq| AND partsgroup ILIKE ?|;
  56     push(@values, like($form->{partsgroup}));
  57   }
  58
  59   if ($form->{status} eq 'orphaned') {
  60     $where .=
  61       qq| AND id NOT IN | .
  62       qq|  (SELECT DISTINCT partsgroup_id FROM parts | .
  63       qq|   WHERE NOT partsgroup_id ISNULL | .
  64       qq| UNION | .
  65       qq|   SELECT DISTINCT partsgroup_id FROM custom_variable_config_partsgroups | .
  66       qq|   WHERE NOT partsgroup_id ISNULL) |;
  67   }
  68
  69   substr($where, 0, 4) = "WHERE " if ($where);
  70
  71   my $sortorder = $form->{sort} ? $form->{sort} : "partsgroup";
  72   $sortorder =~ s/[^a-z_]//g;
  73
  74   my $query =
  75     qq|SELECT id, partsgroup FROM partsgroup | .
  76     $where .
  77     qq|ORDER BY $sortorder|;
  78
  79   $form->{item_list} = selectall_hashref_query($form, $dbh, $query, @values);
  80
  81   $main::lxdebug->leave_sub();
  82
  83   return scalar(@{ $form->{item_list} });
  84 }
  85
  86 sub save_partsgroup {
  87   $main::lxdebug->enter_sub();
  88
  89   my ($self, $myconfig, $form) = @_;
  90
  91   # connect to database
  92   my $dbh = SL::DB->client->dbh;
  93
  94   $form->{discount} /= 100;
  95
  96   my @values = ($form->{partsgroup});
  97   my $query;
  98
  99   if ($form->{id}) {
 100     $query = qq|UPDATE partsgroup SET partsgroup = ? WHERE id = ?|;
 101     push(@values, $form->{id});
 102   } else {
 103     $query = qq|INSERT INTO partsgroup (partsgroup) VALUES (?)|;
 104   }
 105   do_query($form, $dbh, $query, @values);
 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 = SL::DB->client->dbh;
 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   # also not orphaned if partsgroup is selected for a cvar filter
 131   if ($form->{orphaned}) {
 132     my $cvar_count = scalar( @{ SL::DB::PartsGroup->new(id => $form->{id})->custom_variable_configs } );
 133     $form->{orphaned} = !$cvar_count;
 134   }
 135
 136   $main::lxdebug->leave_sub();
 137 }
 138
 139 sub delete_tuple {
 140   $main::lxdebug->enter_sub();
 141
 142   my ($self, $myconfig, $form) = @_;
 143
 144   # connect to database
 145   SL::DB->client->with_transaction(sub {
 146     my $dbh = SL::DB->client->dbh;
 147
 148     my $table = $form->{type} eq "pricegroup" ? "pricegroup" : "partsgroup";
 149
 150     my $query = qq|DELETE FROM $table WHERE id = ?|;
 151     do_query($form, $dbh, $query, $form->{id});
 152     1;
 153   }) or do { die SL::DB->client->error };
 154
 155   $main::lxdebug->leave_sub();
 156 }
 157
 158 ##########################
 159 # get pricegroups from database
 160 #
 161 sub pricegroups {
 162   $main::lxdebug->enter_sub();
 163
 164   my ($self, $myconfig, $form) = @_;
 165
 166   # connect to database
 167   my $dbh = SL::DB->client->dbh;
 168
 169   my ($where, @values);
 170
 171   if ($form->{pricegroup}) {
 172     $where .= qq| AND pricegroup ILIKE ?|;
 173     push(@values, like($form->{pricegroup}));
 174   }
 175
 176   if ($form->{status} eq 'orphaned') {
 177     my $first = 1;
 178
 179     $where .= qq| AND id NOT IN (|;
 180     foreach my $table (qw(invoice orderitems prices)) {
 181       $where .= "UNION " unless ($first);
 182       $first = 0;
 183       $where .=
 184         qq|SELECT DISTINCT pricegroup_id FROM $table | .
 185         qq|WHERE NOT pricegroup_id ISNULL |;
 186     }
 187     $where .= qq|) |;
 188   }
 189
 190   substr($where, 0, 4) = "WHERE " if ($where);
 191
 192   my $sortorder = $form->{sort} ? $form->{sort} : "pricegroup";
 193   $sortorder =~ s/[^a-z_]//g;
 194
 195   my $query =
 196     qq|SELECT id, pricegroup FROM pricegroup | .
 197     $where .
 198     qq|ORDER BY $sortorder|;
 199
 200   $form->{item_list} = selectall_hashref_query($form, $dbh, $query, @values);
 201
 202   $main::lxdebug->leave_sub();
 203
 204   return scalar(@{ $form->{item_list} });
 205 }
 206
 207 ########################
 208 # save pricegruop to database
 209 #
 210 sub save_pricegroup {
 211   $main::lxdebug->enter_sub();
 212
 213   my ($self, $myconfig, $form) = @_;
 214
 215   SL::DB->client->with_transaction(sub {
 216     my $dbh = SL::DB->client->dbh;
 217     my $query;
 218
 219     $form->{discount} /= 100;
 220
 221     my @values = ($form->{pricegroup});
 222
 223     if ($form->{id}) {
 224       $query = qq|UPDATE pricegroup SET pricegroup = ? WHERE id = ? |;
 225       push(@values, $form->{id});
 226     } else {
 227       $query = qq|INSERT INTO pricegroup (pricegroup) VALUES (?)|;
 228     }
 229     do_query($form, $dbh, $query, @values);
 230     1;
 231   }) or do { die SL::DB->client->error };
 232
 233   $main::lxdebug->leave_sub();
 234 }
 235
 236 ############################
 237 # get one pricegroup from database
 238 #
 239 sub get_pricegroup {
 240   $main::lxdebug->enter_sub();
 241
 242   my ($self, $myconfig, $form) = @_;
 243
 244   # connect to database
 245   my $dbh = SL::DB->client->dbh;
 246
 247   my $query = qq|SELECT id, pricegroup FROM pricegroup WHERE id = ?|;
 248   my $sth = prepare_execute_query($form, $dbh, $query, $form->{id});
 249   my $ref = $sth->fetchrow_hashref("NAME_lc");
 250
 251   map({ $form->{$_} = $ref->{$_} } keys(%{$ref}));
 252
 253   $sth->finish;
 254
 255   my $first = 1;
 256
 257   my @values = ();
 258   $query = qq|SELECT |;
 259   foreach my $table (qw(invoice orderitems prices)) {
 260     $query .= " + " unless ($first);
 261     $first = 0;
 262     $query .= qq|(SELECT COUNT(*) FROM $table WHERE pricegroup_id = ?) |;
 263     push(@values, $form->{id});
 264   }
 265
 266   ($form->{orphaned}) = selectrow_query($form, $dbh, $query, @values);
 267   $form->{orphaned} = !$form->{orphaned};
 268
 269   $main::lxdebug->leave_sub();
 270 }
 271
 272 1;
 273