bin/cust_bill-credit34

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use vars qw( $opt_d $opt_s $opt_p $opt_m $opt_c $opt_e $opt_r );
   5 use Getopt::Std;
   6 use Date::Parse qw(str2time);
   7 use FS::UID qw( dbh adminsuidsetup );
   8 use FS::Record qw( qsearch qsearchs );
   9 use FS::cust_main_county;
  10 use FS::cust_bill;
  11 use FS::msg_template;
  12 use FS::cust_credit;
  13 use FS::cust_credit_bill;
  14
  15 getopts('d:s:pm:c:er');
  16
  17 my $user = shift or &usage;
  18 adminsuidsetup $user;
  19
  20 #i should be an option
  21 my $taxname = 'HST, ON';
  22 my $rate = '13';
  23
  24 my $oldAutoCommit = $FS::UID::AutoCommit;
  25 local $FS::UID::AutoCommit = 0;
  26 my $dbh = dbh;
  27
  28 # only pkgpart 34
  29
  30 ###
  31 # find invoices
  32 ###
  33
  34 #my $extra_sql = $opt_s ? " AND cust_main.state = '$opt_s' " : '';
  35
  36 my $start_date = $opt_d ? str2time($opt_d) : 0;
  37 my $end_date = 1375471643;
  38
  39 my @cust_bill = qsearch({
  40   'select'    => 'cust_bill.*',
  41   'table'     => 'cust_bill',
  42   'addl_from' => 'LEFT JOIN cust_main USING ( custnum )',
  43   'hashref'   => { '_date' => { op=>'>', value=>$start_date } },
  44   'extra_sql' => " AND _date < $end_date ",
  45 #  'extra_sql' => $extra_sql,
  46 });
  47
  48 my( @billpkgnums, @setuprecurs, @amounts );
  49
  50 foreach my $cust_bill ( @cust_bill ) {
  51
  52   my $tax = $cust_bill->tax;
  53
  54   my $cust_main = $cust_bill->cust_main;
  55
  56   next if $cust_bill->charged == 0
  57        or $tax == 0
  58        or $cust_main->tax eq 'Y';
  59
  60   my $credit = 0;
  61
  62   @billpkgnums = ();
  63   @setuprecurs = ();
  64   @amounts = ();
  65
  66   foreach my $cust_bill_pkg ( $cust_bill->cust_bill_pkg ) {
  67     my $cust_pkg = $cust_bill_pkg->cust_pkg or next;
  68
  69     my $loc = $cust_pkg->cust_location_or_main;
  70     next if $opt_s && $loc->state ne $opt_s;
  71
  72     my $part_pkg = $cust_pkg->part_pkg;
  73     next unless $cust_pkg->pkgpart == 34; #only pkgpart 34
  74
  75     #my $amount = $cust_bill_pkg->setup + $cust_bill_pkg->recur;
  76     #$credit += $rate * $amount / 100;
  77
  78     if ( $cust_bill_pkg->setup ) {
  79       my $scredit = sprintf('%.2f', ($rate * $cust_bill_pkg->setup / 100) + 0.00000001);
  80       $credit += $scredit;
  81       push @setuprecurs, 'setup';
  82       push @billpkgnums, $cust_bill_pkg->billpkgnum;
  83       push @amounts, $scredit;
  84     }
  85
  86     if ( $cust_bill_pkg->recur ) {
  87       my $rcredit = sprintf('%.2f', ($rate * $cust_bill_pkg->recur / 100) + 0.00000001);
  88       $credit += $rcredit;
  89       push @setuprecurs, 'recur';
  90       push @billpkgnums, $cust_bill_pkg->billpkgnum;
  91       push @amounts, $rcredit;
  92     }
  93
  94   }
  95
  96   $credit = sprintf('%.2f', $credit + 0.00000001);
  97
  98   next if $credit == 0;
  99
 100   #$credit = sprintf('%.2f', $credit + 0.00000001);
 101
 102   warn "invoice ". $cust_bill->invnum. ": credit of $credit is more than orignally taxed ($tax)\n" if $credit > $tax;
 103
 104   warn "invoice ". $cust_bill->invnum. ": credit of $credit is more than 50% of originally taxed ($tax)\n" if $credit-0.01 > $tax/2;
 105
 106   #my $cr_percent = sprintf('%.1f', 100 * $credit / $tax);
 107
 108   if ( $opt_p ) {
 109     #print $cust_bill->invnum. ','. $cust_bill->custnum. ",$tax,$credit,$cr_percent%\n";
 110     print $cust_bill->invnum. ','. $cust_bill->custnum. ',"'.
 111           $cust_bill->cust_main->name. '",'. "$tax,$credit\n";
 112   }
 113
 114   if ( $opt_m && ! $opt_r ) {
 115
 116     my $msg_template = qsearchs('msg_template', { 'msgnum' => $opt_m } )
 117         or die "Template $opt_m not found";
 118     my $error = $msg_template->send(
 119       'cust_main' => $cust_main,
 120       'object'    => $cust_main,
 121     );
 122     if ( $error ) {
 123       warn "error sending email for invnum ". $cust_bill->invnum. ','.
 124            " custnum ". $cust_bill->custnum. ": $error\n";
 125     }
 126   }
 127
 128   if ( $opt_c ) {
 129     my $cust_credit = new FS::cust_credit {
 130       'custnum'   => $cust_main->custnum,
 131       'amount'    => $credit,
 132       'reasonnum' => $opt_c,
 133     };
 134     my $error = $cust_credit->insert;
 135     if ( $error ) {
 136       warn "error inserting credit: $error\n";
 137     }
 138     my $cust_credit_bill = new FS::cust_credit_bill {
 139       'crednum' => $cust_credit->crednum,
 140       'invnum'  => $cust_bill->invnum,
 141       'amount'  => $credit,
 142     };
 143     my $aerror = $cust_credit_bill->insert;
 144     if ( $aerror ) {
 145       warn "error applying credit to invnum ". $cust_bill->invnum. ": $aerror\n";
 146     }
 147   }
 148
 149   if ( $opt_e && ! $opt_r ) {
 150     eval { $cust_bill->email };
 151     if ( $@ ) {
 152       warn "error sending invnum ". $cust_bill->invnum. ','.
 153          " custnum ". $cust_bill->custnum. ": $@\n";
 154     }
 155   }
 156
 157 }
 158
 159 if ( $opt_r ) {
 160   $dbh->rollback or die $dbh->errstr; #if $oldAutoCommit;
 161 } else {
 162   $dbh->commit or die $dbh->errstr; #if $oldAutoCommit;
 163 }
 164
 165 sub usage {
 166   die "usage:  cust_bill-credit [ -d date ] [ -s state ] [ -p ] [ -m templatenum ] [ -c reasonnum ] [ -e ] [ -r ] employee_username\n";
 167 }
 168
 169 =head1 NAME
 170
 171 cust_bill-credit
 172
 173 =head1 SYNOPSIS
 174
 175   cust_bill-credit [ -d date ] [ -s state ] [ -p ] [ -m templatenum ] [ -c reasonnum ] [ -e ] employee_username
 176
 177 =head1 DESCRIPTION
 178
 179 Command-line tool to search for and credit invoices.
 180
 181 -d: Search for invoices starting from this date
 182
 183 -s: Search for invoices for packages within this state
 184
 185 -p: Print an informational line for each invoice with invnum, custnum, original tax amount, calculate credit, and credit percentage of original.
 186
 187 -m: Send an email to the customer with this message template.
 188
 189 -c: Credit the invoice for one-half of the taxation amount, using this reason.
 190
 191 -e: re-Email invoice
 192
 193 -r: dRy run
 194
 195 employee_username
 196
 197 =head1 BUGS
 198
 199 =head1 SEE ALSO
 200
 201 L<FS::part_pkg>
 202
 203 =cut
 204
 205 1;