X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2Fbin%2Ffreeside-daily;h=1db786120e4368c250baa3efb51906ddfdd9b1a9;hb=1583472a6afefb1ad33e05656fd206674f37d9df;hp=8d839cb210f4ea2a9433b9a3f7a4c194f814bdca;hpb=7e3eb82f87c371785544b706b7347c7edde2b593;p=freeside.git

diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily
index 8d839cb21..1db786120 100755
--- a/FS/bin/freeside-daily
+++ b/FS/bin/freeside-daily
@@ -4,17 +4,20 @@ use strict;
 use Fcntl qw(:flock);
 use Date::Parse;
 use Getopt::Std;
-use FS::UID qw(adminsuidsetup);
+use FS::UID qw(adminsuidsetup driver_name dbh datasrc);
 use FS::Record qw(qsearch qsearchs);
+use FS::Conf;
 use FS::cust_main;
 
 &untaint_argv;	#what it sounds like  (eww)
-use vars qw($opt_d);
-getopts("d:");
+use vars qw($opt_d $opt_v);
+getopts("d:v");
 my $user = shift or die &usage;
 
 adminsuidsetup $user;
 
+$FS::cust_main::Debug = 1 if $opt_v;
+
 my @cust_main = @ARGV
   ? map { qsearchs('cust_main', { custnum => $_ } ) } @ARGV
   : qsearch('cust_main', {} )
@@ -26,19 +29,51 @@ my($time)= $opt_d ? str2time($opt_d) : $^T;
 my($cust_main,%saw);
 foreach $cust_main ( @cust_main ) {
 
-  my $error;
+  # $^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;
+  }
 
-  $error = $cust_main->bill( 'time' => $time );
+  my $error = $cust_main->bill( 'time' => $time );
   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 );
+  $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 $statement ( 'vacuum', 'vacuum analyze' ) {
+    my $sth = dbh->prepare($statement) or die dbh->errstr;
+    $sth->execute or die $sth->errstr;
+  }
+}
+
+#local hack
+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;
+  }
+  scp("/var/tmp/$database.sql", $dest);
+  unlink "/var/tmp/$database.sql" or die $!;
+}
+
 # subroutines
 
 sub untaint_argv {