bin/bulk_void

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use vars qw( %opt );
   6 use FS::Misc::Getopt;
   7 use FS::Record qw(qsearch qsearchs dbh);
   8
   9 getopts('cpiXr:t:');
  10
  11 my $dbh = dbh;
  12 $FS::UID::AutoCommit = 0;
  13
  14 sub usage() {
  15   "Usage: bulk_void  -s start -e end
  16                   -r void_reason
  17                   { -c | -p | -i }
  18                   [ -t payby ]
  19                   [ -X ]
  20                   <user>
  21 -s, -e: date range (required)
  22 -r: void reason text (required)
  23 -c, -p, -i: void credits, payments, invoices
  24 -t: only void payments with this payby
  25 -X: commit changes
  26 ";
  27 }
  28
  29 if (!$opt{start} or !$opt{end} or !$opt{r}) {
  30   die usage;
  31 }
  32
  33 print "DRY RUN--changes will not be committed.\n" unless $opt{X};
  34
  35 my %search = ();
  36 $search{payby} = $opt{t} if $opt{t} && $opt{p};
  37
  38 my $date = (keys %search ? ' AND ' : ' WHERE ').
  39            " _date >= $opt{start} AND _date <= $opt{end}";
  40
  41 my %tables = (
  42   c => 'cust_credit',
  43   p => 'cust_pay',
  44   i => 'cust_bill',
  45 );
  46
  47 my $reason = $opt{r};
  48
  49 foreach my $k (keys %tables) {
  50   next unless $opt{$k};
  51   my $table = $tables{$k};
  52   debug("$table:");
  53   my $done_count = 0;
  54   my $error_count = 0;
  55
  56   my $cursor = FS::Cursor->new({
  57     table     => $table,
  58     hashref   => \%search,
  59     extra_sql => $date,
  60   });
  61   my $error;
  62   while (my $record = $cursor->fetch) {
  63     $error = $record->void($reason);
  64     if ( $error ) {
  65       $error = "$table #" . $record->get($record->primary_key) . ": $error";
  66       print "$error\n";
  67       $error_count++;
  68       if ( $opt{X} ) {
  69         $dbh->rollback;
  70         exit(1);
  71       }
  72     } else {
  73       $done_count++;
  74     }
  75   }
  76   print " $table voided: $done_count\n errors: $error_count\n";
  77 }
  78
  79 if ( $opt{X} ) {
  80   $dbh->commit;
  81   print "Committed changes.\n";
  82 } else {
  83   $dbh->rollback;
  84   print "Reverted changes.\n";
  85 }
  86