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