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