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           next if @waiting && ! $opt{'q'};
 121
 122           #add job to queue that calls bill_and_collect with options
 123           my $queue = new FS::queue {
 124             'job'      => 'FS::cust_main::queued_bill',
 125             'secure'   => 'Y',
 126             'priority' => 99, #don't get in the way of provisioning jobs
 127           };
 128           my $error = $queue->insert( 'custnum'=>$custnum, %args );
 129           die $error if $error;
 130
 131           foreach $waiting_queue (@waiting) {
 132             $queue->depend_insert($waiting_queue->jobnum);
 133           }
 134
 135         }
 136
 137       } else {
 138
 139         my $cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } );
 140         if ( $disable_bill ) {
 141           $cust_main->collect( %args, 'debug' => $debug );
 142         } else {
 143           my $error = $cust_main->bill_and_collect( %args, 'fatal' => 'return',
 144                                                            'debug' => $debug, );
 145           if ( $error ) {
 146             $log->error($error);
 147             warn $error; #die $error;
 148           }
 149         }
 150
 151       }
 152
 153     }
 154
 155     last if driver_name =~ /^mysql/;
 156
 157   }
 158
 159   $cursor_dbh->commit or die $cursor_dbh->errstr;
 160
 161   $log->info('finish');
 162 }
 163
 164 # freeside-daily %opt:
 165 #  -d: Pretend it's 'date'.  Date is in any format Date::Parse is happy with,
 166 #      but be careful.
 167 #
 168 #  -y: In addition to -d, which specifies an absolute date, the -y switch
 169 #      specifies an offset, in days.  For example, "-y 15" would increment the
 170 #      "pretend date" 15 days from whatever was specified by the -d switch
 171 #      (or now, if no -d switch was given).
 172 #
 173 #  -n: When used with "-d" and/or "-y", specifies that invoices should be dated
 174 #      with today's date, regardless of the pretend date used to pre-generate
 175 #      the invoices.
 176 #
 177 #  -p: Only process customers with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>)
 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.payby    = '". $opt{'p'}. "'"
 207     if $opt{'p'};
 208   push @search, "cust_main.agentnum IN ( ". $opt{'a'}. " ) "
 209     if $opt{'a'};
 210
 211   #it would be useful if i recognized $opt{g} / $not_pkgpart...
 212
 213   if ( @ARGV ) {
 214     push @search, "( ".
 215       join(' OR ', map "cust_main.custnum = $_", @ARGV ).
 216     " )";
 217   }
 218
 219   ###
 220   # generate where_pkg/where_event search clause
 221   ###
 222
 223   my $conf = new FS::Conf;
 224   my $billtime = $conf->exists('next-bill-ignore-time') ? day_end($time) : $time;
 225
 226   # corresponds to perl checks in FS::cust_main::Billing sub bill
 227   #  ("bill setup" and "bill recurring fee")
 228   # select * from cust_main where
 229   my $where_pkg = <<"END";
 230     EXISTS(
 231       SELECT 1 FROM cust_pkg LEFT JOIN part_pkg USING ( pkgpart )
 232         WHERE cust_main.custnum = cust_pkg.custnum
 233           AND ( cancel IS NULL OR cancel = 0 )
 234           AND (    ( ( cust_pkg.setup IS NULL OR cust_pkg.setup =  0 )
 235                      AND ( start_date IS NULL OR start_date = 0
 236                            OR ( start_date IS NOT NULL AND start_date <= $billtime )
 237                          )
 238                    )
 239                 OR ( freq != '0' AND ( bill IS NULL OR bill  <= $billtime ) )
 240                 OR ( expire  IS NOT NULL AND expire  <= $^T )
 241                 OR ( adjourn IS NOT NULL AND adjourn <= $^T )
 242                 OR ( resume  IS NOT NULL AND resume  <= $^T )
 243               )
 244     )
 245 END
 246
 247   #some false laziness w/cust_main::Billing due_cust_event
 248   my $where_event = join(' OR ', map {
 249     my $eventtable = $_;
 250
 251     # joins and where clauses to test event conditions
 252     my $join  = FS::part_event_condition->join_conditions_sql(  $eventtable,
 253                                                                 'time'=>$time );
 254     my $where = FS::part_event_condition->where_conditions_sql( $eventtable,
 255                                                                 'time'=>$time,
 256                                                               );
 257     $where = $where ? "AND $where" : '';
 258
 259     # test to return all applicable part_events (defined on this eventtable,
 260     # not disabled, check_freq correct, and all event conditions true)
 261     my $are_part_event =
 262       "EXISTS ( SELECT 1 FROM part_event $join
 263                   WHERE check_freq = '$check_freq'
 264                     AND eventtable = '$eventtable'
 265                     AND ( disabled = '' OR disabled IS NULL )
 266                     $where
 267               )
 268       ";
 269
 270     if ( $eventtable eq 'cust_main' ) {
 271       $are_part_event;
 272     } else {
 273       my $cust_join = FS::part_event->eventtables_cust_join->{$eventtable}
 274                       || '';
 275       my $custnum = FS::part_event->eventtables_custnum->{$eventtable};
 276       "EXISTS ( SELECT 1 FROM $eventtable $cust_join
 277                   WHERE cust_main.custnum = $custnum
 278                     AND $are_part_event
 279               )
 280       ";
 281     }
 282
 283   } FS::part_event->eventtables);
 284
 285   push @search, "( $where_pkg OR $where_event )";
 286
 287   warn "searching for customers:\n". join("\n", @search). "\n"
 288     if $opt{'v'} || $opt{'l'};
 289
 290   join(' AND ', @search);
 291
 292 }
 293
 294 1;