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