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