diff options
Diffstat (limited to 'FS')
40 files changed, 1736 insertions, 112 deletions
diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index b38c2671d..66624e179 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -277,6 +277,7 @@ tie my %rights, 'Tie::IxHash', 'Financial reports', { rightname=> 'List inventory', global=>1 }, { rightname=>'View email logs', global=>1 }, + { rightname=>'View system logs' }, 'Download report data', 'Services: Accounts', diff --git a/FS/FS/ClientAPI/PrepaidPhone.pm b/FS/FS/ClientAPI/PrepaidPhone.pm index c34617922..c7317ea23 100644 --- a/FS/FS/ClientAPI/PrepaidPhone.pm +++ b/FS/FS/ClientAPI/PrepaidPhone.pm @@ -3,6 +3,7 @@ package FS::ClientAPI::PrepaidPhone; use strict; use vars qw($DEBUG $me); use FS::Record qw(qsearchs); +use FS::Conf; use FS::rate; use FS::svc_phone; @@ -156,11 +157,15 @@ sub call_time { return \%return; } + my $conf = new FS::Conf; + my $balance = $conf->config_bool('pkg-balances') ? $cust_pkg->balance + : $cust_main->balance; + #XXX granularity? included minutes? another day... - if ( $cust_main->balance >= 0 ) { + if ( $balance >= 0 ) { return { 'error'=>'No balance' }; } else { - $return{'seconds'} = int(60 * abs($cust_main->balance) / $rate_detail->min_charge); + $return{'seconds'} = int(60 * abs($balance) / $rate_detail->min_charge); } warn "$me returning seconds: ". $return{'seconds'}; @@ -248,13 +253,18 @@ sub phonenum_balance { my $cust_pkg = $svc_phone->cust_svc->cust_pkg; - warn "$me returning ". $cust_pkg->cust_main->balance. - " balance for custnum ". $cust_pkg->custnum + my $conf = new FS::Conf; + my $balance = $conf->config_bool('pkg-balances') + ? $cust_pkg->balance + : $cust_pkg->cust_main->balance; + + warn "$me returning $balance balance for pkgnum ". $cust_pkg->pkgnum. + ", custnum ". $cust_pkg->custnum if $DEBUG; return { 'custnum' => $cust_pkg->custnum, - 'balance' => $cust_pkg->cust_main->balance, + 'balance' => $balance, }; } diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 7f3fcaa38..d11916faf 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -749,6 +749,15 @@ sub reason_type_options { }, { + 'key' => 'event_log_level', + 'section' => 'notification', + 'description' => 'Store events in the internal log if they are at least this severe. "info" is the default, "debug" is very detailed and noisy.', + 'type' => 'select', + 'select_enum' => [ '', 'debug', 'info', 'notice', 'warning', 'error', ], + # don't bother with higher levels + }, + + { 'key' => 'log_sent_mail', 'section' => 'notification', 'description' => 'Enable logging of template-generated email.', @@ -1478,7 +1487,7 @@ and customer address. Include units.', 'section' => 'invoicing', 'description' => 'Optional default invoice term, used to calculate a due date printed on invoices.', 'type' => 'select', - 'select_enum' => [ '', 'Payable upon receipt', 'Net 0', 'Net 3', 'Net 9', 'Net 10', 'Net 15', 'Net 20', 'Net 21', 'Net 30', 'Net 45', 'Net 60', 'Net 90' ], + 'select_enum' => [ '', 'Payable upon receipt', 'Net 0', 'Net 3', 'Net 9', 'Net 10', 'Net 15', 'Net 18', 'Net 20', 'Net 21', 'Net 30', 'Net 45', 'Net 60', 'Net 90' ], }, { diff --git a/FS/FS/Cron/bill.pm b/FS/FS/Cron/bill.pm index a9df376dc..6e110e852 100644 --- a/FS/FS/Cron/bill.pm +++ b/FS/FS/Cron/bill.pm @@ -13,6 +13,8 @@ use FS::cust_main; use FS::part_event; use FS::part_event_condition; +use FS::Log; + @ISA = qw( Exporter ); @EXPORT_OK = qw ( bill bill_where ); @@ -27,6 +29,9 @@ use FS::part_event_condition; sub bill { my %opt = @_; + my $log = FS::Log->new('Cron::bill'); + $log->info('start'); + my $check_freq = $opt{'check_freq'} || '1d'; my $debug = 0; @@ -134,6 +139,7 @@ sub bill { $cursor_dbh->commit or die $cursor_dbh->errstr; + $log->info('finish'); } # freeside-daily %opt: diff --git a/FS/FS/Cron/upload.pm b/FS/FS/Cron/upload.pm index 08819fce9..628c6801b 100644 --- a/FS/FS/Cron/upload.pm +++ b/FS/FS/Cron/upload.pm @@ -9,6 +9,7 @@ use FS::Record qw( qsearch qsearchs ); use FS::Conf; use FS::queue; use FS::agent; +use FS::Log; use FS::Misc qw( send_email ); #for bridgestone use FS::upload_target; use LWP::UserAgent; @@ -33,6 +34,8 @@ $me = '[FS::Cron::upload]'; sub upload { my %opt = @_; + my $log = FS::Log->new('Cron::upload'); + $log->info('start'); my $debug = 0; $debug = 1 if $opt{'v'}; @@ -95,6 +98,32 @@ sub upload { } } # foreach @agents + # if there's nothing to do, don't hold up the rest of the process + if (!@tasks) { + $log->info('finish (nothing to upload)'); + return ''; + } + + # wait for any ongoing billing jobs to complete + if ($opt{m}) { + my $dbh = dbh; + my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ". + "WHERE queue.job='FS::cust_main::queued_bill' AND status != 'failed'"; + if (@agents) { + $sql .= ' AND cust_main.agentnum IN('. + join(',', map {$_->agentnum} @agents). + ')'; + } + my $sth = $dbh->prepare($sql) or die $dbh->errstr; + while (1) { + $sth->execute() + or die "Unexpected error executing statement $sql: ". $sth->errstr; + last if $sth->fetchrow_arrayref->[0] == 0; + warn "Waiting 5min for billing to complete...\n" if $DEBUG; + sleep 300; + } + } + foreach (@tasks) { my $agentnum = $_->{agentnum}; @@ -119,11 +148,13 @@ sub upload { } } + $log->info('finish'); } sub spool_upload { my %opt = @_; + my $log = FS::Log->new('spool_upload'); warn "$me spool_upload called\n" if $DEBUG; my $conf = new FS::Conf; @@ -143,6 +174,8 @@ sub spool_upload { my $dbh = dbh; my $agentnum = $opt{agentnum}; + $log->debug('start', agentnum => $agentnum); + my $agent; if ( $agentnum ) { $agent = qsearchs( 'agent', { agentnum => $agentnum } ) @@ -160,6 +193,8 @@ sub spool_upload { { warn "$me neither $dir/$file-header.csv nor ". "$dir/$file-detail.csv found\n" if $DEBUG > 1; + $log->debug("finish (neither $file-header.csv nor ". + "$file-detail.csv found)"); $dbh->commit or die $dbh->errstr if $oldAutoCommit; return; } @@ -170,19 +205,6 @@ sub spool_upload { my $username = $opt{username} or die "no username for agent $agentnum\n"; my $password = $opt{password} or die "no password for agent $agentnum\n"; - # a better way? - if ($opt{m}) { - my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ". - "WHERE queue.job='FS::cust_main::queued_bill' AND cust_main.agentnum = ?"; - my $sth = $dbh->prepare($sql) or die $dbh->errstr; - while (1) { - $sth->execute( $agentnum ) - or die "Unexpected error executing statement $sql: ". $sth->errstr; - last if $sth->fetchrow_arrayref->[0]; - sleep 300; - } - } - foreach ( qw ( header detail ) ) { rename "$dir/$file-$_.csv", "$dir/$file-$date-$_.csv"; @@ -252,6 +274,7 @@ sub spool_upload { unless ( -f "$dir/$file.csv" ) { warn "$me $dir/$file.csv not found\n" if $DEBUG > 1; + $log->debug("finish ($dir/$file.csv not found)"); $dbh->commit or die $dbh->errstr if $oldAutoCommit; return; } @@ -326,14 +349,16 @@ sub spool_upload { } } - send_report('bridgestone-confirm_template', - { - agentnum=> $agentnum, - zipfile => $zipfile, - prefix => $prefix, - seq => $seq, - rows => $rows, - } + send_email( + prepare_report('bridgestone-confirm_template', + { + agentnum=> $agentnum, + zipfile => $zipfile, + prefix => $prefix, + seq => $seq, + rows => $rows, + } + ) ); $seq++; @@ -376,16 +401,26 @@ sub spool_upload { close $reg; close $big; + # zip up all three files for transport my $zipfile = "$basename" . '.zip'; my $command = "cd $dir; zip $zipfile $regfile $bigfile"; system($command) and die "'$command' failed\n"; - my $error = $upload_target->put("$dir/$zipfile"); + # upload them, unless we're using email, in which case + # the zip file will ride along with the report. yes, this + # kind of defeats the purpose of the upload_target interface, + # but at least we have a place to store the configuration. + my $error = ''; + if ( $upload_target->protocol ne 'email' ) { + $error = $upload_target->put("$dir/$zipfile"); + } + + # create the report for (values %sum) { $_ = sprintf('%.2f', $_); } - send_report('ics-confirm_template', + my %report = prepare_report('ics-confirm_template', { agentnum => $agentnum, count => \%count, @@ -393,8 +428,23 @@ sub spool_upload { error => $error, } ); + if ( $upload_target->protocol eq 'email' ) { + $report{'to'} = + join('@', $upload_target->username, $upload_target->hostname); + $report{'subject'} = $upload_target->subject; + $report{'mimeparts'} = [ + { Path => "$dir/$zipfile", + Type => 'application/zip', + Encoding => 'base64', + Filename => $zipfile, + Disposition => 'attachment', + } + ]; + } + $error = send_email(%report); if ( $error ) { + # put the original spool file back rename "$dir/$file-$date.csv", "$dir/$file.csv"; die $error; } @@ -413,6 +463,8 @@ sub spool_upload { } #opt{handling} + $log->debug('finish', agentnum => $agentnum); + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -421,7 +473,8 @@ sub spool_upload { =item send_report CONFIG PARAMS Retrieves the config value named CONFIG, parses it as a Text::Template, -extracts "to" and "subject" headers, and sends it by email. +extracts "to" and "subject" headers, and returns a hash that can be passed +to L<FS::Misc::send_email>. PARAMS is a hashref to be passed to C<fill_in>. It must contain 'agentnum' to look up the per-agent config. @@ -429,7 +482,8 @@ PARAMS is a hashref to be passed to C<fill_in>. It must contain =cut # we used it twice, so it's now a subroutine -sub send_report { + +sub prepare_report { my ($config, $params) = @_; my $agentnum = $params->{agentnum}; @@ -452,7 +506,7 @@ sub send_report { $head =~ /^to:\s*(.*)$/im; my $to = $1; - send_email( + ( to => $to, from => $conf->config('invoice_from', $agentnum), subject => $subject, diff --git a/FS/FS/Log.pm b/FS/FS/Log.pm new file mode 100644 index 000000000..b11630bc9 --- /dev/null +++ b/FS/FS/Log.pm @@ -0,0 +1,103 @@ +package FS::Log; + +use base 'Log::Dispatch'; +use FS::Record qw(qsearch qsearchs); +use FS::Conf; +use FS::Log::Output; +use FS::log; +use vars qw(@STACK @LEVELS); + +# override the stringification of @_ with something more sensible. +BEGIN { + @LEVELS = qw(debug info notice warning error critical alert emergency); + + foreach my $l (@LEVELS) { + my $sub = sub { + my $self = shift; + $self->log( level => $l, message => @_ ); + }; + no strict 'refs'; + *{$l} = $sub; + } +} + +=head1 NAME + +FS::Log - Freeside event log + +=head1 SYNOPSIS + +use FS::Log; + +sub do_something { + my $log = FS::Log->new('do_something'); # set log context to 'do_something' + + ... + if ( $error ) { + $log->error('something is wrong: '.$error); + return $error; + } + # at this scope exit, do_something is removed from context +} + +=head1 DESCRIPTION + +FS::Log provides an interface for logging errors and profiling information +to the database. FS::Log inherits from L<Log::Dispatch>. + +=head1 CLASS METHODS + +=over 4 + +new CONTEXT + +Constructs and returns a log handle. CONTEXT must be a known context tag +indicating what activity is going on, such as the name of the function or +script that is executing. + +Log context is a stack, and each element is removed from the stack when it +goes out of scope. So don't keep log handles in persistent places (i.e. +package variables or class-scoped lexicals). + +=cut + +sub new { + my $class = shift; + my $context = shift; + + my $min_level = FS::Conf->new->config('event_log_level') || 'info'; + + my $self = $class->SUPER::new( + outputs => [ [ '+FS::Log::Output', min_level => $min_level ] ], + ); + $self->{'index'} = scalar(@STACK); + push @STACK, $context; + return $self; +} + +=item context + +Returns the current context stack. + +=cut + +sub context { @STACK }; + +=item log LEVEL, MESSAGE[, OPTIONS ] + +Like L<Log::Dispatch::log>, but OPTIONS may include: + +- agentnum +- object (an <FS::Record> object to reference in this log message) +- tablename and tablenum (an alternate way of specifying 'object') + +=cut + +# inherited + +sub DESTROY { + my $self = shift; + splice(@STACK, $self->{'index'}, 1); # delete the stack entry +} + +1; diff --git a/FS/FS/Log/Output.pm b/FS/FS/Log/Output.pm new file mode 100644 index 000000000..18d7f1b43 --- /dev/null +++ b/FS/FS/Log/Output.pm @@ -0,0 +1,50 @@ +package FS::Log::Output; + +use base Log::Dispatch::Output; +use FS::Record qw( dbdef ); + +sub new { # exactly by the book + my $proto = shift; + my $class = ref $proto || $proto; + + my %p = @_; + + my $self = bless {}, $class; + + $self->_basic_init(%p); + + return $self; +} + +sub log_message { + my $self = shift; + my %m = @_; + + my $object = $m{'object'}; + my ($tablename, $tablenum) = @m{'tablename', 'tablenum'}; + if ( $object and $object->isa('FS::Record') ) { + $tablename = $object->table; + $tablenum = $object->get( dbdef->table($tablename)->primary_key ); + + # get the agentnum from the object if it has one + $m{'agentnum'} ||= $object->get('agentnum'); + # maybe FS::cust_main_Mixin objects should use the customer's agentnum? + # I'm trying not to do database lookups in here, though. + } + + my $entry = FS::log->new({ + _date => time, + agentnum => $m{'agentnum'}, + tablename => ($tablename || ''), + tablenum => ($tablenum || ''), + level => $self->_level_as_number($m{'level'}), + message => $m{'message'}, + }); + my $error = $entry->insert( FS::Log->context ); + if ( $error ) { + # guh? + warn "Error writing log entry: $error"; + } +} + +1; diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 944a4836c..2bc1596f2 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -56,6 +56,8 @@ if ( -e $addl_handler_use_file ) { #use CGI::Carp qw(fatalsToBrowser); use CGI::Cookie; use List::Util qw( max min sum ); + use List::MoreUtils qw( first_index uniq ); + use Scalar::Util qw( blessed ); use Data::Dumper; use Date::Format; use Time::Local; @@ -82,6 +84,7 @@ if ( -e $addl_handler_use_file ) { use IO::Handle; use IO::File; use IO::Scalar; + use IO::String; #not actually using this yet anyway...# use IPC::Run3 0.036; use Net::Whois::Raw qw(whois); if ( $] < 5.006 ) { @@ -327,6 +330,8 @@ if ( -e $addl_handler_use_file ) { use FS::agent_pkg_class; use FS::svc_export_machine; use FS::GeocodeCache; + use FS::log; + use FS::log_context; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 9eb59a09a..172ac8296 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -191,6 +191,7 @@ sub dbdef_dist { foreach my $table ( grep { ! /^clientapi_session/ && ! /^h_/ + && ! /^log(_context)?$/ && ! $tables_hashref_torrus->{$_} } $dbdef->tables @@ -3972,6 +3973,32 @@ sub tables_hashref { 'index' => [], }, + 'log' => { + 'columns' => [ + 'lognum', 'serial', '', '', '', '', + '_date', 'int', '', '', '', '', + 'agentnum', 'int', 'NULL', '', '', '', + 'tablename', 'varchar', 'NULL', $char_d, '', '', + 'tablenum', 'int', 'NULL', '', '', '', + 'level', 'int', '', '', '', '', + 'message', 'text', '', '', '', '', + ], + 'primary_key' => 'lognum', + 'unique' => [], + 'index' => [ ['_date'], ['level'] ], + }, + + 'log_context' => { + 'columns' => [ + 'logcontextnum', 'serial', '', '', '', '', + 'lognum', 'int', '', '', '', '', + 'context', 'varchar', '', 32, '', '', + ], + 'primary_key' => 'logcontextnum', + 'unique' => [ [ 'lognum', 'context' ] ], + 'index' => [], + }, + %{ tables_hashref_torrus() }, # tables of ours for doing torrus virtual port combining diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index 826569b25..a83af1326 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -665,8 +665,9 @@ sub set_display { =item disintegrate -Returns a list of cust_bill_pkg objects each with no more than a single class -(including setup or recur) of charge. +Returns a hash: keys are "setup", "recur" or usage classnum, values are +FS::cust_bill_pkg objects, each with no more than a single class (setup or +recur) of charge. =cut @@ -843,6 +844,18 @@ sub _X_show_zero { $self->cust_pkg->_X_show_zero($what); } +=item credited [ BEFORE, AFTER, OPTIONS ] + +Returns the sum of credits applied to this item. Arguments are the same as +owed_sql/paid_sql/credited_sql. + +=cut + +sub credited { + my $self = shift; + $self->scalar_sql('SELECT '. $self->credited_sql(@_).' FROM cust_bill_pkg WHERE billpkgnum = ?', $self->billpkgnum); +} + =back =head1 CLASS METHODS diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 6185fc472..dfe55fb63 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -172,7 +172,7 @@ sub insert { $dbh->commit or die $dbh->errstr if $oldAutoCommit; - #false laziness w/ cust_credit::insert + #false laziness w/ cust_pay::insert if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) { my @errors = $cust_main->unsuspend; #return @@ -618,6 +618,262 @@ sub credited_sql { unapplied_sql(); } +=item credit_lineitems + +Example: + + my $error = FS::cust_credit->credit_lineitems( + + #the lineitems to credit + 'billpkgnums' => \@billpkgnums, + 'setuprecurs' => \@setuprecurs, + 'amounts' => \@amounts, + + #the credit + 'newreasonnum' => scalar($cgi->param('newreasonnum')), + 'newreasonnum_type' => scalar($cgi->param('newreasonnumT')), + map { $_ => scalar($cgi->param($_)) } + #fields('cust_credit') + qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum + + ); + +=cut + +#maybe i should just be an insert with extra args instead of a class method +use FS::cust_bill_pkg; +sub credit_lineitems { + my( $class, %arg ) = @_; + + my $curuser = $FS::CurrentUser::CurrentUser; + + #some false laziness w/misc/xmlhttp-cust_bill_pkg-calculate_taxes.html + + my $cust_main = qsearchs({ + 'table' => 'cust_main', + 'hashref' => { 'custnum' => $arg{custnum} }, + 'extra_sql' => ' AND '. $curuser->agentnums_sql, + }) or return 'unknown customer'; + + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + #my @cust_bill_pkg = qsearch({ + # 'select' => 'cust_bill_pkg.*', + # 'table' => 'cust_bill_pkg', + # 'addl_from' => ' LEFT JOIN cust_bill USING (invnum) '. + # ' LEFT JOIN cust_main USING (custnum) ', + # 'extra_sql' => ' WHERE custnum = $custnum AND billpkgnum IN ('. + # join( ',', @{$arg{billpkgnums}} ). ')', + # 'order_by' => 'ORDER BY invnum ASC, billpkgnum ASC', + #}); + + my $error = ''; + if ($arg{reasonnum} == -1) { + + $error = 'Enter a new reason (or select an existing one)' + unless $arg{newreasonnum} !~ /^\s*$/; + my $reason = new FS::reason { + 'reason' => $arg{newreasonnum}, + 'reason_type' => $arg{newreasonnum_type}, + }; + $error ||= $reason->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error inserting reason: $error"; + } + $arg{reasonnum} = $reason->reasonnum; + } + + my $cust_credit = new FS::cust_credit ( { + map { $_ => $arg{$_} } + #fields('cust_credit') + qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum + } ); + $error = $cust_credit->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error inserting credit: $error"; + } + + #my $subtotal = 0; + my $taxlisthash = {}; + my %cust_credit_bill = (); + my %cust_bill_pkg = (); + my %cust_credit_bill_pkg = (); + foreach my $billpkgnum ( @{$arg{billpkgnums}} ) { + my $setuprecur = shift @{$arg{setuprecurs}}; + my $amount = shift @{$arg{amounts}}; + + my $cust_bill_pkg = qsearchs({ + 'table' => 'cust_bill_pkg', + 'hashref' => { 'billpkgnum' => $billpkgnum }, + 'addl_from' => 'LEFT JOIN cust_bill USING (invnum)', + 'extra_sql' => 'AND custnum = '. $cust_main->custnum, + }) or die "unknown billpkgnum $billpkgnum"; + + if ( $setuprecur eq 'setup' ) { + $cust_bill_pkg->setup($amount); + $cust_bill_pkg->recur(0); + $cust_bill_pkg->unitrecur(0); + $cust_bill_pkg->type(''); + } else { + $setuprecur = 'recur'; #in case its a usage classnum? + $cust_bill_pkg->recur($amount); + $cust_bill_pkg->setup(0); + $cust_bill_pkg->unitsetup(0); + } + + push @{$cust_bill_pkg{$cust_bill_pkg->invnum}}, $cust_bill_pkg; + + #unapply any payments applied to this line item (other credits too?) + foreach my $cust_bill_pay_pkg ( $cust_bill_pkg->cust_bill_pay_pkg($setuprecur) ) { + $error = $cust_bill_pay_pkg->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error unapplying payment: $error"; + } + } + + #$subtotal += $amount; + $cust_credit_bill{$cust_bill_pkg->invnum} += $amount; + push @{ $cust_credit_bill_pkg{$cust_bill_pkg->invnum} }, + new FS::cust_credit_bill_pkg { + 'billpkgnum' => $cust_bill_pkg->billpkgnum, + 'amount' => $amount, + 'setuprecur' => $setuprecur, + 'sdate' => $cust_bill_pkg->sdate, + 'edate' => $cust_bill_pkg->edate, + }; + + my $part_pkg = $cust_bill_pkg->part_pkg; + $cust_main->_handle_taxes( $part_pkg, + $taxlisthash, + $cust_bill_pkg, + $cust_bill_pkg->cust_pkg, + $cust_bill_pkg->cust_bill->_date, + $cust_bill_pkg->cust_pkg->pkgpart, + ); + } + + ### + # now loop through %cust_credit_bill and insert those + ### + + # (hack to prevent cust_credit_bill_pkg insertion) + local($FS::cust_bill_ApplicationCommon::skip_apply_to_lineitems_hack) = 1; + + foreach my $invnum ( sort { $a <=> $b } keys %cust_credit_bill ) { + + #taxes + + if ( @{ $cust_bill_pkg{$invnum} } ) { + + my $listref_or_error = + $cust_main->calculate_taxes( $cust_bill_pkg{$invnum}, $taxlisthash, $cust_bill_pkg{$invnum}->[0]->cust_bill->_date ); + + unless ( ref( $listref_or_error ) ) { + $dbh->rollback if $oldAutoCommit; + return "Error calculating taxes: $listref_or_error"; + } + + # so, loop through the taxlines, apply just that amount to the tax line + # item (save for later insert) & add to $ + + #my @taxlines = (); + #my $taxtotal = 0; + foreach my $taxline ( @$listref_or_error ) { + + #find equivalent tax line items on the existing invoice + # (XXX need a more specific/deterministic way to find these than itemdesc..) + my $tax_cust_bill_pkg = qsearchs('cust_bill_pkg', { + 'invnum' => $invnum, + 'pkgnum' => 0, #$taxline->invnum + 'itemdesc' => $taxline->desc, + }); + + my $amount = $taxline->setup; + my $desc = $taxline->desc; + + foreach my $location ( $tax_cust_bill_pkg->cust_bill_pkg_tax_Xlocation ) { + + $location->cust_bill_pkg_desc($taxline->desc); #ugh @ that kludge + + #$taxtotal += $location->amount; + $amount -= $location->amount; + + #push @taxlines, + # #[ $location->desc, $taxline->setup, $taxlocnum, $taxratelocnum ]; + # [ $location->desc, $location->amount, $taxlocnum, $taxratelocnum ]; + $cust_credit_bill{$invnum} += $location->amount; + push @{ $cust_credit_bill_pkg{$invnum} }, + new FS::cust_credit_bill_pkg { + 'billpkgnum' => $tax_cust_bill_pkg->billpkgnum, + 'amount' => $location->amount, + 'setuprecur' => 'setup', + 'billpkgtaxlocationnum' => $location->billpkgtaxlocationnum, + 'billpkgtaxratelocationnum' => $location->billpkgtaxratelocationnum, + }; + + } + if ($amount > 0) { + #$taxtotal += $amount; + #push @taxlines, + # [ $taxline->itemdesc. ' (default)', sprintf('%.2f', $amount), '', '' ]; + + $cust_credit_bill{$invnum} += $amount; + push @{ $cust_credit_bill_pkg{$invnum} }, + new FS::cust_credit_bill_pkg { + 'billpkgnum' => $tax_cust_bill_pkg->billpkgnum, + 'amount' => $amount, + 'setuprecur' => 'setup', + }; + + } + } + + } + + #insert cust_credit_bill + + my $cust_credit_bill = new FS::cust_credit_bill { + 'crednum' => $cust_credit->crednum, + 'invnum' => $invnum, + 'amount' => $cust_credit_bill{$invnum}, + }; + $error = $cust_credit_bill->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error applying credit of $cust_credit_bill{$invnum} ". + " to invoice $invnum: $error"; + } + + #and then insert cust_credit_bill_pkg for each cust_bill_pkg + foreach my $cust_credit_bill_pkg ( @{$cust_credit_bill_pkg{$invnum}} ) { + $cust_credit_bill_pkg->creditbillnum( $cust_credit_bill->creditbillnum ); + $error = $cust_credit_bill_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error applying credit to line item: $error"; + } + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =back =head1 BUGS diff --git a/FS/FS/cust_location.pm b/FS/FS/cust_location.pm index 1521960d4..b86529b3d 100644 --- a/FS/FS/cust_location.pm +++ b/FS/FS/cust_location.pm @@ -324,6 +324,9 @@ sub move_to { my $dbh = dbh; my $error = ''; + # prevent this from failing because of pkg_svc quantity limits + local( $FS::cust_svc::ignore_quantity ) = 1; + if ( !$new->locationnum ) { $error = $new->insert; if ( $error ) { diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm index 11247a28f..3dc8f9cad 100644 --- a/FS/FS/cust_main/Billing.pm +++ b/FS/FS/cust_main/Billing.pm @@ -21,6 +21,7 @@ use FS::cust_bill_pkg_tax_rate_location; use FS::part_event; use FS::part_event_condition; use FS::pkg_category; +use FS::Log; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -104,6 +105,9 @@ options of those methods are also available. sub bill_and_collect { my( $self, %options ) = @_; + my $log = FS::Log->new('bill_and_collect'); + $log->debug('start', object => $self, agentnum => $self->agentnum); + my $error; #$options{actual_time} not $options{time} because freeside-daily -d is for @@ -168,6 +172,7 @@ sub bill_and_collect { } } $job->update_statustext('100,finished') if $job; + $log->debug('finish', object => $self, agentnum => $self->agentnum); ''; diff --git a/FS/FS/cust_main/Import.pm b/FS/FS/cust_main/Import.pm index eadcc1a55..e5a4485f9 100644 --- a/FS/FS/cust_main/Import.pm +++ b/FS/FS/cust_main/Import.pm @@ -22,6 +22,8 @@ install_callback FS::UID sub { $conf = new FS::Conf; }; +my %is_location = map { $_ => 1 } FS::cust_main::Location->location_fields; + =head1 NAME FS::cust_main::Import - Batch customer importing @@ -316,13 +318,14 @@ sub batch_import { custbatch => $custbatch, agentnum => $agentnum, refnum => $refnum, - country => $conf->config('countrydefault') || 'US', payby => $payby, #default paydate => '12/2037', #default ); my $billtime = time; my %cust_pkg = ( pkgpart => $pkgpart ); my %svc_x = (); + my %bill_location = (); + my %ship_location = (); foreach my $field ( @fields ) { if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) { @@ -351,6 +354,14 @@ sub batch_import { $svc_x{$1} = shift @columns; + } elsif ( $is_location{$field} ) { + + $bill_location{$field} = shift @columns; + + } elsif ( $field =~ /^ship_(.*)$/ and $is_location{$1} ) { + + $ship_location{$1} = shift @columns; + } else { #refnum interception @@ -379,6 +390,16 @@ sub batch_import { my $value = shift @columns; $cust_main{$field} = $value if length($value); } + } # foreach my $field + # finished importing columns + + $bill_location{'country'} ||= $conf->config('countrydefault') || 'US'; + $cust_main{'bill_location'} = FS::cust_location->new(\%bill_location); + if ( grep $_, values(%ship_location) ) { + $ship_location{'country'} ||= $conf->config('countrydefault') || 'US'; + $cust_main{'ship_location'} = FS::cust_location->new(\%ship_location); + } else { + $cust_main{'ship_location'} = $cust_main{'bill_location'}; } if ( defined $cust_main{'payinfo'} && length $cust_main{'payinfo'} ) { diff --git a/FS/FS/cust_main/Packages.pm b/FS/FS/cust_main/Packages.pm index 11c13e5dd..395cce7e0 100644 --- a/FS/FS/cust_main/Packages.pm +++ b/FS/FS/cust_main/Packages.pm @@ -58,7 +58,7 @@ action completes (such as running the customer's credit card successfully). Optional subject for a ticket created and attached to this customer -=item ticket_subject +=item ticket_queue Optional queue name for ticket additions diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index 143f62ed3..87c1ca730 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -472,8 +472,11 @@ sub taxline { $_->taxnum($self->taxnum) foreach @new_exemptions; - if ( $cust_bill_pkg->billpkgnum ) { - die "tried to calculate tax exemptions on a previously billed line item\n"; + #if ( $cust_bill_pkg->billpkgnum ) { + + #no, need to do this to e.g. calculate tax credit amounts + #die "tried to calculate tax exemptions on a previously billed line item\n"; + # this is unnecessary # foreach my $cust_tax_exempt_pkg (@new_exemptions) { # my $error = $cust_tax_exempt_pkg->insert; @@ -482,7 +485,7 @@ sub taxline { # return "can't insert cust_tax_exempt_pkg: $error"; # } # } - } + #} # attach them to the line item push @{ $cust_bill_pkg->cust_tax_exempt_pkg }, @new_exemptions; diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 16adea3d7..22a7b2c03 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -2650,6 +2650,18 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } +=item balance + +Returns the balance for this specific package, when using +experimental package balance. + +=cut + +sub balance { + my $self = shift; + $self->cust_main->balance_pkgnum( $self->pkgnum ); +} + #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin =item cust_location @@ -2877,7 +2889,8 @@ sub transfer { } foreach my $cust_svc ($self->cust_svc) { - if($target{$cust_svc->svcpart} > 0) { + if($target{$cust_svc->svcpart} > 0 + or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option $target{$cust_svc->svcpart}--; my $new = new FS::cust_svc { $cust_svc->hash }; $new->pkgnum($dest_pkgnum); diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 52069316d..b608b2349 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -479,7 +479,7 @@ Returns a listref of html elements associated with this service's exports. sub export_links { my $self = shift; my $svc_x = $self->svc_x - or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum; + or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ]; $svc_x->export_links; } diff --git a/FS/FS/log.pm b/FS/FS/log.pm new file mode 100644 index 000000000..a4ad214d0 --- /dev/null +++ b/FS/FS/log.pm @@ -0,0 +1,354 @@ +package FS::log; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs dbdef ); +use FS::UID qw( dbh driver_name ); +use FS::log_context; + +=head1 NAME + +FS::log - Object methods for log records + +=head1 SYNOPSIS + + use FS::log; + + $record = new FS::log \%hash; + $record = new FS::log { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::log object represents a log entry. FS::log inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item lognum - primary key + +=item _date - Unix timestamp + +=item agentnum - L<FS::agent> to which the log pertains. If it involves a +specific customer, package, service, invoice, or other agent-specific object, +this will be set to that agentnum. + +=item tablename - table name to which the log pertains, if any. + +=item tablenum - foreign key to that table. + +=item level - log level: 'debug', 'info', 'notice', 'warning', 'error', +'critical', 'alert', 'emergency'. + +=item message - contents of the log entry + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new log entry. Use FS::Log instead of calling this directly, +please. + +=cut + +sub table { 'log'; } + +=item insert [ CONTEXT... ] + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +CONTEXT may be a list of context tags to attach to this record. + +=cut + +sub insert { + # not using process_o2m for this, because we don't have a web interface + my $self = shift; + my $error = $self->SUPER::insert; + return $error if $error; + foreach ( @_ ) { + my $context = FS::log_context->new({ + 'lognum' => $self->lognum, + 'context' => $_ + }); + $error = $context->insert; + return $error if $error; + } + ''; +} + +# the insert method can be inherited from FS::Record + +sub delete { die "Log entries can't be modified." }; + +sub replace { die "Log entries can't be modified." }; + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('lognum') + || $self->ut_number('_date') + || $self->ut_numbern('agentnum') + || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum') + || $self->ut_textn('tablename') + || $self->ut_numbern('tablenum') + || $self->ut_number('level') + || $self->ut_text('message') + ; + return $error if $error; + + if ( my $tablename = $self->tablename ) { + my $dbdef_table = dbdef->table($tablename) + or return "tablename '$tablename' does not exist"; + $error = $self->ut_foreign_key('tablenum', + $tablename, + $dbdef_table->primary_key); + return $error if $error; + } + + $self->SUPER::check; +} + +=item context + +Returns the context for this log entry, as an array, from least to most +specific. + +=cut + +sub context { + my $self = shift; + map { $_->context } qsearch({ + table => 'log_context', + hashref => { lognum => $self->lognum }, + order_by => 'ORDER BY logcontextnum ASC', + }); +} + +=back + +=head1 CLASS METHODS + +=over 4 + +=item search HASHREF + +Returns a qsearch hash expression to search for parameters specified in +HASHREF. Valid parameters are: + +=over 4 + +=item agentnum + +=item date - arrayref of start and end date + +=item level - either a specific level, or an arrayref of min and max level + +=item context - a context string that the log entry must have. This may +change in the future to allow searching for combinations of context strings. + +=item object - any database object, to find log entries related to it. + +=item tablename, tablenum - alternate way of specifying 'object'. + +=item custnum - a customer number, to find log entries related to the customer +or any of their subordinate objects (invoices, packages, etc.). + +=item message - a text string to search in messages. The search will be +a case-insensitive LIKE with % appended at both ends. + +=back + +=cut + +# used for custnum search: all tables with custnums +my @table_stubs; + +sub _setup_table_stubs { + foreach my $table ( + qw( + contact + cust_attachment + cust_bill + cust_credit + cust_location + cust_main + cust_main_exemption + cust_main_note + cust_msg + cust_pay + cust_pay_batch + cust_pay_pending + cust_pay_void + cust_pkg + cust_refund + cust_statement + cust_tag + cust_tax_adjustment + cust_tax_exempt + did_order_item + qual + queue ) ) + { + my $pkey = dbdef->table($table)->primary_key; + push @table_stubs, + "log.tablename = '$table' AND ". + "EXISTS(SELECT 1 FROM $table WHERE log.tablenum = $table.$pkey AND ". + "$table.custnum = "; # needs a closing ) + } + # plus this case + push @table_stubs, + "(log.tablename LIKE 'svc_%' OR log.tablename = 'cust_svc') AND ". + "EXISTS(SELECT 1 FROM cust_svc JOIN cust_pkg USING (svcnum) WHERE ". + "cust_pkg.custnum = "; # needs a closing ) +} + +sub search { + my ($class, $params) = @_; + my @where; + + ## + # parse agent + ## + + if ( $params->{'agentnum'} =~ /^(\d+)$/ ) { + push @where, + "log.agentnum = $1"; + } + + ## + # parse custnum + ## + + if ( $params->{'custnum'} =~ /^(\d+)$/ ) { + _setup_table_stubs() unless @table_stubs; + my $custnum = $1; + my @orwhere = map { "( $_ $custnum) )" } @table_stubs; + push @where, join(' OR ', @orwhere); + } + + ## + # parse level + ## + + if ( ref $params->{'level'} eq 'ARRAY' ) { + my ($min, $max) = @{ $params->{'level'} }; + if ( $min =~ /^\d+$/ ) { + push @where, "log.level >= $min"; + } + if ( $max =~ /^\d+$/ ) { + push @where, "log.level <= $max"; + } + } elsif ( $params->{'level'} =~ /^(\d+)$/ ) { + push @where, "log.level = $1"; + } + + ## + # parse date + ## + + if ( ref $params->{'date'} eq 'ARRAY' ) { + my ($beg, $end) = @{ $params->{'date'} }; + if ( $beg =~ /^\d+$/ ) { + push @where, "log._date >= $beg"; + } + if ( $end =~ /^\d+$/ ) { + push @where, "log._date <= $end"; + } + } + + ## + # parse object + ## + + if ( $params->{'object'} and $params->{'object'}->isa('FS::Record') ) { + my $table = $params->{'object'}->table; + my $pkey = dbdef->table($table)->primary_key; + my $tablenum = $params->{'object'}->get($pkey); + if ( $table and $tablenum ) { + push @where, "log.tablename = '$table'", "log.tablenum = $tablenum"; + } + } elsif ( $params->{'tablename'} =~ /^(\w+)$/ ) { + my $table = $1; + if ( $params->{'tablenum'} =~ /^(\d+)$/ ) { + push @where, "log.tablename = '$table'", "log.tablenum = $1"; + } + } + + ## + # parse message + ## + + if ( $params->{'message'} ) { # can be anything, really, so escape it + my $quoted_message = dbh->quote('%' . $params->{'message'} . '%'); + my $op = (driver_name eq 'Pg' ? 'ILIKE' : 'LIKE'); + push @where, "log.message $op $quoted_message"; + } + + ## + # parse context + ## + + if ( $params->{'context'} ) { + my $quoted = dbh->quote($params->{'context'}); + push @where, + "EXISTS(SELECT 1 FROM log_context WHERE log.lognum = log_context.lognum ". + "AND log_context.context = $quoted)"; + } + + # agent virtualization + my $access_user = $FS::CurrentUser::CurrentUser; + push @where, $access_user->agentnums_sql( + table => 'log', + viewall_right => 'Configuration', + null => 1, + ); + + # put it together + my $extra_sql = ''; + $extra_sql .= 'WHERE ' . join(' AND ', @where) if @where; + my $count_query = 'SELECT COUNT(*) FROM log '.$extra_sql; + my $sql_query = { + 'table' => 'log', + 'hashref' => {}, + 'select' => 'log.*', + 'extra_sql' => $extra_sql, + 'count_query' => $count_query, + 'order_by' => 'ORDER BY _date ASC', + #addl_from, not needed + }; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/log_context.pm b/FS/FS/log_context.pm new file mode 100644 index 000000000..372bdaa39 --- /dev/null +++ b/FS/FS/log_context.pm @@ -0,0 +1,145 @@ +package FS::log_context; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +my @contexts = ( qw( + test + bill_and_collect + Cron::bill + Cron::upload + spool_upload + daily + queue +) ); + +=head1 NAME + +FS::log_context - Object methods for log_context records + +=head1 SYNOPSIS + + use FS::log_context; + + $record = new FS::log_context \%hash; + $record = new FS::log_context { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::log_context object represents a context tag attached to a log entry +(L<FS::log>). FS::log_context inherits from FS::Record. The following +fields are currently supported: + +=over 4 + +=item logcontextnum - primary key + +=item lognum - lognum (L<FS::log> foreign key) + +=item context - context + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new context tag. To add the example to the database, see +L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'log_context'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('logcontextnum') + || $self->ut_number('lognum') + || $self->ut_enum('context', \@contexts) + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 CLASS METHODS + +=over 4 + +=item contexts + +Returns a list of all valid contexts. + +=cut + +sub contexts { @contexts } + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Log>, L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_event/Condition/pkg_dundate.pm b/FS/FS/part_event/Condition/pkg_dundate.pm index f25db2ae8..fefee2022 100644 --- a/FS/FS/part_event/Condition/pkg_dundate.pm +++ b/FS/FS/part_event/Condition/pkg_dundate.pm @@ -19,7 +19,7 @@ sub condition { #my $cust_main = $self->cust_main($cust_pkg); - $cust_pkg->dundate <= $opt{time}; + ( $cust_pkg->dundate || 0 ) <= $opt{time}; } diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index b0f708a66..5d650626e 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -615,6 +615,23 @@ sub weight { export_info()->{$self->exporttype}->{'weight'} || 0; } +=item info + +Returns a reference to (a copy of) the export's %info hash. + +=cut + +sub info { + my $self = shift; + $self->{_info} ||= { + %{ export_info()->{$self->exporttype} } + }; +} + +#default fallbacks... FS::part_export::DID_Common ? +sub get_dids_can_tollfree { 0; } +sub get_dids_npa_select { 1; } + =back =head1 SUBROUTINES diff --git a/FS/FS/part_export/acct_http.pm b/FS/FS/part_export/acct_http.pm index 23df7b37d..af358997e 100644 --- a/FS/FS/part_export/acct_http.pm +++ b/FS/FS/part_export/acct_http.pm @@ -41,6 +41,18 @@ tie %options, 'Tie::IxHash', "password \$new->_password", ), }, + 'suspend_data' => { + label => 'Suspend data', + type => 'textarea', + default => join("\n", + ), + }, + 'unsuspend_data' => { + label => 'Unsuspend data', + type => 'textarea', + default => join("\n", + ), + }, 'success_regexp' => { label => 'Success Regexp', default => '', diff --git a/FS/FS/part_export/acct_xmlrpc.pm b/FS/FS/part_export/acct_xmlrpc.pm index 4c896b422..a493f5206 100644 --- a/FS/FS/part_export/acct_xmlrpc.pm +++ b/FS/FS/part_export/acct_xmlrpc.pm @@ -48,6 +48,8 @@ The following variables are available for interpolation (prefixed with new_ or old_ for replace operations): <UL> <LI><code>$username</code> + <LI><code>$domain</code> + <LI><code>$email</code> - username@domain <LI><code>$_password</code> <LI><code>$crypt_password</code> - encrypted password <LI><code>$ldap_password</code> - Password in LDAP/RFC2307 format (for example, "{PLAIN}himom", "{CRYPT}94pAVyK/4oIBk" or "{MD5}5426824942db4253f87a1009fd5d2d4") @@ -196,8 +198,8 @@ sub _export_value { } else { return Frontier::RPC2::String->new( $svc_acct->$value() ); } - } elsif ( $value eq 'domain' ) { - return Frontier::RPC2::String->new( $svc_acct->domain ); + } elsif ( $value =~ /^(domain|email)$/ ) { + return Frontier::RPC2::String->new( $svc_acct->$value() ); } elsif ( $value eq 'crypt_password' ) { return Frontier::RPC2::String->new( $svc_acct->crypt_password( $self->option('crypt') ) ); } elsif ( $value eq 'ldap_password' ) { @@ -207,6 +209,7 @@ sub _export_value { #XXX } +#this is the "cust_main" email, not svc_acct->email # my $cust_pkg = $svc_acct->cust_svc->cust_pkg; # if ( $cust_pkg ) { # no strict 'vars'; diff --git a/FS/FS/part_export/broadband_http.pm b/FS/FS/part_export/broadband_http.pm index c1ed7fca6..5be8b6851 100644 --- a/FS/FS/part_export/broadband_http.pm +++ b/FS/FS/part_export/broadband_http.pm @@ -35,6 +35,18 @@ tie %options, 'Tie::IxHash', type => 'textarea', default => '', }, + 'suspend_data' => { + label => 'Suspend data', + type => 'textarea', + default => join("\n", + ), + }, + 'unsuspend_data' => { + label => 'Unsuspend data', + type => 'textarea', + default => join("\n", + ), + }, 'success_regexp' => { label => 'Success Regexp', default => '', diff --git a/FS/FS/part_export/broadband_snmp.pm b/FS/FS/part_export/broadband_snmp.pm index 44b4dbabb..9afca0872 100644 --- a/FS/FS/part_export/broadband_snmp.pm +++ b/FS/FS/part_export/broadband_snmp.pm @@ -3,7 +3,7 @@ package FS::part_export::broadband_snmp; use strict; use vars qw(%info $DEBUG); use base 'FS::part_export'; -use Net::SNMP qw(:asn1 :snmp); +use SNMP; use Tie::IxHash; $DEBUG = 0; @@ -11,21 +11,21 @@ $DEBUG = 0; my $me = '['.__PACKAGE__.']'; tie my %snmp_version, 'Tie::IxHash', - v1 => 'snmpv1', - v2c => 'snmpv2c', - # 3 => 'v3' not implemented + v1 => '1', + v2c => '2c', + # v3 unimplemented ; -tie my %snmp_type, 'Tie::IxHash', - i => INTEGER, - u => UNSIGNED32, - s => OCTET_STRING, - n => NULL, - o => OBJECT_IDENTIFIER, - t => TIMETICKS, - a => IPADDRESS, - # others not implemented yet -; +#tie my %snmp_type, 'Tie::IxHash', +# i => INTEGER, +# u => UNSIGNED32, +# s => OCTET_STRING, +# n => NULL, +# o => OBJECT_IDENTIFIER, +# t => TIMETICKS, +# a => IPADDRESS, +# # others not implemented yet +#; tie my %options, 'Tie::IxHash', 'version' => { label=>'SNMP version', @@ -33,14 +33,11 @@ tie my %options, 'Tie::IxHash', options => [ keys %snmp_version ], }, 'community' => { label=>'Community', default=>'public' }, - ( - map { $_.'_command', - { label => ucfirst($_) . ' commands', - type => 'textarea', - default => '', - } - } qw( insert delete replace suspend unsuspend ) - ), + + 'action' => { multiple=>1 }, + 'oid' => { multiple=>1 }, + 'value' => { multiple=>1 }, + 'ip_addr_change_to_new' => { label=>'Send IP address changes to new address', type=>'checkbox' @@ -51,28 +48,14 @@ tie my %options, 'Tie::IxHash', %info = ( 'svc' => 'svc_broadband', 'desc' => 'Send SNMP requests to the service IP address', + 'config_element' => '/edit/elements/part_export/broadband_snmp.html', 'options' => \%options, 'no_machine' => 1, 'weight' => 10, 'notes' => <<'END' Send one or more SNMP SET requests to the IP address registered to the service. -Enter one command per line. Each command is a target OID, data type flag, -and value, separated by spaces. -The data type flag is one of the following: -<font size="-1"><ul> -<li><i>i</i> = INTEGER</li> -<li><i>u</i> = UNSIGNED32</li> -<li><i>s</i> = OCTET-STRING (as ASCII)</li> -<li><i>a</i> = IPADDRESS</li> -<li><i>n</i> = NULL</li></ul> The value may interpolate fields from svc_broadband by prefixing the field name with <b>$</b>, or <b>$new_</b> and <b>$old_</b> for replace operations. -The value may contain whitespace; quotes are not necessary.<br> -<br> -For example, to set the SNMPv2-MIB "sysName.0" object to the string -"svc_broadband" followed by the service number, use the following -command:<br> -<pre>1.3.6.1.2.1.1.5.0 s svc_broadband$svcnum</pre><br> END ); @@ -105,19 +88,18 @@ sub export_command { my $self = shift; my ($action, $svc_new, $svc_old) = @_; - my $command_text = $self->option($action.'_command'); - return if !length($command_text); - - warn "$me parsing ${action}_command:\n" if $DEBUG; + my @a = split("\n", $self->option('action')); + my @o = split("\n", $self->option('oid')); + my @v = split("\n", $self->option('value')); my @commands; - foreach (split /\n/, $command_text) { - my ($oid, $type, $value) = split /\s/, $_, 3; - $oid =~ /^(\d+\.)*\d+$/ or die "invalid OID '$oid'\n"; - my $typenum = $snmp_type{$type} or die "unknown data type '$type'\n"; - $value = '' if !defined($value); # allow sending an empty string + warn "$me parsing $action commands:\n" if $DEBUG; + while (@a) { + my $oid = shift @o; + my $value = shift @v; + next unless shift(@a) eq $action; # ignore commands for other actions $value = $self->substitute($value, $svc_new, $svc_old); - warn "$me $oid $type $value\n" if $DEBUG; - push @commands, $oid, $typenum, $value; + warn "$me $oid :=$value\n" if $DEBUG; + push @commands, $oid, $value; } my $ip_addr = $svc_new->ip_addr; @@ -128,13 +110,13 @@ sub export_command { warn "$me opening session to $ip_addr\n" if $DEBUG; my %opt = ( - -hostname => $ip_addr, - -community => $self->option('community'), - -timeout => $self->option('timeout') || 20, + DestHost => $ip_addr, + Community => $self->option('community'), + Timeout => ($self->option('timeout') || 20) * 1000, ); my $version = $self->option('version'); - $opt{-version} = $snmp_version{$version} or die 'invalid version'; - $opt{-varbindlist} = \@commands; # just for now + $opt{Version} = $snmp_version{$version} or die 'invalid version'; + $opt{VarList} = \@commands; # for now $self->snmp_queue( $svc_new->svcnum, %opt ); } @@ -151,16 +133,22 @@ sub snmp_queue { sub snmp_request { my %opt = @_; - my $varbindlist = delete $opt{-varbindlist}; - my ($session, $error) = Net::SNMP->session(%opt); - die "Couldn't create SNMP session: $error" if !$session; + my $flatvarlist = delete $opt{VarList}; + my $session = SNMP::Session->new(%opt); warn "$me sending SET request\n" if $DEBUG; - my $result = $session->set_request( -varbindlist => $varbindlist ); - $error = $session->error(); - $session->close(); - if (!defined $result) { + my @varlist; + while (@$flatvarlist) { + my @this = splice(@$flatvarlist, 0, 2); + push @varlist, [ $this[0], 0, $this[1], undef ]; + # XXX new option to choose the IID (array index) of the object? + } + + $session->set(\@varlist); + my $error = $session->{ErrorStr}; + + if ( $session->{ErrorNum} ) { die "SNMP request failed: $error\n"; } } @@ -181,4 +169,46 @@ sub substitute { $value; } +sub _upgrade_exporttype { + eval 'use FS::Record qw(qsearch qsearchs)'; + # change from old style with numeric oid, data type flag, and value + # on consecutive lines + foreach my $export (qsearch('part_export', + { exporttype => 'broadband_snmp' } )) + { + # for the new options + my %new_options = ( + 'action' => [], + 'oid' => [], + 'value' => [], + ); + foreach my $action (qw(insert replace delete suspend unsuspend)) { + my $old_option = qsearchs('part_export_option', + { exportnum => $export->exportnum, + optionname => $action.'_command' } ); + next if !$old_option; + my $text = $old_option->optionvalue; + my @commands = split("\n", $text); + foreach (@commands) { + my ($oid, $type, $value) = split /\s/, $_, 3; + push @{$new_options{action}}, $action; + push @{$new_options{oid}}, $oid; + push @{$new_options{value}}, $value; + } + my $error = $old_option->delete; + warn "error migrating ${action}_command option: $error\n" if $error; + } + foreach (keys(%new_options)) { + my $new_option = FS::part_export_option->new({ + exportnum => $export->exportnum, + optionname => $_, + optionvalue => join("\n", @{ $new_options{$_} }) + }); + my $error = $new_option->insert; + warn "error inserting '$_' option: $error\n" if $error; + } + } #foreach $export + ''; +} + 1; diff --git a/FS/FS/part_export/fibernetics_did.pm b/FS/FS/part_export/fibernetics_did.pm new file mode 100644 index 000000000..fb0378550 --- /dev/null +++ b/FS/FS/part_export/fibernetics_did.pm @@ -0,0 +1,177 @@ +package FS::part_export::fibernetics_did; +use base qw( FS::part_export ); + +use strict; +use vars qw( %info $DEBUG ); +use Data::Dumper; +use URI::Escape; +#use Locale::SubCountry; +#use FS::Record qw(qsearch dbh); +use XML::Simple; +#use Net::HTTPS::Any qw( 0.10 https_get ); +use LWP::UserAgent; +use HTTP::Request::Common; + +$DEBUG = 0; + +tie my %options, 'Tie::IxHash', + 'country' => { 'label' => 'Country', 'default' => 'CA', size=>2, }, +; + +%info = ( + 'svc' => 'svc_phone', + 'desc' => 'Provision phone numbers to Fibernetics web services API', + 'options' => \%options, + 'notes' => '', +); + +sub rebless { shift; } + +sub get_dids_can_tollfree { 0; }; +sub get_dids_npa_select { 0; }; + +# i guess we could get em from the API, but since its returning states without +# availability, there's no advantage + # not really needed, we maintain our own list of provinces, but would + # help to hide the ones without availability (need to fix the selector too) +our @states = ( + 'Alberta', + 'British Columbia', + 'Ontario', + 'Quebec', + #'Saskatchewan', + #'The Territories', + #'PEI/Nova Scotia', + #'Manitoba', + #'Newfoundland', + #'New Brunswick', +); + +sub get_dids { + my $self = shift; + my %opt = ref($_[0]) ? %{$_[0]} : @_; + + if ( $opt{'tollfree'} ) { + warn 'Fibernetics DID provisioning does not yet support toll-free numbers'; + return []; + } + + my %query_hash = (); + + #ratecenter + state: return numbers (more structured names, npa selection) + #areacode + exchange: return numbers + #areacode: return city/ratecenter/whatever + #state: return areacodes + + #region + state: return numbers (arbitrary names, no npa selection) + #state: return regions + +# if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers +# +# $query_hash{'region'} = $opt{'exchange'}; +# +# } elsif ( $opt{'areacode'} ) { +# +# $query_hash{'npa'} = $opt{'areacode'}; + + #if ( $opt{'state'} && $opt{'region'} ) { #return numbers + if ( $opt{'region'} ) { #return numbers + + #$query_hash{'province'} = $country->full_name($opt{'state'}); + $query_hash{'region'} = $opt{'region'} + + } elsif ( $opt{'state'} ) { #return regions + + #my $country = new Locale::SubCountry( $self->option('country') ); + #$query_hash{'province'} = $country->full_name($opt{'state'}); + $query_hash{'province'} = $opt{'state'}; + $query_hash{'listregion'} = 1; + + } else { #nothing passed, return states (provinces) + + return \@states; + + } + + + my $url = 'http://'. $self->machine. '/porta/cgi-bin/porta_query.cgi'; + if ( keys %query_hash ) { + $url .= '?'. join('&', map "$_=". uri_escape($query_hash{$_}), + keys %query_hash + ); + } + warn $url if $DEBUG; + + #my( $page, $response, %reply_headers) = https_get( + # 'host' => $self->machine, + #); + + my $ua = LWP::UserAgent->new; + #my $response = $ua->$method( + # $url, \%data, + # 'Content-Type'=>'application/x-www-form-urlencoded' + #); + my $req = HTTP::Request::Common::GET( $url ); + my $response = $ua->request($req); + + die $response->error_as_HTML if $response->is_error; + + my $page = $response->content; + + my $data = XMLin( $page ); + + warn Dumper($data) if $DEBUG; + +# if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers +# +# [ map $_->{'number'}, @{ $data->{'item'} } ]; +# +# } elsif ( $opt{'areacode'} ) { +# +# [ map $_->{'region'}, @{ $data->{'item'} } ]; +# +# } elsif ( $opt{'state'} ) { #return areacodes +# +# [ map $_->{'npa'}, @{ $data->{'item'} } ]; + + #if ( $opt{'state'} && $opt{'region'} ) { #return numbers + if ( $opt{'region'} ) { #return numbers + + [ map { $_ =~ /^(\d?)(\d{3})(\d{3})(\d{4})$/ + #? ($1 ? "$1 " : ''). "$2 $3 $4" + ? "$2 $3 $4" + : $_; + } + sort { $a <=> $b } + map $_->{'phone'}, + @{ $data->{'item'} } + ]; + + } elsif ( $opt{'state'} ) { #return regions + + #[ map $_->{'region'}, @{ $data->{'item'} } ]; + my %regions = map { $_ => 1 } map $_->{'region'}, @{ $data->{'item'} }; + [ sort keys %regions ]; + + #} else { #nothing passed, return states (provinces) + # not really needed, we maintain our own list of provinces, but would + # help to hide the ones without availability (need to fix the selector too) + } + + +} + +#insert, delete, etc... handled with shellcommands + +sub _export_insert { + #my( $self, $svc_phone ) = (shift, shift); +} +sub _export_delete { + #my( $self, $svc_phone ) = (shift, shift); +} + +sub _export_replace { ''; } +sub _export_suspend { ''; } +sub _export_unsuspend { ''; } + +1; diff --git a/FS/FS/part_export/http.pm b/FS/FS/part_export/http.pm index c35c89f12..0d62409fc 100644 --- a/FS/FS/part_export/http.pm +++ b/FS/FS/part_export/http.pm @@ -33,6 +33,18 @@ tie %options, 'Tie::IxHash', default => join("\n", ), }, + 'suspend_data' => { + label => 'Suspend data', + type => 'textarea', + default => join("\n", + ), + }, + 'unsuspend_data' => { + label => 'Unsuspend data', + type => 'textarea', + default => join("\n", + ), + }, 'success_regexp' => { label => 'Success Regexp', default => '', @@ -64,6 +76,16 @@ sub _export_delete { $self->_export_command('delete', @_); } +sub _export_suspend { + my $self = shift; + $self->_export_command('suspend', @_); +} + +sub _export_unsuspend { + my $self = shift; + $self->_export_command('unsuspend', @_); +} + sub _export_command { my( $self, $action, $svc_x ) = ( shift, shift, shift ); diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 6760d09b7..58cc5be95 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -213,6 +213,7 @@ sub _export_replace { return $error; } } + $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } my @del = grep { !exists $new{$_} } keys %old; @@ -230,6 +231,7 @@ sub _export_replace { return $error; } } + $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } } @@ -348,7 +350,7 @@ sub _export_delete { sub sqlradius_queue { my( $self, $svcnum, $method ) = (shift, shift, shift); - my %args = @_; + #my %args = @_; my $queue = new FS::queue { 'svcnum' => $svcnum, 'job' => "FS::part_export::sqlradius::sqlradius_$method", @@ -561,6 +563,7 @@ sub sqlreplace_usergroups { my $error = $err_or_queue->depend_insert( $jobnum ); return $error if $error; } + $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } if ( @newgroups ) { diff --git a/FS/FS/part_export/vitelity.pm b/FS/FS/part_export/vitelity.pm index 350a5ad48..3c0534fc1 100644 --- a/FS/FS/part_export/vitelity.pm +++ b/FS/FS/part_export/vitelity.pm @@ -39,6 +39,8 @@ END sub rebless { shift; } +sub get_dids_can_tollfree { 1; }; + sub get_dids { my $self = shift; my %opt = ref($_[0]) ? %{$_[0]} : @_; diff --git a/FS/FS/pay_batch/eft_canada.pm b/FS/FS/pay_batch/eft_canada.pm index ea9d58402..220fecb3d 100644 --- a/FS/FS/pay_batch/eft_canada.pm +++ b/FS/FS/pay_batch/eft_canada.pm @@ -112,7 +112,7 @@ my %holiday = ( } push @fields, sprintf('%05s', $branch), sprintf('%03s', $bankno), - sprintf('%012s', $account), + $account, sprintf('%.02f', $cust_pay_batch->amount); # DB = debit push @fields, 'DB', $trans_code, $process_date; diff --git a/FS/FS/svc_IP_Mixin.pm b/FS/FS/svc_IP_Mixin.pm index 7026205a5..7eda7e02c 100644 --- a/FS/FS/svc_IP_Mixin.pm +++ b/FS/FS/svc_IP_Mixin.pm @@ -93,7 +93,7 @@ sub _used_addresses { # in use, yes? my %hash = ( $ip_field => { op => '!=', value => '' } ); - $hash{'blocknum'} = $block->blocknum if $block; + #$hash{'blocknum'} = $block->blocknum if $block; $hash{'svcnum'} = { op => '!=', value => $exclude->svcnum } if ref $exclude; map { $_->NetAddr->addr } qsearch($class->table, \%hash); } diff --git a/FS/FS/svc_Radius_Mixin.pm b/FS/FS/svc_Radius_Mixin.pm index ac97eab58..544c7e958 100644 --- a/FS/FS/svc_Radius_Mixin.pm +++ b/FS/FS/svc_Radius_Mixin.pm @@ -68,7 +68,8 @@ sub replace { $old->usergroup; # make sure this is cached for exports - my $error = $new->process_m2m( + my $error = $new->check # make sure fixed fields are set before process_m2m + || $new->process_m2m( 'link_table' => 'radius_usergroup', 'target_table' => 'radius_group', 'params' => $new->usergroup, diff --git a/FS/MANIFEST b/FS/MANIFEST index 9c444be58..f954fe8dd 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -675,3 +675,7 @@ FS/svc_export_machine.pm t/svc_export_machine.t FS/GeocodeCache.pm t/GeocodeCache.t +FS/log.pm +t/log.t +FS/log_context.pm +t/log_context.t diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 8e8ae4ff9..ac93aaf2f 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -4,6 +4,7 @@ use strict; use Getopt::Std; use FS::UID qw(adminsuidsetup); use FS::Conf; +use FS::Log; &untaint_argv; #what it sounds like (eww) use vars qw(%opt); @@ -11,6 +12,8 @@ getopts("p:a:d:vl:sy:nmrkg:o", \%opt); my $user = shift or die &usage; adminsuidsetup $user; +my $log = FS::Log->new('daily'); +$log->info('start'); #you can skip this by not having a NetworkMonitoringSystem configured use FS::Cron::nms_report qw(nms_report); @@ -74,6 +77,8 @@ unlink <${deldir}.CGItemp*>; use FS::Cron::backup qw(backup); backup(); +$log->info('finish'); + ### # subroutines ### @@ -138,7 +143,7 @@ the bill and collect methods of a cust_main object. See L<FS::cust_main>. -l: debugging level - -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing. + -m: Multi-process mode uses the job queue for multi-process and/or multi-machine billing. -r: Multi-process mode dry run option diff --git a/FS/bin/freeside-ipifony-download b/FS/bin/freeside-ipifony-download new file mode 100644 index 000000000..e893326e2 --- /dev/null +++ b/FS/bin/freeside-ipifony-download @@ -0,0 +1,240 @@ +#!/usr/bin/perl + +use strict; +use Getopt::Std; +use Date::Format qw(time2str); +use File::Temp qw(tempdir); +use Net::SFTP::Foreign; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::cust_main; +use FS::Conf; +use Text::CSV; + +my %opt; +getopts('va:P:C:', \%opt); + +#$Net::SFTP::Foreign::debug = -1; +sub HELP_MESSAGE { ' + Usage: + freeside-ipifony-download + [ -v ] + [ -a archivedir ] + [ -P port ] + [ -C category ] + freesideuser sftpuser@hostname[:path] +' } + +my @fields = ( + 'custnum', + 'date_desc', + 'quantity', + 'amount', + 'classname', +); + +my $user = shift or die &HELP_MESSAGE; +adminsuidsetup $user; + +# for statistics +my $num_charges = 0; +my $num_errors = 0; +my $sum_charges = 0; +# cache classnums +my %classnum_of; + +if ( $opt{a} ) { + die "no such directory: $opt{a}\n" + unless -d $opt{a}; + die "archive directory $opt{a} is not writable by the freeside user\n" + unless -w $opt{a}; +} + +my $categorynum = ''; +if ( $opt{C} ) { + # find this category (don't auto-create it, it should exist already) + my $category = qsearchs('pkg_category', { categoryname => $opt{C} }); + if (!defined($category)) { + die "Package category '$opt{C}' does not exist.\n"; + } + $categorynum = $category->categorynum; +} + +#my $tmpdir = File::Temp->newdir(); +my $tmpdir = tempdir( CLEANUP => 1 ); #DIR=>somewhere? + +my $host = shift + or die &HELP_MESSAGE; +my ($sftpuser, $path); +$host =~ s/^(.+)\@//; +$sftpuser = $1 || $ENV{USER}; +$host =~ s/:(.*)//; +$path = $1; + +my $port = 22; +if ( $opt{P} =~ /^(\d+)$/ ) { + $port = $1; +} + +# for now assume SFTP download as the only method +print STDERR "Connecting to $sftpuser\@$host...\n" if $opt{v}; + +my $sftp = Net::SFTP::Foreign->new( + host => $host, + user => $sftpuser, + port => $port, + # for now we don't support passwords. use authorized_keys. + timeout => 30, + more => ($opt{v} ? '-v' : ''), +); +die "failed to connect to '$sftpuser\@$host'\n(".$sftp->error.")\n" + if $sftp->error; + +$sftp->setcwd($path) if $path; + +my $files = $sftp->ls('.', wanted => qr/\.csv$/, names_only => 1); +if (!@$files) { + print STDERR "No charge files found.\n" if $opt{v}; + exit(-1); +} +FILE: foreach my $filename (@$files) { + print STDERR "Retrieving $filename\n" if $opt{v}; + $sftp->get("$filename", "$tmpdir/$filename"); + if($sftp->error) { + warn "failed to download $filename\n"; + next FILE; + } + + # make sure server archive dir exists + if ( !$sftp->stat('Archive') ) { + print STDERR "Creating $path/Archive\n" if $opt{v}; + $sftp->mkdir('Archive'); + if($sftp->error) { + # something is seriously wrong + die "failed to create archive directory on server:\n".$sftp->error."\n"; + } + } + #move to server archive dir + $sftp->rename("$filename", "Archive/$filename"); + if($sftp->error) { + warn "failed to archive $filename on server:\n".$sftp->error."\n"; + } # process it anyway, I guess/ + + #copy to local archive dir + if ( $opt{a} ) { + print STDERR "Copying $tmpdir/$filename to archive dir $opt{a}\n" + if $opt{v}; + copy("$tmpdir/$filename", $opt{a}); + warn "failed to copy $tmpdir/$filename to $opt{a}: $!" if $!; + } + + open my $fh, "<$tmpdir/$filename"; + my $header = <$fh>; + if ($header !~ /^cust_id/) { + warn "warning: $filename has incorrect header row:\n$header\n"; + # but try anyway + } + my $csv = Text::CSV->new; # orthodox CSV + my %hash; + while (my $line = <$fh>) { + $csv->parse($line) or do { + warn "can't parse $filename: ".$csv->error_input."\n"; + next FILE; + }; + @hash{@fields} = $csv->fields(); + my $cust_main = FS::cust_main->by_key($hash{custnum}); + if (!$cust_main) { + warn "customer #$hash{custnum} not found\n"; + next; + } + print STDERR "Found customer #$hash{custnum}: ".$cust_main->name."\n" + if $opt{v}; + + # construct arguments for $cust_main->charge + my %opt = ( + amount => $hash{amount}, + quantity => $hash{quantity}, + start_date => $cust_main->next_bill_date, + pkg => $hash{date_desc}, + ); + if (my $classname = $hash{classname}) { + if (!exists($classnum_of{$classname}) ) { + # then look it up + my $pkg_class = qsearchs('pkg_class', { + classname => $classname, + categorynum => $categorynum, + }); + if (!defined($pkg_class)) { + # then create it + $pkg_class = FS::pkg_class->new({ + classname => $classname, + categorynum => $categorynum, + }); + my $error = $pkg_class->insert; + die "Error creating package class for product code '$classname':\n". + "$error\n" + if $error; + } + + $classnum_of{$classname} = $pkg_class->classnum; + } + $opt{classnum} = $classnum_of{$classname}; + } + # XXX what's the tax status of these charges? + print STDERR " Charging $hash{amount}\n" + if $opt{v}; + my $error = $cust_main->charge(\%opt); + if ($error) { + warn "Error creating charge: $error" if $error; + $num_errors++; + } else { + $num_charges++; + $sum_charges += $hash{amount}; + } + } #while $line + close $fh; +} #FILE + +if ($opt{v}) { + print STDERR " +Finished! + Processed files: @$files + Created charges: $num_charges + Sum of charges: \$".sprintf('%0.2f', $sum_charges)." + Errors: $num_errors +"; +} + +=head1 NAME + +freeside-eftca-download - Retrieve payment batch responses from EFT Canada. + +=head1 SYNOPSIS + + freeside-eftca-download [ -v ] [ -a archivedir ] user + +=head1 DESCRIPTION + +Command line tool to download returned payment reports from the EFT Canada +gateway and void the returned payments. Uses the login and password from +'batchconfig-eft_canada'. + +-v: Be verbose. + +-a directory: Archive response files in the provided directory. + +user: freeside username + +=head1 BUGS + +You need to manually SFTP to ftp.eftcanada.com from the freeside account +and accept their key before running this script. + +=head1 SEE ALSO + +L<FS::pay_batch> + +=cut + +1; + diff --git a/FS/bin/freeside-monthly b/FS/bin/freeside-monthly index 0d6ea14a2..69502a01d 100755 --- a/FS/bin/freeside-monthly +++ b/FS/bin/freeside-monthly @@ -7,7 +7,7 @@ use FS::UID qw(adminsuidsetup); &untaint_argv; #what it sounds like (eww) #use vars qw($opt_d $opt_v $opt_p $opt_a $opt_s $opt_y); use vars qw(%opt); -getopts("p:a:d:vsy:", \%opt); +getopts("p:a:d:vsy:m", \%opt); my $user = shift or die &usage; adminsuidsetup $user; @@ -72,6 +72,8 @@ the bill and collect methods of a cust_main object. See L<FS::cust_main>. -v: enable debugging + -m: Experimental multi-process mode (delay upload jobs until billing jobs complete) + user: From the mapsecrets file - see config.html from the base documentation custnum: if one or more customer numbers are specified, only bills those diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 756b699d4..2fd80255e 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -11,6 +11,7 @@ use FS::Conf; use FS::Record qw(qsearch); use FS::queue; use FS::queue_depend; +use FS::Log; # no autoloading for non-FS classes... use Net::SSH 0.07; @@ -45,6 +46,7 @@ while ( $@ ) { } } +my $log = FS::Log->new('queue'); logfile( "%%%FREESIDE_LOG%%%/queuelog.". $FS::UID::datasrc ); warn "completing daemonization (detaching))\n" if $DEBUG; @@ -135,6 +137,8 @@ while (1) { foreach my $job ( @jobs ) { + $log->debug('locking queue job', object => $job); + my %hash = $job->hash; $hash{'status'} = 'locked'; my $ljob = new FS::queue ( \%hash ); @@ -186,7 +190,7 @@ while (1) { dbh->{'private_profile'} = {} if UNIVERSAL::can(dbh, 'sprintProfile'); #auto-use classes... - if ( $ljob->job =~ /(FS::(part_export|cust_main|cust_pkg)::\w+)::/ + if ( $ljob->job =~ /(FS::(part_export|cust_main|cust_pkg|Cron)::\w+)::/ || $ljob->job =~ /(FS::\w+)::/ ) { @@ -205,6 +209,8 @@ while (1) { } my $eval = "&". $ljob->job. '(@args);'; + # don't put @args in the log, may expose passwords + $log->info('starting job ('.$ljob->job.')'); warn 'running "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG; eval $eval; #throw away return value? suppose so if ( $@ ) { diff --git a/FS/t/log.t b/FS/t/log.t new file mode 100644 index 000000000..42c604b88 --- /dev/null +++ b/FS/t/log.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::log; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/log_context.t b/FS/t/log_context.t new file mode 100644 index 000000000..57c3b340b --- /dev/null +++ b/FS/t/log_context.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::log_context; +$loaded=1; +print "ok 1\n"; |