FS/FS/Cron/bill.pm

   1 package FS::Cron::bill;
   2
   3 use strict;
   4 use vars qw( @ISA @EXPORT_OK );
   5 use Exporter;
   6 use Date::Parse;
   7 use DBI 1.33; #The "clone" method was added in DBI 1.33.
   8 use FS::UID qw( dbh driver_name );
   9 use FS::Record qw( qsearch qsearchs );
  10 use FS::Misc::DateTime qw( day_end );
  11 use FS::queue;
  12 use FS::cust_main;
  13 use FS::part_event;
  14 use FS::part_event_condition;
  15
  16 use FS::Log;
  17
  18 @ISA = qw( Exporter );
  19 @EXPORT_OK = qw ( bill bill_where );
  20
  21 #freeside-daily %opt:
  22 #  -s: re-charge setup fees
  23 #  -v: enable debugging
  24 #  -l: debugging level
  25 #  -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing.
  26 #  -r: Multi-process mode dry run option
  27 #  -g: Don't bill these pkgparts
  28
  29 sub bill {
  30   my %opt = @_;
  31
  32   my $log = FS::Log->new('Cron::bill');
  33   $log->info('start');
  34
  35   my $check_freq = $opt{'check_freq'} || '1d';
  36
  37   my $debug = 0;
  38   $debug = 1 if $opt{'v'};
  39   $debug = $opt{'l'} if $opt{'l'};
  40   $FS::cust_main::DEBUG = $debug;
  41   #$FS::cust_event::DEBUG = $opt{'l'} if $opt{'l'};
  42
  43   my $conf = new FS::Conf;
  44   my $disable_bill = 0;
  45   if ( $conf->exists('disable_cron_billing') ) {
  46     warn "disable_cron_billing set, skipping billing\n" if $debug;
  47     $disable_bill = 1;
  48   }
  49
  50   #we're at now now (and later).
  51   $opt{'time'} = $opt{'d'} ? str2time($opt{'d'}) : $^T;
  52   $opt{'time'} += $opt{'y'} * 86400 if $opt{'y'};
  53
  54   $opt{'invoice_time'} = $opt{'n'} ? $^T : $opt{'time'};
  55
  56   #hashref here doesn't work with -m
  57   #my $not_pkgpart = $opt{g} ? { map { $_=>1 } split(/,\s*/, $opt{g}) }
  58   #                          : {};
  59
  60   ###
  61   # get a list of custnums
  62   ###
  63
  64   my $cursor_dbh = dbh->clone;
  65
  66   my $select = 'SELECT custnum FROM cust_main WHERE '. bill_where( %opt );
  67
  68   unless ( driver_name =~ /^mysql/ ) {
  69     $cursor_dbh->do( "DECLARE cron_bill_cursor CURSOR FOR $select" )
  70       or die $cursor_dbh->errstr;
  71   }
  72
  73   while ( 1 ) {
  74
  75     my $sql = (driver_name =~ /^mysql/)
  76       ? $select
  77       : 'FETCH 100 FROM cron_bill_cursor';
  78
  79     my $sth = $cursor_dbh->prepare($sql);
  80
  81     $sth->execute or die $sth->errstr;
  82
  83     my @custnums = map { $_->[0] } @{ $sth->fetchall_arrayref };
  84
  85     last unless scalar(@custnums);
  86
  87     ###
  88     # for each custnum, queue or make one customer object and bill
  89     # (one at a time, to reduce memory footprint with large #s of customers)
  90     ###
  91
  92     foreach my $custnum ( @custnums ) {
  93
  94       my %args = (
  95           'time'         => $opt{'time'},
  96           'invoice_time' => $opt{'invoice_time'},
  97           'actual_time'  => $^T, #when freeside-bill was started
  98                                  #(not, when using -m, freeside-queued)
  99           'check_freq'   => $check_freq,
 100           'resetup'      => ( $opt{'s'} ? $opt{'s'} : 0 ),
 101           'not_pkgpart'  => $opt{'g'}, #$not_pkgpart,
 102           'one_recur'    => $opt{'o'},
 103           'no_prepaid'   => 1,
 104       );
 105
 106       if ( $opt{'m'} ) {
 107
 108         if ( $opt{'r'} ) {
 109           warn "DRY RUN: would add custnum $custnum for queued_bill\n";
 110         } else {
 111
 112           #avoid queuing another job if there's one still waiting to run
 113           next if qsearch( 'queue', { 'job'     => 'FS::cust_main::queued_bill',
 114                                       'custnum' => $custnum,
 115                                       'status'  => 'new',
 116                                     }
 117                          );
 118
 119           #add job to queue that calls bill_and_collect with options
 120           my $queue = new FS::queue {
 121             'job'      => 'FS::cust_main::queued_bill',
 122             'secure'   => 'Y',
 123             'priority' => 99, #don't get in the way of provisioning jobs
 124           };
 125           my $error = $queue->insert( 'custnum'=>$custnum, %args );
 126
 127         }
 128
 129       } else {
 130
 131         my $cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } );
 132         if ( $disable_bill ) {
 133           $cust_main->collect( %args, 'debug' => $debug );
 134         } else {
 135           $cust_main->bill_and_collect( %args, 'debug' => $debug );
 136         }
 137
 138       }
 139
 140     }
 141
 142     last if driver_name =~ /^mysql/;
 143
 144   }
 145
 146   $cursor_dbh->commit or die $cursor_dbh->errstr;
 147
 148   $log->info('finish');
 149 }
 150
 151 # freeside-daily %opt:
 152 #  -d: Pretend it's 'date'.  Date is in any format Date::Parse is happy with,
 153 #      but be careful.
 154 #
 155 #  -y: In addition to -d, which specifies an absolute date, the -y switch
 156 #      specifies an offset, in days.  For example, "-y 15" would increment the
 157 #      "pretend date" 15 days from whatever was specified by the -d switch
 158 #      (or now, if no -d switch was given).
 159 #
 160 #  -n: When used with "-d" and/or "-y", specifies that invoices should be dated
 161 #      with today's date, regardless of the pretend date used to pre-generate
 162 #      the invoices.
 163 #
 164 #  -p: Only process customers with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>)
 165 #
 166 #  -a: Only process customers with the specified agentnum
 167 #
 168 #  -v: enable debugging
 169 #
 170 #  -l: debugging level
 171
 172 =item bill_where
 173
 174 Internal function.  Returns a WHERE clause to select the set of customers who
 175 have actionable packages (no setup date, or bill date in the past, or expire
 176 or adjourn dates in the past) or events (does a complete where_conditions_sql
 177 scan).
 178
 179 =cut
 180
 181 sub bill_where {
 182   my( %opt ) = @_;
 183
 184   my $time = $opt{'time'};
 185   my $invoice_time = $opt{'invoice_time'};
 186
 187   my $check_freq = $opt{'check_freq'} || '1d';
 188
 189   my @search = ();
 190
 191   push @search, "( cust_main.archived != 'Y' OR archived IS NULL )"; #disable?
 192
 193   push @search, "cust_main.payby    = '". $opt{'p'}. "'"
 194     if $opt{'p'};
 195   push @search, "cust_main.agentnum IN ( ". $opt{'a'}. " ) "
 196     if $opt{'a'};
 197
 198   #it would be useful if i recognized $opt{g} / $not_pkgpart...
 199
 200   if ( @ARGV ) {
 201     push @search, "( ".
 202       join(' OR ', map "cust_main.custnum = $_", @ARGV ).
 203     " )";
 204   }
 205
 206   ###
 207   # generate where_pkg/where_event search clause
 208   ###
 209
 210   my $conf = new FS::Conf;
 211   my $billtime = $conf->exists('next-bill-ignore-time') ? day_end($time) : $time;
 212
 213   # corresponds to perl checks in FS::cust_main::Billing sub bill
 214   #  ("bill setup" and "bill recurring fee")
 215   # select * from cust_main where
 216   my $where_pkg = <<"END";
 217     EXISTS(
 218       SELECT 1 FROM cust_pkg LEFT JOIN part_pkg USING ( pkgpart )
 219         WHERE cust_main.custnum = cust_pkg.custnum
 220           AND ( cancel IS NULL OR cancel = 0 )
 221           AND (    ( ( cust_pkg.setup IS NULL OR cust_pkg.setup =  0 )
 222                      AND ( start_date IS NULL OR start_date = 0
 223                            OR ( start_date IS NOT NULL AND start_date <= $billtime )
 224                          )
 225                    )
 226                 OR ( freq != '0' AND ( bill IS NULL OR bill  <= $billtime ) )
 227                 OR ( expire  IS NOT NULL AND expire  <= $^T )
 228                 OR ( adjourn IS NOT NULL AND adjourn <= $^T )
 229                 OR ( resume  IS NOT NULL AND resume  <= $^T )
 230               )
 231     )
 232 END
 233
 234   #some false laziness w/cust_main::Billing due_cust_event
 235   my $where_event = join(' OR ', map {
 236     my $eventtable = $_;
 237
 238     # joins and where clauses to test event conditions
 239     my $join  = FS::part_event_condition->join_conditions_sql(  $eventtable );
 240     my $where = FS::part_event_condition->where_conditions_sql( $eventtable,
 241                                                                 'time'=>$time,
 242                                                               );
 243     $where = $where ? "AND $where" : '';
 244
 245     # test to return all applicable part_events (defined on this eventtable,
 246     # not disabled, check_freq correct, and all event conditions true)
 247     my $are_part_event =
 248       "EXISTS ( SELECT 1 FROM part_event $join
 249                   WHERE check_freq = '$check_freq'
 250                     AND eventtable = '$eventtable'
 251                     AND ( disabled = '' OR disabled IS NULL )
 252                     $where
 253               )
 254       ";
 255
 256     if ( $eventtable eq 'cust_main' ) {
 257       $are_part_event;
 258     } else {
 259       my $cust_join = FS::part_event->eventtables_cust_join->{$eventtable}
 260                       || '';
 261       my $custnum = FS::part_event->eventtables_custnum->{$eventtable};
 262       "EXISTS ( SELECT 1 FROM $eventtable $cust_join
 263                   WHERE cust_main.custnum = $custnum
 264                     AND $are_part_event
 265               )
 266       ";
 267     }
 268
 269   } FS::part_event->eventtables);
 270
 271   push @search, "( $where_pkg OR $where_event )";
 272
 273   warn "searching for customers:\n". join("\n", @search). "\n"
 274     if $opt{'v'} || $opt{'l'};
 275
 276   join(' AND ', @search);
 277
 278 }
 279
 280 1;