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, like($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       qq| UNION | .
  64       qq|   SELECT DISTINCT partsgroup_id FROM custom_variable_config_partsgroups | .
  65       qq|   WHERE NOT partsgroup_id ISNULL) |;
  66   }
  67
  68   substr($where, 0, 4) = "WHERE " if ($where);
  69
  70   my $sortorder = $form->{sort} ? $form->{sort} : "partsgroup";
  71   $sortorder =~ s/[^a-z_]//g;
  72
  73   my $query =
  74     qq|SELECT id, partsgroup FROM partsgroup | .
  75     $where .
  76     qq|ORDER BY $sortorder|;
  77
  78   $form->{item_list} = selectall_hashref_query($form, $dbh, $query, @values);
  79
  80   $dbh->disconnect;
  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 = $form->dbconnect($myconfig);
  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   $dbh->disconnect;
 109
 110   $main::lxdebug->leave_sub();
 111 }
 112
 113 sub get_partsgroup {
 114   $main::lxdebug->enter_sub();
 115
 116   my ($self, $myconfig, $form) = @_;
 117
 118   # connect to database
 119   my $dbh = $form->dbconnect($myconfig);
 120
 121   my $query =
 122     qq|SELECT pg.*, | .
 123     qq|(SELECT COUNT(*) FROM parts WHERE partsgroup_id = ?) = 0 AS orphaned | .
 124     qq|FROM partsgroup pg | .
 125     qq|WHERE pg.id = ?|;
 126   my $sth = prepare_execute_query($form, $dbh, $query, $form->{id},
 127                                   $form->{id});
 128   my $ref = $sth->fetchrow_hashref("NAME_lc");
 129
 130   map({ $form->{$_} = $ref->{$_} } keys(%{$ref}));
 131   $sth->finish;
 132
 133   $dbh->disconnect;
 134
 135   # also not orphaned if partsgroup is selected for a cvar filter
 136   if ($form->{orphaned}) {
 137     my $cvar_count = scalar( @{ SL::DB::PartsGroup->new(id => $form->{id})->custom_variable_configs } );
 138     $form->{orphaned} = !$cvar_count;
 139   }
 140
 141   $main::lxdebug->leave_sub();
 142 }
 143
 144 sub delete_tuple {
 145   $main::lxdebug->enter_sub();
 146
 147   my ($self, $myconfig, $form) = @_;
 148
 149   # connect to database
 150   my $dbh = $form->dbconnect($myconfig);
 151
 152   my $table = $form->{type} eq "pricegroup" ? "pricegroup" : "partsgroup";
 153
 154   my $query = qq|DELETE FROM $table WHERE id = ?|;
 155   do_query($form, $dbh, $query, $form->{id});
 156
 157   $dbh->disconnect;
 158
 159   $main::lxdebug->leave_sub();
 160 }
 161
 162 ##########################
 163 # get pricegroups from database
 164 #
 165 sub pricegroups {
 166   $main::lxdebug->enter_sub();
 167
 168   my ($self, $myconfig, $form) = @_;
 169
 170   # connect to database
 171   my $dbh = $form->dbconnect($myconfig);
 172
 173   my ($where, @values);
 174
 175   if ($form->{pricegroup}) {
 176     $where .= qq| AND pricegroup ILIKE ?|;
 177     push(@values, like($form->{pricegroup}));
 178   }
 179
 180   if ($form->{status} eq 'orphaned') {
 181     my $first = 1;
 182
 183     $where .= qq| AND id NOT IN (|;
 184     foreach my $table (qw(invoice orderitems prices)) {
 185       $where .= "UNION " unless ($first);
 186       $first = 0;
 187       $where .=
 188         qq|SELECT DISTINCT pricegroup_id FROM $table | .
 189         qq|WHERE NOT pricegroup_id ISNULL |;
 190     }
 191     $where .= qq|) |;
 192   }
 193
 194   substr($where, 0, 4) = "WHERE " if ($where);
 195
 196   my $sortorder = $form->{sort} ? $form->{sort} : "pricegroup";
 197   $sortorder =~ s/[^a-z_]//g;
 198
 199   my $query =
 200     qq|SELECT id, pricegroup FROM pricegroup | .
 201     $where .
 202     qq|ORDER BY $sortorder|;
 203
 204   $form->{item_list} = selectall_hashref_query($form, $dbh, $query, @values);
 205
 206   $dbh->disconnect;
 207
 208   $main::lxdebug->leave_sub();
 209
 210   return scalar(@{ $form->{item_list} });
 211 }
 212
 213 ########################
 214 # save pricegruop to database
 215 #
 216 sub save_pricegroup {
 217   $main::lxdebug->enter_sub();
 218
 219   my ($self, $myconfig, $form) = @_;
 220
 221   # connect to database
 222   my $dbh = $form->dbconnect($myconfig);
 223   my $query;
 224
 225   $form->{discount} /= 100;
 226
 227   my @values = ($form->{pricegroup});
 228
 229   if ($form->{id}) {
 230     $query = qq|UPDATE pricegroup SET pricegroup = ? WHERE id = ? |;
 231     push(@values, $form->{id});
 232   } else {
 233     $query = qq|INSERT INTO pricegroup (pricegroup) VALUES (?)|;
 234   }
 235   do_query($form, $dbh, $query, @values);
 236
 237   $dbh->disconnect;
 238
 239   $main::lxdebug->leave_sub();
 240 }
 241
 242 ############################
 243 # get one pricegroup from database
 244 #
 245 sub get_pricegroup {
 246   $main::lxdebug->enter_sub();
 247
 248   my ($self, $myconfig, $form) = @_;
 249
 250   # connect to database
 251   my $dbh = $form->dbconnect($myconfig);
 252
 253   my $query = qq|SELECT id, pricegroup FROM pricegroup WHERE id = ?|;
 254   my $sth = prepare_execute_query($form, $dbh, $query, $form->{id});
 255   my $ref = $sth->fetchrow_hashref("NAME_lc");
 256
 257   map({ $form->{$_} = $ref->{$_} } keys(%{$ref}));
 258
 259   $sth->finish;
 260
 261   my $first = 1;
 262
 263   my @values = ();
 264   $query = qq|SELECT |;
 265   foreach my $table (qw(invoice orderitems prices)) {
 266     $query .= " + " unless ($first);
 267     $first = 0;
 268     $query .= qq|(SELECT COUNT(*) FROM $table WHERE pricegroup_id = ?) |;
 269     push(@values, $form->{id});
 270   }
 271
 272   ($form->{orphaned}) = selectrow_query($form, $dbh, $query, @values);
 273   $form->{orphaned} = !$form->{orphaned};
 274
 275   $dbh->disconnect;
 276
 277   $main::lxdebug->leave_sub();
 278 }
 279
 280 1;
 281