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 @ISA = qw( Exporter );
  17 @EXPORT_OK = qw ( bill bill_where );
  18
  19 #freeside-daily %opt:
  20 #  -s: re-charge setup fees
  21 #  -v: enable debugging
  22 #  -l: debugging level
  23 #  -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing.
  24 #  -r: Multi-process mode dry run option
  25 #  -g: Don't bill these pkgparts
  26
  27 sub bill {
  28   my %opt = @_;
  29
  30   my $check_freq = $opt{'check_freq'} || '1d';
  31
  32   my $debug = 0;
  33   $debug = 1 if $opt{'v'};
  34   $debug = $opt{'l'} if $opt{'l'};
  35   $FS::cust_main::DEBUG = $debug;
  36   #$FS::cust_event::DEBUG = $opt{'l'} if $opt{'l'};
  37
  38   my $conf = new FS::Conf;
  39   if ( $conf->exists('disable_cron_billing') ) {
  40     warn "disable_cron_billing set, skipping billing\n" if $debug;
  41     return;
  42   }
  43
  44   #we're at now now (and later).
  45   $opt{'time'} = $opt{'d'} ? str2time($opt{'d'}) : $^T;
  46   $opt{'time'} += $opt{'y'} * 86400 if $opt{'y'};
  47
  48   $opt{'invoice_time'} = $opt{'n'} ? $^T : $opt{'time'};
  49
  50   #hashref here doesn't work with -m
  51   #my $not_pkgpart = $opt{g} ? { map { $_=>1 } split(/,\s*/, $opt{g}) }
  52   #                          : {};
  53
  54   ###
  55   # get a list of custnums
  56   ###
  57
  58   my $cursor_dbh = dbh->clone;
  59
  60   my $select = 'SELECT custnum FROM cust_main WHERE '. bill_where( %opt );
  61
  62   unless ( driver_name =~ /^mysql/ ) {
  63     $cursor_dbh->do( "DECLARE cron_bill_cursor CURSOR FOR $select" )
  64       or die $cursor_dbh->errstr;
  65   }
  66
  67   while ( 1 ) {
  68
  69     my $sql = (driver_name =~ /^mysql/)
  70       ? $select
  71       : 'FETCH 100 FROM cron_bill_cursor';
  72
  73     my $sth = $cursor_dbh->prepare($sql);
  74
  75     $sth->execute or die $sth->errstr;
  76
  77     my @custnums = map { $_->[0] } @{ $sth->fetchall_arrayref };
  78
  79     last unless scalar(@custnums);
  80
  81     ###
  82     # for each custnum, queue or make one customer object and bill
  83     # (one at a time, to reduce memory footprint with large #s of customers)
  84     ###
  85
  86     foreach my $custnum ( @custnums ) {
  87
  88       my %args = (
  89           'time'         => $opt{'time'},
  90           'invoice_time' => $opt{'invoice_time'},
  91           'actual_time'  => $^T, #when freeside-bill was started
  92                                  #(not, when using -m, freeside-queued)
  93           'check_freq'   => $check_freq,
  94           'resetup'      => ( $opt{'s'} ? $opt{'s'} : 0 ),
  95           'not_pkgpart'  => $opt{'g'}, #$not_pkgpart,
  96           'one_recur'    => $opt{'o'},
  97       );
  98
  99       if ( $opt{'m'} ) {
 100
 101         if ( $opt{'r'} ) {
 102           warn "DRY RUN: would add custnum $custnum for queued_bill\n";
 103         } else {
 104
 105           #avoid queuing another job if there's one still waiting to run
 106           next if qsearch( 'queue', { 'job'     => 'FS::cust_main::queued_bill',
 107                                       'custnum' => $custnum,
 108                                       'status'  => 'new',
 109                                     }
 110                          );
 111
 112           #add job to queue that calls bill_and_collect with options
 113           my $queue = new FS::queue {
 114             'job'      => 'FS::cust_main::queued_bill',
 115             'secure'   => 'Y',
 116             'priority' => 99, #don't get in the way of provisioning jobs
 117           };
 118           my $error = $queue->insert( 'custnum'=>$custnum, %args );
 119
 120         }
 121
 122       } else {
 123
 124         my $cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } );
 125         $cust_main->bill_and_collect( %args, 'debug' => $debug );
 126
 127       }
 128
 129     }
 130
 131     last if driver_name =~ /^mysql/;
 132
 133   }
 134
 135   $cursor_dbh->commit or die $cursor_dbh->errstr;
 136
 137 }
 138
 139 # freeside-daily %opt:
 140 #  -d: Pretend it's 'date'.  Date is in any format Date::Parse is happy with,
 141 #      but be careful.
 142 #
 143 #  -y: In addition to -d, which specifies an absolute date, the -y switch
 144 #      specifies an offset, in days.  For example, "-y 15" would increment the
 145 #      "pretend date" 15 days from whatever was specified by the -d switch
 146 #      (or now, if no -d switch was given).
 147 #
 148 #  -n: When used with "-d" and/or "-y", specifies that invoices should be dated
 149 #      with today's date, irregardless of the pretend date used to pre-generate
 150 #      the invoices.
 151 #
 152 #  -p: Only process customers with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>)
 153 #
 154 #  -a: Only process customers with the specified agentnum
 155 #
 156 #  -v: enable debugging
 157 #
 158 #  -l: debugging level
 159
 160 =item bill_where
 161
 162 Internal function.  Returns a WHERE clause to select the set of customers who
 163 have actionable packages (no setup date, or bill date in the past, or expire
 164 or adjourn dates in the past) or events (does a complete where_conditions_sql
 165 scan).
 166
 167 =cut
 168
 169 sub bill_where {
 170   my( %opt ) = @_;
 171
 172   my $time = $opt{'time'};
 173   my $invoice_time = $opt{'invoice_time'};
 174
 175   my $check_freq = $opt{'check_freq'} || '1d';
 176
 177   my @search = ();
 178
 179   push @search, "( cust_main.archived != 'Y' OR archived IS NULL )"; #disable?
 180
 181   push @search, "cust_main.payby    = '". $opt{'p'}. "'"
 182     if $opt{'p'};
 183   push @search, "cust_main.agentnum IN ( ". $opt{'a'}. " ) "
 184     if $opt{'a'};
 185
 186   #it would be useful if i recognized $opt{g} / $not_pkgpart...
 187
 188   if ( @ARGV ) {
 189     push @search, "( ".
 190       join(' OR ', map "cust_main.custnum = $_", @ARGV ).
 191     " )";
 192   }
 193
 194   ###
 195   # generate where_pkg/where_event search clause
 196   ###
 197
 198   my $billtime = day_end($time);
 199
 200   # select * from cust_main where
 201   my $where_pkg = <<"END";
 202     EXISTS(
 203       SELECT 1 FROM cust_pkg
 204         WHERE cust_main.custnum = cust_pkg.custnum
 205           AND ( cancel IS NULL OR cancel = 0 )
 206           AND (    ( ( setup IS NULL OR setup =  0 )
 207                      AND ( start_date IS NULL OR start_date = 0
 208                            OR ( start_date IS NOT NULL AND start_date <= $^T )
 209                          )
 210                    )
 211                 OR bill  IS NULL OR bill  <= $billtime
 212                 OR ( expire  IS NOT NULL AND expire  <= $^T )
 213                 OR ( adjourn IS NOT NULL AND adjourn <= $^T )
 214               )
 215     )
 216 END
 217
 218   #some false laziness w/cust_main::Billing due_cust_event
 219   my $where_event = join(' OR ', map {
 220     my $eventtable = $_;
 221
 222     # joins and where clauses to test event conditions
 223     my $join  = FS::part_event_condition->join_conditions_sql(  $eventtable );
 224     my $where = FS::part_event_condition->where_conditions_sql( $eventtable,
 225                                                                 'time'=>$time,
 226                                                               );
 227     $where = $where ? "AND $where" : '';
 228
 229     # test to return all applicable part_events (defined on this eventtable,
 230     # not disabled, check_freq correct, and all event conditions true)
 231     my $are_part_event =
 232       "EXISTS ( SELECT 1 FROM part_event $join
 233                   WHERE check_freq = '$check_freq'
 234                     AND eventtable = '$eventtable'
 235                     AND ( disabled = '' OR disabled IS NULL )
 236                     $where
 237               )
 238       ";
 239
 240     if ( $eventtable eq 'cust_main' ) {
 241       $are_part_event;
 242     } else {
 243       my $cust_join = FS::part_event->eventtables_cust_join->{$eventtable}
 244                       || '';
 245       my $custnum = FS::part_event->eventtables_custnum->{$eventtable};
 246       "EXISTS ( SELECT 1 FROM $eventtable $cust_join
 247                   WHERE cust_main.custnum = $custnum
 248                     AND $are_part_event
 249               )
 250       ";
 251     }
 252
 253   } FS::part_event->eventtables);
 254
 255   push @search, "( $where_pkg OR $where_event )";
 256
 257   warn "searching for customers:\n". join("\n", @search). "\n"
 258     if $opt{'v'} || $opt{'l'};
 259
 260   join(' AND ', @search);
 261
 262 }
 263
 264 1;