From: ivan Date: Wed, 1 Aug 2007 22:26:52 +0000 (+0000) Subject: event refactor, landing on HEAD! X-Git-Tag: TRIXBOX_2_6~438 X-Git-Url: http://git.freeside.biz/gitweb/?a=commitdiff_plain;h=eb4ff7f73c5d4bdf74a3472448b5a195598ff4cd;p=freeside.git event refactor, landing on HEAD! --- diff --git a/ANNOUNCE.1.5 b/ANNOUNCE.1.5 deleted file mode 100644 index 36c78e102..000000000 --- a/ANNOUNCE.1.5 +++ /dev/null @@ -1,54 +0,0 @@ -- broadband (dsl/wireless) tracking, etc etc -- Extended description on invoice for time/data charges -- Multiple, named taxes -- */*FIX -- extended reported and graphing -- integrated RT ticketing system -- one-time payments (in signup server too). DCRD and DCHK on-demand payment types -- credit report -- reseller interface - -1.5.0pre6: -- RADIUS session viewing -- Major updates for reseller interface -- Credit card and ACH refunds (w/supported processor module) -- Proper email payment receipts (not invoice copies) -- modular price plans, rewrote package add/edit page -- fixed up tax report - should be correct for edge cases with named taxes, - tax classes, etc. -- Documentation updates - -1.5.7: -- version numbering change, now even/odd like Perl or Linux -- fix bug that could cause mis-billing on upgrades! (new installs ok) -- updated install documentation -- historical late notice viewing in web interface -- VoIP billing for CDRs from RADIUS -- promotional codes for signup -- lots of RT integration, integrated RT upgraded to 3.2.2, preliminary RT - add-on docs -- one-time referral credits -- invoices now use history records (don't lose details) -- option to credit for remaining service upon package cancel/change - (peter bowen) -- one-time registration codes -- "selfservice_server-session_module" config value can be set to - "Cache::FileCache" on FreeBSD or elsewhere IPC::ShareLite has trouble. -- package changes don't re-charge setup fee -- per-agent payment and credit reports -- CSV and Excel export of most reports, others to be migrated to new report template -- prepaid card support updated: now includes a web generator, agent-specific - prepaid cards, and creates *payments*, not credits -- preliminary setup for Slony-1 PostgreSQL replication -- reformatted latex invoice templates w/Text::Template (khoff) and removed - some useless fields (quantity/unit price) -- simplified upgrade instructions -- add export to vpopmail SQL -- html invoices -- big self-service updates (recharge w/prepaid card, change info, more) -- significant freeside-daily speedup - -notyet (1.5.8?): -- account merging UI in exports (for example, to consolidate passwd files from - multiple servers) - diff --git a/CREDITS b/CREDITS index b3ae26512..768a27c44 100644 --- a/CREDITS +++ b/CREDITS @@ -171,5 +171,8 @@ by Erik Arvidsson, licensed under the terms of the GNU GPL. Contains public domain artwork from openclipart.org by mimooh and other authors. +Contains FCKeditor by Frederico Caldeira Knabben, licensed under the terms of +the GNU GPL. + Everything else is my (Ivan Kohler ) fault. diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index de3423a49..fb7e538c2 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -12,6 +12,14 @@ FS::AccessRight - Access control rights. use FS::AccessRight; + my @rights = FS::AccessRight->rights; + + #my %rights = FS::AccessRight->rights_categorized; + tie my %rights, 'Tie::IxHash', FS::AccessRight->rights_categorized; + foreach my $category ( keys %rights ) { + my @category_rights = @{ $rights{$category} }; + } + =head1 DESCRIPTION Access control rights - Permission to perform specific actions that can be @@ -75,131 +83,202 @@ assigned to users and/or groups. # ##turn it into a more hash-like structure, but ordered via IxHash -#well, this is what we have for now. could be ordered better, could be lots of -# things better, but this ACL system does 99% of what folks need and the UI -# isn't *that* bad -# -# okay, well it *really* needs some catgorization in the UI. badly. -@rights = ( - -## -# basic customer rights -## - 'New customer', - 'View customer', - #'View Customer | View tickets', - 'Edit customer', - 'Cancel customer', - 'Complimentary customer', #aka users-allow_comp - 'Delete customer', #aka. deletecustomers #Enable customer deletions. Be very careful! Deleting a customer will remove all traces that this customer ever existed! It should probably only be used when auditing a legacy database. Normally, you cancel all of a customers' packages if they cancel service. - 'Add customer note', #NEW - 'Edit customer note', #NEW - -### -# customer package rights -### - 'View customer packages', #NEW - 'Order customer package', - 'One-time charge', - 'Change customer package', - 'Bulk change customer packages', - 'Edit customer package dates', - 'Customize customer package', - 'Suspend customer package', - 'Suspend customer package later', - 'Unsuspend customer package', - 'Cancel customer package immediately', - 'Cancel customer package later', - 'Add on-the-fly cancel reason', #NEW - 'Add on-the-fly suspend reason', #NEW - -### -# customer service rights -### - 'Edit usage', #NEW - 'Edit home dir', #NEW - 'Edit www config', #NEW - 'View customer services', #NEW - 'Provision customer service', - 'Recharge customer service', #NEW - 'Unprovision customer service', - - 'View/link unlinked services', #not agent-virtualizable without more work - -### -# customer invoice/financial info rights -### - 'View invoices', - 'View customer tax exemptions', #yow - 'View customer batched payments', #NEW - -### -# customer payment rights -### - 'Post payment', - 'Post payment batch', - 'Unapply payment', #aka. unapplypayments Enable "unapplication" of unclosed payments. - 'Process payment', - 'Refund payment', - - 'Delete payment', #aka. deletepayments - Enable deletion of unclosed payments. Be very careful! Only delete payments that were data-entry errors, not adjustments. Optionally specify one or more comma-separated email addresses to be notified when a payment is deleted. - - 'Delete refund', #NEW - -### -# customer credit rights -### - 'Post credit', - #'Apply credit', - 'Unapply credit', #aka unapplycredits Enable "unapplication" of unclosed credits. - 'Delete credit', #aka. deletecredits Enable deletion of unclosed credits. Be very careful! Only delete credits that were data-entry errors, not adjustments. Optionally specify one or more comma-separated email addresses to be notified when a credit is deleted. - -### -# customer voiding rights.. -### - 'Credit card void', #aka. cc-void #Enable local-only voiding of echeck payments in addition to refunds against the payment gateway - 'Echeck void', #aka. echeck-void #Enable local-only voiding of echeck payments in addition to refunds against the payment gateway - 'Regular void', - 'Unvoid', #aka. unvoid #Enable unvoiding of voided payments - -### -# report/listing rights... -### - 'List customers', - 'List zip codes', #NEW - 'List invoices', - 'List packages', - 'List services', - - 'List rating data', # 'Usage reports', - 'Billing event reports', - 'Financial reports', - -### -# misc rights -### - 'Job queue', # these are not currently agent-virtualized - 'Process batches', # NEW - 'Reprocess batches', # NEW - 'Import', # - 'Export', # - -### -# misc misc rights -### - 'Raw SQL', #NEW - -### -# setup/config rights -### - 'Edit advertising sources', - 'Edit global advertising sources', - - 'Configuration', #most of the rest of the configuraiton is not - # agent-virtualized -); - -sub rights { - @rights; +#well, this is what we have for now. getting better. +tie my %rights, 'Tie::IxHash', + + ### + # basic customer rights + ### + 'Customer rights' => [ + 'New customer', + 'View customer', + #'View Customer | View tickets', + 'Edit customer', + 'Cancel customer', + 'Complimentary customer', #aka users-allow_comp + { rightname=>'Delete customer', desc=>"Enable customer deletions. Be very careful! Deleting a customer will remove all traces that this customer ever existed! It should probably only be used when auditing a legacy database. Normally, you cancel all of a customer's packages if they cancel service." }, #aka. deletecustomers + 'Add customer note', #NEW + 'Edit customer note', #NEW + ], + + ### + # customer package rights + ### + 'Customer package rights' => [ + 'View customer packages', #NEW + 'Order customer package', + 'One-time charge', + 'Change customer package', + 'Bulk change customer packages', + 'Edit customer package dates', + 'Customize customer package', + 'Suspend customer package', + 'Suspend customer package later', + 'Unsuspend customer package', + 'Cancel customer package immediately', + 'Cancel customer package later', + 'Add on-the-fly cancel reason', #NEW + 'Add on-the-fly suspend reason', #NEW + ], + + ### + # customer service rights + ### + 'Customer service rights' => [ + 'Edit usage', #NEW + 'Edit home dir', #NEW + 'Edit www config', #NEW + 'View customer services', #NEW + 'Provision customer service', + 'Recharge customer service', #NEW + 'Unprovision customer service', + + { rightname=>'View/link unlinked services', global=>1 }, #not agent-virtualizable without more work + ], + + ### + # customer invoice/financial info rights + ### + 'Customer invoice / financial info rights' => [ + 'View invoices', + 'View customer tax exemptions', #yow + 'View customer batched payments', #NEW + 'View customer billing events', #NEW + ], + + ### + # customer payment rights + ### + 'Customer payment rights' => [ + 'Post payment', + 'Post payment batch', + { rightname=>'Unapply payment', desc=>'Enable "unapplication" of unclosed payments from specific invoices.' }, #aka. unapplypayments + 'Process payment', + 'Refund payment', + + { rightname=>'Delete payment', desc=>'Enable deletion of unclosed payments. Be very careful! Only delete payments that were data-entry errors, not adjustments.' }, #aka. deletepayments Optionally specify one or more comma-separated email addresses to be notified when a payment is deleted. + + ], + + ### + # customer credit rights + ### + 'Customer credit and refund rights' => [ + 'Post credit', + #'Apply credit', + { rightname=>'Unapply credit', desc=>'Enable "unapplication" of unclosed credits.' }, #aka unapplycredits + { rightname=>'Delete credit', desc=>'Enable deletion of unclosed credits. Be very careful! Only delete credits that were data-entry errors, not adjustments.' }, #aka. deletecredits Optionally specify one or more comma-separated email addresses to be notified when a credit is deleted. + 'Delete refund', #NEW + ], + + ### + # customer voiding rights.. + ### + 'Customer void rights' => [ + { rightname=>'Credit card void', desc=>'Enable local-only voiding of echeck payments in addition to refunds against the payment gateway.' }, #aka. cc-void + { rightname=>'Echeck void', desc=>'Enable local-only voiding of echeck payments in addition to refunds against the payment gateway.' }, #aka. echeck-void + 'Regular void', + { rightname=>'Unvoid', desc=>'Enable unvoiding of voided payments' }, #aka. unvoid + + + ], + + ### + # report/listing rights... + ### + 'Reprting/listing rights' => [ + 'List customers', + 'List zip codes', #NEW + 'List invoices', + 'List packages', + 'List services', + + { rightname=> 'List rating data', desc=>'Usage reports', global=>1 }, + 'Billing event reports', + 'Financial reports', + ], + + ### + # misc rights + ### + 'Miscellaneous rights' => [ + { rightname=>'Job queue', global=>1 }, + { rightname=>'Process batches', global=>1 }, + { rightname=>'Reprocess batches', global=>1 }, + { rightname=>'Import', global=>1 }, #some of these are ag-virt'ed now? give em their own ACLs + { rightname=>'Export', global=>1 }, + #], + # + ### + # misc misc rights + ### + #'Database access rights' => [ + { rightname=>'Raw SQL', global=>1 }, #NEW + ], + + ### + # setup/config rights + ### + 'Configuration rights' => [ + 'Edit advertising sources', + { rightname=>'Edit global advertising sources', global=>1 }, + + 'Edit billing events', + { rightname=>'Edit global billing events', global=>1 }, + + { rightname=>'Configuration', global=>1 }, #most of the rest of the configuraiton is not agent-virtualized + ], + +; + +=head1 CLASS METHODS + +=over 4 + +=item rights + +Returns a list of right names. + +=cut + + sub rights { + #my $class = shift; + map { ref($_) ? $_->{'rightname'} : $_ } map @{ $rights{$_} }, keys %rights; + } + +=item rights_info + +Returns a list of key-value pairs suitable for assigning to a hash. Keys are +category names and values are list references of rights. Each element of the +list reference scalar right name or a hashref with the following keys: + +=over 4 + +=item rightname - Right name + +=item desc - Extended right description + +=item global - Global flag, indicates that this access right provides access to global data which is shared among all agents. + +=back + +=cut + +sub rights_info { + %rights; } +=back + +=head1 BUGS + +Damn those infernal six-legged creatures! + +=head1 SEE ALSO + +L, L, L + +=cut + +1; + diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index f797f275c..7f64058b8 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -171,6 +171,30 @@ sub config_orbase { } } +=item invoice_templatenames + +Returns all possible invoice template names. + +=cut + +sub invoice_templatenames { + my( $self ) = @_; + + my %templatenames = (); + foreach my $item ( $self->config_items ) { + foreach my $base ( @base_items ) { + my( $main, $ext) = split(/\./, $base); + $ext = ".$ext" if $ext; + if ( $item->key =~ /^${main}_(.+)$ext$/ ) { + $templatenames{$1}++; + } + } + } + + sort keys %templatenames; + +} + =item touch KEY [ AGENT ]; Creates the specified configuration key if it does not exist. @@ -483,6 +507,21 @@ httemplate/docs/config.html "Solo", ); +@base_items = qw ( + invoice_template + invoice_latex + invoice_latexreturnaddress + invoice_latexfooter + invoice_latexsmallfooter + invoice_latexnotes + invoice_html + invoice_htmlreturnaddress + invoice_htmlfooter + invoice_htmlnotes + logo.png + logo.eps + ); + @base_items = qw ( invoice_template invoice_latex @@ -1911,6 +1950,25 @@ httemplate/docs/config.html 'select_enum' => \@card_types, }, + { + 'key' => 'disable-fuzzy', + 'section' => 'UI', + 'description' => 'Disable fuzzy searching. Speeds up searching for large sites, but only shows exact matches.', + 'type' => 'checkbox', + }, + + { 'key' => 'pkg_referral', + 'section' => '', + 'description' => 'Enable package-specific advertising sources.', + 'type' => 'checkbox', + }, + + { 'key' => 'pkg_referral-multiple', + 'section' => '', + 'description' => 'In addition, allow multiple advertising sources to be associated with a single package.', + 'type' => 'checkbox', + }, + { 'key' => 'dashboard-toplist', 'section' => 'UI', diff --git a/FS/FS/Cron/bill.pm b/FS/FS/Cron/bill.pm index 3ba1b53d4..1576edcb4 100644 --- a/FS/FS/Cron/bill.pm +++ b/FS/FS/Cron/bill.pm @@ -6,6 +6,8 @@ use Exporter; use Date::Parse; use FS::Record qw(qsearch qsearchs); use FS::cust_main; +use FS::part_event; +use FS::part_event_condition; @ISA = qw( Exporter ); @EXPORT_OK = qw ( bill ); @@ -14,7 +16,11 @@ sub bill { my %opt = @_; + my $check_freq = $opt{'check_freq'} || '1d'; + $FS::cust_main::DEBUG = 1 if $opt{'v'}; + $FS::cust_main::DEBUG = $opt{'l'} if $opt{'l'}; + #$FS::cust_event::DEBUG = $opt{'l'} if $opt{'l'}; my %search = (); $search{'payby'} = $opt{'p'} if $opt{'p'}; @@ -38,91 +44,76 @@ sub bill { ) ) END - - # or - my $where_bill_event = <<"END"; - 0 < ( select count(*) from cust_bill - where cust_main.custnum = cust_bill.custnum - and 0 < charged - - coalesce( - ( select sum(amount) from cust_bill_pay - where cust_bill.invnum = cust_bill_pay.invnum ) - ,0 - ) - - coalesce( - ( select sum(amount) from cust_credit_bill - where cust_bill.invnum = cust_credit_bill.invnum ) - ,0 - ) - and 0 < ( select count(*) from part_bill_event - where payby = cust_main.payby - and ( disabled is null or disabled = '' ) - and seconds <= $time - cust_bill._date - and 0 = ( select count(*) from cust_bill_event - where cust_bill.invnum = cust_bill_event.invnum - and part_bill_event.eventpart = cust_bill_event.eventpart - and status = 'done' - ) - - ) - ) -END - - my $extra_sql = ( scalar(%search) ? ' AND ' : ' WHERE ' ). "( $where_pkg OR $where_bill_event )"; - + + my $where_event = join(' OR ', map { + my $eventtable = $_; + + my $join = FS::part_event_condition->join_conditions_sql( $eventtable ); + my $where = FS::part_event_condition->where_conditions_sql( $eventtable, + 'time'=>$time, + ); + + my $are_part_event = + "0 < ( SELECT COUNT(*) FROM part_event $join + WHERE check_freq = '$check_freq' + AND eventtable = '$eventtable' + AND ( disabled = '' OR disabled IS NULL ) + AND $where + ) + "; + + if ( $eventtable eq 'cust_main' ) { + $are_part_event; + } else { + "0 < ( SELECT COUNT(*) FROM $eventtable + WHERE cust_main.custnum = $eventtable.custnum + AND $are_part_event + ) + "; + } + + } FS::part_event->eventtables); + + my $extra_sql = ( scalar(%search) ? ' AND ' : ' WHERE ' ). + "( $where_pkg OR $where_event )"; + my @cust_main; if ( @ARGV ) { @cust_main = map { qsearchs('cust_main', { custnum => $_, %search } ) } @ARGV } else { - @cust_main = qsearch('cust_main', \%search, '', $extra_sql ); + + warn "searching for customers:\n". + join("\n", map " $_ => ".$search{$_}, keys %search). "\n". + " $extra_sql\n" + if $opt{'v'} || $opt{'l'}; + + @cust_main = qsearch({ + 'table' => 'cust_main', + 'hashref' => \%search, + 'extra_sql' => $extra_sql, + }); + } - ; my($cust_main,%saw); foreach $cust_main ( @cust_main ) { - my $custnum = $cust_main->custnum; - - # $^T not $time because -d is for pre-printing invoices - foreach my $cust_pkg ( - grep { $_->expire && $_->expire <= $^T } $cust_main->ncancelled_pkgs - ) { - my $error = $cust_pkg->cancel; - warn "Error cancelling expired pkg ". $cust_pkg->pkgnum. - " for custnum $custnum: $error" - if $error; - } - # $^T not $time because -d is for pre-printing invoices - foreach my $cust_pkg ( - grep { ( $_->part_pkg->is_prepaid && $_->bill && $_->bill < $^T - || $_->adjourn && $_->adjourn <= $^T - ) - && ! $_->susp - } - $cust_main->ncancelled_pkgs - ) { - my $action = $cust_pkg->part_pkg->option('recur_action') || 'suspend'; - my $error = $cust_pkg->$action(); - warn "Error suspending package ". $cust_pkg->pkgnum. - " for custnum $custnum: $error" - if $error; + if ( $opt{'m'} ) { + + die "XXX multi-process mode not yet completed"; + #add job to queue that calls bill_and_collect with options + + } else { + + $cust_main->bill_and_collect( + 'time' => $time, + 'invoice_time' => $invoice_time, + 'check_freq' => $check_freq, + 'resetup' => $opt{'s'}, + ); + } - - my $error = $cust_main->bill( 'time' => $time, - 'invoice_time' => $invoice_time, - 'resetup' => $opt{'s'}, - ); - warn "Error billing, custnum $custnum: $error" if $error; - - $error = $cust_main->apply_payments_and_credits; - warn "Error applying payments and credits, custnum $custnum: $error" - if $error; - - $error = $cust_main->collect( 'invoice_time' => $time, - 'freq' => $opt{'freq'}, - ); - warn "Error collecting, custnum $custnum: $error" if $error; - + } } diff --git a/FS/FS/Cron/expire_user_pref.pm b/FS/FS/Cron/expire_user_pref.pm new file mode 100644 index 000000000..7ab73d280 --- /dev/null +++ b/FS/FS/Cron/expire_user_pref.pm @@ -0,0 +1,17 @@ +package FS::Cron::expire_user_pref; + +use vars qw( @ISA @EXPORT_OK); +use Exporter; +use FS::UID qw(dbh); + +@ISA = qw( Exporter ); +@EXPORT_OK = qw( expire_user_pref ); + +sub expire_user_pref { + my $sql = "DELETE FROM access_user_pref WHERE expiration IS NOT NULL". + " AND expiration < ?"; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute(time) or die $sth->errstr; +} + +1; diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index d14762cee..f8711d021 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -213,6 +213,7 @@ The preferred usage is to pass a hash reference of named parameters: #these are optional... 'select' => '*', 'extra_sql' => 'AND field ', + 'order_by' => 'ORDER BY something', #'cache_obj' => '', #optional 'addl_from' => 'LEFT JOIN othtable USING ( field )', } @@ -235,13 +236,14 @@ fine in the common case where there are only two parameters: =cut sub qsearch { - my($stable, $record, $select, $extra_sql, $cache, $addl_from ); + my($stable, $record, $select, $extra_sql, $order_by, $cache, $addl_from ); if ( ref($_[0]) ) { #hashref for now, eventually maybe accept a list too my $opt = shift; $stable = $opt->{'table'} or die "table name is required"; $record = $opt->{'hashref'} || {}; $select = $opt->{'select'} || '*'; $extra_sql = $opt->{'extra_sql'} || ''; + $order_by = $opt->{'order_by'} || ''; $cache = $opt->{'cache_obj'} || ''; $addl_from = $opt->{'addl_from'} || ''; } else { @@ -362,6 +364,7 @@ sub qsearch { } $statement .= " $extra_sql" if defined($extra_sql); + $statement .= " $order_by" if defined($order_by); warn "[debug]$me $statement\n" if $DEBUG > 1; my $sth = $dbh->prepare($statement) @@ -2143,7 +2146,7 @@ sub loadRSA { $rsa_module = 'Crypt::OpenSSL::RSA'; # The Default my $conf = new FS::Conf; - if ($conf->exists('encryptionmodule') && $conf->config('encryptionmodule') ne '') { + if ($conf->exists('encryptionmodule') && $conf->config_binary('encryptionmodule') ne '') { $rsa_module = $conf->config('encryptionmodule'); } @@ -2152,13 +2155,13 @@ sub loadRSA { $rsa_loaded++; } # Initialize Encryption - if ($conf->exists('encryptionpublickey') && $conf->config('encryptionpublickey') ne '') { + if ($conf->exists('encryptionpublickey') && $conf->config_binary('encryptionpublickey') ne '') { my $public_key = join("\n",$conf->config('encryptionpublickey')); $rsa_encrypt = $rsa_module->new_public_key($public_key); } # Intitalize Decryption - if ($conf->exists('encryptionprivatekey') && $conf->config('encryptionprivatekey') ne '') { + if ($conf->exists('encryptionprivatekey') && $conf->config_binary('encryptionprivatekey') ne '') { my $private_key = join("\n",$conf->config('encryptionprivatekey')); $rsa_decrypt = $rsa_module->new_private_key($private_key); } diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index cddc520e6..bcfe907a5 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -265,15 +265,17 @@ sub tables_hashref { 'agent' => { 'columns' => [ - 'agentnum', 'serial', '', '', '', '', - 'agent', 'varchar', '', $char_d, '', '', - 'typenum', 'int', '', '', '', '', - 'freq', 'int', 'NULL', '', '', '', - 'prog', @perl_type, '', '', - 'disabled', 'char', 'NULL', 1, '', '', - 'username', 'varchar', 'NULL', $char_d, '', '', - '_password','varchar', 'NULL', $char_d, '', '', - 'ticketing_queueid', 'int', 'NULL', '', '', '', + 'agentnum', 'serial', '', '', '', '', + 'agent', 'varchar', '', $char_d, '', '', + 'typenum', 'int', '', '', '', '', + 'disabled', 'char', 'NULL', 1, '', '', + 'ticketing_queueid', 'int', 'NULL', '', '', '', + 'invoice_template', 'varchar', 'NULL', $char_d, '', '', + 'username', 'varchar', 'NULL', $char_d, '', '', #deprecated + '_password', 'varchar', 'NULL', $char_d, '', '', #deprecated + 'freq', 'int', 'NULL', '', '', '', #deprecated (never used) + 'prog', @perl_type, '', '', #deprecated (never used) + ], 'primary_key' => 'agentnum', 'unique' => [], @@ -349,6 +351,84 @@ sub tables_hashref { 'index' => [ ['payby'], ['disabled'], ], }, + 'part_event' => { + 'columns' => [ + 'eventpart', 'serial', '', '', '', '', + 'agentnum', 'int', 'NULL', '', '', '', + 'event', 'varchar', '', $char_d, '', '', + 'eventtable', 'varchar', '', $char_d, '', '', + 'check_freq', 'varchar', 'NULL', $char_d, '', '', + 'weight', 'int', '', '', '', '', + 'action', 'varchar', '', $char_d, '', '', + 'disabled', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'eventpart', + 'unique' => [], + 'index' => [ ['agentnum'], ['eventtable'], ['check_freq'], ['disabled'], ], + }, + + 'part_event_option' => { + 'columns' => [ + 'optionnum', 'serial', '', '', '', '', + 'eventpart', 'int', '', '', '', '', + 'optionname', 'varchar', '', $char_d, '', '', + 'optionvalue', 'text', 'NULL', '', '', '', + ], + 'primary_key' => 'optionnum', + 'unique' => [], + 'index' => [ [ 'eventpart' ], [ 'optionname' ] ], + }, + + 'part_event_condition' => { + 'columns' => [ + 'eventconditionnum', 'serial', '', '', '', '', + 'eventpart', 'int', '', '', '', '', + 'conditionname', 'varchar', '', $char_d, '', '', + ], + 'primary_key' => 'eventconditionnum', + 'unique' => [], + 'index' => [ [ 'eventpart' ], [ 'conditionname' ] ], + }, + + 'part_event_condition_option' => { + 'columns' => [ + 'optionnum', 'serial', '', '', '', '', + 'eventconditionnum', 'int', '', '', '', '', + 'optionname', 'varchar', '', $char_d, '', '', + 'optionvalue', 'text', 'NULL', '', '', '', + ], + 'primary_key' => 'optionnum', + 'unique' => [], + 'index' => [ [ 'eventconditionnum' ], [ 'optionname' ] ], + }, + + 'part_event_condition_option_option' => { + 'columns' => [ + 'optionoptionnum', 'serial', '', '', '', '', + 'optionnum', 'int', '', '', '', '', + 'optionname', 'varchar', '', $char_d, '', '', + 'optionvalue', 'text', 'NULL', '', '', '', + ], + 'primary_key' => 'optionoptionnum', + 'unique' => [], + 'index' => [ [ 'optionnum' ], [ 'optionname' ] ], + }, + + 'cust_event' => { + 'columns' => [ + 'eventnum', 'serial', '', '', '', '', + 'eventpart', 'int', '', '', '', '', + 'tablenum', 'int', '', '', '', '', + '_date', @date_type, '', '', + 'status', 'varchar', '', $char_d, '', '', + 'statustext', 'text', 'NULL', '', '', '', + ], + 'primary_key' => 'eventnum', + #no... there are retries now #'unique' => [ [ 'eventpart', 'invnum' ] ], + 'unique' => [], + 'index' => [ ['eventpart'], ['tablenum'], ['status'] ], + }, + 'cust_bill_pkg' => { 'columns' => [ 'billpkgnum', 'serial', '', '', '', '', @@ -681,7 +761,10 @@ sub tables_hashref { ], 'primary_key' => 'pkgnum', 'unique' => [], - 'index' => [ ['custnum'], ['pkgpart'] ], + 'index' => [ ['custnum'], ['pkgpart'], + ['setup'], ['last_bill'], ['bill'], ['susp'], ['adjourn'], + ['expire'], ['cancel'] + ], }, 'cust_pkg_option' => { @@ -1731,6 +1814,16 @@ sub tables_hashref { 'index' => [], }, + 'pkg_referral' => { + 'columns' => [ + 'pkgrefnum', 'serial', '', '', '', '', + 'pkgnum', 'int', '', '', '', '', + 'refnum', 'int', '', '', '', '', + ], + 'primary_key' => 'pkgrefnum', + 'unique' => [ [ 'pkgnum', 'refnum' ] ], + 'index' => [ [ 'pkgnum' ], [ 'refnum' ] ], + }, # name type nullability length default local #'new_table' => { diff --git a/FS/FS/Setup.pm b/FS/FS/Setup.pm index 17101a745..55984d4c7 100644 --- a/FS/FS/Setup.pm +++ b/FS/FS/Setup.pm @@ -161,51 +161,52 @@ sub initial_data { { 'groupname' => 'Superuser' }, ], - #billing events - 'part_bill_event' => [ - { 'payby' => 'CARD', - 'event' => 'Batch card', - 'seconds' => 0, - 'eventcode' => '$cust_bill->batch_card(%options);', - 'weight' => 40, - 'plan' => 'batch-card', - }, - { 'payby' => 'BILL', - 'event' => 'Send invoice', - 'seconds' => 0, - 'eventcode' => '$cust_bill->send();', - 'weight' => 50, - 'plan' => 'send', - }, - { 'payby' => 'DCRD', - 'event' => 'Send invoice', - 'seconds' => 0, - 'eventcode' => '$cust_bill->send();', - 'weight' => 50, - 'plan' => 'send', - }, - { 'payby' => 'DCHK', - 'event' => 'Send invoice', - 'seconds' => 0, - 'eventcode' => '$cust_bill->send();', - 'weight' => 50, - 'plan' => 'send', - }, - { 'payby' => 'DCLN', - 'event' => 'Suspend', - 'seconds' => 0, - 'eventcode' => '$cust_bill->suspend();', - 'weight' => 40, - 'plan' => 'suspend', - }, - #{ 'payby' => 'DCLN', - # 'event' => 'Retriable', - # 'seconds' => 0, - # 'eventcode' => '$cust_bill_event->retriable();', - # 'weight' => 60, - # 'plan' => 'retriable', - #}, - ], +#XXX need default new-style billing events +# #billing events +# 'part_bill_event' => [ +# { 'payby' => 'CARD', +# 'event' => 'Batch card', +# 'seconds' => 0, +# 'eventcode' => '$cust_bill->batch_card(%options);', +# 'weight' => 40, +# 'plan' => 'batch-card', +# }, +# { 'payby' => 'BILL', +# 'event' => 'Send invoice', +# 'seconds' => 0, +# 'eventcode' => '$cust_bill->send();', +# 'weight' => 50, +# 'plan' => 'send', +# }, +# { 'payby' => 'DCRD', +# 'event' => 'Send invoice', +# 'seconds' => 0, +# 'eventcode' => '$cust_bill->send();', +# 'weight' => 50, +# 'plan' => 'send', +# }, +# { 'payby' => 'DCHK', +# 'event' => 'Send invoice', +# 'seconds' => 0, +# 'eventcode' => '$cust_bill->send();', +# 'weight' => 50, +# 'plan' => 'send', +# }, +# { 'payby' => 'DCLN', +# 'event' => 'Suspend', +# 'seconds' => 0, +# 'eventcode' => '$cust_bill->suspend();', +# 'weight' => 40, +# 'plan' => 'suspend', +# }, +# #{ 'payby' => 'DCLN', +# # 'event' => 'Retriable', +# # 'seconds' => 0, +# # 'eventcode' => '$cust_bill_event->retriable();', +# # 'weight' => 60, +# # 'plan' => 'retriable', +# #}, +# ], #you must create a service definition. An example of a service definition #would be a dial-up account or a domain. First, it is necessary to create a diff --git a/FS/FS/access_group.pm b/FS/FS/access_group.pm index 25190406f..b5b693a8f 100644 --- a/FS/FS/access_group.pm +++ b/FS/FS/access_group.pm @@ -140,7 +140,7 @@ test if this group has the given RIGHTNAME. =cut sub access_right { - my( $self, $name ) = shift; + my( $self, $name ) = @_; qsearchs('access_right', { 'righttype' => 'FS::access_group', 'rightobjnum' => $self->groupnum, 'rightname' => $name, diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm index cb43b37e9..8e4ad46bd 100644 --- a/FS/FS/access_user.pm +++ b/FS/FS/access_user.pm @@ -308,22 +308,34 @@ Returns a hashref of agentnums this user can view. sub agentnums_href { my $self = shift; - { map { $_ => 1 } $self->agentnums }; + scalar( { map { $_ => 1 } $self->agentnums } ); } -=item agentnums_sql +=item agentnums_sql [ HASHREF | OPTION => VALUE ... ] Returns an sql fragement to select only agentnums this user can view. +Options are passed as a hashref or a list. Available options are: + +=over 4 + +=item null - The frament will also allow the selection of null agentnums. + +=item null_right - The fragment will also allow the selection of null agentnums if the current user has the provided access right + +=back + =cut sub agentnums_sql { - my $self = shift; + my( $self ) = shift; + my %opt = ref($_[0]) ? %{$_[0]} : @_; my @agentnums = map { "agentnum = $_" } $self->agentnums; push @agentnums, 'agentnum IS NULL' - if $self->access_right('View/link unlinked services'); + if $opt{'null'} + || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) ); return ' 1 = 0 ' unless scalar(@agentnums); '( '. join( ' OR ', @agentnums ). ' )'; diff --git a/FS/FS/access_user_pref.pm b/FS/FS/access_user_pref.pm index ff957f2a1..31cd4b362 100644 --- a/FS/FS/access_user_pref.pm +++ b/FS/FS/access_user_pref.pm @@ -27,19 +27,22 @@ FS::access_user_pref - Object methods for access_user_pref records =head1 DESCRIPTION -An FS::access_user_pref object represents an example. FS::access_user_pref inherits from -FS::Record. The following fields are currently supported: +An FS::access_user_pref object represents an per-user preference. Preferenaces +are also used to store transient state information (server-side "cookies"). +FS::access_user_pref inherits from FS::Record. The following fields are +currently supported: =over 4 =item prefnum - primary key -=item usernum - +=item usernum - Internal access user (see L) =item prefname - =item prefvalue - +=item expiration - =back @@ -49,7 +52,7 @@ FS::Record. The following fields are currently supported: =item new HASHREF -Creates a new example. To add the example to the database, see L<"insert">. +Creates a new preference. 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 method. @@ -88,7 +91,7 @@ returns the error, otherwise returns false. =item check -Checks all fields to make sure this is a valid example. If there is +Checks all fields to make sure this is a valid preference. If there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. @@ -104,7 +107,8 @@ sub check { $self->ut_numbern('prefnum') || $self->ut_number('usernum') || $self->ut_text('prefname') - || $self->ut_textn('prefvalue') + #|| $self->ut_textn('prefvalue') + || $self->ut_anything('prefvalue') ; return $error if $error; @@ -115,11 +119,9 @@ sub check { =head1 BUGS -The author forgot to customize this manpage. - =head1 SEE ALSO -L, schema.html from the base documentation. +L, L, schema.html from the base documentation. =cut diff --git a/FS/FS/agent.pm b/FS/FS/agent.pm index e40ef09db..57cc94563 100644 --- a/FS/FS/agent.pm +++ b/FS/FS/agent.pm @@ -117,6 +117,7 @@ sub check { || $self->ut_number('typenum') || $self->ut_numbern('freq') || $self->ut_textn('prog') + || $self->ut_textn('invoice_template') ; return $error if $error; diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 82023f6b5..f6dbc3df0 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -24,6 +24,7 @@ use FS::cust_credit_bill; use FS::pay_batch; use FS::cust_pay_batch; use FS::cust_bill_event; +use FS::cust_event; use FS::part_pkg; use FS::cust_bill_pay; use FS::cust_bill_pay_batch; @@ -271,8 +272,7 @@ sub open_cust_bill_pkg { =item cust_bill_event -Returns the completed invoice events (see L) for this -invoice. +Returns the completed invoice events (deprecated, old-style events - see L) for this invoice. =cut @@ -281,6 +281,54 @@ sub cust_bill_event { qsearch( 'cust_bill_event', { 'invnum' => $self->invnum } ); } +=item num_cust_bill_event + +Returns the number of completed invoice events (deprecated, old-style events - see L) for this invoice. + +=cut + +sub num_cust_bill_event { + my $self = shift; + my $sql = + "SELECT COUNT(*) FROM cust_bill_event WHERE invnum = ?"; + my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql"; + $sth->execute($self->invnum) or die $sth->errstr. " executing $sql"; + $sth->fetchrow_arrayref->[0]; +} + +=item cust_event + +Returns the new-style customer billing events (see L) for this invoice. + +=cut + +#false laziness w/cust_pkg.pm +sub cust_event { + my $self = shift; + qsearch({ + 'table' => 'cust_event', + 'addl_from' => 'JOIN part_event USING ( eventpart )', + 'hashref' => { 'tablenum' => $self->invnum }, + 'extra_sql' => " AND eventtable = 'cust_bill' ", + }); +} + +=item num_cust_event + +Returns the number of new-style customer billing events (see L) for this invoice. + +=cut + +#false laziness w/cust_pkg.pm +sub num_cust_event { + my $self = shift; + my $sql = + "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ". + " WHERE tablenum = ? AND eventtable = 'cust_bill'"; + my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql"; + $sth->execute($self->invnum) or die $sth->errstr. " executing $sql"; + $sth->fetchrow_arrayref->[0]; +} =item cust_main @@ -2577,6 +2625,8 @@ sub _items_payments { =back + + =head1 SUBROUTINES =over 4 @@ -2698,6 +2748,34 @@ sub re_X { =back +=head1 CLASS METHODS + +=over 4 + +=item owed_sql + +Returns an SQL fragment to retreived the amount owed. + +=cut + +sub owed_sql { + #my $class = shift; + + "charged + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum ) + ,0 + ) + "; + +} + =head1 BUGS The delete method. diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 84ca79dbf..e07461d58 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -331,12 +331,45 @@ sub cust_main { } +=back + +=head1 CLASS METHODS + +=over 4 + +=item credited_sql + +Returns an SQL fragment to retreive the unapplied amount. + +=cut + +sub credited_sql { + #my $class = shift; + + "amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + "; + +} + =back =head1 BUGS The delete method. The replace method. +B and B should probably be called B and +B. + =head1 SEE ALSO L, L, L, diff --git a/FS/FS/cust_event.pm b/FS/FS/cust_event.pm new file mode 100644 index 000000000..bebd72a10 --- /dev/null +++ b/FS/FS/cust_event.pm @@ -0,0 +1,407 @@ +package FS::cust_event; + +use strict; +use vars qw( @ISA $DEBUG ); +use Carp qw( croak confess ); +use FS::Record qw( qsearch qsearchs dbdef ); +use FS::cust_main_Mixin; +use FS::part_event; +#for cust_X +use FS::cust_main; +use FS::cust_pkg; +use FS::cust_bill; + +@ISA = qw(FS::cust_main_Mixin FS::Record); + +$DEBUG = 0; + +=head1 NAME + +FS::cust_event - Object methods for cust_event records + +=head1 SYNOPSIS + + use FS::cust_event; + + $record = new FS::cust_event \%hash; + $record = new FS::cust_event { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_event object represents an completed event. FS::cust_event +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item eventnum - primary key + +=item eventpart - event definition (see L) + +=item tablenum - customer, package or invoice, depending on the value of part_event.eventtable (see L, L, and L) + +=item _date - specified as a UNIX timestamp; see L. Also see +L and L for conversion functions. + +=item status - event status: B, B, B or B. Note: B indicates the event is complete and should not be retried (statustext may still be set to an optional message), while B indicates the event failed and should be retried. + +=item statustext - additional status detail (i.e. error or progress message) + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new completed invoice event. To add the compelted invoice event 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 method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'cust_event'; } + +sub cust_linked { $_[0]->cust_main_custnum; } +sub cust_unlinked_msg { + my $self = shift; + "WARNING: can't find cust_main.custnum ". $self->custnum; + #' (cust_bill.invnum '. $self->invnum. ')'; +} +sub custnum { + my $self = shift; + $self->cust_main_custnum(@_) || $self->SUPER::custnum(@_); +} + +=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 completed invoice event. 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('eventnum') + || $self->ut_foreign_key('eventpart', 'part_event', 'eventpart') + ; + return $error if $error; + + my $eventtable = $self->part_event->eventtable; + my $dbdef_eventtable = dbdef->table( $eventtable ); + + $error = + $self->ut_foreign_key( 'tablenum', + $eventtable, + $dbdef_eventtable->primary_key + ) + || $self->ut_number('_date') + || $self->ut_enum('status', [qw( new locked done failed )]) + || $self->ut_textn('statustext') + ; + return $error if $error; + + $self->SUPER::check; +} + +=item part_event + +Returns the event definition (see L) for this completed event. + +=cut + +sub part_event { + my $self = shift; + qsearchs( 'part_event', { 'eventpart' => $self->eventpart } ); +} + +=item cust_X + +Returns the customer, package, invoice or batched payment (see +L, L, L or L) +for this completed invoice event. + +=cut + +sub cust_bill { + croak "FS::cust_event::cust_bill called"; +} + +sub cust_X { + my $self = shift; + my $eventtable = $self->part_event->eventtable; + my $dbdef_table = dbdef->table( $eventtable ); + my $primary_key = $dbdef_table->primary_key; + qsearchs( $eventtable, { $primary_key => $self->tablenum } ); +} + +=item test_conditions [ OPTION => VALUE ... ] + +Tests conditions for this event, returns true if all conditions are satisfied, +false otherwise. + +=cut + +sub test_conditions { + my( $self, %opt ) = @_; + my $part_event = $self->part_event; + my $object = $self->cust_X; + my @conditions = $part_event->part_event_condition; + + #no unsatisfied conditions + #! grep ! $_->condition( $object, %opt ), @conditions; + my @unsatisfied = grep ! $_->condition( $object, %opt ), @conditions; + + if ( $opt{'stats_hashref'} ) { + foreach my $unsat (@unsatisfied) { + $opt{'stats_hashref'}->{$unsat->conditionname}++; + } + } + + ! @unsatisfied; +} + +=item do_event + +Runs the event action. + +=cut + +sub do_event { + my $self = shift; + + my $part_event = $self->part_event; + + my $object = $self->cust_X; + my $obj_pkey = $object->primary_key; + my $for = "for ". $object->table. " ". $object->$obj_pkey(); + warn "running cust_event ". $self->eventnum. + " (". $part_event->action. ") $for\n" + if $DEBUG; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + + my $error; + { + local $SIG{__DIE__}; # don't want Mason __DIE__ handler active + $error = eval { $part_event->do_action($object); }; + } + + my $status = ''; + my $statustext = ''; + if ( $@ ) { + $status = 'failed'; + #$statustext = $@; + $statustext = "Error running ". $part_event->action. " action: $@"; + } elsif ( $error ) { + $status = 'done'; + $statustext = $error; + } else { + $status = 'done'; + } + + #replace or add myself + $self->_date(time); + $self->status($status); + $self->statustext($statustext); + + $error = $self->eventnum ? $self->replace : $self->insert; + if ( $error ) { + #this is why we need that locked state... + my $e = 'WARNING: Event run but database not updated - '. + 'error replacing or inserting cust_event '. $self->eventnum. + " $for: $error\n"; + warn $e; + return $e; + } + + ''; + +} + +=item retry + +Changes the status of this event from B to B, allowing it to be +retried. + +=cut + +sub retry { + my $self = shift; + return '' unless $self->status eq 'done'; + my $old = ref($self)->new( { $self->hash } ); + $self->status('failed'); + $self->replace($old); +} + +#=item retryable +# +#Changes the statustext of this event to B, rendering it +#retriable (should retry be called). +# +#=cut + +sub retriable { + confess "cust_event->retriable called"; + my $self = shift; + return '' unless $self->status eq 'done'; + my $old = ref($self)->new( { $self->hash } ); + $self->statustext('retriable'); + $self->replace($old); +} + +=back + +=head1 SUBROUTINES + +=over 4 + +=item reprint + +=cut + +sub process_reprint { + process_re_X('print', @_); +} + +=item reemail + +=cut + +sub process_reemail { + process_re_X('email', @_); +} + +=item refax + +=cut + +sub process_refax { + process_re_X('fax', @_); +} + +use Storable qw(thaw); +use Data::Dumper; +use MIME::Base64; +sub process_re_X { + my( $method, $job ) = ( shift, shift ); + + my $param = thaw(decode_base64(shift)); + warn Dumper($param) if $DEBUG; + + re_X( + $method, + $param->{'beginning'}, + $param->{'ending'}, + $param->{'failed'}, + $job, + ); + +} + +sub re_X { + my($method, $beginning, $ending, $failed, $job) = @_; + + my $from = 'LEFT JOIN part_event USING ( eventpart )'; + + # yuck! hardcoed *AND* sequential scans! + my $where = " WHERE action LIKE 'cust_bill_send%'". + " AND cust_event._date >= $beginning". + " AND cust_event._date <= $ending"; + $where .= " AND statustext != '' AND statustext IS NOT NULL" + if $failed; + + my @cust_event = qsearch({ + 'table' => 'cust_event', + 'addl_from' => $from, + 'hashref' => {}, + 'extra_sql' => $where, + }); + + my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo + foreach my $cust_event ( @cust_event ) { + + # XXX + $cust_event->cust_bill->$method( + $cust_event->part_event->templatename + || $cust_event->cust_main->agent_template + ); + + if ( $job ) { #progressbar foo + $num++; + if ( time - $min_sec > $last ) { + my $error = $job->update_statustext( + int( 100 * $num / scalar(@cust_event) ) + ); + die $error if $error; + $last = time; + } + } + + } + + #this doesn't work, but it would be nice + #if ( $job ) { #progressbar foo + # my $error = $job->update_statustext( + # scalar(@cust_event). " invoices re-${method}ed" + # ); + # die $error if $error; + #} + +} + +=back + +=head1 SEE ALSO + +L, L, L, schema.html from the +base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 7238e97f3..fb64fa3ad 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,5 +1,6 @@ package FS::cust_main; +require 5.006; use strict; use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields $import $skip_fuzzyfiles $ignore_expired_card @paytypes); @@ -7,13 +8,9 @@ use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; use Exporter; -BEGIN { - eval "use Time::Local;"; - die "Time::Local minimum version 1.05 required with Perl versions before 5.6" - if $] < 5.006 && !defined($Time::Local::VERSION); - #eval "use Time::Local qw(timelocal timelocal_nocheck);"; - eval "use Time::Local qw(timelocal_nocheck);"; -} +use Time::Local qw(timelocal_nocheck); +use Data::Dumper; +use Tie::IxHash; use Digest::MD5 qw(md5_base64); use Date::Format; use Date::Parse; @@ -32,6 +29,7 @@ use FS::cust_bill; use FS::cust_bill_pkg; use FS::cust_pay; use FS::cust_pay_void; +use FS::cust_pay_batch; use FS::cust_credit; use FS::cust_refund; use FS::part_referral; @@ -43,8 +41,9 @@ use FS::cust_bill_pay; use FS::prepay_credit; use FS::queue; use FS::part_pkg; -use FS::part_bill_event qw(due_events); -use FS::cust_bill_event; +use FS::part_event; +use FS::part_event_condition; +#use FS::cust_event; use FS::cust_tax_exempt; use FS::cust_tax_exempt_pkg; use FS::type_pkgs; @@ -1423,11 +1422,10 @@ sub check { $payinfo =~ s/[^\d\@]//g; if ( $conf->exists('echeck-nonus') ) { $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba'; - $payinfo = "$1\@$2"; } else { $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; - $payinfo = "$1\@$2"; } + $payinfo = "$1\@$2"; $self->payinfo($payinfo); $self->paycvv(''); @@ -1547,6 +1545,16 @@ sub all_pkgs { sort sort_packages @cust_pkg; } +=item cust_pkg + +Synonym for B. + +=cut + +sub cust_pkg { + shift->all_pkgs(@_); +} + =item ncancelled_pkgs Returns all non-cancelled packages (see L) for this customer. @@ -1561,11 +1569,18 @@ sub ncancelled_pkgs { my @cust_pkg = (); if ( $self->{'_pkgnum'} ) { + warn "$me ncancelled_pkgs: returning cached objects" + if $DEBUG > 1; + @cust_pkg = grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache }; } else { + warn "$me ncancelled_pkgs: searching for packages for custnum ". + $self->custnum + if $DEBUG > 1; + @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum, @@ -1683,10 +1698,20 @@ sub suspend { grep { $_->suspend(@_) } $self->unsuspended_pkgs; } -=item suspend_if_pkgpart PKGPART [ , PKGPART ... ] +=item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ] Suspends all unsuspended packages (see L) matching the listed -PKGPARTs (see L). +PKGPARTs (see L). Preferred usage is to pass a hashref instead +of a list of pkgparts; the hashref has the following keys: + +=over 4 + +=item pkgparts - listref of pkgparts + +=item (other options are passed to the suspend method) + +=back + Returns a list: an empty list on success or a list of errors. @@ -1706,10 +1731,19 @@ sub suspend_if_pkgpart { $self->unsuspended_pkgs; } -=item suspend_unless_pkgpart PKGPART [ , PKGPART ... ] +=item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ] Suspends all unsuspended packages (see L) unless they match the -listed PKGPARTs (see L). +given PKGPARTs (see L). Preferred usage is to pass a hashref +instead of a list of pkgparts; the hashref has the following keys: + +=over 4 + +=item pkgparts - listref of pkgparts + +=item (other options are passed to the suspend method) + +=back Returns a list: an empty list on success or a list of errors. @@ -1733,22 +1767,31 @@ sub suspend_unless_pkgpart { Cancels all uncancelled packages (see L) for this customer. -Available options are: I, I, and I +Available options are: -I can be set true to supress email cancellation notices. +=over 4 -# I can be set to a cancellation reason (see L) +=item quiet - can be set true to supress email cancellation notices. -I can be set true to ban this customer's credit card or ACH information, -if present. +=item reason - can be set to a cancellation reason (see L), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L, reason - Text of the new reason. + +=item ban - can be set true to ban this customer's credit card or ACH information, if present. + +=back Always returns a list: an empty list on success or a list of errors. =cut sub cancel { - my $self = shift; - my %opt = @_; + my( $self, %opt ) = @_; + + warn "$me cancel called on customer ". $self->custnum. " with options ". + join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n" + if $DEBUG; + + return ( 'access denied' ) + unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer'); if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) { @@ -1763,7 +1806,13 @@ sub cancel { } - grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs; + my @pkgs = $self->ncancelled_pkgs; + + warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/". + scalar(@pkgs). " packages for customer ". $self->custnum. "\n" + if $DEBUG; + + grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs; } sub _banned_pay_hashref { @@ -1810,10 +1859,87 @@ sub agent { qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); } +=item bill_and_collect + +Cancels and suspends any packages due, generates bills, applies payments and +cred + +Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.) + +Options are passed as name-value pairs. Currently available options are: + +=over 4 + +=item time - bills the customer as if it were that time. Specified as a UNIX timestamp; see L). Also see L and L for conversion functions. For example: + + use Date::Parse; + ... + $cust_main->bill( 'time' => str2time('April 20th, 2001') ); + +=item invoice_time - used in conjunction with the I