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           die $error if $error;
 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           my $error = $cust_main->bill_and_collect( %args, 'fatal' => 'return',
 136                                                            'debug' => $debug, );
 137           if ( $error ) {
 138             $log->error($error);
 139             warn $error; #die $error;
 140           }
 141         }
 142
 143       }
 144
 145     }
 146
 147     last if driver_name =~ /^mysql/;
 148
 149   }
 150
 151   $cursor_dbh->commit or die $cursor_dbh->errstr;
 152
 153   $log->info('finish');
 154 }
 155
 156 # freeside-daily %opt:
 157 #  -d: Pretend it's 'date'.  Date is in any format Date::Parse is happy with,
 158 #      but be careful.
 159 #
 160 #  -y: In addition to -d, which specifies an absolute date, the -y switch
 161 #      specifies an offset, in days.  For example, "-y 15" would increment the
 162 #      "pretend date" 15 days from whatever was specified by the -d switch
 163 #      (or now, if no -d switch was given).
 164 #
 165 #  -n: When used with "-d" and/or "-y", specifies that invoices should be dated
 166 #      with today's date, regardless of the pretend date used to pre-generate
 167 #      the invoices.
 168 #
 169 #  -p: Only process customers with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>)
 170 #
 171 #  -a: Only process customers with the specified agentnum
 172 #
 173 #  -v: enable debugging
 174 #
 175 #  -l: debugging level
 176
 177 =item bill_where
 178
 179 Internal function.  Returns a WHERE clause to select the set of customers who
 180 have actionable packages (no setup date, or bill date in the past, or expire
 181 or adjourn dates in the past) or events (does a complete where_conditions_sql
 182 scan).
 183
 184 =cut
 185
 186 sub bill_where {
 187   my( %opt ) = @_;
 188
 189   my $time = $opt{'time'};
 190   my $invoice_time = $opt{'invoice_time'};
 191
 192   my $check_freq = $opt{'check_freq'} || '1d';
 193
 194   my @search = ();
 195
 196   push @search, "( cust_main.archived != 'Y' OR archived IS NULL )"; #disable?
 197
 198   push @search, "cust_main.payby    = '". $opt{'p'}. "'"
 199     if $opt{'p'};
 200   push @search, "cust_main.agentnum IN ( ". $opt{'a'}. " ) "
 201     if $opt{'a'};
 202
 203   #it would be useful if i recognized $opt{g} / $not_pkgpart...
 204
 205   if ( @ARGV ) {
 206     push @search, "( ".
 207       join(' OR ', map "cust_main.custnum = $_", @ARGV ).
 208     " )";
 209   }
 210
 211   ###
 212   # generate where_pkg/where_event search clause
 213   ###
 214
 215   my $conf = new FS::Conf;
 216   my $billtime = $conf->exists('next-bill-ignore-time') ? day_end($time) : $time;
 217
 218   # corresponds to perl checks in FS::cust_main::Billing sub bill
 219   #  ("bill setup" and "bill recurring fee")
 220   # select * from cust_main where
 221   my $where_pkg = <<"END";
 222     EXISTS(
 223       SELECT 1 FROM cust_pkg LEFT JOIN part_pkg USING ( pkgpart )
 224         WHERE cust_main.custnum = cust_pkg.custnum
 225           AND ( cancel IS NULL OR cancel = 0 )
 226           AND (    ( ( cust_pkg.setup IS NULL OR cust_pkg.setup =  0 )
 227                      AND ( start_date IS NULL OR start_date = 0
 228                            OR ( start_date IS NOT NULL AND start_date <= $billtime )
 229                          )
 230                    )
 231                 OR ( freq != '0' AND ( bill IS NULL OR bill  <= $billtime ) )
 232                 OR ( expire  IS NOT NULL AND expire  <= $^T )
 233                 OR ( adjourn IS NOT NULL AND adjourn <= $^T )
 234                 OR ( resume  IS NOT NULL AND resume  <= $^T )
 235               )
 236     )
 237 END
 238
 239   #some false laziness w/cust_main::Billing due_cust_event
 240   my $where_event = join(' OR ', map {
 241     my $eventtable = $_;
 242
 243     # joins and where clauses to test event conditions
 244     my $join  = FS::part_event_condition->join_conditions_sql(  $eventtable,
 245                                                                 'time'=>$time );
 246     my $where = FS::part_event_condition->where_conditions_sql( $eventtable,
 247                                                                 'time'=>$time,
 248                                                               );
 249     $where = $where ? "AND $where" : '';
 250
 251     # test to return all applicable part_events (defined on this eventtable,
 252     # not disabled, check_freq correct, and all event conditions true)
 253     my $are_part_event =
 254       "EXISTS ( SELECT 1 FROM part_event $join
 255                   WHERE check_freq = '$check_freq'
 256                     AND eventtable = '$eventtable'
 257                     AND ( disabled = '' OR disabled IS NULL )
 258                     $where
 259               )
 260       ";
 261
 262     if ( $eventtable eq 'cust_main' ) {
 263       $are_part_event;
 264     } else {
 265       my $cust_join = FS::part_event->eventtables_cust_join->{$eventtable}
 266                       || '';
 267       my $custnum = FS::part_event->eventtables_custnum->{$eventtable};
 268       "EXISTS ( SELECT 1 FROM $eventtable $cust_join
 269                   WHERE cust_main.custnum = $custnum
 270                     AND $are_part_event
 271               )
 272       ";
 273     }
 274
 275   } FS::part_event->eventtables);
 276
 277   push @search, "( $where_pkg OR $where_event )";
 278
 279   warn "searching for customers:\n". join("\n", @search). "\n"
 280     if $opt{'v'} || $opt{'l'};
 281
 282   join(' AND ', @search);
 283
 284 }
 285
 286 1;