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