diff options
Diffstat (limited to 'FS')
45 files changed, 1478 insertions, 685 deletions
diff --git a/FS/FS/API.pm b/FS/FS/API.pm new file mode 100644 index 000000000..36587da59 --- /dev/null +++ b/FS/FS/API.pm @@ -0,0 +1,374 @@ +package FS::API; + +use FS::Conf; +use FS::Record qw( qsearch qsearchs ); +use FS::cust_main; +use FS::cust_location; +use FS::cust_pay; +use FS::cust_credit; +use FS::cust_refund; + +=head1 NAME + +FS::API - Freeside backend API + +=head1 SYNOPSIS + + use FS::API; + +=head1 DESCRIPTION + +This module implements a backend API for advanced back-office integration. + +In contrast to the self-service API, which authenticates an end-user and offers +functionality to that end user, the backend API performs a simple shared-secret +authentication and offers full, administrator functionality, enabling +integration with other back-office systems. + +If accessing this API remotely with XML-RPC or JSON-RPC, be careful to block +the port by default, only allow access from back-office servers with the same +security precations as the Freeside server, and encrypt the communication +channel (for exampple, with an SSH tunnel or VPN) rather than accessing it +in plaintext. + +=head1 METHODS + +=over 4 + +=item insert_payment + +Example: + + my $result = FS::API->insert_payment( + 'secret' => 'sharingiscaring', + 'custnum' => 181318, + 'payby' => 'CASH', + 'paid' => '54.32', + + #optional + '_date' => 1397977200, #UNIX timestamp + ); + + if ( $result->{'error'} ) { + die $result->{'error'}; + } else { + #payment was inserted + print "paynum ". $result->{'paynum'}; + } + +=cut + +#enter cash payment +sub insert_payment { + my($class, %opt) = @_; + my $conf = new FS::Conf; + return { 'error' => 'Incorrect shared secret' } + unless $opt{secret} eq $conf->config('api_shared_secret'); + + #less "raw" than this? we are the backoffice API, and aren't worried + # about version migration ala cust_main/cust_location here + my $cust_pay = new FS::cust_pay { %opt }; + my $error = $cust_pay->insert( 'manual'=>1 ); + return { 'error' => $error, + 'paynum' => $cust_pay->paynum, + }; +} + +# pass the phone number ( from svc_phone ) +sub insert_payment_phonenum { + my($class, %opt) = @_; + my $conf = new FS::Conf; + return { 'error' => 'Incorrect shared secret' } + unless $opt{secret} eq $conf->config('api_shared_secret'); + + $class->_by_phonenum('insert_payment', %opt); + +} + +sub _by_phonenum { + my($class, $method, %opt) = @_; + my $conf = new FS::Conf; + return { 'error' => 'Incorrect shared secret' } + unless $opt{secret} eq $conf->config('api_shared_secret'); + + my $phonenum = delete $opt{'phonenum'}; + + my $svc_phone = qsearchs('svc_phone', { 'phonenum' => $phonenum } ) + or return { 'error' => 'Unknown phonenum' }; + + my $cust_pkg = $svc_phone->cust_svc->cust_pkg + or return { 'error' => 'Unlinked phonenum' }; + + $opt{'custnum'} = $cust_pkg->custnum; + + $class->$method(%opt); + +} + +=item insert_credit + +Example: + + my $result = FS::API->insert_credit( + 'secret' => 'sharingiscaring', + 'custnum' => 181318, + 'amount' => '54.32', + + #optional + '_date' => 1397977200, #UNIX timestamp + ); + + if ( $result->{'error'} ) { + die $result->{'error'}; + } else { + #credit was inserted + print "crednum ". $result->{'crednum'}; + } + +=cut + +#Enter credit +sub insert_credit { + my($class, %opt) = @_; + my $conf = new FS::Conf; + return { 'error' => 'Incorrect shared secret' } + unless $opt{secret} eq $conf->config('api_shared_secret'); + + $opt{'reasonnum'} ||= $conf->config('api_credit_reason'); + + #less "raw" than this? we are the backoffice API, and aren't worried + # about version migration ala cust_main/cust_location here + my $cust_credit = new FS::cust_credit { %opt }; + my $error = $cust_credit->insert; + return { 'error' => $error, + 'crednum' => $cust_credit->crednum, + }; +} + +# pass the phone number ( from svc_phone ) +sub insert_credit_phonenum { + my($class, %opt) = @_; + my $conf = new FS::Conf; + return { 'error' => 'Incorrect shared secret' } + unless $opt{secret} eq $conf->config('api_shared_secret'); + + $class->_by_phonenum('insert_credit', %opt); + +} + +=item insert_refund + +Example: + + my $result = FS::API->insert_refund( + 'secret' => 'sharingiscaring', + 'custnum' => 181318, + 'payby' => 'CASH', + 'refund' => '54.32', + + #optional + '_date' => 1397977200, #UNIX timestamp + ); + + if ( $result->{'error'} ) { + die $result->{'error'}; + } else { + #refund was inserted + print "refundnum ". $result->{'crednum'}; + } + +=cut + +#Enter cash refund. +sub insert_refund { + my($class, %opt) = @_; + my $conf = new FS::Conf; + return { 'error' => 'Incorrect shared secret' } + unless $opt{secret} eq $conf->config('api_shared_secret'); + + # when github pull request #24 is merged, + # will have to change over to default reasonnum like credit + # but until then, this will do + $opt{'reason'} ||= 'API refund'; + + #less "raw" than this? we are the backoffice API, and aren't worried + # about version migration ala cust_main/cust_location here + my $cust_refund = new FS::cust_refund { %opt }; + my $error = $cust_refund->insert; + return { 'error' => $error, + 'refundnum' => $cust_refund->refundnum, + }; +} + +# pass the phone number ( from svc_phone ) +sub insert_refund_phonenum { + my($class, %opt) = @_; + my $conf = new FS::Conf; + return { 'error' => 'Incorrect shared secret' } + unless $opt{secret} eq $conf->config('api_shared_secret'); + + $class->_by_phonenum('insert_refund', %opt); + +} + +#--- + +# "2 way syncing" ? start with non-sync pulling info here, then if necessary +# figure out how to trigger something when those things change + +# long-term: package changes? + +=item new_customer + +=cut + +#certainly false laziness w/ClientAPI::Signup new_customer/new_customer_minimal +# but approaching this from a clean start / back-office perspective +# i.e. no package/service, no immediate credit card run, etc. + +sub new_customer { + my( $class, %opt ) = @_; + my $conf = new FS::Conf; + return { 'error' => 'Incorrect shared secret' } + unless $opt{secret} eq $conf->config('api_shared_secret'); + + #default agentnum like signup_server-default_agentnum? + + #same for refnum like signup_server-default_refnum + + my $cust_main = new FS::cust_main ( { + 'agentnum' => $agentnum, + 'refnum' => $opt{refnum} + || $conf->config('signup_server-default_refnum'), + 'payby' => 'BILL', + + map { $_ => $opt{$_} } qw( + agentnum refnum agent_custid referral_custnum + last first company + daytime night fax mobile + payby payinfo paydate paycvv payname + ), + + } ); + + my @invoicing_list = $opt{'invoicing_list'} + ? split( /\s*\,\s*/, $opt{'invoicing_list'} ) + : (); + push @invoicing_list, 'POST' if $opt{'postal_invoicing'}; + + my ($bill_hash, $ship_hash); + foreach my $f (FS::cust_main->location_fields) { + # avoid having to change this in front-end code + $bill_hash->{$f} = $opt{"bill_$f"} || $opt{$f}; + $ship_hash->{$f} = $opt{"ship_$f"}; + } + + my $bill_location = FS::cust_location->new($bill_hash); + my $ship_location; + # we don't have an equivalent of the "same" checkbox in selfservice^Wthis API + # so is there a ship address, and if so, is it different from the billing + # address? + if ( length($ship_hash->{address1}) > 0 and + grep { $bill_hash->{$_} ne $ship_hash->{$_} } keys(%$ship_hash) + ) { + + $ship_location = FS::cust_location->new( $ship_hash ); + + } else { + $ship_location = $bill_location; + } + + $cust_main->set('bill_location' => $bill_location); + $cust_main->set('ship_location' => $ship_location); + + $error = $cust_main->insert( {}, \@invoicing_list ); + return { 'error' => $error } if $error; + + return { 'error' => '', + 'custnum' => $cust_main->custnum, + }; + +} + +=item customer_info + +=cut + +#some false laziness w/ClientAPI::Myaccount customer_info/customer_info_short + +use vars qw( @cust_main_editable_fields @location_editable_fields ); +@cust_main_editable_fields = qw( + first last company daytime night fax mobile +); +# locale +# payby payinfo payname paystart_month paystart_year payissue payip +# ss paytype paystate stateid stateid_state +@location_editable_fields = qw( + address1 address2 city county state zip country +); + +sub customer_info { + my( $class, %opt ) = @_; + my $conf = new FS::Conf; + return { 'error' => 'Incorrect shared secret' } + unless $opt{secret} eq $conf->config('api_shared_secret'); + + my $cust_main = qsearchs('cust_main', { 'custnum' => $opt{custnum} }) + or return { 'error' => 'Unknown custnum' }; + + my %return = ( + 'error' => '', + 'display_custnum' => $cust_main->display_custnum, + 'name' => $cust_main->first. ' '. $cust_main->get('last'), + 'balance' => $cust_main->balance, + 'status' => $cust_main->status, + 'statuscolor' => $cust_main->statuscolor, + ); + + $return{$_} = $cust_main->get($_) + foreach @cust_main_editable_fields; + + for (@location_editable_fields) { + $return{$_} = $cust_main->bill_location->get($_) + if $cust_main->bill_locationnum; + $return{'ship_'.$_} = $cust_main->ship_location->get($_) + if $cust_main->ship_locationnum; + } + + my @invoicing_list = $cust_main->invoicing_list; + $return{'invoicing_list'} = + join(', ', grep { $_ !~ /^(POST|FAX)$/ } @invoicing_list ); + $return{'postal_invoicing'} = + 0 < ( grep { $_ eq 'POST' } @invoicing_list ); + + #generally, the more useful data from the cust_main record the better. + # well, tell me what you want + + return \%return; + +} + +#I also monitor for changes to the additional locations that are applied to +# packages, and would like for those to be exportable as well. basically the +# location data passed with the custnum. +sub location_info { + my( $class, %opt ) = @_; + my $conf = new FS::Conf; + return { 'error' => 'Incorrect shared secret' } + unless $opt{secret} eq $conf->config('api_shared_secret'); + + my @cust_location = qsearch('cust_location', { 'custnum' => $opt{custnum} }); + + my %return = ( + 'error' => '', + 'locations' => [ map $_->hashref, @cust_location ], + ); + + return \%return; +} + +#Advertising sources? + +=back + +1; diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 862cceb2a..4f4121900 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -555,8 +555,8 @@ sub customer_info_short { 1, ##nobalance ); -warn $return{first} = $cust_main->first; -warn $return{'last'} = $cust_main->get('last'); + $return{first} = $cust_main->first; + $return{'last'} = $cust_main->get('last'); $return{name} = $cust_main->first. ' '. $cust_main->get('last'); $return{payby} = $cust_main->payby; diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm index 29ec23972..5407a8fa6 100644 --- a/FS/FS/ClientAPI/Signup.pm +++ b/FS/FS/ClientAPI/Signup.pm @@ -532,7 +532,7 @@ sub new_customer { || $conf->config('signup_server-default_refnum'), ( map { $_ => $template_cust->$_ } qw( - last first company daytime night fax + last first company daytime night fax mobile ) ), @@ -563,7 +563,8 @@ sub new_customer { map { $_ => $packet->{$_} } qw( last first ss company - daytime night fax stateid stateid_state + daytime night fax mobile + stateid stateid_state payby payinfo paycvv paydate payname paystate paytype paystart_month paystart_year payissue @@ -930,7 +931,7 @@ sub new_customer_minimal { map { $_ => $packet->{$_} } qw( last first ss company - daytime night fax + daytime night fax mobile ), } ); diff --git a/FS/FS/ClientAPI_XMLRPC.pm b/FS/FS/ClientAPI_XMLRPC.pm index 6ebdcec4d..62f61d6e5 100644 --- a/FS/FS/ClientAPI_XMLRPC.pm +++ b/FS/FS/ClientAPI_XMLRPC.pm @@ -30,7 +30,7 @@ L<FS::SelfService::XMLRPC>, L<FS::SelfService> use strict; use vars qw($DEBUG $AUTOLOAD); -use XMLRPC::Lite; # for XMLRPC::Data +use FS::XMLRPC_Lite; #XMLRPC::Lite, for XMLRPC::Data use FS::ClientAPI; $DEBUG = 0; @@ -188,17 +188,4 @@ sub ss2clientapi { }; } - -#XXX submit patch to SOAP::Lite - -use XMLRPC::Transport::HTTP; - -package XMLRPC::Transport::HTTP::Server; - -@XMLRPC::Transport::HTTP::Server::ISA = qw(SOAP::Transport::HTTP::Server); - -sub initialize; *initialize = \&XMLRPC::Server::initialize; -sub make_fault; *make_fault = \&XMLRPC::Transport::HTTP::CGI::make_fault; -sub make_response; *make_response = \&XMLRPC::Transport::HTTP::CGI::make_response; - 1; diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 48b39c5b2..34254c6d6 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -2920,6 +2920,7 @@ and customer address. Include units.', 'section' => 'self-service', 'description' => 'Suspend reason when customers suspend their own packages. Set to nothing to disallow self-suspension.', 'type' => 'select-sub', + #false laziness w/api_credit_reason 'options_sub' => sub { require FS::Record; require FS::reason; my $type = qsearchs('reason_type', @@ -5606,6 +5607,52 @@ and customer address. Include units.', 'type' => 'text', }, + { + 'key' => 'api_shared_secret', + 'section' => 'API', + 'description' => 'Shared secret for back-office API authentication', + 'type' => 'text', + }, + + { + 'key' => 'xmlrpc_api', + 'section' => 'API', + 'description' => 'Enable the back-office API XML-RPC server (on port 8008).', + 'type' => 'checkbox', + }, + +# { +# 'key' => 'jsonrpc_api', +# 'section' => 'API', +# 'description' => 'Enable the back-office API JSON-RPC server (on port 8081).', +# 'type' => 'checkbox', +# }, + + { + 'key' => 'api_credit_reason', + 'section' => 'API', + 'description' => 'Default reason for back-office API credits', + 'type' => 'select-sub', + #false laziness w/api_credit_reason + 'options_sub' => sub { require FS::Record; + require FS::reason; + my $type = qsearchs('reason_type', + { class => 'R' }) + or return (); + map { $_->reasonnum => $_->reason } + FS::Record::qsearch('reason', + { reason_type => $type->typenum } + ); + }, + 'option_sub' => sub { require FS::Record; + require FS::reason; + my $reason = FS::Record::qsearchs( + 'reason', { 'reasonnum' => shift } + ); + $reason ? $reason->reason : ''; + }, + }, + { key => "apacheroot", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "apachemachine", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "apachemachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, diff --git a/FS/FS/Daemon/Preforking.pm b/FS/FS/Daemon/Preforking.pm new file mode 100644 index 000000000..98b4fa68c --- /dev/null +++ b/FS/FS/Daemon/Preforking.pm @@ -0,0 +1,358 @@ +package FS::Daemon::Preforking; +use base 'Exporter'; + +=head1 NAME + +FS::Daemon::Preforking - A preforking web server + +=head1 SYNOPSIS + + use FS::Daemon::Preforking qw( freeside_init1 freeside_init2 daemon_run ); + + my $me = 'mydaemon'; #keep unique among fs daemons, for logfiles etc. + + freeside_init1($me); #daemonize, drop root and connect to freeside + + #do setup tasks which should throw an error to the shell starting the daemon + + freeside_init2($me); #move logging to logfile and disassociate from terminal + + #do setup tasks which will warn/error to the log file, such as declining to + # run if our config is not in place + + daemon_run( + 'port' => 5454, #keep unique among fs daemons + 'handle_request' => \&handle_request, + ); + + sub handle_request { + my $request = shift; #HTTP::Request object + + #... do your thing + + return $response; #HTTP::Response object + + } + +=head1 AUTHOR + +Based on L<http://www.perlmonks.org/?node_id=582781> by Justin Hawkins + +and L<http://poe.perl.org/?POE_Cookbook/Web_Server_With_Forking> + +=cut + +use warnings; +use strict; + +use constant DEBUG => 0; # Enable much runtime information. +use constant MAX_PROCESSES => 10; # Total server process count. +#use constant TESTING_CHURN => 0; # Randomly test process respawning. + +use vars qw( @EXPORT_OK $FREESIDE_LOG $SERVER_PORT $user $handle_request ); +@EXPORT_OK = qw( freeside_init1 freeside_init2 daemon_run ); +$FREESIDE_LOG = '%%%FREESIDE_LOG%%%'; + +use POE 1.2; # Base features. +use POE::Filter::HTTPD; # For serving HTTP content. +use POE::Wheel::ReadWrite; # For socket I/O. +use POE::Wheel::SocketFactory; # For serving socket connections. + +use FS::Daemon qw( daemonize1 drop_root logfile daemonize2 ); +use FS::UID qw( adminsuidsetup forksuidsetup dbh ); + +#use FS::TicketSystem; + +sub freeside_init1 { + my $name = shift; + + $user = shift @ARGV or die &usage($name); + + $FS::Daemon::NOSIG = 1; + $FS::Daemon::PID_NEWSTYLE = 1; + daemonize1($name); + + POE::Kernel->has_forked(); #daemonize forks... + + drop_root(); + + adminsuidsetup($user); +} + +sub freeside_init2 { + my $name = shift; + + logfile("$FREESIDE_LOG/$name.log"); + + daemonize2(); + +} + +sub daemon_run { + my %opt = @_; + $SERVER_PORT = $opt{port}; + $handle_request = $opt{handle_request}; + + #parent doesn't need to hold a DB connection open + dbh->disconnect; + undef $FS::UID::dbh; + + server_spawn(MAX_PROCESSES); + POE::Kernel->run(); + #exit; + +} + +### Spawn the main server. This will run as the parent process. + +sub server_spawn { + my ($max_processes) = @_; + + POE::Session->create( + inline_states => { + _start => \&server_start, + _stop => \&server_stop, + do_fork => \&server_do_fork, + got_error => \&server_got_error, + got_sig_int => \&server_got_sig_int, + got_sig_child => \&server_got_sig_child, + got_connection => \&server_got_connection, + _child => sub { undef }, + }, + heap => { max_processes => MAX_PROCESSES }, + ); +} + +### The main server session has started. Set up the server socket and +### bookkeeping information, then fork the initial child processes. + +sub server_start { + my ( $kernel, $heap ) = @_[ KERNEL, HEAP ]; + + $heap->{server} = POE::Wheel::SocketFactory->new + ( BindPort => $SERVER_PORT, + SuccessEvent => "got_connection", + FailureEvent => "got_error", + Reuse => "yes", + ); + + $kernel->sig( INT => "got_sig_int" ); + $kernel->sig( TERM => "got_sig_int" ); #huh + + $heap->{children} = {}; + $heap->{is_a_child} = 0; + + warn "Server $$ has begun listening on port $SERVER_PORT\n"; + + $kernel->yield("do_fork"); +} + +### The server session has shut down. If this process has any +### children, signal them to shutdown too. + +sub server_stop { + my $heap = $_[HEAP]; + DEBUG and warn "Server $$ stopped.\n"; + + if ( my @children = keys %{ $heap->{children} } ) { + DEBUG and warn "Server $$ is signaling children to stop.\n"; + kill INT => @children; + } +} + +### The server session has encountered an error. Shut it down. + +sub server_got_error { + my ( $heap, $syscall, $errno, $error ) = @_[ HEAP, ARG0 .. ARG2 ]; + warn( "Server $$ got $syscall error $errno: $error\n", + "Server $$ is shutting down.\n", + ); + delete $heap->{server}; +} + +### The server has a need to fork off more children. Only honor that +### request form the parent, otherwise we would surely "forkbomb". +### Fork off as many child processes as we need. + +sub server_do_fork { + my ( $kernel, $heap ) = @_[ KERNEL, HEAP ]; + + return if $heap->{is_a_child}; + + #my $current_children = keys %{ $heap->{children} }; + #for ( $current_children + 2 .. $heap->{max_processes} ) { + while (scalar(keys %{$heap->{children}}) < $heap->{max_processes}) { + + DEBUG and warn "Server $$ is attempting to fork.\n"; + + my $pid = fork(); + + unless ( defined($pid) ) { + DEBUG and + warn( "Server $$ fork failed: $!\n", + "Server $$ will retry fork shortly.\n", + ); + $kernel->delay( do_fork => 1 ); + return; + } + + # Parent. Add the child process to its list. + if ($pid) { + $heap->{children}->{$pid} = 1; + $kernel->sig_child($pid, "got_sig_child"); + next; + } + + # Child. Clear the child process list. + $kernel->has_forked(); + DEBUG and warn "Server $$ forked successfully.\n"; + $heap->{is_a_child} = 1; + $heap->{children} = {}; + + #freeside db connection, etc. + forksuidsetup($user); + + #why isn't this needed ala freeside-selfservice-server?? + #FS::TicketSystem->init(); + + return; + } +} + +### The server session received SIGINT. Don't handle the signal, +### which in turn will trigger the process to exit gracefully. + +sub server_got_sig_int { + my ( $kernel, $heap ) = @_[ KERNEL, HEAP ]; + DEBUG and warn "Server $$ received SIGINT/TERM.\n"; + + if ( my @children = keys %{ $heap->{children} } ) { + DEBUG and warn "Server $$ is signaling children to stop.\n"; + kill INT => @children; + } + + delete $heap->{server}; + $kernel->sig_handled(); +} + +### The server session received a SIGCHLD, indicating that some child +### server has gone away. Remove the child's process ID from our +### list, and trigger more fork() calls to spawn new children. + +sub server_got_sig_child { + my ( $kernel, $heap, $child_pid ) = @_[ KERNEL, HEAP, ARG1 ]; + + return unless delete $heap->{children}->{$child_pid}; + + DEBUG and warn "Server $$ reaped child $child_pid.\n"; + $kernel->yield("do_fork") if exists $_[HEAP]->{server}; +} + +### The server session received a connection request. Spawn off a +### client handler session to parse the request and respond to it. + +sub server_got_connection { + my ( $heap, $socket, $peer_addr, $peer_port ) = @_[ HEAP, ARG0, ARG1, ARG2 ]; + + DEBUG and warn "Server $$ received a connection.\n"; + + POE::Session->create( + inline_states => { + _start => \&client_start, + _stop => \&client_stop, + got_request => \&client_got_request, + got_flush => \&client_flushed_request, + got_error => \&client_got_error, + _parent => sub { 0 }, + }, + heap => { + socket => $socket, + peer_addr => $peer_addr, + peer_port => $peer_port, + }, + ); + +# # Gracefully exit if testing process churn. +# delete $heap->{server} +# if TESTING_CHURN and $heap->{is_a_child} and ( rand() < 0.1 ); +} + +### The client handler has started. Wrap its socket in a ReadWrite +### wheel to begin interacting with it. + +sub client_start { + my $heap = $_[HEAP]; + + $heap->{client} = POE::Wheel::ReadWrite->new + ( Handle => $heap->{socket}, + Filter => POE::Filter::HTTPD->new(), + InputEvent => "got_request", + ErrorEvent => "got_error", + FlushedEvent => "got_flush", + ); + + DEBUG and warn "Client handler $$/", $_[SESSION]->ID, " started.\n"; +} + +### The client handler has stopped. Log that fact. + +sub client_stop { + DEBUG and warn "Client handler $$/", $_[SESSION]->ID, " stopped.\n"; +} + +### The client handler has received a request. If it's an +### HTTP::Response object, it means some error has occurred while +### parsing the request. Send that back and return immediately. +### Otherwise parse and process the request, generating and sending an +### HTTP::Response object in response. + +sub client_got_request { + my ( $heap, $request ) = @_[ HEAP, ARG0 ]; + + DEBUG and + warn "Client handler $$/", $_[SESSION]->ID, " is handling a request.\n"; + + if ( $request->isa("HTTP::Response") ) { + $heap->{client}->put($request); + return; + } + + forksuidsetup($user) unless dbh && dbh->ping; + + my $response = &{ $handle_request }( $request ); + + $heap->{client}->put($response); +} + +### The client handler received an error. Stop the ReadWrite wheel, +### which also closes the socket. + +sub client_got_error { + my ( $heap, $operation, $errnum, $errstr ) = @_[ HEAP, ARG0, ARG1, ARG2 ]; + DEBUG and + warn( "Client handler $$/", $_[SESSION]->ID, + " got $operation error $errnum: $errstr\n", + "Client handler $$/", $_[SESSION]->ID, " is shutting down.\n" + ); + delete $heap->{client}; +} + +### The client handler has flushed its response to the socket. We're +### done with the client connection, so stop the ReadWrite wheel. + +sub client_flushed_request { + my $heap = $_[HEAP]; + DEBUG and + warn( "Client handler $$/", $_[SESSION]->ID, + " flushed its response.\n", + "Client handler $$/", $_[SESSION]->ID, " is shutting down.\n" + ); + delete $heap->{client}; +} + +sub usage { + my $name = shift; + die "Usage:\n\n freeside-$name user\n"; +} + +1; diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 7bf5446ec..caa2e6046 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -78,8 +78,6 @@ if ( -e $addl_handler_use_file ) { use HTML::FormatText; use HTML::Defang; use JSON::XS; -# use XMLRPC::Transport::HTTP; -# use XMLRPC::Lite; # for XMLRPC::Serializer use MIME::Base64; use IO::Handle; use IO::File; @@ -215,7 +213,6 @@ if ( -e $addl_handler_use_file ) { use FS::usage_class; use FS::payment_gateway; use FS::agent_payment_gateway; - use FS::XMLRPC; use FS::payby; use FS::cdr; use FS::cdr_batch; @@ -377,6 +374,7 @@ if ( -e $addl_handler_use_file ) { use FS::part_fee; use FS::cust_bill_pkg_fee; use FS::part_fee_msgcat; + use FS::part_fee_usage; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index 9c18961ea..c598507cc 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -267,7 +267,7 @@ sub send_email { } # Logging - if ( $conf->exists('log_sent_mail') and $options{'custnum'} ) { + if ( $conf->exists('log_sent_mail') ) { my $cust_msg = FS::cust_msg->new({ 'env_from' => $options{'from'}, 'env_to' => join(', ', @to), @@ -278,6 +278,7 @@ sub send_email { 'custnum' => $options{'custnum'}, 'msgnum' => $options{'msgnum'}, 'status' => ($error ? 'failed' : 'sent'), + 'msgtype' => $options{'msgtype'}, }); $cust_msg->insert; # ignore errors } @@ -337,7 +338,7 @@ sub generate_email { my $me = '[FS::Misc::generate_email]'; - my @fields = qw(from to bcc subject custnum msgnum); + my @fields = qw(from to bcc subject custnum msgnum msgtype); my %return; @return{@fields} = @args{@fields}; diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm index 7f593846e..17b12ae23 100644 --- a/FS/FS/Report/Table.pm +++ b/FS/FS/Report/Table.pm @@ -141,7 +141,7 @@ sub payments { sub credits { my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; $self->scalar_sql(" - SELECT SUM(amount) + SELECT SUM(cust_credit.amount) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum). @@ -390,9 +390,6 @@ unspecified, defaults to all three. 'use_override': for line items generated by an add-on package, use the class of the add-on rather than the base package. -'freq': limit to packages with this frequency. Currently uses the part_pkg -frequency, so term discounted packages may give odd results. - 'distribute': for non-monthly recurring charges, ignore the invoice date. Instead, consider the line item's starting/ending dates. Determine the fraction of the line item duration that falls within the specified @@ -421,7 +418,8 @@ my $cust_bill_pkg_join = ' LEFT JOIN cust_main USING ( custnum ) LEFT JOIN cust_pkg USING ( pkgnum ) LEFT JOIN part_pkg USING ( pkgpart ) - LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart'; + LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart + LEFT JOIN part_fee USING ( feepart )'; sub cust_bill_pkg_setup { my $self = shift; @@ -434,7 +432,7 @@ sub cust_bill_pkg_setup { $agentnum ||= $opt{'agentnum'}; my @where = ( - 'pkgnum != 0', + '(pkgnum != 0 OR feepart IS NOT NULL)', $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), $self->with_report_option(%opt), $self->in_time_period_and_agent($speriod, $eperiod, $agentnum), @@ -461,7 +459,7 @@ sub cust_bill_pkg_recur { my $cust_bill_pkg = $opt{'project'} ? 'v_cust_bill_pkg' : 'cust_bill_pkg'; my @where = ( - 'pkgnum != 0', + '(pkgnum != 0 OR feepart IS NOT NULL)', $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), $self->with_report_option(%opt), ); @@ -476,13 +474,14 @@ sub cust_bill_pkg_recur { $item_usage = 'usage'; #already calculated } else { - $item_usage = '( SELECT COALESCE(SUM(amount),0) + $item_usage = '( SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0) FROM cust_bill_pkg_detail WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum )'; } my $recur_fraction = ''; if ( $opt{'distribute'} ) { + $where[0] = 'pkgnum != 0'; # specifically exclude fees push @where, "cust_main.agentnum = $agentnum" if $agentnum; push @where, "$cust_bill_pkg.sdate < $eperiod", @@ -521,7 +520,8 @@ Arguments as for C<cust_bill_pkg>, plus: sub cust_bill_pkg_detail { my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; - my @where = ( "cust_bill_pkg.pkgnum != 0" ); + my @where = + ( "(cust_bill_pkg.pkgnum != 0 OR cust_bill_pkg.feepart IS NOT NULL)" ); push @where, 'cust_main.refnum = '. $opt{'refnum'} if $opt{'refnum'}; @@ -536,7 +536,9 @@ sub cust_bill_pkg_detail { ; if ( $opt{'distribute'} ) { - # then limit according to the usage time, not the billing date + # exclude fees + $where[0] = 'cust_bill_pkg.pkgnum != 0'; + # and limit according to the usage time, not the billing date push @where, $self->in_time_period_and_agent($speriod, $eperiod, $agentnum, 'cust_bill_pkg_detail.startdate' ); @@ -547,7 +549,7 @@ sub cust_bill_pkg_detail { ); } - my $total_sql = " SELECT SUM(amount) "; + my $total_sql = " SELECT SUM(cust_bill_pkg_detail.amount) "; $total_sql .= " / CASE COUNT(cust_pkg.*) WHEN 0 THEN 1 ELSE COUNT(cust_pkg.*) END " @@ -561,6 +563,7 @@ sub cust_bill_pkg_detail { LEFT JOIN cust_pkg ON cust_bill_pkg.pkgnum = cust_pkg.pkgnum LEFT JOIN part_pkg USING ( pkgpart ) LEFT JOIN part_pkg AS override ON pkgpart_override = override.pkgpart + LEFT JOIN part_fee USING ( feepart ) WHERE ".join( ' AND ', grep $_, @where ); $self->scalar_sql($total_sql); @@ -683,14 +686,14 @@ sub with_classnum { @$classnum = grep /^\d+$/, @$classnum; my $in = 'IN ('. join(',', @$classnum). ')'; - if ( $use_override ) { - "( + my $expr = " ( COALESCE(part_pkg.classnum, 0) $in AND pkgpart_override IS NULL) - OR ( COALESCE(override.classnum, 0) $in AND pkgpart_override IS NOT NULL ) - )"; - } else { - "COALESCE(part_pkg.classnum, 0) $in"; + OR ( COALESCE(part_fee.classnum, 0) $in AND feepart IS NOT NULL )"; + if ( $use_override ) { + $expr .= " + OR ( COALESCE(override.classnum, 0) $in AND pkgpart_override IS NOT NULL )"; } + "( $expr )"; } sub with_usageclass { @@ -834,7 +837,8 @@ sub init_projection { # sdate/edate overlapping the ROI, for performance "INSERT INTO v_cust_bill_pkg ( SELECT cust_bill_pkg.*, - (SELECT COALESCE(SUM(amount),0) FROM cust_bill_pkg_detail + (SELECT COALESCE(SUM(cust_bill_pkg_detail.amount),0) + FROM cust_bill_pkg_detail WHERE cust_bill_pkg_detail.billpkgnum = cust_bill_pkg.billpkgnum), cust_bill._date, cust_pkg.expire diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index ec4a1b3e2..bf756d129 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -943,6 +943,7 @@ sub tables_hashref { 'eventnum', 'int', '', '', '', '', 'billpkgnum', 'int', 'NULL', '', '', '', 'feepart', 'int', '', '', '', '', + 'nextbill', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'eventfeenum', # I'd rather just use eventnum 'unique' => [ [ 'billpkgnum' ], [ 'eventnum' ] ], # one-to-one link @@ -2234,6 +2235,7 @@ sub tables_hashref { 'gatewaynum', 'int', 'NULL', '', '', '', #'cust_balance', @money_type, '', '', 'paynum', 'int', 'NULL', '', '', '', + 'void_paynum', 'int', 'NULL', '', '', '', 'jobnum', 'bigint', 'NULL', '', '', '', 'invnum', 'int', 'NULL', '', '', '', 'manual', 'char', 'NULL', 1, '', '', @@ -2256,6 +2258,10 @@ sub tables_hashref { { columns => [ 'paynum' ], table => 'cust_pay', }, + { columns => [ 'void_paynum' ], + table => 'cust_pay_void', + references => [ 'paynum' ], + }, { columns => [ 'jobnum' ], table => 'queue', }, @@ -3188,6 +3194,26 @@ sub tables_hashref { ], }, + 'part_fee_usage' => { + 'columns' => [ + 'feepartusagenum','serial', '', '', '', '', + 'feepart', 'int', '', '', '', '', + 'classnum', 'int', '', '', '', '', + 'amount', @money_type, '', '', + 'percent', 'decimal', '', '7,4', '', '', + ], + 'primary_key' => 'feepartusagenum', + 'unique' => [ [ 'feepart', 'classnum' ] ], + 'index' => [], + 'foreign_keys' => [ + { columns => [ 'feepart' ], + table => 'part_fee', + }, + { columns => [ 'classnum' ], + table => 'usage_class', + }, + ], + }, 'part_pkg_link' => { 'columns' => [ @@ -4427,9 +4453,9 @@ sub tables_hashref { 'unique' => [ [ 'blocknum', 'routernum' ] ], 'index' => [], 'foreign_keys' => [ - { columns => [ 'routernum' ], - table => 'router', - }, + #{ columns => [ 'routernum' ], + # table => 'router', + #}, { columns => [ 'agentnum' ], table => 'agent', }, @@ -5991,7 +6017,7 @@ sub tables_hashref { 'cust_msg' => { 'columns' => [ 'custmsgnum', 'serial', '', '', '', '', - 'custnum', 'int', '', '', '', '', + 'custnum', 'int', 'NULL', '', '', '', 'msgnum', 'int', 'NULL', '', '', '', '_date', @date_type, '', '', 'env_from', 'varchar', 'NULL', 255, '', '', @@ -6000,6 +6026,7 @@ sub tables_hashref { 'body', 'blob', 'NULL', '', '', '', 'error', 'varchar', 'NULL', 255, '', '', 'status', 'varchar', '',$char_d, '', '', + 'msgtype', 'varchar', 'NULL', 16, '', '', ], 'primary_key' => 'custmsgnum', 'unique' => [ ], diff --git a/FS/FS/TemplateItem_Mixin.pm b/FS/FS/TemplateItem_Mixin.pm index bf857a98a..fa20c240f 100644 --- a/FS/FS/TemplateItem_Mixin.pm +++ b/FS/FS/TemplateItem_Mixin.pm @@ -61,14 +61,19 @@ sub desc { my( $self, $locale ) = @_; if ( $self->pkgnum > 0 ) { - $self->itemdesc || $self->part_pkg->pkg_locale($locale); + return $self->itemdesc if $self->itemdesc; + my $part_pkg = $self->part_pkg or return 'UNKNOWN'; + return $part_pkg->pkg_locale($locale); + } elsif ( $self->feepart ) { - $self->part_fee->itemdesc_locale($locale); + return $self->part_fee->itemdesc_locale($locale); + } else { # by the process of elimination it must be a tax my $desc = $self->itemdesc || 'Tax'; $desc .= ' '. $self->itemcomment if $self->itemcomment =~ /\S/; - $desc; + return $desc; } + } =item time_period_pretty PART_PKG, AGENTNUM diff --git a/FS/FS/Template_Mixin.pm b/FS/FS/Template_Mixin.pm index c4c2d7fb0..131a23643 100644 --- a/FS/FS/Template_Mixin.pm +++ b/FS/FS/Template_Mixin.pm @@ -2452,6 +2452,8 @@ sub _items_cust_bill_pkg { warn "$me _items_cust_bill_pkg cust_bill_pkg is quotation_pkg\n" if $DEBUG > 1; + # quotation_pkgs are never fees, so don't worry about the case where + # part_pkg is undefined if ( $cust_bill_pkg->setup != 0 ) { my $description = $desc; @@ -2471,7 +2473,7 @@ sub _items_cust_bill_pkg { }; } - } elsif ( $cust_bill_pkg->pkgnum > 0 ) { + } elsif ( $cust_bill_pkg->pkgnum > 0 ) { # and it's not a quotation_pkg warn "$me _items_cust_bill_pkg cust_bill_pkg is non-tax\n" if $DEBUG > 1; @@ -2739,29 +2741,21 @@ sub _items_cust_bill_pkg { } # recurring or usage with recurring charge - } else { #pkgnum tax or one-shot line item (??) + } else { # taxes and fees warn "$me _items_cust_bill_pkg cust_bill_pkg is tax\n" if $DEBUG > 1; - if ( $cust_bill_pkg->setup != 0 ) { - push @b, { - 'description' => $desc, - 'amount' => sprintf("%.2f", $cust_bill_pkg->setup), - }; - } - if ( $cust_bill_pkg->recur != 0 ) { - push @b, { - 'description' => "$desc (". - $self->time2str_local('short', $cust_bill_pkg->sdate). ' - '. - $self->time2str_local('short', $cust_bill_pkg->edate). ')', - 'amount' => sprintf("%.2f", $cust_bill_pkg->recur), - }; - } + # items of this kind should normally not have sdate/edate. + push @b, { + 'description' => $desc, + 'amount' => sprintf('%.2f', $cust_bill_pkg->setup + + $cust_bill_pkg->recur) + }; - } + } # if quotation / package line item / other line item - } + } # foreach $display $discount_show_always = ($cust_bill_pkg->cust_bill_pkg_discount && $conf->exists('discount-show-always')); diff --git a/FS/FS/XMLRPC.pm b/FS/FS/XMLRPC.pm deleted file mode 100644 index 62ae43d18..000000000 --- a/FS/FS/XMLRPC.pm +++ /dev/null @@ -1,164 +0,0 @@ - package FS::XMLRPC; - -use strict; -use vars qw( $DEBUG ); -use Frontier::RPC2; - -# Instead of 'use'ing freeside modules on the fly below, just preload them now. -use FS; -use FS::CGI; -use FS::Conf; -use FS::Record; -use FS::cust_main; - -use Data::Dumper; - -$DEBUG = 0; - -=head1 NAME - -FS::XMLRPC - Object methods for handling XMLRPC requests - -=head1 SYNOPSIS - - use FS::XMLRPC; - - $xmlrpc = new FS::XMLRPC; - - ($error, $response_xml) = $xmlrpc->serve($request_xml); - -=head1 DESCRIPTION - -The FS::XMLRPC object is a mechanisim to access read-only data from freeside's subroutines. It does not, at least not at this point, give you the ability to access methods of freeside objects remotely. It can, however, be used to call subroutines such as FS::cust_main::smart_search and FS::Record::qsearch. - -See the serve method below for calling syntax. - -=head1 METHODS - -=over 4 - -=item new - -Provides a FS::XMLRPC object used to handle incoming XMLRPC requests. - -=cut - -sub new { - - my $class = shift; - my $self = {}; - bless($self, $class); - - $self->{_coder} = new Frontier::RPC2; - - return $self; - -} - -=item serve REQUEST_XML_SCALAR - -The serve method takes a scalar containg an XMLRPC request for one of freeside's subroutines (not object methods). Parameters passed in the 'methodCall' will be passed as a list to the subroutine untouched. The return value of the called subroutine _must_ be a freeside object reference (eg. qsearchs) or a list of freeside object references (eg. qsearch, smart_search), _and_, the object(s) returned must support the hashref method. This will be checked first by calling UNIVERSAL::can('FS::class::subroutine', 'hashref'). - -Return value is an XMLRPC methodResponse containing the results of the call. The result of the subroutine call itself will be coded in the methodResponse as an array of structs, regardless of whether there was many or a single object returned. In other words, after you decode the response, you'll always have an array. - -=cut - -sub serve { - - my ($self, $request_xml) = (shift, shift); - my $response_xml; - - my $coder = $self->{_coder}; - my $call = $coder->decode($request_xml); - - warn "Got methodCall with method_name='" . $call->{method_name} . "'" - if $DEBUG; - - $response_xml = $coder->encode_response(&_serve($call->{method_name}, $call->{value})); - - return ('', $response_xml); - -} - -sub _serve { #Subroutine, not method - - my ($method_name, $params) = (shift, shift); - - - #die 'Called _serve without parameters' unless ref($params) eq 'ARRAY'; - $params = [] unless (ref($params) eq 'ARRAY'); - - if ($method_name =~ /^(\w+)\.(\w+)/) { - - #my ($class, $sub) = split(/\./, $method_name); - my ($class, $sub) = ($1, $2); - my $fssub = "FS::${class}::${sub}"; - warn "fssub: ${fssub}" if $DEBUG; - warn "params: " . Dumper($params) if $DEBUG; - - my @result; - - if ($class eq 'Conf') { #Special case for FS::Conf because we need an obj. - - if ($sub eq 'config') { - my $conf = new FS::Conf; - @result = ($conf->config(@$params)); - } else { - warn "FS::XMLRPC: Can't call undefined subroutine '${fssub}'"; - } - - } else { - - unless (UNIVERSAL::can("FS::${class}", $sub)) { - warn "FS::XMLRPC: Can't call undefined subroutine '${fssub}'"; - # Should we encode an error in the response, - # or just break silently to the remote caller and complain locally? - return []; - } - - eval { - no strict 'refs'; - my $fssub = "FS::${class}::${sub}"; - @result = (&$fssub(@$params)); - }; - - if ($@) { - warn "FS::XMLRPC: Error while calling '${fssub}': $@"; - return []; - } - - } - - if ( scalar(@result) == 1 && ref($result[0]) eq 'HASH' ) { - return $result[0]; - } elsif (grep { UNIVERSAL::can($_, 'hashref') ? 0 : 1 } @result) { - #warn "FS::XMLRPC: One or more objects returned from '${fssub}' doesn't " . - # "support the 'hashref' method."; - - # If they're not FS::Record decendants, just return the results unmap'd? - # This is more flexible, but possibly more error-prone. - return [ @result ]; - } else { - return [ map { $_->hashref } @result ]; - } - } elsif ($method_name eq 'version') { - return [ $FS::VERSION ]; - } # else... - - warn "Unhandled XMLRPC request '${method_name}'"; - return {}; - -} - -=head1 BUGS - -Probably lots. - -=head1 SEE ALSO - -L<Frontier::RPC2>. - -=cut - -1; - diff --git a/FS/FS/XMLRPC_Lite.pm b/FS/FS/XMLRPC_Lite.pm new file mode 100644 index 000000000..9d3059d69 --- /dev/null +++ b/FS/FS/XMLRPC_Lite.pm @@ -0,0 +1,17 @@ +package FS::XMLRPC_Lite; + +use XMLRPC::Lite; + +use XMLRPC::Transport::HTTP; + +#XXX submit patch to SOAP::Lite + +package XMLRPC::Transport::HTTP::Server; + +@XMLRPC::Transport::HTTP::Server::ISA = qw(SOAP::Transport::HTTP::Server); + +sub initialize; *initialize = \&XMLRPC::Server::initialize; +sub make_fault; *make_fault = \&XMLRPC::Transport::HTTP::CGI::make_fault; +sub make_response; *make_response = \&XMLRPC::Transport::HTTP::CGI::make_response; + +1; diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 83ddb6566..3c0e3e7da 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -1065,6 +1065,8 @@ sub generate_email { my %return = ( 'from' => $args{'from'}, 'subject' => ($args{'subject'} || $self->email_subject), + 'custnum' => $self->custnum, + 'msgtype' => 'invoice', ); $args{'unsquelch_cdr'} = $conf->exists('voip-cdr_email'); diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index a9439217c..066ddf160 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -968,6 +968,31 @@ sub tax_locationnum { } } +sub tax_location { + my $self = shift; + FS::cust_location->by_key($self->tax_locationnum); +} + +=item part_X + +Returns the L<FS::part_pkg> or L<FS::part_fee> object that defines this +charge. If called on a tax line, returns nothing. + +=cut + +sub part_X { + my $self = shift; + if ( $self->override_pkgpart ) { + return FS::part_pkg->by_key($self->override_pkgpart); + } elsif ( $self->pkgnum ) { + return $self->cust_pkg->part_pkg; + } elsif ( $self->feepart ) { + return $self->part_fee; + } else { + return; + } +} + =back =head1 CLASS METHODS diff --git a/FS/FS/cust_bill_pkg_fee.pm b/FS/FS/cust_bill_pkg_fee.pm index 8ea73c9dc..b9adfafa0 100644 --- a/FS/FS/cust_bill_pkg_fee.pm +++ b/FS/FS/cust_bill_pkg_fee.pm @@ -26,8 +26,8 @@ FS::cust_bill_pkg_fee - Object methods for cust_bill_pkg_fee records =head1 DESCRIPTION An FS::cust_bill_pkg_fee object records the origin of a fee. -. FS::cust_bill_pkg_fee inherits from -FS::Record. The following fields are currently supported: +FS::cust_bill_pkg_fee inherits from FS::Record. The following fields +are currently supported: =over 4 @@ -70,8 +70,8 @@ sub check { my $error = $self->ut_numbern('billpkgfeenum') || $self->ut_number('billpkgnum') - || $self->ut_foreign_key('origin_invnum', 'cust_bill', 'invnum') - || $self->ut_foreign_keyn('origin_billpkgnum', 'cust_bill_pkg', 'billpkgnum') + || $self->ut_foreign_key('base_invnum', 'cust_bill', 'invnum') + || $self->ut_foreign_keyn('base_billpkgnum', 'cust_bill_pkg', 'billpkgnum') || $self->ut_money('amount') ; return $error if $error; diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 567be21d6..58bd475b1 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -815,14 +815,9 @@ sub credit_lineitems { # recalculate taxes with new amounts $taxlisthash{$invnum} ||= {}; - my $part_pkg = $cust_bill_pkg->part_pkg; - $cust_main->_handle_taxes( $part_pkg, - $taxlisthash{$invnum}, - $cust_bill_pkg, - $cust_bill_pkg->cust_pkg, - $cust_bill_pkg->cust_bill->_date, #invoice time - $cust_bill_pkg->cust_pkg->pkgpart, - ); + my $part_pkg = $cust_bill_pkg->part_pkg + if $cust_bill_pkg->pkgpart_override; + $cust_main->_handle_taxes( $taxlisthash{$invnum}, $cust_bill_pkg ); } ### @@ -918,12 +913,12 @@ sub credit_lineitems { # we still have to deal with the possibility that the tax links don't # cover the whole amount of tax because of an incomplete upgrade... - if ($amount > 0) { + if ($amount > 0.005) { $cust_credit_bill{$invnum} += $amount; push @{ $cust_credit_bill_pkg{$invnum} }, new FS::cust_credit_bill_pkg { 'billpkgnum' => $tax_item->billpkgnum, - 'amount' => $amount, + 'amount' => sprintf('%.2f', $amount), 'setuprecur' => 'setup', }; diff --git a/FS/FS/cust_credit_bill_pkg.pm b/FS/FS/cust_credit_bill_pkg.pm index be9cd70bd..1f741b289 100644 --- a/FS/FS/cust_credit_bill_pkg.pm +++ b/FS/FS/cust_credit_bill_pkg.pm @@ -166,11 +166,16 @@ sub insert { 'amount' => sprintf('%.2f', 0-$amount), }; - my $error = $cust_tax_exempt_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error inserting cust_tax_exempt_pkg: $error"; + if ( $cust_tax_exempt_pkg->cust_main_county ) { + + my $error = $cust_tax_exempt_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error inserting cust_tax_exempt_pkg: $error"; + } + } + } #foreach $exemption } diff --git a/FS/FS/cust_event_fee.pm b/FS/FS/cust_event_fee.pm index 78794fdfe..181640ddc 100644 --- a/FS/FS/cust_event_fee.pm +++ b/FS/FS/cust_event_fee.pm @@ -45,6 +45,9 @@ time billing runs for the customer. =item feepart - key of the fee definition (L<FS::part_fee>). +=item nextbill - 'Y' if the fee should be charged on the customer's next +bill, rather than causing a bill to be produced immediately. + =back =head1 METHODS @@ -93,6 +96,7 @@ sub check { || $self->ut_foreign_key('eventnum', 'cust_event', 'eventnum') || $self->ut_foreign_keyn('billpkgnum', 'cust_bill_pkg', 'billpkgnum') || $self->ut_foreign_key('feepart', 'part_fee', 'feepart') + || $self->ut_flag('nextbill') ; return $error if $error; @@ -108,7 +112,8 @@ sub check { =item by_cust CUSTNUM[, PARAMS] Finds all cust_event_fee records belonging to the customer CUSTNUM. Currently -fee events can be cust_main or cust_bill events; this will return both. +fee events can be cust_main, cust_pkg, or cust_bill events; this will return +all of them. PARAMS can be additional params to pass to qsearch; this really only works for 'hashref' and 'order_by'. @@ -141,6 +146,15 @@ sub by_cust { extra_sql => "$where eventtable = 'cust_bill' ". "AND cust_bill.custnum = $custnum", %params + }), + qsearch({ + table => 'cust_event_fee', + addl_from => 'JOIN cust_event USING (eventnum) ' . + 'JOIN part_event USING (eventpart) ' . + 'JOIN cust_pkg ON (cust_event.tablenum = cust_pkg.pkgnum)', + extra_sql => "$where eventtable = 'cust_pkg' ". + "AND cust_pkg.custnum = $custnum", + %params }) } diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm index 6bd82d133..8d389928b 100644 --- a/FS/FS/cust_main/Billing.pm +++ b/FS/FS/cust_main/Billing.pm @@ -533,8 +533,6 @@ sub bill { my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} }); - next unless @cust_bill_pkg; #don't create an invoice w/o line items - warn "$me billing pass $pass\n" #.Dumper(\@cust_bill_pkg)."\n" if $DEBUG > 2; @@ -547,13 +545,26 @@ sub bill { hashref => { 'billpkgnum' => '' } ); warn "$me found pending fee events:\n".Dumper(\@pending_event_fees)."\n" - if @pending_event_fees; + if @pending_event_fees and $DEBUG > 1; + + # determine whether to generate an invoice + my $generate_bill = scalar(@cust_bill_pkg) > 0; + + foreach my $event_fee (@pending_event_fees) { + $generate_bill = 1 unless $event_fee->nextbill; + } + + # don't create an invoice with no line items, or where the only line + # items are fees that are supposed to be held until the next invoice + next if !$generate_bill; + # calculate fees... my @fee_items; foreach my $event_fee (@pending_event_fees) { my $object = $event_fee->cust_event->cust_X; + my $part_fee = $event_fee->part_fee; my $cust_bill; - if ( $object->isa('FS::cust_main') ) { + if ( $object->isa('FS::cust_main') or $object->isa('FS::cust_pkg') ) { # Not the real cust_bill object that will be inserted--in particular # there are no taxes yet. If you want to charge a fee on the total # invoice amount including taxes, you have to put the fee on the next @@ -564,12 +575,20 @@ sub bill { 'charged' => ${ $total_setup{$pass} } + ${ $total_recur{$pass} }, }); + + # If this is a package event, only apply the fee to line items + # from that package. + if ($object->isa('FS::cust_pkg')) { + $cust_bill->set('cust_bill_pkg', + [ grep { $_->pkgnum == $object->pkgnum } @cust_bill_pkg ] + ); + } + } elsif ( $object->isa('FS::cust_bill') ) { # simple case: applying the fee to a previous invoice (late fee, # etc.) $cust_bill = $object; } - my $part_fee = $event_fee->part_fee; # if the fee def belongs to a different agent, don't charge the fee. # event conditions should prevent this, but just in case they don't, # skip the fee. @@ -581,11 +600,14 @@ sub bill { # also skip if it's disabled next if $part_fee->disabled eq 'Y'; # calculate the fee - my $fee_item = $event_fee->part_fee->lineitem($cust_bill); + my $fee_item = $part_fee->lineitem($cust_bill) or next; # link this so that we can clear the marker on inserting the line item $fee_item->set('cust_event_fee', $event_fee); push @fee_items, $fee_item; + } + + # add fees to the invoice foreach my $fee_item (@fee_items) { push @cust_bill_pkg, $fee_item; @@ -596,12 +618,9 @@ sub bill { my $fee_location = $self->ship_location; # I think? my $error = $self->_handle_taxes( - $part_fee, $taxlisthash{$pass}, $fee_item, - $fee_location, - $options{invoice_time}, - {} # no options + location => $fee_location ); return $error if $error; @@ -1319,14 +1338,7 @@ sub _make_lines { # handle taxes ### - my $error = $self->_handle_taxes( - $part_pkg, - $taxlisthash, - $cust_bill_pkg, - $cust_location, - $options{invoice_time}, - \%options # I have serious objections to this - ); + my $error = $self->_handle_taxes( $taxlisthash, $cust_bill_pkg ); return $error if $error; $cust_bill_pkg->set_display( @@ -1423,15 +1435,13 @@ sub _transfer_balance { return @transfers; } -=item _handle_taxes PART_ITEM TAXLISTHASH CUST_BILL_PKG CUST_LOCATION TIME [ OPTIONS ] +=item handle_taxes TAXLISTHASH CUST_BILL_PKG [ OPTIONS ] This is _handle_taxes. It's called once for each cust_bill_pkg generated -from _make_lines, along with the part_pkg (or part_fee), cust_location, -invoice time, a flag indicating whether the package is being canceled, and a -partridge in a pear tree. +from _make_lines. -The most important argument is 'taxlisthash'. This is shared across the -entire invoice. It looks like this: +TAXLISTHASH is a hashref shared across the entire invoice. It looks like +this: { 'cust_main_county 1001' => [ [FS::cust_main_county], ... ], 'cust_main_county 1002' => [ [FS::cust_main_county], ... ], @@ -1444,16 +1454,27 @@ That "..." is a list of FS::cust_bill_pkg objects that will be fed to the 'taxline' method to calculate the amount of the tax. This doesn't happen until calculate_taxes, though. +OPTIONS may include: +- part_item: a part_pkg or part_fee object to be used as the package/fee + definition. +- location: a cust_location to be used as the billing location. + +If not supplied, part_item will be inferred from the pkgnum or feepart of the +cust_bill_pkg, and location from the pkgnum (or, for fees, the invnum and +the customer's default service location). + =cut sub _handle_taxes { my $self = shift; - my $part_item = shift; my $taxlisthash = shift; my $cust_bill_pkg = shift; - my $location = shift; - my $invoice_time = shift; - my $options = shift; + my %options = @_; + + # at this point I realize that we have enough information to infer all this + # stuff, instead of passing around giant honking argument lists + my $location = $options{location} || $cust_bill_pkg->tax_location; + my $part_item = $options{part_item} || $cust_bill_pkg->part_X; local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG; @@ -1473,9 +1494,8 @@ sub _handle_taxes { my @classes; #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U'; push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage; - # debatable - push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel}); - push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel}); + push @classes, 'setup' if $cust_bill_pkg->setup; + push @classes, 'recur' if $cust_bill_pkg->recur; my $exempt = $conf->exists('cust_class-tax_exempt') ? ( $self->cust_class ? $self->cust_class->tax : '' ) @@ -1543,10 +1563,7 @@ sub _handle_taxes { warn "adding $totname to taxed taxes\n" if $DEBUG > 2; # calculate the tax amount that the tax_on_tax will apply to my $hashref_or_error = - $tax_object->taxline( $localtaxlisthash{$tax}, - 'custnum' => $self->custnum, - 'invoice_time' => $invoice_time, - ); + $tax_object->taxline( $localtaxlisthash{$tax} ); return $hashref_or_error unless ref($hashref_or_error); diff --git a/FS/FS/cust_msg.pm b/FS/FS/cust_msg.pm index c9cf68663..8d57a54ac 100644 --- a/FS/FS/cust_msg.pm +++ b/FS/FS/cust_msg.pm @@ -22,9 +22,9 @@ FS::cust_msg - Object methods for cust_msg records =head1 DESCRIPTION -An FS::cust_msg object represents a template-generated message sent to -a customer (see L<FS::msg_template>). FS::cust_msg inherits from -FS::Record. The following fields are currently supported: +An FS::cust_msg object represents an email message generated by Freeside +and sent to a customer (see L<FS::msg_template>). FS::cust_msg inherits +from FS::Record. The following fields are currently supported: =over 4 @@ -34,6 +34,8 @@ FS::Record. The following fields are currently supported: =item msgnum - template number +=item msgtype - the message type + =item _date - the time the message was sent =item env_from - envelope From address @@ -125,8 +127,8 @@ sub check { my $error = $self->ut_numbern('custmsgnum') - || $self->ut_number('custnum') - || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') + || $self->ut_numbern('custnum') + || $self->ut_foreign_keyn('custnum', 'cust_main', 'custnum') || $self->ut_numbern('msgnum') || $self->ut_foreign_keyn('msgnum', 'msg_template', 'msgnum') || $self->ut_numbern('_date') @@ -136,6 +138,11 @@ sub check { || $self->ut_anything('body') || $self->ut_enum('status', \@statuses) || $self->ut_textn('error') + || $self->ut_enum('msgtype', [ '', + 'invoice', + 'receipt', + 'admin', + ]) ; return $error if $error; diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 63d7c4835..10b51ad7a 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -414,12 +414,17 @@ sub void { } ); $cust_pay_void->reason(shift) if scalar(@_); my $error = $cust_pay_void->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + + my $cust_pay_pending = + qsearchs('cust_pay_pending', { paynum => $self->paynum }); + if ( $cust_pay_pending ) { + $cust_pay_pending->set('void_paynum', $self->paynum); + $cust_pay_pending->set('paynum', ''); + $error ||= $cust_pay_pending->replace; } - $error = $self->delete; + $error ||= $self->delete; + if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -611,11 +616,12 @@ sub send_receipt { 'custnum' => $cust_main->custnum, }; $error = $queue->insert( - FS::msg_template->by_key($msgnum)->prepare( + FS::msg_template->by_key($msgnum)->prepare( 'cust_main' => $cust_main, 'object' => $self, 'from_config' => 'payment_receipt_from', - ) + ), + 'msgtype' => 'receipt', # override msg_template's default ); } elsif ( $conf->exists('payment_receipt_email') ) { @@ -658,6 +664,7 @@ sub send_receipt { 'job' => 'FS::Misc::process_send_generated_email', 'paynum' => $self->paynum, 'custnum' => $cust_main->custnum, + 'msgtype' => 'receipt', }; $error = $queue->insert( 'from' => $conf->config('invoice_from', $cust_main->agentnum), diff --git a/FS/FS/cust_pay_pending.pm b/FS/FS/cust_pay_pending.pm index f5de73dbe..63274b184 100644 --- a/FS/FS/cust_pay_pending.pm +++ b/FS/FS/cust_pay_pending.pm @@ -135,6 +135,10 @@ L<FS::payment_gateway> id. Payment number (L<FS::cust_pay>) of the completed payment. +=item void_paynum + +Payment number of the payment if it's been voided. + =item invnum Invoice number (L<FS::cust_bill>) to try to apply this payment to. @@ -224,6 +228,7 @@ sub check { || $self->ut_foreign_keyn('paynum', 'cust_pay', 'paynum' ) || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') || $self->ut_foreign_keyn('invnum', 'cust_bill', 'invnum') + || $self->ut_foreign_keyn('void_paynum', 'cust_pay_void', 'paynum' ) || $self->ut_flag('manual') || $self->ut_numbern('discount_term') || $self->payinfo_check() #payby/payinfo/paymask/paydate diff --git a/FS/FS/cust_pay_void.pm b/FS/FS/cust_pay_void.pm index 55b6c6743..b2f777b32 100644 --- a/FS/FS/cust_pay_void.pm +++ b/FS/FS/cust_pay_void.pm @@ -133,12 +133,16 @@ sub unvoid { map { $_ => $self->get($_) } fields('cust_pay') } ); my $error = $cust_pay->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + + my $cust_pay_pending = + qsearchs('cust_pay_pending', { void_paynum => $self->paynum }); + if ( $cust_pay_pending ) { + $cust_pay_pending->set('paynum', $cust_pay->paynum); + $cust_pay_pending->set('void_paynum', ''); + $error ||= $cust_pay_pending->replace; } - $error = $self->delete; + $error ||= $self->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 668de754d..4ea3966c0 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -923,6 +923,8 @@ sub cancel { 'to' => \@invoicing_list, 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ), 'body' => [ map "$_\n", $conf->config('cancelmessage') ], + 'custnum' => $self->custnum, + 'msgtype' => '', #admin? ); } #should this do something on errors? @@ -1343,6 +1345,8 @@ sub suspend { 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n", ( map { "Service : $_\n" } @labels ), ], + 'custnum' => $self->custnum, + 'msgtype' => 'admin' ); if ( $error ) { @@ -1589,6 +1593,8 @@ sub unsuspend { : '' ), ], + 'custnum' => $self->custnum, + 'msgtype' => 'admin', ); if ( $error ) { diff --git a/FS/FS/cust_pkg/Search.pm b/FS/FS/cust_pkg/Search.pm index 43b870340..47efd3140 100644 --- a/FS/FS/cust_pkg/Search.pm +++ b/FS/FS/cust_pkg/Search.pm @@ -397,12 +397,18 @@ sub search { ); if( exists($params->{'active'} ) ) { - # This overrides all the other date-related fields + # This overrides all the other date-related fields, and includes packages + # that were active at some time during the interval. It excludes: + # - packages that were set up after the end of the interval + # - packages that were canceled before the start of the interval + # - packages that were suspended before the start of the interval + # and are still suspended now my($beginning, $ending) = @{$params->{'active'}}; push @where, "cust_pkg.setup IS NOT NULL", "cust_pkg.setup <= $ending", "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )", + "(cust_pkg.susp IS NULL OR cust_pkg.susp >= $beginning )", "NOT (".FS::cust_pkg->onetime_sql . ")"; } else { diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 7bf41ee5d..be5a9eb6a 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -5,6 +5,7 @@ use strict; use vars qw( $DEBUG $me $ignore_quantity $conf $ticket_system ); use Carp; #use Scalar::Util qw( blessed ); +use List::Util qw( max ); use FS::Conf; use FS::Record qw( qsearch qsearchs dbh str2time_sql ); use FS::part_pkg; @@ -363,15 +364,26 @@ sub check { return "Unknown svcpart" unless $part_svc; if ( $self->pkgnum && ! $ignore_quantity ) { - my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); - return "Unknown pkgnum" unless $cust_pkg; - ($part_svc) = grep { $_->svcpart == $self->svcpart } $cust_pkg->part_svc; - return "No svcpart ". $self->svcpart. - " services in pkgpart ". $cust_pkg->pkgpart - unless $part_svc || $ignore_quantity; - return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc. + + #slightly inefficient since ->pkg_svc will also look it up, but fixing + # a much larger perf problem and have bigger fish to fry + my $cust_pkg = $self->cust_pkg; + + my $pkg_svc = $self->pkg_svc + or return "No svcpart ". $self->svcpart. + " services in pkgpart ". $cust_pkg->pkgpart; + + my $num_cust_svc = $cust_pkg->num_cust_svc( $self->svcpart ); + + #false laziness w/cust_pkg->part_svc + my $num_avail = max( 0, ($cust_pkg->quantity || 1) * $pkg_svc->quantity + - $num_cust_svc + ); + + return "Already $num_cust_svc ". $pkg_svc->part_svc->svc. " services for pkgnum ". $self->pkgnum - if !$ignore_quantity && $part_svc->get('num_avail') <= 0 ; + if $num_avail <= 0; + } $self->SUPER::check; diff --git a/FS/FS/option_Common.pm b/FS/FS/option_Common.pm index c1dda22af..74adbede8 100644 --- a/FS/FS/option_Common.pm +++ b/FS/FS/option_Common.pm @@ -134,13 +134,7 @@ sub delete { my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; - - my $error = $self->SUPER::delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - + my $pkey = $self->primary_key; #my $option_table = $self->option_table; @@ -152,6 +146,12 @@ sub delete { } } + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; diff --git a/FS/FS/part_event/Action/Mixin/fee.pm b/FS/FS/part_event/Action/Mixin/fee.pm index 8eb86fa1d..a49782de0 100644 --- a/FS/FS/part_event/Action/Mixin/fee.pm +++ b/FS/FS/part_event/Action/Mixin/fee.pm @@ -2,6 +2,7 @@ package FS::part_event::Action::Mixin::fee; use strict; use base qw( FS::part_event::Action ); +use FS::Record qw( qsearch ); sub event_stage { 'pre-bill'; } @@ -15,16 +16,34 @@ sub option_fields { value_col => 'feepart', disable_empty => 1, }, - ); + ), + } sub default_weight { 10; } +sub hold_until_bill { 1 } + sub do_action { my( $self, $cust_object, $cust_event ) = @_; - die "no fee definition selected for event '".$self->event."'\n" - unless $self->option('feepart'); + my $feepart = $self->option('feepart') + or die "no fee definition selected for event '".$self->event."'\n"; + my $tablenum = $cust_object->get($cust_object->primary_key); + + # see if there's already a pending fee for this customer/invoice + my @existing = qsearch({ + table => 'cust_event_fee', + addl_from => 'JOIN cust_event USING (eventnum)', + hashref => { feepart => $feepart, + billpkgnum => '' }, + extra_sql => " AND tablenum = $tablenum", + }); + if (scalar @existing > 0) { + warn $self->event." event, object $tablenum: already scheduled\n" + if $FS::part_fee::DEBUG; + return; + } # mark the event so that the fee will be charged # the logic for calculating the fee amount is in FS::part_fee @@ -32,8 +51,9 @@ sub do_action { # FS::cust_bill_pkg my $cust_event_fee = FS::cust_event_fee->new({ 'eventnum' => $cust_event->eventnum, - 'feepart' => $self->option('feepart'), + 'feepart' => $feepart, 'billpkgnum' => '', + 'nextbill' => $self->hold_until_bill ? 'Y' : '', }); my $error = $cust_event_fee->insert; diff --git a/FS/FS/part_event/Action/cust_bill_fee.pm b/FS/FS/part_event/Action/cust_bill_fee.pm index fc185e439..5d962b131 100644 --- a/FS/FS/part_event/Action/cust_bill_fee.pm +++ b/FS/FS/part_event/Action/cust_bill_fee.pm @@ -9,4 +9,20 @@ sub eventtable_hashref { { 'cust_bill' => 1 }; } +sub option_fields { + ( + __PACKAGE__->SUPER::option_fields, + 'nextbill' => { label => 'Hold fee until the customer\'s next bill', + type => 'checkbox', + value => 'Y' + }, + ) +} + +# it makes sense for this to be optional for previous-invoice fees +sub hold_until_bill { + my $self = shift; + $self->option('nextbill'); +} + 1; diff --git a/FS/FS/part_event/Action/cust_fee.pm b/FS/FS/part_event/Action/cust_fee.pm index a6f1078e8..9373091ab 100644 --- a/FS/FS/part_event/Action/cust_fee.pm +++ b/FS/FS/part_event/Action/cust_fee.pm @@ -9,6 +9,8 @@ sub eventtable_hashref { { 'cust_main' => 1 }; } +sub hold_until_bill { 1 } + # Otherwise identical to cust_bill_fee. We only have a separate event # because it behaves differently as an invoice event than as a customer # event, and needs a different description. diff --git a/FS/FS/part_event/Action/fee.pm b/FS/FS/part_event/Action/fee.pm index c2b4673fa..f1d5891ac 100644 --- a/FS/FS/part_event/Action/fee.pm +++ b/FS/FS/part_event/Action/fee.pm @@ -1,5 +1,7 @@ package FS::part_event::Action::fee; +# DEPRECATED; will most likely be removed in 4.x + use strict; use base qw( FS::part_event::Action ); @@ -53,11 +55,9 @@ sub _calc_fee { my $part_pkg = FS::part_pkg->new({ taxclass => $self->option('taxclass') }); - my $error = $cust_main->_handle_taxes( - FS::part_pkg->new({ taxclass => ($self->option('taxclass') || '') }), - $taxlisthash, - $charge, - FS::cust_pkg->new({custnum => $cust_main->custnum}), + my $error = $cust_main->_handle_taxes( $taxlisthash, $charge, + location => $cust_main->ship_location, + part_item => $part_pkg, ); if ( $error ) { warn "error estimating taxes for breakage charge: custnum ".$cust_main->custnum."\n"; diff --git a/FS/FS/part_event/Action/pkg_fee.pm b/FS/FS/part_event/Action/pkg_fee.pm new file mode 100644 index 000000000..7e409a556 --- /dev/null +++ b/FS/FS/part_event/Action/pkg_fee.pm @@ -0,0 +1,16 @@ +package FS::part_event::Action::pkg_fee; + +use strict; +use base qw( FS::part_event::Action::Mixin::fee ); + +sub description { 'Charge a fee when this package is billed'; } + +sub eventtable_hashref { + { 'cust_pkg' => 1 }; +} + +sub hold_until_bill { 1 } + +# Functionally identical to cust_fee. + +1; diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 8e10ea712..9d261f02d 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -161,6 +161,10 @@ sub delete { 'link_table' => 'export_nas', 'target_table' => 'nas', 'params' => [], + ) || $self->process_m2m( + 'link_table' => 'export_svc', + 'target_table' => 'part_svc', + 'params' => [], ) || $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; diff --git a/FS/FS/part_export/send_email.pm b/FS/FS/part_export/send_email.pm index 1fcb828b7..41f04093e 100644 --- a/FS/FS/part_export/send_email.pm +++ b/FS/FS/part_export/send_email.pm @@ -6,7 +6,6 @@ use FS::part_export; use FS::Record qw(qsearch qsearchs); use FS::Conf; use FS::msg_template; -use FS::Misc qw(send_email); @ISA = qw(FS::part_export); diff --git a/FS/FS/part_fee.pm b/FS/FS/part_fee.pm index 67da245d8..ccf13513b 100644 --- a/FS/FS/part_fee.pm +++ b/FS/FS/part_fee.pm @@ -5,7 +5,7 @@ use base qw( FS::o2m_Common FS::Record ); use vars qw( $DEBUG ); use FS::Record qw( qsearch qsearchs ); -$DEBUG = 1; +$DEBUG = 0; =head1 NAME @@ -126,6 +126,9 @@ and replace methods. sub check { my $self = shift; + $self->set('amount', 0) unless $self->amount; + $self->set('percent', 0) unless $self->percent; + my $error = $self->ut_numbern('feepart') || $self->ut_textn('comment') @@ -138,28 +141,25 @@ sub check { || $self->ut_floatn('credit_weight') || $self->ut_agentnum_acl('agentnum', [ 'Edit global package definitions' ]) - || $self->ut_moneyn('amount') - || $self->ut_floatn('percent') + || $self->ut_money('amount') + || $self->ut_float('percent') || $self->ut_moneyn('minimum') || $self->ut_moneyn('maximum') || $self->ut_flag('limit_credit') - || $self->ut_enum('basis', [ '', 'charged', 'owed' ]) + || $self->ut_enum('basis', [ 'charged', 'owed', 'usage' ]) || $self->ut_enum('setuprecur', [ 'setup', 'recur' ]) ; return $error if $error; - return "For a percentage fee, the basis must be set" - if $self->get('percent') > 0 and $self->get('basis') eq ''; - - if ( ! $self->get('percent') and ! $self->get('limit_credit') ) { - # then it makes no sense to apply minimum/maximum - $self->set('minimum', ''); - $self->set('maximum', ''); - } if ( $self->get('limit_credit') ) { $self->set('maximum', ''); } + if ( $self->get('basis') eq 'usage' ) { + # to avoid confusion, don't also allow charging a percentage + $self->set('percent', 0); + } + $self->SUPER::check; } @@ -175,7 +175,7 @@ sub explanation { my $money_char = FS::Conf->new->config('money_char') || '$'; my $money = $money_char . '%.2f'; my $percent = '%.1f%%'; - my $string; + my $string = ''; if ( $self->amount > 0 ) { $string = sprintf($money, $self->amount); } @@ -190,7 +190,14 @@ sub explanation { } elsif ( $self->basis('owed') ) { $string .= 'unpaid invoice balance'; } + } elsif ( $self->basis eq 'usage' ) { + if ( $string ) { + $string .= " plus \n"; + } + # append per-class descriptions + $string .= join("\n", map { $_->explanation } $self->part_fee_usage); } + if ( $self->minimum or $self->maximum or $self->limit_credit ) { $string .= "\nbut"; if ( $self->minimum ) { @@ -219,11 +226,17 @@ representing the invoice line item for the fee, with linked L<FS::cust_bill_pkg_fee> record(s) allocating the fee to the invoice or its line items, as appropriate. +If the fee is going to be charged on the upcoming invoice (credit card +processing fees, postal invoice fees), INVOICE should be an uninserted +L<FS::cust_bill> object where the 'cust_bill_pkg' property is an arrayref +of the non-fee line items that will appear on the invoice. + =cut sub lineitem { my $self = shift; my $cust_bill = shift; + my $cust_main = $cust_bill->cust_main; my $amount = 0 + $self->get('amount'); my $total_base; # sum of base line items @@ -235,37 +248,72 @@ sub lineitem { warn "Calculating fee: ".$self->itemdesc." on ". ($cust_bill->invnum ? "invoice #".$cust_bill->invnum : "current invoice"). "\n" if $DEBUG; - if ( $self->percent > 0 and $self->basis ne '' ) { - warn $self->percent . "% of amount ".$self->basis.")\n" - if $DEBUG; - - # $total_base: the total charged/owed on the invoice - # %item_base: billpkgnum => fraction of base amount - if ( $cust_bill->invnum ) { - my $basis = $self->basis; - $total_base = $cust_bill->$basis; # "charged", "owed" + my $basis = $self->basis; + + # $total_base: the total charged/owed on the invoice + # %item_base: billpkgnum => fraction of base amount + if ( $cust_bill->invnum ) { - # calculate the fee on an already-inserted past invoice. This may have - # payments or credits, so if basis = owed, we need to consider those. + # calculate the fee on an already-inserted past invoice. This may have + # payments or credits, so if basis = owed, we need to consider those. + @items = $cust_bill->cust_bill_pkg; + if ( $basis ne 'usage' ) { + + $total_base = $cust_bill->$basis; # "charged", "owed" my $basis_sql = $basis.'_sql'; my $sql = 'SELECT ' . FS::cust_bill_pkg->$basis_sql . ' FROM cust_bill_pkg WHERE billpkgnum = ?'; - @items = $cust_bill->cust_bill_pkg; @item_base = map { FS::Record->scalar_sql($sql, $_->billpkgnum) } @items; - } else { - # the fee applies to _this_ invoice. It has no payments or credits, so - # "charged" and "owed" basis are both just the invoice amount, and - # the line item amounts (setup + recur) + + $amount += $total_base * $self->percent / 100; + } + } else { + # the fee applies to _this_ invoice. It has no payments or credits, so + # "charged" and "owed" basis are both just the invoice amount, and + # the line item amounts (setup + recur) + @items = @{ $cust_bill->get('cust_bill_pkg') }; + if ( $basis ne 'usage' ) { $total_base = $cust_bill->charged; - @items = @{ $cust_bill->get('cust_bill_pkg') }; @item_base = map { $_->setup + $_->recur } @items; - } - $amount += $total_base * $self->percent / 100; + $amount += $total_base * $self->percent / 100; + } } + if ( $basis eq 'usage' ) { + + my %part_fee_usage = map { $_->classnum => $_ } $self->part_fee_usage; + + foreach my $item (@items) { # cust_bill_pkg objects + my $usage_fee = 0; + $item->regularize_details; + my $details; + if ( $item->billpkgnum ) { + $details = [ + qsearch('cust_bill_pkg_detail', { billpkgnum => $item->billpkgnum }) + ]; + } else { + $details = $item->get('details') || []; + } + foreach my $d (@$details) { + # if there's a usage fee defined for this class... + next if $d->amount eq '' # not a real usage detail + or $d->amount == 0 # zero charge, probably shouldn't charge fee + ; + my $p = $part_fee_usage{$d->classnum} or next; + $usage_fee += ($d->amount * $p->percent / 100) + + $p->amount; + # we'd create detail records here if we were doing that + } + # bypass @item_base entirely + push @item_fee, $usage_fee; + $amount += $usage_fee; + } + + } # if $basis eq 'usage' + if ( $self->minimum ne '' and $amount < $self->minimum ) { warn "Applying mininum fee\n" if $DEBUG; $amount = $self->minimum; @@ -273,9 +321,10 @@ sub lineitem { my $maximum = $self->maximum; if ( $self->limit_credit ) { - my $balance = $cust_bill->cust_main; + my $balance = $cust_bill->cust_main->balance; if ( $balance >= 0 ) { - $maximum = 0; + warn "Credit balance is zero, so fee is zero" if $DEBUG; + return; # don't bother doing estimated tax, etc. } elsif ( -1 * $balance < $maximum ) { $maximum = -1 * $balance; } @@ -296,8 +345,36 @@ sub lineitem { setup => 0, recur => 0, }); + + if ( $maximum and $self->taxable ) { + warn "Estimating taxes on fee.\n" if $DEBUG; + # then we need to estimate tax to respect the maximum + # XXX currently doesn't work with external (tax_rate) taxes + # or batch taxes, obviously + my $taxlisthash = {}; + my $error = $cust_main->_handle_taxes( + $taxlisthash, + $cust_bill_pkg, + location => $cust_main->ship_location + ); + my $total_rate = 0; + # $taxlisthash: tax identifier => [ cust_main_county, cust_bill_pkg... ] + my @taxes = map { $_->[0] } values %$taxlisthash; + foreach (@taxes) { + $total_rate += $_->tax; + } + if ($total_rate > 0) { + my $max_cents = $maximum * 100; + my $charge_cents = sprintf('%0.f', $max_cents * 100/(100 + $total_rate)); + # the actual maximum that we can charge... + $maximum = sprintf('%.2f', $charge_cents / 100.00); + $amount = $maximum if $amount > $maximum; + } + } # if $maximum and $self->taxable + + # set the amount that we'll charge $cust_bill_pkg->set( $self->setuprecur, $amount ); - + if ( $self->classnum ) { my $pkg_category = $self->pkg_class->pkg_category; $cust_bill_pkg->set('section' => $pkg_category->categoryname) @@ -327,25 +404,25 @@ sub lineitem { } } } - # and add them to the cust_bill_pkg + } + if ( @item_fee ) { + # add allocation records to the cust_bill_pkg for (my $i = 0; $i < scalar(@items); $i++) { if ( $item_fee[$i] > 0 ) { push @cust_bill_pkg_fee, FS::cust_bill_pkg_fee->new({ cust_bill_pkg => $cust_bill_pkg, - base_invnum => $cust_bill->invnum, + base_invnum => $cust_bill->invnum, # may be null amount => $item_fee[$i], base_cust_bill_pkg => $items[$i], # late resolve }); } } - } else { # if !@item_base + } else { # if !@item_fee # then this isn't a proportional fee, so it just applies to the # entire invoice. - # (if it's the current invoice, $cust_bill->invnum is null and that - # will be fixed later) push @cust_bill_pkg_fee, FS::cust_bill_pkg_fee->new({ cust_bill_pkg => $cust_bill_pkg, - base_invnum => $cust_bill->invnum, + base_invnum => $cust_bill->invnum, # may be null amount => $amount, }); } diff --git a/FS/FS/part_fee_usage.pm b/FS/FS/part_fee_usage.pm new file mode 100644 index 000000000..a1b85ae9d --- /dev/null +++ b/FS/FS/part_fee_usage.pm @@ -0,0 +1,130 @@ +package FS::part_fee_usage; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); +use FS::Conf; + +=head1 NAME + +FS::part_fee_usage - Object methods for part_fee_usage records + +=head1 SYNOPSIS + + use FS::part_fee_usage; + + $record = new FS::part_fee_usage \%hash; + $record = new FS::part_fee_usage { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_fee_usage object is the part of a processing fee definition +(L<FS::part_fee>) that applies to a specific telephone usage class +(L<FS::usage_class>). FS::part_fee_usage inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item feepartusagenum - primary key + +=item feepart - foreign key to L<FS::part_pkg> + +=item classnum - foreign key to L<FS::usage_class> + +=item amount - fixed amount to charge per usage record + +=item percent - percentage of rated price to charge per usage record + +=back + +=head1 METHODS + +=over 4 + +=cut + +sub table { 'part_fee_usage'; } + +sub check { + my $self = shift; + + $self->set('amount', 0) unless ($self->amount || 0) > 0; + $self->set('percent', 0) unless ($self->percent || 0) > 0; + + my $error = + $self->ut_numbern('feepartusagenum') + || $self->ut_foreign_key('feepart', 'part_fee', 'feepart') + || $self->ut_foreign_key('classnum', 'usage_class', 'classnum') + || $self->ut_money('amount') + || $self->ut_float('percent') + ; + return $error if $error; + + $self->SUPER::check; +} + +# silently discard records with percent = 0 and amount = 0 + +sub insert { + my $self = shift; + if ( $self->amount > 0 or $self->percent > 0 ) { + return $self->SUPER::insert; + } + ''; +} + +sub replace { + my ($new, $old) = @_; + $old ||= $new->replace_old; + if ( $new->amount > 0 or $new->percent > 0 ) { + return $new->SUPER::replace($old); + } elsif ( $old->feepartusagenum ) { + return $old->delete; + } + ''; +} + +=item explanation + +Returns a string describing how this fee is calculated. + +=cut + +sub explanation { + my $self = shift; + my $string = ''; + my $money = (FS::Conf->new->config('money_char') || '$') . '%.2f'; + my $percent = '%.1f%%'; + if ( $self->amount > 0 ) { + $string = sprintf($money, $self->amount); + } + if ( $self->percent > 0 ) { + if ( $string ) { + $string .= ' plus '; + } + $string .= sprintf($percent, $self->percent); + $string .= ' of the rated charge'; + } + $string .= ' per '. $self->usage_class->classname . ' call'; + + return $string; +} + +=back + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/pay_batch/nacha.pm b/FS/FS/pay_batch/nacha.pm index 0662c3fd5..d6786e035 100644 --- a/FS/FS/pay_batch/nacha.pm +++ b/FS/FS/pay_batch/nacha.pm @@ -185,7 +185,7 @@ $DEBUG = 0; # 200 mixed debits&credits) sprintf('%06d', $batchcount). #Entry / Addenda Count $entry_hash. - sprintf('%012d', $batchtotal * 100). #Debit total + sprintf('%012.0f', $batchtotal * 100). #Debit total '000000000000'. #Credit total $origin. #Company Identification (Immediate Origin) (' 'x19). #Message Authentication Code (19 char blank) @@ -202,7 +202,7 @@ $DEBUG = 0; sprintf('%06d', $batchcount + 4). #num of physical blocks on the file..? sprintf('%08d', $batchcount). #total # of entry detail and addenda $entry_hash. - sprintf('%012d', $batchtotal * 100). #Debit total + sprintf('%012.0f', $batchtotal * 100). #Debit total '000000000000'. #Credit total ( ' 'x39 ) #Reserved / blank diff --git a/FS/FS/quotation_pkg.pm b/FS/FS/quotation_pkg.pm index c73f857ce..c98e0f98b 100644 --- a/FS/FS/quotation_pkg.pm +++ b/FS/FS/quotation_pkg.pm @@ -2,6 +2,8 @@ package FS::quotation_pkg; use base qw( FS::TemplateItem_Mixin FS::Record ); use strict; +use FS::Record qw( qsearchs ); #qsearch +use FS::part_pkg; use FS::quotation_pkg_discount; #so its loaded when TemplateItem_Mixin needs it =head1 NAME @@ -126,6 +128,13 @@ sub check { $self->SUPER::check; } +#it looks redundant with a v4.x+ auto-generated method, but need to override +# FS::TemplateItem_Mixin's version +sub part_pkg { + my $self = shift; + qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart } ); +} + sub desc { my $self = shift; $self->part_pkg->pkg; diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 3d37677fb..451600432 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -371,7 +371,7 @@ sub passtype_name { $tax_passtypes{$self->passtype}; } -=item taxline TAXABLES, [ OPTIONSHASH ] +=item taxline TAXABLES Returns a listref of a name and an amount of tax calculated for the list of packages/amounts referenced by TAXABLES. If an error occurs, a message @@ -381,13 +381,13 @@ is returned as a scalar. sub taxline { my $self = shift; + # this used to accept a hash of options but none of them did anything + # so it's been removed. my $taxables; - my %opt = (); if (ref($_[0]) eq 'ARRAY') { $taxables = shift; - %opt = @_; }else{ $taxables = [ @_ ]; #exemptions would be broken in this case diff --git a/FS/MANIFEST b/FS/MANIFEST index 129ee64df..637401a8f 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -24,6 +24,7 @@ bin/freeside-sqlradius-reset bin/freeside-sqlradius-seconds bin/freeside-torrus-srvderive FS.pm +FS/API.pm FS/AccessRight.pm FS/AuthCookieHandler.pm FS/AuthCookieHandler24.pm @@ -46,6 +47,7 @@ FS/Cron/backup.pm FS/Cron/bill.pm FS/Cron/vacuum.pm FS/Daemon.pm +FS/Daemon/Preforking.pm FS/Misc.pm FS/Record.pm FS/Report.pm @@ -766,3 +768,5 @@ FS/cust_bill_pkg_fee.pm t/cust_bill_pkg_fee.t FS/part_fee_msgcat.pm t/part_fee_msgcat.t +FS/part_fee_usage.pm +FS/part_fee_usage.t diff --git a/FS/bin/freeside-selfservice-xmlrpcd b/FS/bin/freeside-selfservice-xmlrpcd index 423d2c30b..6413b2b8a 100755 --- a/FS/bin/freeside-selfservice-xmlrpcd +++ b/FS/bin/freeside-selfservice-xmlrpcd @@ -1,299 +1,40 @@ #!/usr/bin/perl -# -# based on http://www.perlmonks.org/?node_id=582781 by Justin Hawkins -# and http://poe.perl.org/?POE_Cookbook/Web_Server_With_Forking - -### -# modules and constants and variables, oh my -### - -use warnings; -use strict; -use constant DEBUG => 1; # Enable much runtime information. -use constant MAX_PROCESSES => 10; # Total server process count. -use constant SERVER_PORT => 8080; # Server port. -use constant TESTING_CHURN => 0; # Randomly test process respawning. - -use POE 1.2; # Base features. -use POE::Filter::HTTPD; # For serving HTTP content. -use POE::Wheel::ReadWrite; # For socket I/O. -use POE::Wheel::SocketFactory; # For serving socket connections. +use FS::Daemon::Preforking qw( freeside_init1 freeside_init2 daemon_run ); use XMLRPC::Transport::HTTP; #SOAP::Transport::HTTP; use XMLRPC::Lite; # for XMLRPC::Serializer -use FS::Daemon qw( daemonize1 drop_root logfile daemonize2 ); -use FS::UID qw( adminsuidsetup forksuidsetup dbh ); use FS::Conf; use FS::ClientAPI qw( load_clientapi_modules ); use FS::ClientAPI_XMLRPC; #FS::SelfService::XMLRPC; -use FS::TicketSystem; - -#freeside -my $FREESIDE_LOG = "%%%FREESIDE_LOG%%%"; -my $FREESIDE_LOCK = "%%%FREESIDE_LOCK%%%"; -my $lock_file = "$FREESIDE_LOCK/selfservice-xmlrpcd.writelock"; #freeside xmlrpc.cgi my %typelookup = ( #not utf-8 safe# base64 => [10, sub {$_[0] =~ /[^\x09\x0a\x0d\x20-\x7f]/}, 'as_base64'], dateTime => [35, sub {$_[0] =~ /^\d{8}T\d\d:\d\d:\d\d$/}, 'as_dateTime'], - string => [40, sub {1}, 'as_string'], + string => [40, sub {1}, 'as_string'], ); -### -# freeside init -### +use constant ME => 'selfservice-xmlrpcd'; -my $user = shift or die &usage; - -$FS::Daemon::NOSIG = 1; -$FS::Daemon::PID_NEWSTYLE = 1; -daemonize1('selfservice-xmlrpcd'); - -POE::Kernel->has_forked(); #daemonize forks... - -drop_root(); +# -adminsuidsetup($user); +freeside_init1(ME); load_clientapi_modules; -logfile("$FREESIDE_LOG/selfservice-xmlrpcd.log"); - -daemonize2(); +freeside_init2(ME); FS::ClientAPI::Signup::clear_cache(); my $conf = new FS::Conf; - die "not running; selfservice-xmlrpc conf option is off\n" unless $conf->exists('selfservice-xmlrpc'); -#parent doesn't need to hold a DB connection open -dbh->disconnect; -undef $FS::UID::dbh; - -### -# the main loop -### - -server_spawn(MAX_PROCESSES); -POE::Kernel->run(); -exit; - -### -# the subroutines -### - -### Spawn the main server. This will run as the parent process. - -sub server_spawn { - my ($max_processes) = @_; - - POE::Session->create( - inline_states => { - _start => \&server_start, - _stop => \&server_stop, - do_fork => \&server_do_fork, - got_error => \&server_got_error, - got_sig_int => \&server_got_sig_int, - got_sig_child => \&server_got_sig_child, - got_connection => \&server_got_connection, - _child => sub { undef }, - }, - heap => { max_processes => MAX_PROCESSES }, - ); -} - -### The main server session has started. Set up the server socket and -### bookkeeping information, then fork the initial child processes. - -sub server_start { - my ( $kernel, $heap ) = @_[ KERNEL, HEAP ]; - - $heap->{server} = POE::Wheel::SocketFactory->new - ( BindPort => SERVER_PORT, - SuccessEvent => "got_connection", - FailureEvent => "got_error", - Reuse => "yes", - ); - - $kernel->sig( INT => "got_sig_int" ); - $kernel->sig( TERM => "got_sig_int" ); #huh - - $heap->{children} = {}; - $heap->{is_a_child} = 0; - - warn "Server $$ has begun listening on port ", SERVER_PORT, "\n"; - - $kernel->yield("do_fork"); -} - -### The server session has shut down. If this process has any -### children, signal them to shutdown too. - -sub server_stop { - my $heap = $_[HEAP]; - DEBUG and warn "Server $$ stopped.\n"; - - if ( my @children = keys %{ $heap->{children} } ) { - DEBUG and warn "Server $$ is signaling children to stop.\n"; - kill INT => @children; - } -} - -### The server session has encountered an error. Shut it down. - -sub server_got_error { - my ( $heap, $syscall, $errno, $error ) = @_[ HEAP, ARG0 .. ARG2 ]; - warn( "Server $$ got $syscall error $errno: $error\n", - "Server $$ is shutting down.\n", - ); - delete $heap->{server}; -} - -### The server has a need to fork off more children. Only honor that -### request form the parent, otherwise we would surely "forkbomb". -### Fork off as many child processes as we need. - -sub server_do_fork { - my ( $kernel, $heap ) = @_[ KERNEL, HEAP ]; - - return if $heap->{is_a_child}; - - #my $current_children = keys %{ $heap->{children} }; - #for ( $current_children + 2 .. $heap->{max_processes} ) { - while (scalar(keys %{$heap->{children}}) < $heap->{max_processes}) { - - DEBUG and warn "Server $$ is attempting to fork.\n"; - - my $pid = fork(); - - unless ( defined($pid) ) { - DEBUG and - warn( "Server $$ fork failed: $!\n", - "Server $$ will retry fork shortly.\n", - ); - $kernel->delay( do_fork => 1 ); - return; - } - - # Parent. Add the child process to its list. - if ($pid) { - $heap->{children}->{$pid} = 1; - $kernel->sig_child($pid, "got_sig_child"); - next; - } - - # Child. Clear the child process list. - $kernel->has_forked(); - DEBUG and warn "Server $$ forked successfully.\n"; - $heap->{is_a_child} = 1; - $heap->{children} = {}; - - #freeside db connection, etc. - forksuidsetup($user); - - #why isn't this needed ala freeside-selfservice-server?? - #FS::TicketSystem->init(); - - return; - } -} - -### The server session received SIGINT. Don't handle the signal, -### which in turn will trigger the process to exit gracefully. - -sub server_got_sig_int { - my ( $kernel, $heap ) = @_[ KERNEL, HEAP ]; - DEBUG and warn "Server $$ received SIGINT/TERM.\n"; - - if ( my @children = keys %{ $heap->{children} } ) { - DEBUG and warn "Server $$ is signaling children to stop.\n"; - kill INT => @children; - } - - delete $heap->{server}; - $kernel->sig_handled(); -} - -### The server session received a SIGCHLD, indicating that some child -### server has gone away. Remove the child's process ID from our -### list, and trigger more fork() calls to spawn new children. - -sub server_got_sig_child { - my ( $kernel, $heap, $child_pid ) = @_[ KERNEL, HEAP, ARG1 ]; - - return unless delete $heap->{children}->{$child_pid}; - - DEBUG and warn "Server $$ reaped child $child_pid.\n"; - $kernel->yield("do_fork") if exists $_[HEAP]->{server}; -} - -### The server session received a connection request. Spawn off a -### client handler session to parse the request and respond to it. - -sub server_got_connection { - my ( $heap, $socket, $peer_addr, $peer_port ) = @_[ HEAP, ARG0, ARG1, ARG2 ]; - - DEBUG and warn "Server $$ received a connection.\n"; - - POE::Session->create( - inline_states => { - _start => \&client_start, - _stop => \&client_stop, - got_request => \&client_got_request, - got_flush => \&client_flushed_request, - got_error => \&client_got_error, - _parent => sub { 0 }, - }, - heap => { - socket => $socket, - peer_addr => $peer_addr, - peer_port => $peer_port, - }, - ); - - # Gracefully exit if testing process churn. - delete $heap->{server} - if TESTING_CHURN and $heap->{is_a_child} and ( rand() < 0.1 ); -} - -### The client handler has started. Wrap its socket in a ReadWrite -### wheel to begin interacting with it. - -sub client_start { - my $heap = $_[HEAP]; - - $heap->{client} = POE::Wheel::ReadWrite->new - ( Handle => $heap->{socket}, - Filter => POE::Filter::HTTPD->new(), - InputEvent => "got_request", - ErrorEvent => "got_error", - FlushedEvent => "got_flush", - ); - - DEBUG and warn "Client handler $$/", $_[SESSION]->ID, " started.\n"; -} - -### The client handler has stopped. Log that fact. - -sub client_stop { - DEBUG and warn "Client handler $$/", $_[SESSION]->ID, " stopped.\n"; -} - -### The client handler has received a request. If it's an -### HTTP::Response object, it means some error has occurred while -### parsing the request. Send that back and return immediately. -### Otherwise parse and process the request, generating and sending an -### HTTP::Response object in response. - -sub client_got_request { - my ( $heap, $request ) = @_[ HEAP, ARG0 ]; - - forksuidsetup($user) unless dbh && dbh->ping; +daemon_run( 'port' => 8080, 'handle_request' => + sub { + my $request = shift; my $serializer = new XMLRPC::Serializer(typelookup => \%typelookup); @@ -303,53 +44,11 @@ sub client_got_request { -> dispatch_to('FS::ClientAPI_XMLRPC') -> serializer($serializer); - DEBUG and - warn "Client handler $$/", $_[SESSION]->ID, " is handling a request.\n"; - - if ( $request->isa("HTTP::Response") ) { - $heap->{client}->put($request); - return; - } - $soap->request($request); $soap->handle; - my $response = $soap->response; - - $heap->{client}->put($response); -} - -### The client handler received an error. Stop the ReadWrite wheel, -### which also closes the socket. - -sub client_got_error { - my ( $heap, $operation, $errnum, $errstr ) = @_[ HEAP, ARG0, ARG1, ARG2 ]; - DEBUG and - warn( "Client handler $$/", $_[SESSION]->ID, - " got $operation error $errnum: $errstr\n", - "Client handler $$/", $_[SESSION]->ID, " is shutting down.\n" - ); - delete $heap->{client}; -} -### The client handler has flushed its response to the socket. We're -### done with the client connection, so stop the ReadWrite wheel. - -sub client_flushed_request { - my $heap = $_[HEAP]; - DEBUG and - warn( "Client handler $$/", $_[SESSION]->ID, - " flushed its response.\n", - "Client handler $$/", $_[SESSION]->ID, " is shutting down.\n" - ); - delete $heap->{client}; -} - -sub usage { - die "Usage:\n\n freeside-selfservice-xmlrpcd user\n"; -} - -### -# the end -### + return $soap->response; + } +); 1; diff --git a/FS/bin/freeside-xmlrpcd b/FS/bin/freeside-xmlrpcd new file mode 100644 index 000000000..e22d0f063 --- /dev/null +++ b/FS/bin/freeside-xmlrpcd @@ -0,0 +1,58 @@ +#!/usr/bin/perl + +use FS::Daemon::Preforking qw( freeside_init1 freeside_init2 daemon_run ); + +use FS::XMLRPC_Lite; #XMLRPC::Lite for XMLRPC::Serializer + #and XMLRPC::Transport::HTTP + +use FS::Conf; + +##use FS::ClientAPI qw( load_clientapi_modules ); +##use FS::ClientAPI_XMLRPC; #FS::SelfService::XMLRPC; +use FS::API; + +#freeside xmlrpc.cgi +my %typelookup = ( +#not utf-8 safe# base64 => [10, sub {$_[0] =~ /[^\x09\x0a\x0d\x20-\x7f]/}, 'as_base64'], + dateTime => [35, sub {$_[0] =~ /^\d{8}T\d\d:\d\d:\d\d$/}, 'as_dateTime'], + string => [40, sub {1}, 'as_string'], +); + +use constant ME => 'xmlrpcd'; + +# + +freeside_init1(ME); + +#load_clientapi_modules; + +freeside_init2(ME); + +#FS::ClientAPI::Signup::clear_cache(); + +my $conf = new FS::Conf; +die "not running; xmlrpc_api conf option is off\n" + unless $conf->exists('xmlrpc_api'); +die "not running; api_shared_secret conf option is not set\n" + unless $conf->config('api_shared_secret'); + +daemon_run( 'port' => 8008, 'handle_request' => + sub { + my $request = shift; + + my $serializer = new XMLRPC::Serializer(typelookup => \%typelookup); + + #my $soap = SOAP::Transport::HTTP::Server + my $soap = XMLRPC::Transport::HTTP::Server + -> new + -> dispatch_to('FS::API') + -> serializer($serializer); + + $soap->request($request); + $soap->handle; + + return $soap->response; + } +); + +1; diff --git a/FS/t/part_fee_usage.t b/FS/t/part_fee_usage.t new file mode 100644 index 000000000..cb7fb220e --- /dev/null +++ b/FS/t/part_fee_usage.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_fee_usage; +$loaded=1; +print "ok 1\n"; |