bin/cust_pay_histogram

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Getopt::Std;
   5 use Date::Parse;
   6 use FS::UID qw(adminsuidsetup);
   7 use FS::Record qw( qsearch );
   8 use FS::cust_pay;
   9
  10 &untaint_argv;  #what it sounds like  (eww)
  11 use vars qw(%opt);
  12 getopts("p:a:b:e:", \%opt);
  13
  14 my $user = shift or die &usage;
  15 my $dbh = adminsuidsetup $user;
  16
  17 my @where = ();
  18
  19 push @where, 'agentnum = '. $dbh->quote($opt{a}) if $opt{a};
  20 push @where, 'cust_pay.payby = '. $dbh->quote($opt{p}) if $opt{p};
  21 push @where, 'cust_pay._date > '. $dbh->quote(str2time($opt{b})) if $opt{b};
  22 push @where, 'cust_pay._date < '. $dbh->quote(str2time($opt{e})) if $opt{e};
  23
  24 my $extra_sql = scalar(@where) ? 'WHERE '. join(' AND ', @where) : '';
  25 my $addl_from = 'LEFT JOIN cust_main USING( custnum )';
  26
  27 my @payrow = qsearch( { table     => 'cust_pay',
  28                         hashref   => {},
  29                         select    => 'count(*) AS quantity, paid',
  30                         addl_from => $addl_from,
  31                         extra_sql => $extra_sql,
  32                         order_by  => 'GROUP BY paid',
  33                       }
  34                     );
  35
  36 my $max = 0;
  37 foreach (@payrow) {
  38   $max = $_->quantity if $_->quantity > $max;
  39 }
  40 my $scale = int($max/60) + 1;
  41
  42 print "\n  PAYMENTS RECEIVED";
  43 print " AFTER $opt{b}" if $opt{b};
  44 print " UNTIL $opt{e}" if $opt{e};
  45 print " VIA $opt{p}" if $opt{p};
  46 print " BY AGENT $opt{a}" if $opt{a};
  47 print "\n\n";
  48 print "(each * represents $scale)\n\n" if $scale > 1;
  49
  50 foreach my $payrow ( @payrow ) {
  51   print sprintf("%10.2f", $payrow->paid),
  52         ": ",
  53         sprintf("%6d", $payrow->quantity),
  54         "| ",
  55         '*' x($payrow->quantity/$scale),
  56         "\n";
  57 }
  58
  59 print "\n";
  60
  61
  62 ###
  63 # subroutines
  64 ###
  65
  66 sub untaint_argv {
  67   foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
  68     #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
  69     # Date::Parse
  70     $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
  71     $ARGV[$_]=$1;
  72   }
  73 }
  74
  75 sub usage {
  76   die "Usage:\n\n  cust_pay_histogram [ -b 'begin_date' ] [ -e 'end_date' ] [ -p 'payby' ] [ -a agentnum ] user\n";
  77 }
  78
  79 ###
  80 # documentation
  81 ###
  82
  83 =head1 NAME
  84
  85 cust_pay_histogram - Show a histogram of payments made for a date range.
  86
  87 =head1 SYNOPSIS
  88
  89   freeside-daily [ -b 'begin_date' ] [ -e 'end_date'] [ -p 'payby' ] [ -a agentnum ] user
  90
  91 =head1 DESCRIPTION
  92
  93 Displays a histogram of cust_pay records in the database.
  94
  95   -b: Include only payments since 'begin_date'.  Date is in any format Date::Parse is happy with, but be careful.
  96
  97   -e: Include only payments before 'end_date'.  Date is in any format Date::Parse is happy with, but be careful.
  98
  99   -p: Only process payments with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>)
 100
 101   -a: Only process payments of customers with the specified agentnum
 102
 103 user: From the mapsecrets file - see config.html from the base documentation
 104
 105 =head1 BUGS
 106
 107 =head1 SEE ALSO
 108
 109 L<FS::cust_pay>
 110
 111 =cut
 112