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('s:e: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{s} or !$opt{e} or !$opt{r}) {
  30   die usage;
  31 }
  32
  33 print "DRY RUN--changes will not be committed.\n" unless $opt{X};
  34
  35 my $date = " WHERE _date >= $opt{s} AND _date <= $opt{e}";
  36
  37 my %search = ();
  38 $search{payby} = $opt{t} if $opt{t} && $opt{p};
  39
  40 my %tables = (
  41   c => 'cust_credit',
  42   p => 'cust_pay',
  43   i => 'cust_bill',
  44 );
  45
  46 my $reason = $opt{r};
  47
  48 foreach my $k (keys %tables) {
  49   next unless $opt{$k};
  50   my $table = $tables{$k};
  51   debug("$table:");
  52   my $done_count = 0;
  53   my $error_count = 0;
  54
  55   my $cursor = FS::Cursor->new({
  56     table     => $table,
  57     hashref   => \%search,
  58     extra_sql => $date,
  59   });
  60   my $error;
  61   while (my $record = $cursor->fetch) {
  62     $error = $record->void($reason);
  63     if ( $error ) {
  64       $error = "$table #" . $record->get($record->primary_key) . ": $error";
  65       print "$error\n";
  66       $error_count++;
  67       if ( $opt{X} ) {
  68         $dbh->rollback;
  69         exit(1);
  70       }
  71     } else {
  72       $done_count++;
  73     }
  74   }
  75   print " $table voided: $done_count\n errors: $error_count\n";
  76 }
  77
  78 if ( $opt{X} ) {
  79   $dbh->commit;
  80   print "Committed changes.\n";
  81 } else {
  82   $dbh->rollback;
  83   print "Reverted changes.\n";
  84 }
  85