finish adding freeside-monthly and monthly events
authorivan <ivan>
Wed, 1 Feb 2006 23:13:48 +0000 (23:13 +0000)
committerivan <ivan>
Wed, 1 Feb 2006 23:13:48 +0000 (23:13 +0000)
12 files changed:
FS/FS/Cron/backup.pm [new file with mode: 0644]
FS/FS/Cron/bill.pm [new file with mode: 0644]
FS/FS/Cron/vacuum.pm [new file with mode: 0644]
FS/FS/cust_bill.pm
FS/FS/cust_main.pm
FS/MANIFEST
FS/bin/freeside-daily
FS/bin/freeside-monthly [new file with mode: 0755]
FS/t/Cron-backup.t [new file with mode: 0644]
FS/t/Cron-bill.t [new file with mode: 0644]
FS/t/Cron-vacuum.t [new file with mode: 0644]
httemplate/browse/part_bill_event.cgi

diff --git a/FS/FS/Cron/backup.pm b/FS/FS/Cron/backup.pm
new file mode 100644 (file)
index 0000000..204069a
--- /dev/null
@@ -0,0 +1,43 @@
+package FS::Cron::backup;
+
+use strict;
+use vars qw( @ISA @EXPORT_OK );
+use Exporter;
+use FS::UID qw(driver_name datasrc);
+
+@ISA = qw( Exporter );
+@EXPORT_OK = qw( backup_scp );
+
+sub backup_scp {
+  my $conf = new FS::Conf;
+  my $dest = $conf->config('dump-scpdest');
+  if ( $dest ) {
+    datasrc =~ /dbname=([\w\.]+)$/ or die "unparsable datasrc ". datasrc;
+    my $database = $1;
+    eval "use Net::SCP qw(scp);";
+    die $@ if $@;
+    if ( driver_name eq 'Pg' ) {
+      system("pg_dump $database >/var/tmp/$database.sql")
+    } else {
+      die "database dumps not yet supported for ". driver_name;
+    }
+    if ( $conf->config('dump-pgpid') ) {
+      eval 'use GnuPG;';
+      die $@ if $@;
+      my $gpg = new GnuPG;
+      $gpg->encrypt( plaintext => "/var/tmp/$database.sql",
+                     output    => "/var/tmp/$database.gpg",
+                     recipient => $conf->config('dump-pgpid'),
+                   );
+      chmod 0600, '/var/tmp/$database.gpg';
+      scp("/var/tmp/$database.gpg", $dest);
+      unlink "/var/tmp/$database.gpg" or die $!;
+    } else {
+      chmod 0600, '/var/tmp/$database.sql';
+      scp("/var/tmp/$database.sql", $dest);
+    }
+    unlink "/var/tmp/$database.sql" or die $!;
+  }
+}
+
+1;
diff --git a/FS/FS/Cron/bill.pm b/FS/FS/Cron/bill.pm
new file mode 100644 (file)
index 0000000..774bf30
--- /dev/null
@@ -0,0 +1,119 @@
+package FS::Cron::bill;
+
+use strict;
+use vars qw( @ISA @EXPORT_OK );
+use Exporter;
+use Date::Parse;
+use FS::Record qw(qsearch qsearchs);
+use FS::cust_main;
+
+@ISA = qw( Exporter );
+@EXPORT_OK = qw ( bill );
+
+sub bill {
+
+  my %opt = @_;
+
+  $FS::cust_main::DEBUG = 1 if $opt{'v'};
+  
+  my %search = ();
+  $search{'payby'}    = $opt{'p'} if $opt{'p'};
+  $search{'agentnum'} = $opt{'a'} if $opt{'a'};
+  
+  #we're at now now (and later).
+  my($time)= $opt{'d'} ? str2time($opt{'d'}) : $^T;
+  $time += $opt{'y'} * 86400 if $opt{'y'};
+
+  # select * from cust_main where
+  my $where_pkg = <<"END";
+    0 < ( select count(*) from cust_pkg
+            where cust_main.custnum = cust_pkg.custnum
+              and ( cancel is null or cancel = 0 )
+              and (    setup is null or setup =  0
+                    or bill  is null or bill  <= $time 
+                    or ( expire is not null and expire <= $^T )
+                  )
+        )
+END
+  
+  # or
+  my $where_bill_event = <<"END";
+    0 < ( select count(*) from cust_bill
+            where cust_main.custnum = cust_bill.custnum
+              and 0 < charged
+                      - coalesce(
+                                  ( select sum(amount) from cust_bill_pay
+                                      where cust_bill.invnum = cust_bill_pay.invnum )
+                                  ,0
+                                )
+                      - coalesce(
+                                  ( select sum(amount) from cust_credit_bill
+                                      where cust_bill.invnum = cust_credit_bill.invnum )
+                                  ,0
+                                )
+              and 0 < ( select count(*) from part_bill_event
+                          where payby = cust_main.payby
+                            and ( disabled is null or disabled = '' )
+                            and seconds <= $time - cust_bill._date
+                            and 0 = ( select count(*) from cust_bill_event
+                                       where cust_bill.invnum = cust_bill_event.invnum
+                                         and part_bill_event.eventpart = cust_bill_event.eventpart
+                                         and status = 'done'
+                                    )
+  
+                      )
+        )
+END
+  
+  my $extra_sql = ( scalar(%search) ? ' AND ' : ' WHERE ' ). "( $where_pkg OR $where_bill_event )";
+  
+  my @cust_main;
+  if ( @ARGV ) {
+    @cust_main = map { qsearchs('cust_main', { custnum => $_, %search } ) } @ARGV
+  } else {
+    @cust_main = qsearch('cust_main', \%search, '', $extra_sql );
+  }
+  ;
+  
+  my($cust_main,%saw);
+  foreach $cust_main ( @cust_main ) {
+  
+    # $^T not $time because -d is for pre-printing invoices
+    foreach my $cust_pkg (
+      grep { $_->expire && $_->expire <= $^T } $cust_main->ncancelled_pkgs
+    ) {
+      my $error = $cust_pkg->cancel;
+      warn "Error cancelling expired pkg ". $cust_pkg->pkgnum. " for custnum ".
+           $cust_main->custnum. ": $error"
+        if $error;
+    }
+    # $^T not $time because -d is for pre-printing invoices
+    foreach my $cust_pkg (
+      grep { $_->part_pkg->is_prepaid
+             && $_->bill && $_->bill < $^T && ! $_->susp
+           }
+           $cust_main->ncancelled_pkgs
+    ) {
+      my $error = $cust_pkg->suspend;
+      warn "Error suspending package ". $cust_pkg->pkgnum.
+           " for custnum ". $cust_main->custnum.
+           ": $error"
+        if $error;
+    }
+  
+    my $error = $cust_main->bill( 'time'    => $time,
+                                  'resetup' => $opt{'s'},
+                                );
+    warn "Error billing, custnum ". $cust_main->custnum. ": $error" if $error;
+  
+    $cust_main->apply_payments;
+    $cust_main->apply_credits;
+  
+    $error = $cust_main->collect( 'invoice_time' => $time,
+                                  'freq'         => $opt{'freq'},
+                                );
+    warn "Error collecting, custnum". $cust_main->custnum. ": $error" if $error;
+  
+  }
+
+}
diff --git a/FS/FS/Cron/vacuum.pm b/FS/FS/Cron/vacuum.pm
new file mode 100644 (file)
index 0000000..075572d
--- /dev/null
@@ -0,0 +1,23 @@
+package FS::Cron::vacuum;
+
+use vars qw( @ISA @EXPORT_OK);
+use Exporter;
+use FS::UID qw(driver_name dbh);
+use FS::Schema qw(dbdef);
+
+@ISA = qw( Exporter );
+@EXPORT_OK = qw( vacuum );
+
+sub vacuum {
+
+  if ( driver_name eq 'Pg' ) {
+    dbh->{AutoCommit} = 1; #so we can vacuum
+    foreach my $table ( dbdef->tables ) {
+      my $sth = dbh->prepare("VACUUM ANALYZE $table") or die dbh->errstr;
+      $sth->execute or die $sth->errstr;
+    }
+  }
+
+}
+
+1;
index 159c9e4..cce028b 100644 (file)
@@ -836,6 +836,8 @@ Options are:
 
 =item agent_spools - if set to a true value, will spool to per-agent files rather than a single global file
 
+=item balanceover - if set, only spools the invoice if the total amount owed on this invoice and all older invoices is greater than the specified amount.
+
 =back
 
 =cut
@@ -852,6 +854,11 @@ sub spool_csv {
                      || ! keys %invoicing_list;
   }
 
+  if ( $opt{'balanceover'} ) {
+    return 'N/A'
+      if $cust_main->total_owed_date($self->_date) < $opt{'balanceover'};
+  }
+
   my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/cust_bill";
   mkdir $spooldir, 0700 unless -d $spooldir;
 
index b5ccf5a..973fe7c 100644 (file)
@@ -118,8 +118,6 @@ FS::cust_main - Object methods for cust_main records
   $error = $record->collect;
   $error = $record->collect %options;
   $error = $record->collect 'invoice_time'   => $time,
-                            'batch_card'     => 'yes',
-                            'report_badcard' => 'yes',
                           ;
 
 =head1 DESCRIPTION
@@ -1886,7 +1884,7 @@ sub bill {
                   $dbh->rollback if $oldAutoCommit;
                   return "fatal: can't lookup exising exemption: ". dbh->errstr;
                 };
-                my $existing_exemption = $sth->fetchrow_arrayref->[0];
+                my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
                 
                 my $remaining_exemption =
                   $tax->exempt_amount - $existing_exemption;
@@ -2001,17 +1999,11 @@ for conversion functions.
 retry - Retry card/echeck/LEC transactions even when not scheduled by invoice
 events.
 
-retry_card - Deprecated alias for 'retry'
-
-batch_card - This option is deprecated.  See the invoice events web interface
-to control whether cards are batched or run against a realtime gateway.
-
-report_badcard - This option is deprecated.
-
-force_print - This option is deprecated; see the invoice events web interface.
-
 quiet - set true to surpress email card/ACH decline notices.
 
+freq - "1d" for the traditional, daily events (the default), or "1m" for the
+new monthly events
+
 =cut
 
 sub collect {
@@ -2052,6 +2044,13 @@ sub collect {
     }
   }
 
+  my $extra_sql = '';
+  if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) {
+    $extra_sql = " AND freq = '1m' ";
+  } else {
+    $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) ";
+  }
+
   foreach my $cust_bill ( $self->open_cust_bill ) {
 
     # don't try to charge for the same invoice if it's already in a batch
@@ -2073,8 +2072,12 @@ sub collect {
                                 'status'    => 'done',
                                                                    } )
              }
-          qsearch('part_bill_event', { 'payby'    => $self->payby,
-                                       'disabled' => '',           } )
+          qsearch( {
+            'table'     => 'part_bill_event',
+            'hashref'   => { 'payby'    => $self->payby,
+                             'disabled' => '',           },
+            'extra_sql' => $extra_sql,
+          } )
     ) {
 
       last if $cust_bill->owed <= 0  # don't run subsequent events if owed<=0
index d8adfb9..452041e 100644 (file)
@@ -33,6 +33,9 @@ FS/ClientAPI/passwd.pm
 FS/ClientAPI/MyAccount.pm
 FS/Conf.pm
 FS/ConfItem.pm
+FS/Cron/backup.pm
+FS/Cron/bill.pm
+FS/Cron/vacuum.pm
 FS/Daemon.pm
 FS/Misc.pm
 FS/Record.pm
@@ -167,6 +170,9 @@ t/ClientAPI.t
 t/ClientAPI_SessionCache.t
 t/Conf.t
 t/ConfItem.t
+t/Cron-backup.t
+t/Cron-bill.t
+t/Cron-vacuum.t
 t/Daemon.t
 t/Misc.t
 t/Record.t
index 603da12..b9742c4 100755 (executable)
 #!/usr/bin/perl -w
 
 use strict;
-use Fcntl qw(:flock);
-use Date::Parse;
 use Getopt::Std;
-use FS::UID qw(adminsuidsetup driver_name dbh datasrc);
-use FS::Record qw(qsearch qsearchs dbdef);
-use FS::Conf;
-use FS::cust_main;
+use FS::UID qw(adminsuidsetup);
 
 &untaint_argv; #what it sounds like  (eww)
-use vars qw($opt_d $opt_v $opt_p $opt_a $opt_s $opt_y);
-getopts("p:a:d:vsy:");
-my $user = shift or die &usage;
+#use vars qw($opt_d $opt_v $opt_p $opt_a $opt_s $opt_y);
+use vars qw(%opt);
+getopts("p:a:d:vsy:", \%opt);
 
+my $user = shift or die &usage;
 adminsuidsetup $user;
 
-$FS::cust_main::DEBUG = 1 if $opt_v;
-
-my %search = ();
-$search{'payby'}    = $opt_p if $opt_p;
-$search{'agentnum'} = $opt_a if $opt_a;
-
-#we're at now now (and later).
-my($time)= $opt_d ? str2time($opt_d) : $^T;
-$time += $opt_y * 86400 if $opt_y;
-
-# select * from cust_main where
-my $where_pkg = <<"END";
-  0 < ( select count(*) from cust_pkg
-          where cust_main.custnum = cust_pkg.custnum
-            and ( cancel is null or cancel = 0 )
-            and (    setup is null or setup =  0
-                  or bill  is null or bill  <= $time 
-                  or ( expire is not null and expire <= $^T )
-                )
-      )
-END
-
-# or
-my $where_bill_event = <<"END";
-  0 < ( select count(*) from cust_bill
-          where cust_main.custnum = cust_bill.custnum
-            and 0 < charged
-                    - coalesce(
-                                ( select sum(amount) from cust_bill_pay
-                                    where cust_bill.invnum = cust_bill_pay.invnum )
-                                ,0
-                              )
-                    - coalesce(
-                                ( select sum(amount) from cust_credit_bill
-                                    where cust_bill.invnum = cust_credit_bill.invnum )
-                                ,0
-                              )
-            and 0 < ( select count(*) from part_bill_event
-                        where payby = cust_main.payby
-                          and ( disabled is null or disabled = '' )
-                          and seconds <= $time - cust_bill._date
-                          and 0 = ( select count(*) from cust_bill_event
-                                     where cust_bill.invnum = cust_bill_event.invnum
-                                       and part_bill_event.eventpart = cust_bill_event.eventpart
-                                       and status = 'done'
-                                  )
-
-                    )
-      )
-END
-
-my $extra_sql = ( scalar(%search) ? ' AND ' : ' WHERE ' ). "( $where_pkg OR $where_bill_event )";
-
-my @cust_main;
-if ( @ARGV ) {
-  @cust_main = map { qsearchs('cust_main', { custnum => $_, %search } ) } @ARGV
-} else {
-  @cust_main = qsearch('cust_main', \%search, '', $extra_sql );
-}
-;
-
-my($cust_main,%saw);
-foreach $cust_main ( @cust_main ) {
-
-  # $^T not $time because -d is for pre-printing invoices
-  foreach my $cust_pkg (
-    grep { $_->expire && $_->expire <= $^T } $cust_main->ncancelled_pkgs
-  ) {
-    my $error = $cust_pkg->cancel;
-    warn "Error cancelling expired pkg ". $cust_pkg->pkgnum. " for custnum ".
-         $cust_main->custnum. ": $error"
-      if $error;
-  }
-  # $^T not $time because -d is for pre-printing invoices
-  foreach my $cust_pkg (
-    grep { $_->part_pkg->is_prepaid
-           && $_->bill && $_->bill < $^T && ! $_->susp
-         }
-         $cust_main->ncancelled_pkgs
-  ) {
-    my $error = $cust_pkg->suspend;
-    warn "Error suspending package ". $cust_pkg->pkgnum.
-         " for custnum ". $cust_main->custnum.
-         ": $error"
-      if $error;
-  }
+use FS::Cron::bill qw(bill);
+bill(%opt);
 
-  my $error = $cust_main->bill( 'time'    => $time,
-                                'resetup' => $opt_s, );
-  warn "Error billing, custnum ". $cust_main->custnum. ": $error" if $error;
+use FS::Cron::vacuum qw(vacuum);
+vacuum();
 
-  $cust_main->apply_payments;
-  $cust_main->apply_credits;
-
-  $error = $cust_main->collect( 'invoice_time' => $time );
-  warn "Error collecting, custnum". $cust_main->custnum. ": $error" if $error;
-
-}
-
-if ( driver_name eq 'Pg' ) {
-  dbh->{AutoCommit} = 1; #so we can vacuum
-  foreach my $table ( dbdef->tables ) {
-    my $sth = dbh->prepare("VACUUM ANALYZE $table") or die dbh->errstr;
-    $sth->execute or die $sth->errstr;
-  }
-}
-
-my $conf = new FS::Conf;
-my $dest = $conf->config('dump-scpdest');
-if ( $dest ) {
-  datasrc =~ /dbname=([\w\.]+)$/ or die "unparsable datasrc ". datasrc;
-  my $database = $1;
-  eval "use Net::SCP qw(scp);";
-  if ( driver_name eq 'Pg' ) {
-    system("pg_dump $database >/var/tmp/$database.sql")
-  } else {
-    die "database dumps not yet supported for ". driver_name;
-  }
-  if ( $conf->config('dump-pgpid') ) {
-    eval 'use GnuPG';
-    my $gpg = new GnuPG;
-    $gpg->encrypt( plaintext => "/var/tmp/$database.sql",
-                   output    => "/var/tmp/$database.gpg",
-                   recipient => $conf->config('dump-pgpid'),
-                 );
-    chmod 0600, '/var/tmp/$database.gpg';
-    scp("/var/tmp/$database.gpg", $dest);
-    unlink "/var/tmp/$database.gpg" or die $!;
-  } else {
-    chmod 0600, '/var/tmp/$database.sql';
-    scp("/var/tmp/$database.sql", $dest);
-  }
-  unlink "/var/tmp/$database.sql" or die $!;
-}
+use FS::Cron::backup qw(backup_scp);
+backup_scp();
 
+###
 # subroutines
+###
 
 sub untaint_argv {
   foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
@@ -166,6 +38,10 @@ sub usage {
   die "Usage:\n\n  freeside-daily [ -d 'date' ] user [ custnum custnum ... ]\n";
 }
 
+###
+# documentation
+###
+
 =head1 NAME
 
 freeside-daily - Run daily billing and invoice collection events.
@@ -179,8 +55,6 @@ freeside-daily - Run daily billing and invoice collection events.
 Bills customers and runs invoice collection events.  Should be run from
 crontab daily.
 
-This script replaces freeside-bill from 1.3.1.
-
 Bills customers.  Searches for customers who are due for billing and calls
 the bill and collect methods of a cust_main object.  See L<FS::cust_main>.
 
diff --git a/FS/bin/freeside-monthly b/FS/bin/freeside-monthly
new file mode 100755 (executable)
index 0000000..a6c75e7
--- /dev/null
@@ -0,0 +1,91 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Getopt::Std;
+use FS::UID qw(adminsuidsetup);
+
+&untaint_argv; #what it sounds like  (eww)
+#use vars qw($opt_d $opt_v $opt_p $opt_a $opt_s $opt_y);
+use vars qw(%opt);
+getopts("p:a:d:vsy:", \%opt);
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+use FS::Cron::bill qw(bill);
+bill(%opt, 'freq'=>'1m' );
+
+###
+# subroutines
+###
+
+sub untaint_argv {
+  foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+    #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+    # Date::Parse
+    $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+    $ARGV[$_]=$1;
+  }
+}
+
+sub usage {
+  die "Usage:\n\n  freeside-monthly [ -d 'date' ] user [ custnum custnum ... ]\n";
+}
+
+###
+# documentation
+###
+
+=head1 NAME
+
+freeside-monthly - Run monthly billing and invoice collection events.
+
+=head1 SYNOPSIS
+
+  freeside-monthly [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] [ -v ] user [ custnum custnum ... ]
+
+=head1 DESCRIPTION
+
+Bills customers and runs invoice collection events, for the alternate monthly
+event chain.  If you have defined monthly event checks, should be run from
+crontab monthly.
+
+Bills customers.  Searches for customers who are due for billing and calls
+the bill and collect methods of a cust_main object.  See L<FS::cust_main>.
+
+  -d: Pretend it's 'date'.  Date is in any format Date::Parse is happy with,
+      but be careful.
+
+  -y: In addition to -d, which specifies an absolute date, the -y switch
+      specifies an offset, in days.  For example, "-y 15" would increment the
+      "pretend date" 15 days from whatever was specified by the -d switch
+      (or now, if no -d switch was given).
+
+  -p: Only process customers with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>)
+
+  -a: Only process customers with the specified agentnum
+
+  -s: re-charge setup fees
+
+  -v: enable debugging
+
+user: From the mapsecrets file - see config.html from the base documentation
+
+custnum: if one or more customer numbers are specified, only bills those
+customers.  Otherwise, bills all customers.
+
+=head1 NOTE
+
+In most cases, you would use freeside-daily only and not freeside-monthly.
+freeside-monthly would only be used in cases where you have events that can
+only be run once each month, for example, batching invoices to a third-party
+print/mail provider.
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<freeside-daily>, L<FS::cust_main>, config.html from the base documentation
+
+=cut
+
diff --git a/FS/t/Cron-backup.t b/FS/t/Cron-backup.t
new file mode 100644 (file)
index 0000000..847d41a
--- /dev/null
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::Cron::backup;
+$loaded=1;
+print "ok 1\n";
diff --git a/FS/t/Cron-bill.t b/FS/t/Cron-bill.t
new file mode 100644 (file)
index 0000000..42c7b4f
--- /dev/null
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::Cron::bill;
+$loaded=1;
+print "ok 1\n";
diff --git a/FS/t/Cron-vacuum.t b/FS/t/Cron-vacuum.t
new file mode 100644 (file)
index 0000000..eaa6b76
--- /dev/null
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::Cron::vacuum;
+$loaded=1;
+print "ok 1\n";
index 0b6d0cb..380e4d7 100755 (executable)
@@ -32,7 +32,8 @@ my $total = scalar(@part_bill_event);
      my $oldfreq = '';
 
      my @payby_part_bill_event =  grep { $payby eq $_->payby }
-                                  sort {    $a->seconds   <=> $b->seconds
+                                  sort {    $a->freq      cmp $b->freq # for now
+                                         || $a->seconds   <=> $b->seconds
                                          || $a->weight    <=> $b->weight
                                          || $a->eventpart <=> $b->eventpart
                                        }