FS/bin/freeside-credit-report

   1 #!/usr/bin/perl -Tw
   2
   3
   4 use strict;
   5 use Date::Parse;
   6 use Time::Local;
   7 use Getopt::Std;
   8 use Text::Template;
   9 use Net::SMTP;
  10 use Mail::Header;
  11 use Mail::Internet;
  12 use FS::Conf;
  13 use FS::UID qw(adminsuidsetup);
  14 use FS::Record qw(qsearch);
  15 use FS::cust_credit;
  16
  17
  18 &untaint_argv;  #what it sounds like  (eww)
  19 use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf $header);
  20 getopts("vpmef:s:");    #switches
  21
  22 #we're at now now (and later).
  23 my($_finishdate)= $opt_f ? str2time($main::opt_f) : $^T;
  24 my($_startdate)= $opt_s ? str2time($main::opt_s) : $^T;
  25
  26 # Get the current month
  27 my ($ssec,$smin,$shour,$smday,$smon,$syear) =
  28         (localtime($_startdate) )[0,1,2,3,4,5];
  29 $smon++;
  30 $syear += 1900;
  31
  32 # Get the current month
  33 my ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear) =
  34         (localtime($_finishdate) )[0,1,2,3,4,5];
  35 $fmon++;
  36 $fyear += 1900;
  37
  38 # Login to the database
  39 my $user = shift or die &usage;
  40 adminsuidsetup $user;
  41
  42 # Get the needed configuration files
  43 my $conf = new FS::Conf;
  44 my $lpr = $conf->config('lpr');
  45 my $email = $conf->config('email');
  46 my $smtpmachine = $conf->config('smtpmachine');
  47 my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') :
  48   'postmaster';
  49 my @report_template = $conf->config('report_template')
  50   or die "cannot load config file report_template";
  51 $report_lines = 0;
  52 foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/
  53   /report_lines\((\d+)\)/;
  54   $report_lines += $1;
  55 }
  56 die "no report_lines() functions in template?" unless $report_lines;
  57 $report_template = new Text::Template (
  58   TYPE   => 'ARRAY',
  59   SOURCE => [ map "$_\n", @report_template ],
  60 ) or die "can't create new Text::Template object: $Text::Template::ERROR";
  61
  62
  63 my(@cust_credits)=qsearch('cust_credit',{});
  64 if (scalar(@cust_credits) == 0)
  65 {
  66         exit 1;
  67 }
  68
  69 # Open print and email pipes
  70 # $lpr and opt_p for printing
  71 # $email and opt_m for email
  72
  73 if ($lpr && $main::opt_p)
  74 {
  75         open(LPR, "|$lpr");
  76 }
  77
  78 if ($email && $main::opt_m)
  79 {
  80   $ENV{MAILADDRESS} = $mail_sender;
  81   $header = new Mail::Header ( [
  82     "From: Account Processor",
  83     "To: $email",
  84     "Sender: $mail_sender",
  85     "Reply-To: $mail_sender",
  86     "Subject: In House Credits",
  87   ] );
  88 }
  89
  90 my $uninvoiced = 0;
  91 my $total = 0;
  92 my $taxed = 0;
  93 my $untaxed = 0;
  94 my $total_tax = 0;
  95
  96 # Now I can start looping
  97 foreach my $cust_credit (@cust_credits)
  98 {
  99         my $_date = $cust_credit->getfield('_date');
 100         my $amount = $cust_credit->getfield('amount');
 101
 102         if ($_date >= $_startdate && $_date <= $_finishdate) {
 103                 $total += $amount;
 104         }
 105 }
 106
 107 push @buf, sprintf(qq{\n%25s%14.2f\n}, "Credits Offered", $total);
 108 push @buf, sprintf(qq{\n%39s\n%39.2f\n}, "=========", $total);
 109
 110 sub FS::credit_report::_template::report_lines {
 111   my $lines = shift;
 112   map {
 113     scalar(@buf) ? shift @buf : '' ;
 114   }
 115   ( 1 .. $lines );
 116 }
 117
 118 $FS::credit_report::_template::title = qq~IN HOUSE CREDITS for $smon/$smday/$syear through $fmon/$fmday/$fyear~;
 119 $FS::credit_report::_template::title = $opt_t if $opt_t;
 120 $FS::credit_report::_template::page = 1;
 121 $FS::credit_report::_template::date = $^T;
 122 $FS::credit_report::_template::date = $^T;
 123 $FS::credit_report::_template::fdate = $_finishdate;
 124 $FS::credit_report::_template::fdate = $_finishdate;
 125 $FS::credit_report::_template::sdate = $_startdate;
 126 $FS::credit_report::_template::sdate = $_startdate;
 127 $FS::credit_report::_template::total_pages =
 128   int( scalar(@buf) / $report_lines);
 129 $FS::credit_report::_template::total_pages++ if scalar(@buf) % $report_lines;
 130
 131 my @report;
 132 while (@buf) {
 133   push @report, split("\n",
 134     $report_template->fill_in( PACKAGE => 'FS::credit_report::_template' )
 135   );
 136   $FS::credit_report::_template::page++;
 137 }
 138
 139 if ($opt_v) {
 140   print map "$_\n", @report;
 141 }
 142 if($lpr && $opt_p)
 143 {
 144   print LPR map "$_\n", @report;
 145   print LPR "\f" if $opt_e;
 146   close LPR || die "Could not close printer: $lpr\n";
 147 }
 148 if($email && $opt_m)
 149 {
 150   my $message = new Mail::Internet (
 151     'Header' => $header,
 152     'Body' => [ (@report) ],
 153   );
 154   $!=0;
 155   $message->smtpsend( Host => "$smtpmachine" )
 156     or die "can't send report to $email via $smtpmachine: $!";
 157 }
 158
 159
 160 # subroutines
 161 sub untaint_argv {
 162   foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
 163     $ARGV[$_] =~ /^([\w\-\/ :\.]*)$/ || die "Illegal argument \"$ARGV[$_]\"";
 164     $ARGV[$_]=$1;
 165   }
 166 }
 167
 168 sub usage {
 169   die "Usage:\n\n  freeside-credit-report [-v] [-p] [-e] user\n";
 170 }
 171
 172 =head1 NAME
 173
 174 freeside-credit-report - Prints or emails total credit memos in a given period.
 175
 176 =head1 SYNOPSIS
 177
 178   freeside-credit-report [-v] [-p] [-m] [-e] [-t "title"] [-s date] [-f date] user
 179
 180 =head1 DESCRIPTION
 181
 182 Prints or emails total credit memos in a given period.
 183
 184 -v: Verbose - Prints records to STDOUT.
 185
 186 -p: Print to printer lpr as found in the conf directory.
 187
 188 -m: Email output to user found in the Conf email file.
 189
 190 -e: Print a final form feed to the printer.
 191
 192 -t: supply a title for the top of each page.
 193
 194 -s: starting date for inclusion
 195
 196 -f: final date for inclusion
 197
 198 user: From the mapsecrets file - see config.html from the base documentation
 199
 200 =head1 VERSION
 201
 202 $Id: freeside-credit-report,v 1.5 2002-09-09 22:57:34 ivan Exp $
 203
 204 =head1 BUGS
 205
 206 Yes..... Use at your own risk. No guarantees or warrantees of any
 207 kind apply to this program. Parts of this program are hacked from
 208 other GNU licensed software created mainly by Ivan Kohler.
 209
 210 This is released under the GNU Public License. See www.gnu.org
 211 for more information regarding this license.
 212
 213 =head1 SEE ALSO
 214
 215 L<FS::cust_main>, config.html from the base documentation
 216
 217 =head1 AUTHOR
 218
 219 Jeff Finucane <jeff@cmh.net>
 220
 221 based on print-batch by Joel Griffiths <griff@aver-computer.com>
 222
 223 =cut
 224