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 $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 #  -a: Only process customers with the specified agentnum
 180 #
 181 #  -v: enable debugging
 182 #
 183 #  -l: debugging level
 184
 185 =item bill_where
 186
 187 Internal function.  Returns a WHERE clause to select the set of customers who
 188 have actionable packages (no setup date, or bill date in the past, or expire
 189 or adjourn dates in the past) or events (does a complete where_conditions_sql
 190 scan).
 191
 192 =cut
 193
 194 sub bill_where {
 195   my( %opt ) = @_;
 196
 197   my $time = $opt{'time'};
 198   my $invoice_time = $opt{'invoice_time'};
 199
 200   my $check_freq = $opt{'check_freq'} || '1d';
 201
 202   my @search = ();
 203
 204   push @search, "( cust_main.archived != 'Y' OR archived IS NULL )"; #disable?
 205
 206   push @search, "cust_main.agentnum IN ( ". $opt{'a'}. " ) "
 207     if $opt{'a'};
 208
 209   #it would be useful if i recognized $opt{g} / $not_pkgpart...
 210
 211   if ( @ARGV ) {
 212     push @search, "( ".
 213       join(' OR ', map "cust_main.custnum = $_", @ARGV ).
 214     " )";
 215   }
 216
 217   ###
 218   # generate where_pkg/where_event search clause
 219   ###
 220
 221   my $conf = new FS::Conf;
 222   my $billtime = $conf->exists('next-bill-ignore-time') ? day_end($time) : $time;
 223
 224   # corresponds to perl checks in FS::cust_main::Billing sub bill
 225   #  ("bill setup" and "bill recurring fee")
 226   # select * from cust_main where
 227   my $where_pkg = <<"END";
 228     EXISTS(
 229       SELECT 1 FROM cust_pkg LEFT JOIN part_pkg USING ( pkgpart )
 230         WHERE cust_main.custnum = cust_pkg.custnum
 231           AND ( cancel IS NULL OR cancel = 0 )
 232           AND (    ( ( cust_pkg.setup IS NULL OR cust_pkg.setup =  0 )
 233                      AND ( start_date IS NULL OR start_date = 0
 234                            OR ( start_date IS NOT NULL AND start_date <= $billtime )
 235                          )
 236                    )
 237                 OR ( freq != '0' AND ( bill IS NULL OR bill  <= $billtime ) )
 238                 OR ( expire  IS NOT NULL AND expire  <= $^T )
 239                 OR ( adjourn IS NOT NULL AND adjourn <= $^T )
 240                 OR ( resume  IS NOT NULL AND resume  <= $^T )
 241               )
 242     )
 243 END
 244
 245   #some false laziness w/cust_main::Billing due_cust_event
 246   my $where_event = join(' OR ', map {
 247     my $eventtable = $_;
 248
 249     # joins and where clauses to test event conditions
 250     my $join  = FS::part_event_condition->join_conditions_sql(  $eventtable,
 251                                                                 'time'=>$time );
 252     my $where = FS::part_event_condition->where_conditions_sql( $eventtable,
 253                                                                 'time'=>$time,
 254                                                               );
 255     $where = $where ? "AND $where" : '';
 256
 257     # test to return all applicable part_events (defined on this eventtable,
 258     # not disabled, check_freq correct, and all event conditions true)
 259     my $are_part_event =
 260       "EXISTS ( SELECT 1 FROM part_event $join
 261                   WHERE check_freq = '$check_freq'
 262                     AND eventtable = '$eventtable'
 263                     AND ( disabled = '' OR disabled IS NULL )
 264                     $where
 265               )
 266       ";
 267
 268     if ( $eventtable eq 'cust_main' ) {
 269       $are_part_event;
 270     } else {
 271       my $cust_join = FS::part_event->eventtables_cust_join->{$eventtable}
 272                       || '';
 273       my $custnum = FS::part_event->eventtables_custnum->{$eventtable};
 274       "EXISTS ( SELECT 1 FROM $eventtable $cust_join
 275                   WHERE cust_main.custnum = $custnum
 276                     AND $are_part_event
 277               )
 278       ";
 279     }
 280
 281   } FS::part_event->eventtables);
 282
 283   push @search, "( $where_pkg OR $where_event )";
 284
 285   warn "searching for customers:\n". join("\n", @search). "\n"
 286     if $opt{'v'} || $opt{'l'};
 287
 288   join(' AND ', @search);
 289
 290 }
 291
 292 1;