diff options
Diffstat (limited to 'FS/bin')
| -rwxr-xr-x | FS/bin/freeside-daily | 8 | ||||
| -rw-r--r-- | FS/bin/freeside-queued | 77 | ||||
| -rw-r--r-- | FS/bin/freeside-reexport | 37 | ||||
| -rw-r--r-- | FS/bin/freeside-selfservice-server | 54 | ||||
| -rwxr-xr-x | FS/bin/freeside-setup | 98 | ||||
| -rwxr-xr-x | FS/bin/freeside-sqlradius-reset | 25 | ||||
| -rwxr-xr-x | FS/bin/freeside-tax-report | 292 |
7 files changed, 185 insertions, 406 deletions
diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 9ff21d421..70894400b 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -16,7 +16,7 @@ my $user = shift or die &usage; adminsuidsetup $user; -$FS::cust_main::Debug = 1 if $opt_v; +$FS::cust_main::DEBUG = 1 if $opt_v; my %search; $search{'payby'} = $opt_p if $opt_p; @@ -57,10 +57,8 @@ foreach $cust_main ( @cust_main ) { 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; - } + my $sth = dbh->prepare('vacuum analyze') or die dbh->errstr; + $sth->execute or die $sth->errstr; } #local hack diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 6ea27c05f..e14ddad8e 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -7,7 +7,7 @@ use Fcntl qw(:flock); use POSIX qw(:sys_wait_h setsid); use Date::Format; use IO::File; -use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh); +use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh myconnect); use FS::Record qw(qsearch qsearchs); use FS::queue; use FS::queue_depend; @@ -51,7 +51,16 @@ $< = $FS::UID::freeside_uid; $> = $FS::UID::freeside_uid; $ENV{HOME} = (getpwuid($>))[7]; #for ssh -adminsuidsetup $user; + +$@ = 'not connected'; +while ( $@ ) { + eval { adminsuidsetup $user; }; + if ( $@ ) { + warn $@; + warn "sleeping for reconnect...\n"; + sleep 5; + } +} $log_file = "/usr/local/etc/freeside/queuelog.". $FS::UID::datasrc; @@ -75,18 +84,34 @@ while (1) { } $warnkids=0; - my $nodepend = driver_name eq 'mysql' - ? '' - : 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. - ' WHERE queue_depend.jobnum = queue.jobnum ) '; + unless ( dbh && dbh->ping ) { + warn "WARNING: connection to database lost, reconnecting...\n"; + + eval { myconnect; }; + + unless ( !$@ && dbh && dbh->ping ) { + warn "WARNING: still no connection to database, sleeping for retry...\n"; + sleep 10; + next; + } else { + warn "WARNING: reconnected to database\n"; + } + } #my($job, $ljob); #{ # my $oldAutoCommit = $FS::UID::AutoCommit; # local $FS::UID::AutoCommit = 0; $FS::UID::AutoCommit = 0; - my $dbh = dbh; - + + #assuming mysql 4.1 w/subqueries now + #my $nodepend = driver_name eq 'mysql' + # ? '' + # : 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. + # ' WHERE queue_depend.jobnum = queue.jobnum ) '; + my $nodepend = 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. + ' WHERE queue_depend.jobnum = queue.jobnum ) '; + my $job = qsearchs( 'queue', { 'status' => 'new' }, @@ -95,25 +120,43 @@ while (1) { ? "$nodepend ORDER BY jobnum LIMIT 1 FOR UPDATE" : "$nodepend ORDER BY jobnum FOR UPDATE LIMIT 1" ) or do { - $dbh->commit or die $dbh->errstr; #if $oldAutoCommit; + # if $oldAutoCommit { + dbh->commit or do { + warn "WARNING: database error, closing connection: ". dbh->errstr; + undef $FS::UID::dbh; + next; + }; + # } sleep 5; #connecting to db is expensive next; }; - if ( driver_name eq 'mysql' - && qsearch('queue_depend', { 'jobnum' => $job->jobnum } ) ) { - $dbh->commit or die $dbh->errstr; #if $oldAutoCommit; - sleep 5; #would be better if mysql could do everything in query above - next; - } + #assuming mysql 4.1 w/subqueries now + #if ( driver_name eq 'mysql' + # && qsearch('queue_depend', { 'jobnum' => $job->jobnum } ) ) { + # dbh->commit or die dbh->errstr; #if $oldAutoCommit; + # sleep 5; #would be better if mysql could do everything in query above + # next; + #} my %hash = $job->hash; $hash{'status'} = 'locked'; my $ljob = new FS::queue ( \%hash ); my $error = $ljob->replace($job); - die $error if $error; + if ( $error ) { + warn "WARNING: database error locking job, closing connection: ". + dbh->errstr; + undef $FS::UID::dbh; + next; + } - $dbh->commit or die $dbh->errstr; #if $oldAutoCommit; + # if $oldAutoCommit { + dbh->commit or do { + warn "WARNING: database error, closing connection: ". dbh->errstr; + undef $FS::UID::dbh; + next; + }; + # } $FS::UID::AutoCommit = 1; #} diff --git a/FS/bin/freeside-reexport b/FS/bin/freeside-reexport index b5c50a422..54af9dd80 100644 --- a/FS/bin/freeside-reexport +++ b/FS/bin/freeside-reexport @@ -1,6 +1,8 @@ -#!/usr/bin/perl -Tw +#!/usr/bin/perl -w use strict; +use vars qw($opt_s $opt_u $opt_p); +use Getopt::Std; use FS::UID qw(adminsuidsetup); use FS::Record qw(qsearch qsearchs); use FS::part_export; @@ -20,25 +22,32 @@ if ( $export_x =~ /^(\d+)$/ ) { or die "no exports of type $export_x found\n"; } -my $svc_something = shift or die &usage; -my $svc_x; -if ( $svc_something =~ /^(\d+)$/ ) { - my $cust_svc = qsearchs('cust_svc', { svcnum=>$1 } ) - or die "svcnum $svc_something not found\n"; - $svc_x = $cust_svc->svc_x; -} else { - $svc_x = qsearchs('svc_acct', { username=>$svc_something } ) - or die "username $svc_something not found\n"; +getopts('s:u:p:'); + +my @svc_x = (); +if ( $opt_s ) { + my $cust_svc = qsearchs('cust_svc', { svcnum=>$opt_s } ) + or die "svcnum $opt_s not found\n"; + push @svc_x, $cust_svc->svc_x; +} elsif ( $opt_u ) { + my $svc_x = qsearchs('svc_acct', { username=>$opt_u } ) + or die "username $opt_u not found\n"; + push @svc_x, $svc_x; +} elsif ( $opt_p ) { + push @svc_x, map { $_->svc_x } qsearch('cust_svc', { svcpart=>$opt_p } ); + die "no services with svcpart $opt_p found\n" unless @svc_x; } foreach my $part_export ( @part_export ) { - my $error = $part_export->export_insert($svc_x); - die $error if $error; + foreach my $svc_x ( @svc_x ) { + my $error = $part_export->export_insert($svc_x); + die $error if $error; + } } sub usage { - die "Usage:\n\n freeside-reexport user exportnum|exporttype svcnum|username\n"; + die "Usage:\n\n freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ]\n"; } =head1 NAME @@ -47,7 +56,7 @@ freeside-reexport - Command line tool to re-trigger export jobs for existing ser =head1 SYNOPSIS - freeside-reexport user exportnum|exporttype svcnum|username + freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ] =head1 DESCRIPTION diff --git a/FS/bin/freeside-selfservice-server b/FS/bin/freeside-selfservice-server index f9571fa1e..c045893d1 100644 --- a/FS/bin/freeside-selfservice-server +++ b/FS/bin/freeside-selfservice-server @@ -8,14 +8,15 @@ # Proc::Daemon or somesuch use strict; -use vars qw( $Debug %kids $kids $max_kids $shutdown $log_file $ssh_pid ); +use vars qw( $Debug %kids $kids $max_kids $shutdown $log_file $ssh_pid + $keepalives ); use subs qw( lock_write unlock_write ); use Fcntl qw(:flock); use POSIX qw(:sys_wait_h setsid); use IO::Handle; use IO::Select; use IO::File; -use Storable qw(nstore_fd fd_retrieve); +use Storable 2.09 qw(nstore_fd fd_retrieve); use Net::SSH qw(sshopen2); use FS::UID qw(adminsuidsetup forksuidsetup); use FS::ClientAPI; @@ -24,21 +25,22 @@ use FS::Conf; use FS::cust_bill; use FS::cust_pkg; -$Debug = 2; # >= 2 will log packet contents, including potentially compromising - # information +$Debug = 1; # 2 will turn on more logging + # 3 will log packet contents, including passwords $shutdown = 0; $max_kids = '10'; #? +$keepalives = 0; #let clientd turn it on, so we don't barf on old ones $kids = 0; my $user = shift or die &usage; my $machine = shift or die &usage; my $tag = scalar(@ARGV) ? shift : ''; -my $pid_file = "/var/run/freeside-selfservice-server.$user.pid"; -#my $pid_file = "/var/run/freeside-selfservice-server.$user.pid"; $FS::UID::datasrc not posible, but should include machine name at least, hmm + +# $FS::UID::datasrc not posible +my $pid_file = "/var/run/freeside-selfservice-server.$user.$machine.pid"; my $lock_file = "/usr/local/etc/freeside/selfservice.$machine.writelock"; -open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!"; &init($user); @@ -57,6 +59,7 @@ while (1) { warn "entering main loop\n" if $Debug; my $undisp = 0; + my $keepalive_count = 0; my $s = IO::Select->new( $reader ); while (1) { @@ -67,6 +70,12 @@ while (1) { my @handles = $s->can_read(5); unless ( @handles ) { &shutdown if $shutdown; + if ( $keepalives && $keepalive_count++ > 10 ) { + $keepalive_count = 0; + lock_write; + nstore_fd( { _token => '_keepalive' }, $writer ); + unlock_write; + } next; } @@ -88,7 +97,13 @@ while (1) { } warn "packet received\n". join('', map { " $_=>$packet->{$_}\n" } keys %$packet ) - if $Debug > 1; + if $Debug > 2; + + if ( $packet->{_packet} eq '_enable_keepalive' ) { + warn "enabling keep alives\n" if $Debug; + $keepalives=1; + next; + } #prevent runaway forking my $warnkids = 0; @@ -106,9 +121,12 @@ while (1) { warn "child $pid spawned\n" if $Debug; } else { #kid time - #get new db handle - $FS::UID::dbh->{InactiveDestroy} = 1; - forksuidsetup($user); + ##get new db handle + #$FS::UID::dbh->{InactiveDestroy} = 1; + #forksuidsetup($user); + + #get db handle + adminsuidsetup($user); my $type = $packet->{_packet}; warn "calling $type handler\n" if $Debug; @@ -119,8 +137,9 @@ while (1) { } $rv->{_token} = $packet->{_token}; #identifier - warn "sending response\n" if $Debug; + open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!"; lock_write; + warn "sending response\n" if $Debug; nstore_fd($rv, $writer) or die "FATAL: can't send response: $!"; $writer->flush or die "FATAL: can't flush: $!"; unlock_write; @@ -131,6 +150,7 @@ while (1) { } + &shutdown if $shutdown; warn "connection lost, reconnecting\n" if $Debug; sleep 3; @@ -180,6 +200,10 @@ sub init { #false laziness w/freeside-queued my $freeside_gid = scalar(getgrnam('freeside')) or die "can't setgid to freeside group\n"; + + open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!"; + chown $FS::UID::freeside_uid, $freeside_gid, $lock_file; + $) = $freeside_gid; $( = $freeside_gid; #if freebsd can't setuid(), presumably it can't setgid() either. grr fleabsd @@ -212,10 +236,12 @@ sub init { } sub shutdown { + &reap_kids; my $wait = 12; #wait up to 1 minute while ( $kids > 0 && $wait-- ) { warn "waiting for $kids children to terminate"; sleep 5; + &reap_kids; } warn "abandoning $kids children" if $kids; kill 'TERM', $ssh_pid if $ssh_pid; @@ -244,6 +270,8 @@ sub _do_logmsg { } sub lock_write { + warn "locking $lock_file mutex for write to write stream\n" if $Debug > 1; + #broken on freebsd? #flock($writer, LOCK_EX) or die "FATAL: can't lock write stream: $!"; @@ -252,6 +280,8 @@ sub lock_write { } sub unlock_write { + warn "unlocking $lock_file mutex\n" if $Debug > 1; + #broken on freebsd? #flock($writer, LOCK_UN) or die "WARNING: can't release write lock: $!"; diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 213dcb947..65e67b5a7 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -6,6 +6,8 @@ BEGIN { $FS::Record::setup_hack = 1; } use strict; use vars qw($opt_s); use Getopt::Std; +use Locale::Country; +use Locale::SubCountry; use DBI; use DBIx::DBSchema 0.20; use DBIx::DBSchema::Table; @@ -240,60 +242,40 @@ foreach my $statement ( $dbdef->sql($dbh) ) { or die "CREATE error: ". $dbh->errstr. "\ndoing statement: $statement"; } -#not really sample data (and shouldn't default to US) - #cust_main_county +foreach my $country ( sort map uc($_), all_country_codes ) { -#USPS state codes -foreach ( qw( -AL AK AS AZ AR CA CO CT DC DE FM FL GA GU HI ID IL IN IA KS KY LA -ME MH MD MA MI MN MS MO MT NC ND NE NH NJ NM NV NY MP OH OK OR PA PW PR RI -SC SD TN TX UT VT VI VA WA WV WI WY AE AA AP -) ) { - my($cust_main_county)=new FS::cust_main_county({ - 'state' => $_, - 'tax' => 0, - 'country' => 'US', - }); - my($error); - $error=$cust_main_county->insert; - die $error if $error; -} + my $subcountry = eval { new Locale::SubCountry($country) }; + my @states = $subcountry ? $subcountry->all_codes : undef; -#AU "offical" state codes ala mark.williamson@ebbs.com.au (Mark Williamson) -foreach ( qw( -VIC NSW NT QLD TAS ACT WA SA -) ) { - my($cust_main_county)=new FS::cust_main_county({ - 'state' => $_, - 'tax' => 0, - 'country' => 'AU', - }); - my($error); - $error=$cust_main_county->insert; - die $error if $error; -} + if ( !scalar(@states) || ( scalar(@states) == 1 && !defined($states[0]) ) ) { -#ISO 2-letter country codes (same as country TLDs) except US and AU -foreach ( qw( -AF AL DZ AS AD AO AI AQ AG AR AM AW AT AZ BS BH BD BB BY BE BZ BJ BM BT BO -BA BW BV BR IO BN BG BF BI KH CM CA CV KY CF TD CL CN CX CC CO KM CG CK CR CI -HR CU CY CZ DK DJ DM DO TP EC EG SV GQ ER EE ET FK FO FJ FI FR FX GF PF TF GA -GM GE DE GH GI GR GL GD GP GU GT GN GW GY HT HM HN HK HU IS IN ID IR IQ IE IL -IT JM JP JO KZ KE KI KP KR KW KG LA LV LB LS LR LY LI LT LU MO MK MG MW MY MV -ML MT MH MQ MR MU YT MX FM MD MC MN MS MA MZ MM NA NR NP NL AN NC NZ NI NE NG -NU NF MP NO OM PK PW PA PG PY PE PH PN PL PT PR QA RE RO RU RW KN LC VC WS SM -ST SA SN SC SL SG SK SI SB SO ZA GS ES LK SH PM SD SR SJ SZ SE CH SY TW TJ TZ -TH TG TK TO TT TN TR TM TC TV UG UA AE GB UM UY UZ VU VA VE VN VG VI WF EH -YE YU ZR ZM ZW -) ) { - my($cust_main_county)=new FS::cust_main_county({ - 'tax' => 0, - 'country' => $_, - }); - my($error); - $error=$cust_main_county->insert; - die $error if $error; + my $cust_main_county = new FS::cust_main_county({ + 'tax' => 0, + 'country' => $country, + }); + my $error = $cust_main_county->insert; + die $error if $error; + + } else { + + if ( $states[0] =~ /^(\d+|\w)$/ ) { + @states = map $subcountry->full_name($_), @states + } + + foreach my $state ( @states ) { + + my $cust_main_county = new FS::cust_main_county({ + 'state' => $state, + 'tax' => 0, + 'country' => $country, + }); + my $error = $cust_main_county->insert; + die $error if $error; + + } + + } } #billing events @@ -436,7 +418,7 @@ sub tables_hash_hack { 'custnum', 'int', '', '', '_date', @date_type, 'amount', @money_type, - 'otaker', 'varchar', '', 8, + 'otaker', 'varchar', '', 32, 'reason', 'text', 'NULL', '', 'closed', 'char', 'NULL', 1, ], @@ -466,7 +448,7 @@ sub tables_hash_hack { 'last', 'varchar', '', $char_d, # 'middle', 'varchar', 'NULL', $char_d, 'first', 'varchar', '', $char_d, - 'ss', 'char', 'NULL', 11, + 'ss', 'varchar', 'NULL', 11, 'company', 'varchar', 'NULL', $char_d, 'address1', 'varchar', '', $char_d, 'address2', 'varchar', 'NULL', $char_d, @@ -498,7 +480,7 @@ sub tables_hash_hack { 'paydate', 'varchar', 'NULL', 10, 'payname', 'varchar', 'NULL', $char_d, 'tax', 'char', 'NULL', 1, - 'otaker', 'varchar', '', 8, + 'otaker', 'varchar', '', 32, 'refnum', 'int', '', '', 'referral_custnum', 'int', 'NULL', '', 'comments', 'text', 'NULL', '', @@ -600,7 +582,7 @@ sub tables_hash_hack { 'pkgnum', 'int', '', '', 'custnum', 'int', '', '', 'pkgpart', 'int', '', '', - 'otaker', 'varchar', '', 8, + 'otaker', 'varchar', '', 32, 'setup', @date_type, 'bill', @date_type, 'susp', @date_type, @@ -620,7 +602,7 @@ sub tables_hash_hack { 'custnum', 'int', '', '', '_date', @date_type, 'refund', @money_type, - 'otaker', 'varchar', '', 8, + 'otaker', 'varchar', '', 32, 'reason', 'varchar', '', $char_d, 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index # into payment type table. @@ -823,10 +805,10 @@ sub tables_hash_hack { 'columns' => [ 'recnum', 'int', '', '', 'svcnum', 'int', '', '', - 'reczone', 'varchar', '', $char_d, + 'reczone', 'varchar', '', 255, 'recaf', 'char', '', 2, - 'rectype', 'char', '', 5, - 'recdata', 'varchar', '', $char_d, + 'rectype', 'varchar', '', 5, + 'recdata', 'varchar', '', 255, ], 'primary_key' => 'recnum', 'unique' => [], diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset index 74f90a582..11cbe9e36 100755 --- a/FS/bin/freeside-sqlradius-reset +++ b/FS/bin/freeside-sqlradius-reset @@ -1,4 +1,4 @@ -#!/usr/bin/perl -Tw +#!/usr/bin/perl -w use strict; use FS::UID qw(adminsuidsetup); @@ -12,9 +12,18 @@ adminsuidsetup $user; #my $machine = shift or die &usage; -my @exports = qsearch('part_export', { exporttype=>'sqlradius' } ); -push @exports, qsearch('part_export', { exporttype=>'sqlradius_withdomain' } ); - +my @exports = (); +if ( @ARGV ) { + foreach my $exportnum ( @ARGV ) { + foreach my $exporttype (qw( sqlradius sqlradius_withdomain )) { + push @exports, qsearch('part_export', { exportnum => $exportnum, + exporttype => $exporttype, } ); + } + } + } else { + @exports = qsearch('part_export', { exporttype=>'sqlradius' } ); + push @exports, qsearch('part_export', { exporttype=>'sqlradius_withdomain' } ); +} foreach my $export ( @exports ) { my $icradius_dbh = DBI->connect( @@ -47,8 +56,7 @@ foreach my $export ( @exports ) { } sub usage { - #die "Usage:\n\n sqlradius_reset user machine\n"; - die "Usage:\n\n freeside-sqlradius-reset user\n"; + die "Usage:\n\n freeside-sqlradius-reset user [ exportnum, ... ]\n"; } =head1 NAME @@ -57,12 +65,13 @@ freeside-sqlradius-reset - Command line interface to reset and recreate RADIUS S =head1 SYNOPSIS - freeside-sqlradius-reset username + freeside-sqlradius-reset username [ EXPORTNUM, ... ] =head1 DESCRIPTION Deletes the radcheck, radreply and usergroup tables and repopulates them from -the Freeside database, for all sqlradius exports. +the Freeside database, for the specified exports, or, if no exports are +specified, for all sqlradius and sqlradius_withdomain exports. B<username> is a username added by freeside-adduser. diff --git a/FS/bin/freeside-tax-report b/FS/bin/freeside-tax-report deleted file mode 100755 index d48da87a6..000000000 --- a/FS/bin/freeside-tax-report +++ /dev/null @@ -1,292 +0,0 @@ -#!/usr/bin/perl -Tw - - -use strict; -use Date::Parse; -use Time::Local; -use Getopt::Std; -use Text::Template; -use Net::SMTP; -use Mail::Header; -use Mail::Internet; -use FS::Conf; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch); -use FS::cust_bill; -use FS::cust_bill_pay; -use FS::cust_pay; - - -&untaint_argv; #what it sounds like (eww) -use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf $header); -getopts("vpmef:s:"); #switches - -#we're at now now (and later). -my($_finishdate)= $opt_f ? str2time($main::opt_f) : $^T; -my($_startdate)= $opt_s ? str2time($main::opt_s) : $^T; - -# Get the current month -my ($ssec,$smin,$shour,$smday,$smon,$syear) = - (localtime($_startdate) )[0,1,2,3,4,5]; -$smon++; -$syear += 1900; - -# Get the current month -my ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear) = - (localtime($_finishdate) )[0,1,2,3,4,5]; -$fmon++; -$fyear += 1900; - -# Login to the database -my $user = shift or die &usage; -adminsuidsetup $user; - -# Get the needed configuration files -my $conf = new FS::Conf; -my $lpr = $conf->config('lpr'); -my $email = $conf->config('email'); -my $smtpmachine = $conf->config('smtpmachine'); -my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') : - 'postmaster'; -my @report_template = $conf->config('report_template') - or die "cannot load config file report_template"; -$report_lines = 0; -foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/ - /report_lines\((\d+)\)/; - $report_lines += $1; -} -die "no report_lines() functions in template?" unless $report_lines; -$report_template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @report_template ], -) or die "can't create new Text::Template object: $Text::Template::ERROR"; - - -my(@cust_bills)=qsearch('cust_bill',{}); -if (scalar(@cust_bills) == 0) -{ - exit 1; -} - -# Open print and email pipes -# $lpr and opt_p for printing -# $email and opt_m for email - -if ($lpr && $main::opt_p) -{ - open(LPR, "|$lpr"); -} - -if ($email && $main::opt_m) -{ - $ENV{MAILADDRESS} = $mail_sender; - $header = new Mail::Header ( [ - "From: Account Processor", - "To: $email", - "Sender: $mail_sender", - "Reply-To: $mail_sender", - "Subject: Sales Taxes Invoiced", - ] ); -} - -my $comped = 0; -my $comped_tax = 0; -my $other = 0; -my $other_tax = 0; -my $total = 0; -my $taxed = 0; -my $untaxed = 0; -my $total_tax = 0; - -# Now I can start looping -foreach my $cust_bill (@cust_bills) -{ - my $_date = $cust_bill->getfield('_date'); - my $invnum = $cust_bill->getfield('invnum'); - my $charged = $cust_bill->getfield('charged'); - - if ($_date >= $_startdate && $_date <= $_finishdate) { - $total += $charged; - - # The following lines were used to produce rather verbose reports - #my ($sec,$min,$hour,$mday,$mon,$year) = - # (localtime($_date) )[0,1,2,3,4,5]; - #$mon++; - #$year -= 100 if $year >= 100; - #$year = "0" . $year if $year < 10; - - my $invoice_amt =0; - my $invoice_tax =0; - my $invoice_comped =0; - my(@cust_bill_pkgs)= $cust_bill->cust_bill_pkg; - foreach my $cust_bill_pkg (@cust_bill_pkgs) { - - my $recur = $cust_bill_pkg->getfield('recur'); - my $setup = $cust_bill_pkg->getfield('setup'); - my $pkgnum = $cust_bill_pkg->getfield('pkgnum'); - - if ($pkgnum == 0) { - # The following line was used to produce rather verbose reports - # push @buf, ('', sprintf(qq{%10s%15s%14.2f}, "$mon/$mday/$year", "Tax $invnum", $recur+$setup)); - $invoice_tax += $recur; - $invoice_tax += $setup; - } else { - # The following line was used to produce rather verbose reports - # push @buf, ('', sprintf(qq{%10s%15s%14.2f}, "$mon/$mday/$year", "Inv $invnum", $recur+$setup)); - $invoice_amt += $recur; - $invoice_amt += $setup; - } - - } - - my(@cust_bill_pays)= $cust_bill->cust_bill_pay; - foreach my $cust_bill_pay (@cust_bill_pays) { - my $payby = $cust_bill_pay->cust_pay->payby; - my $paid = $cust_bill_pay->getfield('amount'); - if ($payby =~ 'COMP') { - $invoice_comped += $paid; - } - } - - if (abs($invoice_comped - ($invoice_amt + $invoice_tax)) < 0.0001){ - $comped += $invoice_amt; - $comped_tax += $invoice_tax; - } elsif ($invoice_comped > 0) { - push @buf, sprintf(qq{\nInvoice %10d has inexpliciable complimentary payments of %14.9f\n}, $invnum, $invoice_comped); - $other += $invoice_amt; - $other_tax += $invoice_tax; - } elsif ($invoice_tax > 0) { - $total_tax += $invoice_tax; - $taxed += $invoice_amt; - } else { - $untaxed += $invoice_amt; - } - - } - -} - -push @buf, ('', sprintf(qq{%25s%14.2f}, "Complimentary", $comped)); -push @buf, sprintf(qq{%25s%14.2f}, "Complimentary Tax", $comped_tax); -push @buf, sprintf(qq{%25s%14.2f}, "Other", $other); -push @buf, sprintf(qq{%25s%14.2f}, "Other Tax", $other_tax); -push @buf, sprintf(qq{%25s%14.2f}, "Untaxed", $untaxed); -push @buf, sprintf(qq{%25s%14.2f}, "Taxed", $taxed); -push @buf, sprintf(qq{%25s%14.2f}, "Tax", $total_tax); -push @buf, ('', sprintf(qq{%39s}, "========="), sprintf(qq{%39.2f}, $total)); - -sub FS::tax_report::_template::report_lines { - my $lines = shift; - map { - scalar(@buf) ? shift @buf : '' ; - } - ( 1 .. $lines ); -} - -$FS::tax_report::_template::title = qq~SALES TAXES INVOICED for $smon/$smday/$syear through $fmon/$fmday/$fyear~; -$FS::tax_report::_template::title = $opt_t if $opt_t; -$FS::tax_report::_template::page = 1; -$FS::tax_report::_template::date = $^T; -$FS::tax_report::_template::date = $^T; -$FS::tax_report::_template::fdate = $_finishdate; -$FS::tax_report::_template::fdate = $_finishdate; -$FS::tax_report::_template::sdate = $_startdate; -$FS::tax_report::_template::sdate = $_startdate; -$FS::tax_report::_template::total_pages = - int( scalar(@buf) / $report_lines); -$FS::tax_report::_template::total_pages++ if scalar(@buf) % $report_lines; - -my @report; -while (@buf) { - push @report, split("\n", - $report_template->fill_in( PACKAGE => 'FS::tax_report::_template' ) - ); - $FS::tax_report::_template::page++; -} - -if ($opt_v) { - print map "$_\n", @report; -} -if($lpr && $opt_p) -{ - print LPR map "$_\n", @report; - print LPR "\f" if $opt_e; - close LPR || die "Could not close printer: $lpr\n"; -} -if($email && $opt_m) -{ - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ (@report) ], - ); - $!=0; - $message->smtpsend( Host => "$smtpmachine" ) - or die "can't send report to $email via $smtpmachine: $!"; -} - - -# subroutines -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/ :\.]*)$/ || die "Illegal argument \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-tax-report [-v] [-p] [-e] user\n"; -} - -=head1 NAME - -freeside-tax-report - Prints or emails sales taxes invoiced in a given period. - -=head1 SYNOPSIS - - freeside-tax-report [-v] [-p] [-m] [-e] [-t "title"] [-s date] [-f date] user - -=head1 DESCRIPTION - -Prints or emails sales taxes invoiced in a given period. - --v: Verbose - Prints records to STDOUT. - --p: Print to printer lpr as found in the conf directory. - --m: Email output to user found in the Conf email file. - --e: Print a final form feed to the printer. - --t: supply a title for the top of each page. - --s: starting date for inclusion - --f: final date for inclusion - -user: From the mapsecrets file - see config.html from the base documentation - -=head1 VERSION - -$Id: freeside-tax-report,v 1.4.4.1 2002-09-09 22:57:32 ivan Exp $ - -=head1 BUGS - -Yes..... Use at your own risk. No guarantees or warrantees of any -kind apply to this program. Parts of this program are hacked from -other GNU licensed software created mainly by Ivan Kohler. - -This is released under the GNU Public License. See www.gnu.org -for more information regarding this license. - -=head1 SEE ALSO - -L<FS::cust_main>, config.html from the base documentation - -=head1 AUTHOR - -Jeff Finucane <jeff@cmh.net> - -based on print-batch by Joel Griffiths <griff@aver-computer.com> - -=cut - |