SL/DN.pm

   1 #======================================================================
   2 # LX-Office ERP
   3 # Copyright (C) 2006
   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 # Dunning process module
  32 #
  33 #======================================================================
  34
  35 package DN;
  36
  37 use SL::Template;
  38 use SL::IS;
  39 use Data::Dumper;
  40
  41 sub get_config {
  42   $main::lxdebug->enter_sub();
  43
  44   my ($self, $myconfig, $form) = @_;
  45
  46   # connect to database
  47   my $dbh = $form->dbconnect($myconfig);
  48
  49   my $query = qq|SELECT dn.*
  50                  FROM dunning_config dn
  51                  ORDER BY dn.dunning_level|;
  52
  53   $sth = $dbh->prepare($query);
  54   $sth->execute || $form->dberror($query);
  55
  56   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
  57     $ref->{fee} = $form->format_amount($myconfig, $ref->{fee}, 2);
  58     $ref->{interest} = $form->format_amount($myconfig, ($ref->{interest} * 100));
  59     push @{ $form->{DUNNING} }, $ref;
  60   }
  61
  62   $sth->finish;
  63   $dbh->disconnect;
  64
  65   $main::lxdebug->leave_sub();
  66 }
  67
  68
  69 sub save_config {
  70   $main::lxdebug->enter_sub();
  71
  72   my ($self, $myconfig, $form) = @_;
  73
  74   # connect to database
  75   my $dbh = $form->dbconnect_noauto($myconfig);
  76
  77   for my $i (1 .. $form->{rowcount}) {
  78     $form->{"active_$i"} *= 1;
  79     $form->{"auto_$i"} *= 1;
  80     $form->{"email_$i"} *= 1;
  81     $form->{"terms_$i"} *= 1;
  82     $form->{"payment_terms_$i"} *= 1;
  83     $form->{"email_attachment_$i"} *= 1;
  84     $form->{"fee_$i"} = $form->parse_amount($myconfig, $form->{"fee_$i"}) * 1;
  85     $form->{"interest_$i"} = $form->parse_amount($myconfig, $form->{"interest_$i"})/100;
  86
  87     if (($form->{"dunning_level_$i"} ne "") && ($form->{"dunning_description_$i"} ne "")) {
  88       if ($form->{"id_$i"}) {
  89         my $query = qq|UPDATE dunning_config SET
  90                        dunning_level = | . $dbh->quote($form->{"dunning_level_$i"}) . qq|,
  91                        dunning_description = | . $dbh->quote($form->{"dunning_description_$i"}) . qq|,
  92                        email_subject = | . $dbh->quote($form->{"email_subject_$i"}) . qq|,
  93                        email_body = | . $dbh->quote($form->{"email_body_$i"}) . qq|,
  94                        template = | . $dbh->quote($form->{"template_$i"}) . qq|,
  95                        fee = '$form->{"fee_$i"}',
  96                        interest = '$form->{"interest_$i"}',
  97                        active = '$form->{"active_$i"}',
  98                        auto = '$form->{"auto_$i"}',
  99                        email = '$form->{"email_$i"}',
 100                        email_attachment = '$form->{"email_attachment_$i"}',
 101                        payment_terms = $form->{"payment_terms_$i"},
 102                        terms = $form->{"terms_$i"}
 103                        WHERE id=$form->{"id_$i"}|;
 104         $dbh->do($query)  || $form->dberror($query);
 105       } else {
 106         my $query = qq|INSERT INTO dunning_config (dunning_level, dunning_description, email_subject, email_body, template, fee, interest, active, auto, email, email_attachment, terms, payment_terms) VALUES (| . $dbh->quote($form->{"dunning_level_$i"}) . qq|,| . $dbh->quote($form->{"dunning_description_$i"}) . qq|,| . $dbh->quote($form->{"email_subject_$i"}) . qq|,| . $dbh->quote($form->{"email_body_$i"}) . qq|,| . $dbh->quote($form->{"template_$i"}) . qq|,'$form->{"fee_$i"}','$form->{"interest_$i"}','$form->{"active_$i"}','$form->{"auto_$i"}','$form->{"email_$i"}','$form->{"email_attachment_$i"}',$form->{"terms_$i"},$form->{"payment_terms_$i"})|;
 107         $dbh->do($query)  || $form->dberror($query);
 108       }
 109     }
 110     if (($form->{"dunning_description_$i"} eq "") && ($form->{"id_$i"})) {
 111       my $query = qq|DELETE FROM dunning_config WHERE id=$form->{"id_$i"}|;
 112       $dbh->do($query)  || $form->dberror($query);
 113     }
 114   }
 115
 116   $dbh->commit;
 117   $dbh->disconnect;
 118
 119   $main::lxdebug->leave_sub();
 120 }
 121
 122 sub save_dunning {
 123   $main::lxdebug->enter_sub();
 124
 125   my ($self, $myconfig, $form, $rows, $userspath,$spool, $sendmail) = @_;
 126   # connect to database
 127   my $dbh = $form->dbconnect_noauto($myconfig);
 128
 129   foreach my $row (@{ $rows }) {
 130
 131     $form->{"interest_$row"} = $form->parse_amount($myconfig,$form->{"interest_$row"});
 132     $form->{"fee_$row"} = $form->parse_amount($myconfig,$form->{"fee_$row"});
 133     $form->{send_email} = $form->{"email_$row"};
 134
 135     my $query = qq| UPDATE ar set dunning_id = '$form->{"next_dunning_id_$row"}' WHERE id='$form->{"inv_id_$row"}'|;
 136     $dbh->do($query) || $form->dberror($query);
 137     my $query = qq| INSERT into dunning (dunning_id,dunning_level,trans_id,fee,interest,transdate,duedate) VALUES ($form->{"next_dunning_id_$row"},(select dunning_level from dunning_config WHERE id=$form->{"next_dunning_id_$row"}),$form->{"inv_id_$row"},'$form->{"fee_$row"}', '$form->{"interest_$row"}',current_date, |.$dbh->quote($form->{"next_duedate_$row"}) . qq|)|;
 138     $dbh->do($query) || $form->dberror($query);
 139   }
 140
 141   my $query = qq| SELECT invnumber, ordnumber, customer_id, amount, netamount, ar.transdate, ar.duedate, paid, amount-paid AS open_amount, template AS formname, email_subject, email_body, email_attachment, da.fee, da.interest, da.transdate AS dunning_date, da.duedate AS dunning_duedate FROM ar LEFT JOIN dunning_config ON (dunning_config.id=ar.dunning_id) LEFT JOIN dunning da ON (ar.id=da.trans_id) where ar.id IN $form->{inv_ids}|;
 142   my $sth = $dbh->prepare($query);
 143   $sth->execute || $form->dberror($query);
 144   my $first = 1;
 145   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 146     if ($first) {
 147       map({ $form->{"dn_$_"} = []; } keys(%{$ref}));
 148       $first = 0;
 149     }
 150     map { $ref->{$_} = $form->format_amount($myconfig, $ref->{$_}, 2) } qw(amount netamount paid open_amount fee interest);
 151     map { $form->{$_} = $ref->{$_} } keys %$ref;
 152     #print(STDERR Dumper($ref));
 153     map { push @{ $form->{"dn_$_"} }, $ref->{$_}} keys %$ref;
 154   }
 155   $sth->finish;
 156
 157   IS->customer_details($myconfig,$form);
 158   #print(STDERR Dumper($form->{dn_invnumber}));
 159   $form->{templates} = "$myconfig->{templates}";
 160
 161
 162
 163   $form->{language} = $form->get_template_language(\%myconfig);
 164   $form->{printer_code} = $form->get_printer_code(\%myconfig);
 165
 166   if ($form->{language} ne "") {
 167     $form->{language} = "_" . $form->{language};
 168   }
 169
 170   if ($form->{printer_code} ne "") {
 171     $form->{printer_code} = "_" . $form->{printer_code};
 172   }
 173
 174   $form->{IN} = "$form->{formname}$form->{language}$form->{printer_code}.html";
 175   if ($form->{format} eq 'postscript') {
 176     $form->{postscript} = 1;
 177     $form->{IN} =~ s/html$/tex/;
 178   } elsif ($form->{"format"} =~ /pdf/) {
 179     $form->{pdf} = 1;
 180     if ($form->{"format"} =~ /opendocument/) {
 181       $form->{IN} =~ s/html$/odt/;
 182     } else {
 183       $form->{IN} =~ s/html$/tex/;
 184     }
 185   } elsif ($form->{"format"} =~ /opendocument/) {
 186     $form->{"opendocument"} = 1;
 187     $form->{"IN"} =~ s/html$/odt/;
 188   }
 189
 190   if ($form->{"send_email"} && $form->{email}) {
 191     $form->{media} = 'email';
 192   }
 193
 194   $form->{keep_tmpfile} = 0;
 195   if ($form->{media} eq 'email') {
 196     $form->{subject} = qq|$form->{label} $form->{"${inv}number"}|
 197       unless $form->{subject};
 198     if (!$form->{email_attachment}) {
 199       $form->{do_not_attach} = 1;
 200     } else {
 201       $form->{do_not_attach} = 0;
 202     }
 203     $form->{subject} = parse_strings($myconfig, $form, $userspath, $form->{email_subject});
 204     $form->{message} = parse_strings($myconfig, $form, $userspath, $form->{email_body});
 205
 206     $form->{OUT} = "$sendmail";
 207
 208   } else {
 209
 210     my $uid = rand() . time;
 211
 212     $uid .= $form->{login};
 213
 214     $uid = substr($uid, 2, 75);
 215     $filename = $uid;
 216
 217     $filename .= '.pdf';
 218     $form->{OUT} = ">$spool/$filename";
 219     push(@{ $form->{DUNNING_PDFS} }, $filename);
 220     $form->{keep_tmpfile} = 1;
 221   }
 222
 223   $form->parse_template($myconfig, $userspath);
 224
 225   $dbh->commit;
 226   $dbh->disconnect;
 227
 228   $main::lxdebug->leave_sub();
 229 }
 230
 231 sub get_invoices {
 232
 233   $main::lxdebug->enter_sub();
 234
 235   my ($self, $myconfig, $form) = @_;
 236
 237   # connect to database
 238   my $dbh = $form->dbconnect($myconfig);
 239
 240   $where = qq| WHERE 1=1 AND a.paid < a.amount AND a.duedate < current_date AND dnn.id = (select id from dunning_config WHERE dunning_level>(select case when a.dunning_id is null then 0 else (select dunning_level from dunning_config where id=a.dunning_id order by dunning_level  limit 1 ) end from dunning_config limit 1) limit 1) |;
 241
 242   if ($form->{"$form->{vc}_id"}) {
 243     $where .= qq| AND a.$form->{vc}_id = $form->{"$form->{vc}_id"}|;
 244   } else {
 245     if ($form->{ $form->{vc} }) {
 246       $where .= " AND lower(ct.name) LIKE '$name'";
 247     }
 248   }
 249
 250   my $sortorder = join ', ',
 251     ("a.id", $form->sort_columns(transdate, duedate, name));
 252   $sortorder = $form->{sort} if $form->{sort};
 253
 254   $where .= " AND lower(ordnumber) LIKE '$form->{ordnumber}'" if $form->{ordnumber};
 255   $where .= " AND lower(invnumber) LIKE '$form->{invnumber}'" if $form->{invnumber};
 256
 257
 258   $form->{minamount} = $form->parse_amount($myconfig,$form->{minamount});
 259   $where .= " AND a.dunning_id='$form->{dunning_level}'"
 260     if $form->{dunning_level};
 261   $where .= " AND a.ordnumber ilike '%$form->{ordnumber}%'"
 262     if $form->{ordnumber};
 263   $where .= " AND a.invnumber ilike '%$form->{invnumber}%'"
 264     if $form->{invnumber};
 265   $where .= " AND a.notes ilike '%$form->{notes}%'"
 266     if $form->{notes};
 267   $where .= " AND ct.name ilike '%$form->{customer}%'"
 268     if $form->{customer};
 269
 270   $where .= " AND a.amount-a.paid>'$form->{minamount}'"
 271     if $form->{minamount};
 272
 273   $where .= " ORDER by $sortorder";
 274
 275   $paymentdate = ($form->{paymentuntil}) ? "'$form->{paymentuntil}'" : current_date;
 276
 277   $query = qq|SELECT a.id, a.ordnumber, a.transdate, a.invnumber,a.amount, ct.name AS customername, a.customer_id, a.duedate,da.fee AS old_fee, dnn.fee as fee, dn.dunning_description, da.transdate AS dunning_date, da.duedate AS dunning_duedate, a.duedate + dnn.terms - current_date AS nextlevel, $paymentdate - a.duedate AS pastdue, dn.dunning_level, current_date + dnn.payment_terms AS next_duedate, dnn.dunning_description AS next_dunning_description, dnn.id AS next_dunning_id, dnn.interest AS interest_rate, dnn.terms
 278                  FROM dunning_config dnn, ar a
 279                  JOIN customer ct ON (a.customer_id = ct.id)
 280                  LEFT JOIN dunning_config dn ON (dn.id = a.dunning_id)
 281                  LEFT JOIN dunning da ON (da.trans_id=a.id)
 282                  $where|;
 283
 284   my $sth = $dbh->prepare($query);
 285   $sth->execute || $form->dberror($query);
 286
 287
 288   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 289     $ref->{fee} += $ref->{old_fee};
 290     $ref->{interest} = ($ref->{amount} * $ref->{pastdue} * $ref->{interest_rate}) /360;
 291     $ref->{interest} = $form->round_amount($ref->{interest},2);
 292     map { $ref->{$_} = $form->format_amount($myconfig, $ref->{$_}, 2)} qw(amount fee interest);
 293     if ($ref->{pastdue} >= $ref->{terms}) {
 294       push @{ $form->{DUNNINGS} }, $ref;
 295     }
 296   }
 297
 298   $sth->finish;
 299
 300   $query = qq|select id, dunning_description FROM dunning_config order by dunning_level|;
 301   my $sth = $dbh->prepare($query);
 302   $sth->execute || $form->dberror($query);
 303
 304   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 305     push @{ $form->{DUNNING_CONFIG} }, $ref;
 306   }
 307
 308   $sth->finish;
 309
 310   $dbh->disconnect;
 311   $main::lxdebug->leave_sub();
 312 }
 313
 314 sub get_dunning {
 315
 316   $main::lxdebug->enter_sub();
 317
 318   my ($self, $myconfig, $form) = @_;
 319
 320   # connect to database
 321   my $dbh = $form->dbconnect($myconfig);
 322
 323   $where = qq| WHERE 1=1 AND da.trans_id=a.id|;
 324
 325   if ($form->{"$form->{vc}_id"}) {
 326     $where .= qq| AND a.$form->{vc}_id = $form->{"$form->{vc}_id"}|;
 327   } else {
 328     if ($form->{ $form->{vc} }) {
 329       $where .= " AND lower(ct.name) LIKE '$name'";
 330     }
 331   }
 332
 333   my $sortorder = join ', ',
 334     ("a.id", $form->sort_columns(transdate, duedate, name));
 335   $sortorder = $form->{sort} if $form->{sort};
 336
 337   $where .= " AND lower(ordnumber) LIKE '$form->{ordnumber}'" if $form->{ordnumber};
 338   $where .= " AND lower(invnumber) LIKE '$form->{invnumber}'" if $form->{invnumber};
 339
 340
 341   $form->{minamount} = $form->parse_amount($myconfig,$form->{minamount});
 342   $where .= " AND a.dunning_id='$form->{dunning_level}'"
 343     if $form->{dunning_level};
 344   $where .= " AND a.ordnumber ilike '%$form->{ordnumber}%'"
 345     if $form->{ordnumber};
 346   $where .= " AND a.invnumber ilike '%$form->{invnumber}%'"
 347     if $form->{invnumber};
 348   $where .= " AND a.notes ilike '%$form->{notes}%'"
 349     if $form->{notes};
 350   $where .= " AND ct.name ilike '%$form->{customer}%'"
 351     if $form->{customer};
 352   $where .= " AND a.amount > a.paid AND da.dunning_id=a.dunning_id " unless ($form->{showold});
 353
 354   $where .= " AND a.transdate >='$form->{transdatefrom}' " if ($form->{transdatefrom});
 355   $where .= " AND a.transdate <='$form->{transdateto}' " if ($form->{transdateto});
 356   $where .= " AND da.transdate >='$form->{dunningfrom}' " if ($form->{dunningfrom});
 357   $where .= " AND da.transdate <='$form->{dunningto}' " if ($form->{dunningto});
 358
 359   $where .= " ORDER by $sortorder";
 360
 361
 362   $query = qq|SELECT a.id, a.ordnumber, a.transdate, a.invnumber,a.amount, ct.name AS customername, a.duedate,da.fee ,da.interest, dn.dunning_description, da.transdate AS dunning_date, da.duedate AS dunning_duedate
 363                  FROM ar a
 364                  JOIN customer ct ON (a.customer_id = ct.id),
 365                  dunning da LEFT JOIN dunning_config dn ON (da.dunning_id=dn.id)
 366                  $where|;
 367
 368   my $sth = $dbh->prepare($query);
 369   $sth->execute || $form->dberror($query);
 370
 371
 372   while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
 373
 374     map { $ref->{$_} = $form->format_amount($myconfig, $ref->{$_}, 2)} qw(amount fee interest);
 375     push @{ $form->{DUNNINGS} }, $ref;
 376   }
 377
 378   $sth->finish;
 379
 380
 381
 382   $dbh->disconnect;
 383   $main::lxdebug->leave_sub();
 384 }
 385
 386
 387 sub parse_strings {
 388
 389   $main::lxdebug->enter_sub();
 390
 391   my ($myconfig, $form, $userspath, $string) = @_;
 392
 393   my $format = $form->{format};
 394   $form->{format} = "html";
 395
 396   $tmpstring = "parse_string.html";
 397   $tmpfile = "$myconfig->{templates}/$tmpstring";
 398   open(OUT, ">$tmpfile") or $form->error("$tmpfile : $!");
 399   print(OUT $string);
 400   close(OUT);
 401
 402   my $in = $form->{IN};
 403   $form->{IN} = $tmpstring;
 404   $template = HTMLTemplate->new($tmpstring, $form, $myconfig, $userspath);
 405
 406   my $fileid = time;
 407   $form->{tmpfile} = "$userspath/${fileid}.$tmpstring";
 408   $out = $form->{OUT};
 409   $form->{OUT} = ">$form->{tmpfile}";
 410
 411   if ($form->{OUT}) {
 412     open(OUT, "$form->{OUT}") or $form->error("$form->{OUT} : $!");
 413   }
 414   if (!$template->parse(*OUT)) {
 415     $form->cleanup();
 416     $form->error("$form->{IN} : " . $template->get_error());
 417   }
 418
 419   close(OUT);
 420   my $result = "";
 421   open(IN, $form->{tmpfile}) or $form->error($form->cleanup . "$form->{tmpfile} : $!");
 422
 423   while (<IN>) {
 424     $result .= $_;
 425   }
 426
 427   close(IN);
 428 #   unlink($tmpfile);
 429 #   unlink($form->{tmpfile});
 430   $form->{IN} = $in;
 431   $form->{format} = $format;
 432
 433   $main::lxdebug->leave_sub();
 434   return $result;
 435 }
 436
 437 sub melt_pdfs {
 438
 439   $main::lxdebug->enter_sub();
 440
 441   my ($self, $myconfig, $form, $userspath) = @_;
 442
 443   foreach my $file (@{ $form->{DUNNING_PDFS} }) {
 444     $inputfiles .= " $userspath/$file ";
 445   }
 446
 447   my $outputfile = "$userspath/dunning.pdf";
 448   system("gs -dBATCH -dNOPAUSE -q -sDEVICE=pdfwrite -sOutputFile=$outputfile $inputfiles");
 449   foreach my $file (@{ $form->{DUNNING_PDFS} }) {
 450     unlink("$userspath/$file");
 451   }
 452   $out="";
 453
 454
 455      $form->{OUT} = $out;
 456
 457       my $numbytes = (-s $outputfile);
 458       open(IN, $outputfile)
 459         or $form->error($self->cleanup . "$outputfile : $!");
 460
 461       $form->{copies} = 1 unless $form->{media} eq 'printer';
 462
 463       chdir("$self->{cwd}");
 464
 465       for my $i (1 .. $form->{copies}) {
 466         if ($form->{OUT}) {
 467           open(OUT, $form->{OUT})
 468             or $form->error($form->cleanup . "$form->{OUT} : $!");
 469         } else {
 470
 471           # launch application
 472           print qq|Content-Type: Application/PDF
 473 Content-Disposition: attachment; filename="$outputfile"
 474 Content-Length: $numbytes
 475
 476 |;
 477
 478           open(OUT, ">-") or $form->error($form->cleanup . "$!: STDOUT");
 479
 480         }
 481
 482         while (<IN>) {
 483           print OUT $_;
 484         }
 485
 486         close(OUT);
 487
 488         seek IN, 0, 0;
 489       }
 490
 491       close(IN);
 492   unlink("$userspath/$outputfile");
 493
 494   $main::lxdebug->leave_sub();
 495 }
 496
 497 1;