diff options
Diffstat (limited to 'FS')
166 files changed, 17515 insertions, 2477 deletions
@@ -102,6 +102,8 @@ L<FS::cust_main_county> - Locale (tax rate) class L<FS::cust_tax_exempt> - Tax exemption record class +L<FS::cust_tax_adjustment> - Tax adjustment record class + L<FS::cust_tax_exempt_pkg> - Line-item specific tax exemption record class L<FS::svc_Common> - Service base class @@ -136,6 +138,10 @@ L<FS::part_virtual_field> - Broadband virtual field class L<FS::svc_phone> - Phone service class +L<FS::phone_device> - Phone device class + +L<FS::part_device> - Device definition class + L<FS::phone_avail> - Phone number availability cache L<FS::cdr> - Call Detail Record class @@ -144,8 +150,6 @@ L<FS::cdr_calltype> - CDR calltype class L<FS::cdr_carrier> - CDR carrier class -L<FS::cdr_upstream_rate> - CDR upstream rate class - L<FS::cdr_type> - CDR type class L<FS::svc_external> - Externally tracked service class. @@ -165,7 +169,7 @@ L<FS::part_export> - External provisioning export class L<FS::part_export_option> - Export option class -L<FS::pkg_category> - Package category class +L<FS::pkg_category> - Package category class (invoice oriented) L<FS::pkg_class> - Package class class @@ -177,6 +181,8 @@ L<FS::part_pkg_taxclass> - Tax class class L<FS::part_pkg_option> - Package definition option class +L<FS::part_pkg_report_option> - Package reporting classification class + L<FS::pkg_svc> - Class linking package definitions (see L<FS::part_pkg>) with service definitions (see L<FS::part_svc>) @@ -228,12 +234,16 @@ L<FS::cust_main_Mixin> - Mixin class for records that contain fields from cust_m L<FS::cust_main_invoice> - Invoice destination class +L<FS::cust_main_exemption> - Customer tax exemption class + L<FS::cust_main_note> - Customer note class L<FS::banned_pay> - Banned payment information class L<FS::cust_bill> - Invoice class +L<FS::cust_statement> - Informational statement class + L<FS::cust_bill_pkg> - Invoice line item class L<FS::cust_bill_pkg_detail> - Invoice line item detail class diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 93660e2..a54d270 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -94,11 +94,10 @@ tie my %rights, 'Tie::IxHash', 'View customer', #'View Customer | View tickets', 'Edit customer', + 'View customer history', '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 'Bill customer now', #NEW 'Bulk send customer notices', #NEW ], @@ -140,6 +139,7 @@ tie my %rights, 'Tie::IxHash', 'Edit www config', #NEW 'Edit domain catchall', #NEW 'Edit domain nameservice', #NEW + 'Manage domain registration', { rightname=>'View/link unlinked services', global=>1 }, #not agent-virtualizable without more work ], @@ -150,7 +150,9 @@ tie my %rights, 'Tie::IxHash', 'Customer invoice / financial info rights' => [ 'View invoices', 'Resend invoices', #NEWNEW + 'Delete invoices', #new, but no need to phase in 'View customer tax exemptions', #yow + 'Add customer tax adjustment', #new, but no need to phase in 'View customer batched payments', #NEW 'View customer pending payments', #NEW 'Edit customer pending payments', #NEW @@ -197,6 +199,21 @@ tie my %rights, 'Tie::IxHash', ], + + ### + # note/attachment rights... + ### + 'Customer note and attachment rights' => [ + 'Add customer note', #NEW + 'Edit customer note', #NEW + 'Download attachment', #NEW + 'Add attachment', #NEW + 'Edit attachment', #NEW + 'Delete attachment', #NEW + 'View deleted attachments', #NEW + 'Undelete attachment', #NEW + 'Purge attachment', #NEW + ], ### # report/listing rights... @@ -210,6 +227,7 @@ tie my %rights, 'Tie::IxHash', { rightname=> 'List rating data', desc=>'Usage reports', global=>1 }, 'Billing event reports', + 'Receivables report', 'Financial reports', ], @@ -221,6 +239,7 @@ tie my %rights, 'Tie::IxHash', { rightname=>'Time queue', global=>1 }, { rightname=>'Process batches', global=>1 }, { rightname=>'Reprocess batches', global=>1 }, + { rightname=>'Redownload resolved batches', global=>1 }, { rightname=>'Import', global=>1 }, #some of these are ag-virt'ed now? give em their own ACLs { rightname=>'Export', global=>1 }, { rightname=> 'Edit rating data', desc=>'Delete CDRs', global=>1 }, @@ -267,14 +286,38 @@ tie my %rights, 'Tie::IxHash', =item rights -Returns a list of right names. +Returns the full list of right names. =cut - sub rights { +sub rights { #my $class = shift; map { ref($_) ? $_->{'rightname'} : $_ } map @{ $rights{$_} }, keys %rights; - } +} + +=item default_superuser_rights + +Most (but not all) right names. + +=cut + +sub default_superuser_rights { + my $class = shift; + my %omit = map { $_=>1 } ( + 'Delete customer', + 'Delete invoices', + 'Delete payment', + 'Delete credit', #? + 'Delete refund', #? + 'Time queue', + 'Redownload resolved batches', + 'Raw SQL', + 'Configuration download', + ); + + no warnings 'uninitialized'; + grep { ! $omit{$_} } $class->rights; +} =item rights_info diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index 7ad1dc2..f33a718 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -241,7 +241,7 @@ sub rooturl { (browse|config|docs|edit|graph|misc|search|view|pref|rt|elements) / (process/)? - ([\w\-\.\/]+) + ([\w\-\.\/]*) $ } {}x; diff --git a/FS/FS/ClientAPI/Bulk.pm b/FS/FS/ClientAPI/Bulk.pm new file mode 100644 index 0000000..ec617df --- /dev/null +++ b/FS/FS/ClientAPI/Bulk.pm @@ -0,0 +1,384 @@ +package FS::ClientAPI::Bulk; + +use strict; + +use vars qw( $DEBUG $cache ); +use Date::Parse; +use FS::Record qw( qsearchs ); +use FS::Conf; +use FS::ClientAPI_SessionCache; +use FS::cust_main; +use FS::cust_pkg; +use FS::cust_svc; +use FS::svc_acct; +use FS::svc_external; +use FS::cust_recon; +use Data::Dumper; + +$DEBUG = 1; + +sub _cache { + $cache ||= new FS::ClientAPI_SessionCache ( { + 'namespace' => 'FS::ClientAPI::Agent', #yes, share session_ids + } ); +} + +sub _izoom_ftp_row_fixup { + my $hash = shift; + + my @addr_fields = qw( address1 address2 city state zip ); + my @fields = ( qw( agent_custid username _password first last ), + @addr_fields, + map { "ship_$_" } @addr_fields ); + + $hash->{$_} =~ s/[&\/\*'"]/_/g foreach @fields; + + #$hash->{action} = '' if $hash->{action} eq 'R'; #unsupported for ftp + + $hash->{refnum} = 1; #ahem + $hash->{country} = 'US'; + $hash->{ship_country} = 'US'; + $hash->{payby} = 'LECB'; + $hash->{payinfo} = $hash->{daytime}; + $hash->{ship_fax} = '' if ( !$hash->{sms} || $hash->{sms} eq 'F' ); + + my $has_ship = + grep { $hash->{"ship_$_"} && + (! $hash->{$_} || $hash->{"ship_$_"} ne $hash->{$_} ) + } + ( @addr_fields, 'fax' ); + + if ( $has_ship ) { + foreach ( @addr_fields, qw( first last ) ) { + $hash->{"ship_$_"} = $hash->{$_} unless $hash->{"ship_$_"}; + } + } + + delete $hash->{sms}; + + ''; + +}; + +sub _izoom_ftp_result { + my ($hash, $error) = @_; + my $cust_main = + qsearchs( 'cust_main', { 'agent_custid' => $hash->{agent_custid}, + 'agentnum' => $hash->{agentnum} + } + ); + + my $custnum = $cust_main ? $cust_main->custnum : ''; + my @response = ( $hash->{action}, $hash->{agent_custid}, $custnum ); + + if ( $error ) { + push @response, ( 'ERROR', $error ); + } else { + push @response, ( 'OK', 'OK' ); + } + + join( ',', @response ); + +} + +sub _izoom_ftp_badaction { + "Invalid action: $_[0] record: @_ "; +} + +sub _izoom_soap_row_fixup { _izoom_ftp_row_fixup(@_) }; + +sub _izoom_soap_result { + my ($hash, $error) = @_; + + if ( $hash->{action} eq 'R' ) { + if ( $error ) { + return "Please check errors:\n $error"; # odd extra space + } else { + return join(' ', "Everything ok.", $hash->{pkg}, $hash->{adjourn} ); + } + } + + my $pkg = $hash->{pkg} || $hash->{saved_pkg} || ''; + if ( $error ) { + return join(' ', $hash->{agent_custid}, $error ); + } else { + return join(' ', $hash->{agent_custid}, $pkg, $hash->{adjourn} ); + } + +} + +sub _izoom_soap_badaction { + "Unknown action '$_[13]' "; +} + +my %format = ( + 'izoom-ftp' => { + 'fields' => [ qw ( action agent_custid username _password + daytime ship_fax sms first last + address1 address2 city state zip + pkg adjourn ship_address1 ship_address2 + ship_city ship_state ship_zip ) ], + 'fixup' => sub { _izoom_ftp_row_fixup(@_) }, + 'result' => sub { _izoom_ftp_result(@_) }, + 'action' => sub { _izoom_ftp_badaction(@_) }, + }, + 'izoom-soap' => { + 'fields' => [ qw ( agent_custid username _password + daytime first last address1 address2 + city state zip pkg action adjourn + ship_fax sms ship_address1 ship_address2 + ship_city ship_state ship_zip ) ], + 'fixup' => sub { _izoom_soap_row_fixup(@_) }, + 'result' => sub { _izoom_soap_result(@_) }, + 'action' => sub { _izoom_soap_badaction(@_) }, + }, +); + +sub processrow { + my $p = shift; + + my $session = _cache->get($p->{'session_id'}) + or return { 'error' => "Can't resume session" }; #better error message + + my $conf = new FS::Conf; + my $format = $conf->config('selfservice-bulk_format', $session->{agentnum}) + || 'izoom-soap'; + my ( @row ) = @{ $p->{row} }; + + warn "processrow called with '". join("' '", @row). "'\n" if $DEBUG; + + return { 'error' => "unknown format: $format" } + unless exists $format{$format}; + + return { 'error' => "Invalid record record length: ". scalar(@row). + "record: @row " #sic + } + unless scalar(@row) == scalar(@{$format{$format}{fields}}); + + my %hash = ( 'agentnum' => $session->{agentnum} ); + my $error; + + foreach my $field ( @{ $format{ $format }{ fields } } ) { + $hash{$field} = shift @row; + } + + $error ||= &{ $format{ $format }{ fixup } }( \%hash ); + + # put in the fixup routine? + if ( 'R' eq $hash{action} ) { + warn "processing reconciliation\n" if $DEBUG; + $error ||= process_recon($hash{agentnum}, $hash{agent_custid}); + } elsif ( 'P' eq $hash{action} ) { + # do nothing + } elsif( 'D' eq $hash{action} ) { + $hash{promo_pkg} = 'disk-1-'. $session->{agent}; + } elsif ( 'S' eq $hash{action} ) { + $hash{promo_pkg} = 'disk-2-'. $session->{agent}; + $hash{saved_pkg} = $hash{pkg}; + $hash{pkg} = ''; + } else { + $error ||= &{ $format{ $format }{ action } }( @row ); + } + + warn "processing provision\n" if ($DEBUG && !$error && $hash{action} ne 'R'); + $error ||= provision( %hash ) unless $hash{action} eq 'R'; + + my $result = &{ $format{ $format }{ result } }( \%hash, $error ); + + warn "processrow returning '". join("' '", $result, $error). "'\n" + if $DEBUG; + + return { 'error' => $error, 'message' => $result }; + +} + +sub provision { + my %args = ( @_ ); + + delete $args{action}; + + my $cust_main = + qsearchs( 'cust_main', + { map { $_ => $args{$_} } qw ( agent_custid agentnum ) }, + ); + + unless ( $cust_main ) { + $cust_main = new FS::cust_main { %args }; + my $error = $cust_main->insert; + return $error if $error; + } + + my @pkgs = grep { $_->part_pkg->freq } $cust_main->ncancelled_pkgs; + if ( scalar(@pkgs) > 1 ) { + return "Invalid account, should not be more then one active package ". #sic + "but found: ". scalar(@pkgs). " packages."; + } + + my $part_pkg = qsearchs( 'part_pkg', { 'pkg' => $args{pkg} } ) + or return "Unknown pkgpart: $args{pkg}" + if $args{pkg}; + + + my $create_package = $args{pkg}; + if ( scalar(@pkgs) && $create_package ) { + my $pkg = pop(@pkgs); + + if ( $part_pkg->pkgpart != $pkg->pkgpart ) { + my @cust_bill_pkg = $pkg->cust_bill_pkg(); + if ( 1 == scalar(@cust_bill_pkg) ) { + my $cbp= pop(@cust_bill_pkg); + my $cust_bill = $cbp->cust_bill; + $cust_bill->delete(); #really? wouldn't a credit be better? + } + $pkg->cancel(); + } else { + $create_package = ''; + $pkg->setfield('adjourn', str2time($args{adjourn})); + my $error = $pkg->replace(); + return $error if $error; + } + } + + if ( $create_package ) { + my $cust_pkg = new FS::cust_pkg ( { + 'pkgpart' => $part_pkg->pkgpart, + 'adjourn' => str2time( $args{adjourn} ), + } ); + + my $svcpart = $part_pkg->svcpart('svc_acct'); + + my $svc_acct = new FS::svc_acct ( { + 'svcpart' => $svcpart, + 'username' => $args{username}, + '_password' => $args{_password}, + } ); + + my $error = $cust_main->order_pkg( cust_pkg => $cust_pkg, + svcs => [ $svc_acct ], + ); + return $error if $error; + } + + if ( $args{promo_pkg} ) { + my $part_pkg = + qsearchs( 'part_pkg', { 'promo_code' => $args{promo_pkg} } ) + or return "unknown pkgpart: $args{promo_pkg}"; + + my $svcpart = $part_pkg->svcpart('svc_external') + or return "unknown svcpart: svc_external"; + + my $cust_pkg = new FS::cust_pkg ( { + 'svcpart' => $svcpart, + 'pkgpart' => $part_pkg->pkgpart, + } ); + + my $svc_ext = new FS::svc_external ( { 'svcpart' => $svcpart } ); + + my $ticket_subject = 'Send setup disk to customer '. $cust_main->custnum; + my $error = $cust_main->order_pkg ( cust_pkg => $cust_pkg, + svcs => [ $svc_ext ], + noexport => 1, + ticket_subject => $ticket_subject, + ticket_queue => "disk-$args{agentnum}", + ); + return $error if $error; + } + + my $error = $cust_main->bill(); + return $error if $error; +} + +sub process_recon { + my ( $agentnum, $id ) = @_; + my @recs = split /;/, $id; + my $err = ''; + foreach my $rec ( @recs ) { + my @record = split /,/, $rec; + my $result = process_recon_record(@record, $agentnum); + $err .= "$result\n" if $result; + } + return $err; +} + +sub process_recon_record { + my ( $agent_custid, $username, $_password, $daytime, $first, $last, $address1, $address2, $city, $state, $zip, $pkg, $adjourn, $agentnum) = @_; + + warn "process_recon_record called with '". join("','", @_). "'\n" if $DEBUG; + + my ($cust_pkg, $package); + + my $cust_main = + qsearchs( 'cust_main', + { 'agent_custid' => $agent_custid, 'agentnum' => $agentnum }, + ); + + my $comments = ''; + if ( $cust_main ) { + my @cust_pkg = grep { $_->part_pkg->freq } $cust_main->ncancelled_pkgs; + if ( scalar(@cust_pkg) == 1) { + $cust_pkg = pop(@cust_pkg); + $package = $cust_pkg->part_pkg->pkg; + $comments = "$agent_custid wrong package, expected: $pkg found: $package" + if ( $pkg ne $package ); + } else { + $comments = "invalid account, should be one active package but found: ". + scalar(@cust_pkg). " packages."; + } + } else { + $comments = + "Customer not found agent_custid=$agent_custid, agentnum=$agentnum"; + } + + my $cust_recon = new FS::cust_recon( { + 'recondate' => time, + 'agentnum' => $agentnum, + 'first' => $first, + 'last' => $last, + 'address1' => $address1, + 'address2' => $address2, + 'city' => $city, + 'state' => $state, + 'zip' => $zip, + 'custnum' => $cust_main ? $cust_main->custnum : '', #really? + 'status' => $cust_main ? $cust_main->status : '', + 'pkg' => $package, + 'adjourn' => $cust_pkg ? $cust_pkg->adjourn : '', + 'agent_custid' => $agent_custid, # redundant? + 'agent_pkg' => $pkg, + 'agent_adjourn' => str2time($adjourn), + 'comments' => $comments, + } ); + + warn Dumper($cust_recon) if $DEBUG; + my $error = $cust_recon->insert; + return $error if $error; + + warn "process_recon_record returning $comments\n" if $DEBUG; + + $comments; + +} + +sub check_username { + my $p = shift; + + my $session = _cache->get($p->{'session_id'}) + or return { 'error' => "Can't resume session" }; #better error message + + my $svc_domain = qsearchs( 'svc_domain', { 'domain' => $p->{domain} } ) + or return { 'error' => 'Unknown domain '. $p->{domain} }; + + my $svc_acct = qsearchs( 'svc_acct', { 'username' => $p->{user}, + 'domsvc' => $svc_domain->svcnum, + }, + ); + + return { 'error' => $p->{user}. '@'. $p->{domain}. " alerady in use" } # sic + if $svc_acct; + + return { 'error' => '', + 'message' => $p->{user}. '@'. $p->{domain}. " is free" + }; +} + +1; diff --git a/FS/FS/ClientAPI/MasonComponent.pm b/FS/FS/ClientAPI/MasonComponent.pm index 78ea9bd..88baf07 100644 --- a/FS/FS/ClientAPI/MasonComponent.pm +++ b/FS/FS/ClientAPI/MasonComponent.pm @@ -1,9 +1,14 @@ package FS::ClientAPI::MasonComponent; use strict; -use vars qw($DEBUG $me); +use vars qw( $cache $DEBUG $me ); +use subs qw( _cache ); use FS::Mason qw( mason_interps ); use FS::Conf; +use FS::ClientAPI_SessionCache; +use FS::Record qw( qsearch qsearchs ); +use FS::cust_main; +use FS::part_pkg; $DEBUG = 0; $me = '[FS::ClientAPI::MasonComponent]'; @@ -13,6 +18,54 @@ my %allowed_comps = map { $_=>1 } qw( /misc/areacodes.cgi /misc/exchanges.cgi /misc/phonenums.cgi + /misc/states.cgi + /misc/counties.cgi + /misc/svc_acct-domains.cgi + /misc/part_svc-columns.cgi +); + +my %session_comps = map { $_=>1 } qw( + /elements/location.html + /edit/cust_main/first_pkg/select-part_pkg.html +); + +my %session_callbacks = ( + + '/elements/location.html' => sub { + my( $custnum, $argsref ) = @_; + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or return "unknown custnum $custnum"; + my %args = @$argsref; + $args{object} = $cust_main; + @$argsref = ( %args ); + return ''; #no error + }, + + '/edit/cust_main/first_pkg/select-part_pkg.html' => sub { + my( $custnum, $argsref ) = @_; + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or return "unknown custnum $custnum"; + + my $pkgpart = $cust_main->agent->pkgpart_hashref; + + #false laziness w/ edit/cust_main/first_pkg.html + my @first_svc = ( 'svc_acct', 'svc_phone' ); + + my @part_pkg = + grep { $_->svcpart(\@first_svc) + && ( $pkgpart->{ $_->pkgpart } + || ( $_->agentnum && $_->agentnum == $cust_main->agentnum ) + ) + } + qsearch( 'part_pkg', { 'disabled' => '' }, '', 'ORDER BY pkg' ); # case? + + my %args = @$argsref; + $args{part_pkg} = \@part_pkg; + @$argsref = ( %args ); + return ''; #no error + + }, + ); my $outbuf; @@ -24,12 +77,23 @@ sub mason_comp { warn "$me mason_comp called on $packet\n" if $DEBUG; my $comp = $packet->{'comp'}; - unless ( $allowed_comps{$comp} ) { + unless ( $allowed_comps{$comp} || $session_comps{$comp} ) { return { 'error' => 'Illegal component' }; } my @args = $packet->{'args'} ? @{ $packet->{'args'} } : (); + if ( $session_comps{$comp} ) { + + my $session = _cache->get($packet->{'session_id'}) + or return ( 'error' => "Can't resume session" ); #better error message + my $custnum = $session->{'custnum'}; + + my $error = &{ $session_callbacks{$comp} }( $custnum, \@args ); + return { 'error' => $error } if $error; + + } + my $conf = new FS::Conf; $FS::Mason::Request::FSURL = $conf->config('selfservice_server-base_url'); $FS::Mason::Request::QUERY_STRING = $packet->{'query_string'} || ''; @@ -43,4 +107,11 @@ sub mason_comp { } +#hmm +sub _cache { + $cache ||= new FS::ClientAPI_SessionCache( { + 'namespace' => 'FS::ClientAPI::MyAccount', + } ); +} + 1; diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index c0586af..26cd76f 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -10,7 +10,7 @@ use Business::CreditCard; use Time::Duration; use FS::UI::Web::small_custview qw(small_custview); #less doh use FS::UI::Web; -use FS::UI::bytecount; +use FS::UI::bytecount qw( display_bytecount ); use FS::Conf; use FS::Record qw(qsearch qsearchs); use FS::Msgcat qw(gettext); @@ -55,12 +55,35 @@ sub _cache { } ); } +sub skin_info { + #my $p = shift; + + my $conf = new FS::Conf; + + use vars qw($skin_info); #cache for performance. + #agentnum eventually...? but if they're not logged in yet.. ? + + $skin_info ||= { + 'head' => join("\n", $conf->config('selfservice-head') ), + 'body_header' => join("\n", $conf->config('selfservice-body_header') ), + 'body_footer' => join("\n", $conf->config('selfservice-body_footer') ), + 'body_bgcolor' => scalar( $conf->config('selfservice-body_bgcolor') ), + 'box_bgcolor' => scalar( $conf->config('selfservice-box_bgcolor') ), + + 'company_name' => scalar($conf->config('company_name')), + }; + + $skin_info; + +} + sub login_info { my $p = shift; my $conf = new FS::Conf; my %info = ( + %{ skin_info() }, 'phone_login' => $conf->exists('selfservice_server-phone_login'), 'single_domain'=> scalar($conf->config('selfservice_server-single_domain')), ); @@ -103,16 +126,6 @@ sub login { ); return { error => 'User not found.' } unless $svc_acct; - #my $pkg_svc = $svc_acct->cust_svc->pkg_svc; - #return { error => 'Only primary user may log in.' } - # if $conf->exists('selfservice_server-primary_only') - # && ( ! $pkg_svc || $pkg_svc->primary_svc ne 'Y' ); - my $cust_svc = $svc_acct->cust_svc; - my $part_pkg = $cust_svc->cust_pkg->part_pkg; - return { error => 'Only primary user may log in.' } - if $conf->exists('selfservice_server-primary_only') - && $cust_svc->svcpart != $part_pkg->svcpart('svc_acct'); - return { error => 'Incorrect password.' } unless $svc_acct->check_password($p->{'password'}); @@ -124,12 +137,28 @@ sub login { 'svcnum' => $svc_x->svcnum, }; - my $cust_pkg = $svc_x->cust_svc->cust_pkg; + my $cust_svc = $svc_x->cust_svc; + my $cust_pkg = $cust_svc->cust_pkg; if ( $cust_pkg ) { my $cust_main = $cust_pkg->cust_main; $session->{'custnum'} = $cust_main->custnum; + if ( $conf->exists('pkg-balances') ) { + my @cust_pkg = grep { $_->part_pkg->freq !~ /^(0|$)/ } + $cust_main->ncancelled_pkgs; + $session->{'pkgnum'} = $cust_pkg->pkgnum + if scalar(@cust_pkg) > 1; + } } + #my $pkg_svc = $svc_acct->cust_svc->pkg_svc; + #return { error => 'Only primary user may log in.' } + # if $conf->exists('selfservice_server-primary_only') + # && ( ! $pkg_svc || $pkg_svc->primary_svc ne 'Y' ); + my $part_pkg = $cust_pkg->part_pkg; + return { error => 'Only primary user may log in.' } + if $conf->exists('selfservice_server-primary_only') + && $cust_svc->svcpart != $part_pkg->svcpart([qw( svc_acct svc_phone )]); + my $session_id; do { $session_id = md5_hex(md5_hex(time(). {}. rand(). $$)) @@ -147,12 +176,59 @@ sub logout { my $p = shift; if ( $p->{'session_id'} ) { _cache->remove($p->{'session_id'}); - return { 'error' => '' }; + return { %{ skin_info() }, 'error' => '' }; } else { - return { 'error' => "Can't resume session" }; #better error message + return { %{ skin_info() }, 'error' => "Can't resume session" }; #better error message } } +sub access_info { + my $p = shift; + + my $conf = new FS::Conf; + + my $info = skin_info($p); + + use vars qw( $cust_paybys ); #cache for performance + unless ( $cust_paybys ) { + + my %cust_paybys = map { $_ => 1 } + map { FS::payby->payby2payment($_) } + $conf->config('signup_server-payby'); + + $cust_paybys = [ keys %cust_paybys ]; + + } + $info->{'cust_paybys'} = $cust_paybys; + + my($context, $session, $custnum) = _custoragent_session_custnum($p); + return { 'error' => $session } if $context eq 'error'; + + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or return { 'error' => "unknown custnum $custnum" }; + + $info->{hide_payment_fields} = + [ + map { my $pg = ''; + if ( FS::payby->realtime($_) ) { + $pg = $cust_main->agent->payment_gateway( + 'method' => FS::payby->payby2bop($_), + 'nofatal' => 1, + ); + } + $pg && $pg->gateway_namespace eq 'Business::OnlineThirdPartyPayment'; + } + @{ $info->{cust_paybys} } + ]; + + return { %$info, + 'custnum' => $custnum, + 'pkgnum' => $session->{'pkgnum'}, + 'svcnum' => $session->{'svcnum'}, + 'nonprimary' => $session->{'nonprimary'}, + }; +} + sub customer_info { my $p = shift; @@ -175,21 +251,32 @@ sub customer_info { my $cust_main = qsearchs('cust_main', $search ) or return { 'error' => "unknown custnum $custnum" }; - $return{balance} = $cust_main->balance; + if ( $session->{'pkgnum'} ) { + $return{balance} = $cust_main->balance_pkgnum( $session->{'pkgnum'} ); + } else { + $return{balance} = $cust_main->balance; + } $return{tickets} = [ ($cust_main->tickets) ]; - my @open = map { - { - invnum => $_->invnum, - date => time2str("%b %o, %Y", $_->_date), - owed => $_->owed, - }; - } $cust_main->open_cust_bill; - $return{open_invoices} = \@open; + unless ( $session->{'pkgnum'} ) { + my @open = map { + { + invnum => $_->invnum, + date => time2str("%b %o, %Y", $_->_date), + owed => $_->owed, + }; + } $cust_main->open_cust_bill; + $return{open_invoices} = \@open; + } $return{small_custview} = - small_custview( $cust_main, $conf->config('countrydefault') ); + small_custview( $cust_main, + scalar($conf->config('countrydefault')), + ( $session->{'pkgnum'} ? 1 : 0 ), #nobalance + ); + + warn $return{small_custview}; $return{name} = $cust_main->first. ' '. $cust_main->get('last'); @@ -281,7 +368,8 @@ sub edit_info { $new->set( 'payby' => $p->{'auto'} ? 'CARD' : 'DCRD' ); - }elsif ( $payby =~ /^(CHEK|DCHK)$/ ) { + } elsif ( $payby =~ /^(CHEK|DCHK)$/ ) { + my $payinfo; $p->{'payinfo1'} =~ /^([\dx]+)$/ or return { 'error' => "illegal account number ". $p->{'payinfo1'} }; @@ -291,15 +379,15 @@ sub edit_info { my $payinfo2 = $1; $payinfo = $payinfo1. '@'. $payinfo2; - if ( $payinfo eq $cust_main->paymask ) { - $new->payinfo($cust_main->payinfo); - } else { - $new->payinfo($payinfo); - } + $new->payinfo( ($payinfo eq $cust_main->paymask) + ? $cust_main->payinfo + : $payinfo + ); $new->set( 'payby' => $p->{'auto'} ? 'CHEK' : 'DCHK' ); - }elsif ( $payby =~ /^(BILL)$/ ) { + } elsif ( $payby =~ /^(BILL)$/ ) { + #no-op } elsif ( $payby ) { #notyet ready return { 'error' => "unknown payby $payby" }; } @@ -338,6 +426,12 @@ sub payment_info { 'country' => $conf->config('countrydefault') || 'US' } ); + my %cust_paybys = map { $_ => 1 } + map { FS::payby->payby2payment($_) } + $conf->config('signup_server-payby'); + + my @cust_paybys = keys %cust_paybys; + $payment_info = { #list all counties/states/countries @@ -353,6 +447,7 @@ sub payment_info { 'paytypes' => [ @FS::cust_main::paytypes ], 'paybys' => [ $conf->config('signup_server-payby') ], + 'cust_paybys' => \@cust_paybys, 'stateid_label' => FS::Msgcat::_gettext('stateid'), 'stateid_state_label' => FS::Msgcat::_gettext('stateid_state'), @@ -375,7 +470,21 @@ sub payment_info { my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) or return { 'error' => "unknown custnum $custnum" }; - $return{balance} = $cust_main->balance; + $return{hide_payment_fields} = + [ + map { my $pg = ''; + if ( FS::payby->realtime($_) ) { + $pg = $cust_main->agent->payment_gateway( + 'method' => FS::payby->payby2bop($_), + 'nofatal' => 1, + ); + } + $pg && $pg->gateway_namespace eq 'Business::OnlineThirdPartyPayment'; + } + @{ $return{cust_paybys} } + ]; + + $return{balance} = $cust_main->balance; #XXX pkg-balances? $return{payname} = $cust_main->payname || ( $cust_main->first. ' '. $cust_main->get('last') ); @@ -436,6 +545,7 @@ sub process_payment { or return { 'error' => gettext('illegal_text'). " paybatch: ". $p->{'paybatch'} }; my $paybatch = $1; + $p->{'payby'} ||= 'CARD'; $p->{'payby'} =~ /^([A-Z]{4})$/ or return { 'error' => "illegal_payby " . $p->{'payby'} }; my $payby = $1; @@ -460,6 +570,8 @@ sub process_payment { $payinfo = $p->{'payinfo'}; + #more intelligent mathing will be needed here if you change + #card_masking_method and don't remove existing paymasks $payinfo = $cust_main->payinfo if $cust_main->paymask eq $payinfo; @@ -490,7 +602,8 @@ sub process_payment { } my %payby2fields = ( - 'CARD' => [ qw( paystart_month paystart_year payissue address1 address2 city state zip payip ) ], + 'CARD' => [ qw( paystart_month paystart_year payissue payip + address1 address2 city state zip country ) ], 'CHEK' => [ qw( ss paytype paystate stateid stateid_state payip ) ], ); @@ -501,6 +614,7 @@ sub process_payment { 'payname' => $payname, 'paybatch' => $paybatch, #this doesn't actually do anything 'paycvv' => $paycvv, + 'pkgnum' => $session->{'pkgnum'}, map { $_ => $p->{$_} } @{ $payby2fields{$payby} } ); return { 'error' => $error } if $error; @@ -512,15 +626,15 @@ sub process_payment { if ($payby eq 'CARD' || $payby eq 'DCRD') { $new->set( $_ => $p->{$_} ) foreach qw( payname paystart_month paystart_year payissue payip - address1 address2 city state zip payinfo ); + address1 address2 city state zip country ); $new->set( 'payby' => $p->{'auto'} ? 'CARD' : 'DCRD' ); } elsif ($payby eq 'CHEK' || $payby eq 'DCHK') { $new->set( $_ => $p->{$_} ) foreach qw( payname payip paytype paystate stateid stateid_state ); - $new->set( 'payinfo' => $payinfo ); $new->set( 'payby' => $p->{'auto'} ? 'CHEK' : 'DCHK' ); } + $new->set( 'payinfo' => $payinfo ); $new->set( 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01' ); my $error = $new->replace($cust_main); return { 'error' => $error } if $error; @@ -531,6 +645,32 @@ sub process_payment { } +sub realtime_collect { + + my $p = shift; + + my $session = _cache->get($p->{'session_id'}) + or return { 'error' => "Can't resume session" }; #better error message + + my $custnum = $session->{'custnum'}; + + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or return { 'error' => "unknown custnum $custnum" }; + + my $error = $cust_main->realtime_collect( + 'method' => $p->{'method'}, + 'pkgnum' => $session->{'pkgnum'}, + 'session_id' => $p->{'session_id'}, + ); + return { 'error' => $error } unless ref( $error ); + + my $amount = $session->{'pkgnum'} + ? $cust_main->balance_pkgnum( $session->{'pkgnum'} ) + : $cust_main->balance; + + return { 'error' => '', amount => $amount, %$error }; +} + sub process_payment_order_pkg { my $p = shift; @@ -617,7 +757,14 @@ sub invoice_logo { #sessioning for this? how do we get the session id to the backend invoice # template so it can add it to the link, blah - my $templatename = $p->{'templatename'}; + my $agentnum = ''; + if ( $p->{'invnum'} ) { + my $cust_bill = qsearchs('cust_bill', { 'invnum' => $p->{'invnum'} } ) + or return { 'error' => 'unknown invnum' }; + $agentnum = $cust_bill->cust_main->agentnum; + } + + my $templatename = $p->{'template'} || $p->{'templatename'}; #false laziness-ish w/view/cust_bill-logo.cgi @@ -631,7 +778,7 @@ sub invoice_logo { my $filename = "logo$templatename.png"; return { 'error' => '', - 'logo' => $conf->config_binary($filename), + 'logo' => $conf->config_binary($filename, $agentnum), 'content_type' => 'image/png', #should allow gif, jpg too }; } @@ -734,10 +881,17 @@ sub list_svcs { foreach my $cust_pkg ( $p->{'ncancelled'} ? $cust_main->ncancelled_pkgs : $cust_main->unsuspended_pkgs ) { + next if $session->{'pkgnum'} && $cust_pkg->pkgnum != $session->{'pkgnum'}; push @cust_svc, @{[ $cust_pkg->cust_svc ]}; #@{[ ]} to force array context } - @cust_svc = grep { $_->part_svc->svcdb eq $p->{'svcdb'} } @cust_svc - if $p->{'svcdb'}; + if ( $p->{'svcdb'} ) { + my $svcdb = ref($p->{'svcdb'}) eq 'HASH' + ? $p->{'svcdb'} + : ref($p->{'svcdb'}) eq 'ARRAY' + ? { map { $_=>1 } @{ $p->{'svcdb'} } } + : { $p->{'svcdb'} => 1 }; + @cust_svc = grep $svcdb->{ $_->part_svc->svcdb }, @cust_svc + } #@svc_x = sort { $a->domain cmp $b->domain || $a->username cmp $b->username } # @svc_x; @@ -745,30 +899,51 @@ sub list_svcs { { #no#'svcnum' => $session->{'svcnum'}, 'custnum' => $custnum, - 'svcs' => [ map { - my $svc_x = $_->svc_x; - my($label, $value) = $_->label; - my $part_pkg = $svc_x->cust_svc->cust_pkg->part_pkg; - - { 'svcnum' => $_->svcnum, - 'label' => $label, - 'value' => $value, - 'username' => $svc_x->username, - 'email' => $svc_x->email, - 'seconds' => $svc_x->seconds, - 'upbytes' => FS::UI::bytecount::display_bytecount($svc_x->upbytes), - 'downbytes' => FS::UI::bytecount::display_bytecount($svc_x->downbytes), - 'totalbytes'=> FS::UI::bytecount::display_bytecount($svc_x->totalbytes), - 'recharge_amount' => $part_pkg->option('recharge_amount', 1), - 'recharge_seconds' => $part_pkg->option('recharge_seconds', 1), - 'recharge_upbytes' => FS::UI::bytecount::display_bytecount($part_pkg->option('recharge_upbytes', 1)), - 'recharge_downbytes' => FS::UI::bytecount::display_bytecount($part_pkg->option('recharge_downbytes', 1)), - 'recharge_totalbytes' => FS::UI::bytecount::display_bytecount($part_pkg->option('recharge_totalbytes', 1)), - # more... - }; - } - @cust_svc - ], + 'svcs' => [ + map { + my $svc_x = $_->svc_x; + my($label, $value) = $_->label; + my $svcdb = $_->part_svc->svcdb; + my $part_pkg = $_->cust_pkg->part_pkg; + + my %hash = ( + 'svcnum' => $_->svcnum, + 'svcdb' => $svcdb, + 'label' => $label, + 'value' => $value, + ); + + if ( $svcdb eq 'svc_acct' ) { + %hash = ( + %hash, + 'username' => $svc_x->username, + 'email' => $svc_x->email, + 'seconds' => $svc_x->seconds, + 'upbytes' => display_bytecount($svc_x->upbytes), + 'downbytes' => display_bytecount($svc_x->downbytes), + 'totalbytes' => display_bytecount($svc_x->totalbytes), + + 'recharge_amount' => $part_pkg->option('recharge_amount',1), + 'recharge_seconds' => $part_pkg->option('recharge_seconds',1), + 'recharge_upbytes' => + display_bytecount($part_pkg->option('recharge_upbytes',1)), + 'recharge_downbytes' => + display_bytecount($part_pkg->option('recharge_downbytes',1)), + 'recharge_totalbytes' => + display_bytecount($part_pkg->option('recharge_totalbytes',1)), + # more... + ); + + } elsif ( $svcdb eq 'svc_phone' ) { + %hash = ( + %hash, + ); + } + + \%hash; + } + @cust_svc + ], }; } @@ -778,9 +953,8 @@ sub _list_svc_usage { my @usage = (); foreach my $part_export ( map { qsearch ( 'part_export', { 'exporttype' => $_ } ) } - qw (sqlradius sqlradius_withdomain') + qw( sqlradius sqlradius_withdomain ) ) { - push @usage, @ { $part_export->usage_sessions($begin, $end, $svc_acct) }; } (@usage); @@ -813,29 +987,50 @@ sub list_support_usage { _usage_details(\&_list_support_usage, @_); } +sub _list_cdr_usage { + my($svc_phone, $begin, $end) = @_; + map [ $_->downstream_csv('format' => 'default') ], #XXX config for format + $svc_phone->cust_svc->get_cdrs( 'begin'=>$begin, 'end'=>$end, ); +} + +sub list_cdr_usage { + my $p = shift; + _usage_details( \&_list_cdr_usage, $p, + 'svcdb' => 'svc_phone', + ); +} + sub _usage_details { - my ($callback, $p) = (shift,shift); + my($callback, $p, %opt) = @_; my($context, $session, $custnum) = _custoragent_session_custnum($p); return { 'error' => $session } if $context eq 'error'; my $search = { 'svcnum' => $p->{'svcnum'} }; $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent'; - my $svc_acct = qsearchs ( 'svc_acct', $search ); + + my $svcdb = $opt{'svcdb'} || 'svc_acct'; + + my $svc_x = qsearchs( $svcdb, $search ); return { 'error' => 'No service selected in list_svc_usage' } - unless $svc_acct; + unless $svc_x; - my $freq = $svc_acct->cust_svc->cust_pkg->part_pkg->freq; - my $start = $svc_acct->cust_svc->cust_pkg->setup; - #my $end = $svc_acct->cust_svc->cust_pkg->bill; # or time? - my $end = time; + my $header = $svcdb eq 'svc_phone' + ? [ split(',', FS::cdr::invoice_header('default') ) ] #XXX + : []; - unless($p->{beginning}){ - $p->{beginning} = $svc_acct->cust_svc->cust_pkg->last_bill; - $p->{ending} = $end; + my $cust_pkg = $svc_x->cust_svc->cust_pkg; + my $freq = $cust_pkg->part_pkg->freq; + my $start = $cust_pkg->setup; + #my $end = $cust_pkg->bill; # or time? + my $end = time; + + unless ( $p->{beginning} ) { + $p->{beginning} = $cust_pkg->last_bill; + $p->{ending} = $end; } - my (@usage) = &$callback($svc_acct,$p->{beginning},$p->{ending}); + my (@usage) = &$callback($svc_x, $p->{beginning}, $p->{ending}); #kinda false laziness with FS::cust_main::bill, but perhaps #we should really change this bit to DateTime and DateTime::Duration @@ -878,6 +1073,7 @@ sub _usage_details { 'ending' => $p->{ending}, 'previous' => ($previous > $start) ? $previous : $start, 'next' => ($next < $end) ? $next : $end, + 'header' => $header, 'usage' => \@usage, }; } @@ -921,7 +1117,7 @@ sub order_pkg { my %fields = ( 'svc_acct' => [ qw( username domsvc _password sec_phrase popnum ) ], 'svc_domain' => [ qw( domain ) ], - 'svc_phone' => [ qw( phonenum pin sip_password ) ], + 'svc_phone' => [ qw( phonenum pin sip_password phone_name ) ], 'svc_external' => [ qw( id title ) ], ); @@ -1124,14 +1320,18 @@ sub renew_info { my $total = $cust_main->balance; my @array = map { - $total += $_->part_pkg->base_recur; + my $bill = $_->bill; + $total += $_->part_pkg->base_recur($_, \$bill); my $renew_date = $_->part_pkg->add_freq($_->bill); { - 'bill_date' => $_->bill, - 'bill_date_pretty' => time2str('%x', $_->bill), - 'renew_date' => $renew_date, - 'renew_date_pretty' => time2str('%x', $renew_date), - 'amount' => sprintf('%.2f', $total), + 'pkgnum' => $_->pkgnum, + 'amount' => sprintf('%.2f', $total), + 'bill_date' => $_->bill, + 'bill_date_pretty' => time2str('%x', $_->bill), + 'renew_date' => $renew_date, + 'renew_date_pretty' => time2str('%x', $renew_date), + 'expire_date' => $_->expire, + 'expire_date_pretty' => time2str('%x', $_->expire), }; } @cust_pkg; @@ -1140,6 +1340,15 @@ sub renew_info { } +sub payment_info_renew_info { + my $p = shift; + my $renew_info = renew_info($p); + my $payment_info = payment_info($p); + return { %$renew_info, + %$payment_info, + }; +} + sub order_renew { my $p = shift; diff --git a/FS/FS/ClientAPI/SGNG.pm b/FS/FS/ClientAPI/SGNG.pm new file mode 100644 index 0000000..7f784dc --- /dev/null +++ b/FS/FS/ClientAPI/SGNG.pm @@ -0,0 +1,277 @@ +#this stuff is SG-specific (i.e. multi-customer company username hack) + +package FS::ClientAPI::SGNG; + +use strict; +use vars qw( $cache $DEBUG ); +use Time::Local qw(timelocal timelocal_nocheck); +use Business::CreditCard; +use FS::Record qw( qsearch qsearchs ); +use FS::Conf; +use FS::cust_main; +use FS::cust_pkg; +use FS::ClientAPI::MyAccount; #qw( payment_info process_payment ) + +$DEBUG = 0; + +sub _cache { + $cache ||= new FS::ClientAPI_SessionCache( { + 'namespace' => 'FS::ClientAPI::MyAccount', #yes, share session_ids + } ); +} + +sub ping { + #my $p = shift; + + return { 'pong' => '1' }; + +} + +#this might almost be general-purpose +sub decompify_pkgs { + my $p = shift; + + my $session = _cache->get($p->{'session_id'}) + or return { 'error' => "Can't resume session" }; #better error message + + my $custnum = $session->{'custnum'}; + + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or return { 'error' => "unknown custnum $custnum" }; + + return { 'error' => 'Not a complimentary customer' } + unless $cust_main->payby eq 'COMP'; + + my $paydate = + $cust_main->paydate =~ /^\S+$/ ? $cust_main->paydate : '2037-12-31'; + + my ($payyear,$paymonth,$payday) = split (/-/,$paydate); + + my $date = timelocal(0,0,0,$payday,--$paymonth,$payyear); + + foreach my $cust_pkg ( + qsearch({ 'table' => 'cust_pkg', + 'hashref' => { 'custnum' => $custnum, + 'bill' => '', + }, + 'extra_sql' => ' AND '. FS::cust_pkg->active_sql, + }) + ) { + $cust_pkg->set('bill', $date); + my $error = $cust_pkg->replace; + return { 'error' => $error } if $error; + } + + return { 'error' => '' }; + +} + +#find old payment info +# (should work just like MyAccount::payment_info, except returns previous info +# too) +# definitly sg-specific, no one else stores past customer records like this +sub previous_payment_info { + my $p = shift; + + my $session = _cache->get($p->{'session_id'}) + or return { 'error' => "Can't resume session" }; #better error message + + my $payment_info = FS::ClientAPI::MyAccount::payment_info($p); + + my $custnum = $session->{'custnum'}; + + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or return { 'error' => "unknown custnum $custnum" }; + + #? + return $payment_info if $cust_main->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/; + + foreach my $prev_cust_main ( + reverse _previous_cust_main( 'custnum' => $custnum, + 'username' => $cust_main->company, + 'with_payments' => 1, + ) + ) { + + next unless $prev_cust_main->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/; + + if ( $prev_cust_main->payby =~ /^(CARD|DCRD)$/ ) { + + #card expired? + my ($payyear,$paymonth,$payday) = split (/-/, $cust_main->paydate); + + my $expdate = timelocal_nocheck(0,0,0,1,$paymonth,$payyear); + + next if $expdate < time; + + } elsif ( $prev_cust_main->payby =~ /^(CHEK|DCHK)$/ ) { + + #any check? or just skip these in favor of cards? + + } + + return { %$payment_info, + #$prev_cust_main->payment_info + _cust_main_payment_info( $prev_cust_main ), + 'previous_custnum' => $prev_cust_main->custnum, + }; + + } + + #still nothing? return an error? + return $payment_info; + +} + +#this is really FS::cust_main::payment_info, but here for now +sub _cust_main_payment_info { + my $self = shift; + + my %return = (); + + $return{balance} = $self->balance; + + $return{payname} = $self->payname + || ( $self->first. ' '. $self->get('last') ); + + $return{$_} = $self->get($_) for qw(address1 address2 city state zip); + + $return{payby} = $self->payby; + $return{stateid_state} = $self->stateid_state; + + if ( $self->payby =~ /^(CARD|DCRD)$/ ) { + $return{card_type} = cardtype($self->payinfo); + $return{payinfo} = $self->paymask; + + @return{'month', 'year'} = $self->paydate_monthyear; + + } + + if ( $self->payby =~ /^(CHEK|DCHK)$/ ) { + my ($payinfo1, $payinfo2) = split '@', $self->paymask; + $return{payinfo1} = $payinfo1; + $return{payinfo2} = $payinfo2; + $return{paytype} = $self->paytype; + $return{paystate} = $self->paystate; + + } + + #doubleclick protection + my $_date = time; + $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32; + + %return; + +} + +#find old cust_main records (with payments) +sub _previous_cust_main { + + #safety check! return nothing unless we're enabled explicitly + return () unless FS::Conf->new->exists('sg-multicustomer_hack'); + + my %opt = @_; + my $custnum = $opt{'custnum'}; + my $username = $opt{'username'}; + + my %search = (); + if ( $opt{'with_payments'} ) { + $search{'extra_sql'} = + ' AND 0 < ( SELECT COUNT(*) FROM cust_pay + WHERE cust_pay.custnum = cust_main.custnum + ) + '; + } + + qsearch( { + 'table' => 'cust_main', + 'hashref' => { 'company' => { op => 'ILIKE', value => $opt{'username'} }, + 'custnum' => { op => '!=', value => $opt{'custnum'} }, + }, + 'order_by' => 'ORDER BY custnum', + %search, + } ); + +} + +#since we could be passing masked old CC data, need to look that up and +#replace it (like regular process_payment does) w/info from old customer record +sub previous_process_payment { + my $p = shift; + + return FS::ClientAPI::MyAccount::process_payment($p) + unless $p->{'previous_custnum'} + && ( ( $p->{'payby'} =~ /^(CARD|DCRD)$/ && $p->{'payinfo'} =~ /x/i ) + || ( $p->{'payby'} =~ /^(CHEK|DCHK)$/ && $p->{'payinfo1'} =~ /x/i ) + ); + + my $session = _cache->get($p->{'session_id'}) + or return { 'error' => "Can't resume session" }; #better error message + + my $custnum = $session->{'custnum'}; + + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or return { 'error' => "unknown custnum $custnum" }; + + #make sure this is really a previous custnum of this customer + my @previous_cust_main = + grep { $_->custnum == $p->{'previous_custnum'} } + _previous_cust_main( 'custnum' => $custnum, + 'username' => $cust_main->company, + 'with_payments' => 1, + ); + + my $previous_cust_main = $previous_cust_main[0]; + + #causes problems with old data w/old masking method + #if $previous_cust_main->paymask eq $payinfo; + + if ( $p->{'payby'} =~ /^(CHEK|DCHK)$/ && $p->{'payinfo1'} =~ /x/i ) { + ( $p->{'payinfo1'}, $p->{'payinfo2'} ) = + split('@', $previous_cust_main->payinfo); + } elsif ( $p->{'payby'} =~ /^(CARD|DCRD)$/ && $p->{'payinfo'} =~ /x/i ) { + $p->{'payinfo'} = $previous_cust_main->payinfo; + } + + FS::ClientAPI::MyAccount::process_payment($p); + +} + +sub previous_payment_info_renew_info { + my $p = shift; + my $renew_info = renew_info($p); + my $payment_info = previous_payment_info($p); + return { %$renew_info, + %$payment_info, + }; +} + +sub previous_process_payment_order_pkg { + my $p = shift; + + my $hr = previous_process_payment($p); + return $hr if $hr->{'error'}; + + order_pkg($p); +} + +sub previous_process_payment_change_pkg { + my $p = shift; + + my $hr = previous_process_payment($p); + return $hr if $hr->{'error'}; + + change_pkg($p); +} + +sub previous_process_payment_order_renew { + my $p = shift; + + my $hr = previous_process_payment($p); + return $hr if $hr->{'error'}; + + order_renew($p); +} + +1; + diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm index 5569dfb..c376476 100644 --- a/FS/FS/ClientAPI/Signup.pm +++ b/FS/FS/ClientAPI/Signup.pm @@ -6,6 +6,7 @@ use Data::Dumper; use Tie::RefHash; use FS::Conf; use FS::Record qw(qsearch qsearchs dbdef); +use FS::CGI qw(popurl); use FS::Msgcat qw(gettext); use FS::Misc qw(card_types); use FS::ClientAPI_SessionCache; @@ -20,6 +21,7 @@ use FS::svc_phone; use FS::acct_snarf; use FS::queue; use FS::reg_code; +use FS::payby; $DEBUG = 0; $me = '[FS::ClientAPI::Signup]'; @@ -59,7 +61,9 @@ sub signup_info { } } grep { $_->svcpart($svc_x) && ( $href->{ $_->pkgpart } - || $_->agentnum == $agent->agentnum + || ( $_->agentnum + && $_->agentnum == $agent->agentnum + ) ) } qsearch( 'part_pkg', { 'disabled' => '' } ) @@ -103,6 +107,8 @@ sub signup_info { 'security_phrase' => $conf->exists('security_phrase'), + 'nomadix' => $conf->exists('signup_server-nomadix'), + 'payby' => [ $conf->config('signup_server-payby') ], 'card_types' => card_types(), @@ -276,6 +282,32 @@ sub signup_info { if ( $agentnum ) { + warn "$me setting agent-specific payment flag\n" if $DEBUG > 1; + my $agent = qsearchs('agent', { 'agentnum' => $agentnum } ); + warn "$me has agent $agent\n" if $DEBUG > 1; + if ( $agent ) { #else complain loudly? + $signup_info->{'hide_payment_fields'} = []; + foreach my $payby (@{$signup_info->{payby}}) { + warn "$me checking $payby payment fields\n" if $DEBUG > 1; + my $hide = 0; + if ( FS::payby->realtime($payby) ) { + my $payment_gateway = + $agent->payment_gateway( 'method' => FS::payby->payby2bop($payby), + 'nofatal' => 1, + ); + if ( $payment_gateway + && $payment_gateway->gateway_namespace + eq 'Business::OnlineThirdPartyPayment' + ) { + warn "$me hiding $payby payment fields\n" if $DEBUG > 1; + $hide = 1; + } + } + push @{$signup_info->{'hide_payment_fields'}}, $hide; + } + } + warn "$me done setting agent-specific payment flag\n" if $DEBUG > 1; + warn "$me setting agent-specific package list\n" if $DEBUG > 1; $signup_info->{'part_pkg'} = $signup_info->{'agentnum2part_pkg'}{$agentnum} unless @{ $signup_info->{'part_pkg'} }; @@ -295,8 +327,6 @@ sub signup_info { ]; warn "$me done setting agent-specific adv. source list\n" if $DEBUG > 1; - my $agent = qsearchs('agent', { 'agentnum' => $agentnum } ); - $signup_info->{'agent_name'} = $agent->agent; $signup_info->{'company_name'} = $conf->config('company_name', $agentnum); @@ -436,6 +466,21 @@ sub new_customer { unless grep { $_ eq $packet->{'payby'} } $conf->config('signup_server-payby'); + if (FS::payby->realtime($packet->{payby})) { + my $payby = $packet->{payby}; + + my $agent = qsearchs('agent', { 'agentnum' => $agentnum }); + return { 'error' => "Unknown reseller" } + unless $agent; + + my $gw = $agent->payment_gateway( 'method' => FS::payby->payby2bop($payby), + 'nofatal' => 1, + ); + + $cust_main->payby('BILL') # MCRD better? + if $gw && $gw->gateway_namespace eq 'Business::OnlineThirdPartyPayment'; + } + $cust_main->payinfo($cust_main->daytime) if $cust_main->payby eq 'LECB' && ! $cust_main->payinfo; @@ -469,14 +514,14 @@ sub new_customer { #return { 'error' => $error } if $error; #should be all auto-magic and shit - my $svc; + my @svc = (); if ( $svc_x eq 'svc_acct' ) { - $svc = new FS::svc_acct ( { + my $svc = new FS::svc_acct { 'svcpart' => $svcpart, map { $_ => $packet->{$_} } qw( username _password sec_phrase popnum ), - } ); + }; my @acct_snarf; my $snarfnum = 1; @@ -493,21 +538,48 @@ sub new_customer { } $svc->child_objects( \@acct_snarf ); + push @svc, $svc; + } elsif ( $svc_x eq 'svc_phone' ) { - $svc = new FS::svc_phone ( { + my $svc = new FS::svc_phone ( { 'svcpart' => $svcpart, map { $_ => $packet->{$_} } qw( countrycode phonenum sip_password pin ), } ); + push @svc, $svc; + } else { die "unknown signup service $svc_x"; } - - my $y = $svc->setdefault; # arguably should be in new method + my $y = $svc[0]->setdefault; # arguably should be in new method return { 'error' => $y } if $y && !ref($y); + if ($packet->{'mac_addr'} && $conf->exists('signup_server-mac_addr_svcparts')) + { + + my %mac_addr_svcparts = map { $_ => 1 } + $conf->config('signup_server-mac_addr_svcparts'); + my @pkg_svc = grep { $_->quantity && $mac_addr_svcparts{$_->svcpart} } + $cust_pkg->part_pkg->pkg_svc; + + return { 'error' => 'No service defined to assign mac address' } + unless @pkg_svc; + + my $svc = new FS::svc_acct { + 'svcpart' => $pkg_svc[0]->svcpart, #multiple matches? alas.. + 'username' => $packet->{'mac_addr'}, + '_password' => '', #blank as requested (set passwordmin to 0) + }; + + my $y = $svc->setdefault; # arguably should be in new method + return { 'error' => $y } if $y && !ref($y); + + push @svc, $svc; + + } + #$error = $svc->check; #return { 'error' => $error } if $error; @@ -521,7 +593,7 @@ sub new_customer { use Tie::RefHash; tie my %hash, 'Tie::RefHash'; - %hash = ( $cust_pkg => [ $svc ] ); + %hash = ( $cust_pkg => \@svc ); #msgcat $error = $cust_main->insert( \%hash, @@ -547,10 +619,26 @@ sub new_customer { # " new customer: $bill_error" # if $bill_error; - $bill_error = $cust_main->collect('realtime' => 1); + if ($cust_main->_new_bop_required()) { + $bill_error = $cust_main->realtime_collect( + method => FS::payby->payby2bop( $packet->{payby} ), + depend_jobnum => $placeholder->jobnum, + ); + } else { + $bill_error = $cust_main->collect('realtime' => 1); + } #warn "[fs_signup_server] error collecting from new customer: $bill_error" # if $bill_error; + if ($bill_error && ref($bill_error) eq 'HASH') { + return { 'error' => '_collect', + ( map { $_ => $bill_error->{$_} } + qw(popup_url reference collectitems) + ), + amount => $cust_main->balance, + }; + } + if ( $cust_main->balance > 0 ) { #this makes sense. credit is "un-doing" the invoice @@ -589,9 +677,9 @@ sub new_customer { ); if ( $svc_x eq 'svc_acct' ) { - $return{$_} = $svc->$_() for qw( username _password ); + $return{$_} = $svc[0]->$_() for qw( username _password ); } elsif ( $svc_x eq 'svc_phone' ) { - $return{$_} = $svc->$_() for qw( countrycode phonenum sip_password pin ); + $return{$_} = $svc[0]->$_() for qw( countrycode phonenum sip_password pin ); } else { die "unknown signup service $svc_x"; } @@ -600,4 +688,83 @@ sub new_customer { } +sub capture_payment { + my $packet = shift; + + warn "$me capture_payment called on $packet\n" if $DEBUG; + + ### + # identify processor/gateway from called back URL + ### + + my $conf = new FS::Conf; + + my $url = $packet->{url}; + my $payment_gateway = + qsearchs('payment_gateway', { 'gateway_callback_url' => popurl(0, $url) } ); + + unless ($payment_gateway) { + + my ( $processor, $login, $password, $action, @bop_options ) = + $conf->config('business-onlinepayment'); + $action ||= 'normal authorization'; + pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/; + die "No real-time processor is enabled - ". + "did you set the business-onlinepayment configuration value?\n" + unless $processor; + + $payment_gateway = new FS::payment_gateway( { + gateway_namespace => $conf->config('business-onlinepayment-namespace'), + gateway_module => $processor, + gateway_username => $login, + gateway_password => $password, + gateway_action => $action, + options => [ ( @bop_options ) ], + }); + + } + + die "No real-time third party processor is enabled - ". + "did you set the business-onlinepayment configuration value?\n*" + unless $payment_gateway->gateway_namespace eq 'Business::OnlineThirdPartyPayment'; + + ### + # locate pending transaction + ### + + eval "use Business::OnlineThirdPartyPayment"; + die $@ if $@; + + my $transaction = + new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module, + @{ [ $payment_gateway->options ] }, + ); + + my $paypendingnum = $transaction->reference($packet->{data}); + + my $cust_pay_pending = + qsearchs('cust_pay_pending', { paypendingnum => $paypendingnum } ); + + unless ($cust_pay_pending) { + my $bill_error = "No payment is being processed with id $paypendingnum". + "; Transaction aborted."; + return { error => '_decline', bill_error => $bill_error }; + } + + if ($cust_pay_pending->status ne 'pending') { + my $bill_error = "Payment with id $paypendingnum is not pending, but ". + $cust_pay_pending->status. "; Transaction aborted."; + return { error => '_decline', bill_error => $bill_error }; + } + + my $cust_main = $cust_pay_pending->cust_main; + my $bill_error = + $cust_main->realtime_botpp_capture( $cust_pay_pending, %{$packet->{data}} ); + + return { 'error' => ( $bill_error->{bill_error} ? '_decline' : '' ), + %$bill_error, + }; + +} + 1; diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index b869302..13bec18 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -8,6 +8,7 @@ use MIME::Base64; use FS::ConfItem; use FS::ConfDefaults; use FS::Conf_compat17; +use FS::payby; use FS::conf; use FS::Record qw(qsearch qsearchs); use FS::UID qw(dbh datasrc use_confcompat); @@ -75,11 +76,23 @@ sub base_dir { $1; } -=item config KEY [ AGENTNUM ] +=item conf KEY [ AGENTNUM [ NODEFAULT ] ] + +Returns the L<FS::conf> record for the key and agent. + +=cut + +sub conf { + my $self = shift; + $self->_config(@_); +} + +=item config KEY [ AGENTNUM [ NODEFAULT ] ] Returns the configuration value or values (depending on context) for key. The optional agent number selects an agent specific value instead of the -global default if one is present. +global default if one is present. If NODEFAULT is true only the agent +specific value(s) is returned. =cut @@ -92,12 +105,12 @@ sub _usecompat { } sub _config { - my($self,$name,$agentnum)=@_; + my($self,$name,$agentnum,$agentonly)=@_; my $hashref = { 'name' => $name }; $hashref->{agentnum} = $agentnum; local $FS::Record::conf = undef; # XXX evil hack prevents recursion my $cv = FS::Record::qsearchs('conf', $hashref); - if (!$cv && defined($agentnum) && $agentnum) { + if (!$agentonly && !$cv && defined($agentnum) && $agentnum) { $hashref->{agentnum} = ''; $cv = FS::Record::qsearchs('conf', $hashref); } @@ -108,12 +121,10 @@ sub config { my $self = shift; return $self->_usecompat('config', @_) if use_confcompat; - my($name, $agentnum)=@_; - - carp "FS::Conf->config($name, $agentnum) called" + carp "FS::Conf->config(". join(', ', @_). ") called" if $DEBUG > 1; - my $cv = $self->_config($name, $agentnum) or return; + my $cv = $self->_config(@_) or return; if ( wantarray ) { my $v = $cv->value; @@ -124,7 +135,7 @@ sub config { } } -=item config_binary KEY [ AGENTNUM ] +=item config_binary KEY [ AGENTNUM [ NODEFAULT ] ] Returns the exact scalar value for key. @@ -134,12 +145,11 @@ sub config_binary { my $self = shift; return $self->_usecompat('config_binary', @_) if use_confcompat; - my($name,$agentnum)=@_; - my $cv = $self->_config($name, $agentnum) or return; + my $cv = $self->_config(@_) or return; decode_base64($cv->value); } -=item exists KEY [ AGENTNUM ] +=item exists KEY [ AGENTNUM [ NODEFAULT ] ] Returns true if the specified key exists, even if the corresponding value is undefined. @@ -152,10 +162,10 @@ sub exists { my($name, $agentnum)=@_; - carp "FS::Conf->exists($name, $agentnum) called" + carp "FS::Conf->exists(". join(', ', @_). ") called" if $DEBUG > 1; - defined($self->_config($name, $agentnum)); + defined($self->_config(@_)); } =item config_orbase KEY SUFFIX @@ -450,11 +460,12 @@ sub _orbase_items { die "don't know about $base items" unless $proto->key eq $base; map { new FS::ConfItem { - 'key' => $_, - 'section' => $proto->section, - 'description' => 'Alternate ' . $proto->description . ' See the <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration#Invoice_templates">billing documentation</a> for details.', - 'type' => $proto->type, - }; + 'key' => $_, + 'base_key' => $proto->key, + 'section' => $proto->section, + 'description' => 'Alternate ' . $proto->description . ' See the <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration#Invoice_templates">billing documentation</a> for details.', + 'type' => $proto->type, + }; } &$listmaker($base); } @base_items, ); @@ -563,17 +574,28 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'alert_expiration', + 'section' => 'billing', + 'description' => 'Enable alerts about billing method expiration.', + 'type' => 'checkbox', + 'per_agent' => 1, + }, + + { 'key' => 'alerter_template', 'section' => 'billing', 'description' => 'Template file for billing method expiration alerts. See the <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration#Credit_cards_and_Electronic_checks">billing documentation</a> for details.', 'type' => 'textarea', - 'per-agent' => 1, + 'per_agent' => 1, }, { 'key' => 'apacheip', - 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add an <i>apache</i> <a href="../browse/part_export.cgi">export</a> instead. Used to be the current IP address to assign to new virtual hosts', + #not actually deprecated yet + #'section' => 'deprecated', + #'description' => '<b>DEPRECATED</b>, add an <i>apache</i> <a href="../browse/part_export.cgi">export</a> instead. Used to be the current IP address to assign to new virtual hosts', + 'section' => '', + 'description' => 'IP address to assign to new virtual hosts', 'type' => 'text', }, @@ -606,6 +628,40 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'billco-url', + 'section' => 'billing', + 'description' => 'The url to use for performing uploads to the invoice mailing service.', + 'type' => 'text', + 'per_agent' => 1, + }, + + { + 'key' => 'billco-username', + 'section' => 'billing', + 'description' => 'The login name to use for uploads to the invoice mailing service.', + 'type' => 'text', + 'per_agent' => 1, + 'agentonly' => 1, + }, + + { + 'key' => 'billco-password', + 'section' => 'billing', + 'description' => 'The password to use for uploads to the invoice mailing service.', + 'type' => 'text', + 'per_agent' => 1, + 'agentonly' => 1, + }, + + { + 'key' => 'billco-clicode', + 'section' => 'billing', + 'description' => 'The clicode to use for uploads to the invoice mailing service.', + 'type' => 'text', + 'per_agent' => 1, + }, + + { 'key' => 'business-onlinepayment', 'section' => 'billing', 'description' => '<a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a> support, at least three lines: processor, login, and password. An optional fourth line specifies the action or actions (multiple actions are separated with `,\': for example: `Authorization Only, Post Authorization\'). Optional additional lines are passed to Business::OnlinePayment as %processor_options.', @@ -620,6 +676,17 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'business-onlinepayment-namespace', + 'section' => 'billing', + 'description' => 'Specifies which perl module namespace (which group of collection routines) is used by default.', + 'type' => 'select', + 'select_hash' => [ + 'Business::OnlinePayment' => 'Direct API (Business::OnlinePayment)', + 'Business::OnlineThirdPartyPayment' => 'Web API (Business::ThirdPartyPayment)', + ], + }, + + { 'key' => 'business-onlinepayment-description', 'section' => 'billing', 'description' => 'String passed as the description field to <a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a>. Evaluated as a double-quoted perl string, with the following variables available: <code>$agent</code> (the agent name), and <code>$pkgs</code> (a comma-separated list of packages for which these charges apply)', @@ -661,7 +728,14 @@ worry that config_items is freeside-specific and icky. { 'key' => 'deletecustomers', 'section' => 'UI', - 'description' => '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.', + 'description' => 'Enable customer deletions. Be very careful! Deleting a customer will remove all traces that the 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.', + 'type' => 'checkbox', + }, + + { + 'key' => 'deleteinvoices', + 'section' => 'UI', + 'description' => 'Enable invoices deletions. Be very careful! Deleting an invoice will remove all traces that the invoice ever existed! Normally, you would apply a credit against the invoice instead.', #invoice voiding? 'type' => 'checkbox', }, @@ -674,8 +748,11 @@ worry that config_items is freeside-specific and icky. { 'key' => 'deletecredits', - 'section' => 'deprecated', - 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to 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.', + #not actually deprecated yet + #'section' => 'deprecated', + #'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to 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.', + 'section' => '', + 'description' => 'One or more comma-separated email addresses to be notified when a credit is deleted.', 'type' => [qw( checkbox text )], }, @@ -687,6 +764,20 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'unapplypayments', + 'section' => 'deprecated', + 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable "unapplication" of unclosed payments.', + 'type' => 'checkbox', + }, + + { + 'key' => 'unapplycredits', + 'section' => 'deprecated', + 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to nable "unapplication" of unclosed credits.', + 'type' => 'checkbox', + }, + + { 'key' => 'dirhash', 'section' => 'shell', 'description' => 'Optional numeric value to control directory hashing. If positive, hashes directories for the specified number of levels from the front of the username. If negative, hashes directories for the specified number of levels from the end of the username. Some examples: <ul><li>1: user -> <a href="#home">/home</a>/u/user<li>2: user -> <a href="#home">/home</a>/u/s/user<li>-1: user -> <a href="#home">/home</a>/r/user<li>-2: user -> <a href="#home">home</a>/r/e/user</ul>', @@ -694,6 +785,20 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'disable_cust_attachment', + 'section' => '', + 'description' => 'Disable customer file attachments', + 'type' => 'checkbox', + }, + + { + 'key' => 'max_attachment_size', + 'section' => '', + 'description' => 'Maximum size for customer file attachments (leave blank for unlimited)', + 'type' => 'text', + }, + + { 'key' => 'disable_customer_referrals', 'section' => 'UI', 'description' => 'Disable new customer-to-customer referrals in the web interface', @@ -787,6 +892,13 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'invoice_usesummary', + 'section' => 'billing', + 'description' => 'Indicates that html and latex invoices should be in summary style and make use of invoice_latexsummary.', + 'type' => 'checkbox', + }, + + { 'key' => 'invoice_template', 'section' => 'billing', 'description' => 'Text template file for invoices. Used if no invoice_html template is defined, and also seen by users using non-HTML capable mail clients. See the <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration#Plaintext_invoice_templates">billing documentation</a> for details.', @@ -806,6 +918,7 @@ worry that config_items is freeside-specific and icky. 'section' => 'billing', 'description' => 'Notes section for HTML invoices. Defaults to the same data in invoice_latexnotes if not specified.', 'type' => 'textarea', + 'per_agent' => 1, }, { @@ -813,6 +926,15 @@ worry that config_items is freeside-specific and icky. 'section' => 'billing', 'description' => 'Footer for HTML invoices. Defaults to the same data in invoice_latexfooter if not specified.', 'type' => 'textarea', + 'per_agent' => 1, + }, + + { + 'key' => 'invoice_htmlsummary', + 'section' => 'billing', + 'description' => 'Summary initial page for HTML invoices.', + 'type' => 'textarea', + 'per_agent' => 1, }, { @@ -834,6 +956,7 @@ worry that config_items is freeside-specific and icky. 'section' => 'billing', 'description' => 'Notes section for LaTeX typeset PostScript invoices.', 'type' => 'textarea', + 'per_agent' => 1, }, { @@ -841,6 +964,15 @@ worry that config_items is freeside-specific and icky. 'section' => 'billing', 'description' => 'Footer for LaTeX typeset PostScript invoices.', 'type' => 'textarea', + 'per_agent' => 1, + }, + + { + 'key' => 'invoice_latexsummary', + 'section' => 'billing', + 'description' => 'Summary initial page for LaTeX typeset PostScript invoices.', + 'type' => 'textarea', + 'per_agent' => 1, }, { @@ -848,6 +980,7 @@ worry that config_items is freeside-specific and icky. 'section' => 'billing', 'description' => 'Remittance coupon for LaTeX typeset PostScript invoices.', 'type' => 'textarea', + 'per_agent' => 1, }, { @@ -862,6 +995,7 @@ worry that config_items is freeside-specific and icky. 'section' => 'billing', 'description' => 'Optional small footer for multi-page LaTeX typeset PostScript invoices.', 'type' => 'textarea', + 'per_agent' => 1, }, { @@ -890,10 +1024,29 @@ worry that config_items is freeside-specific and icky. { 'key' => 'invoice_sections', 'section' => 'billing', - 'description' => 'Split invoice into sections and label according to package class when enabled.', + 'description' => 'Split invoice into sections and label according to package category when enabled.', 'type' => 'checkbox', }, + { + 'key' => 'finance_pkgclass', + 'section' => 'billing', + 'description' => 'The package class for finance charges', + 'type' => 'select-sub', + 'options_sub' => sub { require FS::Record; + require FS::pkg_class; + map { $_->classnum => $_->classname } + FS::Record::qsearch('pkg_class', {} ); + }, + 'option_sub' => sub { require FS::Record; + require FS::pkg_class; + my $pkg_class = FS::Record::qsearchs( + 'pkg_class', { 'classnum'=>shift } + ); + $pkg_class ? $pkg_class->classname : ''; + }, + }, + { 'key' => 'separate_usage', 'section' => 'billing', @@ -902,13 +1055,31 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'invoice_send_receipts', + 'section' => 'deprecated', + 'description' => '<b>DEPRECATED</b>, this used to send an invoice copy on payments and credits. See the payment_receipt_email and XXXX instead.', + 'type' => 'checkbox', + }, + + { 'key' => 'payment_receipt_email', 'section' => 'billing', - 'description' => 'Template file for payment receipts. Payment receipts are sent to the customer email invoice destination(s) when a payment is received. See the <a href="http://search.cpan.org/dist/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation for details on the template substitution language. The following variables are available: <ul><li><code>$date</code> <li><code>$name</code> <li><code>$paynum</code> - Freeside payment number <li><code>$paid</code> - Amount of payment <li><code>$payby</code> - Payment type (Card, Check, Electronic check, etc.) <li><code>$payinfo</code> - Masked credit card number or check number <li><code>$balance</code> - New balance</ul>', + 'description' => 'Template file for payment receipts. Payment receipts are sent to the customer email invoice destination(s) when a payment is received. See the <a href="http://search.cpan.org/dist/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation for details on the template substitution language. The following variables are available: <ul><li><code>$date</code> <li><code>$name</code> <li><code>$paynum</code> - Freeside payment number <li><code>$paid</code> - Amount of payment <li><code>$payby</code> - Payment type (Card, Check, Electronic check, etc.) <li><code>$payinfo</code> - Masked credit card number or check number <li><code>$balance</code> - New balance<li><code>$pkg</code> - Package (requires payment_receipt-trigger set to "when payment is applied".)</ul>', 'type' => [qw( checkbox textarea )], }, { + 'key' => 'payment_receipt-trigger', + 'section' => 'billing', + 'description' => 'When payment receipts are triggered. Defaults to when payment is made.', + 'type' => 'select', + 'select_hash' => [ + 'cust_pay' => 'When payment is made.', + 'cust_bill_pay_pkg' => 'When payment is applied.', + ], + }, + + { 'key' => 'lpr', 'section' => 'required', 'description' => 'Print command for paper invoices, for example `lpr -h\'', @@ -990,6 +1161,13 @@ worry that config_items is freeside-specific and icky. # }, { + 'key' => 'report_template', + 'section' => 'deprecated', + 'description' => 'Deprecated template file for reports.', + 'type' => 'textarea', + }, + + { 'key' => 'maxsearchrecordsperpage', 'section' => 'UI', 'description' => 'If set, number of search records to return per page.', @@ -1127,6 +1305,7 @@ worry that config_items is freeside-specific and icky. 'section' => 'username', 'description' => 'Usernames must contain at least one letter', 'type' => 'checkbox', + 'per_agent' => 1, }, { @@ -1171,6 +1350,13 @@ worry that config_items is freeside-specific and icky. 'type' => 'checkbox', }, + { + 'key' => 'username-colon', + 'section' => 'username', + 'description' => 'Allow the colon character (:) in usernames.', + 'type' => 'checkbox', + }, + { 'key' => 'safe-part_bill_event', 'section' => 'UI', @@ -1293,44 +1479,29 @@ worry that config_items is freeside-specific and icky. 'key' => 'signup_server-default_pkgpart', 'section' => '', 'description' => 'Default package for the signup server', - 'type' => 'select-sub', - 'options_sub' => sub { require FS::Record; - require FS::part_pkg; - map { $_->pkgpart => $_->pkg.' - '.$_->comment } - FS::Record::qsearch( 'part_pkg', - { 'disabled' => ''} - ); - }, - 'option_sub' => sub { require FS::Record; - require FS::part_pkg; - my $part_pkg = FS::Record::qsearchs( - 'part_pkg', { 'pkgpart'=>shift } - ); - $part_pkg - ? $part_pkg->pkg.' - '.$part_pkg->comment - : ''; - }, + 'type' => 'select-part_pkg', }, { 'key' => 'signup_server-default_svcpart', 'section' => '', - 'description' => 'Default svcpart for the signup server - only necessary for services that trigger special provisioning widgets (such as DID provisioning).', - 'type' => 'select-sub', - 'options_sub' => sub { require FS::Record; - require FS::part_svc; - map { $_->svcpart => $_->svc } - FS::Record::qsearch( 'part_svc', - { 'disabled' => ''} - ); - }, - 'option_sub' => sub { require FS::Record; - require FS::part_svc; - my $part_svc = FS::Record::qsearchs( - 'part_svc', { 'svcpart'=>shift } - ); - $part_svc ? $part_svc->svc : ''; - }, + 'description' => 'Default service definition for the signup server - only necessary for services that trigger special provisioning widgets (such as DID provisioning).', + 'type' => 'select-part_svc', + }, + + { + 'key' => 'signup_server-mac_addr_svcparts', + 'section' => '', + 'description' => 'Service definitions which can receive mac addresses (current mapped to username for svc_acct).', + 'type' => 'select-part_svc', + 'multiple' => 1, + }, + + { + 'key' => 'signup_server-nomadix', + 'section' => '', + 'description' => 'Signup page Nomadix integration', + 'type' => 'checkbox', }, { @@ -1347,7 +1518,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'selfservice_server-base_url', 'section' => '', - 'description' => 'Base URL for the self-service web interface - necessary for special provisioning widgets to find their way.', + 'description' => 'Base URL for the self-service web interface - necessary for some widgets to find their way, including retrieval of non-US state information and phone number provisioning.', 'type' => 'text', }, @@ -1452,6 +1623,13 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'bill_usage_on_cancel', + 'section' => 'billing', + 'description' => 'Enable automatic generation of an invoice for usage when a package is cancelled. Not all packages can do this. Usage data must already be available.', + 'type' => 'checkbox', + }, + + { 'key' => 'require_cardname', 'section' => 'billing', 'description' => 'Require an "Exact name on card" to be entered explicitly; don\'t default to using the first and last name.', @@ -1475,7 +1653,14 @@ worry that config_items is freeside-specific and icky. { 'key' => 'enable_taxproducts', 'section' => 'billing', - 'description' => 'Enable per-package mapping to new style tax classes', + 'description' => 'Enable per-package mapping to vendor tax data from CCH or elsewhere.', + 'type' => 'checkbox', + }, + + { + 'key' => 'taxdatadirectdownload', + 'section' => 'billing', #well + 'description' => 'Enable downloading tax data directly from the vendor site', 'type' => 'checkbox', }, @@ -1608,6 +1793,14 @@ worry that config_items is freeside-specific and icky. 'select_enum' => [ 'Framed-IP-Address', 'Framed-Address' ], }, + #http://dev.coova.org/svn/coova-chilli/doc/dictionary.chillispot + { + 'key' => 'radius-chillispot-max', + 'section' => '', + 'description' => 'Enable ChilliSpot (and CoovaChilli) Max attributes, specifically ChilliSpot-Max-{Input,Output,Total}-{Octets,Gigawords}.', + 'type' => 'checkbox', + }, + { 'key' => 'svc_acct-alldomains', 'section' => '', @@ -1630,6 +1823,31 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'users-allow_comp', + 'section' => 'deprecated', + 'description' => '<b>DEPRECATED</b>, enable the <i>Complimentary customer</i> access right instead. Was: Usernames (Freeside users, created with <a href="../docs/man/bin/freeside-adduser.html">freeside-adduser</a>) which can create complimentary customers, one per line. If no usernames are entered, all users can create complimentary accounts.', + 'type' => 'textarea', + }, + + { + 'key' => 'credit_card-recurring_billing_flag', + 'section' => 'billing', + 'description' => 'This controls when the system passes the "recurring_billing" flag on credit card transactions. If supported by your processor (and the Business::OnlinePayment processor module), passing the flag indicates this is a recurring transaction and may turn off the CVV requirement. ', + 'type' => 'select', + 'select_hash' => [ + 'actual_oncard' => 'Default/classic behavior: set the flag if a customer has actual previous charges on the card.', + 'transaction_is_recur' => 'Set the flag if the transaction itself is recurring, irregardless of previous charges on the card.', + ], + }, + + { + 'key' => 'credit_card-recurring_billing_acct_code', + 'section' => 'billing', + 'description' => 'When the "recurring billing" flag is set, also set the "acct_code" to "rebill". Useful for reporting purposes with supported gateways (PlugNPay, others?)', + 'type' => 'checkbox', + }, + + { 'key' => 'cvv-save', 'section' => 'billing', 'description' => 'Save CVV2 information after the initial transaction for the selected credit card types. Enabling this option may be in violation of your merchant agreement(s), so please check them carefully before enabling this option for any credit card types.', @@ -1638,6 +1856,31 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'manual_process-pkgpart', + 'section' => 'billing', + 'description' => 'Package to add to each manual credit card and ACH payments entered from the backend. Enabling this option may be in violation of your merchant agreement(s), so please check them carefully before enabling this option.', + 'type' => 'select-part_pkg', + }, + + { + 'key' => 'manual_process-display', + 'section' => 'billing', + 'description' => 'When using manual_process-pkgpart, add the fee to the amount entered (default), or subtract the fee from the amount entered.', + 'type' => 'select', + 'select_hash' => [ + 'add' => 'Add fee to amount entered', + 'subtract' => 'Subtract fee from amount entered', + ], + }, + + { + 'key' => 'manual_process-skip_first', + 'section' => 'billing', + 'description' => "When using manual_process-pkgpart, omit the fee if it is the customer's first payment.", + 'type' => 'checkbox', + }, + + { 'key' => 'allow_negative_charges', 'section' => 'billing', 'description' => 'Allow negative charges. Normally not used unless importing data from a legacy system that requires this.', @@ -1682,7 +1925,8 @@ worry that config_items is freeside-specific and icky. 'key' => 'svc_www-usersvc_svcpart', 'section' => '', 'description' => 'Allowable service definition svcparts for virtual hosts, one per line.', - 'type' => 'textarea', + 'type' => 'select-part_svc', + 'multiple' => 1, }, { @@ -1847,6 +2091,27 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'echeck-void', + 'section' => 'deprecated', + 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable local-only voiding of echeck payments in addition to refunds against the payment gateway', + 'type' => 'checkbox', + }, + + { + 'key' => 'cc-void', + 'section' => 'deprecated', + 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable local-only voiding of credit card payments in addition to refunds against the payment gateway', + 'type' => 'checkbox', + }, + + { + 'key' => 'unvoid', + 'section' => 'deprecated', + 'description' => '<B>DEPRECATED</B>, now controlled by ACLs. Used to enable unvoiding of voided payments', + 'type' => 'checkbox', + }, + + { 'key' => 'address2-search', 'section' => 'UI', 'description' => 'Enable a "Unit" search box which searches the second address field. Useful for multi-tenant applications. See also: cust_main-require_address2', @@ -1955,7 +2220,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'svc_acct-usage_threshold', 'section' => 'billing', - 'description' => 'The threshold (expressed as percentage) of acct.seconds or acct.up|down|totalbytes at which a warning message is sent to a service holder. Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd. Defaults to 80.', + 'description' => 'The threshold (expressed as percentage) of acct.seconds or acct.up|down|totalbytes at which a warning message is sent to a service holder. Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.', 'type' => 'text', }, @@ -2024,6 +2289,20 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'voip-cdr_email', + 'section' => '', + 'description' => 'Include the call details on emailed invoices even if the customer is configured for not printing them on the invoices.', + 'type' => 'checkbox', + }, + + { + 'key' => 'voip-cust_email_csv_cdr', + 'section' => '', + 'description' => 'Enable the per-customer option for including CDR information as a CSV attachment on emailed invoices.', + 'type' => 'checkbox', + }, + + { 'key' => 'svc_forward-arbitrary_dst', 'section' => '', 'description' => "Allow forwards to point to arbitrary strings that don't necessarily look like email addresses. Only used when using forwards for weird, non-email things.", @@ -2040,21 +2319,35 @@ worry that config_items is freeside-specific and icky. { 'key' => 'tax-pkg_address', 'section' => 'billing', - 'description' => 'By default, tax calculations are done based on the billing address. Enable this switch to calculate tax based on the package address instead (when present).', + 'description' => 'By default, tax calculations are done based on the billing address. Enable this switch to calculate tax based on the package address instead (when present). Note that this option is currently incompatible with vendor data taxation enabled by enable_taxproducts.', 'type' => 'checkbox', }, { 'key' => 'invoice-ship_address', 'section' => 'billing', - 'description' => 'Enable this switch to include the ship address on the invoice.', + 'description' => 'Include the shipping address on invoices.', 'type' => 'checkbox', }, { 'key' => 'invoice-unitprice', 'section' => 'billing', - 'description' => 'This switch enables unit pricing on the invoice.', + 'description' => 'Enable unit pricing on invoices.', + 'type' => 'checkbox', + }, + + { + 'key' => 'invoice-smallernotes', + 'section' => 'billing', + 'description' => 'Display the notes section in a smaller font on invoices.', + 'type' => 'checkbox', + }, + + { + 'key' => 'invoice-smallerfooter', + 'section' => 'billing', + 'description' => 'Display footers in a smaller font on invoices.', 'type' => 'checkbox', }, @@ -2062,19 +2355,7 @@ worry that config_items is freeside-specific and icky. 'key' => 'postal_invoice-fee_pkgpart', 'section' => 'billing', 'description' => 'This allows selection of a package to insert on invoices for customers with postal invoices selected.', - 'type' => 'select-sub', - 'options_sub' => sub { require FS::Record; - require FS::part_pkg; - map { $_->pkgpart => $_->pkg } - FS::Record::qsearch('part_pkg', { disabled=>'' } ); - }, - 'option_sub' => sub { require FS::Record; - require FS::part_pkg; - my $part_pkg = FS::Record::qsearchs( - 'part_pkg', { 'pkgpart'=>shift } - ); - $part_pkg ? $part_pkg->pkg : ''; - }, + 'type' => 'select-part_pkg', }, { @@ -2167,6 +2448,13 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'batchconfig-paymentech', + 'section' => 'billing', + 'description' => 'Configuration for Chase Paymentech batching, four lines: 1. BIN, 2. Terminal ID, 3. Merchant ID, 4. Username', + 'type' => 'textarea', + }, + + { 'key' => 'payment_history-years', 'section' => 'UI', 'description' => 'Number of years of payment history to show by default. Currently defaults to 2.', @@ -2174,6 +2462,20 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'change_history-years', + 'section' => 'UI', + 'description' => 'Number of years of change history to show by default. Currently defaults to 0.5.', + 'type' => 'text', + }, + + { + 'key' => 'cust_main-packages-years', + 'section' => 'UI', + 'description' => 'Number of years to show old (cancelled and one-time charge) packages by default. Currently defaults to 2.', + 'type' => 'text', + }, + + { 'key' => 'cust_main-use_comments', 'section' => 'UI', 'description' => 'Display free form comments on the customer edit screen. Useful as a scratch pad.', @@ -2265,6 +2567,14 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'dashboard-install_welcome', + 'section' => 'UI', + 'description' => 'New install welcome screen.', + 'type' => 'select', + 'select_enum' => [ '', 'ITSP_fsinc_hosted', ], + }, + + { 'key' => 'dashboard-toplist', 'section' => 'UI', 'description' => 'List of items to display on the top of the front page', @@ -2292,7 +2602,7 @@ worry that config_items is freeside-specific and icky. 'key' => 'logo.eps', 'section' => 'billing', #? 'description' => 'Company logo for printed and PDF invoices, in EPS format.', - 'type' => 'binary', + 'type' => 'image', 'per_agent' => 1, #XXX as above, kinda }, @@ -2357,7 +2667,8 @@ worry that config_items is freeside-specific and icky. 'key' => 'support_packages', 'section' => '', 'description' => 'A list of packages eligible for RT ticket time transfer, one pkgpart per line.', #this should really be a select multiple, or specified in the packages themselves... - 'type' => 'textarea', + 'type' => 'select-part_pkg', + 'multiple' => 1, }, { @@ -2474,6 +2785,13 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'previous_balance-summary_only', + 'section' => 'billing', + 'description' => 'Only show a single line summarizing the total previous balance rather than one line per invoice.', + 'type' => 'checkbox', + }, + + { 'key' => 'usps_webtools-userid', 'section' => 'UI', 'description' => 'Production UserID for USPS web tools. Enables USPS address standardization. See the <a href="http://www.usps.com/webtools/">USPS website</a>, register and agree not to use the tools for batch purposes.', @@ -2495,6 +2813,35 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'cust_main-require_censustract', + 'section' => 'UI', + 'description' => 'Customer is required to have a census tract. Useful for FCC form 477 reports. See also: cust_main-auto_standardize_address', + 'type' => 'checkbox', + }, + + { + 'key' => 'census_year', + 'section' => 'UI', + 'description' => 'The year to use in census tract lookups', + 'type' => 'select', + 'select_enum' => [ qw( 2009 2008 2007 2006 ) ], + }, + + { + 'key' => 'company_latitude', + 'section' => 'UI', + 'description' => 'Your company latitude (-90 through 90)', + 'type' => 'text', + }, + + { + 'key' => 'company_longitude', + 'section' => 'UI', + 'description' => 'Your company longitude (-180 thru 180)', + 'type' => 'text', + }, + + { 'key' => 'disable_acl_changes', 'section' => '', 'description' => 'Disable all ACL changes, for demos.', @@ -2511,7 +2858,14 @@ worry that config_items is freeside-specific and icky. { 'key' => 'cust_main-default_agent_custid', 'section' => 'UI', - 'description' => 'Display the agent_custid field instead of the custnum field.', + 'description' => 'Display the agent_custid field when available instead of the custnum field.', + 'type' => 'checkbox', + }, + + { + 'key' => 'cust_bill-default_agent_invid', + 'section' => 'UI', + 'description' => 'Display the agent_invid field when available instead of the invnum field.', 'type' => 'checkbox', }, @@ -2536,7 +2890,7 @@ worry that config_items is freeside-specific and icky. 'key' => 'mcp_svcpart', 'section' => '', 'description' => 'Master Control Program svcpart. Leave this blank.', - 'type' => 'text', + 'type' => 'text', #select-part_svc }, { @@ -2598,6 +2952,23 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'selfservice-bulk_format', + 'section' => '', + 'description' => 'Parameter arrangement for selfservice bulk features', + 'type' => 'select', + 'select_enum' => [ '', 'izoom-soap', 'izoom-ftp' ], + 'per_agent' => 1, + }, + + { + 'key' => 'selfservice-bulk_ftp_dir', + 'section' => '', + 'description' => 'Enable bulk ftp provisioning in this folder', + 'type' => 'text', + 'per_agent' => 1, + }, + + { 'key' => 'signup-no_company', 'section' => '', 'description' => "Don't display a field for company name on signup.", @@ -2647,9 +3018,30 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'cdr-charged_party-accountcode-trim_leading_0s', + 'section' => '', + 'description' => 'When setting the charged_party field of CDRs to the accountcode, trim any leading zeros.', + 'type' => 'checkbox', + }, + +# { +# 'key' => 'cdr-charged_party-truncate_prefix', +# 'section' => '', +# 'description' => 'If the charged_party field has this prefix, truncate it to the length in cdr-charged_party-truncate_length.', +# 'type' => 'text', +# }, +# +# { +# 'key' => 'cdr-charged_party-truncate_length', +# 'section' => '', +# 'description' => 'If the charged_party field has the prefix in cdr-charged_party-truncate_prefix, truncate it to this length.', +# 'type' => 'text', +# }, + + { 'key' => 'cdr-charged_party_rewrite', 'section' => '', - 'description' => 'Do charged party rewriting in the freeside-cdrrewrited daemon; useful if CDRs are being dropped off directly in the database and require special charged_party processing such as cdr-charged_party-accountcode.', + 'description' => 'Do charged party rewriting in the freeside-cdrrewrited daemon; useful if CDRs are being dropped off directly in the database and require special charged_party processing such as cdr-charged_party-accountcode or cdr-charged_party-truncate*.', 'type' => 'checkbox', }, @@ -2674,6 +3066,186 @@ worry that config_items is freeside-specific and icky. 'type' => 'checkbox', }, + { + 'key' => 'sg-multicustomer_hack', + 'section' => '', + 'description' => "Don't use this.", + 'type' => 'checkbox', + }, + + { + 'key' => 'sg-ping_username', + 'section' => '', + 'description' => "Don't use this.", + 'type' => 'text', + }, + + { + 'key' => 'sg-ping_password', + 'section' => '', + 'description' => "Don't use this.", + 'type' => 'text', + }, + + { + 'key' => 'sg-login_username', + 'section' => '', + 'description' => "Don't use this.", + 'type' => 'text', + }, + + { + 'key' => 'disable-cust-pkg_class', + 'section' => 'UI', + 'description' => 'Disable the two-step dropdown for selecting package class and package, and return to the classic single dropdown.', + 'type' => 'checkbox', + }, + + { + 'key' => 'queued-max_kids', + 'section' => '', + 'description' => 'Maximum number of queued processes. Defaults to 10.', + 'type' => 'text', + }, + + { + 'key' => 'cancelled_cust-noevents', + 'section' => 'billing', + 'description' => "Don't run events for cancelled customers", + 'type' => 'checkbox', + }, + + { + 'key' => 'agent-invoice_template', + 'section' => 'billing', + 'description' => 'Enable display/edit of old-style per-agent invoice template selection', + 'type' => 'checkbox', + }, + + { + 'key' => 'svc_broadband-manage_link', + 'section' => 'UI', + 'description' => 'URL for svc_broadband "Manage Device" link. The following substitutions are available: $ip_addr.', + 'type' => 'text', + }, + + #more fine-grained, service def-level control could be useful eventually? + { + 'key' => 'svc_broadband-allow_null_ip_addr', + 'section' => '', + 'description' => '', + 'type' => 'checkbox', + }, + + { + 'key' => 'tax-report_groups', + 'section' => '', + 'description' => 'List of grouping possibilities for tax names on reports, one per line, "label op value" (op can be = or !=).', + 'type' => 'textarea', + }, + + { + 'key' => 'tax-cust_exempt-groups', + 'section' => '', + 'description' => 'List of grouping possibilities for tax names, for per-customer exemption purposes, one tax name per line. For example, "GST" would indicate the ability to exempt customers individually from taxes named "GST" (but not other taxes).', + 'type' => 'textarea', + }, + + { + 'key' => 'cust_main-default_view', + 'section' => 'UI', + 'description' => 'Default customer view, for users who have not selected a default view in their preferences.', + 'type' => 'select', + 'select_hash' => [ + #false laziness w/view/cust_main.cgi and pref/pref.html + 'basics' => 'Basics', + 'notes' => 'Notes', + 'tickets' => 'Tickets', + 'packages' => 'Packages', + 'payment_history' => 'Payment History', + 'change_history' => 'Change History', + 'jumbo' => 'Jumbo', + ], + }, + + { + 'key' => 'enable_tax_adjustments', + 'section' => 'billing', + 'description' => 'Enable the ability to add manual tax adjustments.', + 'type' => 'checkbox', + }, + + { + 'key' => 'rt-crontool', + 'section' => '', + 'description' => 'Enable the RT CronTool extension.', + 'type' => 'checkbox', + }, + + { + 'key' => 'pkg-balances', + 'section' => 'billing', + 'description' => 'Enable experimental package balances. Not recommended for general use.', + 'type' => 'checkbox', + }, + + { + 'key' => 'cust_main-edit_signupdate', + 'section' => 'UI', + 'descritpion' => 'Enable manual editing of the signup date.', + 'type' => 'checkbox', + }, + + { + 'key' => 'svc_acct-disable_access_number', + 'section' => 'UI', + 'descritpion' => 'Disable access number selection.', + 'type' => 'checkbox', + }, + + { 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" }, + { key => "bindprimary", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "bindsecondaries", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "bsdshellmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "cyrus", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "cp_app", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "erpcdmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "icradiusmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "icradius_mysqldest", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "icradius_mysqlsource", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "icradius_secrets", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "maildisablecatchall", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "mxmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "nsmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "arecords", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "cnamerecords", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "nismachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "qmailmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "radiusmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "sendmailconfigpath", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "sendmailmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "sendmailrestart", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "shellmachine", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "shellmachine-useradd", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "shellmachine-userdel", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "shellmachine-usermod", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "shellmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "radiusprepend", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "textradiusprepend", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "username_policy", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "vpopmailmachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "vpopmailrestart", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "safe-part_pkg", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "selfservice_server-quiet", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "signup_server-quiet", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "signup_server-email", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "vonage-username", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "vonage-password", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + { key => "vonage-fromnumber", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, + ); 1; + diff --git a/FS/FS/Conf_compat17.pm b/FS/FS/Conf_compat17.pm index 0f2e193..15d4738 100644 --- a/FS/FS/Conf_compat17.pm +++ b/FS/FS/Conf_compat17.pm @@ -443,10 +443,10 @@ httemplate/docs/config.html }, { - 'key' => 'business-onlinepayment-email_customer', - 'section' => 'billing', - 'description' => 'Controls the "email_customer" flag used by some Business::OnlinePayment processors to enable customer receipts.', - 'type' => 'checkbox', + 'key' => 'business-onlinepayment-email_customer', + 'section' => 'billing', + 'description' => 'Controls the "email_customer" flag used by some Business::OnlinePayment processors to enable customer receipts.', + 'type' => 'checkbox', }, { @@ -484,7 +484,14 @@ httemplate/docs/config.html { 'key' => 'deletecustomers', 'section' => 'UI', - 'description' => '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.', + 'description' => 'Enable customer deletions. Be very careful! Deleting a customer will remove all traces that the 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.', + 'type' => 'checkbox', + }, + + { + 'key' => 'deleteinvoices', + 'section' => 'UI', + 'description' => 'Enable invoices deletions. Be very careful! Deleting an invoice will remove all traces that the invoice ever existed! Normally, you would apply a credit against the invoice instead.', #invoice voiding? 'type' => 'checkbox', }, @@ -643,6 +650,13 @@ httemplate/docs/config.html }, { + 'key' => 'invoice_subject', + 'section' => 'billing', + 'description' => 'Subject: header on email invoices. Defaults to "Invoice". The following substitutions are available: $name, $name_short, $invoice_number, and $invoice_date.', + 'type' => 'text', + }, + + { 'key' => 'invoice_template', 'section' => 'required', 'description' => 'Required template file for invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.', @@ -1185,6 +1199,13 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'username-colon', + 'section' => 'username', + 'description' => 'Allow the colon character (:) in usernames.', + 'type' => 'checkbox', + }, + { 'key' => 'safe-part_bill_event', 'section' => 'UI', @@ -1558,8 +1579,8 @@ httemplate/docs/config.html { 'key' => 'paymentforcedtobatch', - 'section' => 'UI', - 'description' => 'Causes per customer payment entry to be forced to a batch processor rather than performed realtime.', + 'section' => 'deprecated', + 'description' => 'See batch-enable_payby and realtime-disable_payby. Used to (for CHEK): Cause per customer payment entry to be forced to a batch processor rather than performed realtime.', 'type' => 'checkbox', }, @@ -1586,6 +1607,14 @@ httemplate/docs/config.html 'select_enum' => [ 'Framed-IP-Address', 'Framed-Address' ], }, + #http://dev.coova.org/svn/coova-chilli/doc/dictionary.chillispot + { + 'key' => 'radius-chillispot-max', + 'section' => '', + 'description' => 'Enable ChilliSpot (and CoovaChilli) Max attributes, specifically ChilliSpot-Max-{Input,Output,Total}-{Octets,Gigawords}.', + 'type' => 'checkbox', + }, + { 'key' => 'svc_acct-alldomains', 'section' => '', @@ -1615,6 +1644,24 @@ httemplate/docs/config.html }, { + 'key' => 'credit_card-recurring_billing_flag', + 'section' => 'billing', + 'description' => 'This controls when the system passes the "recurring_billing" flag on credit card transactions. If supported by your processor (and the Business::OnlinePayment processor module), passing the flag indicates this is a recurring transaction and may turn off the CVV requirement. ', + 'type' => 'select', + 'select_hash' => [ + 'actual_oncard' => 'Default/classic behavior: set the flag if a customer has actual previous charges on the card.', + 'transaction_is_recur' => 'Set the flag if the transaction itself is recurring, irregardless of previous charges on the card.', + ], + }, + + { + 'key' => 'credit_card-recurring_billing_acct_code', + 'section' => 'billing', + 'description' => 'When the "recurring billing" flag is set, also set the "acct_code" to "rebill". Useful for reporting purposes with supported gateways (PlugNPay, others?)', + 'type' => 'checkbox', + }, + + { 'key' => 'cvv-save', 'section' => 'billing', 'description' => 'Save CVV2 information after the initial transaction for the selected credit card types. Enabling this option may be in violation of your merchant agreement(s), so please check them carefully before enabling this option for any credit card types.', @@ -1818,13 +1865,13 @@ httemplate/docs/config.html 'key' => 'address2-search', 'section' => 'UI', 'description' => 'Enable a "Unit" search box which searches the second address field', - 'type' => 'checkbox', + 'type' => 'checkbox', }, { - 'key' => 'cust_main-require_address2', - 'section' => 'UI', - 'description' => 'Second address field is required (on service address only, if billing and service addresses differ). Also enables "Unit" labeling of address2 on customer view and edit pages. Useful for multi-tenant applications. See also: address2-search', + 'key' => 'cust_main-require_address2', + 'section' => 'UI', + 'description' => 'Second address field is required (on service address only, if billing and service addresses differ). Also enables "Unit" labeling of address2 on customer view and edit pages. Useful for multi-tenant applications. See also: address2-search', 'type' => 'checkbox', }, @@ -2025,21 +2072,29 @@ httemplate/docs/config.html 'type' => 'select-sub', 'options_sub' => sub { require FS::Record; require FS::part_pkg; - map { $_->pkgpart => $_->pkg } + map { $_->pkgpart => $_->pkg } FS::Record::qsearch('part_pkg', { disabled=>'' } ); - }, + }, 'option_sub' => sub { require FS::Record; require FS::part_pkg; - my $part_pkg = FS::Record::qsearchs( - 'part_pkg', { 'pkgpart'=>shift } - ); + my $part_pkg = FS::Record::qsearchs( + 'part_pkg', { 'pkgpart'=>shift } + ); $part_pkg ? $part_pkg->pkg : ''; - }, + }, }, { - 'key' => 'batch-enable', + 'key' => 'postal_invoice-recurring_only', 'section' => 'billing', + 'description' => 'The postal invoice fee is omitted on invoices without recurring charges when this is set', + 'type' => 'checkbox', + }, + + { + 'key' => 'batch-enable', + 'section' => 'deprecated', #make sure batch-enable_payby is set for + #everyone before removing 'description' => 'Enable credit card and/or ACH batching - leave disabled for real-time installations.', 'type' => 'checkbox', }, @@ -2228,20 +2283,6 @@ httemplate/docs/config.html }, { - 'key' => 'cust_main-require_phone', - 'section' => '', - 'description' => 'Require daytime or night for all customer records.', - 'type' => 'checkbox', - }, - - { - 'key' => 'cust_main-require_invoicing_list_email', - 'section' => '', - 'description' => 'Email address field is required: require at least one invoicing email address for all customer records.', - 'type' => 'checkbox', - }, - - { 'key' => 'password-generated-allcaps', 'section' => 'password', 'description' => 'Causes passwords automatically generated to consist entirely of capital letters', @@ -2277,6 +2318,20 @@ httemplate/docs/config.html }, { + 'key' => 'cust_main-require_phone', + 'section' => '', + 'description' => 'Require daytime or night for all customer records.', + 'type' => 'checkbox', + }, + + { + 'key' => 'cust_main-require_invoicing_list_email', + 'section' => '', + 'description' => 'Email address field is required: require at least one invoicing email address for all customer records.', + 'type' => 'checkbox', + }, + + { 'key' => 'cancel_credit_type', 'section' => 'billing', 'description' => 'The group to use for new, automatically generated credit reasons resulting from cancellation.', @@ -2388,7 +2443,7 @@ httemplate/docs/config.html 'description' => 'Default area code for customers.', 'type' => 'text', }, - + { 'key' => 'cust_bill-max_same_services', 'section' => 'billing', @@ -2396,6 +2451,69 @@ httemplate/docs/config.html 'type' => 'text', }, + { + 'key' => 'suspend_email_admin', + 'section' => '', + 'description' => 'Destination admin email address to enable suspension notices', + 'type' => 'text', + }, + + { + 'key' => 'email_report-subject', + 'section' => '', + 'description' => 'Subject for reports emailed by freeside-fetch. Defaults to "Freeside report".', + 'type' => 'text', + }, + + { + 'key' => 'sg-multicustomer_hack', + 'section' => '', + 'description' => "Don't use this.", + 'type' => 'checkbox', + }, + + { + 'key' => 'sg-ping_username', + 'section' => '', + 'description' => "Don't use this.", + 'type' => 'text', + }, + + { + 'key' => 'sg-ping_password', + 'section' => '', + 'description' => "Don't use this.", + 'type' => 'text', + }, + + { + 'key' => 'sg-login_username', + 'section' => '', + 'description' => "Don't use this.", + 'type' => 'text', + }, + + { + 'key' => 'queued-max_kids', + 'section' => '', + 'description' => 'Maximum number of queued processes. Defaults to 10.', + 'type' => 'text', + }, + + { + 'key' => 'cancelled_cust-noevents', + 'section' => 'billing', + 'description' => "Don't run events for cancelled customers", + 'type' => 'checkbox', + }, + + { + 'key' => 'svc_broadband-manage_link', + 'section' => 'UI', + 'description' => 'URL for svc_broadband "Manage Device" link. The following substitutions are available: $ip_addr.', + 'type' => 'text', + }, + ); 1; diff --git a/FS/FS/Cron/alert_expiration.pm b/FS/FS/Cron/alert_expiration.pm new file mode 100644 index 0000000..a9b9da9 --- /dev/null +++ b/FS/FS/Cron/alert_expiration.pm @@ -0,0 +1,177 @@ +package FS::Cron::alert_expiration; + +use vars qw( @ISA @EXPORT_OK); +use Exporter; +use FS::Record qw(qsearch); +use FS::Conf; +use FS::cust_main; +use FS::Misc; +use Time::Local; +use Date::Parse qw(str2time); + + +@ISA = qw( Exporter ); +@EXPORT_OK = qw( alert_expiration ); + +my $warning_time = 30 * 24 * 60 * 60; +my $urgent_time = 15 * 24 * 60 * 60; +my $panic_time = 5 * 24 * 60 * 60; +my $window_time = 24 * 60 * 60; + +sub alert_expiration { + my $conf = new FS::Conf; + my $smtpmachine = $conf->config('smtpmachine'); + + my %opt = @_; + my ($_date) = $opt{'d'} ? str2time($opt{'d'}) : $^T; + $_date += $opt{'y'} * 86400 if $opt{'y'}; + my ($sec, $min, $hour, $mday, $mon, $year) = (localtime($_date)) [0..5]; + $mon++; + + my $debug = 0; + $debug = 1 if $opt{'v'}; + $debug = $opt{'l'} if $opt{'l'}; + + $FS::cust_main::DEBUG = $debug; + + # Get a list of customers. + + my %limit; + $limit{'agentnum'} = $opt{'a'} if $opt{'a'}; + $limit{'payby'} = $opt{'p'} if $opt{'p'}; + + my @customers; + + if(my @custnums = @ARGV) { + # We're given an explicit list of custnums, so select those. Then check against + # -a and -p to avoid doing anything unexpected. + foreach (@custnums) { + my $customer = FS::cust_main->by_key($_); + if($customer and (!$opt{'a'} or $customer->agentnum == $opt{'a'}) + and (!$opt{'p'} or $customer->payby eq $opt{'p'}) ) { + push @customers, $customer; + } + } + } + else { # no @ARGV + @customers = qsearch('cust_main', \%limit); + } + return if(!@customers); + foreach my $customer (@customers) { + my $paydate = $customer->paydate; + next if $paydate =~ /^\s*$/; # skip empty expiration dates + + my $custnum = $customer->custnum; + my $first = $customer->first; + my $last = $customer->last; + my $company = $customer->company; + my $payby = $customer->payby; + my $payinfo = $customer->payinfo; + my $daytime = $customer->daytime; + my $night = $customer->night; + + my ($paymonth, $payyear) = $customer->paydate_monthyear; + $paymonth--; # localtime() convention + $payday = 1; # This is enforced by FS::cust_main::check. + my $expire_time; + if($payby eq 'CARD' || $payby eq 'DCRD') { + # Credit cards expire at the end of the month/year. + if($paymonth == 11) { + $payyear++; + $paymonth = 0; + } else { + $paymonth++; + } + $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear) - 1; + } + else { + $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear); + } + + if (grep { $expire_time < $_date + $_ && + $expire_time > $_date + $_ - $window_time } + ($warning_time, $urgent_time, $panic_time) ) { + my $agentnum = $customer->agentnum; + $mail_sender = $conf->config('invoice_from', $agentnum); + $failure_recipient = $conf->config('invoice_from', $agentnum) + || 'postmaster'; + + my @alerter_template = $conf->config('alerter_template', $agentnum) + or die 'cannot load config file alerter_template'; + + my $alerter = new Text::Template(TYPE => 'ARRAY', + SOURCE => [ + map "$_\n", @alerter_template + ]) + or die "can't create Text::Template object: $Text::Template::ERROR"; + + $alerter->compile() + or die "can't compile template: $Text::Template::ERROR"; + + my @packages = $customer->ncancelled_pkgs; + if(@packages) { + my @invoicing_list = $customer->invoicing_list; + my @to_addrs = grep { $_ ne 'POST' } @invoicing_list; + if(@to_addrs) { + # Set up template fields. + my %fill_in; + $fill_in{$_} = $customer->getfield($_) + foreach(qw(first last company)); + $fill_in{'expdate'} = $expire_time; + $fill_in{'company_name'} = $conf->config('company_name', $agentnum); + $fill_in{'company_address'} = + join("\n",$conf->config('company_address',$agentnum))."\n"; + if($payby eq 'CARD' || $payby eq 'DCRD') { + $fill_in{'payby'} = "credit card (". + substr($customer->payinfo, 0, 2) . "xxxxxxxxxx" . + substr($payinfo, -4) . ")"; + } + elsif($payby eq 'COMP') { + $fill_in{'payby'} = 'complimentary account'; + } + else { + $fill_in{'payby'} = 'current method'; + } + # Send it already! + my $error = FS::Misc::send_email ( + from => $mail_sender, + to => [ @to_addrs ], + subject => 'Billing Arrangement Expiration', + body => [ $alerter->fill_in( HASH => \%fill_in ) ], + ); + die "can't send expiration alert: $error" + if $error; + } + else { # if(@to_addrs) + push @{$agent_failure_body{$customer->agentnum}}, + sprintf(qq{%5d %-32.32s %4s %10s %12s %12s}, + $custnum, + $first . " " . $last . " " . $company, + $payby, + $paydate, + $daytime, + $night ); + } + } # if(@packages) + } # if(expired) + } # foreach(@customers) + + # Failure notification + foreach my $agentnum (keys %agent_failure_body) { + $mail_sender = $conf->config('invoice_from', $agentnum) + if($conf->exists('invoice_from', $agentnum)); + $failure_recipient = $conf->config('invoice_from', $agentnum) + if($conf->exists('invoice_from', $agentnum)); + my $error = FS::Misc::send_email ( + from => $mail_sender, + to => $failure_recipient, + subject => 'Unnotified Billing Arrangement Expirations', + body => [ @{$agent_failure_body{$agentnum}} ], + ); + die "can't send alerter failure email to $failure_recipient: $error" + if $error; + } + +} + +1; diff --git a/FS/FS/Cron/bill.pm b/FS/FS/Cron/bill.pm index ad6498c..dbb6c66 100644 --- a/FS/FS/Cron/bill.pm +++ b/FS/FS/Cron/bill.pm @@ -4,17 +4,26 @@ use strict; use vars qw( @ISA @EXPORT_OK ); use Exporter; use Date::Parse; +use DBI 1.33; #The "clone" method was added in DBI 1.33. use FS::UID qw(dbh); -use FS::Record qw(qsearchs); +use FS::Record qw( qsearch qsearchs ); +use FS::queue; use FS::cust_main; use FS::part_event; use FS::part_event_condition; @ISA = qw( Exporter ); -@EXPORT_OK = qw ( bill ); +@EXPORT_OK = qw ( bill bill_where ); -sub bill { +#freeside-daily %opt: +# -s: re-charge setup fees +# -v: enable debugging +# -l: debugging level +# -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing. +# -r: Multi-process mode dry run option +# -g: Don't bill these pkgparts +sub bill { my %opt = @_; my $check_freq = $opt{'check_freq'} || '1d'; @@ -22,17 +31,135 @@ sub bill { my $debug = 0; $debug = 1 if $opt{'v'}; $debug = $opt{'l'} if $opt{'l'}; - $FS::cust_main::DEBUG = $debug; #$FS::cust_event::DEBUG = $opt{'l'} if $opt{'l'}; + #we're at now now (and later). + $opt{'time'} = $opt{'d'} ? str2time($opt{'d'}) : $^T; + $opt{'time'} += $opt{'y'} * 86400 if $opt{'y'}; + + $opt{'invoice_time'} = $opt{'n'} ? $^T : $opt{'time'}; + + #hashref here doesn't work with -m + #my $not_pkgpart = $opt{g} ? { map { $_=>1 } split(/,\s*/, $opt{g}) } + # : {}; + + ### + # get a list of custnums + ### + + my $cursor_dbh = dbh->clone; + + $cursor_dbh->do( + "DECLARE cron_bill_cursor CURSOR FOR ". + " SELECT custnum FROM cust_main WHERE ". bill_where( %opt ) + ) or die $cursor_dbh->errstr; + + while ( 1 ) { + + my $sth = $cursor_dbh->prepare('FETCH 100 FROM cron_bill_cursor'); #mysql? + + $sth->execute or die $sth->errstr; + + my @custnums = map { $_->[0] } @{ $sth->fetchall_arrayref }; + + last unless scalar(@custnums); + + ### + # for each custnum, queue or make one customer object and bill + # (one at a time, to reduce memory footprint with large #s of customers) + ### + + foreach my $custnum ( @custnums ) { + + my %args = ( + 'time' => $opt{'time'}, + 'invoice_time' => $opt{'invoice_time'}, + 'actual_time' => $^T, #when freeside-bill was started + #(not, when using -m, freeside-queued) + 'check_freq' => $check_freq, + 'resetup' => ( $opt{'s'} ? $opt{'s'} : 0 ), + 'not_pkgpart' => $opt{'g'}, #$not_pkgpart, + ); + + if ( $opt{'m'} ) { + + if ( $opt{'r'} ) { + warn "DRY RUN: would add custnum $custnum for queued_bill\n"; + } else { + + #avoid queuing another job if there's one still waiting to run + next if qsearch( 'queue', { 'job' => 'FS::cust_main::queued_bill', + 'custnum' => $custnum, + 'status' => 'new', + } + ); + + #add job to queue that calls bill_and_collect with options + my $queue = new FS::queue { + 'job' => 'FS::cust_main::queued_bill', + 'secure' => 'Y', + 'priority' => 99, #don't get in the way of provisioning jobs + }; + my $error = $queue->insert( 'custnum'=>$custnum, %args ); + + } + + } else { + + my $cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } ); + $cust_main->bill_and_collect( %args, 'debug' => $debug ); + + } + + } + + } + + $cursor_dbh->commit or die $cursor_dbh->errstr; + +} + +# freeside-daily %opt: +# -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with, +# but be careful. +# +# -y: In addition to -d, which specifies an absolute date, the -y switch +# specifies an offset, in days. For example, "-y 15" would increment the +# "pretend date" 15 days from whatever was specified by the -d switch +# (or now, if no -d switch was given). +# +# -n: When used with "-d" and/or "-y", specifies that invoices should be dated +# with today's date, irregardless of the pretend date used to pre-generate +# the invoices. +# +# -p: Only process customers with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>) +# +# -a: Only process customers with the specified agentnum +# +# -v: enable debugging +# +# -l: debugging level + +sub bill_where { + my( %opt ) = @_; + + my $time = $opt{'time'}; + my $invoice_time = $opt{'invoice_time'}; + + my $check_freq = $opt{'check_freq'} || '1d'; + my @search = (); + push @search, "( cust_main.archived != 'Y' OR archived IS NULL )"; #disable? + push @search, "cust_main.payby = '". $opt{'p'}. "'" if $opt{'p'}; push @search, "cust_main.agentnum = ". $opt{'a'} if $opt{'a'}; + #it would be useful if i recognized $opt{g} / $not_pkgpart... + if ( @ARGV ) { push @search, "( ". join(' OR ', map "cust_main.custnum = $_", @ARGV ). @@ -43,23 +170,22 @@ sub bill { # generate where_pkg/where_event search clause ### - #we're at now now (and later). - my($time)= $opt{'d'} ? str2time($opt{'d'}) : $^T; - $time += $opt{'y'} * 86400 if $opt{'y'}; - - my $invoice_time = $opt{'n'} ? $^T : $time; - # select * from cust_main where my $where_pkg = <<"END"; - 0 < ( select count(*) from cust_pkg - where cust_main.custnum = cust_pkg.custnum - and ( cancel is null or cancel = 0 ) - and ( setup is null or setup = 0 - or bill is null or bill <= $time - or ( expire is not null and expire <= $^T ) - or ( adjourn is not null and adjourn <= $^T ) - ) - ) + EXISTS( + SELECT 1 FROM cust_pkg + WHERE cust_main.custnum = cust_pkg.custnum + AND ( cancel IS NULL OR cancel = 0 ) + AND ( ( ( setup IS NULL OR setup = 0 ) + AND ( start_date IS NULL OR start_date = 0 + OR ( start_date IS NOT NULL AND start_date <= $^T ) + ) + ) + OR bill IS NULL OR bill <= $time + OR ( expire IS NOT NULL AND expire <= $^T ) + OR ( adjourn IS NOT NULL AND adjourn <= $^T ) + ) + ) END my $where_event = join(' OR ', map { @@ -69,23 +195,24 @@ END my $where = FS::part_event_condition->where_conditions_sql( $eventtable, 'time'=>$time, ); + $where = $where ? "AND $where" : ''; 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 - ) + "EXISTS ( SELECT 1 FROM part_event $join + WHERE check_freq = '$check_freq' + AND eventtable = '$eventtable' + AND ( disabled = '' OR disabled IS NULL ) + $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 - ) + "EXISTS ( SELECT 1 FROM $eventtable + WHERE cust_main.custnum = $eventtable.custnum + AND $are_part_event + ) "; } @@ -93,54 +220,11 @@ END push @search, "( $where_pkg OR $where_event )"; - ### - # get a list of custnums - ### - warn "searching for customers:\n". join("\n", @search). "\n" if $opt{'v'} || $opt{'l'}; - my $sth = dbh->prepare( - "SELECT custnum FROM cust_main". - " WHERE ". join(' AND ', @search) - ) or die dbh->errstr; - - $sth->execute or die $sth->errstr; - - my @custnums = map { $_->[0] } @{ $sth->fetchall_arrayref }; - - ### - # for each custnum, queue or make one customer object and bill - # (one at a time, to reduce memory footprint with large #s of customers) - ### - - foreach my $custnum ( @custnums ) { - - my %args = ( - 'time' => $time, - 'invoice_time' => $invoice_time, - 'actual_time' => $^T, #when freeside-bill was started - #(not, when using -m, freeside-queued) - 'check_freq' => $check_freq, - 'resetup' => ( $opt{'s'} ? $opt{'s'} : 0 ), - ); - - if ( $opt{'m'} ) { - - #add job to queue that calls bill_and_collect with options - my $queue = new FS::queue { - 'job' => 'FS::cust_main::queued_bill', - 'secure' => 'Y', - }; - my $error = $queue->insert( 'custnum'=>$custnum, %args ); - - } else { - - my $cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } ); - $cust_main->bill_and_collect( %args, 'debug' => $debug ); - - } - - } + join(' AND ', @search); } + +1; diff --git a/FS/FS/Cron/check.pm b/FS/FS/Cron/check.pm new file mode 100644 index 0000000..9d3ffbd --- /dev/null +++ b/FS/FS/Cron/check.pm @@ -0,0 +1,200 @@ +package FS::Cron::check; + +use strict; +use vars qw( @ISA @EXPORT_OK $DEBUG $FS_RUN $error_msg + $SELFSERVICE_USER $SELFSERVICE_MACHINES @SELFSERVICE_MACHINES + ); +use Exporter; +use LWP::UserAgent; +use HTTP::Request; +use URI::Escape; +use Email::Send; +use FS::Conf; +use FS::Record qw(qsearch); +use FS::cust_pay_pending; + +@ISA = qw( Exporter ); +@EXPORT_OK = qw( + check_queued check_selfservice check_apache check_bop_failures + check_sg check_sg_login check_sgng + alert error_msg +); + +$DEBUG = 0; + +$FS_RUN = '/var/run'; + +sub check_queued { + _check_fsproc('queued'); +} + +$SELFSERVICE_USER = '%%%SELFSERVICE_USER%%%'; + +$SELFSERVICE_MACHINES = '%%%SELFSERVICE_MACHINES%%%'; #substituted by Makefile +$SELFSERVICE_MACHINES =~ s/^\s+//; +$SELFSERVICE_MACHINES =~ s/\s+$//; +@SELFSERVICE_MACHINES = split(/\s+/, $SELFSERVICE_MACHINES); +@SELFSERVICE_MACHINES = () + if scalar(@SELFSERVICE_MACHINES) == 1 + && $SELFSERVICE_MACHINES[0] eq '%%%'.'SELFSERVICE_MACHINES'.'%%%'; + +sub check_selfservice { + foreach my $machine ( @SELFSERVICE_MACHINES ) { + unless ( _check_fsproc("selfservice-server.$SELFSERVICE_USER.$machine") ) { + $error_msg = "Self-service daemon not running for $machine"; + return 0; + } + } + return 1; +} + +sub check_sg { + my $conf = new FS::Conf; + #different trigger if they ever stop using multicustomer_hack ? + return 1 unless $conf->exists('sg-multicustomer_hack'); + + my $ua = new LWP::UserAgent; + $ua->agent("FreesideCronCheck/0.1 " . $ua->agent); + + my $USER = $conf->config('sg-ping_username'); + my $PASS = $conf->config('sg-ping_password'); + my $req = new HTTP::Request GET=>"https://$USER:$PASS\@localhost/sg/ping.cgi"; + my $res = $ua->request($req); + + return 1 if $res->is_success + && $res->content =~ /OK/ + && $res->content !~ /error/i; #doh, the error message includes "OK" + + $error_msg = $res->is_success ? $res->content : $res->status_line; + return 0; +} + +sub check_sg_login { + my $conf = new FS::Conf; + #different trigger if they ever stop using multicustomer_hack ? + return 1 unless $conf->exists('sg-multicustomer_hack'); + + my $ua = new LWP::UserAgent; + $ua->agent("FreesideCronCheck/0.1 " . $ua->agent); + + my $USER = $conf->config('sg-ping_username'); + my $PASS = $conf->config('sg-ping_password'); + my $USERNAME = $conf->config('sg-login_username'); + my $req = new HTTP::Request + GET=>"https://$USER:$PASS\@localhost/sg/start.cgi?". + 'username='. uri_escape($USERNAME); + my $res = $ua->request($req); + + return 1 if $res->is_success + && $res->content =~ /[\da-f]{32}/i #session_id + && $res->content !~ /error/i; + + $error_msg = $res->is_success ? $res->content : $res->status_line; + return 0; +} + +sub check_sgng { + my $conf = new FS::Conf; + #different trigger if they ever stop using multicustomer_hack ? + return 1 unless $conf->exists('sg-multicustomer_hack'); + + eval 'use RPC::XML; use RPC::XML::Client;'; + if ($@) { $error_msg = $@; return 0; }; + + my $cli = RPC::XML::Client->new('https://localhost/selfservice/xmlrpc.cgi'); + my $resp = $cli->send_request('FS.SelfService.XMLRPC.ping'); + + return 1 if ref($resp) + && ! $resp->is_fault + && ref($resp->value) + && $resp->value->{'pong'} == 1; + + #hua + $error_msg = ref($resp) + ? ( $resp->is_fault + ? $resp->string + : ( ref($resp->value) ? $resp->value->{'error'} + : $resp->value + ) + ) + : $resp; + return 0; +} + +sub _check_fsproc { + my $arg = shift; + _check_pidfile( "freeside-$arg.pid" ); +} + +sub _check_pidfile { + my $pidfile = shift; + open(PID, "$FS_RUN/$pidfile") or return 0; + chomp( my $pid = scalar(<PID>) ); + close PID; # or return 0; + + $pid && kill 0, $pid; +} + +sub check_apache { + my $ua = new LWP::UserAgent; + $ua->agent("FreesideCronCheck/0.1 " . $ua->agent); + + my $req = new HTTP::Request GET => 'https://localhost/'; + my $res = $ua->request($req); + + return 1 if $res->is_success || $res->status_line =~ /^403/; + $error_msg = $res->status_line; + return 0; + +} + +#and now for something entirely different... +my $num_consecutive_bop_failures = 60; +sub check_bop_failures { + + return 1 if grep { $_->statustext eq 'captured' } + qsearch({ + 'table' => 'cust_pay_pending', + 'hashref' => { 'status' => 'done' }, + 'order_by' => 'ORDER BY paypendingnum DESC'. + " LIMIT $num_consecutive_bop_failures", + }); + $error_msg = "Last $num_consecutive_bop_failures real-time payments failed"; + return 0; +} + +# + +sub error_msg { + $error_msg; +} + +sub alert { + my( $alert, @emails ) = @_; + + my $conf = new FS::Conf; + my $smtpmachine = $conf->config('smtpmachine'); + my $company_name = $conf->config('company_name'); + + foreach my $email (@emails) { + warn "warning $email about $alert\n" if $DEBUG; + + my $message = <<"__MESSAGE__"; +From: support\@freeside.biz +To: $email +Subject: FREESIDE ALERT for $company_name + +FREESIDE ALERT: $alert + +__MESSAGE__ + + my $sender = Email::Send->new({ mailer => 'SMTP' }); + $sender->mailer_args([ Host => $smtpmachine ]); + $sender->send($message); + + } + +} + +1; + diff --git a/FS/FS/Cron/notify.pm b/FS/FS/Cron/notify.pm index 23cf920..5b0e186 100644 --- a/FS/FS/Cron/notify.pm +++ b/FS/FS/Cron/notify.pm @@ -35,7 +35,7 @@ sub notify_flat_delay { and 0 < ( select count(*) from part_pkg_option where part_pkg.pkgpart = part_pkg_option.pkgpart and part_pkg_option.optionname = 'recur_notify' - and part_pkg_option.optionvalue > 0 + and CAST( part_pkg_option.optionvalue AS INTEGER ) > 0 and 0 <= ( $time + CAST( part_pkg_option.optionvalue AS $integer ) * 86400 @@ -62,7 +62,7 @@ END 0 = ( select count(*) from cust_pkg_option where cust_pkg.pkgnum = cust_pkg_option.pkgnum and cust_pkg_option.optionname = 'impending_recur_notification_sent' - and cust_pkg_option.optionvalue = 1 + and CAST( cust_pkg_option.optionvalue AS INTEGER ) = 1 ) END diff --git a/FS/FS/Cron/upload.pm b/FS/FS/Cron/upload.pm new file mode 100644 index 0000000..fea3d2c --- /dev/null +++ b/FS/FS/Cron/upload.pm @@ -0,0 +1,176 @@ +package FS::Cron::upload; + +use strict; +use vars qw( @ISA @EXPORT_OK $me $DEBUG ); +use Exporter; +use Date::Format; +use FS::UID qw(dbh); +use FS::Record qw( qsearch qsearchs ); +use FS::Conf; +use FS::queue; +use FS::agent; +use LWP::UserAgent; +use HTTP::Request; +use HTTP::Request::Common; +use HTTP::Response; + +@ISA = qw( Exporter ); +@EXPORT_OK = qw ( upload ); +$DEBUG = 0; +$me = '[FS::Cron::upload]'; + +#freeside-daily %opt: +# -v: enable debugging +# -l: debugging level +# -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing. +# -r: Multi-process mode dry run option +# -a: Only process customers with the specified agentnum + + +sub upload { + my %opt = @_; + + my $debug = 0; + $debug = 1 if $opt{'v'}; + $debug = $opt{'l'} if $opt{'l'}; + + local $DEBUG = $debug if $debug; + + warn "$me upload called\n" if $DEBUG; + + my $conf = new FS::Conf; + my @agent = grep { $conf->config( 'billco-username', $_->agentnum, 1 ) } + grep { $conf->config( 'billco-password', $_->agentnum, 1 ) } + qsearch( 'agent', {} ); + + my $date = time2str('%Y%m%d%H%M%S', $^T); # more? + + @agent = grep { $_ == $opt{'a'} } @agent if $opt{'a'}; + + foreach my $agent ( @agent ) { + + my $agentnum = $agent->agentnum; + + if ( $opt{'m'} ) { + + if ( $opt{'r'} ) { + warn "DRY RUN: would add agent $agentnum for queued upload\n"; + } else { + + my $queue = new FS::queue { + 'job' => 'FS::Cron::upload::billco_upload', + }; + my $error = $queue->insert( + 'agentnum' => $agentnum, + 'date' => $date, + 'l' => $opt{'l'} || '', + 'm' => $opt{'m'} || '', + 'v' => $opt{'v'} || '', + ); + + } + + } else { + + eval "&billco_upload( 'agentnum' => $agentnum, 'date' => $date );"; + warn "billco_upload failed: $@\n" + if ( $@ ); + + } + + } + +} + +sub billco_upload { + my %opt = @_; + + warn "$me billco_upload called\n" if $DEBUG; + my $conf = new FS::Conf; + my $dir = '%%%FREESIDE_EXPORT%%%/export.'. $FS::UID::datasrc. '/cust_bill'; + + my $agentnum = $opt{agentnum} or die "no agentnum provided\n"; + my $url = $conf->config( 'billco-url', $agentnum ) + or die "no url for agent $agentnum\n"; + my $username = $conf->config( 'billco-username', $agentnum, 1 ) + or die "no username for agent $agentnum\n"; + my $password = $conf->config( 'billco-password', $agentnum, 1 ) + or die "no password for agent $agentnum\n"; + my $clicode = $conf->config( 'billco-clicode', $agentnum ) + or die "no clicode for agent $agentnum\n"; + + die "no date provided\n" unless $opt{date}; + my $zipfile = "$dir/agentnum$agentnum-$opt{date}.zip"; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $agent = qsearchs( 'agent', { agentnum => $agentnum } ) + or die "no such agent: $agentnum"; + $agent->select_for_update; #mutex + + unless ( -f "$dir/agentnum$agentnum-header.csv" || + -f "$dir/agentnum$agentnum-detail.csv" ) + { + warn "$me neither $dir/agentnum$agentnum-header.csv nor ". + "$dir/agentnum$agentnum-detail.csv found\n" if $DEBUG; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return; + } + + # a better way? + if ($opt{m}) { + my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ". + "WHERE queue.job='FS::cust_main::queued_bill' AND cust_main.agentnum = ?"; + my $sth = $dbh->prepare($sql) or die $dbh->errstr; + while (1) { + $sth->execute( $agentnum ) + or die "Unexpected error executing statement $sql: ". $sth->errstr; + last if $sth->fetchow_arrayref->[0]; + sleep 300; + } + } + + foreach ( qw ( header detail ) ) { + rename "$dir/agentnum$agentnum-$_.csv", + "$dir/agentnum$agentnum-$opt{date}-$_.csv"; + } + + my $command = "cd $dir; zip $zipfile ". + "agentnum$agentnum-$opt{date}-header.csv ". + "agentnum$agentnum-$opt{date}-detail.csv"; + + system($command) and die "$command failed\n"; + + unlink "agentnum$agentnum-$opt{date}-header.csv", + "agentnum$agentnum-$opt{date}-detail.csv"; + + my $ua = new LWP::UserAgent; + my $res = $ua->request( POST( $url, + 'Content_Type' => 'form-data', + 'Content' => [ 'username' => $username, + 'pass' => $password, + 'custid' => $username, + 'clicode' => $clicode, + 'file1' => [ $zipfile ], + ], + ) + ); + + die "upload failed: ". $res->status_line. "\n" + unless $res->is_success; + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +1; diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index ee777a4..6e6072e 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -1,8 +1,9 @@ package FS::Mason; use strict; -use vars qw( @ISA @EXPORT_OK ); +use vars qw( @ISA @EXPORT_OK $addl_handler_use ); use Exporter; +use File::Slurp qw( slurp ); use HTML::Mason 1.27; #http://www.masonhq.com/?ApacheModPerl2Redirect use HTML::Mason::Interp; use HTML::Mason::Compiler::ToObject; @@ -30,6 +31,12 @@ Initializes the Mason environment, loads all Freeside and RT libraries, etc. =cut +$addl_handler_use = ''; +my $addl_handler_use_file = '%%%FREESIDE_CONF%%%/addl_handler_use.pl'; +if ( -e $addl_handler_use_file ) { + $addl_handler_use = slurp( $addl_handler_use_file ); +} + # List of modules that you want to use from components (see Admin # manual for details) { @@ -38,6 +45,13 @@ Initializes the Mason environment, loads all Freeside and RT libraries, etc. use strict; use vars qw( %session ); use CGI 3.29 qw(-private_tempfiles); #3.29 to fix RT attachment problems + + #breaks quick payment entry + #http://rt.cpan.org/Public/Bug/Display.html?id=37365 + die "CGI.pm v3.38 is broken, use any other version >= 3.29". + " (Debian 5.0? aptitude remove libcgi-pm-perl)" + if $CGI::VERSION == 3.38; + #use CGI::Carp qw(fatalsToBrowser); use CGI::Cookie; use List::Util qw( max min ); @@ -45,12 +59,13 @@ Initializes the Mason environment, loads all Freeside and RT libraries, etc. use Date::Format; use Date::Parse; use Time::Local; + use Time::HiRes; use Time::Duration; use DateTime; use DateTime::Format::Strptime; use Lingua::EN::Inflect qw(PL); use Tie::IxHash; - use URI::URL; + use URI; use URI::Escape; use HTML::Entities; use HTML::TreeBuilder; @@ -70,6 +85,19 @@ Initializes the Mason environment, loads all Freeside and RT libraries, etc. use Spreadsheet::WriteExcel; use Business::CreditCard 0.30; #for mask-aware cardtype() use NetAddr::IP; + use Net::Ping; + use Net::Ping::External; + #if CPAN #7815 ever gets fixed# if ( $Net::Ping::External::VERSION <= 0.12 ) + { + no warnings 'redefine'; + eval 'sub Net::Ping::External::_ping_linux { + my %args = @_; + my $command = "ping -s $args{size} -c $args{count} -w $args{timeout} $args{host}"; + return Net::Ping::External::_ping_system($command, 0); + } + '; + die $@ if $@; + } use String::Approx qw(amatch); use Chart::LinesPoints; use Chart::Mountain; @@ -91,6 +119,7 @@ Initializes the Mason environment, loads all Freeside and RT libraries, etc. use FS::UI::bytecount; use FS::Msgcat qw(gettext geterror); use FS::Misc qw( send_email send_fax states_hash counties state_label ); + use FS::Misc::eps2png qw( eps2png ); use FS::Report::Table::Monthly; use FS::TicketSystem; use FS::Tron qw( tron_lint ); @@ -166,6 +195,8 @@ Initializes the Mason environment, loads all Freeside and RT libraries, etc. use FS::access_right; use FS::AccessRight; use FS::svc_phone; + use FS::phone_device; + use FS::part_device; use FS::reason_type; use FS::reason; use FS::cust_main_note; @@ -175,6 +206,25 @@ Initializes the Mason environment, loads all Freeside and RT libraries, etc. use FS::part_pkg_taxoverride; use FS::part_pkg_taxrate; use FS::tax_rate; + use FS::part_pkg_report_option; + use FS::cust_attachment; + use FS::h_cust_pkg; + use FS::h_svc_acct; + use FS::h_svc_broadband; + use FS::h_svc_domain; + #use FS::h_domain_record; + use FS::h_svc_external; + use FS::h_svc_forward; + use FS::h_svc_phone; + #use FS::h_phone_device; + use FS::h_svc_www; + use FS::cust_statement; + # Sammath Naur + + if ( $FS::Mason::addl_handler_use ) { + eval $FS::Mason::addl_handler_use; + die $@ if $@; + } if ( %%%RT_ENABLED%%% ) { eval ' @@ -211,7 +261,7 @@ Initializes the Mason environment, loads all Freeside and RT libraries, etc. #slow, unreliable, segfaults and is optional #see rt/html/Ticket/Elements/ShowTransactionAttachments - #use Text::Quoted; + use Text::Quoted; #?#use File::Path qw( rmtree ); #?#use File::Glob qw( bsd_glob ); @@ -351,6 +401,21 @@ sub mason_interps { RT::LoadConfig(); } + # A hook supporting strange legacy ways people have added stuff on + + my @addl_comp_root = (); + my $addl_comp_root_file = '%%%FREESIDE_CONF%%%/addl_comp_root.pl'; + if ( -e $addl_comp_root_file ) { + warn "reading $addl_comp_root_file\n"; + my $text = slurp( $addl_comp_root_file ); + my @addl = eval $text; + if ( @addl && ! $@ ) { + @addl_comp_root = @addl; + } elsif ($@) { + warn "error parsing $addl_comp_root_file: $@\n"; + } + } + my %interp = ( request_class => $request_class, data_dir => '%%%MASONDATA%%%', @@ -360,6 +425,7 @@ sub mason_interps { comp_root => [ [ 'freeside'=>'%%%FREESIDE_DOCUMENT_ROOT%%%' ], [ 'rt' =>'%%%FREESIDE_DOCUMENT_ROOT%%%/rt' ], + @addl_comp_root, ], ); @@ -374,6 +440,9 @@ sub mason_interps { ${$_[0]} = "'". ${$_[0]}. "'"; } }, + compiler => HTML::Mason::Compiler::ToObject->new( + allow_globals => [qw(%session)], + ), ); my $rt_interp = new HTML::Mason::Interp ( diff --git a/FS/FS/Misc/eps2png.pm b/FS/FS/Misc/eps2png.pm new file mode 100644 index 0000000..aa8e572 --- /dev/null +++ b/FS/FS/Misc/eps2png.pm @@ -0,0 +1,278 @@ +package FS::Misc::eps2png; + +#based on eps2png by Johan Vromans +#Copyright 1994,2008 by Johan Vromans. +#This program is free software; you can redistribute it and/or +#modify it under the terms of the Perl Artistic License or the +#GNU General Public License as published by the Free Software +#Foundation; either version 2 of the License, or (at your option) any +#later version. + +use strict; +use vars qw( @ISA @EXPORT_OK ); +use Exporter; +use File::Temp; +use File::Slurp qw( slurp ); +#use FS::UID; + +@ISA = qw( Exporter ); +@EXPORT_OK = qw( eps2png ); + +################ Program parameters ################ + +# Some GhostScript programs can produce GIF directly. +# If not, we need the PBM package for the conversion. +# NOTE: This will be changed upon install. +my $use_pbm = 0; + +my $res = 82; # default resolution +my $scale = 1; # default scaling +my $mono = 0; # produce BW images if non-zero +my $format; # output format +my $gs_format; # GS output type +my $output; # output, defaults to STDOUT +my $antialias = 4; # antialiasing +my $DEF_width; # desired widht +my $DEF_height; # desired height +#my $DEF_width = 90; # desired widht +#my $DEF_height = 36; # desired height + +my ($verbose,$trace,$test,$debug) = (0,0,0,0); +#handle_options (); +set_out_type ('png'); # unless defined $format; +warn "Producing $format ($gs_format) image.\n" if $verbose; + +$trace |= $test | $debug; +$verbose |= $trace; + +################ Presets ################ + +################ The Process ################ + +my $err = 0; + +sub eps2png { + my( $eps, %options ) = @_; #well, no options yet + + my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; + my $eps_file = new File::Temp( TEMPLATE => 'image.XXXXXXXX', + DIR => $dir, + SUFFIX => '.eps', + #UNLINK => 0, + ) or die "can't open temp file: $!\n"; + print $eps_file $eps; + close $eps_file; + + my @eps = split(/\r?\n/, $eps); + + warn "converting eps (". length($eps). " bytes, ". scalar(@eps). " lines)\n" + if $verbose; + + my $line = shift @eps; #<EPS>; + unless ( $eps =~ /^%!PS-Adobe.*EPSF-/ ) { + warn "not EPS file (no %!PS-Adobe header)\n"; + return; #empty png file? + } + + my $ps = ""; # PostScript input data + my $xscale; + my $yscale; + my $gotbb; + + # Prevent derived values from propagating. + my $width = $DEF_width; + my $height = $DEF_height; + + while ( @eps ) { + + $line = shift(@eps)."\n"; + + # Search for BoundingBox. + if ( $line =~ /^%%BoundingBox:\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/i ) { + $gotbb++; + warn "$eps_file: x0=$1, y0=$2, w=", $3-$1, ", h=", $4-$2 + if $verbose; + + if ( defined $width ) { + $res = 72; + $xscale = $width / ($3 - $1); + if ( defined $height ) { + $yscale = $height / ($4 - $2); + } + else { + $yscale = $xscale; + $height = ($4 - $2) * $yscale; + } + } + elsif ( defined $height ) { + $res = 72; + $yscale = $height / ($4 - $2); + if ( defined $width ) { + $xscale = $width / ($3 - $1); + } + else { + $xscale = $yscale; + $width = ($3 - $1) * $xscale; + } + } + unless ( defined $xscale ) { + $xscale = $yscale = $scale; + # Calculate actual width. + $width = $3 - $1; + $height = $4 - $2; + # Normal PostScript resolution is 72. + $width *= $res/72 * $xscale; + $height *= $res/72 * $yscale; + # Round up. + $width = int ($width + 0.5) + 1; + $height = int ($height + 0.5) + 1; + } + warn ", width=$width, height=$height\n" if $verbose; + + # Scale. + $ps .= "$xscale $yscale scale\n" + if $xscale != 1 || $yscale != 1; + + # Create PostScript code to translate coordinates. + $ps .= (0-$1) . " " . (0-$2) . " translate\n" + unless $1 == 0 && $2 == 0; + + # Include the image, show and quit. + $ps .= "($eps_file) run\n". + "showpage\n". + "quit\n"; + + last; + } + elsif ( $line =~ /^%%EndComments/i ) { + last; + } + } + + unless ( $gotbb ) { + warn "No bounding box in $eps_file\n"; + return; + } + + #it would be better to ask gs to spit out files on stdout, but c'est la vie + + #my $out_file; # output file + #my $pbm_file; # temporary file for PBM conversion + + my $out_file = new File::Temp( TEMPLATE => 'image.XXXXXXXX', + DIR => $dir, + SUFFIX => '.png', + #UNLINK => 0, + ) or die "can't open temp file: $!\n"; + + my $pbm_file = new File::Temp( TEMPLATE => 'image.XXXXXXXX', + DIR => $dir, + SUFFIX => '.pbm', + #UNLINK => 0, + ) or die "can't open temp file: $!\n"; + + # Note the temporary PBM file is created where the output file is + # located, since that will guarantee accessibility (and a valid + # filename). + warn "Creating $out_file\n" if $verbose; + + my $gs0 = "gs -q -dNOPAUSE -r$res -g${width}x$height"; + my $gs1 = "-"; + $gs0 .= " -dTextAlphaBits=$antialias -dGraphicsAlphaBits=$antialias" + if $antialias; + if ( $format eq 'png' ) { + mysystem ("$gs0 -sDEVICE=". ($mono ? "pngmono" : $gs_format). + " -sOutputFile=$out_file $gs1", $ps); + } + elsif ( $format eq 'jpg' ) { + mysystem ("$gs0 -sDEVICE=". ($mono ? "jpeggray" : $gs_format). + " -sOutputFile=$out_file $gs1", $ps); + } + elsif ( $format eq 'gif' ) { + if ( $use_pbm ) { + # Convert to PPM and use some of the PBM converters. + mysystem ("$gs0 -sDEVICE=". ($mono ? "pbm" : "ppm"). + " -sOutputFile=$pbm_file $gs1", $ps); + # mysystem ("pnmcrop $pbm_file | ppmtogif > $out_file"); + mysystem ("ppmtogif $pbm_file > $out_file"); + unlink ($pbm_file); + } + else { + # GhostScript has GIF drivers built-in. + mysystem ("$gs0 -sDEVICE=". ($mono ? "gifmono" : "gif8"). + " -sOutputFile=$out_file $gs1", $ps); + } + } + else { + warn "ASSERT ERROR: Unhandled output type: $format\n"; + exit (1); + } + +# unless ( -s $out_file ) { +# warn "Problem creating $out_file for $eps_file\n"; +# $err++; +# } + + slurp($out_file); + +} + +exit 1 if $err; + +################ Subroutines ################ + +sub mysystem { + my ($cmd, $data) = @_; + warn "+ $cmd\n" if $trace; + if ( $data ) { + if ( $trace ) { + my $dp = ">> " . $data; + $dp =~ s/\n(.)/\n>> $1/g; + warn "$dp"; + } + open (CMD, "|$cmd") or die ("$cmd: $!\n"); + print CMD $data; + close CMD or die ("$cmd close: $!\n"); + } + else { + system ($cmd); + } +} + +sub set_out_type { + my ($opt) = lc (shift (@_)); + if ( $opt =~ /^png(mono|gray|16|256|16m|alpha)?$/ ) { + $format = 'png'; + $gs_format = $format.(defined $1 ? $1 : '16m'); + } + elsif ( $opt =~ /^gif(mono)?$/ ) { + $format = 'gif'; + $gs_format = $format.(defined $1 ? $1 : ''); + } + elsif ( $opt =~ /^(jpg|jpeg)(gray)?$/ ) { + $format = 'jpg'; + $gs_format = 'jpeg'.(defined $2 ? $2 : ''); + } + else { + warn "ASSERT ERROR: Invalid value to set_out_type: $opt\n"; + exit (1); + } +} + +# 'antialias|aa=i' => \$antialias, +# 'noantialias|noaa' => sub { $antialias = 0 }, +# 'scale=f' => \$scale, +# 'width=i' => \$width, +# 'height=i' => \$height, +# 'resolution=i' => \$res, + +# die ("Antialias value must be 0, 1, 2, 4, or 8\n") + +# -width XXX desired with +# -height XXX desired height +# -resolution XXX resolution (default = $res) +# -scale XXX scaling factor +# -antialias XX antialias factor (must be 0, 1, 2, 4 or 8; default: 4) +# -noantialias no antialiasing (same as -antialias 0) + +1; diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 2d0263b..d4d7ca1 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -54,9 +54,14 @@ FS::UID->install_callback( sub { $conf = FS::Conf->new; $conf_encryption = $conf->exists('encryption'); $File::CounterFile::DEFAULT_DIR = $conf->base_dir . "/counters.". datasrc; + if ( driver_name eq 'Pg' ) { + eval "use DBD::Pg ':pg_types'"; + die $@ if $@; + } else { + eval "sub PG_BYTEA { die 'guru meditation #9: calling PG_BYTEA when not running Pg?'; }"; + } } ); - =head1 NAME FS::Record - Database record objects @@ -215,29 +220,33 @@ objects. The preferred usage is to pass a hash reference of named parameters: - my @records = qsearch( { - 'table' => 'table_name', - 'hashref' => { 'field' => 'value' - 'field' => { 'op' => '<', - 'value' => '420', - }, - }, - - #these are optional... - 'select' => '*', - 'extra_sql' => 'AND field ', - 'order_by' => 'ORDER BY something', - #'cache_obj' => '', #optional - 'addl_from' => 'LEFT JOIN othtable USING ( field )', - 'debug' => 1, - } - ); + @records = qsearch( { + 'table' => 'table_name', + 'hashref' => { 'field' => 'value' + 'field' => { 'op' => '<', + 'value' => '420', + }, + }, + + #these are optional... + 'select' => '*', + 'extra_sql' => 'AND field = ? AND intfield = ?', + 'extra_param' => [ 'value', [ 5, 'int' ] ], + 'order_by' => 'ORDER BY something', + #'cache_obj' => '', #optional + 'addl_from' => 'LEFT JOIN othtable USING ( field )', + 'debug' => 1, + } + ); Much code still uses old-style positional parameters, this is also probably fine in the common case where there are only two parameters: my @records = qsearch( 'table', { 'field' => 'value' } ); +Also possible is an experimental LISTREF of PARAMS_HASHREFs for a UNION of +the individual PARAMS_HASHREF queries + ###oops, argh, FS::Record::new only lets us create database fields. #Normal behaviour if SELECT is not specified is `*', as in #C<SELECT * FROM table WHERE ...>. However, there is an experimental new @@ -251,8 +260,40 @@ fine in the common case where there are only two parameters: my %TYPE = (); #for debugging +sub _bind_type { + my($type, $value) = @_; + + my $bind_type = { TYPE => SQL_VARCHAR }; + + if ( $type =~ /(big)?(int|serial)/i && $value =~ /^\d+(\.\d+)?$/ ) { + + $bind_type = { TYPE => SQL_INTEGER }; + + } elsif ( $type =~ /^bytea$/i || $type =~ /(blob|varbinary)/i ) { + + if ( driver_name eq 'Pg' ) { + no strict 'subs'; + $bind_type = { pg_type => PG_BYTEA }; + #} else { + # $bind_type = ? #SQL_VARCHAR could be fine? + } + + #DBD::Pg 1.49: Cannot bind ... unknown sql_type 6 with SQL_FLOAT + #fixed by DBD::Pg 2.11.8 + #can change back to SQL_FLOAT in early-mid 2010, once everyone's upgraded + #(make a Tron test first) + } elsif ( _is_fs_float( $type, $value ) ) { + + $bind_type = { TYPE => SQL_DECIMAL }; + + } + + $bind_type; + +} + sub _is_fs_float { - my ($type, $value) = @_; + my($type, $value) = @_; if ( ( $type =~ /(numeric)/i && $value =~ /^[+-]?\d+(\.\d+)?$/ ) || ( $type =~ /(real|float4)/i && $value =~ /[-+]?\d*\.?\d+([eE][-+]?\d+)?/) ) { @@ -262,101 +303,147 @@ sub _is_fs_float { } sub qsearch { - my($stable, $record, $select, $extra_sql, $order_by, $cache, $addl_from ); - my $debug = ''; - if ( ref($_[0]) ) { #hashref for now, eventually maybe accept a list too + my( @stable, @record, @cache ); + my( @select, @extra_sql, @extra_param, @order_by, @addl_from ); + my @debug = (); + my %union_options = (); + if ( ref($_[0]) eq 'ARRAY' ) { + my $optlist = shift; + %union_options = @_; + foreach my $href ( @$optlist ) { + push @stable, ( $href->{'table'} or die "table name is required" ); + push @record, ( $href->{'hashref'} || {} ); + push @select, ( $href->{'select'} || '*' ); + push @extra_sql, ( $href->{'extra_sql'} || '' ); + push @extra_param, ( $href->{'extra_param'} || [] ); + push @order_by, ( $href->{'order_by'} || '' ); + push @cache, ( $href->{'cache_obj'} || '' ); + push @addl_from, ( $href->{'addl_from'} || '' ); + push @debug, ( $href->{'debug'} || '' ); + } + die "at least one hashref is required" unless scalar(@stable); + } elsif ( ref($_[0]) eq 'HASH' ) { 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'} || ''; - $debug = $opt->{'debug'} || ''; + $stable[0] = $opt->{'table'} or die "table name is required"; + $record[0] = $opt->{'hashref'} || {}; + $select[0] = $opt->{'select'} || '*'; + $extra_sql[0] = $opt->{'extra_sql'} || ''; + $extra_param[0] = $opt->{'extra_param'} || []; + $order_by[0] = $opt->{'order_by'} || ''; + $cache[0] = $opt->{'cache_obj'} || ''; + $addl_from[0] = $opt->{'addl_from'} || ''; + $debug[0] = $opt->{'debug'} || ''; } else { - ($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_; - $select ||= '*'; + ( $stable[0], + $record[0], + $select[0], + $extra_sql[0], + $cache[0], + $addl_from[0] + ) = @_; + $select[0] ||= '*'; } + my $cache = $cache[0]; - #$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table"; - #for jsearch - $stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable"; - $stable = $1; + my @statement = (); + my @value = (); + my @bind_type = (); my $dbh = dbh; + foreach my $stable ( @stable ) { + my $record = shift @record; + my $select = shift @select; + my $extra_sql = shift @extra_sql; + my $extra_param = shift @extra_param; + my $order_by = shift @order_by; + my $cache = shift @cache; + my $addl_from = shift @addl_from; + my $debug = shift @debug; + + #$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table"; + #for jsearch + $stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable"; + $stable = $1; + + my $table = $cache ? $cache->table : $stable; + my $dbdef_table = dbdef->table($table) + or die "No schema for table $table found - ". + "do you need to run freeside-upgrade?"; + my $pkey = $dbdef_table->primary_key; + + my @real_fields = grep exists($record->{$_}), real_fields($table); + my @virtual_fields; + if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { + @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields; + } else { + cluck "warning: FS::$table not loaded; virtual fields not searchable" + unless $nowarn_classload; + @virtual_fields = (); + } - my $table = $cache ? $cache->table : $stable; - my $dbdef_table = dbdef->table($table) - or die "No schema for table $table found - ". - "do you need to run freeside-upgrade?"; - my $pkey = $dbdef_table->primary_key; + my $statement .= "SELECT $select FROM $stable"; + $statement .= " $addl_from" if $addl_from; + if ( @real_fields or @virtual_fields ) { + $statement .= ' WHERE '. join(' AND ', + get_real_fields($table, $record, \@real_fields) , + get_virtual_fields($table, $pkey, $record, \@virtual_fields), + ); + } - my @real_fields = grep exists($record->{$_}), real_fields($table); - my @virtual_fields; - if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { - @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields; - } else { - cluck "warning: FS::$table not loaded; virtual fields not searchable" - unless $nowarn_classload; - @virtual_fields = (); - } + $statement .= " $extra_sql" if defined($extra_sql); + $statement .= " $order_by" if defined($order_by); - my $statement = "SELECT $select FROM $stable"; - $statement .= " $addl_from" if $addl_from; - if ( @real_fields or @virtual_fields ) { - $statement .= ' WHERE '. join(' AND ', - get_real_fields($table, $record, \@real_fields) , - get_virtual_fields($table, $pkey, $record, \@virtual_fields), - ); - } + push @statement, $statement; - $statement .= " $extra_sql" if defined($extra_sql); - $statement .= " $order_by" if defined($order_by); + warn "[debug]$me $statement\n" if $DEBUG > 1 || $debug; + - warn "[debug]$me $statement\n" if $DEBUG > 1 || $debug; - my $sth = $dbh->prepare($statement) - or croak "$dbh->errstr doing $statement"; + foreach my $field ( + grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields + ) { - my $bind = 1; + my $value = $record->{$field}; + my $op = (ref($value) && $value->{op}) ? $value->{op} : '='; + $value = $value->{'value'} if ref($value); + my $type = dbdef->table($table)->column($field)->type; - foreach my $field ( - grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields - ) { + my $bind_type = _bind_type($type, $value); - my $value = $record->{$field}; - my $op = (ref($value) && $value->{op}) ? $value->{op} : '='; - $value = $value->{'value'} if ref($value); - my $type = dbdef->table($table)->column($field)->type; + #if ( $DEBUG > 2 ) { + # no strict 'refs'; + # %TYPE = map { &{"DBI::$_"}() => $_ } @{ $DBI::EXPORT_TAGS{sql_types} } + # unless keys %TYPE; + # warn " bind_param $bind (for field $field), $value, TYPE $TYPE{$TYPE}\n"; + #} - my $TYPE = SQL_VARCHAR; - if ( $type =~ /(big)?(int|serial)/i && $value =~ /^\d+(\.\d+)?$/ ) { - $TYPE = SQL_INTEGER; + push @value, $value; + push @bind_type, $bind_type; - #DBD::Pg 1.49: Cannot bind ... unknown sql_type 6 with SQL_FLOAT - #fixed by DBD::Pg 2.11.8 - #can change back to SQL_FLOAT in early-mid 2010, once everyone's upgraded - } elsif ( _is_fs_float( $type, $value ) ) { - $TYPE = SQL_DECIMAL; } - if ( $DEBUG > 2 ) { - no strict 'refs'; - %TYPE = map { &{"DBI::$_"}() => $_ } @{ $DBI::EXPORT_TAGS{sql_types} } - unless keys %TYPE; - warn " bind_param $bind (for field $field), $value, TYPE $TYPE{$TYPE}\n"; + foreach my $param ( @$extra_param ) { + my $bind_type = { TYPE => SQL_VARCHAR }; + my $value = $param; + if ( ref($param) ) { + $value = $param->[0]; + my $type = $param->[1]; + $bind_type = _bind_type($type, $value); + } + push @value, $value; + push @bind_type, $bind_type; } + } - #if this needs to be re-enabled, it needs to use a custom op like - #"APPROX=" or something (better name?, not '=', to avoid affecting other - # searches - #if ($TYPE eq SQL_DECIMAL && $op eq 'APPROX=' ) { - # # these values are arbitrary; better (faster?) ones welcome - # $sth->bind_param($bind++, $value*1.00001, { TYPE => $TYPE } ); - # $sth->bind_param($bind++, $value*.99999, { TYPE => $TYPE } ); - #} else { - $sth->bind_param($bind++, $value, { TYPE => $TYPE } ); - #} + my $statement = join( ' ) UNION ( ', @statement ); + $statement = "( $statement )" if scalar(@statement) > 1; + $statement .= " $union_options{order_by}" if $union_options{order_by}; + + my $sth = $dbh->prepare($statement) + or croak "$dbh->errstr doing $statement"; + my $bind = 1; + foreach my $value ( @value ) { + my $bind_type = shift @bind_type; + $sth->bind_param($bind++, $value, $bind_type ); } # $sth->execute( map $record->{$_}, @@ -365,6 +452,13 @@ sub qsearch { $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr; + # virtual fields and blessings are nonsense in a heterogeneous UNION, right? + my $table = $stable[0]; + my $pkey = ''; + $table = '' if grep { $_ ne $table } @stable; + $pkey = dbdef->table($table)->primary_key if $table; + + my @virtual_fields = (); if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { @virtual_fields = "FS::$table"->virtual_fields; } else { @@ -1165,7 +1259,10 @@ sub replace { # Encrypt for replace my $saved = {}; - if ($conf->exists('encryption') && defined(eval '@FS::'. $new->table . '::encrypted_fields')) { + if ( $conf->exists('encryption') + && defined(eval '@FS::'. $new->table . '::encrypted_fields') + && scalar( eval '@FS::'. $new->table . '::encrypted_fields') + ) { foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') { $saved->{$field} = $new->getfield($field); $new->setfield($field, $new->encrypt($new->getfield($field))); @@ -1692,11 +1789,14 @@ sub batch_import { my $record = $class->new( \%hash ); + my $param = {}; while ( scalar(@later) ) { my $sub = shift @later; my $data = shift @later; - &{$sub}($record, $data, $conf); # $record->&{$sub}($data, $conf); + &{$sub}($record, $data, $conf, $param); # $record->&{$sub}($data, $conf); + last if exists( $param->{skiprow} ); } + next if exists( $param->{skiprow} ); my $error = $record->insert; @@ -1728,16 +1828,18 @@ sub _h_statement { $time ||= time; + my %nohistory = map { $_=>1 } $self->nohistory_fields; + my @fields = - grep { defined($self->getfield($_)) && $self->getfield($_) ne "" } + grep { defined($self->get($_)) && $self->get($_) ne "" && ! $nohistory{$_} } real_fields($self->table); ; - # If we're encrypting then don't ever store the payinfo or CVV2 in the history.... - # You can see if it changed by the paymask... - if ($conf && $conf->exists('encryption') ) { - @fields = grep $_ ne 'payinfo' && $_ ne 'cvv2', @fields; + # If we're encrypting then don't store the payinfo in the history + if ( $conf && $conf->exists('encryption') ) { + @fields = grep { $_ ne 'payinfo' } @fields; } + my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields; "INSERT INTO h_". $self->table. " ( ". @@ -1941,10 +2043,26 @@ sub ut_money { ''; } +=item ut_moneyn COLUMN + +Check/untaint monetary numbers. May be negative. If there +is an error, returns the error, otherwise returns false. + +=cut + +sub ut_moneyn { + my($self,$field)=@_; + if ($self->getfield($field) eq '') { + $self->setfield($field, ''); + return ''; + } + $self->ut_money($field); +} + =item ut_text COLUMN Check/untaint text. Alphanumerics, spaces, and the following punctuation -symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / = [ ] +symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / = [ ] < > May not be null. If there is an error, returns the error, otherwise returns false. @@ -1956,7 +2074,7 @@ sub ut_text { #warn "notexist ". \¬exist. "\n"; #warn "AUTOLOAD ". \&AUTOLOAD. "\n"; $self->getfield($field) - =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]+)$/ + =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>]+)$/ or return gettext('illegal_or_empty_text'). " $field: ". $self->getfield($field); $self->setfield($field,$1); @@ -2086,12 +2204,14 @@ sub ut_hexn { } =item ut_ip COLUMN -Check/untaint ip addresses. IPv4 only for now. +Check/untaint ip addresses. IPv4 only for now, though ::1 is auto-translated +to 127.0.0.1. =cut sub ut_ip { my( $self, $field ) = @_; + $self->setfield($field, '127.0.0.1') if $self->getfield($field) eq '::1'; $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ or return "Illegal (IP address) $field: ". $self->getfield($field); for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; } @@ -2101,7 +2221,8 @@ sub ut_ip { =item ut_ipn COLUMN -Check/untaint ip addresses. IPv4 only for now. May be null. +Check/untaint ip addresses. IPv4 only for now, though ::1 is auto-translated +to 127.0.0.1. May be null. =cut @@ -2321,7 +2442,7 @@ sub ut_enum { my( $self, $field, $choices ) = @_; foreach my $choice ( @$choices ) { if ( $self->getfield($field) eq $choice ) { - $self->setfield($choice); + $self->setfield($field, $choice); return ''; } } @@ -2657,7 +2778,7 @@ sub _quote { ")\n" if $DEBUG > 2; if ( $value eq '' && $nullable ) { - 'NULL' + 'NULL'; } elsif ( $value eq '' && $column_type =~ /^(int|numeric)/ ) { cluck "WARNING: Attempting to set non-null integer $table.$column null; ". "using 0 instead"; @@ -2665,6 +2786,15 @@ sub _quote { } elsif ( $value =~ /^\d+(\.\d+)?$/ && ! $column_type =~ /(char|binary|text)$/i ) { $value; + } elsif (( $column_type =~ /^bytea$/i || $column_type =~ /(blob|varbinary)/i ) + && driver_name eq 'Pg' + ) + { + no strict 'subs'; +# dbh->quote($value, { pg_type => PG_BYTEA() }); # doesn't work right + # Pg binary string quoting: convert each character to 3-digit octal prefixed with \\, + # single-quote the whole mess, and put an "E" in front. + return ("E'" . join('', map { sprintf('\\\\%03o', ord($_)) } split(//, $value) ) . "'"); } else { dbh->quote($value); } diff --git a/FS/FS/Report/Table/Monthly.pm b/FS/FS/Report/Table/Monthly.pm index d75f0be..845ab15 100644 --- a/FS/FS/Report/Table/Monthly.pm +++ b/FS/FS/Report/Table/Monthly.pm @@ -311,28 +311,99 @@ sub cust_bill_pkg { my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; my $where = ''; + my $comparison = ''; if ( $opt{'classnum'} =~ /^(\d+)$/ ) { if ( $1 == 0 ) { - $where = "classnum IS NULL"; + $comparison = "IS NULL"; } else { - $where = "classnum = $1"; + $comparison = "= $1"; + } + + if ( $opt{'use_override'} ) { + $where = "( + part_pkg.classnum $comparison AND pkgpart_override IS NULL OR + override.classnum $comparison AND pkgpart_override IS NOT NULL + )"; + } else { + $where = "part_pkg.classnum $comparison"; } } $agentnum ||= $opt{'agentnum'}; - $self->scalar_sql(" + my $usage = cust_bill_pkg_detail(@_); + + my $total = $self->scalar_sql(" SELECT SUM(cust_bill_pkg.setup + cust_bill_pkg.recur) FROM cust_bill_pkg LEFT JOIN cust_bill USING ( invnum ) 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 WHERE pkgnum != 0 AND $where AND ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum) ); + if ($opt{use_usage} && $opt{use_usage} eq 'recurring') { + return $total-$usage; + } elsif ($opt{use_usage} && $opt{use_usage} eq 'usage') { + return $usage; + } else { + return $total; + } +} + +sub cust_bill_pkg_detail { + my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; + + my @where = ( "cust_bill_pkg.pkgnum != 0" ); + my $comparison = ''; + if ( $opt{'classnum'} =~ /^(\d+)$/ ) { + if ( $1 == 0 ) { + $comparison = "IS NULL"; + } else { + $comparison = "= $1"; + } + + if ( $opt{'use_override'} ) { + push @where, "( + part_pkg.classnum $comparison AND pkgpart_override IS NULL OR + override.classnum $comparison AND pkgpart_override IS NOT NULL + )"; + } else { + push @where, "part_pkg.classnum $comparison"; + } + } + + if ( $opt{'usageclass'} =~ /^(\d+)$/ ) { + if ( $1 == 0 ) { + $comparison = "IS NULL"; + } else { + $comparison = "= $1"; + } + + push @where, "cust_bill_pkg_detail.classnum $comparison"; + } + + $agentnum ||= $opt{'agentnum'}; + + my $where = join( ' AND ', @where ); + + $self->scalar_sql(" + SELECT SUM(amount) + FROM cust_bill_pkg_detail + LEFT JOIN cust_bill_pkg USING ( billpkgnum ) + LEFT JOIN cust_bill ON cust_bill_pkg.invnum = cust_bill.invnum + LEFT JOIN cust_main USING ( custnum ) + 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 + WHERE $where + AND ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum) + ); + } sub setup_pkg { shift->pkg_field( @_, 'setup' ); } diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 885eaaa..6f53b2a 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -320,6 +320,8 @@ sub tables_hashref { my @perl_type = ( 'text', 'NULL', '' ); my @money_type = ( 'decimal', '', '10,2' ); my @money_typen = ( 'decimal', 'NULL', '10,2' ); + my @taxrate_type = ( 'decimal', '', '14,8' ); # requires pg 8 for + my @taxrate_typen = ( 'decimal', 'NULL', '14,8' ); # fs-upgrade to work my $username_len = 32; #usernamemax config file @@ -370,18 +372,56 @@ sub tables_hashref { 'index' => [ ['typenum'] ], }, + 'cust_attachment' => { + 'columns' => [ + 'attachnum', 'serial', '', '', '', '', + 'custnum', 'int', '', '', '', '', + '_date', @date_type, '', '', + 'otaker', 'varchar', '', 32, '', '', + 'filename', 'varchar', '', 32, '', '', + 'mime_type', 'varchar', '', 32, '', '', + 'body', 'blob', 'NULL', '', '', '', + 'disabled', @date_type, '', '', + ], + 'primary_key' => 'attachnum', + 'unique' => [], + 'index' => [ ['custnum'] ], + }, + 'cust_bill' => { 'columns' => [ - 'invnum', 'serial', '', '', '', '', - 'custnum', 'int', '', '', '', '', - '_date', @date_type, '', '', - 'charged', @money_type, '', '', - 'printed', 'int', '', '', '', '', - 'closed', 'char', 'NULL', 1, '', '', + #regular fields + 'invnum', 'serial', '', '', '', '', + 'custnum', 'int', '', '', '', '', + '_date', @date_type, '', '', + 'charged', @money_type, '', '', + 'invoice_terms', 'varchar', 'NULL', $char_d, '', '', + + #customer balance info at invoice generation time + 'previous_balance', @money_typen, '', '', #eventually not nullable + 'billing_balance', @money_typen, '', '', #eventually not nullable + + #deprecated (unused by now, right?) + 'printed', 'int', '', '', '', '', + + #specific use cases + 'closed', 'char', 'NULL', 1, '', '', + 'statementnum', 'int', 'NULL', '', '', '', #invoice aggregate statements ], 'primary_key' => 'invnum', 'unique' => [], - 'index' => [ ['custnum'], ['_date'] ], + 'index' => [ ['custnum'], ['_date'], ['statementnum'], ], + }, + + 'cust_statement' => { + 'columns' => [ + 'statementnum', 'serial', '', '', '', '', + 'custnum', 'int', '', '', '', '', + '_date', @date_type, '', '', + ], + 'primary_key' => 'statementnum', + 'unique' => [], + 'index' => [ ['custnum'], ['_date'], ], }, 'cust_bill_event' => { @@ -396,7 +436,9 @@ sub tables_hashref { 'primary_key' => 'eventnum', #no... there are retries now #'unique' => [ [ 'eventpart', 'invnum' ] ], 'unique' => [], - 'index' => [ ['invnum'], ['status'], ['eventpart'] ], + 'index' => [ ['invnum'], ['status'], ['eventpart'], + ['statustext'], ['_date'], + ], }, 'part_bill_event' => { @@ -493,7 +535,9 @@ sub tables_hashref { 'primary_key' => 'eventnum', #no... there are retries now #'unique' => [ [ 'eventpart', 'invnum' ] ], 'unique' => [], - 'index' => [ ['eventpart'], ['tablenum'], ['status'] ], + 'index' => [ ['eventpart'], ['tablenum'], ['status'], + ['statustext'], ['_date'], + ], }, 'cust_bill_pkg' => { @@ -507,14 +551,16 @@ sub tables_hashref { 'sdate', @date_type, '', '', 'edate', @date_type, '', '', 'itemdesc', 'varchar', 'NULL', $char_d, '', '', + 'itemcomment', 'varchar', 'NULL', $char_d, '', '', 'section', 'varchar', 'NULL', $char_d, '', '', 'quantity', 'int', 'NULL', '', '', '', 'unitsetup', @money_typen, '', '', 'unitrecur', @money_typen, '', '', + 'hidden', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'billpkgnum', 'unique' => [], - 'index' => [ ['invnum'], [ 'pkgnum' ] ], + 'index' => [ ['invnum'], [ 'pkgnum' ], [ 'itemdesc' ], ], }, 'cust_bill_pkg_detail' => { @@ -523,9 +569,10 @@ sub tables_hashref { 'billpkgnum', 'int', 'NULL', '', '', '', # should not be nullable 'pkgnum', 'int', 'NULL', '', '', '', # deprecated 'invnum', 'int', 'NULL', '', '', '', # deprecated - 'amount', @money_typen, '', '', + 'amount', 'decimal', 'NULL', '10,4', '', '', 'format', 'char', 'NULL', 1, '', '', - 'classnum', 'char', 'NULL', 1, '', '', + 'classnum', 'int', 'NULL', '', '', '', + 'phonenum', 'varchar', 'NULL', 15, '', '', 'detail', 'varchar', '', 255, '', '', ], 'primary_key' => 'detailnum', @@ -554,7 +601,7 @@ sub tables_hashref { 'billpkgtaxlocationnum', 'serial', '', '', '', '', 'billpkgnum', 'int', '', '', '', '', 'taxnum', 'int', '', '', '', '', - 'taxtype', 'varchar', $char_d, '', '', '', + 'taxtype', 'varchar', '', $char_d, '', '', 'pkgnum', 'int', '', '', '', '', 'locationnum', 'int', '', '', '', '', #redundant? 'amount', @money_type, '', '', @@ -564,6 +611,21 @@ sub tables_hashref { 'index' => [ [ 'billpkgnum' ], [ 'taxnum' ], [ 'pkgnum' ], [ 'locationnum' ] ], }, + 'cust_bill_pkg_tax_rate_location' => { + 'columns' => [ + 'billpkgtaxratelocationnum', 'serial', '', '', '', '', + 'billpkgnum', 'int', '', '', '', '', + 'taxnum', 'int', '', '', '', '', + 'taxtype', 'varchar', '', $char_d, '', '', + 'locationtaxid', 'varchar', 'NULL', $char_d, '', '', + 'taxratelocationnum', 'int', '', '', '', '', + 'amount', @money_type, '', '', + ], + 'primary_key' => 'billpkgtaxratelocationnum', + 'unique' => [], + 'index' => [ [ 'billpkgnum' ], [ 'taxnum' ], [ 'taxratelocationnum' ] ], + }, + 'cust_credit' => { 'columns' => [ 'crednum', 'serial', '', '', '', '', @@ -575,6 +637,7 @@ sub tables_hashref { 'reasonnum', 'int', 'NULL', '', '', '', 'addlinfo', 'text', 'NULL', '', '', '', 'closed', 'char', 'NULL', 1, '', '', + 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances ], 'primary_key' => 'crednum', 'unique' => [], @@ -588,6 +651,7 @@ sub tables_hashref { 'invnum', 'int', '', '', '', '', '_date', @date_type, '', '', 'amount', @money_type, '', '', + 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances ], 'primary_key' => 'creditbillnum', 'unique' => [], @@ -664,6 +728,7 @@ sub tables_hashref { 'paytype', 'varchar', 'NULL', $char_d, '', '', 'payip', 'varchar', 'NULL', 15, '', '', 'geocode', 'varchar', 'NULL', 20, '', '', + 'censustract', 'varchar', 'NULL', 20, '', '', # 7 to save space? 'tax', 'char', 'NULL', 1, '', '', 'otaker', 'varchar', '', 32, '', '', 'refnum', 'int', '', '', '', '', @@ -671,7 +736,10 @@ sub tables_hashref { 'comments', 'text', 'NULL', '', '', '', 'spool_cdr','char', 'NULL', 1, '', '', 'squelch_cdr','char', 'NULL', 1, '', '', + 'cdr_termination_percentage', 'decimal', 'NULL', '', '', '', 'invoice_terms', 'varchar', 'NULL', $char_d, '', '', + 'archived', 'char', 'NULL', 1, '', '', + 'email_csv_cdr', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'custnum', 'unique' => [ [ 'agentnum', 'agent_custid' ] ], @@ -680,6 +748,7 @@ sub tables_hashref { [ 'agentnum' ], [ 'refnum' ], [ 'custbatch' ], [ 'referral_custnum' ], [ 'payby' ], [ 'paydate' ], + [ 'archived' ], #billing [ 'last' ], [ 'company' ], [ 'county' ], [ 'state' ], [ 'country' ], @@ -693,6 +762,32 @@ sub tables_hashref { ], }, + 'cust_recon' => { # what purpose does this serve? + 'columns' => [ + 'reconid', 'serial', '', '', '', '', + 'recondate', @date_type, '', '', + 'custnum', 'int' , '', '', '', '', + 'agentnum', 'int', '', '', '', '', + 'last', 'varchar', '', $char_d, '', '', + 'first', 'varchar', '', $char_d, '', '', + 'address1', 'varchar', '', $char_d, '', '', + 'address2', 'varchar', 'NULL', $char_d, '', '', + 'city', 'varchar', '', $char_d, '', '', + 'state', 'varchar', 'NULL', $char_d, '', '', + 'zip', 'varchar', 'NULL', 10, '', '', + 'pkg', 'varchar', 'NULL', $char_d, '', '', + 'adjourn', @date_type, '', '', + 'status', 'varchar', 'NULL', 10, '', '', + 'agent_custid', 'varchar', '', $char_d, '', '', + 'agent_pkg', 'varchar', 'NULL', $char_d, '', '', + 'agent_adjourn', @date_type, '', '', + 'comments', 'text', 'NULL', '', '', '', + ], + 'primary_key' => 'reconid', + 'unique' => [], + 'index' => [], + }, + #eventually use for billing & ship from cust_main too #for now, just cust_pkg locations 'cust_location' => { @@ -739,6 +834,33 @@ sub tables_hashref { 'index' => [ [ 'custnum' ], [ '_date' ], ], }, + 'cust_main_exemption' => { + 'columns' => [ + 'exemptionnum', 'serial', '', '', '', '', + 'custnum', 'int', '', '', '', '', + 'taxname', 'varchar', '', $char_d, '', '', + #start/end dates? for reporting? + ], + 'primary_key' => 'exemptionnum', + 'unique' => [], + 'index' => [ [ 'custnum' ] ], + }, + + 'cust_tax_adjustment' => { + 'columns' => [ + 'adjustmentnum', 'serial', '', '', '', '', + 'custnum', 'int', '', '', '', '', + 'taxname', 'varchar', '', $char_d, '', '', + 'amount', @money_type, '', '', + 'comment', 'varchar', 'NULL', $char_d, '', '', + 'billpkgnum', 'int', 'NULL', '', '', '', + #more? no cust_bill_pkg_tax_location? + ], + 'primary_key' => 'adjustmentnum', + 'unique' => [], + 'index' => [ [ 'custnum' ], [ 'billpkgnum' ] ], + }, + 'cust_main_county' => { #county+state+country are checked off the #cust_main_county for validation and to provide # a tax rate. @@ -770,17 +892,17 @@ sub tables_hashref { 'location', 'varchar', 'NULL', $char_d, '', '',#provided by tax authority 'taxclassnum', 'int', '', '', '', '', 'effective_date', @date_type, '', '', - 'tax', 'real', '', '', '', '', # tax % - 'excessrate', 'real', 'NULL','', '', '', # second tax % + 'tax', @taxrate_type, '', '', # tax % + 'excessrate', @taxrate_typen, '', '', # second tax % 'taxbase', @money_typen, '', '', # amount at first tax rate 'taxmax', @money_typen, '', '', # maximum about at both rates - 'usetax', 'real', 'NULL', '', '', '', # tax % when non-local - 'useexcessrate', 'real', 'NULL', '', '', '', # second tax % when non-local + 'usetax', @taxrate_typen, '', '', # tax % when non-local + 'useexcessrate', @taxrate_typen, '', '', # second tax % when non-local 'unittype', 'int', 'NULL', '', '', '', # for fee - 'fee', 'real', 'NULL', '', '', '', # amount tax per unit - 'excessfee', 'real', 'NULL', '', '', '', # second amount tax per unit - 'feebase', 'real', 'NULL', '', '', '', # units taxed at first rate - 'feemax', 'real', 'NULL', '', '', '', # maximum number of unit taxed + 'fee', @taxrate_typen, '', '', # amount tax per unit + 'excessfee', @taxrate_typen, '', '', # second amount tax per unit + 'feebase', @taxrate_typen, '', '', # units taxed at first rate + 'feemax', @taxrate_typen, '', '', # maximum number of unit taxed 'maxtype', 'int', 'NULL', '', '', '', # indicator of how thresholds accumulate 'taxname', 'varchar', 'NULL', $char_d, '', '', # may appear on invoice 'taxauth', 'int', 'NULL', '', '', '', # tax authority @@ -797,6 +919,21 @@ sub tables_hashref { 'index' => [ ['taxclassnum'], ['data_vendor', 'geocode'] ], }, + 'tax_rate_location' => { + 'columns' => [ + 'taxratelocationnum', 'serial', '', '', '', '', + 'data_vendor', 'varchar', 'NULL', $char_d, '', '', + 'geocode', 'varchar', '', 20, '', '', + 'city', 'varchar', 'NULL', $char_d, '', '', + 'county', 'varchar', 'NULL', $char_d, '', '', + 'state', 'char', 'NULL', 2, '', '', + 'disabled', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'taxratelocationnum', + 'unique' => [], + 'index' => [ [ 'data_vendor', 'geocode', 'disabled' ] ], + }, + 'cust_tax_location' => { 'columns' => [ 'custlocationnum', 'serial', '', '', '', '', @@ -841,14 +978,18 @@ sub tables_hashref { 'payinfo', 'varchar', 'NULL', 512, '', '', #see cust_main above 'paymask', 'varchar', 'NULL', $char_d, '', '', 'paydate', 'varchar', 'NULL', 10, '', '', + 'recurring_billing', 'varchar', 'NULL', $char_d, '', '', #'paybatch', 'varchar', 'NULL', $char_d, '', '', #for auditing purposes. 'payunique', 'varchar', 'NULL', $char_d, '', '', #separate paybatch "unique" functions from current usage + 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances 'status', 'varchar', '', $char_d, '', '', + 'session_id', 'varchar', 'NULL', $char_d, '', '', #only need 32 'statustext', 'text', 'NULL', '', '', '', 'gatewaynum', 'int', 'NULL', '', '', '', #'cust_balance', @money_type, '', '', 'paynum', 'int', 'NULL', '', '', '', + 'jobnum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'paypendingnum', 'unique' => [ [ 'payunique' ] ], @@ -871,6 +1012,7 @@ sub tables_hashref { 'paybatch', 'varchar', 'NULL', $char_d, '', '', #for auditing purposes. 'payunique', 'varchar', 'NULL', $char_d, '', '', #separate paybatch "unique" functions from current usage 'closed', 'char', 'NULL', 1, '', '', + 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances ], 'primary_key' => 'paynum', #i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it# 'unique' => [ [ 'payunique' ] ], @@ -890,6 +1032,7 @@ sub tables_hashref { 'paymask', 'varchar', 'NULL', $char_d, '', '', 'paybatch', 'varchar', 'NULL', $char_d, '', '', #for auditing purposes. 'closed', 'char', 'NULL', 1, '', '', + 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances 'void_date', @date_type, '', '', 'reason', 'varchar', 'NULL', $char_d, '', '', 'otaker', 'varchar', '', 32, '', '', @@ -906,6 +1049,7 @@ sub tables_hashref { 'paynum', 'int', '', '', '', '', 'amount', @money_type, '', '', '_date', @date_type, '', '', + 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances ], 'primary_key' => 'billpaynum', 'unique' => [], @@ -989,6 +1133,7 @@ sub tables_hashref { 'pkgpart', 'int', '', '', '', '', 'locationnum', 'int', 'NULL', '', '', '', 'otaker', 'varchar', '', 32, '', '', + 'start_date', @date_type, '', '', 'setup', @date_type, '', '', 'bill', @date_type, '', '', 'last_bill', @date_type, '', '', @@ -1006,8 +1151,8 @@ sub tables_hashref { 'primary_key' => 'pkgnum', 'unique' => [], 'index' => [ ['custnum'], ['pkgpart'], [ 'locationnum' ], - ['setup'], ['last_bill'], ['bill'], ['susp'], ['adjourn'], - ['expire'], ['cancel'], + [ 'start_date' ], ['setup'], ['last_bill'], ['bill'], + ['susp'], ['adjourn'], ['expire'], ['cancel'], ['change_date'], ], }, @@ -1124,9 +1269,12 @@ sub tables_hashref { 'plan', 'varchar', 'NULL', $char_d, '', '', 'plandata', 'text', 'NULL', '', '', '', 'disabled', 'char', 'NULL', 1, '', '', + 'custom', 'char', 'NULL', 1, '', '', 'taxclass', 'varchar', 'NULL', $char_d, '', '', 'classnum', 'int', 'NULL', '', '', '', 'taxproductnum', 'int', 'NULL', '', '', '', + 'setup_cost', @money_typen, '', '', + 'recur_cost', @money_typen, '', '', 'pay_weight', 'real', 'NULL', '', '', '', 'credit_weight', 'real', 'NULL', '', '', '', 'agentnum', 'int', 'NULL', '', '', '', @@ -1139,24 +1287,28 @@ sub tables_hashref { 'part_pkg_link' => { 'columns' => [ - 'pkglinknum', 'serial', '', '', '', '', - 'src_pkgpart', 'int', '', '', '', '', - 'dst_pkgpart', 'int', '', '', '', '', - 'link_type', 'varchar', '', $char_d, '', '', + 'pkglinknum', 'serial', '', '', '', '', + 'src_pkgpart', 'int', '', '', '', '', + 'dst_pkgpart', 'int', '', '', '', '', + 'link_type', 'varchar', '', $char_d, '', '', + 'hidden', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'pkglinknum', - 'unique' => [ [ 'src_pkgpart', 'dst_pkgpart', 'link_type' ] ], + 'unique' => [ [ 'src_pkgpart', 'dst_pkgpart', 'link_type', 'hidden' ] ], 'index' => [ [ 'src_pkgpart' ] ], }, + # XXX somewhat borked unique: we don't really want a hidden and unhidden + # it turns out we'd prefer to use svc, bill, and invisibill (or something) 'part_pkg_taxclass' => { 'columns' => [ 'taxclassnum', 'serial', '', '', '', '', 'taxclass', 'varchar', '', $char_d, '', '', + 'disabled', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'taxclassnum', 'unique' => [ [ 'taxclass' ] ], - 'index' => [], + 'index' => [ [ 'disabled' ] ], }, 'part_pkg_taxproduct' => { @@ -1225,7 +1377,7 @@ sub tables_hashref { ], 'primary_key' => 'pkgsvcnum', 'unique' => [ ['pkgpart', 'svcpart'] ], - 'index' => [ ['pkgpart'] ], + 'index' => [ ['pkgpart'], ['quantity'] ], }, 'part_referral' => { @@ -1257,6 +1409,7 @@ sub tables_hashref { 'columnnum', 'serial', '', '', '', '', 'svcpart', 'int', '', '', '', '', 'columnname', 'varchar', '', 64, '', '', + 'columnlabel', 'varchar', 'NULL', $char_d, '', '', 'columnvalue', 'varchar', 'NULL', $char_d, '', '', 'columnflag', 'char', 'NULL', 1, '', '', ], @@ -1298,7 +1451,7 @@ sub tables_hashref { 'columns' => [ 'svcnum', 'int', '', '', '', '', 'username', 'varchar', '', $username_len, '', '', - '_password', 'varchar', '', 512, '', '', + '_password', 'varchar', 'NULL', 512, '', '', '_password_encoding', 'varchar', 'NULL', $char_d, '', '', 'sec_phrase', 'varchar', 'NULL', $char_d, '', '', 'popnum', 'int', 'NULL', '', '', '', @@ -1495,16 +1648,20 @@ sub tables_hashref { 'svcnum', 'int', 'NULL', '', '', '', 'custnum', 'int', 'NULL', '', '', '', 'secure', 'char', 'NULL', 1, '', '', + 'priority', 'int', 'NULL', '', '', '', ], 'primary_key' => 'jobnum', 'unique' => [], - 'index' => [ [ 'job' ], [ 'svcnum' ], [ 'custnum' ], [ 'status' ] ], + 'index' => [ [ 'secure' ], [ 'priority' ], + [ 'job' ], [ 'svcnum' ], [ 'custnum' ], [ 'status' ], + ], }, 'queue_arg' => { 'columns' => [ 'argnum', 'serial', '', '', '', '', 'jobnum', 'int', '', '', '', '', + 'frozen', 'char', 'NULL', 1, '', '', 'arg', 'text', 'NULL', '', '', '', ], 'primary_key' => 'argnum', @@ -1654,16 +1811,17 @@ sub tables_hashref { 'columns' => [ 'svcnum', 'int', '', '', '', '', 'description', 'varchar', 'NULL', $char_d, '', '', - 'blocknum', 'int', '', '', '', '', + 'blocknum', 'int', 'NULL', '', '', '', 'speed_up', 'int', '', '', '', '', 'speed_down', 'int', '', '', '', '', - 'ip_addr', 'varchar', '', 15, '', '', + 'ip_addr', 'varchar', 'NULL', 15, '', '', 'mac_addr', 'varchar', 'NULL', 12, '', '', 'authkey', 'varchar', 'NULL', 32, '', '', 'latitude', 'decimal', 'NULL', '', '', '', 'longitude', 'decimal', 'NULL', '', '', '', 'altitude', 'decimal', 'NULL', '', '', '', 'vlan_profile', 'varchar', 'NULL', $char_d, '', '', + 'performance_profile', 'varchar', 'NULL', $char_d, '', '', ], 'primary_key' => 'svcnum', 'unique' => [ [ 'mac_addr' ] ], @@ -1747,6 +1905,17 @@ sub tables_hashref { 'index' => [ [ 'pkgpart' ], [ 'optionname' ] ], }, + 'part_pkg_report_option' => { + 'columns' => [ + 'num', 'serial', '', '', '', '', + 'name', 'varchar', '', $char_d, '', '', + 'disabled', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'num', + 'unique' => [ [ 'name' ] ], + 'index' => [ [ 'disabled' ] ], + }, + 'rate' => { 'columns' => [ 'ratenum', 'serial', '', '', '', '', @@ -1857,10 +2026,12 @@ sub tables_hashref { 'payment_gateway' => { 'columns' => [ 'gatewaynum', 'serial', '', '', '', '', + 'gateway_namespace','varchar', 'NULL', $char_d, '', '', 'gateway_module', 'varchar', '', $char_d, '', '', 'gateway_username', 'varchar', 'NULL', $char_d, '', '', 'gateway_password', 'varchar', 'NULL', $char_d, '', '', 'gateway_action', 'varchar', 'NULL', $char_d, '', '', + 'gateway_callback_url', 'varchar', 'NULL', $char_d, '', '', 'disabled', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'gatewaynum', @@ -1912,6 +2083,7 @@ sub tables_hashref { 'columns' => [ 'categorynum', 'serial', '', '', '', '', 'categoryname', 'varchar', '', $char_d, '', '', + 'weight', 'int', 'NULL', '', '', '', 'disabled', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'categorynum', @@ -1988,7 +2160,7 @@ sub tables_hashref { # how it was rated internally... 'ratedetailnum', 'int', 'NULL', '', '', '', - 'rated_price', 'decimal', 'NULL', '10,2', '', '', + 'rated_price', 'decimal', 'NULL', '10,4', '', '', 'distance', 'decimal', 'NULL', '', '', '', 'islocal', 'int', 'NULL', '', '', '', # '', '', 0, '' instead? @@ -2017,14 +2189,45 @@ sub tables_hashref { #NULL, done (or something) 'freesiderewritestatus', 'varchar', 'NULL', 32, '', '', - 'cdrbatch', 'varchar', 'NULL', $char_d, '', '', + 'cdrbatch', 'varchar', 'NULL', 255, '', '', ], 'primary_key' => 'acctid', 'unique' => [], - 'index' => [ [ 'calldate' ], [ 'src' ], [ 'dst' ], [ 'charged_party' ], [ 'accountcode' ], [ 'freesidestatus' ], [ 'freesiderewritestatus' ], [ 'cdrbatch' ], ], + 'index' => [ [ 'calldate' ], + [ 'src' ], [ 'dst' ], [ 'dcontext' ], [ 'charged_party' ], + [ 'accountcode' ], [ 'carrierid' ], + [ 'freesidestatus' ], [ 'freesiderewritestatus' ], + [ 'cdrbatch' ], + ], + }, + + 'cdr_termination' => { + 'columns' => [ + 'cdrtermnum', 'bigserial', '', '', '', '', + 'acctid', 'bigint', '', '', '', '', + 'termpart', 'int', '', '', '', '',#future use see below + 'rated_price', 'decimal', 'NULL', '10,4', '', '', + 'status', 'varchar', 'NULL', 32, '', '', + ], + 'primary_key' => 'cdrtermnum', + 'unique' => [ [ 'acctid', 'termpart' ] ], + 'index' => [ [ 'acctid' ], [ 'status' ], ], }, + #to handle multiple termination/settlement passes... + # 'part_termination' => { + # 'columns' => [ + # 'termpart', 'int', '', '', '', '', + # 'termname', 'varchar', '', $char_d, '', '', + # 'cdr_column', 'varchar', '', $char_d, '', '', #maybe set it here instead of in the price plan? + # ], + # 'primary_key' => 'termpart', + # 'unique' => [], + # 'index' => [], + # }, + + #the remaining cdr_ tables are not really used 'cdr_calltype' => { 'columns' => [ 'calltypenum', 'serial', '', '', '', '', @@ -2055,18 +2258,6 @@ sub tables_hashref { 'index' => [], }, - #map upstream rateid to ours... - 'cdr_upstream_rate' => { - 'columns' => [ - 'upstreamratenum', 'serial', '', '', '', '', - 'upstream_rateid', 'varchar', '', $char_d, '', '', - 'ratedetailnum', 'int', 'NULL', '', '', '', - ], - 'primary_key' => 'upstreamratenum', #XXX need a primary key - 'unique' => [ [ 'upstream_rateid' ] ], #unless we add another field, yeah - 'index' => [], - }, - #'cdr_file' => { # 'columns' => [ # 'filenum', 'serial', '', '', '', '', @@ -2189,6 +2380,29 @@ sub tables_hashref { 'index' => [ [ 'countrycode', 'phonenum' ] ], }, + 'phone_device' => { + 'columns' => [ + 'devicenum', 'serial', '', '', '', '', + 'devicepart', 'int', '', '', '', '', + 'svcnum', 'int', '', '', '', '', + 'mac_addr', 'varchar', 'NULL', 12, '', '', + ], + 'primary_key' => 'devicenum', + 'unique' => [ [ 'mac_addr' ], ], + 'index' => [ [ 'devicepart' ], [ 'svcnum' ], ], + }, + + 'part_device' => { + 'columns' => [ + 'devicepart', 'serial', '', '', '', '', + 'devicename', 'varchar', '', $char_d, '', '', + #'classnum', #tie to an inventory class? + ], + 'primary_key' => 'devicepart', + 'unique' => [ [ 'devicename' ] ], #? + 'index' => [], + }, + 'phone_avail' => { 'columns' => [ 'availnum', 'serial', '', '', '', '', diff --git a/FS/FS/Setup.pm b/FS/FS/Setup.pm index cba3c7e..edfe912 100644 --- a/FS/FS/Setup.pm +++ b/FS/FS/Setup.pm @@ -364,7 +364,7 @@ sub populate_access { use FS::AccessRight; use FS::access_right; - foreach my $rightname ( FS::AccessRight->rights ) { + foreach my $rightname ( FS::AccessRight->default_superuser_rights ) { my $access_right = new FS::access_right { 'righttype' => 'FS::access_group', 'rightobjnum' => 1, #$supergroup->groupnum, diff --git a/FS/FS/TicketSystem/RT_External.pm b/FS/FS/TicketSystem/RT_External.pm index 3a9c7e8..8ccc937 100644 --- a/FS/FS/TicketSystem/RT_External.pm +++ b/FS/FS/TicketSystem/RT_External.pm @@ -156,14 +156,16 @@ sub _from_customer { } my $sql = " - FROM Tickets - JOIN Queues ON ( Tickets.Queue = Queues.id ) - JOIN Links ON ( Tickets.id = Links.LocalBase ) - JOIN Users ON ( Tickets.Owner = Users.id ) - $join - WHERE ( ". join(' OR ', map "Status = '$_'", $self->statuses ). " ) - AND Target = 'freeside://freeside/cust_main/$custnum' - $where + FROM Tickets + JOIN Queues ON ( Tickets.Queue = Queues.id ) + JOIN Users ON ( Tickets.Owner = Users.id ) + JOIN Links ON ( Tickets.id = Links.LocalBase + AND Links.Base LIKE '%/ticket/' || Tickets.id ) + $join + + WHERE ( ". join(' OR ', map "Status = '$_'", $self->statuses ). " ) + AND Target = 'freeside://freeside/cust_main/$custnum' + $where "; ( $sql, @param ); @@ -349,5 +351,10 @@ sub transaction_status { $self->_retrieve_single_value($sql); } +sub access_right { + warn "WARNING: no access rights available w/ external RT"; + 0; +} + 1; diff --git a/FS/FS/TicketSystem/RT_Internal.pm b/FS/FS/TicketSystem/RT_Internal.pm index d24a96c..033c746 100644 --- a/FS/FS/TicketSystem/RT_Internal.pm +++ b/FS/FS/TicketSystem/RT_Internal.pm @@ -1,13 +1,16 @@ package FS::TicketSystem::RT_Internal; use strict; -use vars qw( @ISA ); +use vars qw( @ISA $DEBUG ); use FS::UID qw(dbh); use FS::CGI qw(popurl); use FS::TicketSystem::RT_Libs; +use RT::CurrentUser; @ISA = qw( FS::TicketSystem::RT_Libs ); +$DEBUG = 0; + sub sql_num_customer_tickets { "( select count(*) from tickets join links on ( tickets.id = links.localbase ) @@ -25,5 +28,111 @@ sub baseurl { } } +#mapping/genericize?? +#ShowConfigTab ModifySelf +sub access_right { + my( $self, $session, $right ) = @_; + + #return '' unless $conf->config('ticket_system'); + return '' unless FS::Conf->new->config('ticket_system'); + + $self->_web_external_auth($session) + unless $session + && $session->{'CurrentUser'}; + + $session->{'CurrentUser'}->HasRight( Right => $right, + Object => $RT::System ); +} + +#shameless false laziness w/rt/html/autohandler to get logged into RT from afar +sub _web_external_auth { + my( $self, $session ) = @_; + + my $user = $FS::CurrentUser::CurrentUser->username; + + $session->{'CurrentUser'} = RT::CurrentUser->new(); + + warn "loading RT user for $user\n" + if $DEBUG; + + $session->{'CurrentUser'}->Load($user); + + if ( ! $session->{'CurrentUser'}->Id() ) { + + # Create users on-the-fly + + warn "can't load RT user for $user; auto-creating\n" + if $DEBUG; + + my $UserObj = RT::User->new( RT::CurrentUser->new('RT_System') ); + + my ( $val, $msg ) = $UserObj->Create( + %{ ref($RT::AutoCreate) ? $RT::AutoCreate : {} }, + Name => $user, + Gecos => $user, + ); + + if ($val) { + + # now get user specific information, to better create our user. + my $new_user_info + = RT::Interface::Web::WebExternalAutoInfo($user); + + # set the attributes that have been defined. + # FIXME: this is a horrible kludge. I'm sure there's something cleaner + foreach my $attribute ( + 'Name', 'Comments', + 'Signature', 'EmailAddress', + 'PagerEmailAddress', 'FreeformContactInfo', + 'Organization', 'Disabled', + 'Privileged', 'RealName', + 'NickName', 'Lang', + 'EmailEncoding', 'WebEncoding', + 'ExternalContactInfoId', 'ContactInfoSystem', + 'ExternalAuthId', 'Gecos', + 'HomePhone', 'WorkPhone', + 'MobilePhone', 'PagerPhone', + 'Address1', 'Address2', + 'City', 'State', + 'Zip', 'Country' + ) + { + #uhh, wrong root + #$m->comp( '/Elements/Callback', %ARGS, + # _CallbackName => 'NewUser' ); + + my $method = "Set$attribute"; + $UserObj->$method( $new_user_info->{$attribute} ) + if ( defined $new_user_info->{$attribute} ); + } + $session->{'CurrentUser'}->Load($user); + } + else { + + # we failed to successfully create the user. abort abort abort. + delete $session->{'CurrentUser'}; + + die "can't auto-create RT user"; #an error message would be nice :/ + #$m->abort() unless $RT::WebFallbackToInternalAuth; + #$m->comp( '/Elements/Login', %ARGS, + # Error => loc( 'Cannot create user: [_1]', $msg ) ); + } + } + + unless ( $session->{'CurrentUser'}->Id() ) { + delete $session->{'CurrentUser'}; + + die "can't auto-create RT user"; + #$user = $orig_user; + # + #if ($RT::WebExternalOnly) { + # $m->comp( '/Elements/Login', %ARGS, + # Error => loc('You are not an authorized user') ); + # $m->abort(); + #} + } + +} + 1; diff --git a/FS/FS/Tron.pm b/FS/FS/Tron.pm index 26ab639..78af0fe 100644 --- a/FS/FS/Tron.pm +++ b/FS/FS/Tron.pm @@ -9,34 +9,56 @@ use FS::Record qw( qsearchs ); use FS::svc_external; use FS::cust_svc_option; -our @EXPORT_OK = qw( tron_scan tron_lint); +our @EXPORT_OK = qw( tron_ping tron_scan tron_lint); our %desired = ( - #lenient for now, so we can fix up important stuff + #less lenient, we need to make sure we upgrade deb 4 & pg 7.4 'freeside_version' => qr/^1\.(7\.3|9\.0)/, - 'debian_version' => qr/^4/, + 'debian_version' => qr/^5/, #qr/^5.0.[2-9]$/ #qr/^4/, 'apache_mpm' => qw/^(Prefork|$)/, + 'pg_version' => qr/^8\.[1-9]/, + 'apache_version' => qr/^2/, #payment gateway survey # 'payment_gateway' => qw/^authorizenet$/, #stuff to add/replace later - #'pg_version' => qr/^8\.[1-9]/, - #'apache_version' => qr/^2/, #'apache_mpm' => qw/^Prefork/, + #'pg_version' => qr/^8\.[3-9]/, ); -sub tron_scan { - my $cust_svc = shift; +sub _cust_svc_external { + my $cust_svc_or_svcnum = shift; - my $svc_external; - if ( ref($cust_svc) ) { + my ( $cust_svc, $svc_external ); + if ( ref($cust_svc_or_svcnum) ) { + $cust_svc = $cust_svc_or_svcnum; $svc_external = $cust_svc->svc_x; } else { - $svc_external = qsearchs('svc_external', { 'svcnum' => $cust_svc } ); + $svc_external = qsearchs('svc_external', { svcnum=>$cust_svc_or_svcnum } ); $cust_svc = $svc_external->cust_svc; } + ( $cust_svc, $svc_external ); + +} + +sub tron_ping { + my( $cust_svc, $svc_external ) = _cust_svc_external(shift); + + my %hash = (); + my $machine = $svc_external->title; # or better as a cust_svc_option?? + sshopen2($machine, *READER, *WRITER, '/bin/echo pong'); + my $pong = scalar(<READER>); + close READER; + close WRITER; + + $pong =~ /pong/; +} + +sub tron_scan { + my( $cust_svc, $svc_external ) = _cust_svc_external(shift); + #don't scan again if things are okay my $bad = 0; foreach my $option ( keys %desired ) { @@ -48,7 +70,9 @@ sub tron_scan { #do the scan my %hash = (); my $machine = $svc_external->title; # or better as a cust_svc_option?? - sshopen2($machine, *READER, *WRITER, '/usr/local/bin/freeside-yori all'); + #sshopen2($machine, *READER, *WRITER, '/usr/local/bin/freeside-yori all'); + #fix freeside users' patch if necessary, since packages put this in /usr/bin + sshopen2($machine, *READER, *WRITER, 'freeside-yori all'); while (<READER>) { chomp; my($option, $value) = split(/: ?/); diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm index 3c52ca5..148085c 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -338,6 +338,8 @@ sub cust_sql_fields { grep { my $field = $_; grep { $_ eq $field } @cust_fields } ( @add_fields, ( map "ship_$_", @add_fields ), 'payby' ); + push @fields, 'agent_custid'; + my @extra_fields = (); if (grep { $_ eq 'current_balance' } @cust_fields) { push @extra_fields, FS::cust_main->balance_sql . " AS current_balance"; @@ -585,7 +587,9 @@ sub job_status { my @return; if ( $job && $job->status ne 'failed' ) { - @return = ( 'progress', $job->statustext ); + my ($progress, $action) = split ',', $job->statustext, 2; + $action ||= 'Server processing job'; + @return = ( 'progress', $progress, $action ); } elsif ( !$job ) { #handle job gone case : job successful # so close popup, redirect parent window... @return = ( 'complete' ); @@ -593,6 +597,7 @@ sub job_status { @return = ( 'error', $job ? $job->statustext : $jobnum ); } + #to_json(\@return); #waiting on deb 5.0 for new JSON.pm? objToJson(\@return); } diff --git a/FS/FS/UI/bytecount.pm b/FS/FS/UI/bytecount.pm index 0891e6d..7e78bf5 100644 --- a/FS/FS/UI/bytecount.pm +++ b/FS/FS/UI/bytecount.pm @@ -1,10 +1,15 @@ package FS::UI::bytecount; use strict; -use vars qw($DEBUG $me); +use vars qw($DEBUG $me @ISA @EXPORT_OK); +use Exporter; use FS::Conf; use Number::Format 1.50; +@ISA = qw( Exporter ); + +@EXPORT_OK = qw( bytecount_unexact parse_bytecount display_bytecount ); + $DEBUG = 0; $me = '[FS::UID::bytecount]'; @@ -32,9 +37,9 @@ sub bytecount_unexact { return("$bc bytes") if ($bc < 1000); return(sprintf("%.2f Kbytes", $bc/1024)) - if ($bc < 1000000); + if ($bc < 1048576); return(sprintf("%.2f Mbytes", $bc/1048576)) - if ($bc < 1000000000); + if ($bc < 1073741824); return(sprintf("%.2f Gbytes", $bc/1073741824)); } diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index 40d29c1..e3a4604 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -2,9 +2,9 @@ package FS::UID; use strict; use vars qw( - @ISA @EXPORT_OK $DEBUG $me $cgi $dbh $freeside_uid $user - $conf_dir $cache_dir $secrets $datasrc $db_user $db_pass %callback @callback - $driver_name $AutoCommit $callback_hack $use_confcompat + @ISA @EXPORT_OK $DEBUG $me $cgi $freeside_uid $user $conf_dir $cache_dir + $secrets $datasrc $db_user $db_pass $schema $dbh $driver_name + $AutoCommit %callback @callback $callback_hack $use_confcompat ); use subs qw( getsecrets cgisetotaker @@ -150,12 +150,24 @@ sub forksuidsetup { } sub myconnect { - DBI->connect( getsecrets(@_), { 'AutoCommit' => 0, - 'ChopBlanks' => 1, - 'ShowErrorStatement' => 1, - } - ) + my $handle = DBI->connect( getsecrets(@_), { 'AutoCommit' => 0, + 'ChopBlanks' => 1, + 'ShowErrorStatement' => 1, + } + ) or die "DBI->connect error: $DBI::errstr\n"; + + if ( $schema ) { + use DBIx::DBSchema::_util qw(_load_driver ); #quelle hack + my $driver = _load_driver($handle); + if ( $driver =~ /^Pg/ ) { + no warnings 'redefine'; + eval "sub DBIx::DBSchema::DBD::${driver}::default_db_schema {'$schema'}"; + die $@ if $@; + } + } + + $handle; } =item install_callback @@ -325,10 +337,11 @@ sub getsecrets { $secrets = 'secrets'; } - ($datasrc, $db_user, $db_pass) = + ($datasrc, $db_user, $db_pass, $schema) = map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/$secrets") or die "Can't get secrets: $conf_dir/$secrets: $!\n"; undef $driver_name; + ($datasrc, $db_user, $db_pass); } diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm index 97f24d4..e5cd5d3 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -91,6 +91,9 @@ sub upgrade_data { tie my %hash, 'Tie::IxHash', + #cust_main (remove paycvv from history) + 'cust_main' => [], + #msgcat 'msgcat' => [], @@ -126,6 +129,15 @@ sub upgrade_data { #fixup access rights 'access_right' => [], + #change tax_rate column types + 'tax_rate' => [], + + #change recur_flat and enable_prorate + 'part_pkg_option' => [], + + #add weights to pkg_category + 'pkg_category' => [], + ; \%hash; diff --git a/FS/FS/access_right.pm b/FS/FS/access_right.pm index 4f8d1e9..bc6dd5d 100644 --- a/FS/FS/access_right.pm +++ b/FS/FS/access_right.pm @@ -153,8 +153,6 @@ sub _upgrade_data { # class method =head1 BUGS -The author forgot to customize this manpage. - =head1 SEE ALSO L<FS::Record>, schema.html from the base documentation. diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm index cf56fd8..8cc8b64 100644 --- a/FS/FS/access_user.pm +++ b/FS/FS/access_user.pm @@ -1,7 +1,7 @@ package FS::access_user; use strict; -use vars qw( @ISA $DEBUG $me $htpasswd_file ); +use vars qw( @ISA $DEBUG $me $conf $htpasswd_file ); use FS::UID; use FS::Conf; use FS::Record qw( qsearch qsearchs dbh ); @@ -19,7 +19,7 @@ $me = '[FS::access_user]'; #kludge htpasswd for now (i hope this bootstraps okay) FS::UID->install_callback( sub { - my $conf = new FS::Conf; + $conf = new FS::Conf; $htpasswd_file = $conf->base_dir. '/htpasswd'; } ); @@ -44,8 +44,8 @@ FS::access_user - Object methods for access_user records =head1 DESCRIPTION -An FS::access_user object represents an internal access user. FS::access_user inherits from -FS::Record. The following fields are currently supported: +An FS::access_user object represents an internal access user. FS::access_user +inherits from FS::Record. The following fields are currently supported: =over 4 @@ -274,6 +274,9 @@ sub name { =item access_usergroup +Returns links to the the groups this user is a part of, as FS::access_usergroup +objects (see L<FS::access_usergroup>). + =cut sub access_usergroup { @@ -467,6 +470,23 @@ sub access_right { } +=item default_customer_view + +Returns the default customer view for this user, from the +"default_customer_view" user preference, the "cust_main-default_view" config, +or the hardcoded default, "jumbo" (may change to "basics" in the near future). + +=cut + +sub default_customer_view { + my $self = shift; + + $self->option('default_customer_view') + || $conf->config('cust_main-default_view') + || 'jumbo'; #'basics' in 1.9.1? + +} + =back =head1 BUGS diff --git a/FS/FS/access_usergroup.pm b/FS/FS/access_usergroup.pm index 8e83060..8511fe5 100644 --- a/FS/FS/access_usergroup.pm +++ b/FS/FS/access_usergroup.pm @@ -133,8 +133,6 @@ sub access_group { =head1 BUGS -The author forgot to customize this manpage. - =head1 SEE ALSO L<FS::Record>, schema.html from the base documentation. diff --git a/FS/FS/agent.pm b/FS/FS/agent.pm index ff0a2b1..28d191a 100644 --- a/FS/FS/agent.pm +++ b/FS/FS/agent.pm @@ -3,12 +3,14 @@ package FS::agent; use strict; use vars qw( @ISA ); #use Crypt::YAPassGen; +use Business::CreditCard 0.28; use FS::Record qw( dbh qsearch qsearchs ); use FS::cust_main; use FS::cust_pkg; use FS::agent_type; use FS::reg_code; use FS::TicketSystem; +use FS::Conf; @ISA = qw( FS::m2m_Common FS::Record ); @@ -200,6 +202,119 @@ sub ticketing_queue { FS::TicketSystem->queue($self->ticketing_queueid); }; +=item payment_gateway [ OPTION => VALUE, ... ] + +Returns a payment gateway object (see L<FS::payment_gateway>) for this agent. + +Currently available options are I<nofatal>, I<invnum>, I<method>, and I<payinfo>. + +If I<nofatal> is set, and no gateway is available, then the empty string +will be returned instead of throwing a fatal exception. + +If I<invnum> is set to the number of an invoice (see L<FS::cust_bill>) then +an attempt will be made to select a gateway suited for the taxes paid on +the invoice. + +The I<method> and I<payinfo> options can be used to influence the choice +as well. Presently only 'CC' and 'ECHECK' methods are meaningful. + +When the I<method> is 'CC' then the card number in I<payinfo> can direct +this routine to route to a gateway suited for that type of card. + +=cut + +sub payment_gateway { + my ( $self, %options ) = @_; + + my $taxclass = ''; + if ( $options{invnum} ) { + + my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{invnum} } ); + die "invnum ". $options{'invnum'}. " not found" unless $cust_bill; + + my @part_pkg = + map { $_->part_pkg } + grep { $_ } + map { $_->cust_pkg } + $cust_bill->cust_bill_pkg; + + my @taxclasses = map $_->taxclass, @part_pkg; + + $taxclass = $taxclasses[0] + unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are + #different taxclasses + } + + #look for an agent gateway override first + my $cardtype; + if ( $options{method} && $options{method} eq 'CC' ) { + $cardtype = cardtype($options{payinfo}); + } elsif ( $options{method} && $options{method} eq 'ECHECK' ) { + $cardtype = 'ACH'; + } else { + $cardtype = $options{method} || ''; + } + + my $override = + qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, + cardtype => $cardtype, + taxclass => $taxclass, } ) + || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, + cardtype => '', + taxclass => $taxclass, } ) + || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, + cardtype => $cardtype, + taxclass => '', } ) + || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, + cardtype => '', + taxclass => '', } ); + + my $payment_gateway = new FS::payment_gateway; + if ( $override ) { #use a payment gateway override + + $payment_gateway = $override->payment_gateway; + + } else { #use the standard settings from the config + # the standard settings from the config could be moved to a null agent + # agent_payment_gateway referenced payment_gateway + + my $conf = new FS::Conf; + unless ( $conf->exists('business-onlinepayment') ) { + if ( $options{'nofatal'} ) { + return ''; + } else { + die "Real-time processing not enabled\n"; + } + } + + #load up config + my $bop_config = 'business-onlinepayment'; + $bop_config .= '-ach' + if ( $options{method} + && $options{method} =~ /^(ECHECK|CHEK)$/ + && $conf->exists($bop_config. '-ach') + ); + my ( $processor, $login, $password, $action, @bop_options ) = + $conf->config($bop_config); + $action ||= 'normal authorization'; + pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/; + die "No real-time processor is enabled - ". + "did you set the business-onlinepayment configuration value?\n" + unless $processor; + + $payment_gateway->gateway_namespace( $conf->config('business-onlinepayment-namespace') || + 'Business::OnlinePayment'); + $payment_gateway->gateway_module($processor); + $payment_gateway->gateway_username($login); + $payment_gateway->gateway_password($password); + $payment_gateway->gateway_action($action); + $payment_gateway->set('options', [ @bop_options ]); + + } + + $payment_gateway; +} + =item num_prospect_cust_main Returns the number of prospects (customers with no packages ever ordered) for diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm index 67c5c1c..d9c602f 100644 --- a/FS/FS/cdr.pm +++ b/FS/FS/cdr.pm @@ -13,7 +13,6 @@ use FS::Record qw( qsearch qsearchs ); use FS::cdr_type; use FS::cdr_calltype; use FS::cdr_carrier; -use FS::cdr_upstream_rate; @ISA = qw(FS::Record); @EXPORT_OK = qw( _cdr_date_parser_maker _cdr_min_parser_maker ); @@ -153,6 +152,54 @@ points to. You can ask the object for a copy with the I<hash> method. sub table { 'cdr'; } +sub table_info { + { + 'fields' => { +#XXX fill in some (more) nice names + #'acctid' => '', + 'calldate' => 'Call date', + 'clid' => 'Caller ID', + 'src' => 'Source', + 'dst' => 'Destination', + 'dcontext' => 'Dest. context', + 'channel' => 'Channel', + 'dstchannel' => 'Destination channel', + #'lastapp' => '', + #'lastdata' => '', + 'startdate' => 'Start date', + 'answerdate' => 'Answer date', + 'enddate' => 'End date', + 'duration' => 'Duration', + 'billsec' => 'Billable seconds', + 'disposition' => 'Disposition', + 'amaflags' => 'AMA flags', + 'accountcode' => 'Account code', + #'uniqueid' => '', + 'userfield' => 'User field', + #'cdrtypenum' => '', + 'charged_party' => 'Charged party', + #'upstream_currency' => '', + 'upstream_price' => 'Upstream price', + #'upstream_rateplanid' => '', + #'ratedetailnum' => '', + 'rated_price' => 'Rated price', + #'distance' => '', + #'islocal' => '', + #'calltypenum' => '', + #'description' => '', + #'quantity' => '', + 'carrierid' => 'Carrier ID', + #'upstream_rateid' => '', + 'svcnum' => 'Freeside service', + 'freesidestatus' => 'Freeside status', + 'freesiderewritestatus' => 'Freeside rewrite status', + 'cdrbatch' => 'Batch', + }, + + }; + +} + =item insert Adds this record to the database. If there is an error, returns the error, @@ -269,6 +316,17 @@ sub check { $self->SUPER::check; } +=item is_tollfree + + Returns true when the cdr represents a toll free number and false otherwise. + +=cut + +sub is_tollfree { + my $self = shift; + ( $self->dst =~ /^(\+?1)?8(8|([02-7])\3)/ ) ? 1 : 0; +} + =item set_charged_party If the charged_party field is already set, does nothing. Otherwise: @@ -284,17 +342,20 @@ or to the dst field if it is a toll free number. sub set_charged_party { my $self = shift; - unless ( $self->charged_party ) { + my $conf = new FS::Conf; - my $conf = new FS::Conf; + unless ( $self->charged_party ) { if ( $conf->exists('cdr-charged_party-accountcode') && $self->accountcode ){ - $self->charged_party( $self->accountcode ); + my $charged_party = $self->accountcode; + $charged_party =~ s/^0+// + if $conf->exists('cdr-charged_party-accountcode-trim_leading_0s'); + $self->charged_party( $charged_party ); } else { - if ( $self->dst =~ /^(\+?1)?8[02-8]{2}/ ) { + if ( $self->is_tollfree ) { $self->charged_party($self->dst); } else { $self->charged_party($self->src); @@ -304,9 +365,17 @@ sub set_charged_party { } +# my $prefix = $conf->config('cdr-charged_party-truncate_prefix'); +# my $prefix_len = length($prefix); +# my $trunc_len = $conf->config('cdr-charged_party-truncate_length'); +# +# $self->charged_party( substr($self->charged_party, 0, $trunc_len) ) +# if $prefix_len && $trunc_len +# && substr($self->charged_party, 0, $prefix_len) eq $prefix; + } -=item set_status_and_rated_price STATUS [ RATED_PRICE ] +=item set_status_and_rated_price STATUS [ RATED_PRICE [ SVCNUM ] ] Sets the status to the provided string. If there is an error, returns the error, otherwise returns false. @@ -314,9 +383,10 @@ error, otherwise returns false. =cut sub set_status_and_rated_price { - my($self, $status, $rated_price) = @_; + my($self, $status, $rated_price, $svcnum) = @_; $self->freesidestatus($status); $self->rated_price($rated_price); + $self->svcnum($svcnum) if $svcnum; $self->replace(); } @@ -402,51 +472,11 @@ sub calltypename { $cdr_calltype ? $cdr_calltype->calltypename : ''; } -=item cdr_upstream_rate - -Returns the upstream rate mapping (see L<FS::cdr_upstream_rate>), or the empty -string if no FS::cdr_upstream_rate object is associated with this CDR. - -=cut - -sub cdr_upstream_rate { - my $self = shift; - return '' unless $self->upstream_rateid; - qsearchs('cdr_upstream_rate', { 'upstream_rateid' => $self->upstream_rateid }) - or ''; -} - -=item _convergent_format COLUMN [ COUNTRYCODE ] - -Returns the number in COLUMN formatted as follows: - -If the country code does not match COUNTRYCODE (default "61"), it is returned -unchanged. - -If the country code does match COUNTRYCODE (default "61"), it is removed. In -addiiton, "0" is prepended unless the number starts with 13, 18 or 19. (???) - -=cut - -sub _convergent_format { - my( $self, $field ) = ( shift, shift ); - my $countrycode = scalar(@_) ? shift : '61'; #+61 = australia - #my $number = $self->$field(); - my $number = $self->get($field); - #if ( $number =~ s/^(\+|011)$countrycode// ) { - if ( $number =~ s/^\+$countrycode// ) { - $number = "0$number" - unless $number =~ /^1[389]/; #??? - } - $number; -} - =item downstream_csv [ OPTION => VALUE, ... ] =cut my %export_names = ( - 'convergent' => {}, 'simple' => { 'name' => 'Simple', 'invoice_header' => "Date,Time,Name,Destination,Duration,Price", @@ -464,30 +494,28 @@ my %export_names = ( 'name' => 'Default with source', 'invoice_header' => 'Caller,Date,Time,Number,Destination,Duration,Price', }, + 'accountcode_default' => { + 'name' => 'Default plus accountcode', + 'invoice_header' => 'Date,Time,Account,Number,Destination,Duration,Price', + }, ); +my $duration_sub = sub { + my($cdr, %opt) = @_; + if ( $opt{minutes} ) { + $opt{minutes}. ( $opt{granularity} ? 'm' : ' call' ); + } else { + sprintf('%.2fm', $cdr->billsec / 60 ); + } +}; + my %export_formats = ( - 'convergent' => [ - 'carriername', #CARRIER - sub { shift->_convergent_format('src') }, #SERVICE_NUMBER - sub { shift->_convergent_format('charged_party') }, #CHARGED_NUMBER - sub { time2str('%Y-%m-%d', shift->calldate_unix ) }, #DATE - sub { time2str('%T', shift->calldate_unix ) }, #TIME - 'billsec', #'duration', #DURATION - sub { shift->_convergent_format('dst') }, #NUMBER_DIALED - '', #XXX add (from prefixes in most recent email) #FROM_DESC - '', #XXX add (from prefixes in most recent email) #TO_DESC - 'calltypename', #CLASS_CODE - 'rated_price', #PRICE - sub { shift->rated_price ? 'Y' : 'N' }, #RATED - '', #OTHER_INFO - ], 'simple' => [ sub { time2str('%D', shift->calldate_unix ) }, #DATE sub { time2str('%r', shift->calldate_unix ) }, #TIME 'userfield', #USER 'dst', #NUMBER_DIALED - sub { sprintf('%.2fm', shift->billsec / 60 ) }, #DURATION + $duration_sub, #DURATION #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; }, #PRICE ], @@ -495,9 +523,9 @@ my %export_formats = ( sub { time2str('%D', shift->calldate_unix ) }, #DATE sub { time2str('%r', shift->calldate_unix ) }, #TIME #'userfield', #USER - 'dst', #NUMBER_DIALED 'src', #called from - sub { sprintf('%.2fm', shift->billsec / 60 ) }, #DURATION + 'dst', #NUMBER_DIALED + $duration_sub, #DURATION #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; }, #PRICE ], @@ -518,9 +546,7 @@ my %export_formats = ( sub { my($cdr, %opt) = @_; $opt{dst_regionname}; }, #DURATION - sub { my($cdr, %opt) = @_; - $opt{minutes}. ( $opt{granularity} ? 'm' : ' call' ); - }, + $duration_sub, #PRICE sub { my($cdr, %opt) = @_; $opt{money_char}. $opt{charge}; }, @@ -528,11 +554,16 @@ my %export_formats = ( ], ); $export_formats{'source_default'} = [ 'src', @{ $export_formats{'default'} }, ]; +$export_formats{'accountcode_default'} = + [ @{ $export_formats{'default'} }[0,1], + 'accountcode', + @{ $export_formats{'default'} }[2..5], + ]; sub downstream_csv { my( $self, %opt ) = @_; - my $format = $opt{'format'}; # 'convergent'; + my $format = $opt{'format'}; return "Unknown format $format" unless exists $export_formats{$format}; #my $conf = new FS::Conf; @@ -654,10 +685,11 @@ sub _cdr_min_parse { sub _cdr_date_parser_maker { my $field = shift; + my %options = @_; my @fields = ref($field) ? @$field : ($field); return sub { my( $cdr, $datestring ) = @_; - my $unixdate = eval { _cdr_date_parse($datestring) }; + my $unixdate = eval { _cdr_date_parse($datestring, %options) }; die "error parsing date for @fields from $datestring: $@\n" if $@; $cdr->$_($unixdate) foreach @fields; }; @@ -665,26 +697,40 @@ sub _cdr_date_parser_maker { sub _cdr_date_parse { my $date = shift; + my %options = @_; return '' unless length($date); #that's okay, it becomes NULL + return '' if $date eq 'NA'; #sansay + + if ( $date =~ /^([a-z]{3})\s+([a-z]{3})\s+(\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s+(\d{4})$/i && $7 > 1970 ) { + my $time = str2time($date); + return $time if $time > 100000; #just in case + } my($year, $mon, $day, $hour, $min, $sec); #$date =~ /^\s*(\d{4})[\-\/]\(\d{1,2})[\-\/](\d{1,2})\s+(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/ #taqua #2007-10-31 08:57:24.113000000 - if ( $date =~ /^\s*(\d{4})\D(\d{1,2})\D(\d{1,2})\s+(\d{1,2})\D(\d{1,2})\D(\d{1,2})(\D|$)/ ) { + if ( $date =~ /^\s*(\d{4})\D(\d{1,2})\D(\d{1,2})\D+(\d{1,2})\D(\d{1,2})\D(\d{1,2})(\D|$)/ ) { ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 ); } elsif ( $date =~ /^\s*(\d{1,2})\D(\d{1,2})\D(\d{4})\s+(\d{1,2})\D(\d{1,2})\D(\d{1,2})(\D|$)/ ) { ($mon, $day, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 ); + } elsif ( $date =~ /^\s*(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d+\.\d+)(\D|$)/ ) { + # broadsoft: 20081223201938.314 + ($year, $mon, $day, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6); } else { die "unparsable date: $date"; #maybe we shouldn't die... } - return '' if $year == 1900 && $mon == 1 && $day == 1 - && $hour == 0 && $min == 0 && $sec == 0; + return '' if ( $year == 1900 || $year == 1970 ) && $mon == 1 && $day == 1 + && $hour == 0 && $min == 0 && $sec == 0; - timelocal($sec, $min, $hour, $day, $mon-1, $year); + if ($options{gmt}) { + timegm($sec, $min, $hour, $day, $mon-1, $year); + } else { + timelocal($sec, $min, $hour, $day, $mon-1, $year); + } } =item batch_import HASHREF diff --git a/FS/FS/cdr/broadsoft.pm b/FS/FS/cdr/broadsoft.pm new file mode 100644 index 0000000..423e96f --- /dev/null +++ b/FS/FS/cdr/broadsoft.pm @@ -0,0 +1,108 @@ +package FS::cdr::broadsoft; + +use strict; +use base qw( FS::cdr ); +use vars qw( %info ); +use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker ); + +%info = ( + 'name' => 'Broadsoft', + 'weight' => 500, + 'header' => 1, #0 default, set to 1 to ignore the first line, or + # to higher numbers to ignore that number of lines + 'type' => 'csv', #csv (default), fixedlength or xls + 'sep_char' => ',', #for csv, defaults to , + 'disabled' => 0, #0 default, set to 1 to disable + + #listref of what to do with each field from the CDR, in order + 'import_fields' => [ + + skip(2), + sub { my($cdr, $data, $conf, $param) = @_; + $param->{skiprow} = 1 if lc($data) ne 'normal'; + '' }, # 3: type + + trim('accountcode'), # 4: userNumber + skip(2), + trim('src'), # 7: callingNumber + skip(1), + trim('dst'), # 9: calledNumber + + _cdr_date_parser_maker('startdate'), # 10: startTime + skip(1), + sub { my($cdr, $data) = @_; + $cdr->disposition( + lc($data) eq 'yes' ? + 'ANSWERED' : 'NO ANSWER') }, # 12: answerIndicator + _cdr_date_parser_maker('answerdate'), # 13: answerTime + _cdr_date_parser_maker('enddate'), # 14: releaseTime + + ], + +); + +sub trim { + my $fieldname = shift; + return sub { + my($cdr, $data) = @_; + $data =~ s/^\+1//; + $cdr->$fieldname($data); + '' + } +} + +sub skip { + map { undef } (1..$_[0]); +} + +1; + +__END__ + +list of freeside CDR fields, useful ones marked with * + + acctid - primary key + *[1] calldate - Call timestamp (SQL timestamp) + clid - Caller*ID with text +7 * src - Caller*ID number / Source number +9 * dst - Destination extension + dcontext - Destination context + channel - Channel used + dstchannel - Destination channel if appropriate + lastapp - Last application if appropriate + lastdata - Last application data +10 * startdate - Start of call (UNIX-style integer timestamp) +13 answerdate - Answer time of call (UNIX-style integer timestamp) +14 * enddate - End time of call (UNIX-style integer timestamp) + * duration - Total time in system, in seconds + * billsec - Total time call is up, in seconds +12 *[2] disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY + amaflags - What flags to use: BILL, IGNORE etc, specified on a per + channel basis like accountcode. +4 *[3] accountcode - CDR account number to use: account + uniqueid - Unique channel identifier + userfield - CDR user-defined field + cdr_type - CDR type - see FS::cdr_type (Usage = 1, S&E = 7, OC&C = 8) + *[4] charged_party - Service number to be billed + upstream_currency - Wholesale currency from upstream + *[5] upstream_price - Wholesale price from upstream + upstream_rateplanid - Upstream rate plan ID + rated_price - Rated (or re-rated) price + distance - km (need units field?) + islocal - Local - 1, Non Local = 0 + *[6] calltypenum - Type of call - see FS::cdr_calltype + description - Description (cdr_type 7&8 only) (used for + cust_bill_pkg.itemdesc) + quantity - Number of items (cdr_type 7&8 only) + carrierid - Upstream Carrier ID (see FS::cdr_carrier) + upstream_rateid - Upstream Rate ID + svcnum - Link to customer service (see FS::cust_svc) + freesidestatus - NULL, done (or something) + +[1] Auto-populated from startdate if not present +[2] Package options available to ignore calls without a specific disposition +[3] When using 'cdr-charged_party-accountcode' config +[4] Auto-populated from src (normal calls) or dst (toll free calls) if not present +[5] When using 'upstream_simple' rating method. +[6] Set to usage class classnum when using pre-rated CDRs and usage class-based + taxation (local/intrastate/interstate/international) diff --git a/FS/FS/cdr/netcentrex.pm b/FS/FS/cdr/netcentrex.pm index 7ccc3df..a434d5d 100644 --- a/FS/FS/cdr/netcentrex.pm +++ b/FS/FS/cdr/netcentrex.pm @@ -28,9 +28,12 @@ use FS::cdr qw(_cdr_date_parser_maker); '', #04 Leg number (all 0) _cdr_date_parser_maker('startdate'), #05 Authorize timestamp _cdr_date_parser_maker('answerdate'), #06 Start timestamp - 'billsec', #'duration', #07 Duration - _e164_parser_maker('src'), #08 Caller - _e164_parser_maker('dst'), #09 Callee + sub { my( $cdr, $duration ) = @_; #07 Duration + $cdr->duration($duration); + $cdr->billsec( $duration); + }, + _e164_parser_maker('src', 'charged_party'), #08 Caller + _e164_parser_maker('dcontext', 'dst', 'norewrite_pivotonly'=>1) ,#09 Callee 'channel', #10 Source IP 'dstchannel', #11 Destination IP 'userfield', #12 selector Tag @@ -80,43 +83,40 @@ use FS::cdr qw(_cdr_date_parser_maker); ); sub _e164_parser_maker { - my $field = shift; + my( $field, $pivot_field, %opt ) = @_; return sub { my( $cdr, $e164 ) = @_; - eval { $cdr->$field( _e164_parse($e164) ); }; - die "error parsing e164 for $field from $e164: $@\n" if $@; + my( $pivot, $number ) = _e164_parse($e164); + if ( $opt{'norewrite_pivotonly'} && ! $pivot ) { + $cdr->$pivot_field( $number ); + } else { + $cdr->$field( $number ); + $cdr->$pivot_field( $pivot ); + } }; } -my %e164_types = ( - '000000' => '', - '100005' => '', - '100009' => '', - '100012' => '', - '100014' => '', - '100015' => '', - '100016' => '', - '300000' => '', -); - sub _e164_parse { my $e164 = shift; $e164 =~ s/^e164://; - my ($type, $number); + my ($pivot, $number); if ( $e164 =~ /^O(\d+)$/ ) { - $type = ''; #? + $pivot = ''; #? $number = $1; - } elsif ( $e164 =~ /^(\d{6})(\d+)$/ ) { - $type = $1; + } elsif ( $e164 =~ /^000000(\d+)$/ ) { + $pivot = ''; + $number = $1; + } elsif ( $e164 =~ /^(1\d{5})(\d+)$/ ) { + $pivot = $1; $number = $2; } else { - $type = ''; + $pivot = ''; $number = $e164; #unparsable... } - #$type...? - $number; + + ( $pivot, $number ); } 1; diff --git a/FS/FS/cdr/sansay.pm b/FS/FS/cdr/sansay.pm new file mode 100644 index 0000000..44accdc --- /dev/null +++ b/FS/FS/cdr/sansay.pm @@ -0,0 +1,408 @@ +package FS::cdr::sansay; + +use strict; +use base qw( FS::cdr ); +use vars qw( %info ); +use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker ); + +%info = ( + 'name' => 'Sansay VSX', + 'weight' => 135, + 'header' => 1, #0 default, set to 1 to ignore the first line, or + # to higher numbers to ignore that number of lines + 'type' => 'csv', #csv (default), fixedlength or xls + 'sep_char' => ';', #for csv, defaults to , + 'disabled' => 0, #0 default, set to 1 to disable + + + #listref of what to do with each field from the CDR, in order + 'import_fields' => [ + + # "Header" (I do not think this means what you think it means) + #002452502;V1.10;R; + + # Record Sequence Number 9 Unique identification of this record + 'uniqueid', + + '', #Version Number 5 Format version number of records to follow + # "V1.10" + '', #Record Type 1 Type of CDR being generated + # R Normal CDR record, A - Audit + + # "Body" + #WithMedia;181-1071459514@192.188.0.28;0001;Mon Dec 15 11:38:34 2003;Mon Dec 15 11:38:41 2003;Mon Dec 15 11:38:48 2003;480;EndedByRemoteUser;3;T;000200;H323;;192.188.0.38;9001;192.188.0.28;f0faff54-2e6c-11d8-8c4b-bd4d562c2265;192.188.0.38;18044;192.188.0.28;10756;G.729b;240;460;6066;14060;0;0;0;000200;H323;;192.188.0.28;8811;192.188.0.38;e83af3d3-1d2d-d811-9f98-003048424934;192.188.0.38;19236;192.188.0.28;10758;G.729b;460;240;14060;6066;0;0;0;F;9001;305;2;15;305000;00000011 44934567 45231267 2300BCC0;8587542200; + + '', #ConnectionType 16 Type of connection : Media or No Media + '', #SessionID 32 Unique ID assigned to the call by + # SSM subsystem + '', #XXX #Release Cause 4 2.4 Internal process Release Cause + + #Cause Code Descriptions + #01 Normal answered call + #02 No Answer, tear down by originator + #03 No answer, tear down by the termination + #04 NORMAL_NO_ANSWER, tear down by + # system + #402 Service Not Available + #403 Termination capability un-compatible + #404 Outbound digit translation failed + #405 Termination reject for some other reasons + #406 Termination Route is blocked + #500 Originator is not in the Authorized list + # (source verification failed) + #501 Origination digit translation failed + #502 Origination direction is not bi-directional or + # inbound + #503 Origination is not in service state + #600 Max system call handling reached + #601 System reject call + #602 System outbound digit translation error + # (maybe invalid configuration) + #603 System inbound digit translation error + # (Maybe invalid configuration) + + + #Start Time of Date 32 Indicates Time of Date when the call + # entered the system + _cdr_date_parser_maker('startddate'), + + #Answer Time of Date 32 Indicates TOD when the call was + # answered + _cdr_date_parser_maker('answerdate'), + + #Release TOD 32 Indicates the TOD when the call was + # disconnected + _cdr_date_parser_maker('enddate'), + + #Minutes West of 32 Minutes West of Greenwich Mean + #Greenwich Mean Time Time. Used to calculate the time + # zone. + '', #XXX use this + + #Release Cause from 32 Release cause string from either H323 + #Protocol Stack or SIP protocol stack + #4. Release Cause String (Field #8 in CDR) + #- a string of text further identifying the teardown circumstance from terminating protocol message. + '', + + #Binary Value of Release 4 Binary value of the protocol release + #Cause from Protocol cause + #stack + # + #3. Release Cause from Stack ( Field # 9 in CDR) + #- an integer value based on the releasing dialogues protocol. + # a. For a H.323 call leg originated release it will be the real Q.931 value received from the far + # side. + #Some of the Q.931 release causes; + #3: No route to destination + #16; Normal Clearing + #17: User Busy + #19: NO Answer from User + #21; Call Rejected + #28: Address Incomplete + #34: No Circuit Channel Available + #.... + # b. For a SIP call leg originated release, it's a RFC 3261 release cause value received from the + # far side. + #The following is the list that VSX generated if certain event happen: + #"400 Parse Failed" - Malformed Message + #"405 Method Not Allowed" - Unsupported Method + #"480 Temporarily Unavailable" - Overload Throttle Rejection, Max Sessions + #Exceeded, Demo License Expired, Capacity Exceeded on Route, Radius Server Timeout + #"415 No valid codec" - No valid codec could be supported between origination and + #term call legs. + #"481 Transaction Does Not Exist" - Unknown Transaction or Dialog + #"487 Transaction Terminated" - Origination Cancel + #"488 ReInvite Rejected" - Relay of ReInvite was Rejected + #"504 Server Time-out" - Internal VSX Failure + #"500 Sequence Out of Order" - CSeq counter violation + # c. For a VSX system originated release, it an internal release cause for teardown. + #If the VSX initiates a call teardown, the following cause values and strings are written into the CDR: + #999, "Demo Licence Expired!" + #999, "VSX Capacity Exceeded" + #999, "VSX Operator Reset" + #999, "Route Rejected" + #999, "Radius Rejected" + #999, "Radius Access Timeout" + #999, "Gatekeeper Reject" + #999, "Enum Server Reject" + #999, "Enum Server Timeout" + #999, "DNS Server Reject" + #999, "DNS/GK Timeout" + #999, "Could not allocate media" + #999, "No Response to INVITE" + #999, "Ring No Answer Timeout" + #999, "200 OK Timeout" + #999, "Maximum Duration Exceeded" + #987, "Termination Capacity Exceeded" + #987, "Origination Capacity Exceeded" + #987, "Term CPS Capacity Exceeded" + #987, "Orig CPS Capacity Exceeded" + #987, "Max H323 Legs Exceeded" + '', + + #1st release dialogue 1 O: origination, T: termination + #2. 1st Release Dialogue ( Field #10 in CDR) + #- one character value identifying the side of the call that i + # ,,O origination initiated the teardown. + # ,,T termination initiated the teardown. + # ,,N the VSX internally initiated the teardown. + '', + + #Trunk ID -- Origination 6 TrunkID for origination GW(resources) + 'accountcode', # right? # use cdr-charged_party-accountcode + + #VoIP Protocol - Origination 6 VoIP protocol for origination dialogue + '', + + #Origination Source Number 128 Source Number in Origination Dialogue + 'src', + + #Origination Source Host Name 128 FQDN or IP address for Source GW in Origination Dialogue + 'channel', + + #Origination Destination Number 128 Destination Number in Origination + #Dialogue + 'dst', + + #Origination Destination Host Name 128 FQDN or IP address for Destination + #GW in Origination Dialogue + 'dstchannel', + + #Origination Call ID 128 Unique ID for the origination dialogue(leg) + '', #'clid', #? that's not really the same call ID + + #Origination Remote 16 Remote Payload IP address for + # Payload IP origination dialogue + # Address + '', + + #Origination Remote 6 Remote Payload UDP address for + # Payload UDP origination dialogue + # Address + '', + + #Origination Local 16 Local(SG) Payload IP address for + # Payload IP origination dialogue + # Address + '', + + #Origination Local 6 Local(SG) Payload UDP address for + # Payload UDP origination dialogue + # Address + '', + + #Origination Codec List 128 Supported Codec list( separated by + # comma) for origination dialogue + '', + + #Origination Ingress 10 Number of Ingress( into Sansay + # Packets system) payload packets in + # origination dialogue + '', + + #Origination Egress 10 Number of Egress( out from Sansay + # Packets system) payload packets in + # origination dialogue + '', + + #Origination Ingress 10 Number of Ingress( into Sansay + # Octets system) payload octets in origination + # dialogue + '', + + #Origination Egress 10 Number of Egress( out from Sansay + # Octets system) payload octets in origination + # dialogue + '', + + #Origination Ingress 10 Number of Ingress( into Sansay + # Packet Loss system) payload packet loss in + # origination dialogue + '', + + #Origination Ingress 10 Average Ingress( into Sansay system) + # Delay payload packets delay ( in ms) in + # origination dialogue + '', + + #Origination Ingress 10 Average of Ingress( into Sansay + # Packet Jitter system) payload packet Jitter ( in ms) + # in origination dialogue + '', + + #Trunk ID -- Termination 6 Trunk ID for termination GW(resources) + 'carrierid', + + #VoIP Protocol - 6 VoIP protocol from termination GW + # Termination + '', + + #Termination Source 128 Source Number in Termination + # Number Dialogue + '', + + #Termination Source Host 128 FQDN or IP address for Source GW + # Name in Termination Dialogue + '', + + #Termination Destination 128 Destination Number in Termination + # Number Dialogue + '', + + #Termination Destination 128 FQDN or IP address for Destination + # Host Name GW in Termination Dialogue + '', + + #Termination Call ID 128 Unique ID for the termination + # dialogue(leg) + '', + + #Termination Remote 16 Remote Payload IP address for + # Payload IP termination dialogue + # Address + '', + + #Termination Remote 6 Remote Payload UDP address for + # Payload UDP termination dialogue + # Address + '', + + #Termination Local 16 Local(SG) Payload IP address for + # Payload IP termination dialogue + # Address + '', + + #Termination Local 6 Local(SG) Payload UDP address for + # Payload UDP termination dialogue + # Address + '', + + #Termination Codec List 128 Supported Codec list( separated by + # comma) for termination dialogue + '', + + #Termination Ingress 10 Number of Ingress( into Sansay + # Packets system) payload packets in + # termination dialogue + '', + + #Termination Egress 10 Number of Egress( out from Sansay + # Packets system) payload packets in + # termination dialogue + '', + + #Termination Ingress 10 Number of Ingress( into Sansay + # Octets system) payload octets in + # termination dialogue + '', + + #Termination Egress 10 Number of Egress( out from Sansay + # Octets system) payload octets in + # termination dialogue + '', + + #Termination Ingress 10 Number of Ingress( into Sansay + # Packet Loss system) payload packet loss in + # termination dialogue + '', + + #Termination Ingress 10 Average Ingress( into Sansay system) + # Delay payload packets delay ( in ms) in + # termination dialogue + '', + + #Termination Ingress 10 Average of Ingress( into Sansay + # Packet Jitter system) payload packet Jitter ( in ms) + # in termination dialogue + '', + + #Final Route Indication 1 F: Final Route Selection, + # I: Intermediate Route Attempts + '', + + #Routing Digits 64 Routing Digit (Digit after Inbound + # translation, before Outbound + # Translation). This may also be the + # LRN if LNP feature is enabled + '', + + #Call Duration in Second 6 Call Duration in Seconds. 0 if this is + # failed call + 'billsec', + + #Post Dial Delay in 6 Post dial delay (from call attempt to + # Seconds ring). 0 if this is failed call + '', + + #Ring Time in Second 6 Ring Time in Seconds. 0 if this is + # failed call + '', + + #Duration in milliseconds 10 Call duration in milliseconds. + '', + + #Conf ID 36 Unique Conference ID for this call in + # Cisco format + '', + + #RPID/ANI 32 Inbound Remote Party ID line or + # Proxy Asserted Identity if provided + 'clid', #? + + ], + +); + +1; + +__END__ + +list of freeside CDR fields, useful ones marked with * + +N/A acctid - primary key +FILLED_IN *[1] calldate - Call timestamp (SQL timestamp) +DONE clid - Caller*ID with text +DONE * src - Caller*ID number / Source number +DONE * dst - Destination extension + dcontext - Destination context +DONE channel - Channel used +DONE dstchannel - Destination channel if appropriate + lastapp - Last application if appropriate + lastdata - Last application data +DONE * startdate - Start of call (UNIX-style integer timestamp) +DONE answerdate - Answer time of call (UNIX-style integer timestamp) +DONE * enddate - End time of call (UNIX-style integer timestamp) +* duration - Total time in system, in seconds +DONE * billsec - Total time call is up, in seconds +*[2] disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY + amaflags - What flags to use: BILL, IGNORE etc, specified on a per + channel basis like accountcode. +DONE *[3] accountcode - CDR account number to use: account + uniqueid - Unique channel identifier + userfield - CDR user-defined field + cdr_type - CDR type - see FS::cdr_type (Usage = 1, S&E = 7, OC&C = 8) +FILLED_IN *[4] charged_party - Service number to be billed + upstream_currency - Wholesale currency from upstream +*[5] upstream_price - Wholesale price from upstream + upstream_rateplanid - Upstream rate plan ID + rated_price - Rated (or re-rated) price + distance - km (need units field?) + islocal - Local - 1, Non Local = 0 +*[6] calltypenum - Type of call - see FS::cdr_calltype + description - Description (cdr_type 7&8 only) (used for + cust_bill_pkg.itemdesc) + quantity - Number of items (cdr_type 7&8 only) +DONE carrierid - Upstream Carrier ID (see FS::cdr_carrier) + upstream_rateid - Upstream Rate ID + svcnum - Link to customer service (see FS::cust_svc) + freesidestatus - NULL, done (or something) + +[1] Auto-populated from startdate if not present +[2] Package options available to ignore calls without a specific disposition +[3] When using 'cdr-charged_party-accountcode' config +[4] Auto-populated from src (normal calls) or dst (toll free calls) if not present +[5] When using 'upstream_simple' rating method. +[6] Set to usage class classnum when using pre-rated CDRs and usage class-based + taxation (local/intrastate/interstate/international) + diff --git a/FS/FS/cdr/taqua.pm b/FS/FS/cdr/taqua.pm index 3052f83..26c0bda 100644 --- a/FS/FS/cdr/taqua.pm +++ b/FS/FS/cdr/taqua.pm @@ -13,7 +13,13 @@ use FS::cdr qw(_cdr_date_parser_maker); 'import_fields' => [ #some of these are kind arbitrary... #0 - 'cdrtypenum', #RecordType + #RecordType + sub { + my($cdr, $field, $conf, $hashref) = @_; + $hashref->{skiprow} = 1 unless ($field == 0 && $cdr->disposition == 100); + $cdr->cdrtypenum($field); + }, + sub { my($cdr, $field) = @_; }, #all10#RecordVersion sub { my($cdr, $field) = @_; }, #OrigShelfNumber sub { my($cdr, $field) = @_; }, #OrigCardNumber @@ -22,11 +28,20 @@ use FS::cdr qw(_cdr_date_parser_maker); 'uniqueid', #SequenceNumber 'accountcode', #SessionNumber 'src', #CallingPartyNumber - 'dst', #CalledPartyNumber + #'dst', #CalledPartyNumber + #CalledPartyNumber + sub { + my( $cdr, $field, $conf ) = @_; + if ( $cdr->calltypenum == 6 && $cdr->cdrtypenum == 0 ) { + $cdr->dst("+$field"); + } else { + $cdr->dst($field); + } + }, #10 - _cdr_date_parser_maker('startdate'), #CallArrivalTime - _cdr_date_parser_maker('enddate'), #CallCompletionTime + _cdr_date_parser_maker('startdate', 'gmt' => 1), #CallArrivalTime + _cdr_date_parser_maker('enddate', 'gmt' => 1), #CallCompletionTime #Disposition #sub { my($cdr, $d ) = @_; $cdr->disposition( $disposition{$d}): }, @@ -42,7 +57,7 @@ use FS::cdr qw(_cdr_date_parser_maker); # 201 => '', # 203 => '', - _cdr_date_parser_maker('answerdate'), #DispositionTime + _cdr_date_parser_maker('answerdate', 'gmt' => 1), #DispositionTime sub { my($cdr, $field) = @_; }, #TCAP sub { my($cdr, $field) = @_; }, #OutboundCarrierConnectTime sub { my($cdr, $field) = @_; }, #OutboundCarrierDisconnectTime @@ -79,7 +94,11 @@ use FS::cdr qw(_cdr_date_parser_maker); return; } } - $cdr->charged_party($field); + if ( $cdr->is_tollfree ) { # thankfully this is already available + $cdr->charged_party($cdr->dst); # and this + } else { + $cdr->charged_party($field); + } }, sub { my($cdr, $field) = @_; }, #SubscriberNumber diff --git a/FS/FS/cdr/transnexus.pm b/FS/FS/cdr/transnexus.pm new file mode 100644 index 0000000..0ed7ad4 --- /dev/null +++ b/FS/FS/cdr/transnexus.pm @@ -0,0 +1,66 @@ +package FS::cdr::transnexus; + +use strict; +use base qw( FS::cdr ); +use vars qw( %info ); +use MIME::Base64; +use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker ); + +%info = ( + 'name' => 'Transnexus', + 'weight' => 18, + 'type' => 'csv', + 'sep_char' => "\t", + + #listref of what to do with each field from the CDR, in order + 'import_fields' => [ + + _cdr_date_parser_maker('startddate'), #O_CallStartTime + 'src', #CallingNumberReported + 'dst', #CalledNumberReported + 'channel', #SourceDeviceName / O_ReportingDeviceName + 'dstchannel', #O_ReportingDeviceName / DestinationDeviceName + sub { $_[0]->clid( decode_base64($_[1]) ); }, #CallId + 'uniqueid', #TransactionId + 'duration', #RatedDuration + 'billsec', #O_BillingDuration + 'upstream_price', #O_BillingAmountCustCurr + ], +); + +1; + +__END__ + +O_CallStartTime - Date and time stamp of the call setup as reported in the CDR from the source device. + +CallingNumberReported - Calling number from the source device reported in authorization request to the OSPrey server. + +CalledNumberReported - Called number from the source device reported in authorization request to the OSPrey server. + +---- +1.1.1 Customer CDR Archive File + +SourceDeviceName - The IP address or Domain Name of the device which is the call source. + +O_ReportingDeviceName - IP address or Domain Name of the source (Originating) device reporting the CDR to the OSPrey Server. If a proxy is used, (such as SIP proxy for signaling or FreeRADIUS for CDR reporting) this field is the IP address of the proxy device, not the actual source device. + +--- +or 1.1.2 Provider CDR Archive File + +O_ReportingDeviceName - IP address or Domain Name of the source (Originating) device reporting the CDR to the OSPrey Server. If a proxy is used, (such as SIP proxy for signaling or FreeRADIUS for CDR reporting) this field is the IP address of the proxy device, not the actual source device. + +DestinationDeviceName - The IP address or Domain Name of the destination device. + +---- + +CallId - The Call Identifier generated by the source VoIP device. + +TransactionId - The unique Transaction Identification number created by the OSPrey server for each call + +RatedDuration - The rateable duration calculated by NexOSS. + +O_BillingDuration - The duration used to calculate the billable amount for a call from the source (Originating) network. This value is derived from RatedDuration and rounded up based on the ¿First Increment¿ or ¿Next Increment¿ rules defined in the Product or Customer Rate Plan used to rate the call. + +O_BillingAmountCustCurr - Amount billable to the source (Originating) Customer. Provided in the currency of the Product or Customer Rate Plan. + diff --git a/FS/FS/cdr/vitelity.pm b/FS/FS/cdr/vitelity.pm new file mode 100644 index 0000000..97ed0c3 --- /dev/null +++ b/FS/FS/cdr/vitelity.pm @@ -0,0 +1,25 @@ +package FS::cdr::vitelity; + +use strict; +use vars qw( @ISA %info ); +use FS::cdr qw(_cdr_date_parser_maker); + +@ISA = qw(FS::cdr); + +%info = ( + 'name' => 'Vitelity', + 'weight' => 100, + 'header' => 1, + 'import_fields' => [ + # Cheers to Vitelity for their concise, readable CDR format. + _cdr_date_parser_maker('startdate'), + 'src', + 'dst', + 'duration', + 'clid', + 'disposition', + 'upstream_price', + ], +); + +1; diff --git a/FS/FS/cdr_termination.pm b/FS/FS/cdr_termination.pm new file mode 100644 index 0000000..e0cde6e --- /dev/null +++ b/FS/FS/cdr_termination.pm @@ -0,0 +1,152 @@ +package FS::cdr_termination; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::cdr_termination - Object methods for cdr_termination records + +=head1 SYNOPSIS + + use FS::cdr_termination; + + $record = new FS::cdr_termination \%hash; + $record = new FS::cdr_termination { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cdr_termination object represents an CDR termination status. +FS::cdr_termination inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item cdrtermnum + +primary key + +=item acctid + +acctid + +=item termpart + +termpart + +=item rated_price + +rated_price + +=item status + +status + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'cdr_termination'; } + +=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 record. 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('cdrtermnum') + || $self->ut_foreign_key('acctid', 'cdr', 'acctid') + #|| $self->ut_foreign_key('termpart', 'part_termination', 'termpart') + || $self->ut_number('termpart') + || $self->ut_float('rated_price') + || $self->ut_enum('status', [ '', 'done' ] ) # , 'skipped' ] ) + ; + return $error if $error; + + $self->SUPER::check; +} + +#=item set_status_and_rated_price STATUS [ RATED_PRICE ] +# +#Sets the status to the provided string. If there is an error, returns the +#error, otherwise returns false. +# +#=cut +# +#sub set_status_and_rated_price { +# my($self, $status, $rated_price) = @_; +# $self->status($status); +# $self->rated_price($rated_price); +# $self->replace(); +#} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::cdr>, L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/clientapi_session_field.pm b/FS/FS/clientapi_session_field.pm index bfa487d..085e956 100644 --- a/FS/FS/clientapi_session_field.pm +++ b/FS/FS/clientapi_session_field.pm @@ -113,8 +113,6 @@ sub check { =head1 BUGS -The author forgot to customize this manpage. - =head1 SEE ALSO L<FS::clientapi_session>, L<FS::ClientAPI>, L<FS::Record>, schema.html from the diff --git a/FS/FS/cust_attachment.pm b/FS/FS/cust_attachment.pm new file mode 100644 index 0000000..9527381 --- /dev/null +++ b/FS/FS/cust_attachment.pm @@ -0,0 +1,170 @@ +package FS::cust_attachment; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); +use FS::Conf; + +=head1 NAME + +FS::cust_attachment - Object methods for cust_attachment records + +=head1 SYNOPSIS + + use FS::cust_attachment; + + $record = new FS::cust_attachment \%hash; + $record = new FS::cust_attachment { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_attachment object represents a file attached to a L<FS::cust_main> +object. FS::cust_attachment inherits from FS::Record. The following fields +are currently supported: + +=over 4 + +=item attachnum + +Primary key (assigned automatically). + +=item custnum + +Customer number (see L<FS::cust_main>). + +=item _date + +The date the record was last updated. + +=item otaker + +Order taker (assigned automatically; see L<FS::UID>). + +=item filename + +The file's name. + +=item mime_type + +The Content-Type of the file. + +=item body + +The contents of the file. + +=item disabled + +If the attachment was disabled, this contains the date it was disabled. + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new attachment object. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'cust_attachment'; } + +sub nohistory_fields { 'body'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item delete + +Delete this record from the database. + +=cut + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $conf = new FS::Conf; + my $error; + if($conf->config('disable_cust_attachment') ) { + $error = 'Attachments disabled (see configuration)'; + } + + $error = + $self->ut_numbern('attachnum') + || $self->ut_number('custnum') + || $self->ut_numbern('_date') + || $self->ut_text('otaker') + || $self->ut_text('filename') + || $self->ut_text('mime_type') + || $self->ut_numbern('disabled') + || $self->ut_anything('body') + ; + if($conf->config('max_attachment_size') + and $self->size > $conf->config('max_attachment_size') ) { + $error = 'Attachment too large' + } + return $error if $error; + + $self->SUPER::check; +} + +=item size + +Returns the size of the attachment in bytes. + +=cut + +sub size { + my $self = shift; + return length($self->body); +} + +=back + +=head1 BUGS + +Doesn't work on non-Postgres systems. + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 704b350..493bc09 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -16,6 +16,7 @@ use FS::Misc qw( send_email send_fax generate_ps generate_pdf do_print ); use FS::Record qw( qsearch qsearchs dbh ); use FS::cust_main_Mixin; use FS::cust_main; +use FS::cust_statement; use FS::cust_bill_pkg; use FS::cust_bill_pkg_display; use FS::cust_credit; @@ -82,6 +83,8 @@ owes you money. The specific charges are itemized as B<cust_bill_pkg> records (see L<FS::cust_bill_pkg>). FS::cust_bill inherits from FS::Record. The following fields are currently supported: +Regular fields + =over 4 =item invnum - primary key (assigned automatically for new invoices) @@ -93,10 +96,38 @@ L<Time::Local> and L<Date::Parse> for conversion functions. =item charged - amount of this invoice +=item invoice_terms - optional terms override for this specific invoice + +=back + +Customer info at invoice generation time + +=over 4 + +=item previous_balance + +=item billing_balance + +=back + +Deprecated + +=over 4 + =item printed - deprecated +=back + +Specific use cases + +=over 4 + =item closed - books closed flag, empty or `Y' +=item statementnum - invoice aggregation (see L<FS::cust_statement>) + +=item agent_invid - legacy invoice number + =back =head1 METHODS @@ -141,7 +172,50 @@ Really, don't use it. sub delete { my $self = shift; return "Can't delete closed invoice" if $self->closed =~ /^Y/i; - $self->SUPER::delete(@_); + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $table (qw( + cust_bill_event + cust_event + cust_credit_bill + cust_bill_pay + cust_bill_pay + cust_credit_bill + cust_pay_batch + cust_bill_pay_batch + cust_bill_pkg + )) { + + foreach my $linked ( $self->$table() ) { + my $error = $linked->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } + + my $error = $self->SUPER::delete(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + } =item replace OLD_RECORD @@ -183,17 +257,16 @@ sub check { my $error = $self->ut_numbern('invnum') - || $self->ut_number('custnum') + || $self->ut_foreign_key('custnum', 'cust_main', 'custnum' ) || $self->ut_numbern('_date') || $self->ut_money('charged') || $self->ut_numbern('printed') || $self->ut_enum('closed', [ '', 'Y' ]) + || $self->ut_foreign_keyn('statementnum', 'cust_statement', 'statementnum' ) + || $self->ut_numbern('agent_invid') #varchar? ; return $error if $error; - return "Unknown customer" - unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - $self->_date(time) unless $self->_date; $self->printed(0) if $self->printed eq ''; @@ -201,6 +274,22 @@ sub check { $self->SUPER::check; } +=item display_invnum + +Returns the displayed invoice number for this invoice: agent_invid if +cust_bill-default_agent_invid is set and it has a value, invnum otherwise. + +=cut + +sub display_invnum { + my $self = shift; + if ( $conf->exists('cust_bill-default_agent_invid') && $self->agent_invid ){ + return $self->agent_invid; + } else { + return $self->invnum; + } +} + =item previous Returns a list consisting of the total previous balance for this customer, @@ -235,6 +324,25 @@ sub cust_bill_pkg { ); } +=item cust_bill_pkg_pkgnum PKGNUM + +Returns the line items (see L<FS::cust_bill_pkg>) for this invoice and +specified pkgnum. + +=cut + +sub cust_bill_pkg_pkgnum { + my( $self, $pkgnum ) = @_; + qsearch( + { 'table' => 'cust_bill_pkg', + 'hashref' => { 'invnum' => $self->invnum, + 'pkgnum' => $pkgnum, + }, + 'order_by' => 'ORDER BY billpkgnum', + } + ); +} + =item cust_pkg Returns the packages (see L<FS::cust_pkg>) corresponding to the line items for @@ -407,6 +515,16 @@ sub cust_pay { #; } +sub cust_pay_batch { + my $self = shift; + qsearch('cust_pay_batch', { 'invnum' => $self->invnum } ); +} + +sub cust_bill_pay_batch { + my $self = shift; + qsearch('cust_bill_pay_batch', { 'invnum' => $self->invnum } ); +} + =item cust_bill_pay Returns all payment applications (see L<FS::cust_bill_pay>) for this invoice. @@ -415,23 +533,71 @@ Returns all payment applications (see L<FS::cust_bill_pay>) for this invoice. sub cust_bill_pay { my $self = shift; + map { $_ } #return $self->num_cust_bill_pay unless wantarray; sort { $a->_date <=> $b->_date } qsearch( 'cust_bill_pay', { 'invnum' => $self->invnum } ); } =item cust_credited +=item cust_credit_bill + Returns all applied credits (see L<FS::cust_credit_bill>) for this invoice. =cut sub cust_credited { my $self = shift; + map { $_ } #return $self->num_cust_credit_bill unless wantarray; sort { $a->_date <=> $b->_date } qsearch( 'cust_credit_bill', { 'invnum' => $self->invnum } ) ; } +sub cust_credit_bill { + shift->cust_credited(@_); +} + +=item cust_bill_pay_pkgnum PKGNUM + +Returns all payment applications (see L<FS::cust_bill_pay>) for this invoice +with matching pkgnum. + +=cut + +sub cust_bill_pay_pkgnum { + my( $self, $pkgnum ) = @_; + map { $_ } #return $self->num_cust_bill_pay_pkgnum($pkgnum) unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_bill_pay', { 'invnum' => $self->invnum, + 'pkgnum' => $pkgnum, + } + ); +} + +=item cust_credited_pkgnum PKGNUM + +=item cust_credit_bill_pkgnum PKGNUM + +Returns all applied credits (see L<FS::cust_credit_bill>) for this invoice +with matching pkgnum. + +=cut + +sub cust_credited_pkgnum { + my( $self, $pkgnum ) = @_; + map { $_ } #return $self->num_cust_credit_bill_pkgnum($pkgnum) unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_credit_bill', { 'invnum' => $self->invnum, + 'pkgnum' => $pkgnum, + } + ); +} + +sub cust_credit_bill_pkgnum { + shift->cust_credited_pkgnum(@_); +} + =item tax Returns the tax amount (see L<FS::cust_bill_pkg>) for this invoice. @@ -465,12 +631,35 @@ sub owed { $balance; } -=item apply_payments_and_credits +sub owed_pkgnum { + my( $self, $pkgnum ) = @_; + + #my $balance = $self->charged; + my $balance = 0; + $balance += $_->setup + $_->recur for $self->cust_bill_pkg_pkgnum($pkgnum); + + $balance -= $_->amount for $self->cust_bill_pay_pkgnum($pkgnum); + $balance -= $_->amount for $self->cust_credited_pkgnum($pkgnum); + + $balance = sprintf( "%.2f", $balance); + $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp + $balance; +} + +=item apply_payments_and_credits [ OPTION => VALUE ... ] + +Applies unapplied payments and credits to this invoice. + +A hash of optional arguments may be passed. Currently "manual" is supported. +If true, a payment receipt is sent instead of a statement when +'payment_receipt_email' configuration option is set. + +If there is an error, returns the error, otherwise returns false. =cut sub apply_payments_and_credits { - my $self = shift; + my( $self, %options ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -488,6 +677,13 @@ sub apply_payments_and_credits { my @payments = grep { $_->unapplied > 0 } $self->cust_main->cust_pay; my @credits = grep { $_->credited > 0 } $self->cust_main->cust_credit; + if ( $conf->exists('pkg-balances') ) { + # limit @payments & @credits to those w/ a pkgnum grepped from $self + my %pkgnums = map { $_ => 1 } map $_->pkgnum, $self->cust_bill_pkg; + @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments; + @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits; + } + while ( $self->owed > 0 and ( @payments || @credits ) ) { my $app = ''; @@ -525,31 +721,42 @@ sub apply_payments_and_credits { die "guru meditation #12 and 35"; } + my $unapp_amount; if ( $app eq 'pay' ) { my $payment = shift @payments; - - $app = new FS::cust_bill_pay { - 'paynum' => $payment->paynum, - 'amount' => sprintf('%.2f', min( $payment->unapplied, $self->owed ) ), - }; + $unapp_amount = $payment->unapplied; + $app = new FS::cust_bill_pay { 'paynum' => $payment->paynum }; + $app->pkgnum( $payment->pkgnum ) + if $conf->exists('pkg-balances') && $payment->pkgnum; } elsif ( $app eq 'credit' ) { my $credit = shift @credits; - - $app = new FS::cust_credit_bill { - 'crednum' => $credit->crednum, - 'amount' => sprintf('%.2f', min( $credit->credited, $self->owed ) ), - }; + $unapp_amount = $credit->credited; + $app = new FS::cust_credit_bill { 'crednum' => $credit->crednum }; + $app->pkgnum( $credit->pkgnum ) + if $conf->exists('pkg-balances') && $credit->pkgnum; } else { die "guru meditation #12 and 35"; } + my $owed; + if ( $conf->exists('pkg-balances') && $app->pkgnum ) { + warn "owed_pkgnum ". $app->pkgnum; + $owed = $self->owed_pkgnum($app->pkgnum); + } else { + $owed = $self->owed; + } + next unless $owed > 0; + + warn "min ( $unapp_amount, $owed )\n" if $DEBUG; + $app->amount( sprintf('%.2f', min( $unapp_amount, $owed ) ) ); + $app->invnum( $self->invnum ); - my $error = $app->insert; + my $error = $app->insert(%options); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "Error inserting ". $app->table. " record: $error"; @@ -585,6 +792,10 @@ text attachment arrayref, optional email subject, optional +=item notice_name + +notice name instead of "Invoice", optional + =back Returns an argument list to be passed to L<FS::Misc::send_email>. @@ -605,11 +816,19 @@ sub generate_email { 'subject' => (($args{'subject'}) ? $args{'subject'} : 'Invoice'), ); + my %opt = ( + 'unsquelch_cdr' => $conf->exists('voip-cdr_email'), + 'template' => $args{'template'}, + 'notice_name' => ( $args{'notice_name'} || 'Invoice' ), + ); + + my $cust_main = $self->cust_main; + if (ref($args{'to'}) eq 'ARRAY') { $return{'to'} = $args{'to'}; } else { $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ } - $self->cust_main->invoicing_list + $cust_main->invoicing_list ]; } @@ -643,7 +862,7 @@ sub generate_email { if ( ref($args{'print_text'}) eq 'ARRAY' ) { $data = $args{'print_text'}; } else { - $data = [ $self->print_text('', $args{'template'}) ]; + $data = [ $self->print_text(\%opt) ]; } } @@ -660,21 +879,22 @@ sub generate_email { my $from = $1 || 'example.com'; my $content_id = join('.', rand()*(2**32), $$, time). "\@$from"; - my $path = "$FS::UID::conf_dir/conf.$FS::UID::datasrc"; - my $file; + my $logo; + my $agentnum = $cust_main->agentnum; if ( defined($args{'template'}) && length($args{'template'}) - && -e "$path/logo_". $args{'template'}. ".png" + && $conf->exists( 'logo_'. $args{'template'}. '.png', $agentnum ) ) { - $file = "$path/logo_". $args{'template'}. ".png"; + $logo = 'logo_'. $args{'template'}. '.png'; } else { - $file = "$path/logo.png"; + $logo = "logo.png"; } + my $image_data = $conf->config_binary( $logo, $agentnum); my $image = build MIME::Entity 'Type' => 'image/png', 'Encoding' => 'base64', - 'Path' => $file, + 'Data' => $image_data, 'Filename' => 'logo.png', 'Content-ID' => "<$content_id>", ; @@ -689,7 +909,7 @@ sub generate_email { ' </title>', ' </head>', ' <body bgcolor="#e8e8e8">', - $self->print_html('', $args{'template'}, $content_id), + $self->print_html({ 'cid'=>$content_id, %opt }), ' </body>', '</html>', ], @@ -697,6 +917,21 @@ sub generate_email { #'Filename' => 'invoice.pdf', ); + my @otherparts = (); + if ( $cust_main->email_csv_cdr ) { + + push @otherparts, build MIME::Entity + 'Type' => 'text/csv', + 'Encoding' => '7bit', + 'Data' => [ map { "$_\n" } + $self->call_details('prepend_billed_number' => 1) + ], + 'Disposition' => 'attachment', + 'Filename' => 'usage-'. $self->invnum. '.csv', + ; + + } + if ( $conf->exists('invoice_email_pdf') ) { #attaching pdf too: @@ -722,9 +957,9 @@ sub generate_email { $related->add_part($image); - my $pdf = build MIME::Entity $self->mimebuild_pdf('', $args{'template'}); + my $pdf = build MIME::Entity $self->mimebuild_pdf(\%opt); - $return{'mimeparts'} = [ $related, $pdf ]; + $return{'mimeparts'} = [ $related, $pdf, @otherparts ]; } else { @@ -736,7 +971,7 @@ sub generate_email { # image/png $return{'content-type'} = 'multipart/related'; - $return{'mimeparts'} = [ $alternative, $image ]; + $return{'mimeparts'} = [ $alternative, $image, @otherparts ]; $return{'type'} = 'multipart/alternative'; #Content-Type of first part... #$return{'disposition'} = 'inline'; @@ -750,7 +985,7 @@ sub generate_email { #mime parts arguments a la MIME::Entity->build(). $return{'mimeparts'} = [ - { $self->mimebuild_pdf('', $args{'template'}) } + { $self->mimebuild_pdf(\%opt) } ]; } @@ -770,7 +1005,7 @@ sub generate_email { if ( ref($args{'print_text'}) eq 'ARRAY' ) { $return{'body'} = $args{'print_text'}; } else { - $return{'body'} = [ $self->print_text('', $args{'template'}) ]; + $return{'body'} = [ $self->print_text(\%opt) ]; } } @@ -795,26 +1030,31 @@ sub mimebuild_pdf { 'Encoding' => 'base64', 'Data' => [ $self->print_pdf(@_) ], 'Disposition' => 'attachment', - 'Filename' => 'invoice.pdf', + 'Filename' => 'invoice-'. $self->invnum. '.pdf', ); } -=item send [ TEMPLATENAME [ , AGENTNUM [ , INVOICE_FROM ] ] ] +=item send HASHREF | [ TEMPLATE [ , AGENTNUM [ , INVOICE_FROM [ , AMOUNT ] ] ] ] Sends this invoice to the destinations configured for this customer: sends email, prints and/or faxes. See L<FS::cust_main_invoice>. -TEMPLATENAME, if specified, is the name of a suffix for alternate invoices. +Options can be passed as a hashref (recommended) or as a list of up to +four values for templatename, agentnum, invoice_from and amount. + +I<template>, if specified, is the name of a suffix for alternate invoices. -AGENTNUM, if specified, means that this invoice will only be sent for customers +I<agentnum>, if specified, means that this invoice will only be sent for customers of the specified agent or agent(s). AGENTNUM can be a scalar agentnum (for a single agent) or an arrayref of agentnums. -INVOICE_FROM, if specified, overrides the default email invoice From: address. +I<invoice_from>, if specified, overrides the default email invoice From: address. -AMOUNT, if specified, only sends the invoice if the total amount owed on this +I<amount>, if specified, only sends the invoice if the total amount owed on this invoice and all older invoices is greater than the specified amount. +I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) + =cut sub queueable_send { @@ -834,48 +1074,73 @@ sub queueable_send { sub send { my $self = shift; - my $template = scalar(@_) ? shift : ''; - if ( scalar(@_) && $_[0] ) { - my $agentnums = ref($_[0]) ? shift : [ shift ]; - return 'N/A' unless grep { $_ == $self->cust_main->agentnum } @$agentnums; - } - my $invoice_from = - scalar(@_) - ? shift - : ( $self->_agent_invoice_from || #XXX should go away - $conf->config('invoice_from', $self->cust_main->agentnum ) - ); + my( $template, $invoice_from, $notice_name ); + my $agentnums = ''; + my $balance_over = 0; - my $balance_over = ( scalar(@_) && $_[0] !~ /^\s*$/ ) ? shift : 0; + if ( ref($_[0]) ) { + my $opt = shift; + $template = $opt->{'template'} || ''; + if ( $agentnums = $opt->{'agentnum'} ) { + $agentnums = [ $agentnums ] unless ref($agentnums); + } + $invoice_from = $opt->{'invoice_from'}; + $balance_over = $opt->{'balance_over'} if $opt->{'balance_over'}; + $notice_name = $opt->{'notice_name'}; + } else { + $template = scalar(@_) ? shift : ''; + if ( scalar(@_) && $_[0] ) { + $agentnums = ref($_[0]) ? shift : [ shift ]; + } + $invoice_from = shift if scalar(@_); + $balance_over = shift if scalar(@_) && $_[0] !~ /^\s*$/; + } + + return 'N/A' unless ! $agentnums + or grep { $_ == $self->cust_main->agentnum } @$agentnums; return '' unless $self->cust_main->total_owed_date($self->_date) > $balance_over; + $invoice_from ||= $self->_agent_invoice_from || #XXX should go away + $conf->config('invoice_from', $self->cust_main->agentnum ); + + my %opt = ( + 'template' => $template, + 'invoice_from' => $invoice_from, + 'notice_name' => ( $notice_name || 'Invoice' ), + ); + my @invoicing_list = $self->cust_main->invoicing_list; - #$self->email_invoice($template, $invoice_from) - $self->email($template, $invoice_from) + #$self->email_invoice(\%opt) + $self->email(\%opt) if grep { $_ !~ /^(POST|FAX)$/ } @invoicing_list or !@invoicing_list; - #$self->print_invoice($template) - $self->print($template) + #$self->print_invoice(\%opt) + $self->print(\%opt) if grep { $_ eq 'POST' } @invoicing_list; #postal - $self->fax_invoice($template) + $self->fax_invoice(\%opt) if grep { $_ eq 'FAX' } @invoicing_list; #fax ''; } -=item email [ TEMPLATENAME [ , INVOICE_FROM ] ] +=item email HASHREF | [ TEMPLATE [ , INVOICE_FROM ] ] Emails this invoice. -TEMPLATENAME, if specified, is the name of a suffix for alternate invoices. +Options can be passed as a hashref (recommended) or as a list of up to +two values for templatename and invoice_from. + +I<template>, if specified, is the name of a suffix for alternate invoices. + +I<invoice_from>, if specified, overrides the default email invoice From: address. -INVOICE_FROM, if specified, overrides the default email invoice From: address. +I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) =cut @@ -897,14 +1162,21 @@ sub queueable_email { #sub email_invoice { sub email { my $self = shift; - my $template = scalar(@_) ? shift : ''; - my $invoice_from = - scalar(@_) - ? shift - : ( $self->_agent_invoice_from || #XXX should go away - $conf->config('invoice_from', $self->cust_main->agentnum ) - ); + my( $template, $invoice_from, $notice_name ); + if ( ref($_[0]) ) { + my $opt = shift; + $template = $opt->{'template'} || ''; + $invoice_from = $opt->{'invoice_from'}; + $notice_name = $opt->{'notice_name'} || 'Invoice'; + } else { + $template = scalar(@_) ? shift : ''; + $invoice_from = shift if scalar(@_); + $notice_name = 'Invoice'; + } + + $invoice_from ||= $self->_agent_invoice_from || #XXX should go away + $conf->config('invoice_from', $self->cust_main->agentnum ); my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list; @@ -916,10 +1188,11 @@ sub email { my $error = send_email( $self->generate_email( - 'from' => $invoice_from, - 'to' => [ grep { $_ !~ /^(POST|FAX)$/ } @invoicing_list ], - 'subject' => $subject, - 'template' => $template, + 'from' => $invoice_from, + 'to' => [ grep { $_ !~ /^(POST|FAX)$/ } @invoicing_list ], + 'subject' => $subject, + 'template' => $template, + 'notice_name' => $notice_name, ) ); die "can't email invoice: $error\n" if $error; @@ -945,48 +1218,98 @@ sub email_subject { eval qq("$subject"); } -=item lpr_data [ TEMPLATENAME ] +=item lpr_data HASHREF | [ TEMPLATE ] Returns the postscript or plaintext for this invoice as an arrayref. -TEMPLATENAME, if specified, is the name of a suffix for alternate invoices. +Options can be passed as a hashref (recommended) or as a single optional value +for template. + +I<template>, if specified, is the name of a suffix for alternate invoices. + +I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) =cut sub lpr_data { - my( $self, $template) = @_; - $conf->exists('invoice_latex') - ? [ $self->print_ps('', $template) ] - : [ $self->print_text('', $template) ]; + my $self = shift; + my( $template, $notice_name ); + if ( ref($_[0]) ) { + my $opt = shift; + $template = $opt->{'template'} || ''; + $notice_name = $opt->{'notice_name'} || 'Invoice'; + } else { + $template = scalar(@_) ? shift : ''; + $notice_name = 'Invoice'; + } + + my %opt = ( + 'template' => $template, + 'notice_name' => $notice_name, + ); + + my $method = $conf->exists('invoice_latex') ? 'print_ps' : 'print_text'; + [ $self->$method( \%opt ) ]; } -=item print [ TEMPLATENAME ] +=item print HASHREF | [ TEMPLATE ] Prints this invoice. -TEMPLATENAME, if specified, is the name of a suffix for alternate invoices. +Options can be passed as a hashref (recommended) or as a single optional +value for template. + +I<template>, if specified, is the name of a suffix for alternate invoices. + +I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) =cut #sub print_invoice { sub print { my $self = shift; - my $template = scalar(@_) ? shift : ''; + my( $template, $notice_name ); + if ( ref($_[0]) ) { + my $opt = shift; + $template = $opt->{'template'} || ''; + $notice_name = $opt->{'notice_name'} || 'Invoice'; + } else { + $template = scalar(@_) ? shift : ''; + $notice_name = 'Invoice'; + } - do_print $self->lpr_data($template); + my %opt = ( + 'template' => $template, + 'notice_name' => $notice_name, + ); + + do_print $self->lpr_data(\%opt); } -=item fax_invoice [ TEMPLATENAME ] +=item fax_invoice HASHREF | [ TEMPLATE ] Faxes this invoice. -TEMPLATENAME, if specified, is the name of a suffix for alternate invoices. +Options can be passed as a hashref (recommended) or as a single optional +value for template. + +I<template>, if specified, is the name of a suffix for alternate invoices. + +I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) =cut sub fax_invoice { my $self = shift; - my $template = scalar(@_) ? shift : ''; + my( $template, $notice_name ); + if ( ref($_[0]) ) { + my $opt = shift; + $template = $opt->{'template'} || ''; + $notice_name = $opt->{'notice_name'} || 'Invoice'; + } else { + $template = scalar(@_) ? shift : ''; + $notice_name = 'Invoice'; + } die 'FAX invoice destination not (yet?) supported with plain text invoices.' unless $conf->exists('invoice_latex'); @@ -994,7 +1317,12 @@ sub fax_invoice { my $dialstring = $self->cust_main->getfield('fax'); #Check $dialstring? - my $error = send_fax( 'docdata' => $self->lpr_data($template), + my %opt = ( + 'template' => $template, + 'notice_name' => $notice_name, + ); + + my $error = send_fax( 'docdata' => $self->lpr_data(\%opt), 'dialstring' => $dialstring, ); die $error if $error; @@ -1456,11 +1784,9 @@ sub print_csv { } else { #pkgnum tax next unless $cust_bill_pkg->setup != 0; - my $itemdesc = defined $cust_bill_pkg->dbdef_table->column('itemdesc') - ? ( $cust_bill_pkg->itemdesc || 'Tax' ) - : 'Tax'; - ($pkg, $setup, $recur, $sdate, $edate) = - ( $itemdesc, sprintf("%10.2f",$cust_bill_pkg->setup), '', '', '' ); + $pkg = $cust_bill_pkg->desc; + $setup = sprintf('%10.2f', $cust_bill_pkg->setup ); + ( $sdate, $edate ) = ( '', '' ); } $csv->combine( @@ -1600,28 +1926,45 @@ sub _agent_invoice_from { $self->cust_main->agent_invoice_from; } -=item print_text [ TIME [ , TEMPLATE ] ] +=item print_text HASHREF | [ TIME [ , TEMPLATE [ , OPTION => VALUE ... ] ] ] Returns an text invoice, as a list of lines. -TIME an optional value used to control the printing of overdue messages. The +Options can be passed as a hashref (recommended) or as a list of time, template +and then any key/value pairs for any other options. + +I<time>, if specified, is used to control the printing of overdue messages. The default is now. It isn't the date of the invoice; that's the `_date' field. It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion functions. +I<template>, if specified, is the name of a suffix for alternate invoices. + +I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) + =cut sub print_text { - my( $self, $today, $template ) = @_; + my $self = shift; + my( $today, $template, %opt ); + if ( ref($_[0]) ) { + %opt = %{ shift() }; + $today = delete($opt{'time'}) || ''; + $template = delete($opt{template}) || ''; + } else { + ( $today, $template, %opt ) = @_; + } my %params = ( 'format' => 'template' ); $params{'time'} = $today if $today; $params{'template'} = $template if $template; + $params{$_} = $opt{$_} + foreach grep $opt{$_}, qw( unsquealch_cdr notice_name ); $self->print_generic( %params ); } -=item print_latex [ TIME [ , TEMPLATE ] ] +=item print_latex HASHREF | [ TIME [ , TEMPLATE [ , OPTION => VALUE ... ] ] ] Internal method - returns a filename of a filled-in LaTeX template for this invoice (Note: add ".tex" to get the actual filename), and a filename of @@ -1629,19 +1972,36 @@ an associated logo (with the .eps extension included). See print_ps and print_pdf for methods that return PostScript and PDF output. -TIME an optional value used to control the printing of overdue messages. The +Options can be passed as a hashref (recommended) or as a list of time, template +and then any key/value pairs for any other options. + +I<time>, if specified, is used to control the printing of overdue messages. The default is now. It isn't the date of the invoice; that's the `_date' field. It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion functions. +I<template>, if specified, is the name of a suffix for alternate invoices. + +I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) + =cut sub print_latex { - my( $self, $today, $template ) = @_; + my $self = shift; + my( $today, $template, %opt ); + if ( ref($_[0]) ) { + %opt = %{ shift() }; + $today = delete($opt{'time'}) || ''; + $template = delete($opt{template}) || ''; + } else { + ( $today, $template, %opt ) = @_; + } my %params = ( 'format' => 'latex' ); $params{'time'} = $today if $today; $params{'template'} = $template if $template; + $params{$_} = $opt{$_} + foreach grep $opt{$_}, qw( unsquealch_cdr notice_name ); $template ||= $self->_agent_template; @@ -1679,7 +2039,7 @@ sub print_latex { } -=item print_generic OPTIONS_HASH +=item print_generic OPTION => VALUE ... Internal method - returns a filled-in template for this invoice as a scalar. @@ -1701,15 +2061,17 @@ cid - unsquelch_cdr - overrides any per customer cdr squelching when true +notice_name - overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) + =cut #what's with all the sprintf('%10.2f')'s in here? will it cause any -# (alignment?) problems to change them all to '%.2f' ? +# (alignment in text invoice?) problems to change them all to '%.2f' ? sub print_generic { my( $self, %params ) = @_; my $today = $params{today} ? $params{today} : time; - warn "FS::cust_bill::print_generic called on $self with suffix $params{template}\n" + warn "$me print_generic called on $self with suffix $params{template}\n" if $DEBUG; my $format = $params{format}; @@ -1761,6 +2123,7 @@ sub print_generic { 'smallfooter' => sub { map "$_", @_ }, 'returnaddress' => sub { map "$_", @_ }, 'coupon' => sub { map "$_", @_ }, + 'summary' => sub { map "$_", @_ }, }, 'html' => { 'notes' => @@ -1794,6 +2157,7 @@ sub print_generic { } @_ }, 'coupon' => sub { "" }, + 'summary' => sub { "" }, }, 'template' => { 'notes' => @@ -1824,6 +2188,7 @@ sub print_generic { } @_ }, 'coupon' => sub { "" }, + 'summary' => sub { "" }, }, ); @@ -1909,37 +2274,53 @@ sub print_generic { } my %invoice_data = ( + + #invoice from info 'company_name' => scalar( $conf->config('company_name', $self->cust_main->agentnum) ), 'company_address' => join("\n", $conf->config('company_address', $self->cust_main->agentnum) ). "\n", - 'custnum' => $cust_main->display_custnum, + 'returnaddress' => $returnaddress, + 'agent' => &$escape_function($cust_main->agent->agent), + + #invoice info 'invnum' => $self->invnum, 'date' => time2str($date_format, $self->_date), 'today' => time2str('%b %o, %Y', $today), - 'agent' => &$escape_function($cust_main->agent->agent), - 'agent_custid' => &$escape_function($cust_main->agent_custid), - 'payname' => &$escape_function($cust_main->payname), - 'company' => &$escape_function($cust_main->company), - 'address1' => &$escape_function($cust_main->address1), - 'address2' => &$escape_function($cust_main->address2), - 'city' => &$escape_function($cust_main->city), - 'state' => &$escape_function($cust_main->state), - 'zip' => &$escape_function($cust_main->zip), - 'fax' => &$escape_function($cust_main->fax), - 'returnaddress' => $returnaddress, - #'quantity' => 1, 'terms' => $self->terms, 'template' => $template, #params{'template'}, - #'notes' => join("\n", $conf->config('invoice_latexnotes') ), - # better hang on to conf_dir for a while - 'conf_dir' => "$FS::UID::conf_dir/conf.$FS::UID::datasrc", - 'page' => 1, - 'total_pages' => 1, + 'notice_name' => ($params{'notice_name'} || 'Invoice'),#escape_function? 'current_charges' => sprintf("%.2f", $self->charged), 'duedate' => $self->due_date2str('%m/%d/%Y'), #date_format? + + #customer info + 'custnum' => $cust_main->display_custnum, + 'agent_custid' => &$escape_function($cust_main->agent_custid), + ( map { $_ => &$escape_function($cust_main->$_()) } qw( + payname company address1 address2 city state zip fax + )), + + #global config 'ship_enable' => $conf->exists('invoice-ship_address'), 'unitprices' => $conf->exists('invoice-unitprice'), + 'smallernotes' => $conf->exists('invoice-smallernotes'), + 'smallerfooter' => $conf->exists('invoice-smallerfooter'), + + # better hang on to conf_dir for a while (for old templates) + 'conf_dir' => "$FS::UID::conf_dir/conf.$FS::UID::datasrc", + + #these are only used when doing paged plaintext + 'page' => 1, + 'total_pages' => 1, + ); + $invoice_data{finance_section} = ''; + if ( $conf->config('finance_pkgclass') ) { + my $pkg_class = + qsearchs('pkg_class', { classnum => $conf->config('finance_pkgclass') }); + $invoice_data{finance_section} = $pkg_class->categoryname; + } + $invoice_data{finance_amount} = '0.00'; + my $countrydefault = $conf->config('countrydefault') || 'US'; my $prefix = $cust_main->has_ship_address ? 'ship_' : ''; foreach ( qw( contact company address1 address2 city state zip country fax) ){ @@ -1986,18 +2367,29 @@ sub print_generic { # my( $cr_total, @cr_cust_credit ) = $self->cust_credit; #credits #my $balance_due = $self->owed + $pr_total - $cr_total; my $balance_due = $self->owed + $pr_total; + $invoice_data{'true_previous_balance'} = sprintf("%.2f", ($self->previous_balance || 0) ); + $invoice_data{'balance_adjustments'} = sprintf("%.2f", ($self->previous_balance || 0) - ($self->billing_balance || 0) ); $invoice_data{'previous_balance'} = sprintf("%.2f", $pr_total); $invoice_data{'balance'} = sprintf("%.2f", $balance_due); + my $agentnum = $self->cust_main->agentnum; + + my $summarypage = ''; + if ( $conf->exists('invoice_usesummary', $agentnum) ) { + $summarypage = 1; + } + $invoice_data{'summarypage'} = $summarypage; + #do variable substitution in notes, footer, smallfooter foreach my $include (qw( notes footer smallfooter coupon )) { my $inc_file = $conf->key_orbase("invoice_${format}$include", $template); my @inc_src; - if ( $conf->exists($inc_file) && length( $conf->config($inc_file) ) ) { + if ( $conf->exists($inc_file, $agentnum) + && length( $conf->config($inc_file, $agentnum) ) ) { - @inc_src = $conf->config($inc_file); + @inc_src = $conf->config($inc_file, $agentnum); } else { @@ -2009,7 +2401,7 @@ sub print_generic { s/--\@\]/$delimiters{$format}[1]/g; $_; } - &$convert_map( $conf->config($inc_file) ); + &$convert_map( $conf->config($inc_file, $agentnum) ); } @@ -2047,6 +2439,7 @@ sub print_generic { 'template' => '', ); my $other_money_char = $other_money_chars{$format}; + $invoice_data{'dollar'} = $other_money_char; my @detail_items = (); my @total_items = (); @@ -2057,56 +2450,66 @@ sub print_generic { $invoice_data{'total_items'} = \@total_items; $invoice_data{'buf'} = \@buf; $invoice_data{'sections'} = \@sections; - + my $previous_section = { 'description' => 'Previous Charges', 'subtotal' => $other_money_char. sprintf('%.2f', $pr_total), + 'summarized' => $summarypage ? 'Y' : '', }; my $taxtotal = 0; my $tax_section = { 'description' => 'Taxes, Surcharges, and Fees', - 'subtotal' => $taxtotal }; # adjusted below + 'subtotal' => $taxtotal, # adjusted below + 'summarized' => $summarypage ? 'Y' : '', + }; my $adjusttotal = 0; my $adjust_section = { 'description' => 'Credits, Payments, and Adjustments', - 'subtotal' => 0 }; # adjusted below + 'subtotal' => 0, # adjusted below + 'summarized' => $summarypage ? 'Y' : '', + }; my $unsquelched = $params{unsquelch_cdr} || $cust_main->squelch_cdr ne 'Y'; my $multisection = $conf->exists('invoice_sections', $cust_main->agentnum); my $late_sections = []; if ( $multisection ) { - push @sections, $self->_items_sections( $late_sections ); + push @sections, + $self->_items_sections( $late_sections, $summarypage, $escape_function ); }else{ push @sections, { 'description' => '', 'subtotal' => '' }; } - foreach my $line_item ( $conf->exists('disable_previous_balance') - ? () - : $self->_items_previous - ) + unless ( $conf->exists('disable_previous_balance') + || $conf->exists('previous_balance-summary_only') + ) { - my $detail = { - ext_description => [], - }; - $detail->{'ref'} = $line_item->{'pkgnum'}; - $detail->{'quantity'} = 1; - $detail->{'section'} = $previous_section; - $detail->{'description'} = &$escape_function($line_item->{'description'}); - if ( exists $line_item->{'ext_description'} ) { - @{$detail->{'ext_description'}} = map { - &$escape_function($_); - } @{$line_item->{'ext_description'}}; + + foreach my $line_item ( $self->_items_previous ) { + + my $detail = { + ext_description => [], + }; + $detail->{'ref'} = $line_item->{'pkgnum'}; + $detail->{'quantity'} = 1; + $detail->{'section'} = $previous_section; + $detail->{'description'} = &$escape_function($line_item->{'description'}); + if ( exists $line_item->{'ext_description'} ) { + @{$detail->{'ext_description'}} = map { + &$escape_function($_); + } @{$line_item->{'ext_description'}}; + } + $detail->{'amount'} = ( $old_latex ? '' : $money_char). + $line_item->{'amount'}; + $detail->{'product_code'} = $line_item->{'pkgpart'} || 'N/A'; + + push @detail_items, $detail; + push @buf, [ $detail->{'description'}, + $money_char. sprintf("%10.2f", $line_item->{'amount'}), + ]; } - $detail->{'amount'} = ( $old_latex ? '' : $money_char). - $line_item->{'amount'}; - $detail->{'product_code'} = $line_item->{'pkgpart'} || 'N/A'; - - push @detail_items, $detail; - push @buf, [ $detail->{'description'}, - $money_char. sprintf("%10.2f", $line_item->{'amount'}), - ]; + } - + if ( @pr_cust_bill && !$conf->exists('disable_previous_balance') ) { push @buf, ['','-----------']; push @buf, [ 'Total Previous Balance', @@ -2116,6 +2519,10 @@ sub print_generic { foreach my $section (@sections, @$late_sections) { + $invoice_data{finance_amount} = sprintf('%.2f', $section->{'subtotal'} ) + if ( $invoice_data{finance_section} && + $section->{'description'} eq $invoice_data{finance_section} ); + $section->{'subtotal'} = $other_money_char. sprintf('%.2f', $section->{'subtotal'}) if $multisection; @@ -2132,6 +2539,7 @@ sub print_generic { $options{'escape_function'} = $escape_function; $options{'format_function'} = sub { () } unless $unsquelched; $options{'unsquelched'} = $unsquelched; + $options{'summary_page'} = $summarypage; foreach my $line_item ( $self->_items_pkg(%options) ) { my $detail = { @@ -2170,6 +2578,9 @@ sub print_generic { } + $invoice_data{current_less_finance} = + sprintf('%.2f', $self->charged - $invoice_data{finance_amount} ); + if ( $multisection && !$conf->exists('disable_previous_balance') ) { unshift @sections, $previous_section if $pr_total; } @@ -2226,7 +2637,7 @@ sub print_generic { } } $invoice_data{'taxtotal'} = sprintf('%.2f', $taxtotal); - + push @buf,['','-----------']; push @buf,[( $conf->exists('disable_previous_balance') ? 'Total Charges' @@ -2272,7 +2683,8 @@ sub print_generic { # credits my $credittotal = 0; - foreach my $credit ( $self->_items_credits ) { + foreach my $credit ( $self->_items_credits('trim_len'=>60) ) { + my $total; $total->{'total_item'} = &$escape_function($credit->{'description'}); $credittotal += $credit->{'amount'}; @@ -2289,24 +2701,16 @@ sub print_generic { product_code => '', section => $adjust_section, }; - }else{ + } else { push @total_items, $total; } + } $invoice_data{'credittotal'} = sprintf('%.2f', $credittotal); - - # credits (again) - foreach ( $self->cust_credited ) { - - #something more elaborate if $_->amount ne $_->cust_credit->credited ? - - my $reason = substr($_->cust_credit->reason,0,32); - $reason .= '...' if length($reason) < length($_->cust_credit->reason); - $reason = " ($reason) " if $reason; - push @buf,[ - "Credit #". $_->crednum. " (". time2str("%x",$_->cust_credit->_date) .")". $reason, - $money_char. sprintf("%10.2f",$_->amount) - ]; + + #credits (again) + foreach my $credit ( $self->_items_credits('trim_len'=>32) ) { + push @buf, [ $credit->{'description'}, $money_char.$credit->{'amount'} ]; } # payments @@ -2348,7 +2752,11 @@ sub print_generic { $total->{'total_item'} = &$embolden_function($self->balance_due_msg); $total->{'total_amount'} = &$embolden_function( - $other_money_char. sprintf('%.2f', $self->owed + $pr_total ) + $other_money_char. sprintf('%.2f', $summarypage + ? $self->charged + + $self->billing_balance + : $self->owed + $pr_total + ) ); if ( $multisection ) { $adjust_section->{'posttotal'} = $total->{'total_item'}. ' '. @@ -2367,6 +2775,49 @@ sub print_generic { if $unsquelched; } + my @includelist = (); + push @includelist, 'summary' if $summarypage; + foreach my $include ( @includelist ) { + + my $inc_file = $conf->key_orbase("invoice_${format}$include", $template); + my @inc_src; + + if ( length( $conf->config($inc_file, $agentnum) ) ) { + + @inc_src = $conf->config($inc_file, $agentnum); + + } else { + + $inc_file = $conf->key_orbase("invoice_latex$include", $template); + + my $convert_map = $convert_maps{$format}{$include}; + + @inc_src = map { s/\[\@--/$delimiters{$format}[0]/g; + s/--\@\]/$delimiters{$format}[1]/g; + $_; + } + &$convert_map( $conf->config($inc_file, $agentnum) ); + + } + + my $inc_tt = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @inc_src ], + DELIMITERS => $delimiters{$format}, + ) or die "Can't create new Text::Template object: $Text::Template::ERROR"; + + unless ( $inc_tt->compile() ) { + my $error = "Can't compile $inc_file template: $Text::Template::ERROR\n"; + warn $error. "Template:\n". join('', map "$_\n", @inc_src); + die $error; + } + + $invoice_data{$include} = $inc_tt->fill_in( HASH => \%invoice_data ); + + $invoice_data{$include} =~ s/\n+$// + if ($format eq 'latex'); + } + $invoice_lines = 0; my $wasfunc = 0; foreach ( grep /invoice_lines\(\d*\)/, @invoice_template ) { #kludgy @@ -2417,15 +2868,20 @@ sub print_generic { } } -=item print_ps [ TIME [ , TEMPLATE ] ] +=item print_ps HASHREF | [ TIME [ , TEMPLATE ] ] Returns an postscript invoice, as a scalar. -TIME an optional value used to control the printing of overdue messages. The +Options can be passed as a hashref (recommended) or as a list of time, template +and then any key/value pairs for any other options. + +I<time> an optional value used to control the printing of overdue messages. The default is now. It isn't the date of the invoice; that's the `_date' field. It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion functions. +I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) + =cut sub print_ps { @@ -2438,15 +2894,22 @@ sub print_ps { $ps; } -=item print_pdf [ TIME [ , TEMPLATE ] ] +=item print_pdf HASHREF | [ TIME [ , TEMPLATE ] ] Returns an PDF invoice, as a scalar. -TIME an optional value used to control the printing of overdue messages. The +Options can be passed as a hashref (recommended) or as a list of time, template +and then any key/value pairs for any other options. + +I<time> an optional value used to control the printing of overdue messages. The default is now. It isn't the date of the invoice; that's the `_date' field. It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion functions. +I<template>, if specified, is the name of a suffix for alternate invoices. + +I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) + =cut sub print_pdf { @@ -2459,16 +2922,20 @@ sub print_pdf { $pdf; } -=item print_html [ TIME [ , TEMPLATE [ , CID ] ] ] +=item print_html HASHREF | [ TIME [ , TEMPLATE [ , CID ] ] ] Returns an HTML invoice, as a scalar. -TIME an optional value used to control the printing of overdue messages. The +I<time> an optional value used to control the printing of overdue messages. The default is now. It isn't the date of the invoice; that's the `_date' field. It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion functions. -CID is a MIME Content-ID used to create a "cid:" URL for the logo image, used +I<template>, if specified, is the name of a suffix for alternate invoices. + +I<notice_name>, if specified, overrides "Invoice" as the name of the sent document (templates from 10/2009 or newer required) + +I<cid> is a MIME Content-ID used to create a "cid:" URL for the logo image, used when emailing the invoice as part of a multipart/related MIME email. =cut @@ -2476,7 +2943,7 @@ when emailing the invoice as part of a multipart/related MIME email. sub print_html { my $self = shift; my %params; - if ( ref $_[0] ) { + if ( ref($_[0]) ) { %params = %{ shift() }; }else{ $params{'time'} = shift; @@ -2534,10 +3001,10 @@ sub _translate_old_latex_format { $line_item_line =~ s/\$(\w+)/'. \$_tr_line->{$1}. '/g; push @template, " \$OUT .= '$line_item_line';"; } - + push @template, '}', '--@]'; - + #' doh, gvim } elsif ( $line =~ /^%%TotalDetails\s*$/ ) { push @template, '[@--', @@ -2571,14 +3038,15 @@ sub _translate_old_latex_format { sub terms { my $self = shift; - #check for an invoice- specific override (eventually) + #check for an invoice-specific override + return $self->invoice_terms if $self->invoice_terms; #check for a customer- specific override - return $self->cust_main->invoice_terms - if $self->cust_main->invoice_terms; + my $cust_main = $self->cust_main; + return $cust_main->invoice_terms if $cust_main->invoice_terms; - #use configured default or default default - $conf->config('invoice_default_terms') || 'Payable upon receipt'; + #use configured default + $conf->config('invoice_default_terms') || ''; } sub due_date { @@ -2643,21 +3111,30 @@ sub _date_pretty { sub _items_sections { my $self = shift; my $late = shift; + my $summarypage = shift; + my $escape = shift; my %s = (); my %l = (); + my %not_tax = (); foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) { - if ( $cust_bill_pkg->pkgnum > 0 ) { + my $usage = $cust_bill_pkg->usage; foreach my $display ($cust_bill_pkg->cust_bill_pkg_display) { + next if ( $display->summary && $summarypage ); + my $desc = $display->section; my $type = $display->type; - if ( $display->post_total ) { + if ( $cust_bill_pkg->pkgnum > 0 ) { + $not_tax{$desc} = 1; + } + + if ( $display->post_total && !$summarypage ) { if (! $type || $type eq 'S') { $l{$desc} += $cust_bill_pkg->setup if ( $cust_bill_pkg->setup != 0 ); @@ -2701,16 +3178,29 @@ sub _items_sections { } - } - } - push @$late, map { { 'description' => $_, + my %cache = map { $_->categoryname => $_ } + qsearch( 'pkg_category', {disabled => 'Y'} ); + $cache{$_->categoryname} = $_ + foreach qsearch( 'pkg_category', {disabled => ''} ); + + push @$late, map { { 'description' => &{$escape}($_), 'subtotal' => $l{$_}, 'post_total' => 1, - } } sort keys %l; - - map { {'description' => $_, 'subtotal' => $s{$_}} } sort keys %s; + } } + sort { $cache{$a}->weight <=> $cache{$b}->weight } keys %l; + + map { { 'description' => &{$escape}($_), + 'subtotal' => $s{$_}, + 'summarized' => $not_tax{$_} ? '' : 'Y', + 'tax_section' => $not_tax{$_} ? '' : 'Y', + } } + sort { $cache{$a}->weight <=> $cache{$b}->weight } + ( $summarypage + ? ( grep { exists($s{$_}) || !$cache{$_}->disabled } keys %cache ) + : ( keys %s ) + ); } @@ -2792,22 +3282,33 @@ sub _items_cust_bill_pkg { my $format_function = $opt{format_function} || ''; my $unsquelched = $opt{unsquelched} || ''; my $section = $opt{section}->{description} if $opt{section}; + my $summary_page = $opt{summary_page} || ''; my @b = (); + my ($s, $r, $u) = ( undef, undef, undef ); foreach my $cust_bill_pkg ( @$cust_bill_pkg ) { + + foreach ( $s, $r, $u ) { + if ( $_ && !$cust_bill_pkg->hidden ) { + $_->{amount} = sprintf( "%.2f", $_->{amount} ), + $_->{unit_amount} = sprintf( "%.2f", $_->{unit_amount} ), + push @b, { %$_ }; + $_ = undef; + } + } + foreach my $display ( grep { defined($section) ? $_->section eq $section : 1 } + grep { $_->summary || !$summary_page } $cust_bill_pkg->cust_bill_pkg_display ) { my $type = $display->type; - my $cust_pkg = $cust_bill_pkg->cust_pkg; - my $desc = $cust_bill_pkg->desc; $desc = substr($desc, 0, 50). '...' if $format eq 'latex' && length($desc) > 50; @@ -2819,24 +3320,35 @@ sub _items_cust_bill_pkg { if ( $cust_bill_pkg->pkgnum > 0 ) { + my $cust_pkg = $cust_bill_pkg->cust_pkg; + if ( $cust_bill_pkg->setup != 0 && (!$type || $type eq 'S') ) { my $description = $desc; $description .= ' Setup' if $cust_bill_pkg->recur != 0; - my @d = map &{$escape_function}($_), - $cust_pkg->h_labels_short($self->_date); + my @d = (); + push @d, map &{$escape_function}($_), + $cust_pkg->h_labels_short($self->_date) + unless $cust_pkg->part_pkg->hide_svc_detail + || $cust_bill_pkg->hidden; push @d, $cust_bill_pkg->details(%details_opt) if $cust_bill_pkg->recur == 0; - push @b, { - description => $description, - #pkgpart => $part_pkg->pkgpart, - pkgnum => $cust_bill_pkg->pkgnum, - amount => sprintf("%.2f", $cust_bill_pkg->setup), - unit_amount => sprintf("%.2f", $cust_bill_pkg->unitsetup), - quantity => $cust_bill_pkg->quantity, - ext_description => \@d, + if ( $cust_bill_pkg->hidden ) { + $s->{amount} += $cust_bill_pkg->setup; + $s->{unit_amount} += $cust_bill_pkg->unitsetup; + push @{ $s->{ext_description} }, @d; + } else { + $s = { + description => $description, + #pkgpart => $part_pkg->pkgpart, + pkgnum => $cust_bill_pkg->pkgnum, + amount => $cust_bill_pkg->setup, + unit_amount => $cust_bill_pkg->unitsetup, + quantity => $cust_bill_pkg->quantity, + ext_description => \@d, + }; }; } @@ -2847,23 +3359,31 @@ sub _items_cust_bill_pkg { { my $is_summary = $display->summary; - my $description = $is_summary ? "Usage charges" : $desc; + my $description = ($is_summary && $type && $type eq 'U') + ? "Usage charges" : $desc; unless ( $conf->exists('disable_line_item_date_ranges') ) { $description .= " (" . time2str("%x", $cust_bill_pkg->sdate). " - ". time2str("%x", $cust_bill_pkg->edate). ")"; } + my @d = (); + #at least until cust_bill_pkg has "past" ranges in addition to #the "future" sdate/edate ones... see #3032 - my @d = (); + my @dates = ( $self->_date ); + my $prev = $cust_bill_pkg->previous_cust_bill_pkg; + push @dates, $prev->sdate if $prev; + push @d, map &{$escape_function}($_), - $cust_pkg->h_labels_short($self->_date) - #$cust_bill_pkg->edate, - #$cust_bill_pkg->sdate), - ; - - @d = () if ($cust_bill_pkg->itemdesc || $is_summary); + $cust_pkg->h_labels_short(@dates) + #$cust_bill_pkg->edate, + #$cust_bill_pkg->sdate) + unless $cust_pkg->part_pkg->hide_svc_detail + || $cust_bill_pkg->itemdesc + || $cust_bill_pkg->hidden + || $is_summary && $type && $type eq 'U'; + push @d, $cust_bill_pkg->details(%details_opt) unless ($is_summary || $type && $type eq 'R'); @@ -2876,17 +3396,45 @@ sub _items_cust_bill_pkg { $amount = $cust_bill_pkg->usage; } - push @b, { - description => $description, - #pkgpart => $part_pkg->pkgpart, - pkgnum => $cust_bill_pkg->pkgnum, - amount => sprintf("%.2f", $amount), - unit_amount => sprintf("%.2f", $cust_bill_pkg->unitrecur), - quantity => $cust_bill_pkg->quantity, - ext_description => \@d, - } unless ( $type eq 'U' && ! $amount ); + if ( !$type || $type eq 'R' ) { + + if ( $cust_bill_pkg->hidden ) { + $r->{amount} += $amount; + $r->{unit_amount} += $cust_bill_pkg->unitrecur; + push @{ $r->{ext_description} }, @d; + } else { + $r = { + description => $description, + #pkgpart => $part_pkg->pkgpart, + pkgnum => $cust_bill_pkg->pkgnum, + amount => $amount, + unit_amount => $cust_bill_pkg->unitrecur, + quantity => $cust_bill_pkg->quantity, + ext_description => \@d, + }; + } + + } elsif ( $amount ) { # && $type eq 'U' + + if ( $cust_bill_pkg->hidden ) { + $u->{amount} += $amount; + $u->{unit_amount} += $cust_bill_pkg->unitrecur; + push @{ $u->{ext_description} }, @d; + } else { + $u = { + description => $description, + #pkgpart => $part_pkg->pkgpart, + pkgnum => $cust_bill_pkg->pkgnum, + amount => $amount, + unit_amount => $cust_bill_pkg->unitrecur, + quantity => $cust_bill_pkg->quantity, + ext_description => \@d, + }; + } - } + } + + } # recurring or usage with recurring charge } else { #pkgnum tax or one-shot line item (??) @@ -2911,12 +3459,21 @@ sub _items_cust_bill_pkg { } + foreach ( $s, $r, $u ) { + if ( $_ ) { + $_->{amount} = sprintf( "%.2f", $_->{amount} ), + $_->{unit_amount} = sprintf( "%.2f", $_->{unit_amount} ), + push @b, { %$_ }; + } + } + @b; } sub _items_credits { - my $self = shift; + my( $self, %opt ) = @_; + my $trim_len = $opt{'trim_len'} || 60; my @b; #credits @@ -2924,10 +3481,10 @@ sub _items_credits { #something more elaborate if $_->amount ne $_->cust_credit->credited ? - my $reason = $_->cust_credit->reason; - #my $reason = substr($_->cust_credit->reason,0,32); - #$reason .= '...' if length($reason) < length($_->cust_credit->reason); + my $reason = substr($_->cust_credit->reason, 0, $trim_len); + $reason .= '...' if length($reason) < length($_->cust_credit->reason); $reason = " ($reason) " if $reason; + push @b, { #'description' => 'Credit ref\#'. $_->crednum. # " (". time2str("%x",$_->cust_credit->_date) .")". @@ -2937,12 +3494,6 @@ sub _items_credits { 'amount' => sprintf("%.2f",$_->amount), }; } - #foreach ( @cr_cust_credit ) { - # push @buf,[ - # "Credit #". $_->crednum. " (" . time2str("%x",$_->_date) .")", - # $money_char. sprintf("%10.2f",$_->credited) - # ]; - #} @b; @@ -2968,6 +3519,38 @@ sub _items_payments { } +=item call_details [ OPTION => VALUE ... ] + +Returns an array of CSV strings representing the call details for this invoice +The only option available is the boolean prepend_billed_number + +=cut + +sub call_details { + my ($self, %opt) = @_; + + my $format_function = sub { shift }; + + if ($opt{prepend_billed_number}) { + $format_function = sub { + my $detail = shift; + my $row = shift; + + $row->amount ? $row->phonenum. ",". $detail : '"Billed number",'. $detail; + + }; + } + + my @details = map { $_->details( 'format_function' => $format_function, + 'escape_function' => sub{ return() }, + ) + } + grep { $_->pkgnum } + $self->cust_bill_pkg; + my $header = $details[0]; + ( $header, grep { $_ ne $header } @details ); +} + =back diff --git a/FS/FS/cust_bill_ApplicationCommon.pm b/FS/FS/cust_bill_ApplicationCommon.pm index af7e087..7449679 100644 --- a/FS/FS/cust_bill_ApplicationCommon.pm +++ b/FS/FS/cust_bill_ApplicationCommon.pm @@ -1,7 +1,7 @@ package FS::cust_bill_ApplicationCommon; use strict; -use vars qw( @ISA $DEBUG $me ); +use vars qw( @ISA $DEBUG $me $skip_apply_to_lineitems_hack ); use List::Util qw(min); use FS::Schema qw( dbdef ); use FS::Record qw( qsearch qsearchs dbh ); @@ -11,6 +11,8 @@ use FS::Record qw( qsearch qsearchs dbh ); $DEBUG = 0; $me = '[FS::cust_bill_ApplicationCommon]'; +$skip_apply_to_lineitems_hack = 0; + =head1 NAME FS::cust_bill_ApplicationCommon - Base class for bill application classes @@ -54,7 +56,7 @@ sub insert { my $dbh = dbh; my $error = $self->SUPER::insert(@_) - || $self->apply_to_lineitems; + || $self->apply_to_lineitems(@_); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -111,10 +113,15 @@ Auto-applies this invoice application to specific line items, if possible. =cut sub apply_to_lineitems { - my $self = shift; + #my $self = shift; + my( $self, %options ) = @_; + + return '' if $skip_apply_to_lineitems_hack; my @apply = (); + my $conf = new FS::Conf; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -127,6 +134,8 @@ sub apply_to_lineitems { my $dbh = dbh; my @open = $self->cust_bill->open_cust_bill_pkg; #FOR UPDATE...? + @open = grep { $_->pkgnum == $self->pkgnum } @open + if $conf->exists('pkg-balances') && $self->pkgnum; warn "$me ". scalar(@open). " open line items for invoice ". $self->cust_bill->invnum. ": ". join(', ', @open). "\n" if $DEBUG; @@ -314,7 +323,7 @@ sub apply_to_lineitems { 'sdate' => $cust_bill_pkg->sdate, 'edate' => $cust_bill_pkg->edate, }); - my $error = $application->insert; + my $error = $application->insert(%options); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; diff --git a/FS/FS/cust_bill_pay.pm b/FS/FS/cust_bill_pay.pm index b7ba2b7..831d7f2 100644 --- a/FS/FS/cust_bill_pay.pm +++ b/FS/FS/cust_bill_pay.pm @@ -7,6 +7,7 @@ use FS::cust_main_Mixin; use FS::cust_bill_ApplicationCommon; use FS::cust_bill; use FS::cust_pay; +use FS::cust_pkg; @ISA = qw( FS::cust_main_Mixin FS::cust_bill_ApplicationCommon ); @@ -121,6 +122,7 @@ sub check { || $self->ut_foreign_key('invnum', 'cust_bill', 'invnum' ) || $self->ut_numbern('_date') || $self->ut_money('amount') + || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') ; return $error if $error; @@ -148,6 +150,25 @@ sub cust_pay { qsearchs( 'cust_pay', { 'paynum' => $self->paynum } ); } +=item send_receipt HASHREF | OPTION => VALUE ... + + +Sends a payment receipt for the associated payment, against this specific +invoice. If there is an error, returns the error, otherwise returns false. + +See L<FS::cust_pay/send_receipt>. + +=cut + +sub send_receipt { + my $self = shift; + my $opt = ref($_[0]) ? shift : { @_ }; + $self->cust_pay->send_receipt( + 'cust_bill' => $self->cust_bill, + %$opt, + ); +} + =back =head1 BUGS diff --git a/FS/FS/cust_bill_pay_pkg.pm b/FS/FS/cust_bill_pay_pkg.pm index cdbace9..48c4364 100644 --- a/FS/FS/cust_bill_pay_pkg.pm +++ b/FS/FS/cust_bill_pay_pkg.pm @@ -2,7 +2,10 @@ package FS::cust_bill_pay_pkg; use strict; use vars qw( @ISA ); +use FS::Conf; use FS::Record qw( qsearch qsearchs ); +use FS::cust_bill_pay; +use FS::cust_bill_pkg; @ISA = qw(FS::Record); @@ -77,7 +80,39 @@ otherwise returns false. =cut -# the insert method can be inherited from FS::Record +sub insert { + my($self, %options) = @_; + + #local $SIG{HUP} = 'IGNORE'; + #local $SIG{INT} = 'IGNORE'; + #local $SIG{QUIT} = 'IGNORE'; + #local $SIG{TERM} = 'IGNORE'; + #local $SIG{TSTP} = 'IGNORE'; + #local $SIG{PIPE} = 'IGNORE'; + # + #my $oldAutoCommit = $FS::UID::AutoCommit; + #local $FS::UID::AutoCommit = 0; + #my $dbh = dbh; + + my $error = $self->SUPER::insert; + if ( $error ) { + #$dbh->rollback if $oldAutoCommit; + return "error inserting $self: $error"; + } + + #payment receipt + my $conf = new FS::Conf; + my $trigger = $conf->config('payment_receipt-trigger') || 'cust_pay'; + if ( $trigger eq 'cust_bill_pay_pkg' ) { + my $error = $self->send_receipt( + 'manual' => $options{'manual'}, + ); + warn "can't send payment receipt/statement: $error" if $error; + } + + ''; + +} =item delete @@ -124,6 +159,47 @@ sub check { $self->SUPER::check; } +=item cust_bill_pay + +Returns the FS::cust_bill_pay object (payment application to the overall +invoice). + +=cut + +sub cust_bill_pay { + my $self = shift; + qsearchs('cust_bill_pay', { 'billpaynum' => $self->billpaynum } ); +} + +=item cust_bill_pkg + +Returns the FS::cust_bill_pkg object (line item to which payment is applied). + +=cut + +sub cust_bill_pkg { + my $self = shift; + qsearchs('cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum } ); +} + +=item send_receipt + +Sends a payment receipt for the associated payment, against this specific +invoice and packages. If there is an error, returns the error, otherwise +returns false. + +=cut + +sub send_receipt { + my $self = shift; + my $opt = ref($_[0]) ? shift : { @_ }; + $self->cust_bill_pay->send_receipt( + 'cust_pkg' => $self->cust_bill_pkg->cust_pkg, + %$opt, + ); +} + + =back =head1 BUGS diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index 6c0589a..d3bdfd1 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -1,7 +1,7 @@ package FS::cust_bill_pkg; use strict; -use vars qw( @ISA $DEBUG ); +use vars qw( @ISA $DEBUG $me ); use FS::Record qw( qsearch qsearchs dbdef dbh ); use FS::cust_main_Mixin; use FS::cust_pkg; @@ -12,10 +12,14 @@ use FS::cust_bill_pkg_display; use FS::cust_bill_pay_pkg; use FS::cust_credit_bill_pkg; use FS::cust_tax_exempt_pkg; +use FS::cust_bill_pkg_tax_location; +use FS::cust_bill_pkg_tax_rate_location; +use FS::cust_tax_adjustment; @ISA = qw( FS::cust_main_Mixin FS::Record ); -$DEBUG = 0; +$DEBUG = 2; +$me = '[FS::cust_bill_pkg]'; =head1 NAME @@ -40,28 +44,57 @@ supported: =over 4 -=item billpkgnum - primary key +=item billpkgnum -=item invnum - invoice (see L<FS::cust_bill>) +primary key -=item pkgnum - package (see L<FS::cust_pkg>) or 0 for the special virtual sales tax package, or -1 for the virtual line item (itemdesc is used for the line) +=item invnum -=item pkgpart_override - optional package definition (see L<FS::part_pkg>) override -=item setup - setup fee +invoice (see L<FS::cust_bill>) -=item recur - recurring fee +=item pkgnum -=item sdate - starting date of recurring fee +package (see L<FS::cust_pkg>) or 0 for the special virtual sales tax package, or -1 for the virtual line item (itemdesc is used for the line) -=item edate - ending date of recurring fee +=item pkgpart_override -=item itemdesc - Line item description (overrides normal package description) +optional package definition (see L<FS::part_pkg>) override -=item quantity - If not set, defaults to 1 +=item setup -=item unitsetup - If not set, defaults to setup +setup fee -=item unitrecur - If not set, defaults to recur +=item recur + +recurring fee + +=item sdate + +starting date of recurring fee + +=item edate + +ending date of recurring fee + +=item itemdesc + +Line item description (overrides normal package description) + +=item quantity + +If not set, defaults to 1 + +=item unitsetup + +If not set, defaults to setup + +=item unitrecur + +If not set, defaults to recur + +=item hidden + +If set to Y, indicates data should not appear as separate line item on invoice =back @@ -109,7 +142,7 @@ sub insert { return $error; } - if ( defined dbdef->table('cust_bill_pkg_detail') && $self->get('details') ) { + if ( $self->get('details') ) { foreach my $detail ( @{$self->get('details')} ) { my $cust_bill_pkg_detail = new FS::cust_bill_pkg_detail { 'billpkgnum' => $self->billpkgnum, @@ -117,22 +150,23 @@ sub insert { 'detail' => (ref($detail) ? $detail->[1] : $detail ), 'amount' => (ref($detail) ? $detail->[2] : '' ), 'classnum' => (ref($detail) ? $detail->[3] : '' ), + 'phonenum' => (ref($detail) ? $detail->[4] : '' ), }; $error = $cust_bill_pkg_detail->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "error inserting cust_bill_pkg_detail: $error"; } } } - if ( defined dbdef->table('cust_bill_pkg_display') && $self->get('display') ){ + if ( $self->get('display') ) { foreach my $cust_bill_pkg_display ( @{ $self->get('display') } ) { $cust_bill_pkg_display->billpkgnum($self->billpkgnum); $error = $cust_bill_pkg_display->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "error inserting cust_bill_pkg_display: $error"; } } } @@ -143,7 +177,7 @@ sub insert { $error = $cust_tax_exempt_pkg->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "error inserting cust_tax_exempt_pkg: $error"; } } } @@ -152,16 +186,36 @@ sub insert { if ( $tax_location ) { foreach my $cust_bill_pkg_tax_location ( @$tax_location ) { $cust_bill_pkg_tax_location->billpkgnum($self->billpkgnum); - warn $cust_bill_pkg_tax_location; $error = $cust_bill_pkg_tax_location->insert; - warn $error; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "error inserting cust_bill_pkg_tax_location: $error"; + } + } + } + + my $tax_rate_location = $self->get('cust_bill_pkg_tax_rate_location'); + if ( $tax_rate_location ) { + foreach my $cust_bill_pkg_tax_rate_location ( @$tax_rate_location ) { + $cust_bill_pkg_tax_rate_location->billpkgnum($self->billpkgnum); + $error = $cust_bill_pkg_tax_rate_location->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error inserting cust_bill_pkg_tax_rate_location: $error"; } } } + my $cust_tax_adjustment = $self->get('cust_tax_adjustment'); + if ( $cust_tax_adjustment ) { + $cust_tax_adjustment->billpkgnum($self->billpkgnum); + $error = $cust_tax_adjustment->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error replacing cust_tax_adjustment: $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -169,13 +223,65 @@ sub insert { =item delete -Currently unimplemented. I don't remove line items because there would then be -no record the items ever existed (which is bad, no?) +Not recommended. =cut sub delete { - return "Can't delete cust_bill_pkg records!"; + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $table (qw( + cust_bill_pkg_detail + cust_bill_pkg_display + cust_bill_pkg_tax_location + cust_bill_pkg_tax_rate_location + cust_tax_exempt_pkg + cust_bill_pay_pkg + cust_credit_bill_pkg + )) { + + foreach my $linked ( qsearch($table, { billpkgnum=>$self->billpkgnum }) ) { + my $error = $linked->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } + + foreach my $cust_tax_adjustment ( + qsearch('cust_tax_adjustment', { billpkgnum=>$self->billpkgnum }) + ) { + $cust_tax_adjustment->billpkgnum(''); #NULL + my $error = $cust_tax_adjustment->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $error = $self->SUPER::delete(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + } #alas, bin/follow-tax-rename @@ -211,6 +317,8 @@ sub check { || $self->ut_numbern('sdate') || $self->ut_numbern('edate') || $self->ut_textn('itemdesc') + || $self->ut_textn('itemcomment') + || $self->ut_enum('hidden', [ '', 'Y' ]) ; return $error if $error; @@ -234,6 +342,7 @@ Returns the package (see L<FS::cust_pkg>) for this invoice line item. sub cust_pkg { my $self = shift; + #warn "$me $self -> cust_pkg"; #carp? qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); } @@ -248,7 +357,10 @@ sub part_pkg { if ( $self->pkgpart_override ) { qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart_override } ); } else { - $self->cust_pkg->part_pkg; + my $part_pkg; + my $cust_pkg = $self->cust_pkg; + $part_pkg = $cust_pkg->part_pkg if $cust_pkg; + $part_pkg; } } @@ -263,6 +375,24 @@ sub cust_bill { qsearchs( 'cust_bill', { 'invnum' => $self->invnum } ); } +=item previous_cust_bill_pkg + +Returns the previous cust_bill_pkg for this package, if any. + +=cut + +sub previous_cust_bill_pkg { + my $self = shift; + return unless $self->sdate; + qsearchs({ + 'table' => 'cust_bill_pkg', + 'hashref' => { 'pkgnum' => $self->pkgnum, + 'sdate' => { op=>'<', value=>$self->sdate }, + }, + 'order_by' => 'ORDER BY sdate DESC LIMIT 1', + }); +} + =item details [ OPTION => VALUE ... ] Returns an array of detail information for the invoice line item. @@ -325,7 +455,7 @@ sub details { $format_sub = $opt{format_function} if $opt{format_function}; map { ( $_->format eq 'C' - ? &{$format_sub}( $_->detail ) + ? &{$format_sub}( $_->detail, $_ ) : &{$escape_function}( $_->detail ) ) } @@ -351,7 +481,9 @@ sub desc { if ( $self->pkgnum > 0 ) { $self->itemdesc || $self->part_pkg->pkg; } else { - $self->itemdesc || 'Tax'; + my $desc = $self->itemdesc || 'Tax'; + $desc .= ' '. $self->itemcomment if $self->itemcomment =~ /\S/; + $desc; } } diff --git a/FS/FS/cust_bill_pkg_detail.pm b/FS/FS/cust_bill_pkg_detail.pm index 8a48888..f8c9d1a 100644 --- a/FS/FS/cust_bill_pkg_detail.pm +++ b/FS/FS/cust_bill_pkg_detail.pm @@ -1,9 +1,10 @@ package FS::cust_bill_pkg_detail; use strict; -use vars qw( @ISA $me $DEBUG ); -use FS::Record qw( qsearch qsearchs dbdef ); +use vars qw( @ISA $me $DEBUG %GetInfoType ); +use FS::Record qw( qsearch qsearchs dbdef dbh ); use FS::cust_bill_pkg; +use FS::Conf; @ISA = qw(FS::Record); $me = '[ FS::cust_bill_pkg_detail ]'; @@ -102,10 +103,27 @@ and replace methods. sub check { my $self = shift; + my $conf = new FS::Conf; + + my $phonenum = $self->phonenum; + my $phonenum_check_method; + if ( $conf->exists('svc_phone-allow_alpha_phonenum') ) { + $phonenum =~ s/\W//g; + $phonenum_check_method = 'ut_alphan'; + } else { + $phonenum =~ s/\D//g; + $phonenum_check_method = 'ut_numbern'; + } + $self->phonenum($phonenum); + $self->ut_numbern('detailnum') || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum') + #|| $self->ut_moneyn('amount') + || $self->ut_floatn('amount') || $self->ut_enum('format', [ '', 'C' ] ) || $self->ut_text('detail') + || $self->ut_foreign_keyn('classnum', 'usage_class', 'classnum') + || $self->$phonenum_check_method('phonenum') || $self->SUPER::check ; @@ -121,6 +139,79 @@ sub _upgrade_data { # class method warn "$me upgrading $class\n" if $DEBUG; + my $columndef = dbdef->table($class->table)->column('classnum'); + unless ($columndef->type eq 'int4') { + + my $dbh = dbh; + if ( $dbh->{Driver}->{Name} eq 'Pg' ) { + + eval "use DBI::Const::GetInfoType;"; + die $@ if $@; + + my $major_version = 0; + $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/ + && ( $major_version = sprintf("%d", $1) ); + + if ( $major_version > 7 ) { + + # ideally this would be supported in DBIx-DBSchema and friends + + foreach my $table ( qw( cust_bill_pkg_detail h_cust_bill_pkg_detail ) ){ + + warn "updating $table column classnum to integer\n" if $DEBUG; + my $sql = "ALTER TABLE $table ALTER classnum TYPE int USING ". + "int4(classnum)"; + my $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute or die $sth->errstr; + + } + + } elsif ( $dbh->{pg_server_version} =~ /^704/ ) { # earlier? + + # ideally this would be supported in DBIx-DBSchema and friends + + # XXX_FIXME better locking + + foreach my $table ( qw( cust_bill_pkg_detail h_cust_bill_pkg_detail ) ){ + + warn "updating $table column classnum to integer\n" if $DEBUG; + + my $sql = "ALTER TABLE $table RENAME classnum TO old_classnum"; + my $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute or die $sth->errstr; + + my $def = dbdef->table($table)->column('classnum'); + $def->type('integer'); + $def->length(''); + $sql = "ALTER TABLE $table ADD COLUMN ". $def->line($dbh); + $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute or die $sth->errstr; + + $sql = "UPDATE $table SET classnum = int4( text( old_classnum ) )"; + $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute or die $sth->errstr; + + $sql = "ALTER TABLE $table DROP old_classnum"; + $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute or die $sth->errstr; + + } + + } else { + + die "cust_bill_pkg_detail classnum upgrade unsupported for this Pg version\n"; + + } + + } else { + + die "cust_bill_pkg_detail classnum upgrade only supported for Pg 8+\n"; + + } + + } + + if ( defined( dbdef->table($class->table)->column('billpkgnum') ) && defined( dbdef->table($class->table)->column('invnum') ) && defined( dbdef->table($class->table)->column('pkgnum') ) diff --git a/FS/FS/cust_bill_pkg_display.pm b/FS/FS/cust_bill_pkg_display.pm index 93c6e87..cf70cbd 100644 --- a/FS/FS/cust_bill_pkg_display.pm +++ b/FS/FS/cust_bill_pkg_display.pm @@ -52,7 +52,12 @@ sub section { if ( defined($value) ) { $self->setfield('section', $value); } else { - $self->getfield('section') || $self->cust_bill_pkg->part_pkg->categoryname; + my $section = $self->getfield('section'); + unless ($section) { + my $part_pkg = $self->cust_bill_pkg->part_pkg; + $section = $part_pkg->categoryname if $part_pkg; + } + $section; } } diff --git a/FS/FS/cust_bill_pkg_tax_rate_location.pm b/FS/FS/cust_bill_pkg_tax_rate_location.pm new file mode 100644 index 0000000..fc5734f --- /dev/null +++ b/FS/FS/cust_bill_pkg_tax_rate_location.pm @@ -0,0 +1,136 @@ +package FS::cust_bill_pkg_tax_rate_location; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); +use FS::cust_bill_pkg; +use FS::cust_pkg; +use FS::cust_location; + +=head1 NAME + +FS::cust_bill_pkg_tax_rate_location - Object methods for cust_bill_pkg_tax_rate_location records + +=head1 SYNOPSIS + + use FS::cust_bill_pkg_tax_rate_location; + + $record = new FS::cust_bill_pkg_tax_rate_location \%hash; + $record = new FS::cust_bill_pkg_tax_rate_location { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_bill_pkg_tax_rate_location object represents an record of taxation +based on package location. FS::cust_bill_pkg_tax_rate_location inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item billpkgtaxratelocationnum + +billpkgtaxratelocationnum + +=item billpkgnum + +billpkgnum + +=item taxnum + +taxnum + +=item taxtype + +taxtype + +=item locationtaxid + +locationtaxid + +=item taxratelocationnum + +taxratelocationnum + +=item amount + +amount + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +sub table { 'cust_bill_pkg_tax_rate_location'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. + +=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. + +=item check + +Checks all fields to make sure this is a valid record. 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('billpkgtaxratelocationnum') + || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum' ) + || $self->ut_number('taxnum') #cust_bill_pkg/tax_rate key, based on taxtype + || $self->ut_enum('taxtype', [ qw( FS::cust_main_county FS::tax_rate ) ] ) + || $self->ut_textn('locationtaxid') + || $self->ut_foreign_key('taxratelocationnum', 'tax_rate_location', 'taxratelocationnum' ) + || $self->ut_money('amount') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 47a8119..6c3effa 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -8,6 +8,7 @@ use FS::Misc qw(send_email); use FS::Record qw( qsearch qsearchs dbdef ); use FS::cust_main_Mixin; use FS::cust_main; +use FS::cust_pkg; use FS::cust_refund; use FS::cust_credit_bill; use FS::part_pkg; @@ -95,6 +96,10 @@ Text Books closed flag, empty or `Y' +=item pkgnum + +Desired pkgnum when using experimental package balances. + =back =head1 METHODS @@ -295,6 +300,7 @@ sub check { || $self->ut_foreign_key('reasonnum', 'reason', 'reasonnum') || $self->ut_textn('addlinfo') || $self->ut_enum('closed', [ '', 'Y' ]) + || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') ; return $error if $error; diff --git a/FS/FS/cust_credit_bill.pm b/FS/FS/cust_credit_bill.pm index 375c885..900a5c0 100644 --- a/FS/FS/cust_credit_bill.pm +++ b/FS/FS/cust_credit_bill.pm @@ -8,6 +8,7 @@ use FS::cust_main_Mixin; use FS::cust_bill_ApplicationCommon; use FS::cust_bill; use FS::cust_credit; +use FS::cust_pkg; @ISA = qw( FS::cust_main_Mixin FS::cust_bill_ApplicationCommon ); @@ -122,6 +123,7 @@ sub check { || $self->ut_foreign_key('invnum', 'cust_bill', 'invnum' ) || $self->ut_numbern('_date') || $self->ut_money('amount') + || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') ; return $error if $error; diff --git a/FS/FS/cust_event.pm b/FS/FS/cust_event.pm index 5ca8167..10fb0ac 100644 --- a/FS/FS/cust_event.pm +++ b/FS/FS/cust_event.pm @@ -1,7 +1,7 @@ package FS::cust_event; use strict; -use vars qw( @ISA $DEBUG ); +use vars qw( @ISA $DEBUG $me ); use Carp qw( croak confess ); use FS::Record qw( qsearch qsearchs dbdef ); use FS::cust_main_Mixin; @@ -14,6 +14,7 @@ use FS::cust_bill; @ISA = qw(FS::cust_main_Mixin FS::Record); $DEBUG = 0; +$me = '[FS::cust_event]'; =head1 NAME @@ -295,6 +296,100 @@ sub retriable { $self->replace($old); } +=item join_cust_sql + +=cut + +sub join_sql { + #my $class = shift; + + " + JOIN part_event USING ( eventpart ) + LEFT JOIN cust_bill ON ( eventtable = 'cust_bill' AND tablenum = invnum ) + LEFT JOIN cust_pkg ON ( eventtable = 'cust_pkg' AND tablenum = pkgnum ) + LEFT JOIN cust_main ON ( ( eventtable = 'cust_main' AND tablenum = cust_main.custnum ) + OR ( eventtable = 'cust_bill' AND cust_bill.custnum = cust_main.custnum ) + OR ( eventtable = 'cust_pkg' AND cust_pkg.custnum = cust_main.custnum ) + ) + "; + +} + +=item search_sql HASHREF + +Class method which returns an SQL WHERE fragment to search for parameters +specified in HASHREF. Valid parameters are + +=over 4 + +=item + +=item + +=back + +=cut + +#Note: validates all passed-in data; i.e. safe to use with unchecked CGI params. +#sub + +sub search_sql { + my($class, $param) = @_; + if ( $DEBUG ) { + warn "$me search_sql called with params: \n". + join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n"; + } + + my @search = (); + + if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) { + push @search, "cust_main.agentnum = $1"; + #my $agent = qsearchs('agent', { 'agentnum' => $1 } ); + #die "unknown agentnum $1" unless $agent; + } + + if ( $param->{'beginning'} =~ /^(\d+)$/ ) { + push @search, "cust_event._date >= $1"; + } + if ( $param->{'ending'} =~ /^(\d+)$/ ) { + push @search, "cust_event._date <= $1"; + } + + if ( $param->{'failed'} ) { + push @search, "statustext != ''", + "statustext IS NOT NULL", + "statustext != 'N/A'"; + } + + #if ( $param->{'part_event.payby'} =~ /^(\w+)$/ ) { + # push @search, "part_event.payby = '$1'"; + #} + + if ( $param->{'custnum'} =~ /^(\d+)$/ ) { + push @search, "cust_main.custnum = '$1'"; + } + + if ( $param->{'invnum'} =~ /^(\d+)$/ ) { + push @search, "part_event.eventtable = 'cust_bill'", + "tablenum = '$1'"; + } + + if ( $param->{'pkgnum'} =~ /^(\d+)$/ ) { + push @search, "part_event.eventtable = 'cust_pkg'", + "tablenum = '$1'"; + } + + #here is the agent virtualization + push @search, + $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' ); + + my $where = 'WHERE '. join(' AND ', @search ); + + + join(' AND ', @search ); + +} + =back =head1 SUBROUTINES @@ -336,42 +431,43 @@ sub process_re_X { re_X( $method, - $param->{'beginning'}, - $param->{'ending'}, - $param->{'failed'}, + $param, $job, ); } -#this needs some updating based on the 1.7 cust_bill_event.pm still, i think sub re_X { - my($method, $beginning, $ending, $failed, $job) = @_; + my($method, $param, $job) = @_; + + my $search_sql = FS::cust_event->search_sql($param); - my $from = 'LEFT JOIN part_event USING ( eventpart )'; + #maybe not...? we do want the "re-" action to match the search more closely + # # yuck! hardcoded *AND* sequential scans! + #my $where = " WHERE action LIKE 'cust_bill_send%' ". + # ( $search_sql ? " AND $search_sql" : "" ); - # 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 $where = ( $search_sql ? " WHERE $search_sql" : "" ); my @cust_event = qsearch({ 'table' => 'cust_event', - 'addl_from' => $from, + 'addl_from' => FS::cust_event->join_sql(), 'hashref' => {}, 'extra_sql' => $where, }); + warn "$me re_X found ". scalar(@cust_event). " events\n" + if $DEBUG; + 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 - ); + my $cust_X = $cust_event->cust_X; # cust_bill + next unless $cust_X->can($method); + + $cust_X->$method( $cust_event->part_event->templatename + || $cust_X->agent_template + ); if ( $job ) { #progressbar foo $num++; diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 865632f..c83acc6 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -9,6 +9,7 @@ use Safe; use Carp; use Exporter; use Scalar::Util qw( blessed ); +use List::Util qw( min ); use Time::Local qw(timelocal); use Data::Dumper; use Tie::IxHash; @@ -23,12 +24,14 @@ use FS::UID qw( getotaker dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef ); use FS::Misc qw( generate_email send_email generate_ps do_print ); use FS::Msgcat qw(gettext); +use FS::payby; use FS::cust_pkg; use FS::cust_svc; use FS::cust_bill; use FS::cust_bill_pkg; use FS::cust_bill_pkg_display; use FS::cust_bill_pkg_tax_location; +use FS::cust_bill_pkg_tax_rate_location; use FS::cust_pay; use FS::cust_pay_pending; use FS::cust_pay_void; @@ -38,7 +41,10 @@ use FS::cust_refund; use FS::part_referral; use FS::cust_main_county; use FS::cust_location; +use FS::cust_main_exemption; +use FS::cust_tax_adjustment; use FS::tax_rate; +use FS::tax_rate_location; use FS::cust_tax_location; use FS::part_pkg_taxrate; use FS::agent; @@ -75,6 +81,8 @@ $skip_fuzzyfiles = 0; $ignore_expired_card = 0; @encrypted_fields = ('payinfo', 'paycvv'); +sub nohistory_fields { ('paycvv'); } + @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings'); #ask FS::UID to run this stuff for us later @@ -358,7 +366,7 @@ invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); -Currently available options are: I<depend_jobnum> and I<noexport>. +Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>. If I<depend_jobnum> is set, all provisioning jobs will have a dependancy on the supplied jobnum (they will not run until the specific job completes). @@ -369,6 +377,9 @@ The I<noexport> option is deprecated. If I<noexport> is set true, no provisioning jobs (exports) are scheduled. (You can schedule them later with the B<reexport> method.) +The I<tax_exemption> option can be set to an arrayref of tax names. +FS::cust_main_exemption records will be created and inserted. + =cut sub insert { @@ -392,7 +403,7 @@ sub insert { my $dbh = dbh; my $prepay_identifier = ''; - my( $amount, $seconds ) = ( 0, 0 ); + my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0); my $payby = ''; if ( $self->payby eq 'PREPAY' ) { @@ -403,7 +414,13 @@ sub insert { warn " looking up prepaid card $prepay_identifier\n" if $DEBUG > 1; - my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds); + my $error = $self->get_prepay( $prepay_identifier, + 'amount_ref' => \$amount, + 'seconds_ref' => \$seconds, + 'upbytes_ref' => \$upbytes, + 'downbytes_ref' => \$downbytes, + 'totalbytes_ref' => \$totalbytes, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; #return "error applying prepaid card (transaction rolled back): $error"; @@ -448,6 +465,24 @@ sub insert { $self->invoicing_list( $invoicing_list ); } + warn " setting cust_main_exemption\n" + if $DEBUG > 1; + + my $tax_exemption = delete $options{'tax_exemption'}; + if ( $tax_exemption ) { + foreach my $taxname ( @$tax_exemption ) { + my $cust_main_exemption = new FS::cust_main_exemption { + 'custnum' => $self->custnum, + 'taxname' => $taxname, + }; + my $error = $cust_main_exemption->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_main_exemption (transaction rolled back): $error"; + } + } + } + if ( $conf->config('cust_main-skeleton_tables') && $conf->config('cust_main-skeleton_custnum') ) { @@ -465,7 +500,13 @@ sub insert { warn " ordering packages\n" if $DEBUG > 1; - $error = $self->order_pkgs($cust_pkgs, \$seconds, %options); + $error = $self->order_pkgs( $cust_pkgs, + %options, + 'seconds_ref' => \$seconds, + 'upbytes_ref' => \$upbytes, + 'downbytes_ref' => \$downbytes, + 'totalbytes_ref' => \$totalbytes, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -475,6 +516,10 @@ sub insert { $dbh->rollback if $oldAutoCommit; return "No svc_acct record to apply pre-paid time"; } + if ( $upbytes || $downbytes || $totalbytes ) { + $dbh->rollback if $oldAutoCommit; + return "No svc_acct record to apply pre-paid data"; + } if ( $amount ) { warn " inserting initial $payby payment of $amount\n" @@ -688,6 +733,14 @@ jobs will have a dependancy on the supplied job (they will not run until the specific job completes). This can be used to defer provisioning until some action completes (such as running the customer's credit card successfully). +=item ticket_subject + +Optional subject for a ticket created and attached to this customer + +=item ticket_subject + +Optional queue name for ticket additions + =back =cut @@ -701,13 +754,15 @@ sub order_pkg { if $DEBUG; my $cust_pkg = $opt->{'cust_pkg'}; - my $seconds = $opt->{'seconds'}; my $svcs = $opt->{'svcs'} || []; my %svc_options = (); $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'} if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'}; + my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () } + qw( ticket_subject ticket_queue ); + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -731,7 +786,7 @@ sub order_pkg { $cust_pkg->custnum( $self->custnum ); - my $error = $cust_pkg->insert; + my $error = $cust_pkg->insert( %insert_params ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "inserting cust_pkg (transaction rolled back): $error"; @@ -745,9 +800,12 @@ sub order_pkg { $error = $new_cust_svc->replace($old_cust_svc); } else { $svc_something->pkgnum( $cust_pkg->pkgnum ); - if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) { - $svc_something->seconds( $svc_something->seconds + $$seconds ); - $$seconds = 0; + if ( $svc_something->isa('FS::svc_acct') ) { + foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } } + qw( seconds upbytes downbytes totalbytes ) ) { + $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } ); + ${ $opt->{$_.'_ref'} } = 0; + } } $error = $svc_something->insert(%svc_options); } @@ -762,7 +820,8 @@ sub order_pkg { } -=item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ] +#deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ] +=item order_pkgs HASHREF [ , OPTION => VALUE ... ] Like the insert method on an existing record, this method orders multiple packages and included services atomicaly. Pass a Tie::RefHash data structure @@ -776,12 +835,13 @@ example: $cust_pkg => [ $svc_acct ], ... ); - $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 ); + $cust_main->order_pkgs( \%hash, 'noexport'=>1 ); Services can be new, in which case they are inserted, or existing unaudited services, in which case they are linked to the newly-created package. -Currently available options are: I<depend_jobnum> and I<noexport>. +Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>, +I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>. If I<depend_jobnum> is set, all provisioning jobs will have a dependancy on the supplied jobnum (they will not run until the specific job completes). @@ -794,13 +854,18 @@ the B<reexport> method for each cust_pkg object. Using the B<reexport> method on the cust_main object is not recommended, as existing services will also be reexported.) +If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is +provided, the scalars (provided by references) will be incremented by the +values of the prepaid card.` + =cut sub order_pkgs { my $self = shift; my $cust_pkgs = shift; - my $seconds = shift; + my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated my %options = @_; + $seconds_ref ||= $options{'seconds_ref'}; warn "$me order_pkgs called with options ". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" @@ -821,11 +886,14 @@ sub order_pkgs { foreach my $cust_pkg ( keys %$cust_pkgs ) { - my $error = $self->order_pkg( 'cust_pkg' => $cust_pkg, - 'svcs' => $cust_pkgs->{$cust_pkg}, - 'seconds' => $seconds, - 'depend_jobnum' => $options{'depend_jobnum'}, - ); + my $error = $self->order_pkg( + 'cust_pkg' => $cust_pkg, + 'svcs' => $cust_pkgs->{$cust_pkg}, + 'seconds_ref' => $seconds_ref, + map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref + depend_jobnum + ) + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -844,13 +912,14 @@ L<FS::prepay_credit>), specified either by I<identifier> or as an FS::prepay_credit object. If there is an error, returns the error, otherwise returns false. -Optionally, four scalar references can be passed as well. They will have their -values filled in with the amount, number of seconds, and number of upload and -download bytes applied by this prepaid -card. +Optionally, five scalar references can be passed as well. They will have their +values filled in with the amount, number of seconds, and number of upload, +download, and total bytes applied by this prepaid card. =cut +#the ref bullshit here should be refactored like get_prepay. MyAccount.pm is +#the only place that uses these args sub recharge_prepay { my( $self, $prepay_credit, $amountref, $secondsref, $upbytesref, $downbytesref, $totalbytesref ) = @_; @@ -868,8 +937,13 @@ sub recharge_prepay { my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 ); - my $error = $self->get_prepay($prepay_credit, \$amount, - \$seconds, \$upbytes, \$downbytes, \$totalbytes) + my $error = $self->get_prepay( $prepay_credit, + 'amount_ref' => \$amount, + 'seconds_ref' => \$seconds, + 'upbytes_ref' => \$upbytes, + 'downbytes_ref' => \$downbytes, + 'totalbytes_ref' => \$totalbytes, + ) || $self->increment_seconds($seconds) || $self->increment_upbytes($upbytes) || $self->increment_downbytes($downbytes) @@ -896,13 +970,13 @@ sub recharge_prepay { } -=item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF +=item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ] Looks up and deletes a prepaid card (see L<FS::prepay_credit>), specified either by I<identifier> or as an FS::prepay_credit object. -References to I<amount> and I<seconds> scalars should be passed as arguments -and will be incremented by the values of the prepaid card. +Available options are: I<amount_ref>, I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>. The scalars (provided by references) will be +incremented by the values of the prepaid card. If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to check or set this customer's I<agentnum>. @@ -913,8 +987,7 @@ If there is an error, returns the error, otherwise returns false. sub get_prepay { - my( $self, $prepay_credit, $amountref, $secondsref, - $upref, $downref, $totalref) = @_; + my( $self, $prepay_credit, %opt ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -959,11 +1032,8 @@ sub get_prepay { return "removing prepay_credit (transaction rolled back): $error"; } - $$amountref += $prepay_credit->amount; - $$secondsref += $prepay_credit->seconds; - $$upref += $prepay_credit->upbytes; - $$downref += $prepay_credit->downbytes; - $$totalref += $prepay_credit->totalbytes; + ${ $opt{$_.'_ref'} } += $prepay_credit->$_() + for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes ); $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -1249,6 +1319,16 @@ sub delete { } } + foreach my $cust_main_exemption ( + qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } ) + ) { + my $error = $cust_main_exemption->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + my $error = $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -1260,7 +1340,8 @@ sub delete { } -=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] +=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ] + Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. @@ -1272,6 +1353,11 @@ check_invoicing_list first. Here's an example: $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] ); +Currently available options are: I<tax_exemption>. + +The I<tax_exemption> option can be set to an arrayref of tax names. +FS::cust_main_exemption records will be deleted and inserted as appropriate. + =cut sub replace { @@ -1318,7 +1404,7 @@ sub replace { return $error; } - if ( @param ) { # INVOICING_LIST_ARYREF + if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF my $invoicing_list = shift @param; $error = $self->check_invoicing_list( $invoicing_list ); if ( $error ) { @@ -1328,6 +1414,40 @@ sub replace { $self->invoicing_list( $invoicing_list ); } + my %options = @param; + + my $tax_exemption = delete $options{'tax_exemption'}; + if ( $tax_exemption ) { + + my %cust_main_exemption = + map { $_->taxname => $_ } + qsearch('cust_main_exemption', { 'custnum' => $old->custnum } ); + + foreach my $taxname ( @$tax_exemption ) { + + next if delete $cust_main_exemption{$taxname}; + + my $cust_main_exemption = new FS::cust_main_exemption { + 'custnum' => $self->custnum, + 'taxname' => $taxname, + }; + my $error = $cust_main_exemption->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_main_exemption (transaction rolled back): $error"; + } + } + + foreach my $cust_main_exemption ( values %cust_main_exemption ) { + my $error = $cust_main_exemption->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "deleting cust_main_exemption (transaction rolled back): $error"; + } + } + + } + if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ && grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { # card/check/lec info has changed, want to retry realtime_ invoice events @@ -1433,6 +1553,7 @@ sub check { || $self->ut_textn('stateid_state') || $self->ut_textn('invoice_terms') || $self->ut_alphan('geocode') + || $self->ut_floatn('cdr_termination_percentage') ; #barf. need message catalogs. i18n. etc. @@ -1450,6 +1571,13 @@ sub check { unless ! $self->referral_custnum || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } ); + if ( $self->censustract ne '' ) { + $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/ + or return "Illegal census tract: ". $self->censustract; + + $self->censustract("$1.$2"); + } + if ( $self->ss eq '' ) { $self->ss(''); } else { @@ -1717,6 +1845,8 @@ sub check { my( $m, $y ); if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) { ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" ); + } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { + ( $m, $y ) = ( $2, "19$1" ); } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { ( $m, $y ) = ( $3, "20$2" ); } else { @@ -1741,7 +1871,7 @@ sub check { $self->payname($1); } - foreach my $flag (qw( tax spool_cdr squelch_cdr )) { + foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) { $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag(); $self->$flag($1); } @@ -1778,7 +1908,7 @@ sub has_ship_address { scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields ); } -=item all_pkgs +=item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all packages (see L<FS::cust_pkg>) for this customer. @@ -1786,14 +1916,15 @@ Returns all packages (see L<FS::cust_pkg>) for this customer. sub all_pkgs { my $self = shift; + my $extra_qsearch = ref($_[0]) ? shift : {}; - return $self->num_pkgs unless wantarray; + return $self->num_pkgs unless wantarray || keys(%$extra_qsearch); my @cust_pkg = (); if ( $self->{'_pkgnum'} ) { @cust_pkg = values %{ $self->{'_pkgnum'}->cache }; } else { - @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); + @cust_pkg = $self->_cust_pkg($extra_qsearch); } sort sort_packages @cust_pkg; @@ -1820,7 +1951,7 @@ sub cust_location { qsearch('cust_location', { 'custnum' => $self->custnum } ); } -=item ncancelled_pkgs +=item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer. @@ -1828,6 +1959,7 @@ Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer. sub ncancelled_pkgs { my $self = shift; + my $extra_qsearch = ref($_[0]) ? shift : {}; return $self->num_ncancelled_pkgs unless wantarray; @@ -1846,33 +1978,56 @@ sub ncancelled_pkgs { $self->custnum. "\n" if $DEBUG > 1; - @cust_pkg = - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => '', - }); - push @cust_pkg, - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => 0, - }); + $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) '; + + @cust_pkg = $self->_cust_pkg($extra_qsearch); + } sort sort_packages @cust_pkg; } +sub _cust_pkg { + my $self = shift; + my $extra_qsearch = ref($_[0]) ? shift : {}; + + $extra_qsearch->{'select'} ||= '*'; + $extra_qsearch->{'select'} .= + ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum ) + AS _num_cust_svc'; + + map { + $_->{'_num_cust_svc'} = $_->get('_num_cust_svc'); + $_; + } + qsearch({ + %$extra_qsearch, + 'table' => 'cust_pkg', + 'hashref' => { 'custnum' => $self->custnum }, + }); + +} + # This should be generalized to use config options to determine order. sub sort_packages { - if ( $a->get('cancel') and $b->get('cancel') ) { - $a->pkgnum <=> $b->pkgnum; - } elsif ( $a->get('cancel') or $b->get('cancel') ) { + + if ( $a->get('cancel') xor $b->get('cancel') ) { return -1 if $b->get('cancel'); return 1 if $a->get('cancel'); + #shouldn't get here... return 0; } else { - $a->pkgnum <=> $b->pkgnum; + my $a_num_cust_svc = $a->num_cust_svc; + my $b_num_cust_svc = $b->num_cust_svc; + return 0 if !$a_num_cust_svc && !$b_num_cust_svc; + return -1 if $a_num_cust_svc && !$b_num_cust_svc; + return 1 if !$a_num_cust_svc && $b_num_cust_svc; + my @a_cust_svc = $a->cust_svc; + my @b_cust_svc = $b->cust_svc; + $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label; } + } =item suspended_pkgs @@ -1912,6 +2067,18 @@ sub unsuspended_pkgs { grep { ! $_->susp } $self->ncancelled_pkgs; } +=item next_bill_date + +Returns the next date this customer will be billed, as a UNIX timestamp, or +undef if no active package has a next bill date. + +=cut + +sub next_bill_date { + my $self = shift; + min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs ); +} + =item num_cancelled_pkgs Returns the number of cancelled packages (see L<FS::cust_pkg>) for this @@ -2043,12 +2210,16 @@ Available options are: =item ban - can be set true to ban this customer's credit card or ACH information, if present. +=item nobill - can be set true to skip billing if it might otherwise be done. + =back Always returns a list: an empty list on success or a list of errors. =cut +# nb that dates are not specified as valid options to this method + sub cancel { my( $self, %opt ) = @_; @@ -2074,6 +2245,13 @@ sub cancel { my @pkgs = $self->ncancelled_pkgs; + if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) { + $opt{nobill} = 1; + my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 ); + warn "Error billing during cancel, custnum ". $self->custnum. ": $error" + if $error; + } + warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/". scalar(@pkgs). " packages for customer ". $self->custnum. "\n" if $DEBUG; @@ -2162,23 +2340,45 @@ Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in opt =back +Options are passed to the B<bill> and B<collect> methods verbatim, so all +options of those methods are also available. + =cut sub bill_and_collect { my( $self, %options ) = @_; - ### - # cancel packages - ### - #$options{actual_time} not $options{time} because freeside-daily -d is for #pre-printing invoices - my @cancel_pkgs = grep { $_->expire && $_->expire <= $options{actual_time} } - $self->ncancelled_pkgs; + $self->cancel_expired_pkgs( $options{actual_time} ); + $self->suspend_adjourned_pkgs( $options{actual_time} ); + + my $error = $self->bill( %options ); + warn "Error billing, custnum ". $self->custnum. ": $error" if $error; + + $self->apply_payments_and_credits; + + unless ( $conf->exists('cancelled_cust-noevents') + && ! $self->num_ncancelled_pkgs + ) { + + $error = $self->collect( %options ); + warn "Error collecting, custnum". $self->custnum. ": $error" if $error; + + } + +} + +sub cancel_expired_pkgs { + my ( $self, $time ) = @_; + + my @cancel_pkgs = $self->ncancelled_pkgs( { + 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time " + } ); foreach my $cust_pkg ( @cancel_pkgs ) { my $cpr = $cust_pkg->last_cust_pkg_reason('expire'); - my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum, + my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum, 'reason_otaker' => $cpr->otaker ) : () @@ -2188,24 +2388,32 @@ sub bill_and_collect { if $error; } - ### - # suspend packages - ### +} - #$options{actual_time} not $options{time} because freeside-daily -d is for - #pre-printing invoices - my @susp_pkgs = - grep { ! $_->susp - && ( ( $_->part_pkg->is_prepaid - && $_->bill - && $_->bill < $options{actual_time} - ) - || ( $_->adjourn - && $_->adjourn <= $options{actual_time} - ) - ) +sub suspend_adjourned_pkgs { + my ( $self, $time ) = @_; + + my @susp_pkgs = $self->ncancelled_pkgs( { + 'extra_sql' => + " AND ( susp IS NULL OR susp = 0 ) + AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time ) + OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time ) + ) + ", + } ); + + #only because there's no SQL test for is_prepaid :/ + @susp_pkgs = + grep { ( $_->part_pkg->is_prepaid + && $_->bill + && $_->bill < $time + ) + || ( $_->adjourn + && $_->adjourn <= $time + ) + } - $self->ncancelled_pkgs; + @susp_pkgs; foreach my $cust_pkg ( @susp_pkgs ) { my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn') @@ -2221,18 +2429,6 @@ sub bill_and_collect { if $error; } - ### - # bill and collect - ### - - my $error = $self->bill( %options ); - warn "Error billing, custnum ". $self->custnum. ": $error" if $error; - - $self->apply_payments_and_credits; - - $error = $self->collect( %options ); - warn "Error collecting, custnum". $self->custnum. ": $error" if $error; - } =item bill OPTIONS @@ -2264,10 +2460,26 @@ An array ref of specific packages (objects) to attempt billing, instead trying a $cust_main->bill( pkg_list => [$pkg1, $pkg2] ); +=item not_pkgpart + +A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar). + =item invoice_time Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices. Other calculations, such as whether or not to generate the invoice in the first place, are not affected. +=item cancel + +This boolean value informs the us that the package is being cancelled. This +typically might mean not charging the normal recurring fee but only usage +fees since the last billing. Setup charges may be charged. Not all package +plans support this feature (they tend to charge 0). + +=item invoice_terms + +Options terms to be printed on this invocice. Otherwise, customer-specific +terms or the default terms are used. + =back =cut @@ -2281,7 +2493,12 @@ sub bill { my $time = $options{'time'} || time; my $invoice_time = $options{'invoice_time'} || $time; - #put below somehow? + $options{'not_pkgpart'} ||= {}; + $options{'not_pkgpart'} = { map { $_ => 1 } + split(/\s*,\s*/, $options{'not_pkgpart'}) + } + unless ref($options{'not_pkgpart'}); + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -2295,6 +2512,17 @@ sub bill { $self->select_for_update; #mutex + my $error = $self->do_cust_event( + 'debug' => ( $options{'debug'} || 0 ), + 'time' => $invoice_time, + 'check_freq' => $options{'check_freq'}, + 'stage' => 'pre-bill', + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + my @cust_bill_pkg = (); ### @@ -2306,11 +2534,10 @@ sub bill { my %taxlisthash; my @precommit_hooks = (); - my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } ); - foreach my $cust_pkg (@cust_pkgs) { + $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks? + foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) { - #NO!! next if $cust_pkg->cancel; - next if $cust_pkg->getfield('cancel'); + next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart}; warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1; @@ -2336,6 +2563,7 @@ sub bill { 'recur' => \$total_recur, 'tax_matrix' => \%taxlisthash, 'time' => $time, + 'real_pkgpart' => $real_pkgpart, 'options' => \%options, ); if ($error) { @@ -2353,35 +2581,44 @@ sub bill { return ''; } - my $postal_pkg = $self->charge_postal_fee(); - if ( $postal_pkg && !ref( $postal_pkg ) ) { - $dbh->rollback if $oldAutoCommit; - return "can't charge postal invoice fee for customer ". - $self->custnum. ": $postal_pkg"; - } - if ( $postal_pkg && - ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) || + if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) || !$conf->exists('postal_invoice-recurring_only') - ) ) { - foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) { - my $error = - $self->_make_lines( 'part_pkg' => $part_pkg, - 'cust_pkg' => $postal_pkg, - 'precommit_hooks' => \@precommit_hooks, - 'line_items' => \@cust_bill_pkg, - 'setup' => \$total_setup, - 'recur' => \$total_recur, - 'tax_matrix' => \%taxlisthash, - 'time' => $time, - 'options' => \%options, - ); - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; + + my $postal_pkg = $self->charge_postal_fee(); + if ( $postal_pkg && !ref( $postal_pkg ) ) { + + $dbh->rollback if $oldAutoCommit; + return "can't charge postal invoice fee for customer ". + $self->custnum. ": $postal_pkg"; + + } elsif ( $postal_pkg ) { + + my $real_pkgpart = $postal_pkg->pkgpart; + foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) { + my %postal_options = %options; + delete $postal_options{cancel}; + my $error = + $self->_make_lines( 'part_pkg' => $part_pkg, + 'cust_pkg' => $postal_pkg, + 'precommit_hooks' => \@precommit_hooks, + 'line_items' => \@cust_bill_pkg, + 'setup' => \$total_setup, + 'recur' => \$total_recur, + 'tax_matrix' => \%taxlisthash, + 'time' => $time, + 'real_pkgpart' => $real_pkgpart, + 'options' => \%postal_options, + ); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } + } + } warn "having a look at the taxes we found...\n" if $DEBUG > 2; @@ -2398,9 +2635,14 @@ sub bill { # values are listrefs of cust_bill_pkg_tax_location hashrefs my %tax_location = (); + # keys are taxlisthash keys (internal identifiers) + # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs + my %tax_rate_location = (); + foreach my $tax ( keys %taxlisthash ) { my $tax_object = shift @{ $taxlisthash{$tax} }; warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2; + warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2; my $hashref_or_error = $tax_object->taxline( $taxlisthash{$tax}, 'custnum' => $self->custnum, @@ -2433,72 +2675,40 @@ sub bill { }; } + $tax_rate_location{ $tax } ||= []; + if ( ref($tax_object) eq 'FS::tax_rate' ) { + my $taxratelocationnum = + $tax_object->tax_rate_location->taxratelocationnum; + push @{ $tax_rate_location{ $tax } }, + { + 'taxnum' => $tax_object->taxnum, + 'taxtype' => ref($tax_object), + 'amount' => sprintf('%.2f', $amount ), + 'locationtaxid' => $tax_object->location, + 'taxratelocationnum' => $taxratelocationnum, + }; + } + } #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg; foreach my $tax ( keys %taxlisthash ) { foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) { - next unless ref($_) eq 'FS::cust_bill_pkg'; # shouldn't happen + next unless ref($_) eq 'FS::cust_bill_pkg'; push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg }, splice( @{ $_->_cust_tax_exempt_pkg } ); } } - #some taxes are taxed - my %totlisthash; - - warn "finding taxed taxes...\n" if $DEBUG > 2; - foreach my $tax ( keys %taxlisthash ) { - my $tax_object = shift @{ $taxlisthash{$tax} }; - warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n" - if $DEBUG > 2; - next unless $tax_object->can('tax_on_tax'); - - foreach my $tot ( $tax_object->tax_on_tax( $self ) ) { - my $totname = ref( $tot ). ' '. $tot->taxnum; - - warn "checking $totname which we call ". $tot->taxname. " as applicable\n" - if $DEBUG > 2; - next unless exists( $taxlisthash{ $totname } ); # only increase - # existing taxes - warn "adding $totname to taxed taxes\n" if $DEBUG > 2; - if ( exists( $totlisthash{ $totname } ) ) { - push @{ $totlisthash{ $totname } }, $tax{ $tax }; - }else{ - $totlisthash{ $totname } = [ $tot, $tax{ $tax } ]; - } - } - } - - warn "having a look at taxed taxes...\n" if $DEBUG > 2; - foreach my $tax ( keys %totlisthash ) { - my $tax_object = shift @{ $totlisthash{$tax} }; - warn "found previously found taxed tax ". $tax_object->taxname. "\n" - if $DEBUG > 2; - my $listref_or_error = - $tax_object->taxline( $totlisthash{$tax}, - 'custnum' => $self->custnum, - 'invoice_time' => $invoice_time - ); - unless (ref($listref_or_error)) { - $dbh->rollback if $oldAutoCommit; - return $listref_or_error; - } - - warn "adding taxed tax amount ". $listref_or_error->[1]. - " as ". $tax_object->taxname. "\n" - if $DEBUG; - $tax{ $tax } += $listref_or_error->[1]; - } - #consolidate and create tax line items warn "consolidating and generating...\n" if $DEBUG > 2; foreach my $taxname ( keys %taxname ) { my $tax = 0; my %seen = (); my @cust_bill_pkg_tax_location = (); + my @cust_bill_pkg_tax_rate_location = (); warn "adding $taxname\n" if $DEBUG > 1; foreach my $taxitem ( @{ $taxname{$taxname} } ) { next if $seen{$taxitem}++; @@ -2507,12 +2717,32 @@ sub bill { push @cust_bill_pkg_tax_location, map { new FS::cust_bill_pkg_tax_location $_ } @{ $tax_location{ $taxitem } }; + push @cust_bill_pkg_tax_rate_location, + map { new FS::cust_bill_pkg_tax_rate_location $_ } + @{ $tax_rate_location{ $taxitem } }; } next unless $tax; $tax = sprintf('%.2f', $tax ); $total_setup = sprintf('%.2f', $total_setup+$tax ); + my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname, + 'disabled' => '', + }, + ); + + my @display = (); + if ( $pkg_category and + $conf->config('invoice_latexsummary') || + $conf->config('invoice_htmlsummary') + ) + { + + my %hash = ( 'section' => $pkg_category->categoryname ); + push @display, new FS::cust_bill_pkg_display { type => 'S', %hash }; + + } + push @cust_bill_pkg, new FS::cust_bill_pkg { 'pkgnum' => 0, 'setup' => $tax, @@ -2520,20 +2750,65 @@ sub bill { 'sdate' => '', 'edate' => '', 'itemdesc' => $taxname, + 'display' => \@display, 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location, + 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location, + }; + + } + + #add tax adjustments + warn "adding tax adjustments...\n" if $DEBUG > 2; + foreach my $cust_tax_adjustment ( + qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum, + 'billpkgnum' => '', + } + ) + ) { + + my $tax = sprintf('%.2f', $cust_tax_adjustment->amount ); + $total_setup = sprintf('%.2f', $total_setup+$tax ); + + my $itemdesc = $cust_tax_adjustment->taxname; + $itemdesc = '' if $itemdesc eq 'Tax'; + + push @cust_bill_pkg, new FS::cust_bill_pkg { + 'pkgnum' => 0, + 'setup' => $tax, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + 'itemdesc' => $itemdesc, + 'itemcomment' => $cust_tax_adjustment->comment, + 'cust_tax_adjustment' => $cust_tax_adjustment, + #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location, }; } my $charged = sprintf('%.2f', $total_setup + $total_recur ); + my @cust_bill = $self->cust_bill; + my $balance = $self->balance; + my $previous_balance = scalar(@cust_bill) + ? ( $cust_bill[$#cust_bill]->billing_balance || 0 ) + : 0; + + $previous_balance += $cust_bill[$#cust_bill]->charged + if scalar(@cust_bill); + #my $balance_adjustments = + # sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged); + #create the new invoice my $cust_bill = new FS::cust_bill ( { - 'custnum' => $self->custnum, - '_date' => ( $invoice_time ), - 'charged' => $charged, + 'custnum' => $self->custnum, + '_date' => ( $invoice_time ), + 'charged' => $charged, + 'billing_balance' => $balance, + 'previous_balance' => $previous_balance, + 'invoice_terms' => $options{'invoice_terms'}, } ); - my $error = $cust_bill->insert; + $error = $cust_bill->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "can't create invoice for customer #". $self->custnum. ": $error"; @@ -2575,10 +2850,10 @@ sub _make_lines { my $total_recur = $params{recur} or die "no recur accumulator specified"; my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified"; my $time = $params{'time'} or die "no time specified"; - my (%options) = %{$params{options}}; #hmmm only for 'resetup' + my (%options) = %{$params{options}}; my $dbh = dbh; - my $real_pkgpart = $cust_pkg->pkgpart; + my $real_pkgpart = $params{real_pkgpart}; my %hash = $cust_pkg->hash; my $old_cust_pkg = new FS::cust_pkg \%hash; @@ -2594,14 +2869,19 @@ sub _make_lines { my $setup = 0; my $unitsetup = 0; - if ( ! $cust_pkg->setup && - ( - ( $conf->exists('disable_setup_suspended_pkgs') && - ! $cust_pkg->getfield('susp') - ) || ! $conf->exists('disable_setup_suspended_pkgs') - ) - || $options{'resetup'} - ) { + if ( $options{'resetup'} + || ( ! $cust_pkg->setup + && ( ! $cust_pkg->start_date + || $cust_pkg->start_date <= $time + ) + && ( ! $conf->exists('disable_setup_suspended_pkgs') + || ( $conf->exists('disable_setup_suspended_pkgs') && + ! $cust_pkg->getfield('susp') + ) + ) + ) + ) + { warn " bill setup\n" if $DEBUG > 1; $lineitems++; @@ -2617,6 +2897,9 @@ sub _make_lines { #do need it, but it won't get written to the db #|| $cust_pkg->pkgpart != $real_pkgpart; + $cust_pkg->setfield('start_date', '') + if $cust_pkg->start_date; + } ### @@ -2627,13 +2910,15 @@ sub _make_lines { my $recur = 0; my $unitrecur = 0; my $sdate; - if ( ! $cust_pkg->getfield('susp') and - ( $part_pkg->getfield('freq') ne '0' && - ( $cust_pkg->getfield('bill') || 0 ) <= $time + if ( ! $cust_pkg->get('susp') + and ! $cust_pkg->get('start_date') + and ( $part_pkg->getfield('freq') ne '0' + && ( $cust_pkg->getfield('bill') || 0 ) <= $time ) || ( $part_pkg->plan eq 'voip_cdr' && $part_pkg->option('bill_every_call') ) + || ( $options{cancel} ) ) { # XXX should this be a package event? probably. events are called @@ -2647,18 +2932,22 @@ sub _make_lines { $lineitems++; # XXX shared with $recur_prog - $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; + $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill ) + || $cust_pkg->setup + || $time; #over two params! lets at least switch to a hashref for the rest... my $increment_next_bill = ( $part_pkg->freq ne '0' && ( $cust_pkg->getfield('bill') || 0 ) <= $time + && !$options{cancel} ); my %param = ( 'precommit_hooks' => $precommit_hooks, 'increment_next_bill' => $increment_next_bill, ); - $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) }; - return "$@ running calc_recur for $cust_pkg\n" + my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur'; + $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) }; + return "$@ running $method for $cust_pkg\n" if ( $@ ); if ( $increment_next_bill ) { @@ -2733,14 +3022,17 @@ sub _make_lines { 'unitrecur' => $unitrecur, 'quantity' => $cust_pkg->quantity, 'details' => \@details, + 'hidden' => $part_pkg->hidden, }; if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) { $cust_bill_pkg->sdate( $hash{last_bill} ); $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1 + $cust_bill_pkg->edate( $time ) if $options{cancel}; } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) { $cust_bill_pkg->sdate( $sdate ); $cust_bill_pkg->edate( $cust_pkg->bill ); + #$cust_bill_pkg->edate( $time ) if $options{cancel}; } $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart) @@ -2754,7 +3046,7 @@ sub _make_lines { ### my $error = - $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg); + $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options); return $error if $error; push @$cust_bill_pkgs, $cust_bill_pkg; @@ -2773,6 +3065,9 @@ sub _handle_taxes { my $taxlisthash = shift; my $cust_bill_pkg = shift; my $cust_pkg = shift; + my $invoice_time = shift; + my $real_pkgpart = shift; + my $options = shift; my %cust_bill_pkg = (); my %taxes = (); @@ -2780,8 +3075,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; - push @classes, 'setup' if $cust_bill_pkg->setup; - push @classes, 'recur' if $cust_bill_pkg->recur; + push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel}); + push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel}); if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) { @@ -2835,6 +3130,10 @@ sub _handle_taxes { @taxes = qsearch( 'cust_main_county', \%taxhash_elim ); } + @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) } + @taxes + if $self->cust_main_exemption; #just to be safe + if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) { foreach (@taxes) { $_->set('pkgnum', $cust_pkg->pkgnum ); @@ -2847,32 +3146,53 @@ sub _handle_taxes { $taxes{'recur'} = [ @taxes ]; $taxes{$_} = [ @taxes ] foreach (@classes); - # maybe eliminate this entirely, along with all the 0% records - unless ( @taxes ) { - return - "fatal: can't find tax rate for state/county/country/taxclass ". - join('/', map $taxhash{$_}, qw(state county country taxclass) ); - } + # # maybe eliminate this entirely, along with all the 0% records + # unless ( @taxes ) { + # return + # "fatal: can't find tax rate for state/county/country/taxclass ". + # join('/', map $taxhash{$_}, qw(state county country taxclass) ); + # } } #if $conf->exists('enable_taxproducts') ... } my @display = (); - if ( $conf->exists('separate_usage') ) { + my $separate = $conf->exists('separate_usage'); + my $usage_mandate = $cust_pkg->part_pkg->option('usage_mandate', 'Hush!'); + if ( $separate || $cust_bill_pkg->hidden || $usage_mandate ) { + + my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart }; + my %hash = $cust_bill_pkg->hidden # maybe for all bill linked? + ? ( 'section' => $temp_pkg->part_pkg->categoryname ) + : (); + my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!'); my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!'); - push @display, new FS::cust_bill_pkg_display { type => 'S' }; - push @display, new FS::cust_bill_pkg_display { type => 'R' }; - push @display, new FS::cust_bill_pkg_display { type => 'U', - section => $section - }; - if ($section && $summary) { - $display[2]->post_total('Y'); + if ( $separate ) { + push @display, new FS::cust_bill_pkg_display { type => 'S', %hash }; + push @display, new FS::cust_bill_pkg_display { type => 'R', %hash }; + } else { + push @display, new FS::cust_bill_pkg_display + { type => '', + %hash, + ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ), + }; + } + + if ($separate && $section && $summary) { push @display, new FS::cust_bill_pkg_display { type => 'U', summary => 'Y', - } + %hash, + }; + } + if ($usage_mandate || $section && $summary) { + $hash{post_total} = 'Y'; } + + $hash{section} = $section if ($separate || $usage_mandate); + push @display, new FS::cust_bill_pkg_display { type => 'U', %hash }; + } $cust_bill_pkg->set('display', \@display); @@ -2881,19 +3201,51 @@ sub _handle_taxes { my @taxes = @{ $taxes{$key} || [] }; my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key}; + my %localtaxlisthash = (); foreach my $tax ( @taxes ) { - my $taxname = ref( $tax ). ' taxnum'. $tax->taxnum; + my $taxname = ref( $tax ). ' '. $tax->taxnum; # $taxname .= ' pkgnum'. $cust_pkg->pkgnum. # ' locationnum'. $cust_pkg->locationnum # if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum; - if ( exists( $taxlisthash->{ $taxname } ) ) { - push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg; - }else{ - $taxlisthash->{ $taxname } = [ $tax, $tax_cust_bill_pkg ]; + $taxlisthash->{ $taxname } ||= [ $tax ]; + push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg; + + $localtaxlisthash{ $taxname } ||= [ $tax ]; + push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg; + + } + + warn "finding taxed taxes...\n" if $DEBUG > 2; + foreach my $tax ( keys %localtaxlisthash ) { + my $tax_object = shift @{ $localtaxlisthash{$tax} }; + warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n" + if $DEBUG > 2; + next unless $tax_object->can('tax_on_tax'); + + foreach my $tot ( $tax_object->tax_on_tax( $self ) ) { + my $totname = ref( $tot ). ' '. $tot->taxnum; + + warn "checking $totname which we call ". $tot->taxname. " as applicable\n" + if $DEBUG > 2; + next unless exists( $localtaxlisthash{ $totname } ); # only increase + # existing taxes + warn "adding $totname to taxed taxes\n" if $DEBUG > 2; + my $hashref_or_error = + $tax_object->taxline( $localtaxlisthash{$tax}, + 'custnum' => $self->custnum, + 'invoice_time' => $invoice_time, + ); + return $hashref_or_error + unless ref($hashref_or_error); + + $taxlisthash->{ $totname } ||= [ $tot ]; + push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount}; + } } + } ''; @@ -2912,6 +3264,7 @@ sub _gather_taxes { unless (@taxclassnums) { @taxclassnums = map { $_->taxclassnum } + grep { $_->taxable eq 'Y' } $part_pkg->part_pkg_taxrate('cch', $geocode, $class); } warn "Found taxclassnum values of ". join(',', @taxclassnums) @@ -2935,7 +3288,7 @@ sub _gather_taxes { } -=item collect OPTIONS +=item collect [ HASHREF | OPTION => VALUE ... ] (Attempt to) collect money for this customer's outstanding invoices (see L<FS::cust_bill>). Usually used after the bill method. @@ -2960,25 +3313,24 @@ Use this time when deciding when to print invoices and late notices on those inv Retry card/echeck/LEC transactions even when not scheduled by invoice events. -=item quiet - -set true to surpress email card/ACH decline notices. - =item check_freq "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq) -=item payby +=item quiet -allows for one time override of normal customer billing method +set true to surpress email card/ACH decline notices. =item debug Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries) - =back +# =item payby +# +# allows for one time override of normal customer billing method + =cut sub collect { @@ -3016,12 +3368,107 @@ sub collect { } } + my $error = $self->do_cust_event( + 'debug' => ( $options{'debug'} || 0 ), + 'time' => $invoice_time, + 'check_freq' => $options{'check_freq'}, + 'stage' => 'collect', + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item do_cust_event [ HASHREF | OPTION => VALUE ... ] + +Runs billing events; see L<FS::part_event> and the billing events web +interface. + +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 + +Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. + +=item check_freq + +"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq) + +=item stage + +"collect" (the default) or "pre-bill" + +=item quiet + +set true to surpress email card/ACH decline notices. + +=item debug + +Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries) + +=cut + +# =item payby +# +# allows for one time override of normal customer billing method + +# =item retry +# +# Retry card/echeck/LEC transactions even when not scheduled by invoice events. + +sub do_cust_event { + my( $self, %options ) = @_; + my $time = $options{'time'} || time; + + #put below somehow? + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + $self->select_for_update; #mutex + + if ( $DEBUG ) { + my $balance = $self->balance; + warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n" + } + +# if ( exists($options{'retry_card'}) ) { +# carp 'retry_card option passed to collect is deprecated; use retry'; +# $options{'retry'} ||= $options{'retry_card'}; +# } +# if ( exists($options{'retry'}) && $options{'retry'} ) { +# my $error = $self->retry_realtime; +# if ( $error ) { +# $dbh->rollback if $oldAutoCommit; +# return $error; +# } +# } + # false laziness w/pay_batch::import_results my $due_cust_event = $self->due_cust_event( 'debug' => ( $options{'debug'} || 0 ), - 'time' => $invoice_time, + 'time' => $time, 'check_freq' => $options{'check_freq'}, + 'stage' => ( $options{'stage'} || 'collect' ), ); unless( ref($due_cust_event) ) { $dbh->rollback if $oldAutoCommit; @@ -3033,7 +3480,7 @@ sub collect { #XXX lock event #re-eval event conditions (a previous event could have changed things) - unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) { + unless ( $cust_event->test_conditions( 'time' => $time ) ) { #don't leave stray "new/locked" records around my $error = $cust_event->delete; if ( $error ) { @@ -3086,6 +3533,10 @@ options are: Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized. +=item stage + +"collect" (the default) or "pre-bill" + =item time "Current time" for the events. @@ -3141,7 +3592,7 @@ sub due_cust_event { unless $opt{testonly}; ### - # 1: find possible events (initial search) + # find possible events (initial search) ### my @cust_event = (); @@ -3232,8 +3683,20 @@ sub due_cust_event { " total possible cust events found in initial search\n" if $DEBUG; # > 1; + + ## + # test stage + ## + + $opt{stage} ||= 'collect'; + @cust_event = + grep { my $stage = $_->part_event->event_stage; + $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' ) + } + @cust_event; + ## - # 2: test conditions + # test conditions ## my %unsat = (); @@ -3250,7 +3713,7 @@ sub due_cust_event { if $DEBUG; # > 1; ## - # 3: insert + # insert ## unless( $opt{testonly} ) { @@ -3268,7 +3731,7 @@ sub due_cust_event { $dbh->commit or die $dbh->errstr if $oldAutoCommit; ## - # 4: return + # return ## warn " returning events: ". Dumper(@cust_event). "\n" @@ -3368,6 +3831,10 @@ sub retry_realtime { } +# some horrid false laziness here to avoid refactor fallout +# eventually realtime realtime_bop and realtime_refund_bop should go +# away and be replaced by _new_realtime_bop and _new_realtime_refund_bop + =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ] Runs a realtime credit card, ACH (electronic check) or phone bill transaction @@ -3401,7 +3868,12 @@ I<payunique> is a unique identifier for this payment. =cut sub realtime_bop { - my( $self, $method, $amount, %options ) = @_; + my $self = shift; + + return $self->_new_realtime_bop(@_) + if $self->_new_bop_required(); + + my( $method, $amount, %options ) = @_; if ( $DEBUG ) { warn "$me realtime_bop: $method $amount\n"; warn " $_ => $options{$_}\n" foreach keys %options; @@ -3435,24 +3907,35 @@ sub realtime_bop { return "Banned credit card" if $ban; ### - # select a gateway + # set taxclass and trans_is_recur based on invnum if there is one ### my $taxclass = ''; + my $trans_is_recur = 0; if ( $options{'invnum'} ) { + my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } ); die "invnum ". $options{'invnum'}. " not found" unless $cust_bill; - my @taxclasses = - map { $_->part_pkg->taxclass } + + my @part_pkg = + map { $_->part_pkg } grep { $_ } map { $_->cust_pkg } $cust_bill->cust_bill_pkg; - unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are - #different taxclasses - $taxclass = $taxclasses[0]; - } + + my @taxclasses = map $_->taxclass, @part_pkg; + $taxclass = $taxclasses[0] + unless grep { $taxclasses[0] ne $_ } @taxclasses; #unless there are + #different taxclasses + $trans_is_recur = 1 + if grep { $_->freq ne '0' } @part_pkg; + } + ### + # select a gateway + ### + #look for an agent gateway override first my $cardtype; if ( $method eq 'CC' ) { @@ -3580,16 +4063,15 @@ sub realtime_bop { : $self->payissue; $content{issue_number} = $payissue if $payissue; - $content{recurring_billing} = 'YES' - if qsearch('cust_pay', { 'custnum' => $self->custnum, - 'payby' => 'CARD', - 'payinfo' => $payinfo, - } ) - || qsearch('cust_pay', { 'custnum' => $self->custnum, - 'payby' => 'CARD', - 'paymask' => $self->mask_payinfo('CARD', $payinfo), - } ); - + if ( $self->_bop_recurring_billing( 'payinfo' => $payinfo, + 'trans_is_recur' => $trans_is_recur, + ) + ) + { + $content{recurring_billing} = 'YES'; + $content{acct_code} = 'rebill' + if $conf->exists('credit_card-recurring_billing_acct_code'); + } } elsif ( $method eq 'ECHECK' ) { ( $content{account_number}, $content{routing_code} ) = @@ -3648,15 +4130,17 @@ sub realtime_bop { #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out my $cust_pay_pending = new FS::cust_pay_pending { - 'custnum' => $self->custnum, - #'invnum' => $options{'invnum'}, - 'paid' => $amount, - '_date' => '', - 'payby' => $method2payby{$method}, - 'payinfo' => $payinfo, - 'paydate' => $paydate, - 'status' => 'new', - 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ), + 'custnum' => $self->custnum, + #'invnum' => $options{'invnum'}, + 'paid' => $amount, + '_date' => '', + 'payby' => $method2payby{$method}, + 'payinfo' => $payinfo, + 'paydate' => $paydate, + 'recurring_billing' => $content{recurring_billing}, + 'pkgnum' => $options{'pkgnum'}, + 'status' => 'new', + 'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ), }; $cust_pay_pending->payunique( $options{payunique} ) if defined($options{payunique}) && length($options{payunique}); @@ -3810,6 +4294,7 @@ sub realtime_bop { 'payinfo' => $payinfo, 'paybatch' => $paybatch, 'paydate' => $paydate, + 'pkgnum' => $options{'pkgnum'}, } ); #doesn't hurt to know, even though the dup check is in cust_pay_pending now $cust_pay->payunique( $options{payunique} ) @@ -3912,7 +4397,13 @@ sub realtime_bop { $template->compile() or return "($perror) can't compile template: $Text::Template::ERROR"; - my $templ_hash = { error => $transaction->error_message }; + my $templ_hash = { + 'company_name' => + scalar( $conf->config('company_name', $self->agentnum ) ), + 'company_address' => + join("\n", $conf->config('company_address', $self->agentnum ) ), + 'error' => $transaction->error_message, + }; my $error = send_email( 'from' => $conf->config('invoice_from', $self->agentnum ), @@ -3942,25 +4433,912 @@ sub realtime_bop { } -=item fake_bop +sub _bop_recurring_billing { + my( $self, %opt ) = @_; + + my $method = $conf->config('credit_card-recurring_billing_flag'); + + if ( $method eq 'transaction_is_recur' ) { + + return 1 if $opt{'trans_is_recur'}; + + } else { + + my %hash = ( 'custnum' => $self->custnum, + 'payby' => 'CARD', + ); + + return 1 + if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } ) + || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD', + $opt{'payinfo'} ) + } ); + + } + + return 0; + +} + + +=item realtime_refund_bop METHOD [ OPTION => VALUE ... ] + +Refunds a realtime credit card, ACH (electronic check) or phone bill transaction +via a Business::OnlinePayment realtime gateway. See +L<http://420.am/business-onlinepayment> for supported gateways. + +Available methods are: I<CC>, I<ECHECK> and I<LEC> + +Available options are: I<amount>, I<reason>, I<paynum>, I<paydate> + +Most gateways require a reference to an original payment transaction to refund, +so you probably need to specify a I<paynum>. + +I<amount> defaults to the original amount of the payment if not specified. + +I<reason> specifies a reason for the refund. + +I<paydate> specifies the expiration date for a credit card overriding the +value from the customer record or the payment record. Specified as yyyy-mm-dd + +Implementation note: If I<amount> is unspecified or equal to the amount of the +orignal payment, first an attempt is made to "void" the transaction via +the gateway (to cancel a not-yet settled transaction) and then if that fails, +the normal attempt is made to "refund" ("credit") the transaction via the +gateway is attempted. + +#The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>, +#I<zip>, I<payinfo> and I<paydate> are also available. Any of these options, +#if set, will override the value from the customer record. + +#If an I<invnum> is specified, this payment (if successful) is applied to the +#specified invoice. If you don't specify an I<invnum> you might want to +#call the B<apply_payments> method. =cut -sub fake_bop { - my( $self, $method, $amount, %options ) = @_; +#some false laziness w/realtime_bop, not enough to make it worth merging +#but some useful small subs should be pulled out +sub realtime_refund_bop { + my $self = shift; - if ( $options{'fake_failure'} ) { - return "Error: No error; test failure requested with fake_failure"; + return $self->_new_realtime_refund_bop(@_) + if $self->_new_bop_required(); + + my( $method, %options ) = @_; + if ( $DEBUG ) { + warn "$me realtime_refund_bop: $method refund\n"; + warn " $_ => $options{$_}\n" foreach keys %options; } + eval "use Business::OnlinePayment"; + die $@ if $@; + + ### + # look up the original payment and optionally a gateway for that payment + ### + + my $cust_pay = ''; + my $amount = $options{'amount'}; + + my( $processor, $login, $password, @bop_options ) ; + my( $auth, $order_number ) = ( '', '', '' ); + + if ( $options{'paynum'} ) { + + warn " paynum: $options{paynum}\n" if $DEBUG > 1; + $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } ) + or return "Unknown paynum $options{'paynum'}"; + $amount ||= $cust_pay->paid; + + $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/ + or return "Can't parse paybatch for paynum $options{'paynum'}: ". + $cust_pay->paybatch; + my $gatewaynum = ''; + ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 ); + + if ( $gatewaynum ) { #gateway for the payment to be refunded + + my $payment_gateway = + qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } ); + die "payment gateway $gatewaynum not found" + unless $payment_gateway; + + $processor = $payment_gateway->gateway_module; + $login = $payment_gateway->gateway_username; + $password = $payment_gateway->gateway_password; + @bop_options = $payment_gateway->options; + + } else { #try the default gateway + + my( $conf_processor, $unused_action ); + ( $conf_processor, $login, $password, $unused_action, @bop_options ) = + $self->default_payment_gateway($method); + + return "processor of payment $options{'paynum'} $processor does not". + " match default processor $conf_processor" + unless $processor eq $conf_processor; + + } + + + } else { # didn't specify a paynum, so look for agent gateway overrides + # like a normal transaction + + my $cardtype; + if ( $method eq 'CC' ) { + $cardtype = cardtype($self->payinfo); + } elsif ( $method eq 'ECHECK' ) { + $cardtype = 'ACH'; + } else { + $cardtype = $method; + } + my $override = + qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, + cardtype => $cardtype, + taxclass => '', } ) + || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, + cardtype => '', + taxclass => '', } ); + + if ( $override ) { #use a payment gateway override + + my $payment_gateway = $override->payment_gateway; + + $processor = $payment_gateway->gateway_module; + $login = $payment_gateway->gateway_username; + $password = $payment_gateway->gateway_password; + #$action = $payment_gateway->gateway_action; + @bop_options = $payment_gateway->options; + + } else { #use the standard settings from the config + + my $unused_action; + ( $processor, $login, $password, $unused_action, @bop_options ) = + $self->default_payment_gateway($method); + + } + + } + return "neither amount nor paynum specified" unless $amount; + + my %content = ( + 'type' => $method, + 'login' => $login, + 'password' => $password, + 'order_number' => $order_number, + 'amount' => $amount, + 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/ + ); + $content{authorization} = $auth + if length($auth); #echeck/ACH transactions have an order # but no auth + #(at least with authorize.net) + + my $disable_void_after; + if ($conf->exists('disable_void_after') + && $conf->config('disable_void_after') =~ /^(\d+)$/) { + $disable_void_after = $1; + } + + #first try void if applicable + if ( $cust_pay && $cust_pay->paid == $amount + && ( + ( not defined($disable_void_after) ) + || ( time < ($cust_pay->_date + $disable_void_after ) ) + ) + ) { + warn " attempting void\n" if $DEBUG > 1; + my $void = new Business::OnlinePayment( $processor, @bop_options ); + $void->content( 'action' => 'void', %content ); + $void->submit(); + if ( $void->is_success ) { + my $error = $cust_pay->void($options{'reason'}); + if ( $error ) { + # gah, even with transactions. + my $e = 'WARNING: Card/ACH voided but database not updated - '. + "error voiding payment: $error"; + warn $e; + return $e; + } + warn " void successful\n" if $DEBUG > 1; + return ''; + } + } + + warn " void unsuccessful, trying refund\n" + if $DEBUG > 1; + + #massage data + my $address = $self->address1; + $address .= ", ". $self->address2 if $self->address2; + + my($payname, $payfirst, $paylast); + if ( $self->payname && $method ne 'ECHECK' ) { + $payname = $self->payname; + $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ + or return "Illegal payname $payname"; + ($payfirst, $paylast) = ($1, $2); + } else { + $payfirst = $self->getfield('first'); + $paylast = $self->getfield('last'); + $payname = "$payfirst $paylast"; + } + + my @invoicing_list = $self->invoicing_list_emailonly; + if ( $conf->exists('emailinvoiceautoalways') + || $conf->exists('emailinvoiceauto') && ! @invoicing_list + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $self->all_emails; + } + + my $email = ($conf->exists('business-onlinepayment-email-override')) + ? $conf->config('business-onlinepayment-email-override') + : $invoicing_list[0]; + + my $payip = exists($options{'payip'}) + ? $options{'payip'} + : $self->payip; + $content{customer_ip} = $payip + if length($payip); + + my $payinfo = ''; + if ( $method eq 'CC' ) { + + if ( $cust_pay ) { + $content{card_number} = $payinfo = $cust_pay->payinfo; + (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate) + =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ && + ($content{expiration} = "$2/$1"); # where available + } else { + $content{card_number} = $payinfo = $self->payinfo; + (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate) + =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + $content{expiration} = "$2/$1"; + } + + } elsif ( $method eq 'ECHECK' ) { + + if ( $cust_pay ) { + $payinfo = $cust_pay->payinfo; + } else { + $payinfo = $self->payinfo; + } + ( $content{account_number}, $content{routing_code} )= split('@', $payinfo ); + $content{bank_name} = $self->payname; + $content{account_type} = 'CHECKING'; + $content{account_name} = $payname; + $content{customer_org} = $self->company ? 'B' : 'I'; + $content{customer_ssn} = $self->ss; + } elsif ( $method eq 'LEC' ) { + $content{phone} = $payinfo = $self->payinfo; + } + + #then try refund + my $refund = new Business::OnlinePayment( $processor, @bop_options ); + my %sub_content = $refund->content( + 'action' => 'credit', + 'customer_id' => $self->custnum, + 'last_name' => $paylast, + 'first_name' => $payfirst, + 'name' => $payname, + 'address' => $address, + 'city' => $self->city, + 'state' => $self->state, + 'zip' => $self->zip, + 'country' => $self->country, + 'email' => $email, + 'phone' => $self->daytime || $self->night, + %content, #after + ); + warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content ) + if $DEBUG > 1; + $refund->submit(); + + return "$processor error: ". $refund->error_message + unless $refund->is_success(); + my %method2payby = ( 'CC' => 'CARD', 'ECHECK' => 'CHEK', 'LEC' => 'LECB', ); + my $paybatch = "$processor:". $refund->authorization; + $paybatch .= ':'. $refund->order_number + if $refund->can('order_number') && $refund->order_number; + + while ( $cust_pay && $cust_pay->unapplied < $amount ) { + my @cust_bill_pay = $cust_pay->cust_bill_pay; + last unless @cust_bill_pay; + my $cust_bill_pay = pop @cust_bill_pay; + my $error = $cust_bill_pay->delete; + last if $error; + } + + my $cust_refund = new FS::cust_refund ( { + 'custnum' => $self->custnum, + 'paynum' => $options{'paynum'}, + 'refund' => $amount, + '_date' => '', + 'payby' => $method2payby{$method}, + 'payinfo' => $payinfo, + 'paybatch' => $paybatch, + 'reason' => $options{'reason'} || 'card or ACH refund', + } ); + my $error = $cust_refund->insert; + if ( $error ) { + $cust_refund->paynum(''); #try again with no specific paynum + my $error2 = $cust_refund->insert; + if ( $error2 ) { + # gah, even with transactions. + my $e = 'WARNING: Card/ACH refunded but database not updated - '. + "error inserting refund ($processor): $error2". + " (previously tried insert with paynum #$options{'paynum'}" . + ": $error )"; + warn $e; + return $e; + } + } + + ''; #no error + +} + +# does the configuration indicate the new bop routines are required? + +sub _new_bop_required { + my $self = shift; + + my $botpp = 'Business::OnlineThirdPartyPayment'; + + return 1 + if ( $conf->config('business-onlinepayment-namespace') eq $botpp || + scalar( grep { $_->gateway_namespace eq $botpp } + qsearch( 'payment_gateway', { 'disabled' => '' } ) + ) + ) + ; + + ''; +} + + +=item realtime_collect [ OPTION => VALUE ... ] + +Runs a realtime credit card, ACH (electronic check) or phone bill transaction +via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime +gateway. See L<http://420.am/business-onlinepayment> and +L<http://420.am/business-onlinethirdpartypayment> for supported gateways. + +On failure returns an error message. + +Returns false or a hashref upon success. The hashref contains keys popup_url reference, and collectitems. The first is a URL to which a browser should be redirected for completion of collection. The second is a reference id for the transaction suitable for the end user. The collectitems is a reference to a list of name value pairs suitable for assigning to a html form and posted to popup_url. + +Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>, I<pkgnum> + +I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified +then it is deduced from the customer record. + +If no I<amount> is specified, then the customer balance is used. + +The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>, +I<zip>, I<payinfo> and I<paydate> are also available. Any of these options, +if set, will override the value from the customer record. + +I<description> is a free-text field passed to the gateway. It defaults to +"Internet services". + +If an I<invnum> is specified, this payment (if successful) is applied to the +specified invoice. If you don't specify an I<invnum> you might want to +call the B<apply_payments> method. + +I<quiet> can be set true to surpress email decline notices. + +I<paynum_ref> can be set to a scalar reference. It will be filled in with the +resulting paynum, if any. + +I<payunique> is a unique identifier for this payment. + +I<session_id> is a session identifier associated with this payment. + +I<depend_jobnum> allows payment capture to unlock export jobs + +=cut + +sub realtime_collect { + my( $self, %options ) = @_; + + if ( $DEBUG ) { + warn "$me realtime_collect:\n"; + warn " $_ => $options{$_}\n" foreach keys %options; + } + + $options{amount} = $self->balance unless exists( $options{amount} ); + $options{method} = FS::payby->payby2bop($self->payby) + unless exists( $options{method} ); + + return $self->realtime_bop({%options}); + +} + +=item _realtime_bop { [ ARG => VALUE ... ] } + +Runs a realtime credit card, ACH (electronic check) or phone bill transaction +via a Business::OnlinePayment realtime gateway. See +L<http://420.am/business-onlinepayment> for supported gateways. + +Required arguments in the hashref are I<method>, and I<amount> + +Available methods are: I<CC>, I<ECHECK> and I<LEC> + +Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id> + +The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>, +I<zip>, I<payinfo> and I<paydate> are also available. Any of these options, +if set, will override the value from the customer record. + +I<description> is a free-text field passed to the gateway. It defaults to +"Internet services". + +If an I<invnum> is specified, this payment (if successful) is applied to the +specified invoice. If you don't specify an I<invnum> you might want to +call the B<apply_payments> method. + +I<quiet> can be set true to surpress email decline notices. + +I<paynum_ref> can be set to a scalar reference. It will be filled in with the +resulting paynum, if any. + +I<payunique> is a unique identifier for this payment. + +I<session_id> is a session identifier associated with this payment. + +I<depend_jobnum> allows payment capture to unlock export jobs + +(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too) + +=cut + +# some helper routines +sub _payment_gateway { + my ($self, $options) = @_; + + $options->{payment_gateway} = $self->agent->payment_gateway( %$options ) + unless exists($options->{payment_gateway}); + + $options->{payment_gateway}; +} + +sub _bop_auth { + my ($self, $options) = @_; + + ( + 'login' => $options->{payment_gateway}->gateway_username, + 'password' => $options->{payment_gateway}->gateway_password, + ); +} + +sub _bop_options { + my ($self, $options) = @_; + + $options->{payment_gateway}->gatewaynum + ? $options->{payment_gateway}->options + : @{ $options->{payment_gateway}->get('options') }; +} + +sub _bop_defaults { + my ($self, $options) = @_; + + $options->{description} ||= 'Internet services'; + $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} ); + $options->{invnum} ||= ''; + $options->{payname} = $self->payname unless exists( $options->{payname} ); +} + +sub _bop_content { + my ($self, $options) = @_; + my %content = (); + + $content{address} = exists($options->{'address1'}) + ? $options->{'address1'} + : $self->address1; + my $address2 = exists($options->{'address2'}) + ? $options->{'address2'} + : $self->address2; + $content{address} .= ", ". $address2 if length($address2); + + my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip; + $content{customer_ip} = $payip if length($payip); + + $content{invoice_number} = $options->{'invnum'} + if exists($options->{'invnum'}) && length($options->{'invnum'}); + + $content{email_customer} = + ( $conf->exists('business-onlinepayment-email_customer') + || $conf->exists('business-onlinepayment-email-override') ); + + $content{payfirst} = $self->getfield('first'); + $content{paylast} = $self->getfield('last'); + + $content{account_name} = "$content{payfirst} $content{paylast}" + if $options->{method} eq 'ECHECK'; + + $content{name} = $options->{payname}; + $content{name} = $content{account_name} if exists($content{account_name}); + + $content{city} = exists($options->{city}) + ? $options->{city} + : $self->city; + $content{state} = exists($options->{state}) + ? $options->{state} + : $self->state; + $content{zip} = exists($options->{zip}) + ? $options->{'zip'} + : $self->zip; + $content{country} = exists($options->{country}) + ? $options->{country} + : $self->country; + $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/ + $content{phone} = $self->daytime || $self->night; + + (%content); +} + +my %bop_method2payby = ( + 'CC' => 'CARD', + 'ECHECK' => 'CHEK', + 'LEC' => 'LECB', +); + +sub _new_realtime_bop { + my $self = shift; + + my %options = (); + if (ref($_[0]) eq 'HASH') { + %options = %{$_[0]}; + } else { + my ( $method, $amount ) = ( shift, shift ); + %options = @_; + $options{method} = $method; + $options{amount} = $amount; + } + + if ( $DEBUG ) { + warn "$me realtime_bop (new): $options{method} $options{amount}\n"; + warn " $_ => $options{$_}\n" foreach keys %options; + } + + return $self->fake_bop(%options) if $options{'fake'}; + + $self->_bop_defaults(\%options); + + ### + # set trans_is_recur based on invnum if there is one + ### + + my $trans_is_recur = 0; + if ( $options{'invnum'} ) { + + my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } ); + die "invnum ". $options{'invnum'}. " not found" unless $cust_bill; + + my @part_pkg = + map { $_->part_pkg } + grep { $_ } + map { $_->cust_pkg } + $cust_bill->cust_bill_pkg; + + $trans_is_recur = 1 + if grep { $_->freq ne '0' } @part_pkg; + + } + + ### + # select a gateway + ### + + my $payment_gateway = $self->_payment_gateway( \%options ); + my $namespace = $payment_gateway->gateway_namespace; + + eval "use $namespace"; + die $@ if $@; + + ### + # check for banned credit card/ACH + ### + + my $ban = qsearchs('banned_pay', { + 'payby' => $bop_method2payby{$options{method}}, + 'payinfo' => md5_base64($options{payinfo}), + } ); + return "Banned credit card" if $ban; + + ### + # massage data + ### + + my (%bop_content) = $self->_bop_content(\%options); + + if ( $options{method} ne 'ECHECK' ) { + $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ + or return "Illegal payname $options{payname}"; + ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2); + } + + my @invoicing_list = $self->invoicing_list_emailonly; + if ( $conf->exists('emailinvoiceautoalways') + || $conf->exists('emailinvoiceauto') && ! @invoicing_list + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $self->all_emails; + } + + my $email = ($conf->exists('business-onlinepayment-email-override')) + ? $conf->config('business-onlinepayment-email-override') + : $invoicing_list[0]; + + my $paydate = ''; + my %content = (); + if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) { + + $content{card_number} = $options{payinfo}; + $paydate = exists($options{'paydate'}) + ? $options{'paydate'} + : $self->paydate; + $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + $content{expiration} = "$2/$1"; + + my $paycvv = exists($options{'paycvv'}) + ? $options{'paycvv'} + : $self->paycvv; + $content{cvv2} = $paycvv + if length($paycvv); + + my $paystart_month = exists($options{'paystart_month'}) + ? $options{'paystart_month'} + : $self->paystart_month; + + my $paystart_year = exists($options{'paystart_year'}) + ? $options{'paystart_year'} + : $self->paystart_year; + + $content{card_start} = "$paystart_month/$paystart_year" + if $paystart_month && $paystart_year; + + my $payissue = exists($options{'payissue'}) + ? $options{'payissue'} + : $self->payissue; + $content{issue_number} = $payissue if $payissue; + + if ( $self->_bop_recurring_billing( 'payinfo' => $options{'payinfo'}, + 'trans_is_recur' => $trans_is_recur, + ) + ) + { + $content{recurring_billing} = 'YES'; + $content{acct_code} = 'rebill' + if $conf->exists('credit_card-recurring_billing_acct_code'); + } + + } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){ + ( $content{account_number}, $content{routing_code} ) = + split('@', $options{payinfo}); + $content{bank_name} = $options{payname}; + $content{bank_state} = exists($options{'paystate'}) + ? $options{'paystate'} + : $self->getfield('paystate'); + $content{account_type} = exists($options{'paytype'}) + ? uc($options{'paytype'}) || 'CHECKING' + : uc($self->getfield('paytype')) || 'CHECKING'; + $content{customer_org} = $self->company ? 'B' : 'I'; + $content{state_id} = exists($options{'stateid'}) + ? $options{'stateid'} + : $self->getfield('stateid'); + $content{state_id_state} = exists($options{'stateid_state'}) + ? $options{'stateid_state'} + : $self->getfield('stateid_state'); + $content{customer_ssn} = exists($options{'ss'}) + ? $options{'ss'} + : $self->ss; + } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) { + $content{phone} = $options{payinfo}; + } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) { + #move along + } else { + #die an evil death + } + + ### + # run transaction(s) + ### + + my $balance = exists( $options{'balance'} ) + ? $options{'balance'} + : $self->balance; + + $self->select_for_update; #mutex ... just until we get our pending record in + + #the checks here are intended to catch concurrent payments + #double-form-submission prevention is taken care of in cust_pay_pending::check + + #check the balance + return "The customer's balance has changed; $options{method} transaction aborted." + if $self->balance < $balance; + #&& $self->balance < $options{amount}; #might as well anyway? + + #also check and make sure there aren't *other* pending payments for this cust + + my @pending = qsearch('cust_pay_pending', { + 'custnum' => $self->custnum, + 'status' => { op=>'!=', value=>'done' } + }); + return "A payment is already being processed for this customer (". + join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ). + "); $options{method} transaction aborted." + if scalar(@pending); + + #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out + + my $cust_pay_pending = new FS::cust_pay_pending { + 'custnum' => $self->custnum, + #'invnum' => $options{'invnum'}, + 'paid' => $options{amount}, + '_date' => '', + 'payby' => $bop_method2payby{$options{method}}, + 'payinfo' => $options{payinfo}, + 'paydate' => $paydate, + 'recurring_billing' => $content{recurring_billing}, + 'pkgnum' => $options{'pkgnum'}, + 'status' => 'new', + 'gatewaynum' => $payment_gateway->gatewaynum || '', + 'session_id' => $options{session_id} || '', + 'jobnum' => $options{depend_jobnum} || '', + }; + $cust_pay_pending->payunique( $options{payunique} ) + if defined($options{payunique}) && length($options{payunique}); + my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted + return $cpp_new_err if $cpp_new_err; + + my( $action1, $action2 ) = + split( /\s*\,\s*/, $payment_gateway->gateway_action ); + + my $transaction = new $namespace( $payment_gateway->gateway_module, + $self->_bop_options(\%options), + ); + + $transaction->content( + 'type' => $options{method}, + $self->_bop_auth(\%options), + 'action' => $action1, + 'description' => $options{'description'}, + 'amount' => $options{amount}, + #'invoice_number' => $options{'invnum'}, + 'customer_id' => $self->custnum, + %bop_content, + 'reference' => $cust_pay_pending->paypendingnum, #for now + 'email' => $email, + %content, #after + ); + + $cust_pay_pending->status('pending'); + my $cpp_pending_err = $cust_pay_pending->replace; + return $cpp_pending_err if $cpp_pending_err; + + #config? + my $BOP_TESTING = 0; + my $BOP_TESTING_SUCCESS = 1; + + unless ( $BOP_TESTING ) { + $transaction->submit(); + } else { + if ( $BOP_TESTING_SUCCESS ) { + $transaction->is_success(1); + $transaction->authorization('fake auth'); + } else { + $transaction->is_success(0); + $transaction->error_message('fake failure'); + } + } + + if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) { + + return { reference => $cust_pay_pending->paypendingnum, + map { $_ => $transaction->$_ } qw ( popup_url collectitems ) }; + + } elsif ( $transaction->is_success() && $action2 ) { + + $cust_pay_pending->status('authorized'); + my $cpp_authorized_err = $cust_pay_pending->replace; + return $cpp_authorized_err if $cpp_authorized_err; + + my $auth = $transaction->authorization; + my $ordernum = $transaction->can('order_number') + ? $transaction->order_number + : ''; + + my $capture = + new Business::OnlinePayment( $payment_gateway->gateway_module, + $self->_bop_options(\%options), + ); + + my %capture = ( + %content, + type => $options{method}, + action => $action2, + $self->_bop_auth(\%options), + order_number => $ordernum, + amount => $options{amount}, + authorization => $auth, + description => $options{'description'}, + ); + + foreach my $field (qw( authorization_source_code returned_ACI + transaction_identifier validation_code + transaction_sequence_num local_transaction_date + local_transaction_time AVS_result_code )) { + $capture{$field} = $transaction->$field() if $transaction->can($field); + } + + $capture->content( %capture ); + + $capture->submit(); + + unless ( $capture->is_success ) { + my $e = "Authorization successful but capture failed, custnum #". + $self->custnum. ': '. $capture->result_code. + ": ". $capture->error_message; + warn $e; + return $e; + } + + } + + ### + # remove paycvv after initial transaction + ### + + #false laziness w/misc/process/payment.cgi - check both to make sure working + # correctly + if ( defined $self->dbdef_table->column('paycvv') + && length($self->paycvv) + && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save') + ) { + my $error = $self->remove_cvv; + if ( $error ) { + warn "WARNING: error removing cvv: $error\n"; + } + } + + ### + # result handling + ### + + $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options ); + +} + +=item fake_bop + +=cut + +sub fake_bop { + my $self = shift; + + my %options = (); + if (ref($_[0]) eq 'HASH') { + %options = %{$_[0]}; + } else { + my ( $method, $amount ) = ( shift, shift ); + %options = @_; + $options{method} = $method; + $options{amount} = $amount; + } + + if ( $options{'fake_failure'} ) { + return "Error: No error; test failure requested with fake_failure"; + } + #my $paybatch = ''; - #if ( $payment_gateway ) { # agent override + #if ( $payment_gateway->gatewaynum ) { # agent override # $paybatch = $payment_gateway->gatewaynum. '-'; #} # @@ -3975,9 +5353,9 @@ sub fake_bop { my $cust_pay = new FS::cust_pay ( { 'custnum' => $self->custnum, 'invnum' => $options{'invnum'}, - 'paid' => $amount, + 'paid' => $options{amount}, '_date' => '', - 'payby' => $method2payby{$method}, + 'payby' => $bop_method2payby{$options{method}}, #'payinfo' => $payinfo, 'payinfo' => '4111111111111111', 'paybatch' => $paybatch, @@ -4012,7 +5390,355 @@ sub fake_bop { } -=item default_payment_gateway + +# item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ] +# +# Wraps up processing of a realtime credit card, ACH (electronic check) or +# phone bill transaction. + +sub _realtime_bop_result { + my( $self, $cust_pay_pending, $transaction, %options ) = @_; + if ( $DEBUG ) { + warn "$me _realtime_bop_result: pending transaction ". + $cust_pay_pending->paypendingnum. "\n"; + warn " $_ => $options{$_}\n" foreach keys %options; + } + + my $payment_gateway = $options{payment_gateway} + or return "no payment gateway in arguments to _realtime_bop_result"; + + $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined'); + my $cpp_captured_err = $cust_pay_pending->replace; + return $cpp_captured_err if $cpp_captured_err; + + if ( $transaction->is_success() ) { + + my $paybatch = ''; + if ( $payment_gateway->gatewaynum ) { # agent override + $paybatch = $payment_gateway->gatewaynum. '-'; + } + + $paybatch .= $payment_gateway->gateway_module. ":". + $transaction->authorization; + + $paybatch .= ':'. $transaction->order_number + if $transaction->can('order_number') + && length($transaction->order_number); + + my $cust_pay = new FS::cust_pay ( { + 'custnum' => $self->custnum, + 'invnum' => $options{'invnum'}, + 'paid' => $cust_pay_pending->paid, + '_date' => '', + 'payby' => $cust_pay_pending->payby, + #'payinfo' => $payinfo, + 'paybatch' => $paybatch, + 'paydate' => $cust_pay_pending->paydate, + 'pkgnum' => $cust_pay_pending->pkgnum, + } ); + #doesn't hurt to know, even though the dup check is in cust_pay_pending now + $cust_pay->payunique( $options{payunique} ) + if defined($options{payunique}) && length($options{payunique}); + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction + + my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () ); + + if ( $error ) { + $cust_pay->invnum(''); #try again with no specific invnum + my $error2 = $cust_pay->insert( $options{'manual'} ? + ( 'manual' => 1 ) : () + ); + if ( $error2 ) { + # gah. but at least we have a record of the state we had to abort in + # from cust_pay_pending now. + my $e = "WARNING: $options{method} captured but payment not recorded -". + " error inserting payment (". $payment_gateway->gateway_module. + "): $error2". + " (previously tried insert with invnum #$options{'invnum'}" . + ": $error ) - pending payment saved as paypendingnum ". + $cust_pay_pending->paypendingnum. "\n"; + warn $e; + return $e; + } + } + + my $jobnum = $cust_pay_pending->jobnum; + if ( $jobnum ) { + my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } ); + + unless ( $placeholder ) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + my $e = "WARNING: $options{method} captured but job $jobnum not ". + "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n"; + warn $e; + return $e; + } + + $error = $placeholder->delete; + + if ( $error ) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + my $e = "WARNING: $options{method} captured but could not delete ". + "job $jobnum for paypendingnum ". + $cust_pay_pending->paypendingnum. ": $error\n"; + warn $e; + return $e; + } + + } + + if ( $options{'paynum_ref'} ) { + ${ $options{'paynum_ref'} } = $cust_pay->paynum; + } + + $cust_pay_pending->status('done'); + $cust_pay_pending->statustext('captured'); + $cust_pay_pending->paynum($cust_pay->paynum); + my $cpp_done_err = $cust_pay_pending->replace; + + if ( $cpp_done_err ) { + + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + my $e = "WARNING: $options{method} captured but payment not recorded - ". + "error updating status for paypendingnum ". + $cust_pay_pending->paypendingnum. ": $cpp_done_err \n"; + warn $e; + return $e; + + } else { + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return ''; #no error + + } + + } else { + + my $perror = $payment_gateway->gateway_module. " error: ". + $transaction->error_message; + + my $jobnum = $cust_pay_pending->jobnum; + if ( $jobnum ) { + my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } ); + + if ( $placeholder ) { + my $error = $placeholder->depended_delete; + $error ||= $placeholder->delete; + warn "error removing provisioning jobs after declined paypendingnum ". + $cust_pay_pending->paypendingnum. "\n"; + } else { + my $e = "error finding job $jobnum for declined paypendingnum ". + $cust_pay_pending->paypendingnum. "\n"; + warn $e; + } + + } + + unless ( $transaction->error_message ) { + + my $t_response; + if ( $transaction->can('response_page') ) { + $t_response = { + 'page' => ( $transaction->can('response_page') + ? $transaction->response_page + : '' + ), + 'code' => ( $transaction->can('response_code') + ? $transaction->response_code + : '' + ), + 'headers' => ( $transaction->can('response_headers') + ? $transaction->response_headers + : '' + ), + }; + } else { + $t_response .= + "No additional debugging information available for ". + $payment_gateway->gateway_module; + } + + $perror .= "No error_message returned from ". + $payment_gateway->gateway_module. " -- ". + ( ref($t_response) ? Dumper($t_response) : $t_response ); + + } + + if ( !$options{'quiet'} && !$realtime_bop_decline_quiet + && $conf->exists('emaildecline') + && grep { $_ ne 'POST' } $self->invoicing_list + && ! grep { $transaction->error_message =~ /$_/ } + $conf->config('emaildecline-exclude') + ) { + my @templ = $conf->config('declinetemplate'); + my $template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @templ ], + ) or return "($perror) can't create template: $Text::Template::ERROR"; + $template->compile() + or return "($perror) can't compile template: $Text::Template::ERROR"; + + my $templ_hash = { + 'company_name' => + scalar( $conf->config('company_name', $self->agentnum ) ), + 'company_address' => + join("\n", $conf->config('company_address', $self->agentnum ) ), + 'error' => $transaction->error_message, + }; + + my $error = send_email( + 'from' => $conf->config('invoice_from', $self->agentnum ), + 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ], + 'subject' => 'Your payment could not be processed', + 'body' => [ $template->fill_in(HASH => $templ_hash) ], + ); + + $perror .= " (also received error sending decline notification: $error)" + if $error; + + } + + $cust_pay_pending->status('done'); + $cust_pay_pending->statustext("declined: $perror"); + my $cpp_done_err = $cust_pay_pending->replace; + if ( $cpp_done_err ) { + my $e = "WARNING: $options{method} declined but pending payment not ". + "resolved - error updating status for paypendingnum ". + $cust_pay_pending->paypendingnum. ": $cpp_done_err \n"; + warn $e; + $perror = "$e ($perror)"; + } + + return $perror; + } + +} + +=item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ] + +Verifies successful third party processing of a realtime credit card, +ACH (electronic check) or phone bill transaction via a +Business::OnlineThirdPartyPayment realtime gateway. See +L<http://420.am/business-onlinethirdpartypayment> for supported gateways. + +Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique> + +The additional options I<payname>, I<city>, I<state>, +I<zip>, I<payinfo> and I<paydate> are also available. Any of these options, +if set, will override the value from the customer record. + +I<description> is a free-text field passed to the gateway. It defaults to +"Internet services". + +If an I<invnum> is specified, this payment (if successful) is applied to the +specified invoice. If you don't specify an I<invnum> you might want to +call the B<apply_payments> method. + +I<quiet> can be set true to surpress email decline notices. + +I<paynum_ref> can be set to a scalar reference. It will be filled in with the +resulting paynum, if any. + +I<payunique> is a unique identifier for this payment. + +Returns a hashref containing elements bill_error (which will be undefined +upon success) and session_id of any associated session. + +=cut + +sub realtime_botpp_capture { + my( $self, $cust_pay_pending, %options ) = @_; + if ( $DEBUG ) { + warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n"; + warn " $_ => $options{$_}\n" foreach keys %options; + } + + eval "use Business::OnlineThirdPartyPayment"; + die $@ if $@; + + ### + # select the gateway + ### + + my $method = FS::payby->payby2bop($cust_pay_pending->payby); + + my $payment_gateway = $cust_pay_pending->gatewaynum + ? qsearchs( 'payment_gateway', + { gatewaynum => $cust_pay_pending->gatewaynum } + ) + : $self->agent->payment_gateway( 'method' => $method, + # 'invnum' => $cust_pay_pending->invnum, + # 'payinfo' => $cust_pay_pending->payinfo, + ); + + $options{payment_gateway} = $payment_gateway; # for the helper subs + + ### + # massage data + ### + + my @invoicing_list = $self->invoicing_list_emailonly; + if ( $conf->exists('emailinvoiceautoalways') + || $conf->exists('emailinvoiceauto') && ! @invoicing_list + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $self->all_emails; + } + + my $email = ($conf->exists('business-onlinepayment-email-override')) + ? $conf->config('business-onlinepayment-email-override') + : $invoicing_list[0]; + + my %content = (); + + $content{email_customer} = + ( $conf->exists('business-onlinepayment-email_customer') + || $conf->exists('business-onlinepayment-email-override') ); + + ### + # run transaction(s) + ### + + my $transaction = + new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module, + $self->_bop_options(\%options), + ); + + $transaction->reference({ %options }); + + $transaction->content( + 'type' => $method, + $self->_bop_auth(\%options), + 'action' => 'Post Authorization', + 'description' => $options{'description'}, + 'amount' => $cust_pay_pending->paid, + #'invoice_number' => $options{'invnum'}, + 'customer_id' => $self->custnum, + 'referer' => 'http://cleanwhisker.420.am/', + 'reference' => $cust_pay_pending->paypendingnum, + 'email' => $email, + 'phone' => $self->daytime || $self->night, + %content, #after + # plus whatever is required for bogus capture avoidance + ); + + $transaction->submit(); + + my $error = + $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options ); + + { + bill_error => $error, + session_id => $cust_pay_pending->session_id, + } + +} + +=item default_payment_gateway DEPRECATED -- use agent->payment_gateway =cut @@ -4022,6 +5748,8 @@ sub default_payment_gateway { die "Real-time processing not enabled\n" unless $conf->exists('business-onlinepayment'); + #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n"; + #load up config my $bop_config = 'business-onlinepayment'; $bop_config .= '-ach' @@ -4055,7 +5783,7 @@ sub remove_cvv { ''; } -=item realtime_refund_bop METHOD [ OPTION => VALUE ... ] +=item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ] Refunds a realtime credit card, ACH (electronic check) or phone bill transaction via a Business::OnlinePayment realtime gateway. See @@ -4093,16 +5821,23 @@ gateway is attempted. #some false laziness w/realtime_bop, not enough to make it worth merging #but some useful small subs should be pulled out -sub realtime_refund_bop { - my( $self, $method, %options ) = @_; +sub _new_realtime_refund_bop { + my $self = shift; + + my %options = (); + if (ref($_[0]) ne 'HASH') { + %options = %{$_[0]}; + } else { + my $method = shift; + %options = @_; + $options{method} = $method; + } + if ( $DEBUG ) { - warn "$me realtime_refund_bop: $method refund\n"; + warn "$me realtime_refund_bop (new): $options{method} refund\n"; warn " $_ => $options{$_}\n" foreach keys %options; } - eval "use Business::OnlinePayment"; - die $@ if $@; - ### # look up the original payment and optionally a gateway for that payment ### @@ -4110,7 +5845,7 @@ sub realtime_refund_bop { my $cust_pay = ''; my $amount = $options{'amount'}; - my( $processor, $login, $password, @bop_options ) ; + my( $processor, $login, $password, @bop_options, $namespace ) ; my( $auth, $order_number ) = ( '', '', '' ); if ( $options{'paynum'} ) { @@ -4136,13 +5871,22 @@ sub realtime_refund_bop { $processor = $payment_gateway->gateway_module; $login = $payment_gateway->gateway_username; $password = $payment_gateway->gateway_password; + $namespace = $payment_gateway->gateway_namespace; @bop_options = $payment_gateway->options; } else { #try the default gateway - my( $conf_processor, $unused_action ); - ( $conf_processor, $login, $password, $unused_action, @bop_options ) = - $self->default_payment_gateway($method); + my $conf_processor; + my $payment_gateway = + $self->agent->payment_gateway('method' => $options{method}); + + ( $conf_processor, $login, $password, $namespace ) = + map { my $method = "gateway_$_"; $payment_gateway->$method } + qw( module username password namespace ); + + @bop_options = $payment_gateway->gatewaynum + ? $payment_gateway->options + : @{ $payment_gateway->get('options') }; return "processor of payment $options{'paynum'} $processor does not". " match default processor $conf_processor" @@ -4153,46 +5897,27 @@ sub realtime_refund_bop { } else { # didn't specify a paynum, so look for agent gateway overrides # like a normal transaction - - my $cardtype; - if ( $method eq 'CC' ) { - $cardtype = cardtype($self->payinfo); - } elsif ( $method eq 'ECHECK' ) { - $cardtype = 'ACH'; - } else { - $cardtype = $method; - } - my $override = - qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, - cardtype => $cardtype, - taxclass => '', } ) - || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, - cardtype => '', - taxclass => '', } ); - - if ( $override ) { #use a payment gateway override - my $payment_gateway = $override->payment_gateway; - - $processor = $payment_gateway->gateway_module; - $login = $payment_gateway->gateway_username; - $password = $payment_gateway->gateway_password; - #$action = $payment_gateway->gateway_action; - @bop_options = $payment_gateway->options; + my $payment_gateway = + $self->agent->payment_gateway( 'method' => $options{method}, + #'payinfo' => $payinfo, + ); + my( $processor, $login, $password, $namespace ) = + map { my $method = "gateway_$_"; $payment_gateway->$method } + qw( module username password namespace ); - } else { #use the standard settings from the config - - my $unused_action; - ( $processor, $login, $password, $unused_action, @bop_options ) = - $self->default_payment_gateway($method); - - } + my @bop_options = $payment_gateway->gatewaynum + ? $payment_gateway->options + : @{ $payment_gateway->get('options') }; } return "neither amount nor paynum specified" unless $amount; + eval "use $namespace"; + die $@ if $@; + my %content = ( - 'type' => $method, + 'type' => $options{method}, 'login' => $login, 'password' => $password, 'order_number' => $order_number, @@ -4242,7 +5967,7 @@ sub realtime_refund_bop { $address .= ", ". $self->address2 if $self->address2; my($payname, $payfirst, $paylast); - if ( $self->payname && $method ne 'ECHECK' ) { + if ( $self->payname && $options{method} ne 'ECHECK' ) { $payname = $self->payname; $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ or return "Illegal payname $payname"; @@ -4271,7 +5996,7 @@ sub realtime_refund_bop { if length($payip); my $payinfo = ''; - if ( $method eq 'CC' ) { + if ( $options{method} eq 'CC' ) { if ( $cust_pay ) { $content{card_number} = $payinfo = $cust_pay->payinfo; @@ -4285,7 +6010,7 @@ sub realtime_refund_bop { $content{expiration} = "$2/$1"; } - } elsif ( $method eq 'ECHECK' ) { + } elsif ( $options{method} eq 'ECHECK' ) { if ( $cust_pay ) { $payinfo = $cust_pay->payinfo; @@ -4298,7 +6023,7 @@ sub realtime_refund_bop { $content{account_name} = $payname; $content{customer_org} = $self->company ? 'B' : 'I'; $content{customer_ssn} = $self->ss; - } elsif ( $method eq 'LEC' ) { + } elsif ( $options{method} eq 'LEC' ) { $content{phone} = $payinfo = $self->payinfo; } @@ -4326,12 +6051,6 @@ sub realtime_refund_bop { return "$processor error: ". $refund->error_message unless $refund->is_success(); - my %method2payby = ( - 'CC' => 'CARD', - 'ECHECK' => 'CHEK', - 'LEC' => 'LECB', - ); - my $paybatch = "$processor:". $refund->authorization; $paybatch .= ':'. $refund->order_number if $refund->can('order_number') && $refund->order_number; @@ -4349,7 +6068,7 @@ sub realtime_refund_bop { 'paynum' => $options{'paynum'}, 'refund' => $amount, '_date' => '', - 'payby' => $method2payby{$method}, + 'payby' => $bop_method2payby{$options{method}}, 'payinfo' => $payinfo, 'paybatch' => $paybatch, 'reason' => $options{'reason'} || 'card or ACH refund', @@ -4503,19 +6222,23 @@ sub batch_card { ''; } -=item apply_payments_and_credits +=item apply_payments_and_credits [ OPTION => VALUE ... ] Applies unapplied payments and credits. In most cases, this new method should be used in place of sequential apply_payments and apply_credits methods. +A hash of optional arguments may be passed. Currently "manual" is supported. +If true, a payment receipt is sent instead of a statement when +'payment_receipt_email' configuration option is set. + If there is an error, returns the error, otherwise returns false. =cut sub apply_payments_and_credits { - my $self = shift; + my( $self, %options ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -4531,7 +6254,7 @@ sub apply_payments_and_credits { $self->select_for_update; #mutex foreach my $cust_bill ( $self->open_cust_bill ) { - my $error = $cust_bill->apply_payments_and_credits; + my $error = $cust_bill->apply_payments_and_credits(%options); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "Error applying: $error"; @@ -4584,32 +6307,52 @@ sub apply_credits { @invoices = sort { $b->_date <=> $a->_date } @invoices if defined($opt{'order'}) && $opt{'order'} eq 'newest'; + if ( $conf->exists('pkg-balances') ) { + # limit @credits to those w/ a pkgnum grepped from $self + my %pkgnums = (); + foreach my $i (@invoices) { + foreach my $li ( $i->cust_bill_pkg ) { + $pkgnums{$li->pkgnum} = 1; + } + } + @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits; + } + my $credit; + foreach my $cust_bill ( @invoices ) { - my $amount; if ( !defined($credit) || $credit->credited == 0) { $credit = pop @credits or last; } - if ($cust_bill->owed >= $credit->credited) { - $amount=$credit->credited; - }else{ - $amount=$cust_bill->owed; + my $owed; + if ( $conf->exists('pkg-balances') && $credit->pkgnum ) { + $owed = $cust_bill->owed_pkgnum($credit->pkgnum); + } else { + $owed = $cust_bill->owed; } + unless ( $owed > 0 ) { + push @credits, $credit; + next; + } + + my $amount = min( $credit->credited, $owed ); my $cust_credit_bill = new FS::cust_credit_bill ( { 'crednum' => $credit->crednum, 'invnum' => $cust_bill->invnum, 'amount' => $amount, } ); + $cust_credit_bill->pkgnum( $credit->pkgnum ) + if $conf->exists('pkg-balances') && $credit->pkgnum; my $error = $cust_credit_bill->insert; if ( $error ) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; die $error; } - redo if ($cust_bill->owed > 0); + redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances'); } @@ -4620,19 +6363,24 @@ sub apply_credits { return $total_unapplied_credits; } -=item apply_payments +=item apply_payments [ OPTION => VALUE ... ] Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>) to outstanding invoice balances in chronological order. #and returns the value of any remaining unapplied payments. +A hash of optional arguments may be passed. Currently "manual" is supported. +If true, a payment receipt is sent instead of a statement when +'payment_receipt_email' configuration option is set. + + Dies if there is an error. =cut sub apply_payments { - my $self = shift; + my( $self, %options ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -4657,33 +6405,52 @@ sub apply_payments { grep { $_->owed > 0 } $self->cust_bill; + if ( $conf->exists('pkg-balances') ) { + # limit @payments to those w/ a pkgnum grepped from $self + my %pkgnums = (); + foreach my $i (@invoices) { + foreach my $li ( $i->cust_bill_pkg ) { + $pkgnums{$li->pkgnum} = 1; + } + } + @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments; + } + my $payment; foreach my $cust_bill ( @invoices ) { - my $amount; if ( !defined($payment) || $payment->unapplied == 0 ) { $payment = pop @payments or last; } - if ( $cust_bill->owed >= $payment->unapplied ) { - $amount = $payment->unapplied; + my $owed; + if ( $conf->exists('pkg-balances') && $payment->pkgnum ) { + $owed = $cust_bill->owed_pkgnum($payment->pkgnum); } else { - $amount = $cust_bill->owed; + $owed = $cust_bill->owed; + } + unless ( $owed > 0 ) { + push @payments, $payment; + next; } + my $amount = min( $payment->unapplied, $owed ); + my $cust_bill_pay = new FS::cust_bill_pay ( { 'paynum' => $payment->paynum, 'invnum' => $cust_bill->invnum, 'amount' => $amount, } ); - my $error = $cust_bill_pay->insert; + $cust_bill_pay->pkgnum( $payment->pkgnum ) + if $conf->exists('pkg-balances') && $payment->pkgnum; + my $error = $cust_bill_pay->insert(%options); if ( $error ) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; die $error; } - redo if ( $cust_bill->owed > 0); + redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances'); } @@ -4717,6 +6484,22 @@ see L<Time::Local> and L<Date::Parse> for conversion functions. sub total_owed_date { my $self = shift; my $time = shift; + +# my $custnum = $self->custnum; +# +# my $owed_sql = FS::cust_bill->owed_sql; +# +# my $sql = " +# SELECT SUM($owed_sql) FROM cust_bill +# WHERE custnum = $custnum +# AND _date <= $time +# "; +# +# my $sth = dbh->prepare($sql) or die dbh->errstr; +# $sth->execute() or die $sth->errstr; +# +# return sprintf( '%.2f', $sth->fetchrow_arrayref->[0] ); + my $total_bill = 0; foreach my $cust_bill ( grep { $_->_date <= $time } @@ -4725,6 +6508,42 @@ sub total_owed_date { $total_bill += $cust_bill->owed; } sprintf( "%.2f", $total_bill ); + +} + +=item total_owed_pkgnum PKGNUM + +Returns the total owed on all invoices for this customer's specific package +when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>). + +=cut + +sub total_owed_pkgnum { + my( $self, $pkgnum ) = @_; + $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037 +} + +=item total_owed_date_pkgnum TIME PKGNUM + +Returns the total owed for this customer's specific package when using +experimental package balances on all invoices with date earlier than +TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also +see L<Time::Local> and L<Date::Parse> for conversion functions. + +=cut + +sub total_owed_date_pkgnum { + my( $self, $time, $pkgnum ) = @_; + + my $total_bill = 0; + foreach my $cust_bill ( + grep { $_->_date <= $time } + qsearch('cust_bill', { 'custnum' => $self->custnum, } ) + ) { + $total_bill += $cust_bill->owed_pkgnum($pkgnum); + } + sprintf( "%.2f", $total_bill ); + } =item total_paid @@ -4763,6 +6582,21 @@ sub total_unapplied_credits { sprintf( "%.2f", $total_credit ); } +=item total_unapplied_credits_pkgnum PKGNUM + +Returns the total outstanding credit (see L<FS::cust_credit>) for this +customer. See L<FS::cust_credit/credited>. + +=cut + +sub total_unapplied_credits_pkgnum { + my( $self, $pkgnum ) = @_; + my $total_credit = 0; + $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum); + sprintf( "%.2f", $total_credit ); +} + + =item total_unapplied_payments Returns the total unapplied payments (see L<FS::cust_pay>) for this customer. @@ -4777,6 +6611,22 @@ sub total_unapplied_payments { sprintf( "%.2f", $total_unapplied ); } +=item total_unapplied_payments_pkgnum PKGNUM + +Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's +specific package when using experimental package balances. See +L<FS::cust_pay/unapplied>. + +=cut + +sub total_unapplied_payments_pkgnum { + my( $self, $pkgnum ) = @_; + my $total_unapplied = 0; + $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum); + sprintf( "%.2f", $total_unapplied ); +} + + =item total_unapplied_refunds Returns the total unrefunded refunds (see L<FS::cust_refund>) for this @@ -4829,6 +6679,26 @@ sub balance_date { ); } +=item balance_pkgnum PKGNUM + +Returns the balance for this customer's specific package when using +experimental package balances (total_owed plus total_unrefunded, minus +total_unapplied_credits minus total_unapplied_payments) + +=cut + +sub balance_pkgnum { + my( $self, $pkgnum ) = @_; + + sprintf( "%.2f", + $self->total_owed_pkgnum($pkgnum) +# n/a - refunds aren't part of pkg-balances since they don't apply to invoices +# + $self->total_unapplied_refunds_pkgnum($pkgnum) + - $self->total_unapplied_credits_pkgnum($pkgnum) + - $self->total_unapplied_payments_pkgnum($pkgnum) + ); +} + =item in_transit_payments Returns the total of requests for payments for this customer pending in @@ -4852,6 +6722,86 @@ sub in_transit_payments { sprintf( "%.2f", $in_transit_payments ); } +=item payment_info + +Returns a hash of useful information for making a payment. + +=over 4 + +=item balance + +Current balance. + +=item payby + +'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand), +'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand), +'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free). + +=back + +For credit card transactions: + +=over 4 + +=item card_type 1 + +=item payname + +Exact name on card + +=back + +For electronic check transactions: + +=over 4 + +=item stateid_state + +=back + +=cut + +sub payment_info { + my $self = shift; + + my %return = (); + + $return{balance} = $self->balance; + + $return{payname} = $self->payname + || ( $self->first. ' '. $self->get('last') ); + + $return{$_} = $self->get($_) for qw(address1 address2 city state zip); + + $return{payby} = $self->payby; + $return{stateid_state} = $self->stateid_state; + + if ( $self->payby =~ /^(CARD|DCRD)$/ ) { + $return{card_type} = cardtype($self->payinfo); + $return{payinfo} = $self->paymask; + + @return{'month', 'year'} = $self->paydate_monthyear; + + } + + if ( $self->payby =~ /^(CHEK|DCHK)$/ ) { + my ($payinfo1, $payinfo2) = split '@', $self->paymask; + $return{payinfo1} = $payinfo1; + $return{payinfo2} = $payinfo2; + $return{paytype} = $self->paytype; + $return{paystate} = $self->paystate; + + } + + #doubleclick protection + my $_date = time; + $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32; + + %return; + +} + =item paydate_monthyear Returns a two-element list consisting of the month and year of this customer's @@ -4870,6 +6820,28 @@ sub paydate_monthyear { } } +=item tax_exemption TAXNAME + +=cut + +sub tax_exemption { + my( $self, $taxname ) = @_; + + qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum, + 'taxname' => $taxname, + }, + ); +} + +=item cust_main_exemption + +=cut + +sub cust_main_exemption { + my $self = shift; + qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } ); +} + =item invoicing_list [ ARRAYREF ] If an arguement is given, sets these email addresses as invoice recipients @@ -5042,6 +7014,24 @@ sub invoicing_list_emailonly_scalar { join(', ', $self->invoicing_list_emailonly); } +=item referral_custnum_cust_main + +Returns the customer who referred this customer (or the empty string, if +this customer was not referred). + +Note the difference with referral_cust_main method: This method, +referral_custnum_cust_main returns the single customer (if any) who referred +this customer, while referral_cust_main returns an array of customers referred +BY this customer. + +=cut + +sub referral_custnum_cust_main { + my $self = shift; + return '' unless $self->referral_custnum; + qsearchs('cust_main', { 'custnum' => $self->referral_custnum } ); +} + =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ] Returns an array of customers referred by this customer (referral_custnum set @@ -5049,6 +7039,11 @@ to this custnum). If DEPTH is given, recurses up to the given depth, returning customers referred by customers referred by this customer and so on, inclusive. The default behavior is DEPTH 1 (no recursion). +Note the difference with referral_custnum_cust_main method: This method, +referral_cust_main, returns an array of customers referred BY this customer, +while referral_custnum_cust_main returns the single customer (if any) who +referred this customer. + =cut sub referral_cust_main { @@ -5155,33 +7150,75 @@ sub credit { } -=item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ] +=item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ] Creates a one-time charge for this customer. If there is an error, returns the error, otherwise returns false. +New-style, with a hashref of options: + + my $error = $cust_main->charge( + { + 'amount' => 54.32, + 'quantity' => 1, + 'start_date' => str2time('7/4/2009'), + 'pkg' => 'Description', + 'comment' => 'Comment', + 'additional' => [], #extra invoice detail + 'classnum' => 1, #pkg_class + + 'setuptax' => '', # or 'Y' for tax exempt + + #internal taxation + 'taxclass' => 'Tax class', + + #vendor taxation + 'taxproduct' => 2, #part_pkg_taxproduct + 'override' => {}, #XXX describe + + #will be filled in with the new object + 'cust_pkg_ref' => \$cust_pkg, + + #generate an invoice immediately + 'bill_now' => 0, + 'invoice_terms' => '', #with these terms + } + ); + +Old-style: + + my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' ); + =cut sub charge { my $self = shift; - my ( $amount, $quantity, $pkg, $comment, $classnum, $additional ); + my ( $amount, $quantity, $start_date, $classnum ); + my ( $pkg, $comment, $additional ); my ( $setuptax, $taxclass ); #internal taxes my ( $taxproduct, $override ); #vendor (CCH) taxes + my $cust_pkg_ref = ''; + my ( $bill_now, $invoice_terms ) = ( 0, '' ); if ( ref( $_[0] ) ) { $amount = $_[0]->{amount}; $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1; + $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : ''; $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge'; $comment = exists($_[0]->{comment}) ? $_[0]->{comment} : '$'. sprintf("%.2f",$amount); $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : ''; $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : ''; $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : ''; - $additional = $_[0]->{additional}; + $additional = $_[0]->{additional} || []; $taxproduct = $_[0]->{taxproductnum}; $override = { '' => $_[0]->{tax_override} }; - }else{ + $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : ''; + $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : ''; + $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : ''; + } else { $amount = shift; $quantity = 1; + $start_date = ''; $pkg = @_ ? shift : 'One-time charge'; $comment = @_ ? shift : '$'. sprintf("%.2f",$amount); $setuptax = ''; @@ -5239,19 +7276,32 @@ sub charge { } my $cust_pkg = new FS::cust_pkg ( { - 'custnum' => $self->custnum, - 'pkgpart' => $pkgpart, - 'quantity' => $quantity, + 'custnum' => $self->custnum, + 'pkgpart' => $pkgpart, + 'quantity' => $quantity, + 'start_date' => $start_date, } ); $error = $cust_pkg->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; + } elsif ( $cust_pkg_ref ) { + ${$cust_pkg_ref} = $cust_pkg; + } + + if ( $bill_now ) { + my $error = $self->bill( 'invoice_terms' => $invoice_terms, + 'pkg_list' => [ $cust_pkg ], + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; + return ''; } @@ -5290,6 +7340,7 @@ Returns all the invoices (see L<FS::cust_bill>) for this customer. sub cust_bill { my $self = shift; + map { $_ } #return $self->num_cust_bill unless wantarray; sort { $a->_date <=> $b->_date } qsearch('cust_bill', { 'custnum' => $self->custnum, } ) } @@ -5303,7 +7354,27 @@ customer. sub open_cust_bill { my $self = shift; - grep { $_->owed > 0 } $self->cust_bill; + + qsearch({ + 'table' => 'cust_bill', + 'hashref' => { 'custnum' => $self->custnum, }, + 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0', + 'order_by' => 'ORDER BY _date ASC', + }); + +} + +=item cust_statements + +Returns all the statements (see L<FS::cust_statement>) for this customer. + +=cut + +sub cust_statement { + my $self = shift; + map { $_ } #return $self->num_cust_statement unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch('cust_statement', { 'custnum' => $self->custnum, } ) } =item cust_credit @@ -5314,10 +7385,28 @@ Returns all the credits (see L<FS::cust_credit>) for this customer. sub cust_credit { my $self = shift; + map { $_ } #return $self->num_cust_credit unless wantarray; sort { $a->_date <=> $b->_date } qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) } +=item cust_credit_pkgnum + +Returns all the credits (see L<FS::cust_credit>) for this customer's specific +package when using experimental package balances. + +=cut + +sub cust_credit_pkgnum { + my( $self, $pkgnum ) = @_; + map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_credit', { 'custnum' => $self->custnum, + 'pkgnum' => $pkgnum, + } + ); +} + =item cust_pay Returns all the payments (see L<FS::cust_pay>) for this customer. @@ -5326,10 +7415,43 @@ Returns all the payments (see L<FS::cust_pay>) for this customer. sub cust_pay { my $self = shift; + return $self->num_cust_pay unless wantarray; sort { $a->_date <=> $b->_date } qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) } +=item num_cust_pay + +Returns the number of payments (see L<FS::cust_pay>) for this customer. Also +called automatically when the cust_pay method is used in a scalar context. + +=cut + +sub num_cust_pay { + my $self = shift; + my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?"; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute($self->custnum) or die $sth->errstr; + $sth->fetchrow_arrayref->[0]; +} + +=item cust_pay_pkgnum + +Returns all the payments (see L<FS::cust_pay>) for this customer's specific +package when using experimental package balances. + +=cut + +sub cust_pay_pkgnum { + my( $self, $pkgnum ) = @_; + map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_pay', { 'custnum' => $self->custnum, + 'pkgnum' => $pkgnum, + } + ); +} + =item cust_pay_void Returns all voided payments (see L<FS::cust_pay_void>) for this customer. @@ -5338,6 +7460,7 @@ Returns all voided payments (see L<FS::cust_pay_void>) for this customer. sub cust_pay_void { my $self = shift; + map { $_ } #return $self->num_cust_pay_void unless wantarray; sort { $a->_date <=> $b->_date } qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } ) } @@ -5350,7 +7473,8 @@ Returns all batched payments (see L<FS::cust_pay_void>) for this customer. sub cust_pay_batch { my $self = shift; - sort { $a->_date <=> $b->_date } + map { $_ } #return $self->num_cust_pay_batch unless wantarray; + sort { $a->paybatchnum <=> $b->paybatchnum } qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } ) } @@ -5397,6 +7521,7 @@ Returns all the refunds (see L<FS::cust_refund>) for this customer. sub cust_refund { my $self = shift; + map { $_ } #return $self->num_cust_refund unless wantarray; sort { $a->_date <=> $b->_date } qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) } @@ -5695,6 +7820,19 @@ sub support_services { } +# Return a list of latitude/longitude for one of the services (if any) +sub service_coordinates { + my $self = shift; + + my @svc_X = + grep { $_->latitude && $_->longitude } + map { $_->svc_x } + map { $_->cust_svc } + $self->ncancelled_pkgs; + + scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : () +} + =back =head1 CLASS METHODS @@ -5896,6 +8034,32 @@ sub balance_date_sql { } +=item unapplied_payments_date_sql START_TIME [ END_TIME ] + +Returns an SQL fragment to retreive the total unapplied payments for this +customer, only considering invoices with date earlier than START_TIME, and +optionally not later than END_TIME. + +Times are specified as SQL fragments or numeric +UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and +L<Date::Parse> for conversion functions. The empty string can be passed +to disable that time constraint completely. + +Available options are: + +=cut + +sub unapplied_payments_date_sql { + my( $class, $start, $end, ) = @_; + + my $unapp_pay = FS::cust_pay->unapplied_sql; + + my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end, + 'unapplied_date'=>1 ); + + " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) "; +} + =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ] Helper method for balance_date_sql; name (and usage) subject to change @@ -6003,6 +8167,13 @@ sub search_sql { unless $params->{'cancelled_pkgs'}; ## + # parse without census tract checkbox + ## + + push @where, "(censustract = '' or censustract is null)" + if $params->{'no_censustract'}; + + ## # dates ## @@ -6166,6 +8337,9 @@ sub email_search_sql { my $job = delete $params->{'job'}; + $params->{'payby'} = [ split(/\0/, $params->{'payby'}) ] + unless ref($params->{'payby'}); + my $sql_query = $class->search_sql($params); my $count_query = delete($sql_query->{'count_query'}); @@ -6227,6 +8401,9 @@ sub process_email_search_sql { $param->{'job'} = $job; + $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ] + unless ref($param->{'payby'}); + my $error = FS::cust_main->email_search_sql( $param ); die $error if $error; @@ -6540,12 +8717,12 @@ sub smart_search { } - #eliminate duplicates - my %saw = (); - @cust_main = grep { !$saw{$_->custnum}++ } @cust_main; - } + #eliminate duplicates + my %saw = (); + @cust_main = grep { !$saw{$_->custnum}++ } @cust_main; + @cust_main; } @@ -7113,6 +9290,15 @@ sub queued_bill { ); } +sub _upgrade_data { #class method + my ($class, %opts) = @_; + + my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL'; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute or die $sth->errstr; + +} + =back =head1 BUGS diff --git a/FS/FS/cust_main_Mixin.pm b/FS/FS/cust_main_Mixin.pm index ced0a1f..86751b1 100644 --- a/FS/FS/cust_main_Mixin.pm +++ b/FS/FS/cust_main_Mixin.pm @@ -26,7 +26,12 @@ for example, from a JOINed search. See httemplate/search/ for examples. =over 4 -=item name +=cut + +sub cust_unlinked_msg { '(unlinked)'; } +sub cust_linked { $_[0]->custnum; } + +=item display_custnum Given an object that contains fields from cust_main (say, from a JOINed search; see httemplate/search/ for examples), returns the equivalent of the @@ -35,8 +40,21 @@ a customer. =cut -sub cust_unlinked_msg { '(unlinked)'; } -sub cust_linked { $_[0]->custnum; } +sub display_custnum { + my $self = shift; + $self->cust_linked + ? FS::cust_main::display_custnum($self) + : $self->cust_unlinked_msg; +} + +=item name + +Given an object that contains fields from cust_main (say, from a JOINed +search; see httemplate/search/ for examples), returns the equivalent of the +FS::cust_main I<name> method, or "(unlinked)" if this object is not linked to +a customer. + +=cut sub name { my $self = shift; diff --git a/FS/FS/cust_main_exemption.pm b/FS/FS/cust_main_exemption.pm new file mode 100644 index 0000000..06d22b7 --- /dev/null +++ b/FS/FS/cust_main_exemption.pm @@ -0,0 +1,128 @@ +package FS::cust_main_exemption; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); +use FS::cust_main; + +=head1 NAME + +FS::cust_main_exemption - Object methods for cust_main_exemption records + +=head1 SYNOPSIS + + use FS::cust_main_exemption; + + $record = new FS::cust_main_exemption \%hash; + $record = new FS::cust_main_exemption { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_main_exemption object represents a customer tax exemption from a +specific tax name (prefix). FS::cust_main_exemption inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item exemptionnum + +Primary key + +=item custnum + +Customer (see L<FS::cust_main>) + +=item taxname + +taxname + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'cust_main_exemption'; } + +=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 record. 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('exemptionnum') + || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') + || $self->ut_text('taxname') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::cust_main>, L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 583a724..69bcd87 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -17,6 +17,7 @@ use FS::cust_bill; use FS::cust_bill_pay; use FS::cust_pay_refund; use FS::cust_main; +use FS::cust_pkg; use FS::cust_pay_void; @ISA = qw( FS::payinfo_transaction_Mixin FS::cust_main_Mixin FS::Record ); @@ -62,28 +63,54 @@ currently supported: =over 4 -=item paynum - primary key (assigned automatically for new payments) +=item paynum -=item custnum - customer (see L<FS::cust_main>) +primary key (assigned automatically for new payments) -=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see +=item custnum + +customer (see L<FS::cust_main>) + +=item _date + +specified as a UNIX timestamp; see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion functions. -=item paid - Amount of this payment +=item paid + +Amount of this payment + +=item otaker + +order taker (assigned automatically, see L<FS::UID>) + +=item payby + +Payment Type (See L<FS::payinfo_Mixin> for valid payby values) + +=item payinfo + +Payment Information (See L<FS::payinfo_Mixin> for data format) -=item otaker - order taker (assigned automatically, see L<FS::UID>) +=item paymask -=item payby - Payment Type (See L<FS::payinfo_Mixin> for valid payby values) +Masked payinfo (See L<FS::payinfo_Mixin> for how this works) -=item payinfo - Payment Information (See L<FS::payinfo_Mixin> for data format) +=item paybatch -=item paymask - Masked payinfo (See L<FS::payinfo_Mixin> for how this works) +text field for tracking card processing or other batch grouping -=item paybatch - text field for tracking card processing or other batch grouping +=item payunique -=item payunique - Optional unique identifer to prevent duplicate transactions. +Optional unique identifer to prevent duplicate transactions. -=item closed - books closed flag, empty or `Y' +=item closed + +books closed flag, empty or `Y' + +=item pkgnum + +Desired pkgnum when using experimental package balances. =back @@ -105,21 +132,22 @@ sub cust_unlinked_msg { ' (cust_pay.paynum '. $self->paynum. ')'; } -=item insert +=item insert [ OPTION => VALUE ... ] Adds this payment to the database. For backwards-compatibility and convenience, if the additional field invnum is defined, an FS::cust_bill_pay record for the full amount of the payment -will be created. In this case, custnum is optional. An hash of optional -arguments may be passed. Currently "manual" is supported. If true, a -payment receipt is sent instead of a statement when 'payment_receipt_email' -configuration option is set. +will be created. In this case, custnum is optional. + +A hash of optional arguments may be passed. Currently "manual" is supported. +If true, a payment receipt is sent instead of a statement when +'payment_receipt_email' configuration option is set. =cut sub insert { - my ($self, %options) = @_; + my($self, %options) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -142,7 +170,6 @@ sub insert { $self->custnum($cust_bill->custnum ); } - my $error = $self->check; return $error if $error; @@ -162,7 +189,7 @@ sub insert { 'amount' => $self->paid, '_date' => $self->_date, }; - $error = $cust_bill_pay->insert; + $error = $cust_bill_pay->insert(%options); if ( $error ) { if ( $ignore_noapply ) { warn "warning: error inserting $cust_bill_pay: $error ". @@ -189,69 +216,15 @@ sub insert { $dbh->commit or die $dbh->errstr if $oldAutoCommit; - #my $cust_main = $self->cust_main; - if ( $conf->exists('payment_receipt_email') - && grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list - ) { - - $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though? - - my $error; - if ( ( exists($options{'manual'}) && $options{'manual'} ) - || ! $conf->exists('invoice_html_statement') - || ! $cust_bill - ) { - - my $receipt_template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ], - ) or do { - warn "can't create payment receipt template: $Text::Template::ERROR"; - return ''; - }; - - my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } - $cust_main->invoicing_list; - - my $payby = $self->payby; - my $payinfo = $self->payinfo; - $payby =~ s/^BILL$/Check/ if $payinfo; - $payinfo = $self->paymask if $payby eq 'CARD' || $payby eq 'CHEK'; - $payby =~ s/^CHEK$/Electronic check/; - - $error = send_email( - 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), - #invoice_from??? well as good as any - 'to' => \@invoicing_list, - 'subject' => 'Payment receipt', - 'body' => [ $receipt_template->fill_in( HASH => { - 'date' => time2str("%a %B %o, %Y", $self->_date), - 'name' => $cust_main->name, - 'paynum' => $self->paynum, - 'paid' => sprintf("%.2f", $self->paid), - 'payby' => ucfirst(lc($payby)), - 'payinfo' => $payinfo, - 'balance' => $cust_main->balance, - } ) ], - ); - - } else { - - my $queue = new FS::queue { - 'paynum' => $self->paynum, - 'job' => 'FS::cust_bill::queueable_email', - }; - $error = $queue->insert( - 'invnum' => $cust_bill->invnum, - 'template' => 'statement', - ); - - } - - if ( $error ) { - warn "can't send payment receipt/statement: $error"; - } - + #payment receipt + my $trigger = $conf->config('payment_receipt-trigger') || 'cust_pay'; + if ( $trigger eq 'cust_pay' ) { + my $error = $self->send_receipt( + 'manual' => $options{'manual'}, + 'cust_bill' => $cust_bill, + 'cust_main' => $cust_main, + ); + warn "can't send payment receipt/statement: $error" if $error; } ''; @@ -340,7 +313,8 @@ sub delete { return $error; } - if ( $conf->config('deletepayments') ne '' ) { + if ( $conf->exists('deletepayments') + && $conf->config('deletepayments') ne '' ) { my $cust_main = $self->cust_main; @@ -411,6 +385,7 @@ sub check { || $self->ut_textn('paybatch') || $self->ut_textn('payunique') || $self->ut_enum('closed', [ '', 'Y' ]) + || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') || $self->payinfo_check() ; return $error if $error; @@ -437,58 +412,109 @@ sub check { $self->SUPER::check; } -=item batch_insert CUST_PAY_OBJECT, ... +=item send_receipt HASHREF | OPTION => VALUE ... -Class method which inserts multiple payments. Takes a list of FS::cust_pay -objects. Returns a list, each element representing the status of inserting the -corresponding payment - empty. If there is an error inserting any payment, the -entire transaction is rolled back, i.e. all payments are inserted or none are. +Sends a payment receipt for this payment.. -For example: +Available options: - my @errors = FS::cust_pay->batch_insert(@cust_pay); - my $num_errors = scalar(grep $_, @errors); - if ( $num_errors == 0 ) { - #success; all payments were inserted - } else { - #failure; no payments were inserted. - } +=over 4 + +=item manual + +Flag indicating the payment is being made manually. + +=item cust_bill + +Invoice (FS::cust_bill) object. If not specified, the most recent invoice +will be assumed. + +=item cust_main + +Customer (FS::cust_main) object (for efficiency). + +=back =cut -sub batch_insert { - my $self = shift; #class method +sub send_receipt { + my $self = shift; + my $opt = ref($_[0]) ? shift : { @_ }; - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; + my $cust_bill = $opt->{'cust_bill'}; + my $cust_main = $opt->{'cust_main'} || $self->cust_main; - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; + my $conf = new FS::Conf; - my $errors = 0; - - my @errors = map { - my $error = $_->insert( 'manual' => 1 ); - if ( $error ) { - $errors++; + return '' + unless $conf->exists('payment_receipt_email') + && grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list; + + $cust_bill ||= ($cust_main->cust_bill)[-1]; #rather inefficient though? + + if ( ( exists($opt->{'manual'}) && $opt->{'manual'} ) + || ! $conf->exists('invoice_html_statement') + || ! $cust_bill + ) { + + my $receipt_template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", $conf->config('payment_receipt_email') ], + ) or do { + warn "can't create payment receipt template: $Text::Template::ERROR"; + return ''; + }; + + my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } + $cust_main->invoicing_list; + + my $payby = $self->payby; + my $payinfo = $self->payinfo; + $payby =~ s/^BILL$/Check/ if $payinfo; + if ( $payby eq 'CARD' || $payby eq 'CHEK' ) { + $payinfo = $self->paymask } else { - $_->cust_main->apply_payments; + $payinfo = $self->decrypt($payinfo); } - $error; - } @_; + $payby =~ s/^CHEK$/Electronic check/; + + my %fill_in = ( + 'date' => time2str("%a %B %o, %Y", $self->_date), + 'name' => $cust_main->name, + 'paynum' => $self->paynum, + 'paid' => sprintf("%.2f", $self->paid), + 'payby' => ucfirst(lc($payby)), + 'payinfo' => $payinfo, + 'balance' => $cust_main->balance, + 'company_name' => $conf->config('company_name', $cust_main->agentnum), + ); + + if ( $opt->{'cust_pkg'} ) { + $fill_in{'pkg'} = $opt->{'cust_pkg'}->part_pkg->pkg; + #setup date, other things? + } + + send_email( + 'from' => $conf->config('invoice_from', $cust_main->agentnum), + #invoice_from??? well as good as any + 'to' => \@invoicing_list, + 'subject' => 'Payment receipt', + 'body' => [ $receipt_template->fill_in( HASH => \%fill_in ) ], + ); - if ( $errors ) { - $dbh->rollback if $oldAutoCommit; } else { - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - } - @errors; + my $queue = new FS::queue { + 'paynum' => $self->paynum, + 'job' => 'FS::cust_bill::queueable_email', + }; + + $queue->insert( + 'invnum' => $cust_bill->invnum, + 'template' => 'statement', + ); + + } } @@ -569,6 +595,61 @@ sub amount { =over 4 +=item batch_insert CUST_PAY_OBJECT, ... + +Class method which inserts multiple payments. Takes a list of FS::cust_pay +objects. Returns a list, each element representing the status of inserting the +corresponding payment - empty. If there is an error inserting any payment, the +entire transaction is rolled back, i.e. all payments are inserted or none are. + +For example: + + my @errors = FS::cust_pay->batch_insert(@cust_pay); + my $num_errors = scalar(grep $_, @errors); + if ( $num_errors == 0 ) { + #success; all payments were inserted + } else { + #failure; no payments were inserted. + } + +=cut + +sub batch_insert { + my $self = shift; #class method + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $errors = 0; + + my @errors = map { + my $error = $_->insert( 'manual' => 1 ); + if ( $error ) { + $errors++; + } else { + $_->cust_main->apply_payments; + } + $error; + } @_; + + if ( $errors ) { + $dbh->rollback if $oldAutoCommit; + } else { + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + } + + @errors; + +} + =item unapplied_sql Returns an SQL fragment to retreive the unapplied amount. diff --git a/FS/FS/cust_pay_pending.pm b/FS/FS/cust_pay_pending.pm index bbabd24..f48e1a8 100644 --- a/FS/FS/cust_pay_pending.pm +++ b/FS/FS/cust_pay_pending.pm @@ -6,6 +6,7 @@ use FS::Record qw( qsearch qsearchs dbh ); #dbh for _upgrade_data use FS::payinfo_transaction_Mixin; use FS::cust_main_Mixin; use FS::cust_main; +use FS::cust_pkg; use FS::cust_pay; @ISA = qw( FS::payinfo_transaction_Mixin FS::cust_main_Mixin FS::Record ); @@ -77,6 +78,10 @@ Expiration date Unique identifer to prevent duplicate transactions. +=item pkgnum + +Desired pkgnum when using experimental package balances. + =item status Pending transaction status, one of the following: @@ -191,7 +196,9 @@ sub check { #|| $self->ut_textn('statustext') || $self->ut_anything('statustext') #|| $self->ut_money('cust_balance') + || $self->ut_hexn('session_id') || $self->ut_foreign_keyn('paynum', 'cust_pay', 'paynum' ) + || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') || $self->payinfo_check() #payby/payinfo/paymask/paydate ; return $error if $error; @@ -215,6 +222,18 @@ sub check { $self->SUPER::check; } +=item cust_main + +Returns the associated L<FS::cust_main> record if any. Otherwise returns false. + +=cut + +sub cust_main { + my $self = shift; + qsearchs('cust_main', { custnum => $self->custnum } ); +} + + #these two are kind-of false laziness w/cust_main::realtime_bop #(currently only used when resolving pending payments manually) diff --git a/FS/FS/cust_pay_void.pm b/FS/FS/cust_pay_void.pm index de05f71..86fbbe5 100644 --- a/FS/FS/cust_pay_void.pm +++ b/FS/FS/cust_pay_void.pm @@ -9,6 +9,7 @@ use FS::cust_pay; #use FS::cust_bill_pay; #use FS::cust_pay_refund; #use FS::cust_main; +use FS::cust_pkg; @ISA = qw( FS::Record FS::payinfo_Mixin ); @@ -40,24 +41,44 @@ are currently supported: =over 4 -=item paynum - primary key (assigned automatically for new payments) +=item paynum -=item custnum - customer (see L<FS::cust_main>) +primary key (assigned automatically for new payments) -=item paid - Amount of this payment +=item custnum -=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see +customer (see L<FS::cust_main>) + +=item paid + +Amount of this payment + +=item _date + +specified as a UNIX timestamp; see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion functions. -=item payby - `CARD' (credit cards), `CHEK' (electronic check/ACH), +=item payby + +`CARD' (credit cards), `CHEK' (electronic check/ACH), `LECB' (phone bill billing), `BILL' (billing), `CASH' (cash), `WEST' (Western Union), `MCRD' (Manual credit card), or `COMP' (free) -=item payinfo - card number, check #, or comp issuer (4-8 lowercase alphanumerics; think username), respectively +=item payinfo + +card number, check #, or comp issuer (4-8 lowercase alphanumerics; think username), respectively + +=item paybatch + +text field for tracking card processing + +=item closed + +books closed flag, empty or `Y' -=item paybatch - text field for tracking card processing +=item pkgnum -=item closed - books closed flag, empty or `Y' +Desired pkgnum when using experimental package balances. =item void_date @@ -156,6 +177,7 @@ sub check { || $self->ut_number('_date') || $self->ut_textn('paybatch') || $self->ut_enum('closed', [ '', 'Y' ]) + || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') || $self->ut_numbern('void_date') || $self->ut_textn('reason') ; diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index dd6db1b..e839eb9 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -2,9 +2,11 @@ package FS::cust_pkg; use strict; use vars qw(@ISA $disable_agentcheck $DEBUG); +use Carp qw(cluck); use Scalar::Util qw( blessed ); use List::Util qw(max); use Tie::IxHash; +use MIME::Entity; use FS::UID qw( getotaker dbh ); use FS::Misc qw( send_email ); use FS::Record qw( qsearch qsearchs ); @@ -120,6 +122,10 @@ Billing item definition (see L<FS::part_pkg>) Optional link to package location (see L<FS::location>) +=item start_date + +date + =item setup date @@ -228,6 +234,14 @@ If set true, supresses any referral credit to a referring customer. cust_pkg_option records will be created +=item ticket_subject + +a ticket will be added to this customer with this subject + +=item ticket_queue + +an optional queue name for ticket additions + =back =cut @@ -270,6 +284,29 @@ sub insert { my $conf = new FS::Conf; + if ( $conf->config('ticket_system') && $options{ticket_subject} ) { + eval ' + use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" ); + use RT; + '; + die $@ if $@; + + RT::LoadConfig(); + RT::Init(); + my $q = new RT::Queue($RT::SystemUser); + $q->Load($options{ticket_queue}) if $options{ticket_queue}; + my $t = new RT::Ticket($RT::SystemUser); + my $mime = new MIME::Entity; + $mime->build( Type => 'text/plain', Data => $options{ticket_subject} ); + $t->Create( $options{ticket_queue} ? (Queue => $q) : (), + Subject => $options{ticket_subject}, + MIMEObj => $mime, + ); + $t->AddLink( Type => 'MemberOf', + Target => 'freeside://freeside/cust_main/'. $self->custnum, + ); + } + if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) { my $queue = new FS::queue { 'job' => 'FS::cust_main::queueable_print', @@ -439,15 +476,14 @@ replace methods. sub check { my $self = shift; - $self->locationnum('') - if defined($self->locationnum) && length($self->locationnum) - && ( $self->locationnum == 0 || $self->locationnum == -1 ); + $self->locationnum('') if !$self->locationnum || $self->locationnum == -1; my $error = $self->ut_numbern('pkgnum') || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') || $self->ut_numbern('pkgpart') || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum') + || $self->ut_numbern('start_date') || $self->ut_numbern('setup') || $self->ut_numbern('bill') || $self->ut_numbern('susp') @@ -481,10 +517,10 @@ sub check { unless ( $disable_agentcheck ) { my $agent = qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } ); - my $pkgpart_href = $agent->pkgpart_hashref; - return "agent ". $agent->agentnum. + return "agent ". $agent->agentnum. ':'. $agent->agent. " can't purchase pkgpart ". $self->pkgpart - unless $pkgpart_href->{ $self->pkgpart }; + unless $agent->pkgpart_hashref->{ $self->pkgpart } + || $agent->agentnum == $self->part_pkg->agentnum; } $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' ); @@ -524,6 +560,8 @@ Available options are: =item date - can be set to a unix style timestamp to specify when to cancel (expire) +=item nobill - can be set true to skip billing if it might otherwise be done. + =back If there is an error, returns the error, otherwise returns false. @@ -534,6 +572,8 @@ sub cancel { my( $self, %options ) = @_; my $error; + my $conf = new FS::Conf; + warn "cust_pkg::cancel called with options". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; @@ -559,6 +599,20 @@ sub cancel { my $date = $options{date} if $options{date}; # expire/cancel later $date = '' if ($date && $date <= time); # complain instead? + #race condition: usage could be ongoing until unprovisioned + #resolved by performing a change package instead (which unprovisions) and + #later cancelling + if ( !$options{nobill} && !$date && $conf->exists('bill_usage_on_cancel') ) { + my $copy = $self->new({$self->hash}); + my $error = + $copy->cust_main->bill( pkg_list => [ $copy ], cancel => 1 ); + warn "Error billing during cancel, custnum ". + #$self->cust_main->custnum. ": $error" + ": $error" + if $error; + } + + my $cancel_time = $options{'time'} || time; if ( $options{'reason'} ) { @@ -594,7 +648,6 @@ sub cancel { # Add a credit for remaining service my $remaining_value = $self->calc_remain(time=>$cancel_time); if ( $remaining_value > 0 && !$options{'no_credit'} ) { - my $conf = new FS::Conf; my $error = $self->cust_main->credit( $remaining_value, 'Credit for unused time on '. $self->part_pkg->pkg, @@ -620,10 +673,8 @@ sub cancel { $dbh->commit or die $dbh->errstr if $oldAutoCommit; return '' if $date; #no errors - my $conf = new FS::Conf; my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list; if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) { - my $conf = new FS::Conf; my $error = send_email( 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), 'to' => \@invoicing_list, @@ -1137,6 +1188,22 @@ sub change { return "Unable to transfer all services from package ". $self->pkgnum; } + #reset usage if changing pkgpart + # AND usage rollover is off (otherwise adds twice, now and at package bill) + if ($self->pkgpart != $cust_pkg->pkgpart) { + my $part_pkg = $cust_pkg->part_pkg; + $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid + ? () + : ( 'null' => 1 ) + ) + if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover'); + + if ($error) { + $dbh->rollback if $oldAutoCommit; + return "Error setting usage values: $error"; + } + } + #Good to go, cancel old package. $error = $self->cancel( quiet=>1 ); if ($error) { @@ -1209,10 +1276,9 @@ L<FS::part_pkg>). sub part_pkg { my $self = shift; - #exists( $self->{'_pkgpart'} ) - $self->{'_pkgpart'} - ? $self->{'_pkgpart'} - : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); + return $self->{'_pkgpart'} if $self->{'_pkgpart'}; + cluck "cust_pkg->part_pkg called" if $DEBUG > 1; + qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); } =item old_cust_pkg @@ -1402,11 +1468,15 @@ services. sub cust_svc { my $self = shift; + return () unless $self->num_cust_svc(@_); + if ( @_ ) { return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum, 'svcpart' => shift, } ); } + cluck "cust_pkg->cust_svc called" if $DEBUG > 2; + #if ( $self->{'_svcnum'} ) { # values %{ $self->{'_svcnum'}->cache }; #} else { @@ -1427,7 +1497,8 @@ is specified, return only the matching services. sub overlimit { my $self = shift; - grep { $_->overlimit } $self->cust_svc; + return () unless $self->num_cust_svc(@_); + grep { $_->overlimit } $self->cust_svc(@_); } =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] @@ -1476,9 +1547,19 @@ specified, counts only the matching services. sub num_cust_svc { my $self = shift; + + return $self->{'_num_cust_svc'} + if !scalar(@_) + && exists($self->{'_num_cust_svc'}) + && $self->{'_num_cust_svc'} =~ /\d/; + + cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'} + if $DEBUG > 2; + my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?'; $sql .= ' AND svcpart = ?' if @_; - my $sth = dbh->prepare($sql) or die dbh->errstr; + + my $sth = dbh->prepare($sql) or die dbh->errstr; $sth->execute($self->pkgnum, @_) or die $sth->errstr; $sth->fetchrow_arrayref->[0]; } @@ -1535,7 +1616,8 @@ sub part_svc { $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil $part_svc->{'Hash'}{'num_avail'} = max( 0, $pkg_svc->quantity - $num_cust_svc ); - $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ]; + $part_svc->{'Hash'}{'cust_pkg_svc'} = + $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []; $part_svc; } $self->part_pkg->pkg_svc; @@ -1545,7 +1627,8 @@ sub part_svc { my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart); $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ? - $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ]; + $part_svc->{'Hash'}{'cust_pkg_svc'} = + $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []; $part_svc; } $self->extra_part_svc; @@ -1567,20 +1650,38 @@ sub extra_part_svc { my $pkgnum = $self->pkgnum; my $pkgpart = $self->pkgpart; +# qsearch( { +# 'table' => 'part_svc', +# 'hashref' => {}, +# 'extra_sql' => +# "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc +# WHERE pkg_svc.svcpart = part_svc.svcpart +# AND pkg_svc.pkgpart = ? +# AND quantity > 0 +# ) +# AND 0 < ( SELECT COUNT(*) FROM cust_svc +# LEFT JOIN cust_pkg USING ( pkgnum ) +# WHERE cust_svc.svcpart = part_svc.svcpart +# AND pkgnum = ? +# )", +# 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ], +# } ); + +#seems to benchmark slightly faster... qsearch( { - 'table' => 'part_svc', - 'hashref' => {}, - 'extra_sql' => "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc - WHERE pkg_svc.svcpart = part_svc.svcpart - AND pkg_svc.pkgpart = $pkgpart - AND quantity > 0 - ) - AND 0 < ( SELECT count(*) - FROM cust_svc - LEFT JOIN cust_pkg using ( pkgnum ) - WHERE cust_svc.svcpart = part_svc.svcpart - AND pkgnum = $pkgnum - )", + 'select' => 'DISTINCT ON (svcpart) part_svc.*', + 'table' => 'part_svc', + 'addl_from' => + 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart + AND pkg_svc.pkgpart = ? + AND quantity > 0 + ) + LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart ) + LEFT JOIN cust_pkg USING ( pkgnum ) + ', + 'hashref' => {}, + 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ", + 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ], } ); } @@ -1635,8 +1736,8 @@ tie my %statuscolor, 'Tie::IxHash', sub statuses { my $self = shift; #could be class... - grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway - # mayble split btw one-time vs. recur + #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway + # # mayble split btw one-time vs. recur keys %statuscolor; } @@ -1651,6 +1752,63 @@ sub statuscolor { $statuscolor{$self->status}; } +=item pkg_label + +Returns a label for this package. (Currently "pkgnum: pkg - comment" or +"pkg-comment" depending on user preference). + +=cut + +sub pkg_label { + my $self = shift; + my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 ); + $label = $self->pkgnum. ": $label" + if $FS::CurrentUser::CurrentUser->option('show_pkgnum'); + $label; +} + +=item pkg_label_long + +Returns a long label for this package, adding the primary service's label to +pkg_label. + +=cut + +sub pkg_label_long { + my $self = shift; + my $label = $self->pkg_label; + my $cust_svc = $self->primary_cust_svc; + $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc; + $label; +} + +=item primary_cust_svc + +Returns a primary service (as FS::cust_svc object) if one can be identified. + +=cut + +#for labeling purposes - might not 100% match up with part_pkg->svcpart's idea + +sub primary_cust_svc { + my $self = shift; + + my @cust_svc = $self->cust_svc; + + return '' unless @cust_svc; #no serivces - irrelevant then + + return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service + + # primary service as specified in the package definition + # or exactly one service definition with quantity one + my $svcpart = $self->part_pkg->svcpart; + @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc; + return $cust_svc[0] if scalar(@cust_svc) == 1; + + #couldn't identify one thing.. + return ''; +} + =item labels Returns a list of lists, calling the label method for all services @@ -1679,6 +1837,19 @@ sub h_labels { map { [ $_->label(@_) ] } $self->h_cust_svc(@_); } +=item labels_short + +Like labels, except returns a simple flat list, and shortens long +(currently >5 or the cust_bill-max_same_services configuration value) lists of +identical services to one line that lists the service label and the number of +individual services rather than individual items. + +=cut + +sub labels_short { + shift->_labels_short( 'labels', @_ ); +} + =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ] Like h_labels, except returns a simple flat list, and shortens long @@ -1689,7 +1860,11 @@ individual services rather than individual items. =cut sub h_labels_short { - my $self = shift; + shift->_labels_short( 'h_labels', @_ ); +} + +sub _labels_short { + my( $self, $method ) = ( shift, shift ); my $conf = new FS::Conf; my $max_same_services = $conf->config('cust_bill-max_same_services') || 5; @@ -2039,6 +2214,18 @@ sub active_sql { " AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) "; } +=item not_yet_billed_sql + +Returns an SQL expression identifying packages which have not yet been billed. + +=cut + +sub not_yet_billed_sql { " + ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) +"; } + =item inactive_sql Returns an SQL expression identifying inactive packages (one-time packages @@ -2048,6 +2235,7 @@ that are otherwise unsuspended/uncancelled). sub inactive_sql { " ". $_[0]->onetime_sql(). " + AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) "; } @@ -2100,11 +2288,15 @@ active, inactive, suspended, cancel (or cancelled) active, inactive, suspended, one-time charge, inactive, cancel (or cancelled) +=item custom + + boolean selects custom packages + =item classnum =item pkgpart -list specified how? +pkgpart or arrayref or hashref of pkgparts =item setup @@ -2172,8 +2364,13 @@ sub search_sql { push @where, FS::cust_pkg->active_sql(); - } elsif ( $params->{'magic'} eq 'inactive' - || $params->{'status'} eq 'inactive' ) { + } elsif ( $params->{'magic'} eq 'not yet billed' + || $params->{'status'} eq 'not yet billed' ) { + + push @where, FS::cust_pkg->not_yet_billed_sql(); + + } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/ + || $params->{'status'} =~ /^(one-time charge|inactive)/ ) { push @where, FS::cust_pkg->inactive_sql(); @@ -2187,10 +2384,6 @@ sub search_sql { push @where, FS::cust_pkg->cancelled_sql(); - } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) { - - push @where, FS::cust_pkg->inactive_sql(); - } ### @@ -2227,12 +2420,68 @@ sub search_sql { #eslaf ### + # parse package report options + ### + + my @report_option = (); + if ( exists($params->{'report_option'}) + && $params->{'report_option'} =~ /^([,\d]*)$/ + ) + { + @report_option = split(',', $1); + } + + if (@report_option) { + # this will result in the empty set for the dangling comma case as it should + push @where, + map{ "0 < ( SELECT count(*) FROM part_pkg_option + WHERE part_pkg_option.pkgpart = part_pkg.pkgpart + AND optionname = 'report_option_$_' + AND optionvalue = '1' )" + } @report_option; + } + + #eslaf + + ### + # parse custom + ### + + push @where, "part_pkg.custom = 'Y'" if $params->{custom}; + + ### + # parse censustract + ### + + if ( exists($params->{'censustract'}) ) { + $params->{'censustract'} =~ /^([.\d]*)$/; + my $censustract = "cust_main.censustract = '$1'"; + $censustract .= ' OR cust_main.censustract is NULL' unless $1; + push @where, "( $censustract )"; + } + + ### # parse part_pkg ### - my $pkgpart = join (' OR pkgpart=', - grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'})); - push @where, '(pkgpart=' . $pkgpart . ')' if $pkgpart; + if ( ref($params->{'pkgpart'}) ) { + + my @pkgpart = (); + if ( ref($params->{'pkgpart'}) eq 'HASH' ) { + @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} }; + } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) { + @pkgpart = @{ $params->{'pkgpart'} }; + } else { + die 'unhandled pkgpart ref '. $params->{'pkgpart'}; + } + + @pkgpart = grep /^(\d+)$/, @pkgpart; + + push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart); + + } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) { + push @where, "pkgpart = $1"; + } ### # parse dates @@ -2714,11 +2963,11 @@ All svc_accts which are part of this package have their values reset. =cut sub set_usage { - my ($self, $valueref) = @_; + my ($self, $valueref, %opt) = @_; foreach my $cust_svc ($self->cust_svc){ my $svc_x = $cust_svc->svc_x; - $svc_x->set_usage($valueref) + $svc_x->set_usage($valueref, %opt) if $svc_x->can("set_usage"); } } diff --git a/FS/FS/cust_pkg_reason.pm b/FS/FS/cust_pkg_reason.pm index 4037513..bb0542b 100644 --- a/FS/FS/cust_pkg_reason.pm +++ b/FS/FS/cust_pkg_reason.pm @@ -136,12 +136,15 @@ sub reasontext { use FS::h_cust_pkg; use FS::h_cust_pkg_reason; +use FS::Schema qw(dbdef); sub _upgrade_data { # class method my ($class, %opts) = @_; - my $test_cust_pkg_reason = new FS::cust_pkg_reason; - return '' unless $test_cust_pkg_reason->dbdef_table->column('action'); + return '' unless dbdef->table('cust_pkg_reason')->column('action'); + + my $action_replace = + " AND ( history_action = 'replace_old' OR history_action = 'replace_new' )"; my $count = 0; my @unmigrated = qsearch('cust_pkg_reason', { 'action' => '' } ); @@ -151,27 +154,24 @@ sub _upgrade_data { # class method next unless scalar(@history_cust_pkg_reason) == 1; - my %action_value = ( op => 'LIKE', - value => 'replace_%', - ); my $hashref = { pkgnum => $_->pkgnum, history_date => $history_cust_pkg_reason[0]->history_date, - history_action => { %action_value }, }; - my @history = qsearch({ table => 'h_cust_pkg', - hashref => $hashref, - order_by => 'ORDER BY history_action', + my @history = qsearch({ table => 'h_cust_pkg', + hashref => $hashref, + extra_sql => $action_replace, + order_by => 'ORDER BY history_action', }); my $fuzz = 0; while (scalar(@history) < 2 && $fuzz < 3) { $hashref->{history_date}++; - $hashref->{history_action} = { %action_value }; # qsearch distorts this! $fuzz++; - push @history, qsearch({ table => 'h_cust_pkg', - hashref => $hashref, - order_by => 'ORDER BY history_action', + push @history, qsearch({ table => 'h_cust_pkg', + hashref => $hashref, + extra_sql => $action_replace, + order_by => 'ORDER BY history_action', }); } @@ -226,26 +226,23 @@ sub _upgrade_data { # class method }); foreach ( @unmigrated ) { - my %action_value = ( op => 'LIKE', - value => 'replace_%', - ); my $hashref = { pkgnum => $_->pkgnum, history_date => $_->date, - history_action => { %action_value }, }; - my @history = qsearch({ table => 'h_cust_pkg', - hashref => $hashref, - order_by => 'ORDER BY history_action', + my @history = qsearch({ table => 'h_cust_pkg', + hashref => $hashref, + extra_sql => $action_replace, + order_by => 'ORDER BY history_action', }); my $fuzz = 0; while (scalar(@history) < 2 && $fuzz < 3) { $hashref->{history_date}++; - $hashref->{history_action} = { %action_value }; # qsearch distorts this! $fuzz++; push @history, qsearch({ table => 'h_cust_pkg', hashref => $hashref, + extra_sql => $action_replace, order_by => 'ORDER BY history_action', }); } diff --git a/FS/FS/cust_recon.pm b/FS/FS/cust_recon.pm new file mode 100644 index 0000000..0a1ca3a --- /dev/null +++ b/FS/FS/cust_recon.pm @@ -0,0 +1,193 @@ +package FS::cust_recon; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::cust_recon - Object methods for cust_recon records + +=head1 SYNOPSIS + + use FS::cust_recon; + + $record = new FS::cust_recon \%hash; + $record = new FS::cust_recon { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_recon object represents a customer reconcilation. FS::cust_recon +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item reconid + +primary key + +=item recondate + +recondate + +=item custnum + +custnum + +=item agentnum + +agentnum + +=item last + +last + +=item first + +first + +=item address1 + +address1 + +=item address2 + +address2 + +=item city + +city + +=item state + +state + +=item zip + +zip + +=item pkg + +pkg + +=item adjourn + +adjourn + +=item status + +status + +=item agent_custid + +agent_custid + +=item agent_pkg + +agent_pkg + +=item agent_adjourn + +agent_adjourn + +=item comments + +comments + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new customer reconcilation. To add the reconcilation to the database, +see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +sub table { 'cust_recon'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item delete + +Delete this record from the database. + +=cut + +=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 + +=item check + +Checks all fields to make sure this is a valid reconcilation. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('reconid') + || $self->ut_numbern('recondate') + || $self->ut_number('custnum') + || $self->ut_number('agentnum') + || $self->ut_text('last') + || $self->ut_text('first') + || $self->ut_text('address1') + || $self->ut_textn('address2') + || $self->ut_text('city') + || $self->ut_textn('state') + || $self->ut_textn('zip') + || $self->ut_textn('pkg') + || $self->ut_numbern('adjourn') + || $self->ut_textn('status') + || $self->ut_text('agent_custid') + || $self->ut_textn('agent_pkg') + || $self->ut_numbern('agent_adjourn') + || $self->ut_textn('comments') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +Possibly the existance of this module. + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_statement.pm b/FS/FS/cust_statement.pm new file mode 100644 index 0000000..83dd5c1 --- /dev/null +++ b/FS/FS/cust_statement.pm @@ -0,0 +1,272 @@ +package FS::cust_statement; + +use strict; +use base qw( FS::cust_bill ); +use FS::Record qw( dbh qsearch ); #qsearchs ); +use FS::cust_main; +use FS::cust_bill; + +=head1 NAME + +FS::cust_statement - Object methods for cust_statement records + +=head1 SYNOPSIS + + use FS::cust_statement; + + $record = new FS::cust_statement \%hash; + $record = new FS::cust_statement { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_statement object represents an informational statement which +aggregates one or more invoices. FS::cust_statement inherits from +FS::cust_bill. + +The following fields are currently supported: + +=over 4 + +=item statementnum + +primary key + +=item custnum + +customer + +=item _date + +date + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +sub new { FS::Record::new(@_); } + +sub table { 'cust_statement'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + FS::Record::insert($self); + + foreach my $cust_bill ( + qsearch({ + 'table' => 'cust_bill', + 'hashref' => { 'custnum' => $self->custnum, + 'statementnum' => '', + }, + 'extra_sql' => 'FOR UPDATE' , + }) + ) + { + $cust_bill->statementnum( $self->statementnum ); + my $error = $cust_bill->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error associating invoice: $error"; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no error + +} + +=item delete + +Delete this record from the database. + +=cut + +sub delete { FS::Record::delete(@_); } + +=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 + +sub replace { FS::Record::replace(@_); } + +sub replace_check { ''; } + +=item check + +Checks all fields to make sure this is a valid record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('statementnum') + || $self->ut_foreign_key('custnum', 'cust_main', 'custnum' ) + || $self->ut_numbern('_date') + ; + return $error if $error; + + $self->_date(time) unless $self->_date; + + #don't want to call cust_bill, and Record just checks virtual fields + #$self->SUPER::check; + ''; + +} + +=item cust_bill + +Returns the associated invoices (cust_bill records) for this statement. + +=cut + +sub cust_bill { + my $self = shift; + qsearch('cust_bill', { 'statementnum' => $self->statementnum } ); +} + +sub _aggregate { + my( $self, $method ) = ( shift, shift ); + + my @agg = (); + + foreach my $cust_bill ( $self->cust_bill ) { + push @agg, $cust_bill->$method( @_ ); + } + + @agg; +} + +sub _total { + my( $self, $method ) = ( shift, shift ); + + my $total = 0; + + foreach my $cust_bill ( $self->cust_bill ) { + $total += $cust_bill->$method( @_ ); + } + + $total; +} + +=item cust_bill_pkg + +Returns the line items (see L<FS::cust_bill_pkg>) for all associated invoices. + +=item cust_bill_pkg_pkgnum PKGNUM + +Returns the line items (see L<FS::cust_bill_pkg>) for all associated invoices +and specified pkgnum. + +=item cust_bill_pay + +Returns all payment applications (see L<FS::cust_bill_pay>) for all associated +invoices. + +=item cust_credited + +Returns all applied credits (see L<FS::cust_credit_bill>) for all associated +invoices. + +=item cust_bill_pay_pkgnum PKGNUM + +Returns all payment applications (see L<FS::cust_bill_pay>) for all associated +invoices with matching pkgnum. + +=item cust_credited_pkgnum PKGNUM + +Returns all applied credits (see L<FS::cust_credit_bill>) for all associated +invoices with matching pkgnum. + +=cut + +sub cust_bill_pay { shift->_aggregate('cust_bill_pay', @_); } +sub cust_credited { shift->_aggregate('cust_credited', @_); } +sub cust_bill_pay_pkgnum { shift->_aggregate('cust_bill_pay_pkgnum', @_); } +sub cust_credited_pkgnum { shift->_aggregate('cust_credited_pkgnum', @_); } + +sub cust_bill_pkg { shift->_aggregate('cust_bill_pkg', @_); } +sub cust_bill_pkg_pkgnum { shift->_aggregate('cust_bill_pkg_pkgnum', @_); } + +=item tax + +Returns the total tax amount for all assoicated invoices.0 + +=cut + +=item charged + +Returns the total amount charged for all associated invoices. + +=cut + +=item owed + +Returns the total amount owed for all associated invoices. + +=cut + +sub tax { shift->_total('tax', @_); } +sub charged { shift->_total('charged', @_); } +sub owed { shift->_total('owed', @_); } + +#don't show previous info +sub previous { + ( 0 ); # 0, empty list +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::cust_bill>, L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 30b2390..3c28204 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -375,23 +375,34 @@ Usage example: my($label, $value, $svcdb) = $cust_svc->label; +=item label_long + +Like the B<label> method, except the second item in the list ("meaningful +identifier") may be longer - typically, a full name is included. + =cut -sub label { +sub label { shift->_label('svc_label', @_); } +sub label_long { shift->_label('svc_label_long', @_); } + +sub _label { my $self = shift; - carp "FS::cust_svc::label called on $self" if $DEBUG; + my $method = shift; my $svc_x = $self->svc_x or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum; - $self->_svc_label($svc_x); + $self->$method($svc_x); } +sub svc_label { shift->_svc_label('label', @_); } +sub svc_label_long { shift->_svc_label('label_long', @_); } + sub _svc_label { - my( $self, $svc_x ) = ( shift, shift ); + my( $self, $method, $svc_x ) = ( shift, shift, shift ); ( $self->part_svc->svc, - $svc_x->label(@_), + $svc_x->$method(@_), $self->part_svc->svcdb, $self->svcnum ); @@ -629,7 +640,8 @@ sub attribute_since_sqlradacct { ) or die $dbh->errstr; $sth->execute($username, $start, $end) or die $sth->errstr; - $sum += $sth->fetchrow_arrayref->[0]; + my $row = $sth->fetchrow_arrayref; + $sum += $row->[0] if defined($row->[0]); warn "$mes done SUMing sessions\n" if $DEBUG; @@ -680,32 +692,57 @@ CDRs are associated with svc_phone services via svc_phone.phonenum =cut sub get_cdrs_for_update { + my $self = shift; + $self->get_cdrs( 'freesidestatus' => '', + 'for_update' => 1, + @_, + ); +} + +sub get_cdrs { my($self, %options) = @_; my @fields = ( 'charged_party' ); push @fields, 'src' unless $options{'disable_src'}; - #CDRs are now associated with svc_phone services via svc_phone.phonenum + my $for_update = $options{'for_update'} ? 'FOR UPDATE' : ''; + + my %hash = (); + $hash{'freesidestatus'} = $options{'freesidestatus'} + if exists($options{'freesidestatus'}); + + #CDRs are associated with svc_phone services via svc_phone.phonenum + #return () unless $self->svc_x->isa('FS::svc_phone'); return () unless $self->part_svc->svcdb eq 'svc_phone'; my $number = $self->svc_x->phonenum; my $prefix = $options{'default_prefix'}; - my @where = map " $_ = '$number' ", @fields; - push @where, map " $_ = '$prefix$number' ", @fields + my @orwhere = map " $_ = '$number' ", @fields; + push @orwhere, map " $_ = '$prefix$number' ", @fields if length($prefix); if ( $prefix =~ /^\+(\d+)$/ ) { - push @where, map " $_ = '$1$number' ", @fields + push @orwhere, map " $_ = '$1$number' ", @fields + } + + my @where = ( ' ( '. join(' OR ', @orwhere ). ' ) ' ); + + if ( $options{'begin'} ) { + push @where, 'startdate >= '. $options{'begin'}; + } + if ( $options{'end'} ) { + push @where, 'startdate < '. $options{'end'}; } - my $extra_sql = ' AND ( '. join(' OR ', @where ). ' ) '; + my $extra_sql = ( keys(%hash) ? ' AND ' : ' WHERE ' ). join(' AND ', @where ); my @cdrs = qsearch( { 'table' => 'cdr', - 'hashref' => { 'freesidestatus' => '', }, - 'extra_sql' => "$extra_sql FOR UPDATE", + 'hashref' => \%hash, + 'extra_sql' => $extra_sql, + 'order_by' => "ORDER BY startdate $for_update", } ); @cdrs; diff --git a/FS/FS/cust_svc_option.pm b/FS/FS/cust_svc_option.pm index 0a242d5..07fec90 100644 --- a/FS/FS/cust_svc_option.pm +++ b/FS/FS/cust_svc_option.pm @@ -124,8 +124,6 @@ sub check { =head1 BUGS -The author forgot to customize this manpage. - =head1 SEE ALSO L<FS::Record>, schema.html from the base documentation. diff --git a/FS/FS/cdr_upstream_rate.pm b/FS/FS/cust_tax_adjustment.pm index 2fd9782..5891368 100644 --- a/FS/FS/cdr_upstream_rate.pm +++ b/FS/FS/cust_tax_adjustment.pm @@ -1,22 +1,21 @@ -package FS::cdr_upstream_rate; +package FS::cust_tax_adjustment; use strict; -use vars qw( @ISA ); +use base qw( FS::Record ); use FS::Record qw( qsearch qsearchs ); -use FS::rate_detail; - -@ISA = qw(FS::Record); +use FS::cust_main; +use FS::cust_bill_pkg; =head1 NAME -FS::cdr_upstream_rate - Object methods for cdr_upstream_rate records +FS::cust_tax_adjustment - Object methods for cust_tax_adjustment records =head1 SYNOPSIS - use FS::cdr_upstream_rate; + use FS::cust_tax_adjustment; - $record = new FS::cdr_upstream_rate \%hash; - $record = new FS::cdr_upstream_rate { 'column' => 'value' }; + $record = new FS::cust_tax_adjustment \%hash; + $record = new FS::cust_tax_adjustment { 'column' => 'value' }; $error = $record->insert; @@ -28,17 +27,36 @@ FS::cdr_upstream_rate - Object methods for cdr_upstream_rate records =head1 DESCRIPTION -An FS::cdr_upstream_rate object represents an upstream rate mapping to -internal rate detail (see L<FS::rate_detail>). FS::cdr_upstream_rate inherits -from FS::Record. The following fields are currently supported: +An FS::cust_tax_adjustment object represents an taxation adjustment. +FS::cust_tax_adjustment inherits from FS::Record. The following fields are +currently supported: =over 4 -=item upstreamratenum - primary key +=item adjustmentnum + +primary key + +=item custnum + +custnum + +=item taxname + +taxname + +=item amount + +amount -=item upstream_rateid - CDR upstream Rate ID (cdr.upstream_rateid - see L<FS::cdr>) +=item comment + +comment + +=item billpkgnum + +billpkgnum -=item ratedetailnum - Rate detail - see L<FS::rate_detail> =back @@ -48,8 +66,7 @@ from FS::Record. The following fields are currently supported: =item new HASHREF -Creates a new upstream rate mapping. To add the upstream rate to the database, -see L<"insert">. +Creates a new record. To add the record to the database, see L<"insert">. Note that this stores the hash reference, not a distinct copy of the hash it points to. You can ask the object for a copy with the I<hash> method. @@ -58,7 +75,7 @@ points to. You can ask the object for a copy with the I<hash> method. # the new method can be inherited from FS::Record, if a table method is defined -sub table { 'cdr_upstream_rate'; } +sub table { 'cust_tax_adjustment'; } =item insert @@ -88,7 +105,7 @@ returns the error, otherwise returns false. =item check -Checks all fields to make sure this is a valid upstream rate. If there is +Checks all fields to make sure this is a valid record. If there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. @@ -101,27 +118,21 @@ sub check { my $self = shift; my $error = - $self->ut_numbern('upstreamratenum') - #|| $self->ut_number('upstream_rateid') - || $self->ut_alpha('upstream_rateid') - #|| $self->ut_text('upstream_rateid') - || $self->ut_foreign_key('ratedetailnum', 'rate_detail', 'ratedetailnum' ) + $self->ut_numbern('adjustmentnum') + || $self->ut_foreign_key('custnum', 'cust_main', 'custnum' ) + || $self->ut_text('taxname') + || $self->ut_money('amount') + || $self->ut_textn('comment') + || $self->ut_foreign_keyn('billpkgnum', 'cust_bill_pkg', 'billpkgnum' ) ; return $error if $error; $self->SUPER::check; } -=item rate_detail - -Returns the internal rate detail object for this upstream rate (see -L<FS::rate_detail>). - -=cut - -sub rate_detail { +sub cust_bill_pkg { my $self = shift; - qsearchs('rate_detail', { 'ratedetailnum' => $self->ratedetailnum } ); + qsearchs('cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum } ); } =back diff --git a/FS/FS/cust_tax_location.pm b/FS/FS/cust_tax_location.pm index b7437a0..161a654 100644 --- a/FS/FS/cust_tax_location.pm +++ b/FS/FS/cust_tax_location.pm @@ -119,25 +119,31 @@ sub check { || $self->ut_text('state') || $self->ut_numbern('plus4hi') || $self->ut_numbern('plus4lo') - || $self->ut_enum('default', [ '', ' ', 'Y' ] ) # wtf? + || $self->ut_enum('default_location', [ '', 'Y' ] ) || $self->ut_enum('cityflag', [ '', 'I', 'O', 'B' ] ) || $self->ut_alpha('geocode') ; return $error if $error; - #ugh! cch canada weirdness - if ($self->state eq 'CN') { + #ugh! cch canada weirdness and more + if ($self->state eq 'CN' && $self->data_vendor eq 'cch-zip' ) { $error = "Illegal cch canadian zip" unless $self->zip =~ /^[A-Z]$/; + } elsif ($self->state =~ /^E([B-DFGILNPR-UW])$/ && $self->data_vendor eq 'cch-zip' ) { + $error = "Illegal cch european zip" + unless $self->zip =~ /^E$1$/; } else { $error = $self->ut_number('zip', $self->state eq 'CN' ? 'CA' : 'US'); } return $error if $error; - #ugh! cch canada weirdness + #ugh! cch canada weirdness and more return "must specify either city/county or plus4lo/plus4hi" unless ( $self->plus4lo && $self->plus4hi || - ($self->city || $self->state eq 'CN') && $self->county + ( $self->city || + $self->state eq 'CN' || + $self->state =~ /^E([B-DFGILNPR-UW])$/ + ) && $self->county ); $self->SUPER::check; @@ -179,7 +185,7 @@ sub batch_import { } if ( $format eq 'cch' || $format eq 'cch-update' ) { - @fields = qw( zip state plus4lo plus4hi geocode default ); + @fields = qw( zip state plus4lo plus4hi geocode default_location ); push @fields, 'actionflag' if $format eq 'cch-update'; $imported++ if $format eq 'cch-update'; #empty file ok @@ -188,6 +194,7 @@ sub batch_import { my $hash = shift; $hash->{'data_vendor'} = 'cch'; + $hash->{'default_location'} =~ s/ //g; if (exists($hash->{actionflag}) && $hash->{actionflag} eq 'D') { delete($hash->{actionflag}); @@ -210,7 +217,7 @@ sub batch_import { }; } elsif ( $format eq 'cch-zip' || $format eq 'cch-update-zip' ) { - @fields = qw( zip city county state postalcity countyfips countydef default geocode cityflag unique ); + @fields = qw( zip city county state postalcity countyfips countydef default_location geocode cityflag unique ); push @fields, 'actionflag' if $format eq 'cch-update-zip'; $imported++ if $format eq 'cch-update'; #empty file ok @@ -222,6 +229,7 @@ sub batch_import { delete($hash->{$_}) foreach qw( countyfips countydef unique ); $hash->{'cityflag'} =~ s/ //g; + $hash->{'default_location'} =~ s/ //g; if (exists($hash->{actionflag}) && $hash->{actionflag} eq 'D') { delete($hash->{actionflag}); @@ -275,7 +283,7 @@ sub batch_import { if ( $job ) { # progress bar if ( time - $min_sec > $last ) { my $error = $job->update_statustext( - int( 100 * $imported / $count ) + int( 100 * $imported / $count ). ",Importing locations" ); die $error if $error; $last = time; diff --git a/FS/FS/h_cust_svc.pm b/FS/FS/h_cust_svc.pm index e030436..d280d53 100644 --- a/FS/FS/h_cust_svc.pm +++ b/FS/FS/h_cust_svc.pm @@ -52,9 +52,15 @@ If a service is found, returns a list consisting of: =cut -sub label { +sub label { shift->_label('svc_label', @_); } +sub label_long { shift->_label('svc_label_long', @_); } + +sub _label { my $self = shift; - carp "FS::h_cust_svc::label called on $self" if $DEBUG; + my $method = shift; + + #carp "FS::h_cust_svc::_label called on $self" if $DEBUG; + warn "FS::h_cust_svc::_label called on $self for $method" if $DEBUG; my $svc_x = $self->h_svc_x(@_); return () unless $svc_x; my $part_svc = $self->part_svc; @@ -65,7 +71,7 @@ sub label { } my @label; - eval { @label = $self->_svc_label($svc_x, @_); }; + eval { @label = $self->$method($svc_x, @_); }; if ($@) { carp 'while resolving history record for svcdb/svcnum ' . diff --git a/FS/FS/part_device.pm b/FS/FS/part_device.pm new file mode 100644 index 0000000..79a534a --- /dev/null +++ b/FS/FS/part_device.pm @@ -0,0 +1,134 @@ +package FS::part_device; + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); + +=head1 NAME + +FS::part_device - Object methods for part_device records + +=head1 SYNOPSIS + + use FS::part_device; + + $record = new FS::part_device \%hash; + $record = new FS::part_device { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_device object represents a phone device definition. FS::part_device +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item devicepart + +primary key + +=item devicename + +devicename + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'part_device'; } + +=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 record. 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('devicepart') + || $self->ut_text('devicename') + ; + return $error if $error; + + $self->SUPER::check; +} + +sub process_batch_import { + my $job = shift; + + my $opt = { 'table' => 'part_device', + 'params' => [], + 'formats' => { 'default' => [ 'devicename' ] }, + 'default_csv' => 1, + }; + + FS::Record::process_batch_import( $job, $opt, @_ ); + +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_event.pm b/FS/FS/part_event.pm index 6f2c536..c98c3f8 100644 --- a/FS/FS/part_event.pm +++ b/FS/FS/part_event.pm @@ -52,7 +52,7 @@ following fields are currently supported: =item event - event name -=item eventtable - table name against which this event is triggered; currently "cust_bill" (the traditional invoice events), "cust_main" (customer events) or "cust_pkg (package events) +=item eventtable - table name against which this event is triggered; currently "cust_bill" (the traditional invoice events), "cust_main" (customer events) or "cust_pkg (package events) (or "cust_statement") =item check_freq - how often events of this type are checked; currently "1d" (daily) and "1m" (monthly) are recognized. Note that the apprioriate freeside-daily and/or freeside-monthly cron job needs to be in place. @@ -133,7 +133,7 @@ sub check { my $error = $self->ut_numbern('eventpart') || $self->ut_text('event') - || $self->ut_enum('eventtable', [ 'cust_bill', 'cust_main', 'cust_pkg' ] ) + || $self->ut_enum('eventtable', [ $self->eventtables ] ) || $self->ut_enum('check_freq', [ '1d', '1m' ]) || $self->ut_number('weight') || $self->ut_alpha('action') @@ -273,6 +273,7 @@ sub eventtable_labels { 'cust_bill' => 'Invoice', 'cust_main' => 'Customer', 'cust_pay_batch' => 'Batch payment', + 'cust_statement' => 'Statement', #too general a name here? "Invoice group"? ; \%hash @@ -310,6 +311,7 @@ sub eventtable_pkey { 'cust_bill' => 'invnum', 'cust_pkg' => 'pkgnum', 'cust_pay_batch' => 'paybatchnum', + 'cust_statement' => 'statementnum', }; } diff --git a/FS/FS/part_event/Action.pm b/FS/FS/part_event/Action.pm index 57239d7..45219a3 100644 --- a/FS/FS/part_event/Action.pm +++ b/FS/FS/part_event/Action.pm @@ -54,6 +54,19 @@ sub eventtable_hashref { }; } +=item event_stage + +Action classes may define an event_stage method to indicate a preference +for being run at a non-standard stage of the billing and collection process. + +This method may currently return "collect" (the default) or "pre-bill". + +=cut + +sub event_stage { + 'collect'; +} + =item option_fields Action classes may define an option_fields method to indicate that they diff --git a/FS/FS/part_event/Action/cust_bill_email.pm b/FS/FS/part_event/Action/cust_bill_email.pm new file mode 100644 index 0000000..a5cd861 --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_email.pm @@ -0,0 +1,23 @@ +package FS::part_event::Action::cust_bill_email; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { 'Send invoice (email only)'; } + +sub eventtable_hashref { + { 'cust_bill' => 1 }; +} + +sub default_weight { 51; } + +sub do_action { + my( $self, $cust_bill ) = @_; + + #my $cust_main = $self->cust_main($cust_bill); + my $cust_main = $cust_bill->cust_main; + + $cust_bill->email; +} + +1; diff --git a/FS/FS/part_event/Action/cust_bill_fee_percent.pm b/FS/FS/part_event/Action/cust_bill_fee_percent.pm index 570fd63..b0397d4 100644 --- a/FS/FS/part_event/Action/cust_bill_fee_percent.pm +++ b/FS/FS/part_event/Action/cust_bill_fee_percent.pm @@ -9,10 +9,17 @@ sub eventtable_hashref { { 'cust_bill' => 1 }; } +sub event_stage { 'pre-bill'; } + sub option_fields { ( - 'percent' => { label=>'Percent', size=>2, }, - 'reason' => 'Reason', + 'percent' => { label=>'Percent', size=>2, }, + 'reason' => 'Reason', + 'taxclass' => { label=>'Tax class', type=>'select-taxclass', }, + 'nextbill' => { label=>'Hold late fee until next invoice', + type=>'checkbox', value=>'Y' }, + 'setuptax' => { label=>'Late fee is tax exempt', + type=>'checkbox', value=>'Y' }, ); } @@ -24,10 +31,24 @@ sub do_action { #my $cust_main = $self->cust_main($cust_bill); my $cust_main = $cust_bill->cust_main; - my $error = $cust_main->charge( - sprintf('%.2f', $cust_bill->owed * $self->option('percent') / 100 ), - $self->option('reason') + my $conf = new FS::Conf; + + my $amount = + sprintf('%.2f', $cust_bill->owed * $self->option('percent') / 100 ); + + my %charge = ( + 'amount' => $amount, + 'pkg' => $self->option('reason'), + 'taxclass' => $self->option('taxclass'), + 'classnum' => $conf->config('finance_pkgclass'), + 'setuptax' => $self->option('setuptax'), ); + + $charge{'start_date'} = $cust_main->next_bill_date #unless its more than N months away? + if $self->option('nextbill'); + + my $error = $cust_main->charge( \%charge ); + die $error if $error; ''; diff --git a/FS/FS/part_event/Action/cust_bill_send.pm b/FS/FS/part_event/Action/cust_bill_send.pm index 663caf1..587a7c6 100644 --- a/FS/FS/part_event/Action/cust_bill_send.pm +++ b/FS/FS/part_event/Action/cust_bill_send.pm @@ -14,9 +14,6 @@ sub default_weight { 50; } sub do_action { my( $self, $cust_bill ) = @_; - #my $cust_main = $self->cust_main($cust_bill); - my $cust_main = $cust_bill->cust_main; - $cust_bill->send; } diff --git a/FS/FS/part_event/Action/cust_bill_send_reminder.pm b/FS/FS/part_event/Action/cust_bill_send_reminder.pm new file mode 100644 index 0000000..2ba8136 --- /dev/null +++ b/FS/FS/part_event/Action/cust_bill_send_reminder.pm @@ -0,0 +1,31 @@ +package FS::part_event::Action::cust_bill_send_reminder; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { 'Send invoice (email/print/fax) reminder'; } + +sub eventtable_hashref { + { 'cust_bill' => 1 }; +} + +sub option_fields { + ( + 'notice_name' => 'Reminder name', + #'notes' => { 'label' => 'Reminder notes' }, + #include standard notes? no/prepend/append + ); +} + +sub default_weight { 50; } + +sub do_action { + my( $self, $cust_bill ) = @_; + + #my $cust_main = $self->cust_main($cust_bill); + #my $cust_main = $cust_bill->cust_main; + + $cust_bill->send({ 'notice_name' => $self->option('notice_name') }); +} + +1; diff --git a/FS/FS/part_event/Action/cust_bill_spool_csv.pm b/FS/FS/part_event/Action/cust_bill_spool_csv.pm index f20ee46..43d2300 100644 --- a/FS/FS/part_event/Action/cust_bill_spool_csv.pm +++ b/FS/FS/part_event/Action/cust_bill_spool_csv.pm @@ -35,6 +35,7 @@ sub option_fields { }, 'spoolagent_spools' => { label => 'Individual per-agent spools', type => 'checkbox', + value => '1', }, ); } diff --git a/FS/FS/part_event/Action/cust_statement.pm b/FS/FS/part_event/Action/cust_statement.pm new file mode 100644 index 0000000..2d9e877 --- /dev/null +++ b/FS/FS/part_event/Action/cust_statement.pm @@ -0,0 +1,39 @@ +package FS::part_event::Action::cust_statement; + +use strict; + +use base qw( FS::part_event::Action ); + +use FS::cust_statement; + +sub description { + 'Group invoices into an informational statement.'; +} + +sub eventtable_hashref { + { 'cust_main' => 1, + 'cust_pkg' => 1, + }; +} + +sub default_weight { + 90; +} + +sub do_action { + my( $self, $cust_main ) = @_; + + #my( $self, $object ) = @_; + #my $cust_main = $self->cust_main($object); + + my $cust_statement = new FS::cust_statement { + 'custnum' => $cust_main->custnum + }; + my $error = $cust_statement->insert; + die $error if $error; + + ''; + +} + +1; diff --git a/FS/FS/part_event/Action/cust_statement_send.pm b/FS/FS/part_event/Action/cust_statement_send.pm new file mode 100644 index 0000000..74cc48c --- /dev/null +++ b/FS/FS/part_event/Action/cust_statement_send.pm @@ -0,0 +1,26 @@ +package FS::part_event::Action::cust_statement_send; + +use strict; + +use base qw( FS::part_event::Action ); + +sub description { + 'Send statement (email/print/fax)'; +} + +sub eventtable_hashref { + { 'cust_statement' => 1, }; +} + +sub default_weight { + 95; +} + +sub do_action { + my( $self, $cust_statement ) = @_; + + $cust_statement->send( 'statement' ); #XXX configure + +} + +1; diff --git a/FS/FS/part_event/Action/fee.pm b/FS/FS/part_event/Action/fee.pm index 3cf50fb..163b4fa 100644 --- a/FS/FS/part_event/Action/fee.pm +++ b/FS/FS/part_event/Action/fee.pm @@ -5,10 +5,17 @@ use base qw( FS::part_event::Action ); sub description { 'Late fee (flat)'; } +sub event_stage { 'pre-bill'; } + sub option_fields { ( - 'charge' => { label=>'Amount', type=>'money', }, # size=>7, }, - 'reason' => 'Reason', + 'charge' => { label=>'Amount', type=>'money', }, # size=>7, }, + 'reason' => 'Reason', + 'taxclass' => { label=>'Tax class', type=>'select-taxclass', }, + 'nextbill' => { label=>'Hold late fee until next invoice', + type=>'checkbox', value=>'Y' }, + 'setuptax' => { label=>'Late fee is tax exempt', + type=>'checkbox', value=>'Y' }, ); } @@ -19,7 +26,20 @@ sub do_action { my $cust_main = $self->cust_main($cust_object); - my $error = $cust_main->charge( $self->option('charge'), $self->option('reason') ); + my $conf = new FS::Conf; + + my %charge = ( + 'amount' => $self->option('charge'), + 'pkg' => $self->option('reason'), + 'taxclass' => $self->option('taxclass'), + 'classnum' => $conf->config('finance_pkgclass'), + 'setuptax' => $self->option('setuptax'), + ); + + $charge{'start_date'} = $cust_main->next_bill_date #unless its more than N months away? + if $self->option('nextbill'); + + my $error = $cust_main->charge( \%charge ); die $error if $error; diff --git a/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm b/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm index 08cf9a8..eb9b510 100644 --- a/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm +++ b/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm @@ -38,6 +38,7 @@ sub _calc_referral_credit { my $what = $self->option('what'); + #false laziness w/Condition/cust_payments_pkg.pm if ( $what eq 'base_recur_permonth' ) { #huh. yuck. if ( $part_pkg->freq !~ /^\d+$/ ) { die 'WARNING: Not crediting customer '. $cust_main->referral_custnum. diff --git a/FS/FS/part_event/Action/writeoff.pm b/FS/FS/part_event/Action/writeoff.pm new file mode 100644 index 0000000..8529d29 --- /dev/null +++ b/FS/FS/part_event/Action/writeoff.pm @@ -0,0 +1,33 @@ +package FS::part_event::Action::writeoff; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { 'Write off bad debt with a credit entry.'; } + +sub option_fields { + ( + #'charge' => { label=>'Amount', type=>'money', }, # size=>7, }, + 'reasonnum' => { 'label' => 'Reason', + 'type' => 'select-reason', + 'reason_class' => 'R', + }, + ); +} + +sub default_weight { 65; } + +sub do_action { + my( $self, $cust_object ) = @_; + + my $cust_main = $self->cust_main($cust_object); + + my $reasonnum = $self->option('reasonnum'); + + my $error = $cust_main->credit( $cust_main->balance, \$reasonnum ); + die $error if $error; + + ''; +} + +1; diff --git a/FS/FS/part_event/Condition.pm b/FS/FS/part_event/Condition.pm index 544b560..ddd8a61 100644 --- a/FS/FS/part_event/Condition.pm +++ b/FS/FS/part_event/Condition.pm @@ -41,6 +41,7 @@ of eventtables (values set true indicate the condition can be tested): 'cust_bill' => 1, 'cust_pkg' => 0, 'cust_pay_batch' => 0, + 'cust_statement' => 0, }; } @@ -52,6 +53,7 @@ sub eventtable_hashref { 'cust_bill' => 1, 'cust_pkg' => 1, 'cust_pay_batch' => 1, + 'cust_statement' => 1, }; } diff --git a/FS/FS/part_event/Condition/cust_payments.pm b/FS/FS/part_event/Condition/cust_payments.pm index 41ef6c7..477ecdb 100644 --- a/FS/FS/part_event/Condition/cust_payments.pm +++ b/FS/FS/part_event/Condition/cust_payments.pm @@ -3,7 +3,7 @@ package FS::part_event::Condition::cust_payments; use strict; use base qw( FS::part_event::Condition ); -sub description { 'Customer total payments'; } +sub description { 'Customer total payments (amount)'; } sub option_fields { ( diff --git a/FS/FS/part_event/Condition/cust_payments_pkg.pm b/FS/FS/part_event/Condition/cust_payments_pkg.pm new file mode 100644 index 0000000..d6c493b --- /dev/null +++ b/FS/FS/part_event/Condition/cust_payments_pkg.pm @@ -0,0 +1,68 @@ +package FS::part_event::Condition::cust_payments_pkg; + +use strict; +use base qw( FS::part_event::Condition ); + +sub description { 'Customer total payments (multiplier of package)'; } + +sub eventtable_hashref { + { 'cust_pkg' => 1 }; +} + +sub option_fields { + ( + 'over_times' => { 'label' => 'Customer total payments as least', + 'type' => 'text', + 'value' => '1', #default + }, + 'what' => { 'label' => 'Times', + 'type' => 'select', + #also add some way to specify in the package def, no? + 'options' => [ qw( base_recur_permonth ) ], + 'labels' => { 'base_recur_permonth' => 'Base monthly fee', }, + }, + ); +} + +sub condition { + my($self, $cust_pkg) = @_; + + my $cust_main = $self->cust_main($cust_pkg); + + my $part_pkg = $cust_pkg->part_pkg; + + my $over_times = $self->option('over_times'); + $over_times = 0 unless length($over_times); + + my $what = $self->option('what'); + + #false laziness w/Condition/cust_payments_pkg.pm + if ( $what eq 'base_recur_permonth' ) { #huh. yuck. + if ( $part_pkg->freq !~ /^\d+$/ ) { + die 'WARNING: Not crediting customer '. $cust_main->referral_custnum. + ' for package '. $cust_pkg->pkgnum. + ' ( customer '. $cust_pkg->custnum. ')'. + ' - Referral credits not (yet) available for '. + ' packages with '. $part_pkg->freq_pretty. ' frequency'; + } + } + + $cust_main->total_paid >= $over_times * $part_pkg->$what($cust_pkg); + +} + +#XXX add for efficiency. could use cust_main::total_paid_sql +#use FS::cust_main; +#sub condition_sql { +# my( $class, $table ) = @_; +# +# my $over = $class->condition_sql_option('balance'); +# +# my $balance_sql = FS::cust_main->balance_sql; +# +# "$balance_sql > $over"; +# +#} + +1; + diff --git a/FS/FS/part_event/Condition/has_pkg_class.pm b/FS/FS/part_event/Condition/has_pkg_class.pm new file mode 100644 index 0000000..59a3675 --- /dev/null +++ b/FS/FS/part_event/Condition/has_pkg_class.pm @@ -0,0 +1,40 @@ +package FS::part_event::Condition::has_pkg_class; + +use strict; + +use base qw( FS::part_event::Condition ); +use FS::Record qw( qsearch ); +use FS::pkg_class; + +sub description { + 'Customer has uncancelled package with class'; +} + +sub eventtable_hashref { + { 'cust_main' => 1, + 'cust_bill' => 1, + 'cust_pkg' => 1, + }; +} + +#something like this +sub option_fields { + ( + 'pkgclass' => { 'label' => 'Package Class', + 'type' => 'select-pkg_class', + 'multiple' => 1, + }, + ); +} + +sub condition { + my( $self, $object ) = @_; + + my $cust_main = $self->cust_main($object); + + #XXX test + my $hashref = $self->option('pkgclass') || {}; + grep $hashref->{ $_->part_pkg->classnum }, $cust_main->ncancelled_pkgs; +} + +1; diff --git a/FS/FS/part_event/Condition/has_pkgpart.pm b/FS/FS/part_event/Condition/has_pkgpart.pm new file mode 100644 index 0000000..c54b7e2 --- /dev/null +++ b/FS/FS/part_event/Condition/has_pkgpart.pm @@ -0,0 +1,41 @@ +package FS::part_event::Condition::has_pkgpart; + +use strict; + +use base qw( FS::part_event::Condition ); + +sub description { 'Customer has uncancelled package of specified definitions'; } + +sub eventtable_hashref { + { 'cust_main' => 1, + 'cust_bill' => 1, + 'cust_pkg' => 1, + }; +} + +sub option_fields { + ( + 'if_pkgpart' => { 'label' => 'Only packages: ', + 'type' => 'select-part_pkg', + 'multiple' => 1, + }, + ); +} + +sub condition { + my( $self, $object) = @_; + + my $cust_main = $self->cust_main($object); + + #XXX test + my $if_pkgpart = $self->option('if_pkgpart') || {}; + grep $if_pkgpart->{ $_->pkgpart }, $cust_main->ncancelled_pkgs; + +} + +#XXX +#sub condition_sql { +# +#} + +1; diff --git a/FS/FS/part_event/Condition/has_referral_custnum.pm b/FS/FS/part_event/Condition/has_referral_custnum.pm index d43d6c0..61a8155 100644 --- a/FS/FS/part_event/Condition/has_referral_custnum.pm +++ b/FS/FS/part_event/Condition/has_referral_custnum.pm @@ -7,18 +7,42 @@ use base qw( FS::part_event::Condition ); sub description { 'Customer has a referring customer'; } +sub option_fields { + ( + 'active' => { 'label' => 'Referring customer is active', + 'type' => 'checkbox', + 'value' => 'Y', + }, + ); +} + sub condition { my($self, $object) = @_; my $cust_main = $self->cust_main($object); - $cust_main->referral_custnum; + if ( $self->option('active') ) { + + return 0 unless $cust_main->referral_custnum; + + #check for no cust_main for referral_custnum? (deleted?) + + $cust_main->referral_custnum_cust_main->status eq 'active'; + + } else { + + $cust_main->referral_custnum; # ? 1 : 0; + + } + } sub condition_sql { #my( $class, $table ) = @_; "cust_main.referral_custnum IS NOT NULL"; + + #XXX a bit harder to check active status here } 1; diff --git a/FS/FS/part_event/Condition/hasnt_pkgpart.pm b/FS/FS/part_event/Condition/hasnt_pkgpart.pm new file mode 100644 index 0000000..421d023 --- /dev/null +++ b/FS/FS/part_event/Condition/hasnt_pkgpart.pm @@ -0,0 +1,40 @@ +package FS::part_event::Condition::hasnt_pkgpart; + +use strict; + +use base qw( FS::part_event::Condition ); + +sub description { 'Customer does not have uncancelled package of specified definitions'; } + +sub eventtable_hashref { + { 'cust_main' => 1, + 'cust_bill' => 1, + 'cust_pkg' => 1, + }; +} + +sub option_fields { + ( + 'unless_pkgpart' => { 'label' => 'Packages: ', + 'type' => 'select-part_pkg', + 'multiple' => 1, + }, + ); +} + +sub condition { + my( $self, $object ) = @_; + + my $cust_main = $self->cust_main($object); + + #XXX test + my $unless_pkgpart = $self->option('unless_pkgpart') || {}; + ! grep $unless_pkgpart->{ $_->pkgpart }, $cust_main->ncancelled_pkgs; +} + +#XXX +#sub condition_sql { +# +#} + +1; diff --git a/FS/FS/part_event/Condition/once.pm b/FS/FS/part_event/Condition/once.pm index 5a9161f..d004814 100644 --- a/FS/FS/part_event/Condition/once.pm +++ b/FS/FS/part_event/Condition/once.pm @@ -7,7 +7,7 @@ use FS::cust_event; use base qw( FS::part_event::Condition ); -sub description { "Don't run this event again after it has completed sucessfully"; } +sub description { "Don't run this event again after it has completed successfully"; } sub implicit_flag { 10; } diff --git a/FS/FS/part_export/acct_plesk.pm b/FS/FS/part_export/acct_plesk.pm index 1be820a..d8d70a3 100644 --- a/FS/FS/part_export/acct_plesk.pm +++ b/FS/FS/part_export/acct_plesk.pm @@ -23,7 +23,7 @@ Real-time export to <a href="http://www.swsoft.com/">Plesk</a> managed server. Requires installation of <a href="http://search.cpan.org/dist/Net-Plesk">Net::Plesk</a> -from CPAN. +from CPAN and proper <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration:acct_plesk.pm">configuration</a>. END ); diff --git a/FS/FS/part_export/amazon_ec2.pm b/FS/FS/part_export/amazon_ec2.pm new file mode 100644 index 0000000..0e65ca0 --- /dev/null +++ b/FS/FS/part_export/amazon_ec2.pm @@ -0,0 +1,169 @@ +package FS::part_export::amazon_ec2; + +use base qw( FS::part_export ); + +use vars qw(@ISA %info $replace_ok_kludge); +use Tie::IxHash; +use FS::Record qw( qsearchs ); +use FS::svc_external; + +tie my %options, 'Tie::IxHash', + 'access_key' => { label => 'AWS access key', }, + 'secret_key' => { label => 'AWS secret key', }, + 'ami' => { label => 'AMI', 'default' => 'ami-ff46a796', }, + 'keyname' => { label => 'Keypair name', }, + #option to turn off (or on) ip address allocation +; + +%info = ( + 'svc' => 'svc_external', + 'desc' => + 'Export to Amazon EC2', + 'options' => \%options, + 'notes' => <<'END' +Create instances in the Amazon EC2 (Elastic compute cloud). Install +Net::Amazon::EC2 perl module. Advisable to set svc_external-skip_manual config +option. +END +); + +$replace_ok_kludge = 0; + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_external) = (shift, shift); + $err_or_queue = $self->amazon_ec2_queue( $svc_external->svcnum, 'insert', + $svc_external->svcnum, + $self->option('ami'), + $self->option('keyname'), + ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + return '' if $replace_ok_kludge; + return "can't change instance id or IP address"; + #$err_or_queue = $self->amazon_ec2_queue( $new->svcnum, + # 'replace', $new->username, $new->_password ); + #ref($err_or_queue) ? '' : $err_or_queue; +} + +sub _export_delete { + my( $self, $svc_external ) = (shift, shift); + my( $instance_id, $ip ) = split(/:/, $svc_external->title ); + $err_or_queue = $self->amazon_ec2_queue( $svc_external->svcnum, 'delete', + $instance_id, + $ip, + ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +#these three are optional +# fallback for svc_acct will change and restore password +#sub _export_suspend { +# my( $self, $svc_something ) = (shift, shift); +# $err_or_queue = $self->amazon_ec2_queue( $svc_something->svcnum, +# 'suspend', $svc_something->username ); +# ref($err_or_queue) ? '' : $err_or_queue; +#} +# +#sub _export_unsuspend { +# my( $self, $svc_something ) = (shift, shift); +# $err_or_queue = $self->amazon_ec2_queue( $svc_something->svcnum, +# 'unsuspend', $svc_something->username ); +# ref($err_or_queue) ? '' : $err_or_queue; +#} + +sub export_links { + my($self, $svc_external, $arrayref) = (shift, shift, shift); + my( $instance_id, $ip ) = split(/:/, $svc_external->title ); + + push @$arrayref, qq!<A HREF="http://$ip/">http://$ip/</A>!; + ''; +} + +### + +#a good idea to queue anything that could fail or take any time +sub amazon_ec2_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::amazon_ec2::amazon_ec2_$method", + }; + $queue->insert( $self->option('access_key'), + $self->option('secret_key'), + @_ + ) + or $queue; +} + +sub amazon_ec2_new { + my( $access_key, $secret_key, @rest ) = @_; + + eval 'use Net::Amazon::EC2;'; + die $@ if $@; + + my $ec2 = new Net::Amazon::EC2 'AWSAccessKeyId' => $access_key, + 'SecretAccessKey' => $secret_key; + + ( $ec2, @rest ); +} + +sub amazon_ec2_insert { #subroutine, not method + my( $ec2, $svcnum, $ami, $keyname ) = amazon_ec2_new(@_); + + my $reservation_info = $ec2->run_instances( 'ImageId' => $ami, + 'KeyName' => $keyname, + 'MinCount' => 1, + 'MaxCount' => 1, + ); + + my $instance_id = $reservation_info->instances_set->[0]->instance_id; + + my $ip = $ec2->allocate_address + or die "can't allocate address"; + $ec2->associate_address('InstanceId' => $instance_id, + 'PublicIp' => $ip, + ) + or die "can't assocate IP address $ip with instance $instance_id"; + + my $svc_external = qsearchs('svc_external', { 'svcnum' => $svcnum } ) + or die "can't find svc_external.svcnum $svcnum\n"; + + $svc_external->title("$instance_id:$ip"); + + local($replace_ok_kludge) = 1; + my $error = $svc_external->replace; + die $error if $error; + +} + +#sub amazon_ec2_replace { #subroutine, not method +#} + +sub amazon_ec2_delete { #subroutine, not method + my( $ec2, $id, $ip ) = amazon_ec2_new(@_); + + my $instance_id = sprintf('i-%x', $id); + $ec2->disassociate_address('PublicIp'=>$ip) + or die "can't dissassocate $ip"; + + $ec2->release_address('PublicIp'=>$ip) + or die "can't release $ip"; + + my $result = $ec2->terminate_instances('InstanceId'=>$instance_id); + #check for instance_id match or something? + +} + +#sub amazon_ec2_suspend { #subroutine, not method +#} + +#sub amazon_ec2_unsuspend { #subroutine, not method +#} + +1; + diff --git a/FS/FS/part_export/domreg_net_dri.pm b/FS/FS/part_export/domreg_net_dri.pm new file mode 100644 index 0000000..bf01602 --- /dev/null +++ b/FS/FS/part_export/domreg_net_dri.pm @@ -0,0 +1,614 @@ +package FS::part_export::domreg_net_dri; + +use vars qw(@ISA %info %options $conf); +use Tie::IxHash; +use FS::part_export::null; + +=head1 NAME + +FS::part_export::domreg_net_dri - Register or transfer domains with Net::DRI + +=head1 DESCRIPTION + +This module handles registering and transferring domains with select registrars or registries supported +by L<Net::DRI>. + +As a part_export, this module can be designated for use with svc_domain services. When the svc_domain object +is inserted into the Freeside database, registration or transferring of the domain may be initiated, depending +on the setting of the svc_domain's action field. Further operations can be performed from the View Domain screen. + +Logging information is written to the Freeside log folder. + +For correct operation you must add name/value pairs to the protcol and transport options fields. The setttings +depend on the domain registry driver (DRD) selected. + +=over 4 + +=item N - Register the domain + +=item M - Transfer the domain + +=item I - Ignore the domain for registration purposes + +=back + +=cut + +@ISA = qw(FS::part_export::null); + +my @tldlist = qw/com net org biz info name mobi at be ca cc ch cn de dk es eu fr it mx nl tv uk us/; + +my $opensrs_protocol_opts=<<'END'; +username= +password= +auto_renew=0 +affiliate_id= +reseller_id= +END + +my $opensrs_transport_opts=<<'END'; +client_login= +client_password= +END + +tie %options, 'Tie::IxHash', + 'drd' => { label => 'Domain Registry Driver (DRD)', + type => 'select', + options => [ qw/BookMyName CentralNic Gandi OpenSRS OVH VNDS/ ], + default => 'OpenSRS' }, + 'log_level' => { label => 'Logging', + type => 'select', + options => [ qw/debug info notice warning error critical alert emergency/ ], + default => 'warning' }, + 'protocol_opts' => { + label => 'Protocol Options', + type => 'textarea', + default => $opensrs_protocol_opts, + }, + 'transport_opts' => { + label => 'Transport Options', + type => 'textarea', + default => $opensrs_transport_opts, + }, +# 'register' => { label => 'Use for registration', +# type => 'checkbox', +# default => '1' }, +# 'transfer' => { label => 'Use for transfer', +# type => 'checkbox', +# default => '1' }, +# 'delete' => { label => 'Use for deletion', +# type => 'checkbox', +# default => '1' }, +# 'renew' => { label => 'Use for renewals', +# type => 'checkbox', +# default => '1' }, + 'tlds' => { label => 'Use this export for these top-level domains (TLDs)', + type => 'select', + multi => 1, + size => scalar(@tldlist), + options => [ @tldlist ], + default => 'com net org' }, +; + +my $opensrs_protocol_defaults = $opensrs_protocol_opts; +$opensrs_protocol_defaults =~ s|\n|\\n|g; + +my $opensrs_transport_defaults = $opensrs_transport_opts; +$opensrs_transport_defaults =~ s|\n|\\n|g; + +%info = ( + 'svc' => 'svc_domain', + 'desc' => 'Domain registration via Net::DRI', + 'options' => \%options, + 'notes' => <<"END" +Registers and transfers domains via a Net::DRI registrar or registry. +<a href="http://search.cpan.org/search?dist=Net-DRI">Net::DRI</a> +must be installed. You must have an account at the selected registrar/registry. +<BR /> +Some top-level domains have additional business rules not supported by this export. These TLDs cannot be registered or transfered with this export. +<BR><BR>Use these buttons for some useful presets: +<UL> + <LI> + <INPUT TYPE="button" VALUE="OpenSRS Live System (rr-n1-tor.opensrs.net)" onClick=' + document.dummy.machine.value = "rr-n1-tor.opensrs.net"; + this.form.machine.value = "rr-n1-tor.opensrs.net"; + '> + <LI> + <INPUT TYPE="button" VALUE="OpenSRS Test System (horizon.opensrs.net)" onClick=' + document.dummy.machine.value = "horizon.opensrs.net"; + this.form.machine.value = "horizon.opensrs.net"; + '> + <LI> + <INPUT TYPE="button" VALUE="OpenSRS protocol/transport options" onClick=' + this.form.protocol_opts.value = "$opensrs_protocol_defaults"; + this.form.transport_opts.value = "$opensrs_transport_defaults"; + '> +</UL> +END +); + +install_callback FS::UID sub { + $conf = new FS::Conf; +}; + +#sub rebless { shift; } + +# experiment: want the status of these right away, so no queueing + +sub _export_insert { + my( $self, $svc_domain ) = ( shift, shift ); + + return if $svc_domain->action eq 'I'; # Ignoring registration, just doing DNS + + if ($svc_domain->action eq 'N') { + return $self->register( $svc_domain ); + } elsif ($svc_domain->action eq 'M') { + return $self->transfer( $svc_domain ); + } + return "Unknown domain action " . $svc_domain->action; +} + +=item get_portfolio_credentials + +Returns, in list context, the user name and password for the domain portfolio. + +This is currently specified via the username and password keys in the protocol options. + +=cut + +sub get_portfolio_credentials { + my $self = shift; + + my %opts = $self->get_protocol_options(); + return ($opts{username}, $opts{password}); +} + +=item format_tel + +Reformats a phone number according to registry rules. Currently Freeside stores phone numbers +in NANPA format and most registries prefer "+CCC.NPANPXNNNN" + +=cut + +sub format_tel { + my $tel = shift; + + #if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})\s*(x\s*(\d+))?$/) { + if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})$/) { + $tel = "+1.$1$2$3"; # TBD: other country codes +# if $tel .= "$4" if $4; + } + return $tel; +} + +sub gen_contact_set { + my ($self, $dri, $cust_main) = @_; + + my @invoicing_list = $cust_main->invoicing_list_emailonly; + if ( $conf->exists('emailinvoiceautoalways') + || $conf->exists('emailinvoiceauto') && ! @invoicing_list + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $cust_main->all_emails; + } + + my $email = ($conf->exists('business-onlinepayment-email-override')) + ? $conf->config('business-onlinepayment-email-override') + : $invoicing_list[0]; + + my $cs=$dri->local_object('contactset'); + my $co=$dri->local_object('contact'); + + my ($user, $pass) = $self->get_portfolio_credentials(); + + $co->srid($user); # Portfolio user name for OpenSRS? + $co->auth($pass); # Portfolio password for OpenSRS? + + $co->firstname($cust_main->first); + $co->name($cust_main->last); + $co->org($cust_main->company || '-'); + $co->street([$cust_main->address1, $cust_main->address2]); + $co->city($cust_main->city); + $co->sp($cust_main->state); + $co->pc($cust_main->zip); + $co->cc($cust_main->country); + $co->voice(format_tel($cust_main->daytime())); + $co->email($email); + + $cs->set($co, 'registrant'); + $cs->set($co, 'admin'); + $cs->set($co, 'billing'); + + return $cs; +} + +=item validate_contact_set + +Attempts to validate contact data for the domain based on OpenSRS rules. + +Returns undef if the contact data is acceptable, an error message if the contact +data lacks one or more required fields. + +=cut + +sub validate_contact_set { + my $c = shift; + + my %fields = ( + firstname => "first name", + name => "last name", + street => "street address", + city => "city", + sp => "state", + pc => "ZIP/postal code", + cc => "country", + email => "email address", + voice => "phone number", + ); + my @err = (); + foreach my $which (qw/registrant admin billing/) { + my $co = $c->get($which); + foreach (keys %fields) { + if (!$co->$_()) { + push @err, $fields{$_}; + } + } + } + if (scalar(@err) > 0) { + return "Contact information needs: " . join(', ', @err); + } + undef; +} + +#sub _export_replace { +# my( $self, $new, $old ) = (shift, shift, shift); +# +# return ''; +# +#} + +## Domain registration exports do nothing on delete. You're just removing the domain from Freeside, not the registry +#sub _export_delete { +# my( $self, $www ) = ( shift, shift ); +# +# return ''; +#} + +=item split_textarea_options + +Split textarea contents into lines, split lines on =, and then trim the results; + +=cut + +sub split_textarea_options { + my ($self, $optname) = @_; + my %opts = map { + my ($key, $value) = split /=/, $_; + $key =~ s/^\s*//; + $key =~ s/\s*$//; + $value =~ s/^\s*//; + $value =~ s/\s*$//; + $key => $value } split /\n/, $self->option($optname); + %opts; +} + +=item get_protocol_options + +Return a hash of protocol options + +=cut + +sub get_protocol_options { + my $self = shift; + my %opts = $self->split_textarea_options('protocol_opts'); + if ($self->machine =~ /opensrs\.net/) { + my %topts = $self->get_transport_options; + $opts{reseller_id} = $topts{client_login}; + } + %opts; +} + +=item get_transport_options + +Return a hash of transport options + +=cut + +sub get_transport_options { + my $self = shift; + my %opts = $self->split_textarea_options('transport_opts'); + $opts{remote_url} = "https://" . $self->machine . ":55443/resellers" if $self->machine =~ /opensrs\.net/; + %opts; +} + +=item is_supported_domain + +Return undef if the domain name uses a TLD or SLD that is supported by this registrar. +Otherwise return an error message explaining what's wrong. + +=cut + +sub is_supported_domain { + my $self = shift; + my $svc_domain = shift; + + # Get the TLD of the new domain + my @bits = split /\./, $svc_domain->domain; + + return "Can't register subdomains: " . $svc_domain->domain if scalar(@bits) != 2; + + my $tld = pop @bits; + + # See if it's one this export supports + my @tlds = split /\s+/, $self->option('tlds'); + @tlds = map { s/\.//; $_ } @tlds; + return "Can't register top-level domain $tld, restricted to: " . $self->option('tlds') if ! grep { $_ eq $tld } @tlds; + return undef; +} + +=item get_dri + +=cut + +sub get_dri { + my $self = shift; + my $dri; + +# return $self->{dri} if $self->{dri}; #!!!TBD!!! connection caching. + + eval "use Net::DRI 0.95;"; + return $@ if $@; + +# $dri=Net::DRI->new(...) to create the global object. Save the result, + + eval { + #$dri = Net::DRI::TrapExceptions->new(10); + $dri = Net::DRI->new({logging => [ 'files', { output_directory => '%%%FREESIDE_LOG%%%' } ]}); #!!!TBD!!! + $dri->logging->level( $self->option('log_level') ); + $dri->add_registry( $self->option('drd') ); + my $protocol; + $protocol = 'xcp' if $self->option('drd') eq 'OpenSRS'; + + $dri->target( $self->option('drd') )->add_current_profile($self->option('drd') . '1', +# 'Net::DRI::Protocol::' . $self->option('protocol_type'), +# $self->option('protocol_type'), +# 'xcp', #TBD!!!! + $protocol, # Implies transport +# 'Net::DRI::Transport::' . $self->option('transport_type'), + { $self->get_transport_options() }, +# [ $self->get_protocol_options() ] + ); + }; + return $@ if $@; + + $self->{dri} = $dri; + return $dri; +} + +=item get_status + +Returns a reference to a hashref containing information on the domain's status. The keys +defined depend on the status. + +'unregistered' means the domain is not registered. + +Otherwise, if the domain is in an asynchronous operation such as a transfer, returns the state +of that operation. + +Otherwise returns a value indicating if the domain can be managed through our reseller account. + +=cut + +sub get_status { + my ( $self, $svc_domain ) = @_; + my $rc; + my $rslt = {}; + + my $dri = $self->get_dri; + + if (UNIVERSAL::isa($dri, 'Net::DRI::Exception')) { + $rslt->{'message'} = $dri->as_string; + return $rslt; + } + eval { + $rc = $dri->domain_check( $svc_domain->domain ); + if (!$rc->is_success()) { + # Problem accessing the registry/registrar + $rslt->{'message'} = $rc->message; + } elsif (!$dri->get_info('exist')) { + # Domain is not registered + $rslt->{'unregistered'} = 1; + } else { + $rc = $dri->domain_transfer_query( $svc_domain->domain ); + if ($rc->is_success() && $dri->get_info('status')) { + # Transfer in progress + $rslt->{status} = $dri->get_info('status'); + $rslt->{contact_email} = $dri->get_info('request_address'); + $rslt->{last_update_time} = $dri->get_info('unixtime'); + } elsif ($dri->get_info('reason')) { + $rslt->{'reason'} = $dri->get_info('reason'); + # Domain is not being transferred... + $rc = $dri->domain_info( $svc_domain->domain, { $self->get_protocol_options() } ); + if ($rc->is_success() && $dri->get_info('exDate')) { + $rslt->{'expdate'} = $dri->get_info('exDate'); + } + } else { + $rslt->{status} = 'Unknown'; + } + } + }; +# rslt->{'message'} = $@->as_string if $@; + if ($@) { + $rslt->{'message'} = (UNIVERSAL::isa($@, 'Net::DRI::Exception')) ? $@->as_string : $@->message; + } + + return $rslt; # Success +} + +=item register + +Attempts to register the domain through the reseller account associated with this export. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub register { + my ( $self, $svc_domain, $years ) = @_; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + + my $dri = $self->get_dri; + return $dri->as_string if (UNIVERSAL::isa($dri, 'Net::DRI::Exception')); + + eval { # All $dri methods can throw an exception. + +# Call methods + my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main; + + my $cs = $self->gen_contact_set($dri, $cust_main); + + $err = validate_contact_set($cs); + return $err if $err; + +# !!!TBD!!! add custom name servers when supported; add ns => $ns to hash passed to domain_create + + $res = $dri->domain_create($svc_domain->domain, { $self->get_protocol_options(), pure_create => 1, contact => $cs, duration => DateTime::Duration->new(years => $years) }); + $err = $res->is_success ? '' : $res->message; + }; + if ($@) { + $err = (UNIVERSAL::isa($@, 'Net::DRI::Exception')) ? $@->msg : $@->message; + } + + return $err; +} + +=item transfer + +Attempts to transfer the domain into the reseller account associated with this export. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub transfer { + my ( $self, $svc_domain ) = @_; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + +# $dri=Net::DRI->new(...) to create the global object. Save the result, + my $dri = $self->get_dri; + return $dri->as_string if (UNIVERSAL::isa($dri, 'Net::DRI::Exception')); + + eval { # All $dri methods can throw an exception + +# Call methods + my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main; + + my $cs = $self->gen_contact_set($dri, $cust_main); + + $err = validate_contact_set($cs); + return $err if $err; + +# !!!TBD!!! add custom name servers when supported; add ns => $ns to hash passed to domain_transfer_start + + $res = $dri->domain_transfer_start($svc_domain->domain, { $self->get_protocol_options(), contact => $cs }); + $err = $res->is_success ? '' : $res->message; + }; + if ($@) { + $err = (UNIVERSAL::isa($@, 'Net::DRI::Exception')) ? $@->msg : $@->message; + } + + return $err; +} + +=item renew + +Attempts to renew the domain for the specified number of years. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub renew { + my ( $self, $svc_domain, $years ) = @_; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + + my $dri = $self->get_dri; + return $dri->as_string if (UNIVERSAL::isa($dri, 'Net::DRI::Exception')); + + eval { # All $dri methods can throw an exception + my $expdate; + my $res = $dri->domain_info( $svc_domain->domain, { $self->get_protocol_options() } ); + if ($res->is_success() && $dri->get_info('exDate')) { + $expdate = $dri->get_info('exDate'); + +# return "Domain renewal not enabled" if !$self->option('renew'); + $res = $dri->domain_renew( $svc_domain->domain, { $self->get_protocol_options(), duration => DateTime::Duration->new(years => $years), current_expiration => $expdate }); + } + $err = $res->is_success ? '' : $res->message; + }; + if ($@) { + $err = (UNIVERSAL::isa($@, 'Net::DRI::Exception')) ? $@->msg : $@->message; + } + + return $err; +} + +=item revoke + +Attempts to revoke the domain registration. Only succeeds if invoked during the DRI +grace period immediately after registration. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub revoke { + my ( $self, $svc_domain ) = @_; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + + my $dri = $self->get_dri; + return $dri->as_string if (UNIVERSAL::isa($dri, 'Net::DRI::Exception')); + + eval { # All $dri methods can throw an exception + +# return "Domain registration revocation not enabled" if !$self->option('revoke'); + my $res = $dri->domain_delete( $svc_domain->domain, { $self->get_protocol_options(), domain => $svc_domain->domain, pure_delete => 1 }); + $err = $res->is_success ? '' : $res->message; + }; + if ($@) { + $err = (UNIVERSAL::isa($@, 'Net::DRI::Exception')) ? $@->msg : $@->message; + } + + return $err; +} + +=item registrar + +Should return a full-blown object representing the Net::DRI DRD, but current just returns a hashref +containing the registrar name. + +=cut + +sub registrar { + my $self = shift; + return { + name => $self->option('drd'), + }; +} + +=head1 SEE ALSO + +L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_domain>, +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_export/domreg_opensrs.pm b/FS/FS/part_export/domreg_opensrs.pm new file mode 100644 index 0000000..1799ed0 --- /dev/null +++ b/FS/FS/part_export/domreg_opensrs.pm @@ -0,0 +1,512 @@ +package FS::part_export::domreg_opensrs; + +use vars qw(@ISA %info %options $conf); +use Tie::IxHash; +use FS::Record qw(qsearchs qsearch); +use FS::Conf; +use FS::part_export::null; +use FS::svc_domain; +use FS::part_pkg; + +=head1 NAME + +FS::part_export::domreg_opensrs - Register or transfer domains with Tucows OpenSRS + +=head1 DESCRIPTION + +This module handles registering and transferring domains using a registration service provider (RSP) account +at Tucows OpenSRS, an ICANN-approved domain registrar. + +As a part_export, this module can be designated for use with svc_domain services. When the svc_domain object +is inserted into the Freeside database, registration or transferring of the domain may be initiated, depending +on the setting of the svc_domain's action field. + +=over 4 + +=item N - Register the domain + +=item M - Transfer the domain + +=item I - Ignore the domain for registration purposes + +=back + +This export uses Net::OpenSRS. Registration and transfer attempts will fail unless Net::OpenSRS is installed +and LWP::UserAgent is able to make HTTPS posts. You can turn on debugging messages and use the OpenSRS test +gateway when setting up this export. + +=cut + +@ISA = qw(FS::part_export::null); + +my @tldlist = qw/com net org biz info name mobi at be ca cc ch cn de dk es eu fr it mx nl tv uk us/; + +tie %options, 'Tie::IxHash', + 'username' => { label => 'Reseller user name at OpenSRS', + }, + 'privatekey' => { label => 'Private key', + }, + 'password' => { label => 'Password for management account', + }, + 'masterdomain' => { label => 'Master domain at OpenSRS', + }, + 'debug_level' => { label => 'Net::OpenSRS debug level', + type => 'select', + options => [ 0, 1, 2, 3 ], + default => 0 }, +# 'register' => { label => 'Use for registration', +# type => 'checkbox', +# default => '1' }, +# 'transfer' => { label => 'Use for transfer', +# type => 'checkbox', +# default => '1' }, + 'tlds' => { label => 'Use this export for these top-level domains (TLDs)', + type => 'select', + multi => 1, + size => scalar(@tldlist), + options => [ @tldlist ], + default => 'com net org' }, +; + +%info = ( + 'svc' => 'svc_domain', + 'desc' => 'Domain registration via Tucows OpenSRS', + 'options' => \%options, + 'notes' => <<'END' +Registers and transfers domains via the <a href="http://opensrs.com/">Tucows OpenSRS</a> registrar (using <a href="http://search.cpan.org/dist/Net-OpenSRS">Net::OpenSRS</a>). +All of the Net::OpenSRS restrictions apply: +<UL> + <LI>You must have a reseller account with Tucows. + <LI>You must add the public IP address of the Freeside server to the 'Script API allow' list in the OpenSRS web interface. + <LI>You must generate an API access key in the OpenSRS web interface and enter it below. + <LI>All domains are managed using the same user name and password, but you can create sub-accounts for clients. + <LI>The user name must be the same as your OpenSRS reseller ID. + <LI>You must enter a master domain that all other domains are associated with. That domain must be registered through your OpenSRS account. +</UL> +Some top-level domains offered by OpenSRS have additional business rules not supported by this export. These TLDs cannot be registered or transfered with this export. +<BR><BR>Use these buttons for some useful presets: +<UL> + <LI> + <INPUT TYPE="button" VALUE="OpenSRS Live System (rr-n1-tor.opensrs.net)" onClick=' + document.dummy.machine.value = "rr-n1-tor.opensrs.net"; + this.form.machine.value = "rr-n1-tor.opensrs.net"; + '> + <LI> + <INPUT TYPE="button" VALUE="OpenSRS Test System (horizon.opensrs.net)" onClick=' + document.dummy.machine.value = "horizon.opensrs.net"; + this.form.machine.value = "horizon.opensrs.net"; + '> +</UL> +END +); + +install_callback FS::UID sub { + $conf = new FS::Conf; +}; + +=head1 METHODS + +=over 4 + +=item format_tel + +Reformats a phone number according to registry rules. Currently Freeside stores phone numbers +in NANPA format and the registry prefers "+CCC.NPANPXNNNN" + +=cut + +sub format_tel { + my $tel = shift; + + #if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})( x(\d+))?$/) { + if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})$/) { + $tel = "+1.$1$2$3"; +# if $tel .= "$4" if $4; + } + return $tel; +} + +=item gen_contact_info + +Generates contact data for the domain based on the customer data. + +Currently relies on Net::OpenSRS to format the telephone number for OpenSRS. + +=cut + +sub gen_contact_info +{ + my ($co)=@_; + + my @invoicing_list = $co->invoicing_list_emailonly; + if ( $conf->exists('emailinvoiceautoalways') + || $conf->exists('emailinvoiceauto') && ! @invoicing_list + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $co->all_emails; + } + + my $email = ($conf->exists('business-onlinepayment-email-override')) + ? $conf->config('business-onlinepayment-email-override') + : $invoicing_list[0]; + + my $c = { + firstname => $co->first, + lastname => $co->last, + company => $co->company, + address => $co->address1, + city => $co->city(), + state => $co->state(), + zip => $co->zip(), + country => uc($co->country()), + email => $email, + #phone => format_tel($co->daytime()), + phone => $co->daytime() || $co->night, + }; + return $c; +} + +=item validate_contact_info + +Attempts to validate contact data for the domain based on OpenSRS rules. + +Returns undef if the contact data is acceptable, an error message if the contact +data lacks one or more required fields. + +=cut + +sub validate_contact_info { + my $c = shift; + + my %fields = ( + firstname => "first name", + lastname => "last name", + address => "street address", + city => "city", + state => "state", + zip => "ZIP/postal code", + country => "country", + email => "email address", + phone => "phone number", + ); + my @err = (); + foreach (keys %fields) { + if (!defined($c->{$_}) || !$c->{$_}) { + push @err, $fields{$_}; + } + } + if (scalar(@err) > 0) { + return "Contact information needs: " . join(', ', @err); + } + undef; +} + +=item testmode + +Returns the Net::OpenSRS-required test mode string based on whether the export +is configured to use the live or the test gateway. + +=cut + +sub testmode { + my $self = shift; + + return 'live' if $self->machine eq "rr-n1-tor.opensrs.net"; + return 'test' if $self->machine eq "horizon.opensrs.net"; + undef; +} + +=item _export_insert + +Attempts to "export" the domain, i.e. register or transfer it if the user selected +that option when editing the domain. + +Returns an error message on failure or undef on success. + +May also return an error message if it cannot load the required Perl module Net::OpenSRS, +or if the domain is not registerable, or if insufficient data is provided in the customer +record to generate the required contact information to register or transfer the domain. + +=cut + +sub _export_insert { + my( $self, $svc_domain ) = ( shift, shift ); + + return if $svc_domain->action eq 'I'; # Ignoring registration, just doing DNS + + if ($svc_domain->action eq 'N') { + return $self->register( $svc_domain ); + } elsif ($svc_domain->action eq 'M') { + return $self->transfer( $svc_domain ); + } + return "Unknown domain action " . $svc_domain->action; +} + +## Domain registration exports do nothing on replace. Mainly because we haven't decided what they should do. +#sub _export_replace { +# my( $self, $new, $old ) = (shift, shift, shift); +# +# return ''; +# +#} + +## Domain registration exports do nothing on delete. You're just removing the domain from Freeside, not the registry +#sub _export_delete { +# my( $self, $svc_domain ) = ( shift, shift ); +# +# return ''; +#} + +=item is_supported_domain + +Return undef if the domain name uses a TLD or SLD that is supported by this registrar. +Otherwise return an error message explaining what's wrong. + +=cut + +sub is_supported_domain { + my $self = shift; + my $svc_domain = shift; + + # Get the TLD of the new domain + my @bits = split /\./, $svc_domain->domain; + + return "Can't register subdomains: " . $svc_domain->domain if scalar(@bits) != 2; + + my $tld = pop @bits; + + # See if it's one this export supports + my @tlds = split /\s+/, $self->option('tlds'); + @tlds = map { s/\.//; $_ } @tlds; + return "Can't register top-level domain $tld, restricted to: " . $self->option('tlds') if ! grep { $_ eq $tld } @tlds; + return undef; +} + +=item get_srs + +=cut + +sub get_srs { + my $self = shift; + + my $srs = Net::OpenSRS->new(); + + $srs->debug_level( $self->option('debug_level') ); # Output should be in the Apache error log + + $srs->environment( $self->testmode() ); + $srs->set_key( $self->option('privatekey') ); + + $srs->set_manage_auth( $self->option('username'), $self->option('password') ); + return $srs; +} + +=item get_status + +Returns a reference to a hashref containing information on the domain's status. The keys +defined depend on the status. + +'unregistered' means the domain is not registered. + +Otherwise, if the domain is in an asynchronous operation such as a transfer, returns the state +of that operation. + +Otherwise returns a value indicating if the domain can be managed through our reseller account. + +=cut + +sub get_status { + my ( $self, $svc_domain ) = @_; + my $rslt = {}; + + eval "use Net::OpenSRS;"; + return $@ if $@; + + my $srs = $self->get_srs; + + if ($srs->is_available( $svc_domain->domain )) { + $rslt->{'unregistered'} = 1; + } else { + $rslt = $srs->check_transfer( $svc_domain->domain ); + if (defined($rslt->{'reason'})) { + my $rv = $srs->make_request( + { + action => 'belongs_to_rsp', + object => 'domain', + attributes => { + domain => $svc_domain->domain + } + } + ); + if ($rv) { + $self->_set_response; + if ( $rv->{attributes}->{'domain_expdate'} ) { + $rslt->{'expdate'} = $rv->{attributes}->{'domain_expdate'}; + } + } + } + } + + return $rslt; # Success +} + +=item register + +Attempts to register the domain through the reseller account associated with this export. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub register { + my ( $self, $svc_domain, $years ) = @_; + + return "Net::OpenSRS does not support period other than 1 year" if $years != 1; + + eval "use Net::OpenSRS;"; + return $@ if $@; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + + my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main; + + my $c = gen_contact_info($cust_main); + + $err = validate_contact_info($c); + return $err if $err; + + my $srs = $self->get_srs; + + my $cookie = $srs->get_cookie( $self->option('masterdomain') ); + if (!$cookie) { + return "Unable to get cookie at OpenSRS: " . $srs->last_response(); + } + +# return "Domain registration not enabled" if !$self->option('register'); + return $srs->last_response() if !$srs->register_domain( $svc_domain->domain, $c); + + return ''; # Should only get here if register succeeded +} + +=item transfer + +Attempts to transfer the domain into the reseller account associated with this export. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub transfer { + my ( $self, $svc_domain ) = @_; + + eval "use Net::OpenSRS;"; + return $@ if $@; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + + my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main; + + my $c = gen_contact_info($cust_main); + + $err = validate_contact_info($c); + return $err if $err; + + my $srs = $self->get_srs; + + my $cookie = $srs->get_cookie( $self->option('masterdomain') ); + if (!$cookie) { + return "Unable to get cookie at OpenSRS: " . $srs->last_response(); + } + +# return "Domain transfer not enabled" if !$self->option('transfer'); + return $srs->last_response() if !$srs->transfer_domain( $svc_domain->domain, $c); + + return ''; # Should only get here if transfer succeeded +} + +=item renew + +Attempts to renew the domain for the specified number of years. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub renew { + my ( $self, $svc_domain, $years ) = @_; + + eval "use Net::OpenSRS;"; + return $@ if $@; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + + my $srs = $self->get_srs; + + my $cookie = $srs->get_cookie( $self->option('masterdomain') ); + if (!$cookie) { + return "Unable to get cookie at OpenSRS: " . $srs->last_response(); + } + +# return "Domain renewal not enabled" if !$self->option('renew'); + return $srs->last_response() if !$srs->renew_domain( $svc_domain->domain, $years ); + + return ''; # Should only get here if renewal succeeded +} + +=item revoke + +Attempts to revoke the domain registration. Only succeeds if invoked during the OpenSRS +grace period immediately after registration. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub revoke { + my ( $self, $svc_domain ) = @_; + + eval "use Net::OpenSRS;"; + return $@ if $@; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + + my $srs = $self->get_srs; + + my $cookie = $srs->get_cookie( $self->option('masterdomain') ); + if (!$cookie) { + return "Unable to get cookie at OpenSRS: " . $srs->last_response(); + } + +# return "Domain registration revocation not enabled" if !$self->option('revoke'); + return $srs->last_response() if !$srs->revoke_domain( $svc_domain->domain); + + return ''; # Should only get here if transfer succeeded +} + +=item registrar + +Should return a full-blown object representing OpenSRS, but current just returns a hashref +containing the registrar name. + +=cut + +sub registrar { + return { + name => 'OpenSRS', + }; +} + +=back + +=head1 SEE ALSO + +L<Net::OpenSRS>, L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_domain>, +L<FS::Record>, schema.html from the base documentation. + + +=cut + +1; + diff --git a/FS/FS/part_export/globalpops_voip.pm b/FS/FS/part_export/globalpops_voip.pm index 3bd5783..67b48bb 100644 --- a/FS/FS/part_export/globalpops_voip.pm +++ b/FS/FS/part_export/globalpops_voip.pm @@ -32,7 +32,7 @@ sub get_dids { my $self = shift; my %opt = ref($_[0]) ? %{$_[0]} : @_; - my %search = (); + my %getdids = (); # 'orderby' => 'npa', #but it doesn't seem to work :/ if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers diff --git a/FS/FS/part_export/netsapiens.pm b/FS/FS/part_export/netsapiens.pm new file mode 100644 index 0000000..cf4b5e3 --- /dev/null +++ b/FS/FS/part_export/netsapiens.pm @@ -0,0 +1,308 @@ +package FS::part_export::netsapiens; + +use vars qw(@ISA $me %info); +use URI; +use MIME::Base64; +use Tie::IxHash; +use FS::part_export; + +@ISA = qw(FS::part_export); +$me = '[FS::part_export::netsapiens]'; + +tie my %options, 'Tie::IxHash', + 'login' => { label=>'NetSapiens tac2 User API username' }, + 'password' => { label=>'NetSapiens tac2 User API password' }, + 'url' => { label=>'NetSapiens tac2 User URL' }, + 'device_login' => { label=>'NetSapiens tac2 Device API username' }, + 'device_password' => { label=>'NetSapiens tac2 Device API password' }, + 'device_url' => { label=>'NetSapiens tac2 Device URL' }, + 'domain' => { label=>'NetSapiens Domain' }, + 'debug' => { label=>'Enable debugging', type=>'checkbox' }, +; + +%info = ( + 'svc' => 'svc_phone', + 'desc' => 'Provision phone numbers to NetSapiens', + 'options' => \%options, + 'notes' => <<'END' +Requires installation of +<a href="http://search.cpan.org/dist/REST-Client">REST::Client</a> +from CPAN. +END +); + +sub rebless { shift; } + +sub ns_command { + my $self = shift; + $self->_ns_command('', @_); +} + +sub ns_device_command { + my $self = shift; + $self->_ns_command('device_', @_); +} + +sub _ns_command { + my( $self, $prefix, $method, $command ) = splice(@_,0,4); + + eval 'use REST::Client'; + die $@ if $@; + + my $ns = new REST::Client 'host'=>$self->option($prefix.'url'); + + my @args = ( $command ); + + if ( $method eq 'PUT' ) { + my $content = $ns->buildQuery( { @_ } ); + $content =~ s/^\?//; + push @args, $content; + } elsif ( $method eq 'GET' ) { + $args[0] .= $ns->buildQuery( { @_ } ); + } + + warn "$me $method ". $self->option($prefix.'url'). + " $command ". join(', ', @_). "\n" + if $self->option('debug'); + + my $auth = encode_base64( $self->option($prefix.'login'). ':'. + $self->option($prefix.'password') ); + push @args, { 'Authorization' => "Basic $auth" }; + + $ns->$method( @args ); + $ns; +} + +sub ns_subscriber { + my($self, $svc_phone) = (shift, shift); + + my $domain = $self->option('domain'); + my $phonenum = $svc_phone->phonenum; + + "/domains_config/$domain/subscriber_config/$phonenum"; +} + +sub ns_registrar { + my($self, $svc_phone) = (shift, shift); + + $self->ns_subscriber($svc_phone). + '/registrar_config/'. $self->ns_devicename($svc_phone); +} + +sub ns_devicename { + my( $self, $svc_phone ) = (shift, shift); + + my $domain = $self->option('domain'); + #my $countrycode = $svc_phone->countrycode; + my $phonenum = $svc_phone->phonenum; + + #"sip:$countrycode$phonenum\@$domain"; + "sip:$phonenum\@$domain"; +} + +sub ns_dialplan { + my($self, $svc_phone) = (shift, shift); + + #my $countrycode = $svc_phone->countrycode; + my $phonenum = $svc_phone->phonenum; + + #"/dialplans/DID+Table/dialplan_config/sip:$countrycode$phonenum\@*" + "/dialplans/DID+Table/dialplan_config/sip:$phonenum\@*" +} + +sub ns_device { + my($self, $svc_phone, $phone_device ) = (shift, shift, shift); + + #my $countrycode = $svc_phone->countrycode; + #my $phonenum = $svc_phone->phonenum; + + "/phones_config/". lc($phone_device->mac_addr); +} + +sub ns_create_or_update { + my($self, $svc_phone, $dial_policy) = (shift, shift, shift); + + my $domain = $self->option('domain'); + #my $countrycode = $svc_phone->countrycode; + my $phonenum = $svc_phone->phonenum; + + my( $firstname, $lastname ); + if ( $svc_phone->phone_name =~ /^\s*(\S+)\s+(\S.*\S)\s*$/ ) { + $firstname = $1; + $lastname = $2; + } else { + #deal w/unaudited netsapiens services? + my $cust_main = $svc_phone->cust_svc->cust_pkg->cust_main; + $firstname = $cust_main->get('first'); + $lastname = $cust_main->get('last'); + } + + # Piece 1 (already done) - User creation + + my $ns = $self->ns_command( 'PUT', $self->ns_subscriber($svc_phone), + 'subscriber_login' => $phonenum.'@'.$domain, + 'firstname' => $firstname, + 'lastname' => $lastname, + 'subscriber_pin' => $svc_phone->pin, + 'dial_plan' => 'Default', #config? + 'dial_policy' => $dial_policy, + ); + + if ( $ns->responseCode !~ /^2/ ) { + return $ns->responseCode. ' '. + join(', ', $self->ns_parse_response( $ns->responseContent ) ); + } + + #Piece 2 - sip device creation + + my $ns2 = $self->ns_command( 'PUT', $self->ns_registrar($svc_phone), + 'termination_match' => $self->ns_devicename($svc_phone) + ); + + if ( $ns2->responseCode !~ /^2/ ) { + return $ns2->responseCode. ' '. + join(', ', $self->ns_parse_response( $ns2->responseContent ) ); + } + + #Piece 3 - DID mapping to user + + my $ns3 = $self->ns_command( 'PUT', $self->ns_dialplan($svc_phone), + 'to_user' => $phonenum, + 'to_host' => $domain, + ); + + if ( $ns3->responseCode !~ /^2/ ) { + return $ns3->responseCode. ' '. + join(', ', $self->ns_parse_response( $ns3->responseContent ) ); + } + + ''; +} + +sub ns_delete { + my($self, $svc_phone) = (shift, shift); + + my $ns = $self->ns_command( 'DELETE', $self->ns_subscriber($svc_phone) ); + + #delete other things? + + if ( $ns->responseCode !~ /^2/ ) { + return $ns->responseCode. ' '. + join(', ', $self->ns_parse_response( $ns->responseContent ) ); + } + + ''; + +} + +sub ns_parse_response { + my( $self, $content ) = ( shift, shift ); + + #try to screen-scrape something useful + tie my %hash, Tie::IxHash; + while ( $content =~ s/^.*?<p>\s*<b>(.+?)<\/b>\s*(.+?)\s*<\/p>//is ) { + ( $hash{$1} = $2 ) =~ s/^\s*<(\w+)>(.+?)<\/\1>/$2/is; + } + + %hash; +} + +sub _export_insert { + my($self, $svc_phone) = (shift, shift); + $self->ns_create_or_update($svc_phone, 'Permit All'); +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + return "can't change phonenum with NetSapiens (unprovision and reprovision?)" + if $old->phonenum ne $new->phonenum; + $self->_export_insert($new); +} + +sub _export_delete { + my( $self, $svc_phone ) = (shift, shift); + + $self->ns_delete($svc_phone); +} + +sub _export_suspend { + my( $self, $svc_phone ) = (shift, shift); + $self->ns_create_or_update($svc_phone, 'Deny'); +} + +sub _export_unsuspend { + my( $self, $svc_phone ) = (shift, shift); + #$self->ns_create_or_update($svc_phone, 'Permit All'); + $self->_export_insert($svc_phone); +} + +sub export_device_insert { + my( $self, $svc_phone, $phone_device ) = (shift, shift, shift); + + #my $domain = $self->option('domain'); + my $countrycode = $svc_phone->countrycode; + my $phonenum = $svc_phone->phonenum; + + my $device = $self->ns_devicename($svc_phone); + + my $ns = $self->ns_device_command( + 'PUT', $self->ns_device($svc_phone, $phone_device), + 'line1_enable' => 'yes', + 'device1' => $self->ns_devicename($svc_phone), + 'line1_ext' => $phonenum, +, + #'line2_enable' => 'yes', + #'device2' => + #'line2_ext' => + + #'notes' => + 'server' => 'SiPbx', + 'domain' => $self->option('domain'), + + 'brand' => $phone_device->part_device->devicename, + + ); + + if ( $ns->responseCode !~ /^2/ ) { + return $ns->responseCode. ' '. + join(', ', $self->ns_parse_response( $ns->responseContent ) ); + } + + ''; + +} + +sub export_device_delete { + my( $self, $svc_phone, $phone_device ) = (shift, shift, shift); + + my $ns = $self->ns_device_command( + 'DELETE', $self->ns_device($svc_phone, $phone_device), + ); + + if ( $ns->responseCode !~ /^2/ ) { + return $ns->responseCode. ' '. + join(', ', $self->ns_parse_response( $ns->responseContent ) ); + } + + ''; + +} + + +sub export_device_replace { + my( $self, $svc_phone, $new_phone_device, $old_phone_device ) = + (shift, shift, shift, shift); + + #? + $self->export_device_insert( $svc_phone, $new_phone_device ); + +} + +sub export_links { + my($self, $svc_phone, $arrayref) = (shift, shift, shift); + #push @$arrayref, qq!<A HREF="http://example.com/~!. $svc_phone->username. + # qq!">!. $svc_phone->username. qq!</A>!; + ''; +} + +1; diff --git a/FS/FS/part_export/prizm.pm b/FS/FS/part_export/prizm.pm index 2d4d858..9705440 100644 --- a/FS/FS/part_export/prizm.pm +++ b/FS/FS/part_export/prizm.pm @@ -200,6 +200,9 @@ sub _export_insert { # } # } + my $performance_profile = $svc->performance_profile; + $performance_profile ||= $svc->cust_svc->cust_pkg->part_pkg->pkg; + my $element_name_length = 50; $element_name_length = $1 if $self->option('element_name_length') =~ /^\s*(\d+)\s*$/; @@ -211,7 +214,7 @@ sub _export_insert { $location, $contact, sprintf("%032X", $svc->authkey), - $svc->cust_svc->cust_pkg->part_pkg->pkg, + $performance_profile, $svc->vlan_profile, ($self->option('ems') ? 1 : 0 ), ); @@ -256,7 +259,7 @@ sub _export_insert { $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfigSet', [ $element ], - $svc->cust_svc->cust_pkg->part_pkg->pkg, + $performance_profile, 0, 1, ); @@ -395,9 +398,12 @@ sub _export_replace { return $err_or_som unless ref($err_or_som); + my $performance_profile = $new->performance_profile; + $performance_profile ||= $new->cust_svc->cust_pkg->part_pkg->pkg; + $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfigSet', [ $element ], - $new->cust_svc->cust_pkg->part_pkg->pkg, + $performance_profile, 0, 1, ); diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index c55fa36..7baf2da 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -14,6 +14,9 @@ tie my %options, 'Tie::IxHash', default=>'useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username' #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir' }, + 'useradd_no_queue' => { label=>'Run immediately', + type => 'checkbox', + }, 'useradd_stdin' => { label=>'Insert command STDIN', type =>'textarea', default=>'', @@ -22,6 +25,9 @@ tie my %options, 'Tie::IxHash', default=>'userdel -r $username', #default=>'rm -rf $dir', }, + 'userdel_no_queue' => { label=>'Run immediately', + type =>'checkbox', + }, 'userdel_stdin' => { label=>'Delete command STDIN', type =>'textarea', default=>'', @@ -35,6 +41,9 @@ tie my %options, 'Tie::IxHash', # 'rm -rf $old_dir'. #')' }, + 'usermod_no_queue' => { label=>'Run immediately', + type =>'checkbox', + }, 'usermod_stdin' => { label=>'Modify command STDIN', type =>'textarea', default=>'', @@ -48,12 +57,18 @@ tie my %options, 'Tie::IxHash', 'suspend' => { label=>'Suspension command', default=>'usermod -L $username', }, + 'suspend_no_queue' => { label=>'Run immediately', + type =>'checkbox', + }, 'suspend_stdin' => { label=>'Suspension command STDIN', default=>'', }, 'unsuspend' => { label=>'Unsuspension command', default=>'usermod -U $username', }, + 'unsuspend_no_queue' => { label=>'Run immediately', + type =>'checkbox', + }, 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', default=>'', }, @@ -65,6 +80,9 @@ tie my %options, 'Tie::IxHash', 'Radius group mapping to reason (via template user)', type => 'textarea', }, +# 'no_queue' => { label => 'Run command immediately', +# type => 'checkbox', +# }, ; %info = ( @@ -172,6 +190,8 @@ old_ for replace operations): <LI><code>$reasontext (when suspending)</code> <LI><code>$reasontypenum (when suspending)</code> <LI><code>$reasontypetext (when suspending)</code> + <LI><code>$pkgnum</code> + <LI><code>$custnum</code> <LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available. </UL> END @@ -296,15 +316,27 @@ sub _export_command { $finger = shell_quote $finger; $crypt_password = shell_quote $crypt_password; $ldap_password = shell_quote $ldap_password; + $pkgnum = $cust_pkg ? $cust_pkg->pkgnum : ''; + $custnum = $cust_pkg ? $cust_pkg->custnum : ''; my $command_string = eval(qq("$command")); - - $self->shellcommands_queue( $svc_acct->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => $command_string, - stdin_string => $stdin_string, + my @ssh_cmd_args = ( + user => $self->option('user') || 'root', + host => $self->machine, + command => $command_string, + stdin_string => $stdin_string, ); + + if($self->option($action . '_no_queue')) { + # discard return value just like freeside-queued. + eval { ssh_cmd(@ssh_cmd_args) }; + $error = $@; + return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')' + if $error; + } + else { + $self->shellcommands_queue( $svc_acct->svcnum, @ssh_cmd_args ); + } } sub _export_replace { @@ -317,6 +349,8 @@ sub _export_replace { ${"old_$_"} = $old->getfield($_) foreach $old->fields; ${"new_$_"} = $new->getfield($_) foreach $new->fields; } + my $old_cust_pkg = $old->cust_svc->cust_pkg; + my $new_cust_pkg = $new->cust_svc->cust_pkg; $new_finger =~ /^(.*)\s+(\S+)$/ or $new_finger =~ /^((.*))$/; ($new_first, $new_last ) = ( $1, $2 ); $quoted_new__password = shell_quote $new__password; #old, wrong? @@ -364,15 +398,30 @@ sub _export_replace { $new_finger = shell_quote $new_finger; $new_crypt_password = shell_quote $new_crypt_password; $new_ldap_password = shell_quote $new_ldap_password; + $old_pkgnum = $old_cust_pkg ? $old_cust_pkg->pkgnum : ''; + $old_custnum = $old_cust_pkg ? $old_cust_pkg->custnum : ''; + $new_pkgnum = $new_cust_pkg ? $new_cust_pkg->pkgnum : ''; + $new_custnum = $new_cust_pkg ? $new_cust_pkg->custnum : ''; my $command_string = eval(qq("$command")); - $self->shellcommands_queue( $new->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => $command_string, - stdin_string => $stdin_string, + my @ssh_cmd_args = ( + user => $self->option('user') || 'root', + host => $self->machine, + command => $command_string, + stdin_string => $stdin_string, ); + + if($self->option('usermod_no_queue')) { + # discard return value just like freeside-queued. + eval { ssh_cmd(@ssh_cmd_args) }; + $error = $@; + return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')' + if $error; + } + else { + $self->shellcommands_queue( $new->svcnum, @ssh_cmd_args ); + } } #a good idea to queue anything that could fail or take any time diff --git a/FS/FS/part_export/shellcommands_withdomain.pm b/FS/FS/part_export/shellcommands_withdomain.pm index 7c5d904..c209002 100644 --- a/FS/FS/part_export/shellcommands_withdomain.pm +++ b/FS/FS/part_export/shellcommands_withdomain.pm @@ -15,6 +15,9 @@ tie my %options, 'Tie::IxHash', type =>'textarea', #default=>"$_password\n$_password\n", }, + 'useradd_no_queue' => { label => 'Run immediately', + type => 'checkbox', + }, 'userdel' => { label=>'Delete command', #default=>'', }, @@ -22,6 +25,9 @@ tie my %options, 'Tie::IxHash', type =>'textarea', #default=>'', }, + 'userdel_no_queue' => { label => 'Run immediately', + type => 'checkbox', + }, 'usermod' => { label=>'Modify command', default=>'', }, @@ -29,6 +35,9 @@ tie my %options, 'Tie::IxHash', type =>'textarea', #default=>"$_password\n$_password\n", }, + 'usermod_no_queue' => { label => 'Run immediately', + type => 'checkbox', + }, 'usermod_pwonly' => { label=>'Disallow username, domain, uid, dir and RADIUS group changes', type =>'checkbox', }, @@ -41,12 +50,18 @@ tie my %options, 'Tie::IxHash', 'suspend_stdin' => { label=>'Suspension command STDIN', default=>'', }, + 'suspend_no_queue' => { label => 'Run immediately', + type => 'checkbox', + }, 'unsuspend' => { label=>'Unsuspension command', default=>'', }, 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', default=>'', }, + 'unsuspend_no_queue' => { label => 'Run immediately', + type => 'checkbox', + }, 'crypt' => { label => 'Default password encryption', type=>'select', options=>[qw(crypt md5)], default => 'crypt', @@ -84,6 +99,17 @@ the same username with different domains. You will need to this.form.usermod_stdin.value = ""; this.form.usermod_pwonly.checked = true; '> + <LI><INPUT TYPE="button" VALUE="MagicMail" onClick=' + this.form.useradd.value = "/usr/bin/mm_create_email_service -e $svcnum -d $domain -u $username -p $quoted_password -f $first -l $last -m $svcnum -g EMAIL"; + this.form.useradd_stdin.value = ""; + this.form.useradd_no_queue.checked = 1; + this.form.userdel.value = "/usr/bin/mm_delete_user -e ${username}\\\@${domain}"; + this.form.userdel_stdin.value = ""; + this.form.suspend.value = "/usr/bin/mm_suspend_user -e ${username}\\\@${domain}"; + this.form.suspend_stdin.value = ""; + this.form.unsuspend.value = "/usr/bin/mm_activate_user -e ${username}\\\@${domain}"; + this.form.unsuspend_stdin.value = ""; + '> </UL> The following variables are available for interpolation (prefixed with diff --git a/FS/FS/part_export/www_plesk.pm b/FS/FS/part_export/www_plesk.pm index 82d5557..ccf9b3e 100644 --- a/FS/FS/part_export/www_plesk.pm +++ b/FS/FS/part_export/www_plesk.pm @@ -26,7 +26,7 @@ Real-time export to <a href="http://www.swsoft.com/">Plesk</a> managed server. Requires installation of <a href="http://search.cpan.org/dist/Net-Plesk">Net::Plesk</a> -from CPAN. +from CPAN and proper <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration:www_plesk.pm">configuration</a>. END ); diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index ef24b53..287453f 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -1,7 +1,7 @@ package FS::part_pkg; use strict; -use vars qw( @ISA %plans $DEBUG $setup_hack ); +use vars qw( @ISA %plans $DEBUG $setup_hack $skip_pkg_svc_hack ); use Carp qw(carp cluck confess); use Scalar::Util qw( blessed ); use Time::Local qw( timelocal_nocheck ); @@ -23,6 +23,7 @@ use FS::part_pkg_link; @ISA = qw( FS::m2m_Common FS::option_Common ); $DEBUG = 0; $setup_hack = 0; +$skip_pkg_svc_hack = 0; =head1 NAME @@ -85,6 +86,12 @@ inherits from FS::Record. The following fields are currently supported: =item disabled - Disabled flag, empty or `Y' +=item custom - Custom flag, empty or `Y' + +=item setup_cost - for cost tracking + +=item recur_cost - for cost tracking + =item pay_weight - Weight (relative to credit_weight and other package definitions) that controls payment application to specific line items. =item credit_weight - Weight (relative to other package definitions) that controls credit application to specific line items. @@ -109,9 +116,8 @@ sub table { 'part_pkg'; } =item clone An alternate constructor. Creates a new package definition by duplicating -an existing definition. A new pkgpart is assigned and `(CUSTOM) ' is prepended -to the comment field. To add the package definition to the database, see -L<"insert">. +an existing definition. A new pkgpart is assigned and the custom flag is +set to Y. To add the package definition to the database, see L<"insert">. =cut @@ -120,8 +126,7 @@ sub clone { my $class = ref($self); my %hash = $self->hash; $hash{'pkgpart'} = ''; - $hash{'comment'} = "(CUSTOM) ". $hash{'comment'} - unless $hash{'comment'} =~ /^\(CUSTOM\) /; + $hash{'custom'} = 'Y'; #new FS::part_pkg ( \%hash ); # ? new $class ( \%hash ); # ? } @@ -213,26 +218,30 @@ sub insert { } } - warn " inserting pkg_svc records" if $DEBUG; - my $pkg_svc = $options{'pkg_svc'} || {}; - foreach my $part_svc ( qsearch('part_svc', {} ) ) { - my $quantity = $pkg_svc->{$part_svc->svcpart} || 0; - my $primary_svc = - ( $options{'primary_svc'} && $options{'primary_svc'}==$part_svc->svcpart ) - ? 'Y' - : ''; - - my $pkg_svc = new FS::pkg_svc( { - 'pkgpart' => $self->pkgpart, - 'svcpart' => $part_svc->svcpart, - 'quantity' => $quantity, - 'primary_svc' => $primary_svc, - } ); - my $error = $pkg_svc->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + unless ( $skip_pkg_svc_hack ) { + + warn " inserting pkg_svc records" if $DEBUG; + my $pkg_svc = $options{'pkg_svc'} || {}; + foreach my $part_svc ( qsearch('part_svc', {} ) ) { + my $quantity = $pkg_svc->{$part_svc->svcpart} || 0; + my $primary_svc = + ( $options{'primary_svc'} && $options{'primary_svc'}==$part_svc->svcpart ) + ? 'Y' + : ''; + + my $pkg_svc = new FS::pkg_svc( { + 'pkgpart' => $self->pkgpart, + 'svcpart' => $part_svc->svcpart, + 'quantity' => $quantity, + 'primary_svc' => $primary_svc, + } ); + my $error = $pkg_svc->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } + } if ( $options{'cust_pkg'} ) { @@ -365,7 +374,7 @@ sub replace { foreach my $part_svc ( qsearch('part_svc', {} ) ) { my $quantity = $pkg_svc->{$part_svc->svcpart} || 0; my $primary_svc = - ( defined($options->{'primary_svc'}) + ( defined($options->{'primary_svc'}) && $options->{'primary_svc'} && $options->{'primary_svc'} == $part_svc->svcpart ) ? 'Y' @@ -448,6 +457,11 @@ sub check { || $self->ut_enum('recurtax', [ '', 'Y' ] ) || $self->ut_textn('taxclass') || $self->ut_enum('disabled', [ '', 'Y' ] ) + || $self->ut_enum('custom', [ '', 'Y' ] ) + #|| $self->ut_moneyn('setup_cost') + #|| $self->ut_moneyn('recur_cost') + || $self->ut_floatn('setup_cost') + || $self->ut_floatn('recur_cost') || $self->ut_floatn('pay_weight') || $self->ut_floatn('credit_weight') || $self->ut_numbern('taxproductnum') @@ -480,20 +494,30 @@ sub check { ''; } -=item pkg_comment +=item pkg_comment [ OPTION => VALUE... ] Returns an (internal) string representing this package. Currently, "pkgpart: pkg - comment", is returned. "pkg - comment" may be returned in the -future, omitting pkgpart. +future, omitting pkgpart. The comment will have '(CUSTOM) ' prepended if +custom is Y. + +If the option nopkgpart is true then the "pkgpart: ' is omitted. =cut sub pkg_comment { my $self = shift; + my %opt = @_; #$self->pkg. ' - '. $self->comment; #$self->pkg. ' ('. $self->comment. ')'; - $self->pkgpart. ': '. $self->pkg. ' - '. $self->comment; + my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': '; + $pre. $self->pkg. ' - '. $self->custom_comment; +} + +sub custom_comment { + my $self = shift; + ( $self->custom ? '(CUSTOM) ' : '' ). $self->comment; } =item pkg_class @@ -613,25 +637,49 @@ Returns the svcpart of the primary service definition (see L<FS::part_svc>) associated with this package definition (see L<FS::pkg_svc>). Returns false if there not a primary service definition or exactly one service definition with quantity 1, or if SVCDB is specified and does not match the -svcdb of the service definition, +svcdb of the service definition. SVCDB can be specified as a scalar table +name, such as 'svc_acct', or as an arrayref of possible table names. =cut sub svcpart { + my $pkg_svc = shift->_primary_pkg_svc(@_); + $pkg_svc ? $pkg_svc->svcpart : ''; +} + +=item part_svc [ SVCDB ] + +Like the B<svcpart> method, but returns the FS::part_svc object (see +L<FS::part_svc>). + +=cut + +sub part_svc { + my $pkg_svc = shift->_primary_pkg_svc(@_); + $pkg_svc ? $pkg_svc->part_svc : ''; +} + +sub _primary_pkg_svc { my $self = shift; - my $svcdb = scalar(@_) ? shift : ''; + + my $svcdb = scalar(@_) ? shift : []; + $svcdb = ref($svcdb) ? $svcdb : [ $svcdb ]; + my %svcdb = map { $_=>1 } @$svcdb; + my @svcdb_pkg_svc = - grep { ( $svcdb eq $_->part_svc->svcdb || !$svcdb ) } $self->pkg_svc; + grep { !scalar(@$svcdb) || $svcdb{ $_->part_svc->svcdb } } + $self->pkg_svc; + my @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc; @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc unless @pkg_svc; return '' if scalar(@pkg_svc) != 1; - $pkg_svc[0]->svcpart; + $pkg_svc[0]; } =item svcpart_unique_svcdb SVCDB -Returns the svcpart of the a service definition (see L<FS::part_svc>) matching +Returns the svcpart of a service definition (see L<FS::part_svc>) matching SVCDB associated with this package definition (see L<FS::pkg_svc>). Returns false if there not a primary service definition for SVCDB or there are multiple service definitions for SVCDB. @@ -874,10 +922,12 @@ sub svc_part_pkg_link { sub _part_pkg_link { my( $self, $type ) = @_; - qsearch('part_pkg_link', { 'src_pkgpart' => $self->pkgpart, - 'link_type' => $type, - } - ); + qsearch({ table => 'part_pkg_link', + hashref => { 'src_pkgpart' => $self->pkgpart, + 'link_type' => $type, + }, + order_by => "ORDER BY hidden", + }); } sub self_and_bill_linked { @@ -885,12 +935,18 @@ sub self_and_bill_linked { } sub _self_and_linked { - my( $self, $type ) = @_; + my( $self, $type, $hidden ) = @_; + $hidden ||= ''; + + my @result = (); + foreach ( ( $self, map { $_->dst_pkg->_self_and_linked($type, $_->hidden) } + $self->_part_pkg_link($type) ) ) + { + $_->hidden($hidden) if $hidden; + push @result, $_; + } - ( $self, - map { $_->dst_pkg->_self_and_linked($type) } - $self->_part_pkg_link($type) - ); + (@result); } =item part_pkg_taxoverride [ CLASS ] @@ -1116,6 +1172,9 @@ sub calc_remain { 0; } sub calc_cancel { 0; } sub calc_units { 0; } +#fallback for everything except bulk.pm +sub hide_svc_detail { 0; } + =item format OPTION DATA Returns data formatted according to the function 'format' described @@ -1179,27 +1238,29 @@ sub _upgrade_data { # class method foreach my $part_pkg (@part_pkg) { unless ( $part_pkg->plan ) { - $part_pkg->plan('flat'); + } - if ( $part_pkg->setup =~ /^\s*([\d\.]+)\s*$/ ) { + if ( length($part_pkg->option('setup_fee')) == 0 + && $part_pkg->setup =~ /^\s*([\d\.]+)\s*$/ ) { - my $opt = new FS::part_pkg_option { - 'pkgpart' => $part_pkg->pkgpart, - 'optionname' => 'setup_fee', - 'optionvalue' => $1, - }; - my $error = $opt->insert; - die $error if $error; + my $opt = new FS::part_pkg_option { + 'pkgpart' => $part_pkg->pkgpart, + 'optionname' => 'setup_fee', + 'optionvalue' => $1, + }; + my $error = $opt->insert; + die $error if $error; - $part_pkg->setup(''); - } else { - die "Can't parse part_pkg.setup for fee; convert pkgnum ". - $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n"; - } + #} else { + # die "Can't parse part_pkg.setup for fee; convert pkgnum ". + # $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n"; + } + $part_pkg->setup(''); - if ( $part_pkg->recur =~ /^\s*([\d\.]+)\s*$/ ) { + if ( length($part_pkg->option('recur_fee')) == 0 + && $part_pkg->recur =~ /^\s*([\d\.]+)\s*$/ ) { my $opt = new FS::part_pkg_option { 'pkgpart' => $part_pkg->pkgpart, @@ -1209,19 +1270,45 @@ sub _upgrade_data { # class method my $error = $opt->insert; die $error if $error; - $part_pkg->recur(''); - - } else { - die "Can't parse part_pkg.setup for fee; convert pkgnum ". - $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n"; - } + #} else { + # die "Can't parse part_pkg.setup for fee; convert pkgnum ". + # $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n"; } + $part_pkg->recur(''); $part_pkg->replace; #this should take care of plandata, right? } + # now upgrade to the explicit custom flag + + @part_pkg = qsearch({ + 'table' => 'part_pkg', + 'hashref' => { disabled => 'Y', custom => '' }, + 'extra_sql' => "AND comment LIKE '(CUSTOM) %'", + }); + + foreach my $part_pkg (@part_pkg) { + my $new = new FS::part_pkg { $part_pkg->hash }; + $new->custom('Y'); + my $comment = $part_pkg->comment; + $comment =~ s/^\(CUSTOM\) //; + $comment = '(none)' unless $comment =~ /\S/; + $new->comment($comment); + + my $pkg_svc = { map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc }; + my $primary = $part_pkg->svcpart; + my $options = { $part_pkg->options }; + + my $error = $new->replace( $part_pkg, + 'pkg_svc' => $pkg_svc, + 'primary_svc' => $primary, + 'options' => $options, + ); + die $error if $error; + } + } =item curuser_pkgs_sql @@ -1233,9 +1320,31 @@ L<FS::type_pkgs>). =cut sub curuser_pkgs_sql { - #my($class) = shift; + my $class = shift; + + $class->_pkgs_sql( $FS::CurrentUser::CurrentUser->agentnums ); + +} + +=item agent_pkgs_sql AGENT | AGENTNUM, ... - my $agentnums = join(',', $FS::CurrentUser::CurrentUser->agentnums); +Returns an SQL fragment for searching for packages the provided agent or agents +can use, either via part_pkg.agentnum directly, or via agent type (see +L<FS::type_pkgs>). + +=cut + +sub agent_pkgs_sql { + my $class = shift; #i'm a class method, not a sub (the question is... why??) + my @agentnums = map { ref($_) ? $_->agentnum : $_ } @_; + + $class->_pkgs_sql(@agentnums); #is this why + +} + +sub _pkgs_sql { + my( $class, @agentnums ) = @_; + my $agentnums = join(',', @agentnums); " ( @@ -1322,6 +1431,8 @@ plandata should go part_pkg_taxrate is Pg specific +replace should be smarter about managing the related tables (options, pkg_svc) + =head1 SEE ALSO L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>. diff --git a/FS/FS/part_pkg/agent.pm b/FS/FS/part_pkg/agent.pm new file mode 100644 index 0000000..d41978c --- /dev/null +++ b/FS/FS/part_pkg/agent.pm @@ -0,0 +1,175 @@ +package FS::part_pkg::agent; + +use strict; +use vars qw(@ISA $DEBUG $me %info); +use Date::Format; +use FS::Record qw( qsearch ); +use FS::agent; +use FS::cust_main; + +#use FS::part_pkg::recur_Common;; +#@ISA = qw(FS::part_pkg::recur_Common); +use FS::part_pkg::prorate; +@ISA = qw(FS::part_pkg::prorate); + +$DEBUG = 0; + +$me = '[FS::part_pkg::agent]'; + +%info = ( + 'name' => 'Wholesale bulk billing, for master customers of an agent.', + 'shortname' => 'Wholesale bulk billing for agent.', + + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Base recurring fee for this package', + 'default' => 0, + }, + + + #'recur_method' => { 'name' => 'Recurring fee method', + # #'type' => 'radio', + # #'options' => \%recur_method, + # 'type' => 'select', + # 'select_options' => \%recur_Common::recur_method, + # }, + 'cutoff_day' => { 'name' => 'Billing Day (1 - 28)', + 'default' => '1', + }, + + 'no_pkg_prorate' => { 'name' => 'Disable prorating bulk packages (charge full price for packages active only a portion of the month)', + 'type' => 'checkbox', + }, + + }, + + #'fieldorder' => [qw( setup_fee recur_fee recur_method cutoff_day ) ], + 'fieldorder' => [qw( setup_fee recur_fee cutoff_day no_pkg_prorate ) ], + + 'weight' => 51, + +); + +#some false laziness-ish w/bulk.pm... not a lot +sub calc_recur { + my $self = shift; + my($cust_pkg, $sdate, $details, $param ) = @_; + + my $last_bill = $cust_pkg->last_bill; + + return sprintf("%.2f", $self->SUPER::calc_recur(@_) ) + unless $$sdate > $last_bill; + + my $conf = new FS::Conf; + my $money_char = $conf->config('money_char') || '$'; + + my $total_agent_charge = 0; + + warn "$me billing for agent packages from ". time2str('%x', $last_bill). + " to ". time2str('%x', $$sdate). "\n" + if $DEBUG; + + my $prorate_ratio = ( $$sdate - $last_bill ) + / ( $self->add_freq($last_bill) - $last_bill ); + + #almost always just one, + #unless you have multiple agents with same master customer0 + my @agents = qsearch('agent', { 'agent_custnum' => $cust_pkg->custnum } ); + + foreach my $agent (@agents) { + + warn "$me billing for agent ". $agent->agent. "\n" + if $DEBUG; + + #not the most efficient to load them all into memory, + #but good enough for our current needs + my @cust_main = qsearch('cust_main', { 'agentnum' => $agent->agentnum } ); + + foreach my $cust_main (@cust_main) { + + warn "$me billing agent charges for ". $cust_main->name_short. "\n" + if $DEBUG; + + #make sure setup dates are filled in + my $error = $cust_main->bill; #options don't propogate from freeside-daily + die "Error pre-billing agent customer: $error" if $error; + + my @cust_pkg = grep { my $setup = $_->get('setup'); + my $cancel = $_->get('cancel'); + + $setup < $$sdate # END + && ( ! $cancel || $cancel > $last_bill ) #START + } + $cust_main->all_pkgs; + + foreach my $cust_pkg ( @cust_pkg ) { + + warn "$me billing agent charges for pkgnum ". $cust_pkg->pkgnum. "\n" + if $DEBUG; + + my $pkg_details = $cust_main->name_short. ': '; #name? + # + something to identify package... primary service probably + + my $pkg_charge = 0; + + my $part_pkg = $cust_pkg->part_pkg; + #option to not fallback? via options above + my $pkg_setup_fee = + $part_pkg->setup_cost || $part_pkg->option('setup_fee'); + my $pkg_base_recur = + $part_pkg->recur_cost || $part_pkg->base_recur_permonth($cust_pkg); + + my $pkg_start = $cust_pkg->get('setup'); + if ( $pkg_start < $last_bill ) { + $pkg_start = $last_bill; + } elsif ( $pkg_setup_fee ) { + $pkg_charge += $pkg_setup_fee; + $pkg_details .= $money_char. sprintf('%.2f setup, ', $pkg_setup_fee ); + } + + my $pkg_end = $cust_pkg->get('cancel'); + $pkg_end = ( !$pkg_end || $pkg_end > $$sdate ) ? $$sdate : $pkg_end; + + + my $pkg_recur_charge = $prorate_ratio * $pkg_base_recur; + $pkg_recur_charge *= ( $pkg_end - $pkg_start ) + / ( $$sdate - $last_bill ) + unless $self->option('no_pkg_prorate'); + + my $recur_charge += $pkg_recur_charge; + + $pkg_details .= $money_char. sprintf('%.2f', $recur_charge ). + ' ('. time2str('%x', $pkg_start). + ' - '. time2str('%x', $pkg_end ). ')' + if $recur_charge; + + $pkg_charge += $recur_charge; + + push @$details, $pkg_details + if $pkg_charge; + $total_agent_charge += $pkg_charge; + + } #foreach $cust_pkg + + } #foreach $cust_main + + } #foreach $agent; + + my $charges = $total_agent_charge + $self->SUPER::calc_recur(@_); #prorate + + sprintf('%.2f', $charges ); + +} + +sub hide_svc_detail { + 1; +} + +sub is_free { + 0; +} + +1; + diff --git a/FS/FS/part_pkg/base_rate.pm b/FS/FS/part_pkg/base_rate.pm index 64636d9..440e985 100644 --- a/FS/FS/part_pkg/base_rate.pm +++ b/FS/FS/part_pkg/base_rate.pm @@ -63,7 +63,7 @@ sub calc_remain { my $time = time; #should be able to pass this in for credit calculation my $next_bill = $cust_pkg->getfield('bill') || 0; my $last_bill = $cust_pkg->last_bill || 0; - return 0 if ! $self->base_recur + return 0 if ! $self->base_recur($cust_pkg) || ! $self->option('unused_credit', 1) || ! $last_bill || ! $next_bill @@ -81,7 +81,7 @@ sub calc_remain { my $freq_sec = $1 * $sec{$2||'m'}; return 0 unless $freq_sec; - sprintf("%.2f", $self->base_recur * ( $next_bill - $time ) / $freq_sec ); + sprintf("%.2f", $self->base_recur($cust_pkg) * ( $next_bill - $time ) / $freq_sec ); } diff --git a/FS/FS/part_pkg/bulk.pm b/FS/FS/part_pkg/bulk.pm index 63d344d..1b52d9f 100644 --- a/FS/FS/part_pkg/bulk.pm +++ b/FS/FS/part_pkg/bulk.pm @@ -7,7 +7,7 @@ use FS::part_pkg::flat; @ISA = qw(FS::part_pkg::flat); -$DEBUG = 0; +$DEBUG = 1; $me = '[FS::part_pkg::bulk]'; %info = ( @@ -35,6 +35,7 @@ $me = '[FS::part_pkg::bulk]'; 'weight' => 50, ); +#some false laziness-ish w/agent.pm... not a lot sub calc_recur { my($self, $cust_pkg, $sdate, $details ) = @_; @@ -45,6 +46,9 @@ sub calc_recur { my $last_bill = $cust_pkg->last_bill; + return sprintf("%.2f", $self->base_recur($cust_pkg) ) + unless $$sdate > $last_bill; + my $total_svc_charge = 0; warn "$me billing for bulk services from ". time2str('%x', $last_bill). @@ -52,16 +56,15 @@ sub calc_recur { if $DEBUG; # END START - foreach my $h_svc ( $cust_pkg->h_cust_svc( $$sdate, $last_bill ) ) { + foreach my $h_cust_svc ( $cust_pkg->h_cust_svc( $$sdate, $last_bill ) ) { - my @label = $h_svc->label( $$sdate, $last_bill ); + my @label = $h_cust_svc->label_long( $$sdate, $last_bill ); die "fatal: no historical label found, wtf?" unless scalar(@label); #? - #my $svc_details = $label[0].': '. $label[1]. ': '; - my $svc_details = $label[1]. ': '; + my $svc_details = $label[0]. ': '. $label[1]. ': '; my $svc_charge = 0; - my $svc_start = $h_svc->date_inserted; + my $svc_start = $h_cust_svc->date_inserted; if ( $svc_start < $last_bill ) { $svc_start = $last_bill; } elsif ( $svc_setup_fee ) { @@ -69,23 +72,30 @@ sub calc_recur { $svc_details .= $money_char. sprintf('%.2f setup, ', $svc_setup_fee); } - my $svc_end = $h_svc->date_deleted; + my $svc_end = $h_cust_svc->date_deleted; $svc_end = ( !$svc_end || $svc_end > $$sdate ) ? $$sdate : $svc_end; - $svc_charge = $self->option('svc_recur_fee') * ( $svc_end - $svc_start ) - / ( $$sdate - $last_bill ); + my $recur_charge = + $self->option('svc_recur_fee') * ( $svc_end - $svc_start ) + / ( $$sdate - $last_bill ); - $svc_details .= $money_char. sprintf('%.2f', $svc_charge ). + $svc_details .= $money_char. sprintf('%.2f', $recur_charge ). ' ('. time2str('%x', $svc_start). ' - '. time2str('%x', $svc_end ). ')' - if $self->option('svc_recur_fee'); + if $recur_charge; + + $svc_charge += $recur_charge; push @$details, $svc_details; $total_svc_charge += $svc_charge; } - sprintf("%.2f", $self->base_recur($cust_pkg) + $total_svc_charge ); + sprintf('%.2f', $self->base_recur($cust_pkg) + $total_svc_charge ); +} + +sub hide_svc_detail { + 1; } sub is_free_options { diff --git a/FS/FS/part_pkg/cdr_termination.pm b/FS/FS/part_pkg/cdr_termination.pm new file mode 100644 index 0000000..d99903d --- /dev/null +++ b/FS/FS/part_pkg/cdr_termination.pm @@ -0,0 +1,207 @@ +package FS::part_pkg::cdr_termination; + +use strict; +use base qw( FS::part_pkg::recur_Common ); +use vars qw( $DEBUG %info ); +use Tie::IxHash; +use FS::Record qw( qsearch ); #qsearchs ); +use FS::cdr; +use FS::cdr_termination; + +tie my %temporalities, 'Tie::IxHash', + 'upcoming' => "Upcoming (future)", + 'preceding' => "Preceding (past)", +; + +%info = ( + 'name' => 'VoIP rating of CDR records for termination partners.', + 'shortname' => 'VoIP/telco CDR termination', + 'fields' => { + + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Base recurring fee for this package', + 'default' => 0, + }, + + #'cdr_column' => { 'name' => 'Column from CDR records', + # 'type' => 'select', + # 'select_enum' => [qw( + # dcontext + # channel + # dstchannel + # lastapp + # lastdata + # accountcode + # userfield + # cdrtypenum + # calltypenum + # description + # carrierid + # upstream_rateid + # )], + # }, + + #false laziness w/flat.pm + 'recur_temporality' => { 'name' => 'Charge recurring fee for period', + 'type' => 'select', + 'select_options' => \%temporalities, + }, + + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + + 'cutoff_day' => { 'name' => 'Billing Day (1 - 28) for prorating or '. + 'subscription', + 'default' => '1', + }, + + 'recur_method' => { 'name' => 'Recurring fee method', + #'type' => 'radio', + #'options' => \%recur_method, + 'type' => 'select', + 'select_options' => \%FS::part_pkg::recur_Common::recur_method, + }, + + #false laziness w/cdr_termination.pm + 'output_format' => { 'name' => 'CDR invoice display format', + 'type' => 'select', + 'select_options' => { FS::cdr::invoice_formats() }, + 'default' => 'simple2', #XXX test + }, + + 'usage_section' => { 'name' => 'Section in which to place separate usage charges', + }, + + 'summarize_usage' => { 'name' => 'Include usage summary with recurring charges when usage is in separate section', + 'type' => 'checkbox', + }, + + }, + #cdr_column + 'fieldorder' => [qw( + setup_fee recur_fee + recur_temporality unused_credit recur_method cutoff_day + output_format usage_section summarize_usage + ) + ], + + 'weight' => 48, + +); + +sub calc_setup { + my($self, $cust_pkg ) = @_; + $self->option('setup_fee'); +} + +sub calc_recur { + my $self = shift; + my($cust_pkg, $sdate, $details, $param ) = @_; + + #my $last_bill = $cust_pkg->last_bill; + my $last_bill = $cust_pkg->get('last_bill'); #->last_bill falls back to setup + + return 0 + if $self->option('recur_temporality', 1) eq 'preceding' + && ( $last_bill eq '' || $last_bill == 0 ); + + # termination calculations + + my $term_percent = $cust_pkg->cust_main->cdr_termination_percentage; + die "no customer termination percentage" unless $term_percent; + + my $output_format = $self->option('output_format', 'Hush!') || 'simple2'; + + my $charges = 0; + + #find an svc_external record + my @svc_external = map { $_->svc_x } + grep { $_->part_svc->svcdb eq 'svc_external' } + $cust_pkg->cust_svc; + + die "cdr_termination package has no svc_external service" + unless @svc_external; + die "cdr_termination package has multiple svc_external services" + if scalar(@svc_external) > 1; + + my $svc_external = $svc_external[0]; + + # find CDRs: + # - matching our customer via svc_external.id/title? (and via what field?) + + #let's try carrierid for now, can always make it configurable or rewrite + my $cdr_column = 'carrierid'; + + my %hashref = ( 'freesidestatus' => 'done' ); + + # try matching on svc_external.id for now... (or title? if ints don't cut it) + $hashref{$cdr_column} = $svc_external[0]->id; + + # - with no cdr_termination.status + + my $termpart = 1; #or from an option + + #false lazienss w/search/cdr.html (i should be a part_termination method) + my $where_term = + "( cdr.acctid = cdr_termination.acctid AND termpart = $termpart ) "; + #my $join_term = "LEFT JOIN cdr_termination ON ( $where_term )"; + my $extra_sql = + "AND NOT EXISTS ( SELECT 1 FROM cdr_termination WHERE $where_term )"; + + #may need to process in batches if there's waaay too many + my @cdrs = qsearch({ + 'table' => 'cdr', + #'addl_from' => $join_term, + 'hashref' => \%hashref, + 'extra_sql' => "$extra_sql FOR UPDATE", + }); + + foreach my $cdr (@cdrs) { + + #add a cdr_termination record and the charges + + # XXX config? + #my $term_price = sprintf('%.2f', $cdr->rated_price * $term_percent / 100 ); + my $term_price = sprintf('%.4f', $cdr->rated_price * $term_percent / 100 ); + + my $cdr_termination = new FS::cdr_termination { + 'acctid' => $cdr->acctid, + 'termpart' => $termpart, + 'rated_price' => $term_price, + 'status' => 'done', + }; + + my $error = $cdr_termination->insert; + die $error if $error; #next if $error; #or just skip this one??? why? + + $charges += $term_price; + + # and add a line to the invoice + + my $call_details = $cdr->downstream_csv( 'format' => $output_format, + 'charge' => $term_price, + ); + + my $classnum = ''; #usage class? + + #option to turn off? or just use squelch_cdr for the customer probably + push @$details, [ 'C', $call_details, $term_price, $classnum ]; + + } + + # eotermiation calculation + + $charges += $self->calc_recur_Common(@_); + + $charges; +} + +sub is_free { + 0; +} + +1; diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm index 3ac44c4..02ac6ae 100644 --- a/FS/FS/part_pkg/flat.pm +++ b/FS/FS/part_pkg/flat.pm @@ -1,7 +1,10 @@ package FS::part_pkg::flat; use strict; -use vars qw(@ISA %info); +use vars qw( @ISA %info + %usage_fields %usage_recharge_fields + @usage_fieldorder @usage_recharge_fieldorder + ); use Tie::IxHash; #use FS::Record qw(qsearch); use FS::UI::bytecount; @@ -14,30 +17,8 @@ tie my %temporalities, 'Tie::IxHash', 'preceding' => "Preceding (past)", ; -%info = ( - 'name' => 'Flat rate (anniversary billing)', - 'shortname' => 'Anniversary', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - - #false laziness w/voip_cdr.pm - 'recur_temporality' => { 'name' => 'Charge recurring fee for period', - 'type' => 'select', - 'select_options' => \%temporalities, - }, +%usage_fields = ( - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. - ' of service at cancellation', - 'type' => 'checkbox', - }, - 'externalid' => { 'name' => 'Optional External ID', - 'default' => '', - }, 'seconds' => { 'name' => 'Time limit for this package', 'default' => '', 'check' => sub { shift =~ /^\d*$/ }, @@ -60,6 +41,10 @@ tie my %temporalities, 'Tie::IxHash', 'format' => \&FS::UI::bytecount::display_bytecount, 'parse' => \&FS::UI::bytecount::parse_bytecount, }, +); + +%usage_recharge_fields = ( + 'recharge_amount' => { 'name' => 'Cost of recharge for this package', 'default' => '', 'check' => sub { shift =~ /^\d*(\.\d{2})?$/ }, @@ -94,13 +79,46 @@ tie my %temporalities, 'Tie::IxHash', 'package recharge', 'type' => 'checkbox', }, +); + +@usage_fieldorder = qw( seconds upbytes downbytes totalbytes ); +@usage_recharge_fieldorder = qw( + recharge_amount recharge_seconds recharge_upbytes + recharge_downbytes recharge_totalbytes + usage_rollover recharge_reset +); + +%info = ( + 'name' => 'Flat rate (anniversary billing)', + 'shortname' => 'Anniversary', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + + #false laziness w/voip_cdr.pm + 'recur_temporality' => { 'name' => 'Charge recurring fee for period', + 'type' => 'select', + 'select_options' => \%temporalities, + }, + + %usage_fields, + %usage_recharge_fields, + + 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. + ' of service at cancellation', + 'type' => 'checkbox', + }, + 'externalid' => { 'name' => 'Optional External ID', + 'default' => '', + }, }, - 'fieldorder' => [qw( setup_fee recur_fee recur_temporality unused_credit - seconds upbytes downbytes totalbytes - recharge_amount recharge_seconds recharge_upbytes - recharge_downbytes recharge_totalbytes - usage_rollover recharge_reset externalid - ) + 'fieldorder' => [ qw( setup_fee recur_fee recur_temporality unused_credit ), + @usage_fieldorder, @usage_recharge_fieldorder, + qw( externalid ), ], 'weight' => 10, ); @@ -126,7 +144,8 @@ sub unit_setup { } sub calc_recur { - my($self, $cust_pkg) = @_; + my $self = shift; + my($cust_pkg) = @_; #my $last_bill = $cust_pkg->last_bill; my $last_bill = $cust_pkg->get('last_bill'); #->last_bill falls back to setup @@ -134,7 +153,7 @@ sub calc_recur { return 0 if $self->option('recur_temporality', 1) eq 'preceding' && $last_bill == 0; - $self->base_recur($cust_pkg); + $self->base_recur(@_); } sub base_recur { @@ -143,11 +162,11 @@ sub base_recur { } sub base_recur_permonth { - my($self, $cust_pkg) = @_; #$cust_pkg? + my($self, $cust_pkg) = @_; return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0; - sprintf('%.2f', $self->base_recur / $self->freq ); + sprintf('%.2f', $self->base_recur($cust_pkg) / $self->freq ); } sub calc_remain { @@ -165,7 +184,7 @@ sub calc_remain { #my $last_bill = $cust_pkg->last_bill || 0; my $last_bill = $cust_pkg->get('last_bill') || 0; #->last_bill falls back to setup - return 0 if ! $self->base_recur + return 0 if ! $self->base_recur($cust_pkg) || ! $self->option('unused_credit', 1) || ! $last_bill || ! $next_bill @@ -183,7 +202,7 @@ sub calc_remain { my $freq_sec = $1 * $sec{$2||'m'}; return 0 unless $freq_sec; - sprintf("%.2f", $self->base_recur * ( $next_bill - $time ) / $freq_sec ); + sprintf("%.2f", $self->base_recur($cust_pkg) * ( $next_bill - $time ) / $freq_sec ); } @@ -195,16 +214,21 @@ sub is_prepaid { 0; #no, we're postpaid } +sub usage_valuehash { + my $self = shift; + map { $_, $self->option($_) } + grep { $self->option($_, 'hush') } + qw(seconds upbytes downbytes totalbytes); +} + sub reset_usage { my($self, $cust_pkg, %opt) = @_; warn " resetting usage counters" if $opt{debug} > 1; - my %values = map { $_, $self->option($_) } - grep { $self->option($_, 'hush') } - qw(seconds upbytes downbytes totalbytes); + my %values = $self->usage_valuehash; if ($self->option('usage_rollover', 1)) { $cust_pkg->recharge(\%values); }else{ - $cust_pkg->set_usage(\%values); + $cust_pkg->set_usage(\%values, %opt); } } diff --git a/FS/FS/part_pkg/flat_delayed.pm b/FS/FS/part_pkg/flat_delayed.pm index 4a2f1ba..33f9dd8 100644 --- a/FS/FS/part_pkg/flat_delayed.pm +++ b/FS/FS/part_pkg/flat_delayed.pm @@ -58,7 +58,7 @@ sub calc_remain { return 0 if $last_bill + (86400 * $free_days) == $next_bill && $last_bill == $cust_pkg->setup; - return 0 if ! $self->base_recur + return 0 if ! $self->base_recur($cust_pkg) || ! $self->option('unused_credit', 1) || ! $last_bill || ! $next_bill; diff --git a/FS/FS/part_pkg/flat_introrate.pm b/FS/FS/part_pkg/flat_introrate.pm index 2568afa..2d551f1 100644 --- a/FS/FS/part_pkg/flat_introrate.pm +++ b/FS/FS/part_pkg/flat_introrate.pm @@ -1,46 +1,38 @@ package FS::part_pkg::flat_introrate; use strict; -use vars qw(@ISA %info $DEBUG $DEBUG_PRE); +use vars qw(@ISA %info $DEBUG $me); #use FS::Record qw(qsearch qsearchs); use FS::part_pkg::flat; use Date::Manip qw(DateCalc UnixDate ParseDate); @ISA = qw(FS::part_pkg::flat); +$me = '[' . __PACKAGE__ . ']'; $DEBUG = 0; -$DEBUG_PRE = '[' . __PACKAGE__ . ']: '; -%info = ( - 'name' => 'Introductory price for X months, then flat rate,'. - 'relative to setup date (anniversary billing)', - 'shortname' => 'Anniversary, with intro price', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', +(%info) = (%FS::part_pkg::flat::info); +$info{name} = 'Introductory price for X months, then flat rate,'. + 'relative to setup date (anniversary billing)'; +$info{shortname} = 'Anniversary, with intro price'; +$info{fields} = { %{$info{fields}} }; +$info{fields}{intro_fee} = + { 'name' => 'Introductory recurring fee for this package', 'default' => 0, - }, - 'intro_fee' => { 'name' => 'Introductory recurring free for this package', - 'default' => 0, - }, - 'intro_duration' => { 'name' => 'Duration of the introductory period, ' . - 'in number of months', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - 'unused_credit' => { 'name' => 'Credit the customer for the unused portion'. - ' of service at cancellation', - 'type' => 'checkbox', - }, - }, - 'fieldorder' => [ 'setup_fee', 'intro_duration', 'intro_fee', 'recur_fee', 'unused_credit' ], - 'weight' => 14, -); - -sub calc_recur { + }; +$info{fields}{intro_duration} = + { 'name' => 'Duration of the introductory period, in number of months', + 'default' => 0, + }; +$info{fieldorder} = [ @{ $info{fieldorder} } ]; +splice @{$info{fieldorder}}, 1, 0, qw( intro_duration intro_fee ); +$info{weight} = 14; + +sub base_recur { my($self, $cust_pkg, $time ) = @_; + my $now = $time ? $$time : time; + my ($duration) = ($self->option('intro_duration') =~ /^(\d+)$/); unless ($duration) { die "Invalid intro_duration: " . $self->option('intro_duration'); @@ -50,11 +42,11 @@ sub calc_recur { my $intro_end = &DateCalc($setup, "+${duration} month"); my $recur; - warn $DEBUG_PRE . "\$duration = ${duration}" if $DEBUG; - warn $DEBUG_PRE . "\$intro_end = ${intro_end}" if $DEBUG; - warn $DEBUG_PRE . "$$time < " . &UnixDate($intro_end, '%s') if $DEBUG; + warn "$me: \$duration = ${duration}" if $DEBUG; + warn "$me: \$intro_end = ${intro_end}" if $DEBUG; + warn "$me: $now < " . &UnixDate($intro_end, '%s') if $DEBUG; - if ($$time < &UnixDate($intro_end, '%s')) { + if ($now < &UnixDate($intro_end, '%s')) { $recur = $self->option('intro_fee'); } else { $recur = $self->option('recur_fee'); diff --git a/FS/FS/part_pkg/prepaid.pm b/FS/FS/part_pkg/prepaid.pm index 4499d0e..cff165a 100644 --- a/FS/FS/part_pkg/prepaid.pm +++ b/FS/FS/part_pkg/prepaid.pm @@ -12,6 +12,11 @@ tie %recur_action, 'Tie::IxHash', 'cancel' => 'cancel', ; +tie my %overlimit_action, 'Tie::IxHash', + 'overlimit' => 'Default overlimit processing', + 'cancel' => 'Cancel', +; + %info = ( 'name' => 'Prepaid, flat rate', #'name' => 'Prepaid (no automatic recurring)', #maybe use it here too @@ -27,8 +32,17 @@ tie %recur_action, 'Tie::IxHash', 'type' => 'select', 'select_options' => \%recur_action, }, + %FS::part_pkg::flat::usage_fields, + 'overlimit_action' => { 'name' => 'Action to take upon reaching a usage limit.', + 'type' => 'select', + 'select_options' => \%overlimit_action, + }, + #XXX if you set overlimit_action to 'cancel', should also have the ability + # to select a reason }, - 'fieldorder' => [ 'setup_fee', 'recur_fee', 'recur_action', ], + 'fieldorder' => [ qw( setup_fee recur_fee recur_action ), + @FS::part_pkg::flat::usage_fieldorder, 'overlimit_action', + ], 'weight' => 25, ); diff --git a/FS/FS/part_pkg/prorate_delayed.pm b/FS/FS/part_pkg/prorate_delayed.pm index 1d22798..0073493 100644 --- a/FS/FS/part_pkg/prorate_delayed.pm +++ b/FS/FS/part_pkg/prorate_delayed.pm @@ -56,7 +56,7 @@ sub calc_remain { return 0 if $last_bill + (86400 * $free_days) == $next_bill && $last_bill == $cust_pkg->setup; - return 0 if ! $self->base_recur + return 0 if ! $self->base_recur($cust_pkg) || ! $self->option('unused_credit', 1) || ! $last_bill || ! $next_bill; diff --git a/FS/FS/part_pkg/recur_Common.pm b/FS/FS/part_pkg/recur_Common.pm new file mode 100644 index 0000000..2739cbc --- /dev/null +++ b/FS/FS/part_pkg/recur_Common.pm @@ -0,0 +1,59 @@ +package FS::part_pkg::recur_Common; + +use strict; +use vars qw( @ISA %info %recur_method ); +use Tie::IxHash; +use Time::Local; +use FS::part_pkg::prorate; + +@ISA = qw(FS::part_pkg::prorate); + +%info = ( 'disabled' => 1 ); #recur_Common not a usable price plan directly + +tie %recur_method, 'Tie::IxHash', + 'anniversary' => 'Charge the recurring fee at the frequency specified above', + 'prorate' => 'Charge a prorated fee the first time (selectable billing date)', + 'subscription' => 'Charge the full fee for the first partial period (selectable billing date)', +; + +sub calc_recur_Common { + my $self = shift; + my($cust_pkg, $sdate, $details, $param ) = @_; #only need $sdate & $param + + my $charges = 0; + + if ( $param->{'increment_next_bill'} ) { + + my $recur_method = $self->option('recur_method', 1) || 'anniversary'; + + if ( $recur_method eq 'prorate' ) { + + $charges = $self->SUPER::calc_recur(@_); + + } else { + + $charges = $self->option('recur_fee'); + + if ( $recur_method eq 'subscription' ) { + + my $cutoff_day = $self->option('cutoff_day', 1) || 1; + my ($day, $mon, $year) = ( localtime($$sdate) )[ 3..5 ]; + + if ( $day < $cutoff_day ) { + if ( $mon == 0 ) { $mon=11; $year--; } + else { $mon--; } + } + + $$sdate = timelocal(0, 0, 0, $cutoff_day, $mon, $year); + + }#$recur_method eq 'subscription' + + }#$recur_method eq 'prorate' + + }#increment_next_bill + + $charges; + +} + +1; diff --git a/FS/FS/part_pkg/voip_cdr.pm b/FS/FS/part_pkg/voip_cdr.pm index a691fda..eccf2c1 100644 --- a/FS/FS/part_pkg/voip_cdr.pm +++ b/FS/FS/part_pkg/voip_cdr.pm @@ -6,20 +6,22 @@ use Date::Format; use Tie::IxHash; use FS::Conf; use FS::Record qw(qsearchs qsearch); -use FS::part_pkg::flat; +use FS::part_pkg::recur_Common; use FS::cdr; use FS::rate; use FS::rate_prefix; use FS::rate_detail; +use FS::part_pkg::recur_Common; -@ISA = qw(FS::part_pkg::flat); +@ISA = qw(FS::part_pkg::recur_Common); $DEBUG = 0; tie my %rating_method, 'Tie::IxHash', 'prefix' => 'Rate calls by using destination prefix to look up a region and rate according to the internal prefix and rate tables', - 'upstream' => 'Rate calls based on upstream data: If the call type is "1", map the upstream rate ID directly to an internal rate (rate_detail), otherwise, pass the upstream price through directly.', +# 'upstream' => 'Rate calls based on upstream data: If the call type is "1", map the upstream rate ID directly to an internal rate (rate_detail), otherwise, pass the upstream price through directly.', 'upstream_simple' => 'Simply pass through and charge the "upstream_price" amount.', + 'single_price' => 'A single price per minute for all calls.', ; #tie my %cdr_location, 'Tie::IxHash', @@ -33,6 +35,8 @@ tie my %temporalities, 'Tie::IxHash', 'preceding' => "Preceding (past)", ; +tie my %granularity, 'Tie::IxHash', FS::rate_detail::granularities(); + %info = ( 'name' => 'VoIP rating by plan of CDR records in an internal (or external) SQL table', 'shortname' => 'VoIP/telco CDR rating (standard)', @@ -55,7 +59,19 @@ tie my %temporalities, 'Tie::IxHash', 'type' => 'checkbox', }, - 'rating_method' => { 'name' => 'Region rating method', + 'cutoff_day' => { 'name' => 'Billing Day (1 - 28) for prorating or '. + 'subscription', + 'default' => '1', + }, + + 'recur_method' => { 'name' => 'Recurring fee method', + #'type' => 'radio', + #'options' => \%recur_method, + 'type' => 'select', + 'select_options' => \%FS::part_pkg::recur_Common::recur_method, + }, + + 'rating_method' => { 'name' => 'Rating method', 'type' => 'radio', 'options' => \%rating_method, }, @@ -67,6 +83,14 @@ tie my %temporalities, 'Tie::IxHash', 'select_label' => 'ratename', }, + 'min_charge' => { 'name' => 'Charge per minute when using "single price per minute" rating method', + }, + + 'sec_granularity' => { 'name' => 'Granularity when using "single price per minute" rating method', + 'type' => 'select', + 'select_options' => \%granularity, + }, + 'ignore_unrateable' => { 'name' => 'Ignore calls without a rate in the rate tables. By default, the system will throw a fatal error upon encountering unrateable calls.', 'type' => 'checkbox', }, @@ -119,6 +143,12 @@ tie my %temporalities, 'Tie::IxHash', 'skip_dstchannel_prefix' => { 'name' => 'Do not charge for CDRs where the dstchannel starts with:', }, + 'skip_dst_length_less' => { 'name' => 'Do not charge for CDRs where the destination is less than this many digits:', + }, + + 'skip_lastapp' => { 'name' => 'Do not charge for CDRs where the lastapp matches this value', + }, + 'use_duration' => { 'name' => 'Calculate usage based on the duration field instead of the billsec field', 'type' => 'checkbox', }, @@ -126,23 +156,33 @@ tie my %temporalities, 'Tie::IxHash', '411_rewrite' => { 'name' => 'Rewrite these (comma-separated) destination numbers to 411 for rating purposes (also ignore any carrierid check): ', }, + #false laziness w/cdr_termination.pm 'output_format' => { 'name' => 'CDR invoice display format', 'type' => 'select', 'select_options' => { FS::cdr::invoice_formats() }, 'default' => 'default', #XXX test }, - 'usage_section' => { 'name' => 'Section in which to place separate usage charges', + 'usage_section' => { 'name' => 'Section in which to place usage charges (whether separated or not)', }, 'summarize_usage' => { 'name' => 'Include usage summary with recurring charges when usage is in separate section', 'type' => 'checkbox', }, + 'usage_mandate' => { 'name' => 'Always put usage details in separate section', + 'type' => 'checkbox', + }, + #eofalse + 'bill_every_call' => { 'name' => 'Generate an invoice immediately for every call. Useful for prepaid.', 'type' => 'checkbox', }, + 'count_available_phones' => { 'name' => 'Consider for tax purposes the number of lines to be svc_phones that may be provisioned rather than those that actually are.', + 'type' => 'checkbox', + }, + #XXX also have option for an external db # 'cdr_location' => { 'name' => 'CDR database location' # 'type' => 'select', @@ -169,7 +209,9 @@ tie my %temporalities, 'Tie::IxHash', }, 'fieldorder' => [qw( setup_fee recur_fee recur_temporality unused_credit - rating_method ratenum ignore_unrateable + recur_method cutoff_day + rating_method ratenum min_charge sec_granularity + ignore_unrateable default_prefix disable_src domestic_prefix international_prefix @@ -177,10 +219,12 @@ tie my %temporalities, 'Tie::IxHash', use_amaflags use_disposition use_disposition_taqua use_carrierid use_cdrtypenum skip_dcontext skip_dstchannel_prefix + skip_dst_length_less skip_lastapp use_duration 411_rewrite - output_format summarize_usage usage_section + output_format usage_mandate summarize_usage usage_section bill_every_call + count_available_phones ) ], 'weight' => 40, @@ -191,15 +235,38 @@ sub calc_setup { $self->option('setup_fee'); } -#false laziness w/voip_sqlradacct calc_recur resolve it if that one ever gets used again sub calc_recur { - my($self, $cust_pkg, $sdate, $details, $param ) = @_; + my $self = shift; + my($cust_pkg, $sdate, $details, $param ) = @_; + + my $charges = 0; + + $charges += $self->calc_usage(@_); + $charges += $self->calc_recur_Common(@_); + + $charges; + +} + +sub calc_cancel { + my $self = shift; + my($cust_pkg, $sdate, $details, $param ) = @_; + + $self->calc_usage(@_); +} + +#false laziness w/voip_sqlradacct calc_recur resolve it if that one ever gets used again + +sub calc_usage { + my $self = shift; + my($cust_pkg, $sdate, $details, $param ) = @_; #my $last_bill = $cust_pkg->last_bill; my $last_bill = $cust_pkg->get('last_bill'); #->last_bill falls back to setup return 0 - if $self->option('recur_temporality', 1) eq 'preceding' && $last_bill == 0; + if $self->option('recur_temporality', 1) eq 'preceding' + && ( $last_bill eq '' || $last_bill == 0 ); my $ratenum = $cust_pkg->part_pkg->option('ratenum'); @@ -209,7 +276,7 @@ sub calc_recur { my $charges = 0; - my $downstream_cdr = ''; +# my $downstream_cdr = ''; my $rating_method = $self->option('rating_method') || 'prefix'; my $intl = $self->option('international_prefix') || '011'; @@ -285,9 +352,7 @@ sub calc_recur { ### my( $to_or_from, $number ); - if ( $cdr->dst =~ /^(\+?1)?8([02-8])\1/ - && ! $disable_tollfree - ) + if ( $cdr->is_tollfree && ! $disable_tollfree ) { #tollfree call $to_or_from = 'from'; $number = $cdr->src; @@ -364,48 +429,78 @@ sub calc_recur { } - } elsif ( $rating_method eq 'upstream' ) { #XXX this was convergent, not currently used. very much becoming the odd one out. remove? +# } elsif ( $rating_method eq 'upstream' ) { #XXX this was convergent, not currently used. very much becoming the odd one out. remove? +# +# if ( $cdr->cdrtypenum == 1 ) { #rate based on upstream rateid +# +# $rate_detail = $cdr->cdr_upstream_rate->rate_detail; +# +# $regionnum = $rate_detail->dest_regionnum; +# $rate_region = $rate_detail->dest_region; +# +# $pretty_destnum = $cdr->dst; +# +# warn " found rate for regionnum $regionnum and ". +# "rate detail $rate_detail\n" +# if $DEBUG; +# +# } else { #pass upstream price through +# +# $charge = sprintf('%.2f', $cdr->upstream_price); +# $charges += $charge; +# +# @call_details = ( +# #time2str("%Y %b %d - %r", $cdr->calldate_unix ), +# time2str("%c", $cdr->calldate_unix), #XXX this should probably be a config option dropdown so they can select US vs- rest of world dates or whatnot +# 'N/A', #minutes... +# '$'.$charge, +# #$pretty_destnum, +# $cdr->description, #$rate_region->regionname, +# ); +# +# } - if ( $cdr->cdrtypenum == 1 ) { #rate based on upstream rateid + } elsif ( $rating_method eq 'upstream_simple' ) { - $rate_detail = $cdr->cdr_upstream_rate->rate_detail; + #XXX $charge = sprintf('%.2f', $cdr->upstream_price); + $charge = sprintf('%.3f', $cdr->upstream_price); + $charges += $charge; - $regionnum = $rate_detail->dest_regionnum; - $rate_region = $rate_detail->dest_region; + @call_details = ($cdr->downstream_csv( 'format' => $output_format, + 'charge' => $charge, + ) + ); + $classnum = $cdr->calltypenum; - $pretty_destnum = $cdr->dst; + } elsif ( $rating_method eq 'single_price' ) { - warn " found rate for regionnum $regionnum and ". - "rate detail $rate_detail\n" - if $DEBUG; + # a little false laziness w/below - } else { #pass upstream price through + my $granularity = length($self->option('sec_granularity')) + ? $self->option('sec_granularity') + : 60; - $charge = sprintf('%.2f', $cdr->upstream_price); - $charges += $charge; - - @call_details = ( - #time2str("%Y %b %d - %r", $cdr->calldate_unix ), - time2str("%c", $cdr->calldate_unix), #XXX this should probably be a config option dropdown so they can select US vs- rest of world dates or whatnot - 'N/A', #minutes... - '$'.$charge, - #$pretty_destnum, - $cdr->description, #$rate_region->regionname, - ); + # length($cdr->billsec) ? $cdr->billsec : $cdr->duration; + my $seconds = $use_duration ? $cdr->duration : $cdr->billsec; - } + $seconds += $granularity - ( $seconds % $granularity ) + if $seconds # don't granular-ize 0 billsec calls (bills them) + && $granularity; # 0 is per call + my $minutes = $seconds / 60; # sprintf("%.1f", + #$minutes =~ s/\.0$// if $granularity == 60; - } elsif ( $rating_method eq 'upstream_simple' ) { + # XXX config? + #$charge = sprintf('%.2f', ( $self->option('min_charge') * $minutes ) + #+ 0.00000001 ); #so 1.005 rounds to 1.01 + $charge = sprintf('%.4f', ( $self->option('min_charge') * $minutes ) + + 0.0000000001 ); #so 1.00005 rounds to 1.0001 - #XXX $charge = sprintf('%.2f', $cdr->upstream_price); - $charge = sprintf('%.3f', $cdr->upstream_price); $charges += $charge; @call_details = ($cdr->downstream_csv( 'format' => $output_format, 'charge' => $charge, ) ); - $classnum = $cdr->calltypenum; } else { die "don't know how to rate CDRs using method: $rating_method\n"; @@ -449,9 +544,11 @@ sub calc_recur { $included_min{$regionnum} -= $minutes; if ( $included_min{$regionnum} < 0 ) { - my $charge_min = 0 - $included_min{$regionnum}; + my $charge_min = 0 - $included_min{$regionnum}; #XXX should preserve + #(display?) this $included_min{$regionnum} = 0; - $charge = sprintf('%.2f', $rate_detail->min_charge * $charge_min ); + $charge = sprintf('%.2f', ( $rate_detail->min_charge * $charge_min ) + + 0.00000001 ); #so 1.005 rounds to 1.01 $charges += $charge; } @@ -475,13 +572,16 @@ sub calc_recur { if ( $charge > 0 ) { #just use FS::cust_bill_pkg_detail objects? my $call_details; + my $phonenum = $cust_svc->svc_x->phonenum; #if ( $self->option('rating_method') eq 'upstream_simple' ) { if ( scalar(@call_details) == 1 ) { - $call_details = [ 'C', $call_details[0], $charge, $classnum ]; + $call_details = + [ 'C', $call_details[0], $charge, $classnum, $phonenum ]; } else { #only used for $rating_method eq 'upstream' now $csv->combine(@call_details); - $call_details = [ 'C', $csv->string, $charge, $classnum ]; + $call_details = + [ 'C', $csv->string, $charge, $classnum, $phonenum ]; } warn " adding details on charge to invoice: [ ". join(', ', @{$call_details} ). " ]" @@ -492,10 +592,13 @@ sub calc_recur { # if the customer flag is on, call "downstream_csv" or something # like it to export the call downstream! # XXX price plan option to pick format, or something... - $downstream_cdr .= $cdr->downstream_csv( 'format' => 'convergent' ) - if $spool_cdr; + #$downstream_cdr .= $cdr->downstream_csv( 'format' => 'XXX format' ) + # if $spool_cdr; - my $error = $cdr->set_status_and_rated_price('done', $charge); + my $error = $cdr->set_status_and_rated_price( 'done', + $charge, + $cust_svc->svcnum, + ); die $error if $error; } @@ -507,35 +610,32 @@ sub calc_recur { unshift @$details, [ 'C', FS::cdr::invoice_header($output_format) ] if @$details && $rating_method ne 'upstream'; - if ( $spool_cdr && length($downstream_cdr) ) { - - use FS::UID qw(datasrc); - my $dir = '/usr/local/etc/freeside/export.'. datasrc. '/cdr'; - mkdir $dir, 0700 unless -d $dir; - $dir .= '/'. $cust_pkg->custnum. - mkdir $dir, 0700 unless -d $dir; - my $filename = time2str("$dir/CDR%Y%m%d-spool.CSV", time); #XXX invoice date instead? would require changing the order things are generated in cust_main::bill insert cust_bill first - with transactions it could be done though - - push @{ $param->{'precommit_hooks'} }, - sub { - #lock the downstream spool file and append the records - use Fcntl qw(:flock); - use IO::File; - my $spool = new IO::File ">>$filename" - or die "can't open $filename: $!\n"; - flock( $spool, LOCK_EX) - or die "can't lock $filename: $!\n"; - seek($spool, 0, 2) - or die "can't seek to end of $filename: $!\n"; - print $spool $downstream_cdr; - flock( $spool, LOCK_UN ); - close $spool; - }; - - } #if ( $spool_cdr && length($downstream_cdr) ) - - $charges += $self->option('recur_fee') - if $param->{'increment_next_bill'}; +# if ( $spool_cdr && length($downstream_cdr) ) { +# +# use FS::UID qw(datasrc); +# my $dir = '/usr/local/etc/freeside/export.'. datasrc. '/cdr'; +# mkdir $dir, 0700 unless -d $dir; +# $dir .= '/'. $cust_pkg->custnum. +# mkdir $dir, 0700 unless -d $dir; +# my $filename = time2str("$dir/CDR%Y%m%d-spool.CSV", time); #XXX invoice date instead? would require changing the order things are generated in cust_main::bill insert cust_bill first - with transactions it could be done though +# +# push @{ $param->{'precommit_hooks'} }, +# sub { +# #lock the downstream spool file and append the records +# use Fcntl qw(:flock); +# use IO::File; +# my $spool = new IO::File ">>$filename" +# or die "can't open $filename: $!\n"; +# flock( $spool, LOCK_EX) +# or die "can't lock $filename: $!\n"; +# seek($spool, 0, 2) +# or die "can't seek to end of $filename: $!\n"; +# print $spool $downstream_cdr; +# flock( $spool, LOCK_UN ); +# close $spool; +# }; +# +# } #if ( $spool_cdr && length($downstream_cdr) ) $charges; } @@ -554,10 +654,12 @@ sub check_chargable { use_carrierid use_cdrtypenum skip_dcontext - skip_dstchannel_prefix; + skip_dstchannel_prefix + skip_dst_length_less + skip_lastapp ); foreach my $opt (grep !exists($flags{option_cache}->{$_}), @opt ) { - $flags{option_cache}->{$opt} = $self->option($opt); + $flags{option_cache}->{$opt} = $self->option($opt, 1); } my %opt = %{ $flags{option_cache} }; @@ -583,10 +685,17 @@ sub check_chargable { if $opt{'skip_dcontext'} =~ /\S/ && grep { $cdr->dcontext eq $_ } split(/\s*,\s*/, $opt{'skip_dcontext'}); - my $len = length($opt{'skip_dstchannel_prefix'}); + my $len_prefix = length($opt{'skip_dstchannel_prefix'}); return "dstchannel starts with $opt{'skip_dstchannel_prefix'}" - if $len - && substr($cdr->dstchannel, 0, $len) eq $opt{'skip_dstchannel_prefix'}; + if $len_prefix + && substr($cdr->dstchannel,0,$len_prefix) eq $opt{'skip_dstchannel_prefix'}; + + my $dst_length = $opt{'skip_dst_length_less'}; + return "destination less than $dst_length digits" + if $dst_length && length($cdr->dst) < $dst_length; + + return "lastapp is $opt{'skip_lastapp'}" + if length($opt{'skip_lastapp'}) && $cdr->lastapp eq $opt{'skip_lastapp'}; #all right then, rate it ''; @@ -596,16 +705,20 @@ sub is_free { 0; } -sub base_recur { - my($self, $cust_pkg) = @_; - $self->option('recur_fee'); -} - # This equates svc_phone records; perhaps svc_phone should have a field # to indicate it represents a line sub calc_units { my($self, $cust_pkg ) = @_; - scalar(grep { $_->part_svc->svcdb eq 'svc_phone' } $cust_pkg->cust_svc); + my $count = 0; + if ( $self->option('count_available_phones', 1)) { + map { $count += ( $_->quantity || 0 ) } + grep { $_->part_svc->svcdb eq 'svc_phone' } + $cust_pkg->part_pkg->pkg_svc; + } else { + $count = + scalar(grep { $_->part_svc->svcdb eq 'svc_phone' } $cust_pkg->cust_svc); + } + $count; } 1; diff --git a/FS/FS/part_pkg_link.pm b/FS/FS/part_pkg_link.pm index f517360..fb7a8d3 100644 --- a/FS/FS/part_pkg_link.pm +++ b/FS/FS/part_pkg_link.pm @@ -51,6 +51,11 @@ Destination package (see L<FS::part_pkg>) Link type - currently, "bill" (source package bills a line item from target package), or "svc" (source package includes services from target package). +=item hidden + +Flag indicating that this subpackage should be felt, but not seen as an invoice +line item when set to 'Y' + =back =head1 METHODS @@ -114,7 +119,8 @@ sub check { $self->ut_numbern('pkglinknum') || $self->ut_foreign_key('src_pkgpart', 'part_pkg', 'pkgpart') || $self->ut_foreign_key('dst_pkgpart', 'part_pkg', 'pkgpart') - || $self->ut_text('link_type', [ 'bill', 'svc' ] ) + || $self->ut_enum('link_type', [ 'bill', 'svc' ] ) + || $self->ut_enum('hidden', [ '', 'Y' ] ) ; return $error if $error; diff --git a/FS/FS/part_pkg_option.pm b/FS/FS/part_pkg_option.pm index 9708f11..3cb330b 100644 --- a/FS/FS/part_pkg_option.pm +++ b/FS/FS/part_pkg_option.pm @@ -127,11 +127,16 @@ sub check { sub _upgrade_data { # class method my ($class, %opts) = @_; - my $sql = "UPDATE part_pkg_option SETUP optionname = 'recur_fee'". + my $sql = "UPDATE part_pkg_option SET optionname = 'recur_fee'". " WHERE optionname = 'recur_flat'"; my $sth = dbh->prepare($sql) or die dbh->errstr; $sth->execute or die $sth->errstr; + $sql = "UPDATE part_pkg_option SET optionname = 'recur_method',". + "optionvalue = 'prorate' WHERE optionname = 'enable_prorate'"; + $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute or die $sth->errstr; + ''; } diff --git a/FS/FS/part_pkg_report_option.pm b/FS/FS/part_pkg_report_option.pm new file mode 100644 index 0000000..16a4c98 --- /dev/null +++ b/FS/FS/part_pkg_report_option.pm @@ -0,0 +1,125 @@ +package FS::part_pkg_report_option; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::part_pkg_report_option - Object methods for part_pkg_report_option records + +=head1 SYNOPSIS + + use FS::part_pkg_report_option; + + $record = new FS::part_pkg_report_option \%hash; + $record = new FS::part_pkg_report_option { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_pkg_report_option object represents a package definition optional +reporting classification. FS::part_pkg_report_option inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item num + +primary key + +=item name + +name - The name associated with the reporting option + +=item disabled + +disabled - set to 'Y' to prevent addition to new packages + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new report option. To add the option to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +sub table { 'part_pkg_report_option'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item delete + +Delete this record from the database. + +=cut + +sub delete { + return "Can't delete part_pkg_report_option records!"; +} + +=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 + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('num') + || $self->ut_text('name') + || $self->ut_enum('disabled', [ '', 'Y' ]) + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +Overlaps somewhat with pkg_class and pkg_category + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_pkg_taxclass.pm b/FS/FS/part_pkg_taxclass.pm index fda200e..6e3acf2 100644 --- a/FS/FS/part_pkg_taxclass.pm +++ b/FS/FS/part_pkg_taxclass.pm @@ -2,8 +2,9 @@ package FS::part_pkg_taxclass; use strict; use vars qw( @ISA ); -use FS::UID qw(dbh); -use FS::Record qw( qsearch qsearchs ); +use FS::UID qw( dbh ); +use FS::Record; # qw( qsearch qsearchs ); +use FS::cust_main_county; @ISA = qw(FS::Record); @@ -41,6 +42,10 @@ Primary key Tax class +=item disabled + +Disabled flag, empty or 'Y' + =back =head1 METHODS @@ -67,7 +72,57 @@ otherwise returns false. =cut -# the insert method can be inherited from FS::Record +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + my $sth = dbh->prepare(" + SELECT country, state, county FROM cust_main_county + WHERE taxclass IS NOT NULL AND taxclass != '' + GROUP BY country, state, county + ") or die dbh->errstr; + $sth->execute or die $sth->errstr; + + while ( my $row = $sth->fetchrow_hashref ) { + #warn "inserting for $row"; + my $cust_main_county = new FS::cust_main_county { + 'country' => $row->{country}, + 'state' => $row->{state}, + 'county' => $row->{county}, + 'tax' => 0, + 'taxclass' => $self->taxclass, + #exempt_amount + #taxname + #setuptax + #recurtax + }; + $error = $cust_main_county->insert; + #last if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} =item delete @@ -84,7 +139,18 @@ returns the error, otherwise returns false. =cut -# the replace method can be inherited from FS::Record +sub replace { + my $new = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + + return "Can't change tax class name (disable and create anew)" + if $old->taxclass ne $new->taxclass; + + $new->SUPER::replace(@_); +} =item check @@ -103,6 +169,7 @@ sub check { my $error = $self->ut_numbern('taxclassnum') || $self->ut_text('taxclass') + || $self->ut_enum('disabled', [ '', 'Y' ] ) ; return $error if $error; diff --git a/FS/FS/part_pkg_taxproduct.pm b/FS/FS/part_pkg_taxproduct.pm index c66fb8c..56e63b6 100644 --- a/FS/FS/part_pkg_taxproduct.pm +++ b/FS/FS/part_pkg_taxproduct.pm @@ -1,10 +1,11 @@ package FS::part_pkg_taxproduct; use strict; -use vars qw( @ISA ); +use vars qw( @ISA $delete_kludge ); use FS::Record qw( qsearch ); @ISA = qw(FS::Record); +$delete_kludge = 0; =head1 NAME @@ -85,8 +86,10 @@ sub delete { return "Can't delete a tax product which has attached package tax rates!" if qsearch( 'part_pkg_taxrate', { 'taxproductnum' => $self->taxproductnum } ); - return "Can't delete a tax product which has attached packages!" - if qsearch( 'part_pkg', { 'taxproductnum' => $self->taxproductnum } ); + unless ( $delete_kludge ) { + return "Can't delete a tax product which has attached packages!" + if qsearch( 'part_pkg', { 'taxproductnum' => $self->taxproductnum } ); + } $self->SUPER::delete(@_); } diff --git a/FS/FS/part_pkg_taxrate.pm b/FS/FS/part_pkg_taxrate.pm index 6d1414a..5a1e7ba 100644 --- a/FS/FS/part_pkg_taxrate.pm +++ b/FS/FS/part_pkg_taxrate.pm @@ -3,6 +3,8 @@ package FS::part_pkg_taxrate; use strict; use vars qw( @ISA ); use Date::Parse; +use DateTime; +use DateTime::Format::Strptime; use FS::UID qw(dbh); use FS::Record qw( qsearch qsearchs ); use FS::part_pkg_taxproduct; @@ -181,7 +183,7 @@ sub batch_import { if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) { $format =~ s/-fixed//; my $date_format = sub { my $r=''; - /^(\d{4})(\d{2})(\d{2})$/ && ($r="$1/$2/$3"); + /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1"); $r; }; $column_callbacks[16] = $date_format; @@ -248,8 +250,8 @@ sub batch_import { $part_pkg_taxproduct{'description'} = join(' : ', (map{ $hash->{$_} } qw(groupdesc itemdesc)), - $providers{$hash->{'provider'}}, - $customers{$hash->{'customer'}}, + $providers{$hash->{'provider'}} || '', + $customers{$hash->{'customer'}} || '', ); $part_pkg_taxproduct = new FS::part_pkg_taxproduct \%part_pkg_taxproduct; my $error = $part_pkg_taxproduct->insert; @@ -286,7 +288,12 @@ sub batch_import { delete($hash->{$_}) foreach @{$map{$item}}; } - $hash->{'effdate'} = str2time($hash->{'effdate'}); + my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y", + time_zone => 'floating', + ); + my $dt = $parser->parse_datetime( $hash->{'effdate'} ); + $hash->{'effdate'} = $dt ? $dt->epoch : ''; + $hash->{'country'} = 'US'; # CA is available delete($hash->{'taxable'}) if ($hash->{'taxable'} eq 'N'); @@ -295,10 +302,18 @@ sub batch_import { delete($hash->{actionflag}); my $part_pkg_taxrate = qsearchs('part_pkg_taxrate', $hash); - return "Can't find part_pkg_taxrate to delete: ". - #join(" ", map { "$_ => ". $hash->{$_} } @fields) - join(" ", map { "$_ => *". $hash->{$_}. '*' } keys(%$hash) ) - unless $part_pkg_taxrate; + unless ( $part_pkg_taxrate ) { + if ( $hash->{taxproductnum} ) { + my $taxproduct = + qsearchs( 'part_pkg_taxproduct', + { 'taxproductnum' => $hash->{taxproductnum} } + ); + $hash->{taxproductnum} .= ' ( '. $taxproduct->taxproduct. ' )' + if $taxproduct; + } + return "Can't find part_pkg_taxrate to delete: ". + join(" ", map { "$_ => *". $hash->{$_}. '*' } keys(%$hash) ); + } my $error = $part_pkg_taxrate->delete; return $error if $error; @@ -345,7 +360,7 @@ sub batch_import { if ( $job ) { # progress bar if ( time - $min_sec > $last ) { my $error = $job->update_statustext( - int( 100 * $imported / $count ) + int( 100 * $imported / $count ). ",Importing tax matrix" ); die $error if $error; $last = time; diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 580038b..e57efe4 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -133,7 +133,8 @@ sub insert { # fields('part_svc'); foreach my $field ( grep { $_ ne 'svcnum' - && defined( $self->getfield($svcdb.'__'.$_.'_flag') ) + && ( defined( $self->getfield($svcdb.'__'.$_.'_flag') ) + || $self->getfield($svcdb.'__'.$_.'_label') !~ /^\s*$/ ) } (fields($svcdb), @fields) ) { my $part_svc_column = $self->part_svc_column($field); @@ -142,20 +143,28 @@ sub insert { 'columnname' => $field, } ); - my $flag = $self->getfield($svcdb.'__'.$field.'_flag'); - #if ( uc($flag) =~ /^([DFMAX])$/ ) { - if ( uc($flag) =~ /^([A-Z])$/ ) { #part_svc_column will test it - my $parser = FS::part_svc->svc_table_fields($svcdb)->{$field}->{parse} - || sub { shift }; - $part_svc_column->setfield('columnflag', $1); - $part_svc_column->setfield('columnvalue', - &$parser($self->getfield($svcdb.'__'.$field)) - ); + my $flag = $self->getfield($svcdb.'__'.$field.'_flag'); + my $label = $self->getfield($svcdb.'__'.$field.'_label'); + if ( uc($flag) =~ /^([A-Z])$/ || $label !~ /^\s*$/ ) { + + if ( uc($flag) =~ /^([A-Z])$/ ) { + my $parser = FS::part_svc->svc_table_fields($svcdb)->{$field}->{parse} + || sub { shift }; + $part_svc_column->setfield('columnflag', $1); + $part_svc_column->setfield('columnvalue', + &$parser($self->getfield($svcdb.'__'.$field)) + ); + } + + $part_svc_column->setfield('columnlabel', $label) + if $label !~ /^\s*$/; + if ( $previous ) { $error = $part_svc_column->replace($previous); } else { $error = $part_svc_column->insert; } + } else { $error = $previous ? $previous->delete : ''; } @@ -254,7 +263,8 @@ sub replace { my $svcdb = $new->svcdb; foreach my $field ( grep { $_ ne 'svcnum' - && defined( $new->getfield($svcdb.'__'.$_.'_flag') ) + && ( defined( $new->getfield($svcdb.'__'.$_.'_flag') ) + || $new->getfield($svcdb.'__'.$_.'_label') !~ /^\s*$/ ) } (fields($svcdb),@fields) ) { my $part_svc_column = $new->part_svc_column($field); @@ -263,15 +273,23 @@ sub replace { 'columnname' => $field, } ); - my $flag = $new->getfield($svcdb.'__'.$field.'_flag'); - #if ( uc($flag) =~ /^([DFMAX])$/ ) { - if ( uc($flag) =~ /^([A-Z])$/ ) { #part_svc_column will test it - my $parser = FS::part_svc->svc_table_fields($svcdb)->{$field}->{parse} + my $flag = $new->getfield($svcdb.'__'.$field.'_flag'); + my $label = $new->getfield($svcdb.'__'.$field.'_label'); + + if ( uc($flag) =~ /^([A-Z])$/ || $label !~ /^\s*$/ ) { + + if ( uc($flag) =~ /^([A-Z])$/ ) { + my $parser = FS::part_svc->svc_table_fields($svcdb)->{$field}->{parse} || sub { shift }; - $part_svc_column->setfield('columnflag', $1); - $part_svc_column->setfield('columnvalue', - &$parser($new->getfield($svcdb.'__'.$field)) - ); + $part_svc_column->setfield('columnflag', $1); + $part_svc_column->setfield('columnvalue', + &$parser($new->getfield($svcdb.'__'.$field)) + ); + } + + $part_svc_column->setfield('columnlabel', $label) + if $label !~ /^\s*$/; + if ( $previous ) { $error = $part_svc_column->replace($previous); } else { @@ -713,17 +731,16 @@ sub process { push @fields, 'usergroup' if $svcdb eq 'svc_acct'; #kludge map { - if ( $param->{ $svcdb.'__'.$_.'_flag' } =~ /^[MA]$/ ) { - $param->{ $svcdb.'__'.$_ } = - delete( $param->{ $svcdb.'__'.$_.'_classnum' } ); + my $f = $svcdb.'__'.$_; + if ( $param->{ $f.'_flag' } =~ /^[MA]$/ ) { + $param->{ $f } = delete( $param->{ $f.'_classnum' } ); } - if ( $param->{ $svcdb.'__'.$_.'_flag' } =~ /^S$/ ) { - $param->{ $svcdb.'__'.$_} = - ref($param->{ $svcdb.'__'.$_}) - ? join(',', @{$param->{ $svcdb.'__'.$_ }} ) - : $param->{ $svcdb.'__'.$_ }; + if ( $param->{ $f.'_flag' } =~ /^S$/ ) { + $param->{ $f } = ref($param->{ $f }) + ? join(',', @{$param->{ $f }} ) + : $param->{ $f }; } - ( $svcdb.'__'.$_, $svcdb.'__'.$_.'_flag' ); + ( $f, $f.'_flag', $f.'_label' ); } @fields; @@ -738,7 +755,7 @@ sub process { my $error; if ( $param->{'svcpart'} ) { $error = $new->replace( $old, - '1.3-COMPAT', + '1.3-COMPAT', #totally bunk, as jeff noted [ 'usergroup' ], \%exportnums, $job diff --git a/FS/FS/part_svc_column.pm b/FS/FS/part_svc_column.pm index d2b8fd9..f5b39c0 100644 --- a/FS/FS/part_svc_column.pm +++ b/FS/FS/part_svc_column.pm @@ -39,6 +39,8 @@ fields are currently supported: =item columnname - column name in part_svc.svcdb table +=item columnlabel - label for the column + =item columnvalue - default or fixed value for the column =item columnflag - null or empty (no default), `D' for default, `F' for fixed (unchangeable), `S' for selectable choice, `M' for manual selection from inventory, or `A' for automatic selection from inventory. For virtual fields, can also be 'X' for excluded. @@ -87,11 +89,12 @@ sub check { $self->ut_numbern('columnnum') || $self->ut_number('svcpart') || $self->ut_alpha('columnname') + || $self->ut_textn('columnlabel') || $self->ut_anything('columnvalue') ; return $error if $error; - $self->columnflag =~ /^([DFSMAX])$/ + $self->columnflag =~ /^([DFSMAX]?)$/ or return "illegal columnflag ". $self->columnflag; $self->columnflag(uc($1)); diff --git a/FS/FS/pay_batch.pm b/FS/FS/pay_batch.pm index 5448b03..83bf7a3 100644 --- a/FS/FS/pay_batch.pm +++ b/FS/FS/pay_batch.pm @@ -1,11 +1,12 @@ package FS::pay_batch; use strict; -use vars qw( @ISA ); +use vars qw( @ISA $DEBUG %import_info %export_info $conf ); use Time::Local; use Text::CSV_XS; use FS::Record qw( dbh qsearch qsearchs ); use FS::cust_pay; +use FS::Conf; @ISA = qw(FS::Record); @@ -137,6 +138,42 @@ sub set_status { $self->replace(); } +# further false laziness + +%import_info = %export_info = (); +foreach my $INC (@INC) { + warn "globbing $INC/FS/pay_batch/*.pm\n" if $DEBUG; + foreach my $file ( glob("$INC/FS/pay_batch/*.pm")) { + warn "attempting to load batch format from $file\n" if $DEBUG; + $file =~ /\/(\w+)\.pm$/; + next if !$1; + my $mod = $1; + my ($import, $export, $name) = + eval "use FS::pay_batch::$mod; + ( \\%FS::pay_batch::$mod\::import_info, + \\%FS::pay_batch::$mod\::export_info, + \$FS::pay_batch::$mod\::name)"; + $name ||= $mod; # in case it's not defined + if( $@) { + # in FS::cdr this is a die, not a warn. That's probably a bug. + warn "error using FS::pay_batch::$mod (skipping): $@\n"; + next; + } + if(!keys(%$import)) { + warn "no \%import_info found in FS::pay_batch::$mod (skipping)\n"; + } + else { + $import_info{$name} = $import; + } + if(!keys(%$export)) { + warn "no \%export_info found in FS::pay_batch::$mod (skipping)\n"; + } + else { + $export_info{$name} = $export; + } + } +} + =item import_results OPTION => VALUE, ... Import batch results. @@ -155,222 +192,19 @@ sub import_results { my $param = ref($_[0]) ? shift : { @_ }; my $fh = $param->{'filehandle'}; my $format = $param->{'format'}; - - my $filetype; # CSV, Fixed80, Fixed264 - my @fields; - my $formatre; # for Fixed.+ - my @values; - my $begin_condition; - my $end_condition; - my $end_hook; - my $hook; - my $approved_condition; - my $declined_condition; - - if ( $format eq 'csv-td_canada_trust-merchant_pc_batch' ) { - - $filetype = "CSV"; - - @fields = ( - 'paybatchnum', # Reference#: Invoice number of the transaction - 'paid', # Amount: Amount of the transaction. Dollars and cents - # with no decimal entered. - '', # Card Type: 0 - MCrd, 1 - Visa, 2 - AMEX, 3 - Discover, - # 4 - Insignia, 5 - Diners/EnRoute, 6 - JCB - '_date', # Transaction Date: Date the Transaction was processed - 'time', # Transaction Time: Time the transaction was processed - 'payinfo', # Card Number: Card number for the transaction - '', # Expiry Date: Expiry date of the card - '', # Auth#: Authorization number entered for force post - # transaction - 'type', # Transaction Type: 0 - purchase, 40 - refund, - # 20 - force post - 'result', # Processing Result: 3 - Approval, - # 4 - Declined/Amount over limit, - # 5 - Invalid/Expired/stolen card, - # 6 - Comm Error - '', # Terminal ID: Terminal ID used to process the transaction - ); - - $end_condition = sub { - my $hash = shift; - $hash->{'type'} eq '0BC'; - }; - - $end_hook = sub { - my( $hash, $total) = @_; - $total = sprintf("%.2f", $total); - my $batch_total = sprintf("%.2f", $hash->{'paybatchnum'} / 100 ); - return "Our total $total does not match bank total $batch_total!" - if $total != $batch_total; - ''; - }; - - $hook = sub { - my $hash = shift; - $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100 ); - $hash->{'_date'} = timelocal( substr($hash->{'time'}, 4, 2), - substr($hash->{'time'}, 2, 2), - substr($hash->{'time'}, 0, 2), - substr($hash->{'_date'}, 6, 2), - substr($hash->{'_date'}, 4, 2)-1, - substr($hash->{'_date'}, 0, 4)-1900, ); - }; - - $approved_condition = sub { - my $hash = shift; - $hash->{'type'} eq '0' && $hash->{'result'} == 3; - }; - - $declined_condition = sub { - my $hash = shift; - $hash->{'type'} eq '0' && ( $hash->{'result'} == 4 - || $hash->{'result'} == 5 ); - }; - - - }elsif ( $format eq 'csv-chase_canada-E-xactBatch' ) { - - $filetype = "CSV"; - - @fields = ( - '', # Internal(bank) id of the transaction - '', # Transaction Type: 00 - purchase, 01 - preauth, - # 02 - completion, 03 - forcepost, - # 04 - refund, 05 - auth, - # 06 - purchase corr, 07 - refund corr, - # 08 - void 09 - void return - '', # gateway used to process this transaction - 'paid', # Amount: Amount of the transaction. Dollars and cents - # with decimal entered. - 'auth', # Auth#: Authorization number (if approved) - 'payinfo', # Card Number: Card number for the transaction - '', # Expiry Date: Expiry date of the card - '', # Cardholder Name - 'bankcode', # Bank response code (3 alphanumeric) - 'bankmess', # Bank response message - 'etgcode', # ETG response code (2 alphanumeric) - 'etgmess', # ETG response message - '', # Returned customer number for the transaction - 'paybatchnum', # Reference#: paybatch number of the transaction - '', # Reference#: Invoice number of the transaction - 'result', # Processing Result: Approved of Declined - ); - - $end_condition = sub { - ''; - }; - - $hook = sub { - my $hash = shift; - my $cpb = shift; - $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'}); #hmmmm - $hash->{'_date'} = time; # got a better one? - $hash->{'payinfo'} = $cpb->{'payinfo'} - if( substr($hash->{'payinfo'}, -4) eq substr($cpb->{'payinfo'}, -4) ); - }; - - $approved_condition = sub { - my $hash = shift; - $hash->{'etgcode'} eq '00' && $hash->{'result'} eq "Approved"; - }; - - $declined_condition = sub { - my $hash = shift; - $hash->{'etgcode'} ne '00' # internal processing error - || ( $hash->{'result'} eq "Declined" ); - }; - - - }elsif ( $format eq 'PAP' ) { - - $filetype = "Fixed264"; - - @fields = ( - 'recordtype', # We are interested in the 'D' or debit records - 'batchnum', # Record#: batch number we used when sending the file - 'datacenter', # Where in the bowels of the bank the data was processed - 'paid', # Amount: Amount of the transaction. Dollars and cents - # with no decimal entered. - '_date', # Transaction Date: Date the Transaction was processed - 'bank', # Routing information - 'payinfo', # Account number for the transaction - 'paybatchnum', # Reference#: Invoice number of the transaction - ); - - $formatre = '^(.).{19}(.{4})(.{3})(.{10})(.{6})(.{9})(.{12}).{110}(.{19}).{71}$'; - - $end_condition = sub { - my $hash = shift; - $hash->{'recordtype'} eq 'W'; - }; - - $end_hook = sub { - my( $hash, $total) = @_; - $total = sprintf("%.2f", $total); - my $batch_total = $hash->{'datacenter'}.$hash->{'paid'}. - substr($hash->{'_date'},0,1); # YUCK! - $batch_total = sprintf("%.2f", $batch_total / 100 ); - return "Our total $total does not match bank total $batch_total!" - if $total != $batch_total; - ''; - }; - - $hook = sub { - my $hash = shift; - $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100 ); - my $tmpdate = timelocal( 0,0,1,1,0,substr($hash->{'_date'}, 0, 3)+2000); - $tmpdate += 86400*(substr($hash->{'_date'}, 3, 3)-1) ; - $hash->{'_date'} = $tmpdate; - $hash->{'payinfo'} = $hash->{'payinfo'} . '@' . $hash->{'bank'}; - }; - - $approved_condition = sub { - 1; - }; - - $declined_condition = sub { - 0; - }; - - }elsif ( $format eq 'ach-spiritone' ) { - - $filetype = "CSV"; - - @fields = ( - '', # Name - 'paybatchnum', # ID: Number of the transaction - 'aba', # ABA Number for the transaction - 'payinfo', # Bank Account Number for the transaction - '', # Transaction Type: 27 - debit - 'paid', # Amount: Amount of the transaction. Dollars and cents - # with decimal entered. - '', # Default Transaction Type - '', # Default Amount: Dollars and cents with decimal entered. - ); - - $end_condition = sub { - ''; - }; - - $hook = sub { - my $hash = shift; - $hash->{'_date'} = time; # got a better one? - $hash->{'payinfo'} = $hash->{'payinfo'} . '@' . $hash->{'aba'}; - }; - - $approved_condition = sub { - 1; - }; - - $declined_condition = sub { - 0; - }; - - - } else { - return "Unknown format $format"; - } + my $info = $import_info{$format} + or die "unknown format $format"; + + my $filetype = $info->{'filetype'}; # CSV or fixed + my @fields = @{ $info->{'fields'} }; + my $formatre = $info->{'formatre'}; # for fixed + my @all_values; + my $begin_condition = $info->{'begin_condition'}; + my $end_condition = $info->{'end_condition'}; + my $end_hook = $info->{'end_hook'}; + my $hook = $info->{'hook'}; + my $approved_condition = $info->{'approved'}; + my $declined_condition = $info->{'declined'}; my $csv = new Text::CSV_XS; @@ -390,36 +224,68 @@ sub import_results { unless ( $reself->status eq 'I' ) { $dbh->rollback if $oldAutoCommit; return "batchnum ". $self->batchnum. "no longer in transit"; - }; + } my $error = $self->set_status('R'); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error + return $error; } my $total = 0; my $line; - while ( defined($line=<$fh>) ) { - - next if $line =~ /^\s*$/; #skip blank lines - if ($filetype eq "CSV") { - $csv->parse($line) or do { - $dbh->rollback if $oldAutoCommit; - return "can't parse: ". $csv->error_input(); - }; - @values = $csv->fields(); - }elsif ($filetype eq "Fixed80" || $filetype eq "Fixed264"){ - @values = $line =~ /$formatre/; - unless (@values) { - $dbh->rollback if $oldAutoCommit; - return "can't parse: ". $line; - }; - }else{ + # Order of operations has been changed here. + # We now slurp everything into @all_values, then + # process one line at a time. + + if ($filetype eq 'XML') { + eval "use XML::Simple"; + die $@ if $@; + my @xmlkeys = @{ $info->{'xmlkeys'} }; # for XML + my $xmlrow = $info->{'xmlrow'}; # also for XML + + # Do everything differently. + my $data = XML::Simple::XMLin($fh, KeepRoot => 1); + my $rows = $data; + # $xmlrow = [ RootKey, FirstLevelKey, SecondLevelKey... ] + $rows = $rows->{$_} foreach( @$xmlrow ); + if(!defined($rows)) { $dbh->rollback if $oldAutoCommit; - return "Unknown file type $filetype"; + return "can't find rows in XML file"; + } + $rows = [ $rows ] if ref($rows) ne 'ARRAY'; + foreach my $row (@$rows) { + push @all_values, [ @{$row}{@xmlkeys} ]; } + } + else { + while ( defined($line=<$fh>) ) { + + next if $line =~ /^\s*$/; #skip blank lines + + if ($filetype eq "CSV") { + $csv->parse($line) or do { + $dbh->rollback if $oldAutoCommit; + return "can't parse: ". $csv->error_input(); + }; + push @all_values, [ $csv->fields() ]; + }elsif ($filetype eq 'fixed'){ + my @values = $line =~ /$formatre/; + unless (@values) { + $dbh->rollback if $oldAutoCommit; + return "can't parse: ". $line; + }; + push @all_values, \@values; + }else{ + $dbh->rollback if $oldAutoCommit; + return "Unknown file type $filetype"; + } + } + } + + foreach (@all_values) { + my @values = @$_; my %hash; foreach my $field ( @fields ) { @@ -428,8 +294,9 @@ sub import_results { $hash{$field} = $value; } - if ( &{$end_condition}(\%hash) ) { - my $error = &{$end_hook}(\%hash, $total); + if ( defined($end_condition) and &{$end_condition}(\%hash) ) { + my $error; + $error = &{$end_hook}(\%hash, $total) if defined($end_hook); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -514,7 +381,6 @@ sub import_results { } - } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -522,6 +388,94 @@ sub import_results { } +sub export_batch { +# Formerly httemplate/misc/download-batch.cgi + my $self = shift; + my $conf = new FS::Conf; + my $format = shift || $conf->config('batch-default_format') + or die "No batch format configured\n"; + my $info = $export_info{$format} or die "Format not found: '$format'\n"; + &{$info->{'init'}}($conf) if exists($info->{'init'}); + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error; + + my $first_download; + if($self->status eq 'O') { + $first_download = 1; + } + elsif($self->status eq 'I' and + $FS::CurrentUser::CurrentUser->access_right('Reprocess batches')) { + $first_download = 0; + } + else { + die "No pending batch.\n" + } + + $error = $self->set_status('I'); + die "error updating pay_batch status: $error\n" if $error; + + my $batch = ''; + my $batchtotal = 0; + my $batchcount = 0; + + my @cust_pay_batch = sort { $a->paybatchnum <=> $b->paybatchnum } + qsearch('cust_pay_batch', { batchnum => $self->batchnum } ); + + my $h = $info->{'header'}; + if(ref($h) eq 'CODE') { + $batch .= &$h($self, \@cust_pay_batch) . "\n"; + } + else { + $batch .= $h . "\n"; + } + foreach my $cust_pay_batch (@cust_pay_batch) { + if($first_download) { + my $balance = $cust_pay_batch->cust_main->balance; + $error = ''; + if($balance <= 0) { # then don't charge this customer + $error = $cust_pay_batch->delete; + undef $cust_pay_batch; + } + elsif($balance < $cust_pay_batch->amount) { # then reduce the charge to the remaining balance + $cust_pay_batch->amount($balance); + $error = $cust_pay_batch->replace; + } + # else $balance >= $cust_pay_batch->amount + if($error) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die $error; + } + } + if($cust_pay_batch) { # that is, it wasn't deleted + $batchcount++; + $batchtotal += $cust_pay_batch->amount; + $batch .= &{$info->{'row'}}($cust_pay_batch, $self) . "\n"; + } + } + my $f = $info->{'footer'}; + if(ref($f) eq 'CODE') { + $batch .= &$f($self, $batchcount, $batchtotal) . "\n"; + } + else { + $batch .= $f . "\n"; + } + + if ($info->{'autopost'}) { + $error = &{$info->{'autopost'}}($self, $batch); + if($error) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return $batch; +} + =back =head1 BUGS diff --git a/FS/FS/pay_batch/BoM.pm b/FS/FS/pay_batch/BoM.pm new file mode 100644 index 0000000..7bfc22a --- /dev/null +++ b/FS/FS/pay_batch/BoM.pm @@ -0,0 +1,73 @@ +package FS::pay_batch::BoM; + +use strict; +use vars qw(@ISA %import_info %export_info $name); +use Time::Local 'timelocal'; +use FS::Conf; + +my $conf; +my ($origid, $datacenter, $typecode, $shortname, $longname, $mybank, $myacct); + +$name = 'BoM'; + +%import_info = ( + 'filetype' => 'CSV', + 'fields' => [], + 'hook' => sub { die "Can't import BoM" }, + 'approved' => sub { 1 }, + 'declined' => sub { 0 }, +); + +%export_info = ( + init => sub { + $conf = shift; + ($origid, + $datacenter, + $typecode, + $shortname, + $longname, + $mybank, + $myacct) = $conf->config("batchconfig-BoM"); + }, + header => sub { + my $pay_batch = shift; + sprintf( "A%10s%04u%06u%05u%54s\n", + $origid, + $pay_batch->batchnum, + jdate($pay_batch->download), + $datacenter, + "") . + sprintf( "XD%03u%06u%-15s%-30s%09u%-12s \n", + $typecode, + jdate($pay_batch->download), + $shortname, + $longname, + $mybank, + $myacct); + }, + row => sub { + my ($cust_pay_batch, $pay_batch) = @_; + my ($account, $aba) = split('@', $cust_pay_batch->payinfo); + sprintf( "D%010.0f%09u%-12s%-29s%-19s\n", + $cust_pay_batch->amount * 100, + $aba, + $account, + $cust_pay_batch->payname, + $cust_pay_batch->paybatchnum + ); + }, + footer => sub { + my ($pay_batch, $batchcount, $batchtotal) = @_; + sprintf( "YD%08u%014.0f%56s\n", $batchcount, $batchtotal*100, ""). + sprintf( "Z%014u%04u%014u%05u%41s\n", + $batchtotal*100, $batchcount, "0", "0", ""); + }, +); + +sub jdate { + my (@date) = localtime(shift); + sprintf("%03d%03d", $date[5] % 100, $date[7] + 1); +} + +1; + diff --git a/FS/FS/pay_batch/PAP.pm b/FS/FS/pay_batch/PAP.pm new file mode 100644 index 0000000..432ef07 --- /dev/null +++ b/FS/FS/pay_batch/PAP.pm @@ -0,0 +1,103 @@ +package FS::pay_batch::PAP; + +use strict; +use vars qw(@ISA %import_info %export_info $name); +use Time::Local 'timelocal'; +use FS::Conf; + +my $conf; +my ($origid, $datacenter, $typecode, $shortname, $longname, $mybank, $myacct); + +$name = 'PAP'; + +%import_info = ( + 'filetype' => 'fixed', + 'formatre' => '^(.).{19}(.{4})(.{3})(.{10})(.{6})(.{9})(.{12}).{110}(.{19}).{71}$', + 'fields' => [ + 'recordtype', + 'batchnum', + 'datacenter', + 'paid', + '_date', + 'bank', + 'payinfo', + 'paybatchnum', + ], + 'hook' => sub { + my $hash = shift; + $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100 ); + my $tmpdate = timelocal( 0,0,1,1,0,substr($hash->{'_date'}, 0, 3)+2000); + $tmpdate += 86400*(substr($hash->{'_date'}, 3, 3)-1) ; + $hash->{'_date'} = $tmpdate; + $hash->{'payinfo'} = $hash->{'payinfo'} . '@' . $hash->{'bank'}; + }, + 'approved' => sub { 1 }, + 'declined' => sub { 0 }, +# Why does pay_batch.pm have approved_condition and declined_condition? +# It doesn't even try to handle the case of neither condition being met. + 'end_hook' => sub { + my( $hash, $total) = @_; + $total = sprintf("%.2f", $total); + my $batch_total = $hash->{'datacenter'}.$hash->{'paid'}. + substr($hash->{'_date'},0,1); # YUCK! + $batch_total = sprintf("%.2f", $batch_total / 100 ); + return "Our total $total does not match bank total $batch_total!" + if $total != $batch_total; + ''; + }, + 'end_condition' => sub { + my $hash = shift; + $hash->{recordtype} eq 'W'; + }, +); + +%export_info = ( + init => sub { + $conf = shift; + ($origid, + $datacenter, + $typecode, + $shortname, + $longname, + $mybank, + $myacct) = $conf->config("batchconfig-PAP"); + }, + header => sub { + my $pay_batch = shift; + sprintf( "H%10sD%3s%06u%-15s%09u%-12s%04u%19s\n", + $origid, + $typecode, + cdate($pay_batch->download), + $shortname, + $mybank, + $myacct, + $pay_batch->batchnum, + "" ) + }, + row => sub { + my ($cust_pay_batch, $pay_batch) = @_; + my ($account, $aba) = split('@', $cust_pay_batch->payinfo); + sprintf( "D%-23s%06u%-19s%09u%-12s%010.0f\n", + $cust_pay_batch->payname, + cdate($pay_batch->download), + $cust_pay_batch->paybatchnum, + $aba, + $account, + $cust_pay_batch->amount*100 ); + }, + footer => sub { + my ($pay_batch, $batchcount, $batchtotal) = @_; + sprintf( "T%08u%014.0f%57s\n", + $batchcount, + $batchtotal*100, + "" ); + }, +); + +sub cdate { + my (@date) = localtime(shift); + sprintf("%02d%02d%02d", $date[3], $date[4] + 1, $date[5] % 100); +} + +1; + diff --git a/FS/FS/pay_batch/ach_spiritone.pm b/FS/FS/pay_batch/ach_spiritone.pm new file mode 100644 index 0000000..bd3bb14 --- /dev/null +++ b/FS/FS/pay_batch/ach_spiritone.pm @@ -0,0 +1,65 @@ +package FS::pay_batch::ach_spiritone; + +use strict; +use vars qw(@ISA %import_info %export_info $name); +use Time::Local 'timelocal'; +use FS::Conf; +use File::Temp; + +my $conf; +my ($origid, $datacenter, $typecode, $shortname, $longname, $mybank, $myacct); + +$name = 'ach-spiritone'; # note spelling + +%import_info = ( + 'filetype' => 'CSV', + 'fields' => [ + '', #name + 'paybatchnum', + 'aba', + 'payinfo', + '', #transaction type + 'paid', + '', #default transaction type + '', #default amount + ], + 'hook' => sub { + my $hash = shift; + $hash->{'_date'} = time; + $hash->{'payinfo'} = $hash->{'payinfo'} . '@' . $hash->{'aba'}; + }, + 'approved' => sub { 1 }, + 'declined' => sub { 0 }, +); + +%export_info = ( +# This is the simplest case. + row => sub { + my ($cust_pay_batch, $pay_batch) = @_; + my ($account, $aba) = split('@', $cust_pay_batch->payinfo); + my $payname = $cust_pay_batch->first . ' ' . $cust_pay_batch->last; + $payname =~ tr/",/ /; + qq!"$payname","!.$cust_pay_batch->paybatchnum. + qq!","$aba","$account","27","!.$cust_pay_batch->amount. + qq!","27","0.00"!; #" + }, + autopost => sub { + my ($pay_batch, $batch) = @_; + my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; + my $fh = new File::Temp( + TEMPLATE => 'paybatch.'. $pay_batch->batchnum .'.XXXXXXXX', + DIR => $dir, + ) or return "can't open temp file: $!\n"; + + print $fh $batch; + seek $fh, 0, 0; + + my $error = $pay_batch->import_results( 'filehandle' => $fh, + 'format' => $name, + ); + return $error if $error; + }, +); + +1; + diff --git a/FS/FS/pay_batch/chase_canada.pm b/FS/FS/pay_batch/chase_canada.pm new file mode 100644 index 0000000..909e4ae --- /dev/null +++ b/FS/FS/pay_batch/chase_canada.pm @@ -0,0 +1,104 @@ +package FS::pay_batch::chase_canada; + +use strict; +use vars qw(@ISA %import_info %export_info $name); +use Time::Local 'timelocal'; +use FS::Conf; + +my $conf; +my $origid; + +$name = 'csv-chase_canada-E-xactBatch'; + +%import_info = ( + 'filetype' => 'CSV', + 'fields' => [ + '', + '', + '', + 'paid', + 'auth', + 'payinfo', + '', + '', + 'bankcode', + 'bankmess', + 'etgcode', + 'etgmess', + '', + 'paybatchnum', + '', + 'result', + ], + 'hook' => sub { + my $hash = shift; + my $cpb = shift; + $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} ); + $hash->{'_date'} = time; + $hash->{'payinfo'} = $cpb->{'payinfo'} + if( substr($hash->{'payinfo'}, -4) eq substr($cpb->{'payinfo'}, -4) ); + }, + 'approved' => sub { + my $hash = shift; + $hash->{'etgcode'} eq '00' && $hash->{'result'} eq 'Approved'; + }, + 'declined' => sub { + my $hash = shift; + $hash->{'etgcode'} ne '00' || $hash->{'result'} eq 'Declined'; + }, +); + +%export_info = ( + init => sub { + $conf = shift; + ($origid) = $conf->config("batchconfig-$name"); + }, + header => sub { + my $pay_batch = shift; + sprintf( '$$E-xactBatchFileV1.0$$%s:%03u$$%s', + sdate($pay_batch->download), + $pay_batch->batchnum, + $origid ); + }, + row => sub { + my ($cust_pay_batch, $pay_batch) = @_; + my $payname = $cust_pay_batch->payname; + $payname =~ tr/",/ /; + + join(',', + $cust_pay_batch->paybatchnum, + $cust_pay_batch->custnum, + $cust_pay_batch->invnum, + qq!"$payname"!, + '00', + $cust_pay_batch->payinfo, + $cust_pay_batch->amount, + expdate($cust_pay_batch->exp), + '', + '' + ); + }, + # no footer +); + +sub sdate { + my (@date) = localtime(shift); + sprintf('%02d/%02d/%02d', $date[5] % 100, $date[4] + 1, $date[3]); +} + +sub expdate { + my $exp = shift; + $exp =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + my ($mon, $y) = ($2, $1); + if($conf->exists('batch-increment_expiration')) { + my ($curmon, $curyear) = (localtime(time))[4,5]; + $curmon++; + $curyear -= 100; + $y++ while $y < $curyear || ($y == $curyear && $mon < $curmon); + } + $mon = "0$mon" if $mon =~ /^\d$/; + $y = "0$y" if $y =~ /^\d$/; + return "$mon$y"; +} + +1; diff --git a/FS/FS/pay_batch/paymentech.pm b/FS/FS/pay_batch/paymentech.pm new file mode 100644 index 0000000..44fa78a --- /dev/null +++ b/FS/FS/pay_batch/paymentech.pm @@ -0,0 +1,114 @@ +package FS::pay_batch::paymentech; + +use strict; +use vars qw(@ISA %import_info %export_info $name); +use Time::Local; +use Date::Format 'time2str'; +use Date::Parse 'str2time'; +use FS::Conf; + +my $conf; +my ($bin, $merchantID, $terminalID, $username); +$name = 'paymentech'; + +%import_info = ( + filetype => 'XML', + xmlrow => [ qw(transResponse newOrderResp) ], + fields => [ + 'paybatchnum', + '_date', + 'approvalStatus', + ], + xmlkeys => [ + 'orderID', + 'respDateTime', + 'approvalStatus', + ], + 'hook' => sub { + my ($hash, $oldhash) = @_; + my ($mon, $day, $year, $hour, $min, $sec) = + $hash->{'_date'} =~ /^(..)(..)(....)(..)(..)(..)$/; + $hash->{'_date'} = timelocal($sec, $min, $hour, $day, $mon-1, $year); + $hash->{'paid'} = $oldhash->{'amount'}; + }, + 'approved' => sub { my $hash = shift; + $hash->{'approvalStatus'} + }, + 'declined' => sub { my $hash = shift; + ! $hash->{'approvalStatus'} + }, +); + +my %paytype = ( + 'personal checking' => 'C', + 'personal savings' => 'S', + 'business checking' => 'X', + 'business savings' => 'X', + ); + +%export_info = ( + init => sub { +# Load this at run time + eval "use XML::Simple"; + die $@ if $@; + my $conf = shift; + ($bin, $terminalID, $merchantID, $username) = + $conf->config('batchconfig-paymentech'); + }, +# Here we do all the work in the header function. + header => sub { + my $pay_batch = shift; + my @cust_pay_batch = @{(shift)}; + my $count = 0; + XML::Simple::XMLout( { + transRequest => { + RequestCount => scalar(@cust_pay_batch), + batchFileID => { + userID => $username, + fileDateTime => time2str('%Y%m%d%H%M%s',time), + fileID => 'batch'.time2str('%Y%m%d',time), + }, + newOrder => [ map { { + # $_ here refers to a cust_pay_batch record. + BatchRequestNo => $count++, + industryType => 'EC', + transType => 'AC', + bin => $bin, + merchantID => $merchantID, + terminalID => $terminalID, + ($_->payby eq 'CARD') ? ( + # Credit card stuff + ccAccountNum => $_->payinfo, + ccExp => time2str('%y%m',str2time($_->exp)), + ) : ( + # ECP (electronic check) stuff + ecpCheckRT => ($_->payinfo =~ /@(\d+)/), + ecpCheckDDA => ($_->payinfo =~ /(\d+)@/), + ecpBankAcctType => $paytype{lc($_->cust_main->paytype)}, + ecpDelvMethod => 'B' + ), + avsZip => $_->zip, + avsAddress1 => $_->address1, + avsAddress2 => $_->address2, + avsCity => $_->city, + avsState => $_->state, + avsName => $_->first . ' ' . $_->last, + avsCountryCode => $_->country, + orderID => $_->paybatchnum, + amount => $_->amount * 100, + } } @cust_pay_batch + ], + endOfDay => { + BatchRequestNo => $count++, + bin => $bin, + merchantID => $merchantID, + terminalID => $terminalID + }, + } + }, KeepRoot => 1, NoAttr => 1); + }, + row => sub {}, +); + +1; + diff --git a/FS/FS/pay_batch/td_canada_trust.pm b/FS/FS/pay_batch/td_canada_trust.pm new file mode 100644 index 0000000..43b9237 --- /dev/null +++ b/FS/FS/pay_batch/td_canada_trust.pm @@ -0,0 +1,104 @@ +package FS::pay_batch::td_canada_trust; + +# Formerly known as csv-td_canada_trust-merchant_pc_batch, +# which I'm sure we can all agree is both a terrible name +# and an illegal Perl identifier. + +use strict; +use vars qw(@ISA %import_info %export_info $name); +use Time::Local 'timelocal'; +use FS::Conf; + +my $conf; +my ($origid, $datacenter, $typecode, $shortname, $longname, $mybank, $myacct); + +$name = 'csv-td_canada_trust-merchant_pc_batch'; + +%import_info = ( + 'filetype' => 'CSV', + 'fields' => [ + 'paybatchnum', + 'paid', + '', # card type + '_date', + 'time', + 'payinfo', + '', # expiry date + '', # auth number + 'type', # transaction type + 'result', # processing result + '', # terminal ID + ], + 'hook' => sub { + my $hash = shift; + my $date = $hash->{'_date'}; + my $time = $hash->{'time'}; + $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100); + $hash->{'_date'} = timelocal( substr($time, 4, 2), + substr($time, 2, 2), + substr($time, 0, 2), + substr($date, 6, 2), + substr($date, 4, 2)-1, + substr($date, 0, 4)-1900 ); + }, + 'approved' => sub { + my $hash = shift; + $hash->{'type'} eq '0' && $hash->{'result'} == 3 + }, + 'declined' => sub { + my $hash = shift; + $hash->{'type'} eq '0' && ( $hash->{'result'} == 4 + || $hash->{'result'} == 5 ) + }, + 'end_condition' => sub { + my $hash = shift; + $hash->{'type'} eq '0BC'; + }, + 'end_hook' => sub { + my ($hash, $total) = @_; + $total = sprintf("%.2f", $total); + my $batch_total = sprintf("%.2f", $hash->{'paybatchnum'} / 100); + return "Our total $total does not match bank total $batch_total!" + if $total != $batch_total; + }, +); + +%export_info = ( + init => sub { + $conf = shift; + }, + # no header + row => sub { + my ($cust_pay_batch, $pay_batch) = @_; + + return join(',', + '', + '', + '', + '', + $cust_pay_batch->payinfo, + expdate($cust_pay_batch->exp), + $cust_pay_batch->amount, + $cust_pay_batch->paybatchnum + ); + }, +# no footer +); + +sub expdate { + my $exp = shift; + $exp =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + my ($mon, $y) = ($2, $1); + if($conf->exists('batch-increment_expiration')) { + my ($curmon, $curyear) = (localtime(time))[4,5]; + $curmon++; + $curyear -= 100; + $y++ while $y < $curyear || ($y == $curyear && $mon < $curmon); + } + $mon = "0$mon" if $mon =~ /^\d$/; + $y = "0$y" if $y =~ /^\d$/; + return "$mon$y"; +} + +1; + diff --git a/FS/FS/payby.pm b/FS/FS/payby.pm index b54e5d9..30a03dd 100644 --- a/FS/FS/payby.pm +++ b/FS/FS/payby.pm @@ -48,28 +48,33 @@ tie %hash, 'Tie::IxHash', tinyname => 'card', shortname => 'Credit card', longname => 'Credit card (automatic)', + realtime => 1, }, 'DCRD' => { tinyname => 'card', shortname => 'Credit card', longname => 'Credit card (on-demand)', cust_pay => 'CARD', #this is a customer type only, payments are CARD... + realtime => 1, }, 'CHEK' => { tinyname => 'check', shortname => 'Electronic check', longname => 'Electronic check (automatic)', + realtime => 1, }, 'DCHK' => { tinyname => 'check', shortname => 'Electronic check', longname => 'Electronic check (on-demand)', cust_pay => 'CHEK', #this is a customer type only, payments are CHEK... + realtime => 1, }, 'LECB' => { tinyname => 'phone bill', shortname => 'Phone bill billing', longname => 'Phone bill billing', + realtime => 1, }, 'BILL' => { tinyname => 'billing', @@ -131,6 +136,15 @@ sub can_payby { return 1; } +sub realtime { # can use realtime payment facilities + my( $self, $payby ) = @_; + + return 0 unless $hash{$payby}; + return 0 unless exists( $hash{$payby}->{realtime} ); + + return $hash{$payby}->{realtime}; +} + sub payby2longname { my $self = shift; map { $_ => $hash{$_}->{longname} } $self->payby; @@ -157,6 +171,7 @@ sub longname { %payby2bop = ( 'CARD' => 'CC', 'CHEK' => 'ECHECK', + 'MCRD' => 'CC', ); sub payby2bop { diff --git a/FS/FS/payment_gateway.pm b/FS/FS/payment_gateway.pm index 35b4f08..bc8b875 100644 --- a/FS/FS/payment_gateway.pm +++ b/FS/FS/payment_gateway.pm @@ -1,12 +1,14 @@ package FS::payment_gateway; use strict; -use vars qw( @ISA ); +use vars qw( @ISA $me $DEBUG ); use FS::Record qw( qsearch qsearchs dbh ); use FS::option_Common; use FS::agent_payment_gateway; @ISA = qw( FS::option_Common ); +$me = '[ FS::payment_gateway ]'; +$DEBUG=0; =head1 NAME @@ -37,6 +39,8 @@ currently supported: =item gatewaynum - primary key +=item gateway_namespace - Business::OnlinePayment or Business::OnlineThirdPartyPayment + =item gateway_module - Business::OnlinePayment:: module name =item gateway_username - payment gateway username @@ -110,8 +114,12 @@ sub check { my $error = $self->ut_numbern('gatewaynum') || $self->ut_alpha('gateway_module') + || $self->ut_enum('gateway_namespace', ['Business::OnlinePayment', + 'Business::OnlineThirdPartyPayment', + ] ) || $self->ut_textn('gateway_username') || $self->ut_anything('gateway_password') + || $self->ut_textn('gateway_callback_url') # a bit too permissive || $self->ut_enum('disabled', [ '', 'Y' ] ) #|| $self->ut_textn('gateway_action') ; @@ -131,6 +139,10 @@ sub check { $self->gateway_action('Normal Authorization'); } + # this little kludge mimics FS::CGI::popurl + $self->gateway_callback_url($self->gateway_callback_url. '/') + if ( $self->gateway_callback_url && $self->gateway_callback_url !~ /\/$/ ); + $self->SUPER::check; } @@ -186,6 +198,41 @@ sub disable { } +=item namespace_description + +returns a friendly name for the namespace + +=cut + +my %namespace2description = ( + '' => 'Direct', + 'Business::OnlinePayment' => 'Direct', + 'Business::OnlineThirdPartyPayment' => 'Hosted', +); + +sub namespace_description { + $namespace2description{shift->gateway_namespace} || 'Unknown'; +} + +# _upgrade_data +# +# Used by FS::Upgrade to migrate to a new database. +# +# + +sub _upgrade_data { + my ($class, %opts) = @_; + my $dbh = dbh; + + warn "$me upgrading $class\n" if $DEBUG; + + foreach ( qsearch( 'payment_gateway', { 'gateway_namespace' => '' } ) ) { + $_->gateway_namespace('Business::OnlinePayment'); #defaulting + my $error = $_->replace; + die "$class had error during upgrade replacement: $error" if $error; + } +} + =back =head1 BUGS diff --git a/FS/FS/phone_device.pm b/FS/FS/phone_device.pm new file mode 100644 index 0000000..1bdbc34 --- /dev/null +++ b/FS/FS/phone_device.pm @@ -0,0 +1,240 @@ +package FS::phone_device; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( dbh qsearchs ); # qsearch ); +use FS::part_device; +use FS::svc_phone; + +=head1 NAME + +FS::phone_device - Object methods for phone_device records + +=head1 SYNOPSIS + + use FS::phone_device; + + $record = new FS::phone_device \%hash; + $record = new FS::phone_device { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::phone_device object represents a specific customer phone device, such as +a SIP phone or ATA. FS::phone_device inherits from FS::Record. The following +fields are currently supported: + +=over 4 + +=item devicenum + +primary key + +=item devicepart + +devicepart + +=item svcnum + +svcnum + +=item mac_addr + +mac_addr + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'phone_device'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $self->svc_phone->export('device_insert', $self); #call device export + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + + +=item delete + +Delete this record from the database. + +=cut + +sub delete { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + $self->svc_phone->export('device_delete', $self); #call device export + + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + +=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 + +sub replace { + my $new = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $new->SUPER::replace($old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $new->svc_phone->export('device_replace', $new, $old); #call device export + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + +=item check + +Checks all fields to make sure this is a valid record. 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 $mac = $self->mac_addr; + $mac =~ s/\s+//g; + $mac =~ s/://g; + $self->mac_addr($mac); + + my $error = + $self->ut_numbern('devicenum') + || $self->ut_foreign_key('devicepart', 'part_device', 'devicepart') + || $self->ut_foreign_key('svcnum', 'svc_phone', 'svcnum' ) #cust_svc? + || $self->ut_hexn('mac_addr') + ; + return $error if $error; + + $self->SUPER::check; +} + +=item part_device + +Returns the device type record (see L<FS::part_device>) associated with this +customer device. + +=cut + +sub part_device { + my $self = shift; + qsearchs( 'part_device', { 'devicepart' => $self->devicepart } ); +} + +=item svc_phone + +Returns the phone number (see L<FS::svc_phone>) associated with this customer +device. + +=cut + +sub svc_phone { + my $self = shift; + qsearchs( 'svc_phone', { 'svcnum' => $self->svcnum } ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/pkg_category.pm b/FS/FS/pkg_category.pm index 69578c9..0beaf1c 100644 --- a/FS/FS/pkg_category.pm +++ b/FS/FS/pkg_category.pm @@ -1,11 +1,13 @@ package FS::pkg_category; use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch ); +use vars qw( @ISA $me $DEBUG ); +use FS::Record qw( qsearch dbh ); use FS::part_pkg; @ISA = qw( FS::Record ); +$DEBUG = 0; +$me = '[FS::pkg_category]'; =head1 NAME @@ -95,10 +97,39 @@ sub check { $self->ut_numbern('categorynum') or $self->ut_text('categoryname') + or $self->ut_snumber('weight') or $self->SUPER::check; } +# _ upgrade_data +# +# Used by FS::Upgrade to migrate to a new database. +# +# + +sub _upgrade_data { + my ($class, %opts) = @_; + my $dbh = dbh; + + warn "$me upgrading $class\n" if $DEBUG; + + my @pkg_category = + qsearch('pkg_category', { weight => { op => '!=', value => '' } } ); + + unless( scalar(@pkg_category) ) { + my @pkg_category = qsearch('pkg_category', {} ); + my $weight = 0; + foreach ( sort { $a->description cmp $b->description } @pkg_category ) { + $_->weight($weight); + my $error = $_->replace; + die "error setting pkg_category weight: $error\n" if $error; + $weight += 10; + } + } + ''; +} + =back =head1 BUGS diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index 381e418..1f2abe3 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -3,6 +3,8 @@ package FS::queue; use strict; use vars qw( @ISA @EXPORT_OK $DEBUG $conf $jobnums); use Exporter; +use MIME::Base64; +use Storable qw( nfreeze thaw ); use FS::UID qw(myconnect); use FS::Conf; use FS::Record qw( qsearch qsearchs dbh ); @@ -142,9 +144,11 @@ sub insert { } foreach my $arg ( @args ) { + my $freeze = ref($arg) ? 'Y' : ''; my $queue_arg = new FS::queue_arg ( { 'jobnum' => $self->jobnum, - 'arg' => $arg, + 'frozen' => $freeze, + 'arg' => $freeze ? encode_base64(nfreeze($arg)) : $arg,# always freeze? } ); $error = $queue_arg->insert; if ( $error ) { @@ -254,11 +258,12 @@ Returns a list of the arguments associated with this job. sub args { my $self = shift; - map $_->arg, qsearch( 'queue_arg', - { 'jobnum' => $self->jobnum }, - '', - 'ORDER BY argnum' - ); + map { $_->frozen ? thaw(decode_base64($_->arg)) : $_->arg } + qsearch( 'queue_arg', + { 'jobnum' => $self->jobnum }, + '', + 'ORDER BY argnum' + ); } =item cust_svc diff --git a/FS/FS/queue_arg.pm b/FS/FS/queue_arg.pm index c96ff12..8e9a10d 100644 --- a/FS/FS/queue_arg.pm +++ b/FS/FS/queue_arg.pm @@ -36,6 +36,8 @@ FS::Record. The following fields are currently supported: =item jobnum - see L<FS::queue> +=item frozen - argument is frozen with Storable + =item arg - argument =back @@ -96,6 +98,7 @@ sub check { my $error = $self->ut_numbern('argnum') || $self->ut_numbern('jobnum') + || $self->ut_enum('frozen', [ '', 'Y' ]) || $self->ut_anything('arg') ; return $error if $error; diff --git a/FS/FS/rate_detail.pm b/FS/FS/rate_detail.pm index 62c0fa1..b7b23ba 100644 --- a/FS/FS/rate_detail.pm +++ b/FS/FS/rate_detail.pm @@ -1,14 +1,17 @@ package FS::rate_detail; use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); +use vars qw( @ISA $DEBUG $me ); +use FS::Record qw( qsearch qsearchs dbh ); use FS::rate; use FS::rate_region; use Tie::IxHash; @ISA = qw(FS::Record); +$DEBUG = 0; +$me = '[FS::rate_detail]'; + =head1 NAME FS::rate_detail - Object methods for rate_detail records @@ -229,6 +232,344 @@ sub granularities { %granularities; } +use Storable qw(thaw); +use Data::Dumper; +use MIME::Base64; +sub process_edit_import { + my $job = shift; + + #do we actually belong in rate_detail, like 'table' says? even though we + # can possible create new rate records, that's a side effect, mostly we + # do edit rate_detail records in batch... + + my $opt = { 'table' => 'rate_detail', + 'params' => [], #required, apparantly + 'formats' => { 'default' => [ + 'dest_regionnum', + '', #regionname + '', #country + '', #prefixes + #loop these + 'min_included', + 'min_charge', + sub { + my( $rate_detail, $g ) = @_; + $g = 0 if $g =~ /^\s*(per-)?call\s*$/i; + $g = 60 if $g =~ /^\s*minute\s*$/i; + $g =~ /^(\d+)/ or die "can't parse granularity: $g". + " for record ". Dumper($rate_detail); + $rate_detail->sec_granularity($1); + }, + 'classnum', + ] }, + 'format_headers' => { 'default' => 1, }, + 'format_types' => { 'default' => 'xls' }, + }; + + #false laziness w/ + #FS::Record::process_batch_import( $job, $opt, @_ ); + + my $table = $opt->{table}; + my @pass_params = @{ $opt->{params} }; + my %formats = %{ $opt->{formats} }; + + my $param = thaw(decode_base64(shift)); + warn Dumper($param) if $DEBUG; + + my $files = $param->{'uploaded_files'} + or die "No files provided.\n"; + + my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files; + + my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/'; + my $file = $dir. $files{'file'}; + + my $error = + #false laziness w/ + #FS::Record::batch_import( { + FS::rate_detail::edit_import( { + #class-static + table => $table, + formats => \%formats, + format_types => $opt->{format_types}, + format_headers => $opt->{format_headers}, + format_sep_chars => $opt->{format_sep_chars}, + format_fixedlength_formats => $opt->{format_fixedlength_formats}, + #per-import + job => $job, + file => $file, + #type => $type, + format => $param->{format}, + params => { map { $_ => $param->{$_} } @pass_params }, + #? + default_csv => $opt->{default_csv}, + } ); + + unlink $file; + + die "$error\n" if $error; + +} + +#false laziness w/ #FS::Record::batch_import, grep "edit_import" for differences +#could be turned into callbacks or something +use Text::CSV_XS; +sub edit_import { + my $param = shift; + + warn "$me edit_import call with params: \n". Dumper($param) + if $DEBUG; + + my $table = $param->{table}; + my $formats = $param->{formats}; + + my $job = $param->{job}; + my $file = $param->{file}; + my $format = $param->{'format'}; + my $params = $param->{params} || {}; + + die "unknown format $format" unless exists $formats->{ $format }; + + my $type = $param->{'format_types'} + ? $param->{'format_types'}{ $format } + : $param->{type} || 'csv'; + + unless ( $type ) { + if ( $file =~ /\.(\w+)$/i ) { + $type = lc($1); + } else { + #or error out??? + warn "can't parse file type from filename $file; defaulting to CSV"; + $type = 'csv'; + } + $type = 'csv' + if $param->{'default_csv'} && $type ne 'xls'; + } + + my $header = $param->{'format_headers'} + ? $param->{'format_headers'}{ $param->{'format'} } + : 0; + + my $sep_char = $param->{'format_sep_chars'} + ? $param->{'format_sep_chars'}{ $param->{'format'} } + : ','; + + my $fixedlength_format = + $param->{'format_fixedlength_formats'} + ? $param->{'format_fixedlength_formats'}{ $param->{'format'} } + : ''; + + my @fields = @{ $formats->{ $format } }; + + my $row = 0; + my $count; + my $parser; + my @buffer = (); + my @header = (); #edit_import + if ( $type eq 'csv' || $type eq 'fixedlength' ) { + + if ( $type eq 'csv' ) { + + my %attr = (); + $attr{sep_char} = $sep_char if $sep_char; + $parser = new Text::CSV_XS \%attr; + + } elsif ( $type eq 'fixedlength' ) { + + eval "use Parse::FixedLength;"; + die $@ if $@; + $parser = new Parse::FixedLength $fixedlength_format; + + } else { + die "Unknown file type $type\n"; + } + + @buffer = split(/\r?\n/, slurp($file) ); + splice(@buffer, 0, ($header || 0) ); + $count = scalar(@buffer); + + } elsif ( $type eq 'xls' ) { + + eval "use Spreadsheet::ParseExcel;"; + die $@ if $@; + + eval "use DateTime::Format::Excel;"; + #for now, just let the error be thrown if it is used, since only CDR + # formats bill_west and troop use it, not other excel-parsing things + #die $@ if $@; + + my $excel = Spreadsheet::ParseExcel::Workbook->new->Parse($file); + + $parser = $excel->{Worksheet}[0]; #first sheet + + $count = $parser->{MaxRow} || $parser->{MinRow}; + $count++; + + $row = $header || 0; + + #edit_import - need some magic to parse the header + if ( $header ) { + my @header_row = @{ $parser->{Cells}[$0] }; + @header = map $_->{Val}, @header_row; + } + + } else { + die "Unknown file type $type\n"; + } + + #my $columns; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + #edit_import - use the header to setup looping over different rates + my @rate = (); + if ( @header ) { + splice(@header,0,4); # # Region Country Prefixes + while ( my @next = splice(@header,0,4) ) { + my $rate; + if ( $next[0] =~ /^(\d+):\s*([^:]+):/ ) { + $rate = qsearchs('rate', { 'ratenum' => $1 } ) + or die "unknown ratenum $1"; + } elsif ( $next[0] =~ /^(NEW:)?\s*([^:]+)/i ) { + $rate = new FS::rate { 'ratename' => $2 }; + my $error = $rate->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error inserting new rate: $error\n"; + } + } + push @rate, $rate; + } + } + die unless @rate; + + my $line; + my $imported = 0; + my( $last, $min_sec ) = ( time, 5 ); #progressbar foo + while (1) { + + my @columns = (); + if ( $type eq 'csv' ) { + + last unless scalar(@buffer); + $line = shift(@buffer); + + $parser->parse($line) or do { + $dbh->rollback if $oldAutoCommit; + return "can't parse: ". $parser->error_input(); + }; + @columns = $parser->fields(); + + } elsif ( $type eq 'fixedlength' ) { + + @columns = $parser->parse($line); + + } elsif ( $type eq 'xls' ) { + + last if $row > ($parser->{MaxRow} || $parser->{MinRow}) + || ! $parser->{Cells}[$row]; + + my @row = @{ $parser->{Cells}[$row] }; + @columns = map $_->{Val}, @row; + + #my $z = 'A'; + #warn $z++. ": $_\n" for @columns; + + } else { + die "Unknown file type $type\n"; + } + + #edit_import loop + + my @repeat = @columns[0..3]; + + foreach my $rate ( @rate ) { + + my @later = (); + my %hash = %$params; + + foreach my $field ( @fields ) { + + my $value = shift @columns; + + if ( ref($field) eq 'CODE' ) { + #&{$field}(\%hash, $value); + push @later, $field, $value; + #} else { + } elsif ($field) { #edit_import + #??? $hash{$field} = $value if length($value); + $hash{$field} = $value if defined($value) && length($value); + } + + } + + unshift @columns, @repeat; #edit_import put these back on for next time + + my $class = "FS::$table"; + + my $record = $class->new( \%hash ); + + $record->ratenum($rate->ratenum); #edit_import + + #edit_improt n/a my $param = {}; + while ( scalar(@later) ) { + my $sub = shift @later; + my $data = shift @later; + #&{$sub}($record, $data, $conf, $param);# $record->&{$sub}($data, $conf); + &{$sub}($record, $data); #edit_import - don't have $conf + #edit_import wrong loop last if exists( $param->{skiprow} ); + } + #edit_import wrong loop next if exists( $param->{skiprow} ); + + #edit_import update or insert, not just insert + my $old = qsearchs({ + 'table' => $table, + 'hashref' => { map { $_ => $record->$_() } qw(ratenum dest_regionnum) }, + }); + + my $error; + if ( $old ) { + $record->ratedetailnum($old->ratedetailnum); + $error = $record->replace($old) + } else { + $record->insert; + } + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't insert record". ( $line ? " for $line" : '' ). ": $error"; + } + + } + + $row++; + $imported++; + + if ( $job && time - $min_sec > $last ) { #progress bar + $job->update_statustext( int(100 * $imported / $count) ); + $last = time; + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit;; + + return "Empty file!" unless $imported || $param->{empty_ok}; + + ''; #no error + +} + + =back diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index da1cfe1..8fd5d0d 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -1,8 +1,9 @@ package FS::svc_Common; use strict; -use vars qw( @ISA $noexport_hack $DEBUG $me ); -use Carp qw( cluck carp croak ); #specify cluck have to specify them all.. +use vars qw( @ISA $noexport_hack $DEBUG $me + $overlimit_missing_cust_svc_nonfatal_kludge ); +use Carp qw( cluck carp croak confess ); #specify cluck have to specify them all use Scalar::Util qw( blessed ); use FS::Record qw( qsearch qsearchs fields dbh ); use FS::cust_main_Mixin; @@ -18,6 +19,8 @@ use FS::inventory_class; $me = '[FS::svc_Common]'; $DEBUG = 0; +$overlimit_missing_cust_svc_nonfatal_kludge = 0; + =head1 NAME FS::svc_Common - Object method for all svc_ records @@ -151,6 +154,11 @@ sub label { $self->svcnum; } +sub label_long { + my $self = shift; + $self->label(@_); +} + =item check Checks the validity of fields in this record. @@ -793,7 +801,19 @@ Sets or retrieves overlimit date. sub overlimit { my $self = shift; - $self->cust_svc->overlimit(@_); + #$self->cust_svc->overlimit(@_); + my $cust_svc = $self->cust_svc; + unless ( $cust_svc ) { #wtf? + my $error = "$me overlimit: missing cust_svc record for svc_acct svcnum ". + $self->svcnum; + if ( $overlimit_missing_cust_svc_nonfatal_kludge ) { + cluck "$error; continuing anyway as requested"; + return ''; + } else { + confess $error; + } + } + $cust_svc->overlimit(@_); } =item cancel diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 6f11051..1b12654 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -6,7 +6,7 @@ use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles $usernamemax $passwordmin $passwordmax $username_ampersand $username_letter $username_letterfirst $username_noperiod $username_nounderscore $username_nodash - $username_uppercase $username_percent + $username_uppercase $username_percent $username_colon $password_noampersand $password_noexclamation $warning_template $warning_from $warning_subject $warning_mimetype $warning_cc @@ -15,17 +15,20 @@ use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles $dirhash @saltset @pw_set ); use Scalar::Util qw( blessed ); +use Math::BigInt; use Carp; use Fcntl qw(:flock); use Date::Format; use Crypt::PasswdMD5 1.2; use Data::Dumper; +use Text::Template; use Authen::Passphrase; use FS::UID qw( datasrc driver_name ); use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh dbdef ); use FS::Msgcat qw(gettext); use FS::UI::bytecount; +use FS::part_pkg; use FS::svc_Common; use FS::cust_svc; use FS::part_svc; @@ -53,7 +56,11 @@ FS::UID->install_callback( sub { @shells = $conf->config('shells'); $usernamemin = $conf->config('usernamemin') || 2; $usernamemax = $conf->config('usernamemax'); - $passwordmin = $conf->config('passwordmin') || 6; + $passwordmin = $conf->config('passwordmin'); # || 6; + #blank->6, keep 0 + $passwordmin = ( defined($passwordmin) && $passwordmin =~ /\d+/ ) + ? $passwordmin + : 6; $passwordmax = $conf->config('passwordmax') || 8; $username_letter = $conf->exists('username-letter'); $username_letterfirst = $conf->exists('username-letterfirst'); @@ -63,6 +70,7 @@ FS::UID->install_callback( sub { $username_uppercase = $conf->exists('username-uppercase'); $username_ampersand = $conf->exists('username-ampersand'); $username_percent = $conf->exists('username-percent'); + $username_colon = $conf->exists('username-colon'); $password_noampersand = $conf->exists('password-noexclamation'); $password_noexclamation = $conf->exists('password-noexclamation'); $dirhash = $conf->config('dirhash') || 0; @@ -212,9 +220,9 @@ sub table_info { 'fields' => { 'dir' => 'Home directory', 'uid' => { - label => 'UID', - def_label => 'UID (set to fixed and blank for no UIDs)', - type => 'text', + label => 'UID', + def_info => 'set to fixed and blank for no UIDs', + type => 'text', }, 'slipip' => 'IP address', # 'popnum' => qq!<A HREF="$p/browse/svc_acct_pop.cgi/">POP number</A>!, @@ -241,24 +249,22 @@ sub table_info { }, '_password' => 'Password', 'gid' => { - label => 'GID', - def_label => 'GID (when blank, defaults to UID)', - type => 'text', + label => 'GID', + def_info => 'when blank, defaults to UID', + type => 'text', }, 'shell' => { - #desc =>'Shell (all service definitions should have a default or fixed shell that is present in the <b>shells</b> configuration file, set to blank for no shell tracking)', label => 'Shell', - def_label=> 'Shell (set to blank for no shell tracking)', - type =>'select', + def_info => 'set to blank for no shell tracking', + type => 'select', #select_list => [ $conf->config('shells') ], select_list => [ $conf ? $conf->config('shells') : () ], disable_inventory => 1, disable_select => 1, }, - 'finger' => 'Real name (GECOS)', + 'finger' => 'Real name', # (GECOS)', 'domsvc' => { label => 'Domain', - #def_label => 'svcnum from svc_domain', type => 'select', select_table => 'svc_domain', select_key => 'svcnum', @@ -277,6 +283,7 @@ sub table_info { type => 'text', disable_inventory => 1, disable_select => 1, + disable_part_svc_column => 1, }, 'upbytes' => { label => 'Upload', type => 'text', @@ -284,6 +291,7 @@ sub table_info { disable_select => 1, 'format' => \&FS::UI::bytecount::display_bytecount, 'parse' => \&FS::UI::bytecount::parse_bytecount, + disable_part_svc_column => 1, }, 'downbytes' => { label => 'Download', type => 'text', @@ -291,6 +299,7 @@ sub table_info { disable_select => 1, 'format' => \&FS::UI::bytecount::display_bytecount, 'parse' => \&FS::UI::bytecount::parse_bytecount, + disable_part_svc_column => 1, }, 'totalbytes'=> { label => 'Total up and download', type => 'text', @@ -298,11 +307,13 @@ sub table_info { disable_select => 1, 'format' => \&FS::UI::bytecount::display_bytecount, 'parse' => \&FS::UI::bytecount::parse_bytecount, + disable_part_svc_column => 1, }, 'seconds_threshold' => { label => 'Seconds threshold', type => 'text', disable_inventory => 1, disable_select => 1, + disable_part_svc_column => 1, }, 'upbytes_threshold' => { label => 'Upload threshold', type => 'text', @@ -310,6 +321,7 @@ sub table_info { disable_select => 1, 'format' => \&FS::UI::bytecount::display_bytecount, 'parse' => \&FS::UI::bytecount::parse_bytecount, + disable_part_svc_column => 1, }, 'downbytes_threshold' => { label => 'Download threshold', type => 'text', @@ -317,6 +329,7 @@ sub table_info { disable_select => 1, 'format' => \&FS::UI::bytecount::display_bytecount, 'parse' => \&FS::UI::bytecount::parse_bytecount, + disable_part_svc_column => 1, }, 'totalbytes_threshold'=> { label => 'Total up and download threshold', type => 'text', @@ -324,6 +337,7 @@ sub table_info { disable_select => 1, 'format' => \&FS::UI::bytecount::display_bytecount, 'parse' => \&FS::UI::bytecount::parse_bytecount, + disable_part_svc_column => 1, }, 'last_login'=> { label => 'Last login', @@ -419,7 +433,13 @@ sub search_sql { $class->search_sql_field('username', $string ). ' ) '; } else { - $class->search_sql_field('username', $string); + ' ( '. + $class->search_sql_field('username', $string). + ( $string =~ /^\d+$/ + ? 'OR '. $class->search_sql_field('svcnum', $string) + : '' + ). + ' ) '; } } @@ -437,8 +457,26 @@ sub label { $self->email(@_); } +=item label_long [ END_TIMESTAMP [ START_TIMESTAMP ] ] + +Returns a longer string label for this acccount ("Real Name <username@domain>" +if available, or "username@domain"). + +END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with +history records. + =cut +sub label_long { + my $self = shift; + my $label = $self->label(@_); + my $finger = $self->finger; + return $label unless $finger =~ /\S/; + my $maxlen = 40 - length($label) - length($self->cust_svc->part_svc->svc); + $finger = substr($finger, 0, $maxlen-3).'...' if length($finger) > $maxlen; + "$finger <$label>"; +} + =item insert [ , OPTION => VALUE ... ] Adds this account to the database. If there is an error, returns the error, @@ -503,6 +541,27 @@ sub insert { $self->svcpart($cust_svc->svcpart); } + # set usage fields and thresholds if unset but set in a package def + if ( $self->pkgnum ) { + my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); + my $part_pkg = $cust_pkg->part_pkg if $cust_pkg; + if ( $part_pkg && $part_pkg->can('usage_valuehash') ) { + + my %values = $part_pkg->usage_valuehash; + my $multiplier = $conf->exists('svc_acct-usage_threshold') + ? 1 - $conf->config('svc_acct-usage_threshold')/100 + : 0.20; #doesn't matter + + foreach ( keys %values ) { + next if $self->getfield($_); + $self->setfield( $_, $values{$_} ); + $self->setfield( $_. '_threshold', int( $values{$_} * $multiplier ) ) + if $conf->exists('svc_acct-usage_threshold'); + } + + } + } + my @jobnums; $error = $self->SUPER::insert( 'jobnums' => \@jobnums, @@ -976,13 +1035,28 @@ sub check { ; return $error if $error; + my $cust_pkg; + local $username_letter = $username_letter; + if ($self->svcnum) { + my $cust_svc = $self->cust_svc + or return "no cust_svc record found for svcnum ". $self->svcnum; + my $cust_pkg = $cust_svc->cust_pkg; + } + if ($self->pkgnum) { + $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $self->pkgnum } );#complain? + } + if ($cust_pkg) { + $username_letter = + $conf->exists('username-letter', $cust_pkg->cust_main->agentnum); + } + my $ulen = $usernamemax || $self->dbdef_table->column('username')->length; if ( $username_uppercase ) { - $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/i + $recref->{username} =~ /^([a-z0-9_\-\.\&\%\:]{$usernamemin,$ulen})$/i or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username}; $recref->{username} = $1; } else { - $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/ + $recref->{username} =~ /^([a-z0-9_\-\.\&\%\:]{$usernamemin,$ulen})$/ or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username}; $recref->{username} = $1; } @@ -1007,6 +1081,9 @@ sub check { unless ( $username_percent ) { $recref->{username} =~ /\%/ and return gettext('illegal_username'); } + unless ( $username_colon ) { + $recref->{username} =~ /\:/ and return gettext('illegal_username'); + } $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum}; $recref->{popnum} = $1; @@ -1158,7 +1235,7 @@ sub check { #carp "warning: _password_encoding unspecified\n"; #generate a password if it is blank - unless ( length( $recref->{_password} ) ) { + unless ( length($recref->{_password}) || ! $passwordmin ) { $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) ); @@ -1374,6 +1451,29 @@ sub radius_reply { $reply{'Session-Timeout'} = $self->seconds; } + if ( $conf->exists('radius-chillispot-max') ) { + #http://dev.coova.org/svn/coova-chilli/doc/dictionary.chillispot + + #hmm. just because sqlradius.pm says so? + my %whatis = ( + 'input' => 'up', + 'output' => 'down', + 'total' => 'total', + ); + + foreach my $what (qw( input output total )) { + my $is = $whatis{$what}.'bytes'; + if ( $self->$is() =~ /\d/ ) { + my $big = new Math::BigInt $self->$is(); + $big = new Math::BigInt '0' if $big->is_neg(); + my $att = "Chillispot-Max-\u$what"; + $reply{"$att-Octets"} = $big->copy->band(0xffffffff)->bstr; + $reply{"$att-Gigawords"} = $big->copy->brsft(32)->bstr; + } + } + + } + %reply; } @@ -1407,11 +1507,15 @@ sub radius_check { $check{$pw_attrib} = $password; my $cust_svc = $self->cust_svc; - die "FATAL: no cust_svc record for svc_acct.svcnum ". $self->svcnum. "\n" - unless $cust_svc; - my $cust_pkg = $cust_svc->cust_pkg; - if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill ) { - $check{'Expiration'} = time2str('%B %e %Y %T', $cust_pkg->bill ); #http://lists.cistron.nl/pipermail/freeradius-users/2005-January/040184.html + if ( $cust_svc ) { + my $cust_pkg = $cust_svc->cust_pkg; + if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill ) { + $check{'Expiration'} = time2str('%B %e %Y %T', $cust_pkg->bill ); #http://lists.cistron.nl/pipermail/freeradius-users/2005-January/040184.html + } + } else { + warn "WARNING: no cust_svc record for svc_acct.svcnum ". $self->svcnum. + "; can't set Expiration\n" + unless $cust_svc; } %check; @@ -1659,7 +1763,7 @@ my %op2condition = ( $self->$column - $amount <= 0; }, '+' => sub { my($self, $column, $amount) = @_; - $self->$column + $amount > 0; + ($self->$column || 0) + $amount > 0; }, ); my %op2warncondition = ( @@ -1668,7 +1772,7 @@ my %op2warncondition = ( $self->$column - $amount <= $self->$threshold + 0; }, '+' => sub { my($self, $column, $amount) = @_; - $self->$column + $amount > 0; + ($self->$column || 0) + $amount > 0; }, ); @@ -1706,6 +1810,38 @@ sub _op_usage { die "Can't update $column for svcnum". $self->svcnum if $rv == 0; + #$self->snapshot; #not necessary, we retain the old values + #create an object with the updated usage values + my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum }); + #call exports + my $error = $new->replace($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error replacing: $error"; + } + + #overlimit_action eq 'cancel' handling + my $cust_pkg = $self->cust_svc->cust_pkg; + if ( $cust_pkg + && $cust_pkg->part_pkg->option('overlimit_action', 1) eq 'cancel' + && $op eq '-' && &{$op2condition{$op}}($self, $column, $amount) + ) + { + + my $error = $cust_pkg->cancel; #XXX should have a reason + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error cancelling: $error"; + } + + #nothing else is relevant if we're cancelling, so commit & return success + warn "$me update successful; committing\n" + if $DEBUG; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return ''; + + } + my $action = $op2action{$op}; if ( &{$op2condition{$op}}($self, $column, $amount) && @@ -1777,7 +1913,7 @@ sub _op_usage { } sub set_usage { - my( $self, $valueref ) = @_; + my( $self, $valueref, %options ) = @_; warn "$me set_usage called for svcnum ". $self->svcnum. ' ('. $self->email. "): ". @@ -1798,6 +1934,11 @@ sub set_usage { my $reset = 0; my %handyhash = (); + if ( $options{null} ) { + %handyhash = ( map { ( $_ => 'NULL', $_."_threshold" => 'NULL' ) } + qw( seconds upbytes downbytes totalbytes ) + ); + } foreach my $field (keys %$valueref){ $reset = 1 if $valueref->{$field}; $self->setfield($field, $valueref->{$field}); @@ -1816,8 +1957,8 @@ sub set_usage { #die $error if $error; #services not explicity changed via the UI my $sql = "UPDATE svc_acct SET " . - join (',', map { "$_ = ?" } (keys %handyhash) ). - " WHERE svcnum = ?"; + join (',', map { "$_ = $handyhash{$_}" } (keys %handyhash) ). + " WHERE svcnum = ". $self->svcnum; warn "$me $sql\n" if $DEBUG; @@ -1825,13 +1966,23 @@ sub set_usage { if (scalar(keys %handyhash)) { my $sth = $dbh->prepare( $sql ) or die "Error preparing $sql: ". $dbh->errstr; - my $rv = $sth->execute((values %handyhash), $self->svcnum); + my $rv = $sth->execute(); die "Error executing $sql: ". $sth->errstr unless defined($rv); die "Can't update usage for svcnum ". $self->svcnum if $rv == 0; } + #$self->snapshot; #not necessary, we retain the old values + #create an object with the updated usage values + my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum }); + #call exports + my $error = $new->replace($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error replacing: $error"; + } + if ( $reset ) { my $error; @@ -2613,6 +2764,8 @@ probably live somewhere else... insertion of RADIUS group stuff in insert could be done with child_objects now (would probably clean up export of them too) +_op_usage and set_usage bypass the history... maybe they shouldn't + =head1 SEE ALSO L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface, diff --git a/FS/FS/svc_broadband.pm b/FS/FS/svc_broadband.pm index b808527..74cedfc 100755 --- a/FS/FS/svc_broadband.pm +++ b/FS/FS/svc_broadband.pm @@ -6,6 +6,7 @@ use FS::Record qw( qsearchs qsearch dbh ); use FS::svc_Common; use FS::cust_svc; use FS::addr_block; +use FS::part_svc_router; use NetAddr::IP; @ISA = qw( FS::svc_Common ); @@ -110,6 +111,8 @@ sub table_info { sub table { 'svc_broadband'; } +sub table_dupcheck_fields { ( 'mac_addr' ); } + =item search_sql STRING Class method which returns an SQL fragment to search for the given string. @@ -243,7 +246,19 @@ sub check { } } + $error = $self->_check_ip_addr; + return $error if $error; + + $self->SUPER::check; +} + +sub _check_ip_addr { + my $self = shift; + if (not($self->ip_addr) or $self->ip_addr eq '0.0.0.0') { + + return '' if $conf->exists('svc_broadband-allow_null_ip_addr'); #&& !$self->blocknum + return "Must supply either address or block" unless $self->blocknum; my $next_addr = $self->addr_block->next_free_addr; @@ -252,6 +267,7 @@ sub check { } else { return "No free addresses in addr_block (blocknum: ".$self->blocknum.")"; } + } if (not($self->blocknum)) { @@ -285,9 +301,21 @@ sub check { return 'Router '.$router->routernum.' cannot provide svcpart '.$self->svcpart; } - $self->SUPER::check; + ''; } +sub _check_duplicate { + my $self = shift; + + return "MAC already in use" + if ( $self->mac_addr && + scalar( qsearch( 'svc_broadband', { 'mac_addr', $self->mac_addr } ) ) + ); + + ''; +} + + =item NetAddr Returns a NetAddr::IP object containing the IP address of this service. The netmask diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 47aa8f3..3311ac5 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -140,8 +140,8 @@ otherwise returns false. The additional fields I<pkgnum> and I<svcpart> (see L<FS::cust_svc>) should be defined. An FS::cust_svc record will be created and inserted. -The additional field I<action> should be set to I<N> for new domains or I<M> -for transfers. +The additional field I<action> should be set to I<N> for new domains, I<M> +for transfers, or I<I> for no action (registered elsewhere). A registration or transfer email will be submitted unless $FS::svc_domain::whois_hack is true. @@ -300,7 +300,7 @@ sub replace { if $old->getfield('domain') ne $new->getfield('domain'); # Better to do it here than to force the caller to remember that svc_domain is weird. - $new->setfield(action => 'M'); + $new->setfield(action => 'I'); my $error = $new->SUPER::replace($old, @_); return $error if $error; } @@ -388,7 +388,6 @@ sub check { or $self->ut_numbern('setup_date') or $self->ut_numbern('renewal_interval') or $self->ut_numbern('expiration_date') - or $self->ut_textn('purpose') or $self->SUPER::check; } diff --git a/FS/FS/svc_external.pm b/FS/FS/svc_external.pm index 0fb391f..aca7c1b 100644 --- a/FS/FS/svc_external.pm +++ b/FS/FS/svc_external.pm @@ -95,6 +95,7 @@ sub label { substr('0000000000'.uc($self->title), -10); } else { #$self->SUPER::label; + return $self->id unless $self->title =~ /\S/; $self->id. ' - '. $self->title; } } diff --git a/FS/FS/svc_phone.pm b/FS/FS/svc_phone.pm index ce767d5..11a5a0e 100644 --- a/FS/FS/svc_phone.pm +++ b/FS/FS/svc_phone.pm @@ -3,10 +3,11 @@ package FS::svc_phone; use strict; use vars qw( @ISA @pw_set $conf ); use FS::Conf; -use FS::Record qw( qsearch qsearchs ); +use FS::Record qw( qsearch qsearchs dbh ); use FS::Msgcat qw(gettext); use FS::svc_Common; use FS::part_svc; +use FS::phone_device; @ISA = qw( FS::svc_Common ); @@ -102,7 +103,7 @@ sub table_info { disable_select => 1, }, 'sip_password' => 'SIP password', - 'name' => 'Name', + 'phone_name' => 'Name', }, }; } @@ -151,6 +152,39 @@ Delete this record from the database. =cut +sub delete { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $phone_device ( $self->phone_device ) { + my $error = $phone_device->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + # the delete method can be inherited from FS::Record =item replace OLD_RECORD @@ -326,6 +360,17 @@ sub radius_groups { (); } +=item phone_device + +Returns any FS::phone_device records associated with this service. + +=cut + +sub phone_device { + my $self = shift; + qsearch('phone_device', { 'svcnum' => $self->svcnum } ); +} + =back =head1 BUGS diff --git a/FS/FS/tax_class.pm b/FS/FS/tax_class.pm index 480fa10..4f03969 100644 --- a/FS/FS/tax_class.pm +++ b/FS/FS/tax_class.pm @@ -246,7 +246,7 @@ sub batch_import { if ( $job ) { # progress bar if ( time - $min_sec > $last ) { my $error = $job->update_statustext( - int( 100 * $imported / $count ) + int( 100 * $imported / $count ). ",Importing tax classes" ); die $error if $error; $last = time; @@ -270,7 +270,7 @@ sub batch_import { if ( $job ) { # progress bar if ( time - $min_sec > $last ) { my $error = $job->update_statustext( - int( 100 * $imported / $count ) + int( 100 * $imported / $count ). ",Importing tax classes" ); die $error if $error; $last = time; @@ -319,7 +319,7 @@ sub batch_import { if ( $job ) { # progress bar if ( time - $min_sec > $last ) { my $error = $job->update_statustext( - int( 100 * $imported / $count ) + int( 100 * $imported / $count ). ",Importing tax classes" ); die $error if $error; $last = time; diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 0d9156b..d55b09b 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -3,15 +3,27 @@ package FS::tax_rate; use strict; use vars qw( @ISA $DEBUG $me %tax_unittypes %tax_maxtypes %tax_basetypes %tax_authorities - %tax_passtypes ); + %tax_passtypes %GetInfoType ); use Date::Parse; +use DateTime; +use DateTime::Format::Strptime; use Storable qw( thaw ); +use IO::File; +use File::Temp; +use LWP::UserAgent; +use HTTP::Request; +use HTTP::Response; use MIME::Base64; -use FS::Record qw( qsearch qsearchs dbh ); +use DBIx::DBSchema; +use DBIx::DBSchema::Table; +use DBIx::DBSchema::Column; +use FS::Record qw( qsearch qsearchs dbh dbdef ); use FS::tax_class; use FS::cust_bill_pkg; use FS::cust_tax_location; +use FS::tax_rate_location; use FS::part_pkg_taxrate; +use FS::part_pkg_taxproduct; use FS::cust_main; use FS::Misc qw( csv_from_fixed ); @@ -530,6 +542,26 @@ sub tax_on_tax { } +=item tax_rate_location + +Returns an object representing the location associated with this tax +(see L<FS::tax_rate_location>) + +=cut + +sub tax_rate_location { + my $self = shift; + + qsearchs({ 'table' => 'tax_rate_location', + 'hashref' => { 'data_vendor' => $self->data_vendor, + 'geocode' => $self->geocode, + 'disabled' => '', + }, + }) || + new FS::tax_rate_location; + +} + =back =head1 SUBROUTINES @@ -557,7 +589,7 @@ sub batch_import { if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) { $format =~ s/-fixed//; my $date_format = sub { my $r=''; - /^(\d{4})(\d{2})(\d{2})$/ && ($r="$1/$2/$3"); + /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1"); $r; }; my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r }; @@ -588,7 +620,13 @@ sub batch_import { $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch'); $hash->{'data_vendor'} ='cch'; - $hash->{'effective_date'} = str2time($hash->{'effective_date'}); + my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y", + time_zone => 'floating', + ); + my $dt = $parser->parse_datetime( $hash->{'effective_date'} ); + $hash->{'effective_date'} = $dt ? $dt->epoch : ''; + + $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax ); my $taxclassid = join(':', map{ $hash->{$_} } qw(taxtype taxcat) ); @@ -675,7 +713,7 @@ sub batch_import { if ( $job ) { # progress bar if ( time - $min_sec > $last ) { my $error = $job->update_statustext( - int( 100 * $imported / $count ) + int( 100 * $imported / $count ). ",Importing tax rates" ); die $error if $error; $last = time; @@ -719,7 +757,7 @@ sub batch_import { if ( $job ) { # progress bar if ( time - $min_sec > $last ) { my $error = $job->update_statustext( - int( 100 * $imported / $count ) + int( 100 * $imported / $count ). ",Importing tax rates" ); die $error if $error; $last = time; @@ -743,7 +781,7 @@ sub batch_import { if ( $job ) { # progress bar if ( time - $min_sec > $last ) { my $error = $job->update_statustext( - int( 100 * $imported / $count ) + int( 100 * $imported / $count ). ",Importing tax rates" ); die $error if $error; $last = time; @@ -777,7 +815,7 @@ sub batch_import { if ( $job ) { # progress bar if ( time - $min_sec > $last ) { my $error = $job->update_statustext( - int( 100 * $imported / $count ) + int( 100 * $imported / $count ). ",Importing tax rates" ); die $error if $error; $last = time; @@ -837,7 +875,8 @@ sub process_batch_import { my $error = ''; my $have_location = 0; - my @list = ( 'CODE', 'codefile', \&FS::tax_class::batch_import, + my @list = ( 'GEOCODE', 'geofile', \&FS::tax_rate_location::batch_import, + 'CODE', 'codefile', \&FS::tax_class::batch_import, 'PLUS4', 'plus4file', \&FS::cust_tax_location::batch_import, 'ZIP', 'zipfile', \&FS::cust_tax_location::batch_import, 'TXMATRIX', 'txmatrix', \&FS::part_pkg_taxrate::batch_import, @@ -878,8 +917,10 @@ sub process_batch_import { my $error = ''; my @insert_list = (); my @delete_list = (); + my @predelete_list = (); - my @list = ( 'CODE', 'codefile', \&FS::tax_class::batch_import, + my @list = ( 'GEOCODE', 'geofile', \&FS::tax_rate_location::batch_import, + 'CODE', 'codefile', \&FS::tax_class::batch_import, 'PLUS4', 'plus4file', \&FS::cust_tax_location::batch_import, 'ZIP', 'zipfile', \&FS::cust_tax_location::batch_import, 'TXMATRIX', 'txmatrix', \&FS::part_pkg_taxrate::batch_import, @@ -932,9 +973,26 @@ sub process_batch_import { close $dfh; push @insert_list, $name, $ifh->filename, $import_sub; - unshift @delete_list, $name, $dfh->filename, $import_sub; + if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better + unshift @predelete_list, $name, $dfh->filename, $import_sub; + } else { + unshift @delete_list, $name, $dfh->filename, $import_sub; + } + + } + + while( scalar(@predelete_list) ) { + my ($name, $file, $import_sub) = + (shift @predelete_list, shift @predelete_list, shift @predelete_list); + my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' ); + open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!"; + $error ||= + &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job); + close $fh; + unlink $file or warn "Can't delete $file: $!"; } + while( scalar(@insert_list) ) { my ($name, $file, $import_sub) = (shift @insert_list, shift @insert_list, shift @insert_list); @@ -983,6 +1041,541 @@ sub process_batch_import { } +=item process_download_and_reload + +Download and process a tax update as a queued JSRPC job after wiping the +existing wipable tax data. + +=cut + +sub process_download_and_reload { + my $job = shift; + + my $param = thaw(decode_base64($_[0])); + my $format = $param->{'format'}; #well... this is all cch specific + + my ( $count, $last, $min_sec, $imported ) = (0, time, 5, 0); #progressbar + $count = 100; + + if ( $job ) { # progress bar + my $error = $job->update_statustext( int( 100 * $imported / $count ) ); + die $error if $error; + } + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $error = ''; + + my $sql = + "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ". + "USING (taxclassnum) WHERE data_vendor = '$format'"; + my $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute + or die "Unexpected error executing statement $sql: ". $sth->errstr; + die "Don't (yet) know how to handle part_pkg_taxoverride records." + if $sth->fetchrow_arrayref->[0]; + + # really should get a table EXCLUSIVE lock here + + #remember disabled taxes + my %disabled_tax_rate = (); + foreach my $tax_rate ( qsearch( { table => 'tax_rate', + hashref => { disabled => 'Y', + data_vendor => $format, + }, + select => 'geocode, taxclassnum', + } + ) + ) + { + my $tax_class = + qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } ); + unless ( $tax_class ) { + warn "failed to find tax_class ". $tax_rate->taxclassnum; + next; + } + $disabled_tax_rate{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1; + } + + #remember tax products + # XXX FIXME this loop only works when cch is the only data provider + my %taxproduct = (); + my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ". + "0 < ( SELECT count(*) from part_pkg_option WHERE ". + " part_pkg_option.pkgpart = part_pkg.pkgpart AND ". + " optionname LIKE 'usage_taxproductnum_%' AND ". + " optionvalue != '' )"; + foreach my $part_pkg ( qsearch( { table => 'part_pkg', + select => 'DISTINCT pkgpart,taxproductnum', + hashref => {}, + extra_sql => $extra_sql, + } + ) + ) + { + warn "working with package part ". $part_pkg->pkgpart. + "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG; + my $part_pkg_taxproduct = $part_pkg->taxproduct(''); + $taxproduct{$part_pkg->pkgpart}{''} = $part_pkg_taxproduct->taxproduct + if $part_pkg_taxproduct; + + foreach my $option ( $part_pkg->part_pkg_option ) { + next unless $option->optionname =~ /^usage_taxproductnum_(\w)$/; + my $class = $1; + + $part_pkg_taxproduct = $part_pkg->taxproduct($class); + $taxproduct{$part_pkg->pkgpart}{$class} = $part_pkg_taxproduct->taxproduct + if $part_pkg_taxproduct; + } + } + + #wipe out the old data + foreach my $tax_rate_location ( qsearch( 'tax_rate_location', + { data_vendor => $format, + disabled => '', + } + ) + ) + { + $tax_rate_location->disabled('Y'); + my $error = $tax_rate_location->replace; + if ( $error ) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die $error; + } + } + + local $FS::part_pkg_taxproduct::delete_kludge = 1; + my @table = qw( + tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location + ); + foreach my $table ( @table ) { + foreach my $row ( qsearch( $table, { data_vendor => $format } ) ) { + my $error = $row->delete; + if ( $error ) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die $error; + } + } + } + + if ( $format eq 'cch' ) { + foreach my $cust_tax_location ( qsearch( 'cust_tax_location', + { data_vendor => "$format-zip" } + ) + ) + { + my $error = $cust_tax_location->delete; + if ( $error ) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die $error; + } + } + } + + #import new data + process_download_and_update($job, @_); + + #restore taxproducts + foreach my $pkgpart ( keys %taxproduct ) { + warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG; + + my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } ); + unless ( $part_pkg ) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die "somehow failed to find part_pkg with pkgpart $pkgpart!\n"; + } + + my %options = $part_pkg->options; + my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc; + my $primary_svc = $part_pkg->svcpart; + my $new = new FS::part_pkg { $part_pkg->hash }; + + foreach my $class ( keys %{ $taxproduct{$pkgpart} } ) { + warn "working with class '$class'\n" if $DEBUG; + my $part_pkg_taxproduct = + qsearchs( 'part_pkg_taxproduct', + { taxproduct => $taxproduct{$pkgpart}{$class}, + data_vendor => $format, + } + ); + + unless ( $part_pkg_taxproduct ) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die "failed to find part_pkg_taxproduct ($taxproduct{pkgpart}{$class})". + " for pkgpart $pkgpart\n"; + } + + if ( $class eq '' ) { + $new->taxproductnum($part_pkg_taxproduct->taxproductnum); + next; + } + + $options{"usage_taxproductnum_$class"} = + $part_pkg_taxproduct->taxproductnum; + + } + + my $error = $new->replace( $part_pkg, + 'pkg_svc' => \%pkg_svc, + 'primary_svc' => $primary_svc, + 'options' => \%options, + ); + + if ( $error ) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die $error; + } + } + + #disable tax_rates + foreach my $key (keys %disabled_tax_rate) { + my ($geocode,$taxclass) = split /:/, $key, 2; + my @tax_class = qsearch( 'tax_class', { data_vendor => $format, + taxclass => $taxclass, + } ); + if (scalar(@tax_class) > 1) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die "found multiple tax_class records for format $format class $taxclass"; + } + + unless (scalar(@tax_class)) { + warn "no tax_class for format $format class $taxclass\n"; + next; + } + + my @tax_rate = + qsearch('tax_rate', { data_vendor => $format, + geocode => $geocode, + taxclassnum => $tax_class[0]->taxclassnum, + } + ); + + if (scalar(@tax_rate) > 1) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die "found multiple tax_rate records for format $format geocode $geocode". + " and taxclass $taxclass ( taxclassnum ". $tax_class[0]->taxclassnum. + " )"; + } + + if (scalar(@tax_rate)) { + $tax_rate[0]->disabled('Y'); + my $error = $tax_rate[0]->replace; + if ( $error ) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die $error; + } + } + } + + #success! + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + +} + +=item process_download_and_update + +Download and process a tax update as a queued JSRPC job + +=cut + +sub process_download_and_update { + my $job = shift; + + my $param = thaw(decode_base64(shift)); + my $format = $param->{'format'}; #well... this is all cch specific + + my ( $count, $last, $min_sec, $imported ) = (0, time, 5, 0); #progressbar + $count = 100; + + if ( $job ) { # progress bar + my $error = $job->update_statustext( int( 100 * $imported / $count ) ); + die $error if $error; + } + + my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/taxdata'; + unless (-d $dir) { + mkdir $dir or die "can't create $dir: $!\n"; + } + + if ($format eq 'cch') { + + eval "use Text::CSV_XS;"; + die $@ if $@; + + eval "use XBase;"; + die $@ if $@; + + my $conffile = '%%%FREESIDE_CONF%%%/cchconf'; + my $conffh = new IO::File "<$conffile" or die "can't open $conffile: $!\n"; + my ( $urls, $secret, $states ) = + map { /^(.*)$/ or die "bad config line in $conffile: $_\n"; $1 } + <$conffh>; + + $dir .= '/cch'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $error = ''; + + # really should get a table EXCLUSIVE lock here + # check if initial import or update + + my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'"; + my $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + my $upgrade = $sth->fetchrow_arrayref->[0]; + + # create cache and/or rotate old tax data + + if (-d $dir) { + + if (-d "$dir.4") { + opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n"; + foreach my $file (readdir($dirh)) { + unlink "$dir.4/$file" if (-f "$dir.4/$file"); + } + closedir($dirh); + rmdir "$dir.4"; + } + + for (3, 2, 1) { + if ( -e "$dir.$_" ) { + rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n"; + } + } + rename "$dir", "$dir.1" or die "can't rename $dir: $!\n"; + + } else { + + die "can't find previous tax data\n" if $upgrade; + + } + + mkdir "$dir.new" or die "can't create $dir.new: $!\n"; + + # fetch and unpack the zip files + + my $ua = new LWP::UserAgent; + foreach my $url (split ',', $urls) { + my @name = split '/', $url; #somewhat restrictive + my $name = pop @name; + $name =~ /(.*)/; # untaint that which we trust; + $name = $1; + + open my $taxfh, ">$dir.new/$name" or die "Can't open $dir.new/$name: $!\n"; + + my $res = $ua->request( + new HTTP::Request( GET => $url), + sub { #my ($data, $response_object) = @_; + print $taxfh $_[0] or die "Can't write to $dir.new/$name: $!\n"; + my $content_length = $_[1]->content_length; + $imported += length($_[0]); + if ( time - $min_sec > $last ) { + my $error = $job->update_statustext( + ($content_length ? int(100 * $imported/$content_length) : 0 ). + ",Downloading data from CCH" + ); + die $error if $error; + $last = time; + } + }, + ); + die "download of $url failed: ". $res->status_line + unless $res->is_success; + + close $taxfh; + my $error = $job->update_statustext( "0,Unpacking data" ); + die $error if $error; + $secret =~ /(.*)/; # untaint that which we trust; + $secret = $1; + system('unzip', "-P", $secret, "-d", "$dir.new", "$dir.new/$name") == 0 + or die "unzip -P $secret -d $dir.new $dir.new/$name failed"; + #unlink "$dir.new/$name"; + } + + # extract csv files from the dbf files + + foreach my $name ( qw( code detail geocode plus4 txmatrix zip ) ) { + my $error = $job->update_statustext( "0,Unpacking $name" ); + die $error if $error; + warn "opening $dir.new/$name.dbf\n" if $DEBUG; + my $table = new XBase 'name' => "$dir.new/$name.dbf"; + die "failed to access $dir.new/$name.dbf: ". XBase->errstr + unless defined($table); + $count = $table->last_record; # approximately; + $imported = 0; + open my $csvfh, ">$dir.new/$name.txt" + or die "failed to open $dir.new/$name.txt: $!\n"; + + my $csv = new Text::CSV_XS { 'always_quote' => 1 }; + my @fields = $table->field_names; + my $cursor = $table->prepare_select; + my $format_date = + sub { my $date = shift; + $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1"); + $date; + }; + while (my $row = $cursor->fetch_hashref) { + $csv->combine( map { ($table->field_type($_) eq 'D') + ? &{$format_date}($row->{$_}) + : $row->{$_} + } + @fields + ); + print $csvfh $csv->string, "\n"; + $imported++; + if ( time - $min_sec > $last ) { + my $error = $job->update_statustext( + int(100 * $imported/$count). ",Unpacking $name" + ); + die $error if $error; + $last = time; + } + } + $table->close; + close $csvfh; + } + + # generate the diff files + + my @insert_list = (); + my @delete_list = (); + my @predelete_list = (); + + my @list = ( + 'geocode', \&FS::tax_rate_location::batch_import, + 'code', \&FS::tax_class::batch_import, + 'plus4', \&FS::cust_tax_location::batch_import, + 'zip', \&FS::cust_tax_location::batch_import, + 'txmatrix', \&FS::part_pkg_taxrate::batch_import, + 'detail', \&FS::tax_rate::batch_import, + ); + + while( scalar(@list) ) { + my ( $name, $method ) = ( shift @list, shift @list ); + my %oldlines = (); + + my $error = $job->update_statustext( "0,Comparing to previous $name" ); + die $error if $error; + + warn "processing $dir.new/$name.txt\n" if $DEBUG; + + if ($upgrade) { + open my $oldcsvfh, "$dir.1/$name.txt" + or die "failed to open $dir.1/$name.txt: $!\n"; + + while(<$oldcsvfh>) { + chomp; + $oldlines{$_} = 1; + } + close $oldcsvfh; + } + + open my $newcsvfh, "$dir.new/$name.txt" + or die "failed to open $dir.new/$name.txt: $!\n"; + + my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX", + DIR => "$dir.new", + UNLINK => 0, #meh + ) or die "can't open temp file: $!\n"; + + my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX", + DIR => "$dir.new", + UNLINK => 0, #meh + ) or die "can't open temp file: $!\n"; + + while(<$newcsvfh>) { + chomp; + if (exists($oldlines{$_})) { + $oldlines{$_} = 0; + } else { + print $ifh $_, ',"I"', "\n"; + } + } + close $newcsvfh; + + if ($name eq 'detail') { + for (keys %oldlines) { # one file for rate details + print $ifh $_, ',"D"', "\n" if $oldlines{$_}; + } + } else { + for (keys %oldlines) { + print $dfh $_, ',"D"', "\n" if $oldlines{$_}; + } + } + %oldlines = (); + + push @insert_list, $name, $ifh->filename, $method; + if ( $name eq 'geocode' ) { + unshift @predelete_list, $name, $dfh->filename, $method + unless $name eq 'detail'; + } else { + unshift @delete_list, $name, $dfh->filename, $method + unless $name eq 'detail'; + } + + close $dfh; + close $ifh; + } + + while( scalar(@predelete_list) ) { + my ($name, $file, $method) = + (shift @predelete_list, shift @predelete_list, shift @predelete_list); + + my $fmt = "$format-update"; + $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' ); + open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!"; + $error ||= + &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job); + close $fh; + #unlink $file or warn "Can't delete $file: $!"; + } + + while( scalar(@insert_list) ) { + my ($name, $file, $method) = + (shift @insert_list, shift @insert_list, shift @insert_list); + + my $fmt = "$format-update"; + $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' ); + open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!"; + $error ||= + &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job); + close $fh; + #unlink $file or warn "Can't delete $file: $!"; + } + + while( scalar(@delete_list) ) { + my ($name, $file, $method) = + (shift @delete_list, shift @delete_list, shift @delete_list); + + my $fmt = "$format-update"; + $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' ); + open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!"; + $error ||= + &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job); + close $fh; + #unlink $file or warn "Can't delete $file: $!"; + } + + if ($error) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die $error; + }else{ + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + } + + rename "$dir.new", "$dir" + or die "cch tax update processed, but can't rename $dir.new: $!\n"; + + }else{ + die "Unknown format: $format"; + } +} + =item browse_queries PARAMS Returns a list consisting of a hashref suited for use as the argument @@ -1063,6 +1656,111 @@ sub browse_queries { return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql"); } +# _upgrade_data +# +# Used by FS::Upgrade to migrate to a new database. +# +# + +sub _upgrade_data { # class method + my ($self, %opts) = @_; + my $dbh = dbh; + + warn "$me upgrading $self\n" if $DEBUG; + + my @column = qw ( tax excessrate usetax useexcessrate fee excessfee + feebase feemax ); + + if ( $dbh->{Driver}->{Name} eq 'Pg' ) { + + eval "use DBI::Const::GetInfoType;"; + die $@ if $@; + + my $major_version = 0; + $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/ + && ( $major_version = sprintf("%d", $1) ); + + if ( $major_version > 7 ) { + + # ideally this would be supported in DBIx-DBSchema and friends + + foreach my $column ( @column ) { + my $columndef = dbdef->table($self->table)->column($column); + unless ($columndef->type eq 'numeric') { + + warn "updating tax_rate column $column to numeric\n" if $DEBUG; + my $sql = "ALTER TABLE tax_rate ALTER $column TYPE numeric(14,8)"; + my $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute or die $sth->errstr; + + warn "updating h_tax_rate column $column to numeric\n" if $DEBUG; + $sql = "ALTER TABLE h_tax_rate ALTER $column TYPE numeric(14,8)"; + $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute or die $sth->errstr; + + } + } + + } elsif ( $dbh->{pg_server_version} =~ /^704/ ) { + + # ideally this would be supported in DBIx-DBSchema and friends + + foreach my $column ( @column ) { + my $columndef = dbdef->table($self->table)->column($column); + unless ($columndef->type eq 'numeric') { + + warn "updating tax_rate column $column to numeric\n" if $DEBUG; + + foreach my $table ( qw( tax_rate h_tax_rate ) ) { + + my $sql = "ALTER TABLE $table RENAME $column TO old_$column"; + my $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute or die $sth->errstr; + + my $def = dbdef->table($table)->column($column); + $def->type('numeric'); + $def->length('14,8'); + my $null = $def->null; + $def->null('NULL'); + + $sql = "ALTER TABLE $table ADD COLUMN ". $def->line($dbh); + $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute or die $sth->errstr; + + $sql = "UPDATE $table SET $column = CAST( old_$column AS numeric )"; + $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute or die $sth->errstr; + + unless ( $null eq 'NULL' ) { + $sql = "ALTER TABLE $table ALTER $column SET NOT NULL"; + $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute or die $sth->errstr; + } + + $sql = "ALTER TABLE $table DROP old_$column"; + $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute or die $sth->errstr; + + } + } + } + + } else { + + warn "WARNING: tax_rate table upgrade unsupported for this Pg version\n"; + + } + + } else { + + warn "WARNING: tax_rate table upgrade only supported for Pg 8+\n"; + + } + + ''; + +} + =back =head1 BUGS diff --git a/FS/FS/tax_rate_location.pm b/FS/FS/tax_rate_location.pm new file mode 100644 index 0000000..218ed97 --- /dev/null +++ b/FS/FS/tax_rate_location.pm @@ -0,0 +1,317 @@ +package FS::tax_rate_location; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs dbh ); +use FS::Misc qw( csv_from_fixed ); + +=head1 NAME + +FS::tax_rate_location - Object methods for tax_rate_location records + +=head1 SYNOPSIS + + use FS::tax_rate_location; + + $record = new FS::tax_rate_location \%hash; + $record = new FS::tax_rate_location { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::tax_rate_location object represents an example. FS::tax_rate_location inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item taxratelocationnum + +Primary key (assigned automatically for new tax_rate_locations) + +=item data_vendor + +The tax data vendor + +=item geocode + +A unique geographic location code provided by the data vendor + +=item city + +City + +=item county + +County + +=item state + +State + +=item disabled + +If 'Y' this record is no longer active. + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new tax rate location. To add the record to the database, see + L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +sub table { 'tax_rate_location'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +=item delete + +Delete this record from the database. + +=cut + +sub delete { + return "Can't delete tax rate locations. Set disable to 'Y' instead."; + # check that it is unused in any cust_bill_pkg_tax_location records instead? +} + +=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 + +=item check + +Checks all fields to make sure this is a valid tax rate location. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('taxratelocationnum') + || $self->ut_textn('data_vendor') + || $self->ut_alpha('geocode') + || $self->ut_textn('city') + || $self->ut_textn('county') + || $self->ut_textn('state') + || $self->ut_enum('disabled', [ '', 'Y' ]) + ; + return $error if $error; + + my $t; + $t = qsearchs( 'tax_rate_location', + { disabled => '', + ( map { $_ => $self->$_ } qw( data_vendor geocode ) ), + }, + ) + unless $self->disabled; + + $t = $self->by_key( $self->taxratelocationnum ) + if ( !$t && $self->taxratelocationnum ); + + return "geocode ". $self->geocode. " already in use for this vendor" + if ( $t && $t->taxratelocationnum != $self->taxratelocationnum ); + + return "may only be disabled" + if ( $t && scalar( grep { $t->$_ ne $self->$_ } + grep { $_ ne 'disabled' } + $self->fields + ) + ); + + $self->SUPER::check; +} + +=back + +=head1 SUBROUTINES + +=over 4 + +=item batch_import + +=cut + +sub batch_import { + my ($param, $job) = @_; + + my $fh = $param->{filehandle}; + my $format = $param->{'format'}; + + my %insert = (); + my %delete = (); + + my @fields; + my $hook; + + my @column_lengths = (); + my @column_callbacks = (); + if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) { + $format =~ s/-fixed//; + my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r }; + push @column_lengths, qw( 28 25 2 10 ); + push @column_lengths, 1 if $format eq 'cch-update'; + push @column_callbacks, $trim foreach (@column_lengths); + } + + my $line; + my ( $count, $last, $min_sec ) = (0, time, 5); #progressbar + if ( $job || scalar(@column_callbacks) ) { + my $error = + csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks); + return $error if $error; + } + + if ( $format eq 'cch' || $format eq 'cch-update' ) { + @fields = qw( city county state geocode ); + push @fields, 'actionflag' if $format eq 'cch-update'; + + $hook = sub { + my $hash = shift; + + $hash->{'data_vendor'} ='cch'; + + if (exists($hash->{'actionflag'}) && $hash->{'actionflag'} eq 'D') { + delete($hash->{actionflag}); + + $hash->{disabled} = ''; + my $tax_rate_location = qsearchs('tax_rate_location', $hash); + return "Can't find tax_rate_location to delete: ". + join(" ", map { "$_ => ". $hash->{$_} } @fields) + unless $tax_rate_location; + + $tax_rate_location->disabled('Y'); + my $error = $tax_rate_location->replace; + return $error if $error; + + delete($hash->{$_}) foreach (keys %$hash); + } + + delete($hash->{'actionflag'}); + + ''; + + }; + + } elsif ( $format eq 'extended' ) { + die "unimplemented\n"; + @fields = qw( ); + $hook = sub {}; + } else { + die "unknown format $format"; + } + + eval "use Text::CSV_XS;"; + die $@ if $@; + + my $csv = new Text::CSV_XS; + + my $imported = 0; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + while ( defined($line=<$fh>) ) { + $csv->parse($line) or do { + $dbh->rollback if $oldAutoCommit; + return "can't parse: ". $csv->error_input(); + }; + + if ( $job ) { # progress bar + if ( time - $min_sec > $last ) { + my $error = $job->update_statustext( + int( 100 * $imported / $count ) + ); + die $error if $error; + $last = time; + } + } + + my @columns = $csv->fields(); + + my %tax_rate_location = (); + foreach my $field ( @fields ) { + $tax_rate_location{$field} = shift @columns; + } + if ( scalar( @columns ) ) { + $dbh->rollback if $oldAutoCommit; + return "Unexpected trailing columns in line (wrong format?): $line"; + } + + my $error = &{$hook}(\%tax_rate_location); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + if (scalar(keys %tax_rate_location)) { #inserts only + + my $tax_rate_location = new FS::tax_rate_location( \%tax_rate_location ); + $error = $tax_rate_location->insert; + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't insert tax_rate_location for $line: $error"; + } + + } + + $imported++; + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + return "Empty file!" unless ($imported || $format eq 'cch-update'); + + ''; #no error + +} + +=head1 BUGS + +Currently somewhat specific to CCH supplied data. + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/MANIFEST b/FS/MANIFEST index 4b9fd91..f5511f0 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -13,7 +13,6 @@ bin/freeside-deloutsource bin/freeside-deloutsourceuser bin/freeside-deluser bin/freeside-email -bin/freeside-expiration-alerter bin/freeside-queued bin/freeside-radgroup bin/freeside-reexport @@ -335,8 +334,6 @@ FS/inventory_class.pm t/inventory_class.t FS/inventory_item.pm t/inventory_item.t -FS/cdr_upstream_rate.pm -t/cdr_upstream_rate.t FS/access_user.pm t/access_user.t FS/access_user_pref.pm @@ -434,3 +431,25 @@ FS/cust_location.pm t/cust_location.t FS/cust_bill_pkg_tax_location.pm t/cust_bill_pkg_tax_location.t +FS/tax_rate_location.pm +t/tax_rate_location.t +FS/cust_bill_pkg_tax_rate_location.pm +t/cust_bill_pkg_tax_rate_location.t +FS/cust_recon.pm +t/cust_recon.t +FS/part_pkg_report_option.pm +t/part_pkg_report_option.t +FS/cust_main_exemption.pm +t/cust_main_exemption.t +FS/cust_tax_adjustment.pm +t/cust_tax_adjustment.t +FS/phone_device.pm +t/phone_device.t +FS/part_device.pm +t/part_device.t +FS/cdr_termination.pm +t/cdr_termination.t +FS/cust_attachment.pm +t/cust_attachment.t +FS/cust_statement.pm +t/cust_statement.t diff --git a/FS/bin/freeside-addgroup b/FS/bin/freeside-addgroup index 7b30f7d..25c2345 100755 --- a/FS/bin/freeside-addgroup +++ b/FS/bin/freeside-addgroup @@ -24,7 +24,7 @@ my $error = $access_group->insert; die $error if $error; if ( $opt_s ) { - foreach my $rightname ( FS::AccessRight->rights ) { + foreach my $rightname ( FS::AccessRight->default_superuser_rights ) { my $access_right = new FS::access_right { 'righttype' => 'FS::access_group', 'rightobjnum' => $access_group->groupnum, diff --git a/FS/bin/freeside-apply_payments_and_credits b/FS/bin/freeside-apply_payments_and_credits new file mode 100755 index 0000000..d789c6c --- /dev/null +++ b/FS/bin/freeside-apply_payments_and_credits @@ -0,0 +1,79 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( $DEBUG ); +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::cust_main; +use DBI; + +$DEBUG = 1; + +my $user = shift or die &usage; +my $dbh = adminsuidsetup $user; + +my $unapplied_payments_sql = <<EOF; +SELECT custnum FROM cust_pay WHERE paid > + ( ( SELECT coalesce(sum(amount),0) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + + ( SELECT coalesce(sum(amount),0) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum) + ) +EOF + +my $unapplied_credits_sql = <<EOF; +SELECT custnum FROM cust_credit WHERE cust_credit.amount > + ( ( SELECT coalesce(sum(cust_credit_bill.amount),0) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + + ( SELECT coalesce(sum(cust_Credit_refund.amount),0) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum) + ) +EOF + +my %custnum = (); + +my $sth = $dbh->prepare($unapplied_payments_sql) or die $dbh->errstr; +$sth->execute or die "unapplied payment search failed: ". $sth->errstr; + +map { $custnum{$_->[0]} = 1 } @{ $sth->fetchall_arrayref }; + +$sth = $dbh->prepare($unapplied_credits_sql) or die $dbh->errstr; +$sth->execute or die "unapplied credit search failed: ". $sth->errstr; + +map { $custnum{$_->[0]} = 1 } @{ $sth->fetchall_arrayref }; + +foreach my $custnum ( keys %custnum ) { + + warn "processing customer $custnum\n" if $DEBUG; + + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or die "customer $custnum no longer exists!\n"; + + my $error = $cust_main->apply_payments_and_credits; + die $error if $error; + +} + +sub usage { + die "Usage:\n\n freeside-apply_payments_and_credits user\n"; +} + +=head1 NAME + +freeside-apply_payments_and_credits - Command line interface to apply payments and credits to invoice + +=head1 SYNOPSIS + + freeside-apply_payments_and_credits username + +=head1 DESCRIPTION + +Finds unapplied payment and credit amounts and applies them to any outstanding +uncovered invoice amounts. + +B<username> is a username added by freeside-adduser. + +=cut + + + diff --git a/FS/bin/freeside-cdr-sftp_and_import b/FS/bin/freeside-cdr-sftp_and_import new file mode 100755 index 0000000..e87698f --- /dev/null +++ b/FS/bin/freeside-cdr-sftp_and_import @@ -0,0 +1,187 @@ +#!/usr/bin/perl + +use strict; +use Getopt::Std; +use Net::SFTP::Foreign::Compat; +use Net::FTP; +use FS::UID qw(adminsuidsetup datasrc); +use FS::cdr; + +### +# parse command line +### + +use vars qw( $opt_m $opt_p $opt_r $opt_e $opt_d $opt_v ); +getopts('m:p:r:e:d:v'); + +$opt_e ||= 'csv'; +#$opt_e = ".$opt_e" unless $opt_e =~ /^\./; +$opt_e =~ s/^\.//; + +$opt_p ||= ''; + +my $user = shift or die &usage; +adminsuidsetup $user; + +# %%%FREESIDE_CACHE%%% +my $cachedir = '/usr/local/etc/freeside/cache.'. datasrc. '/cdrs'; +mkdir $cachedir unless -d $cachedir; + +my $format = shift or die &usage; + +use vars qw( $servername ); +$servername = shift or die &usage; + +### +# get the file list +### + +warn "Retrieving directory listing\n" if $opt_v; + +$opt_m = 'sftp' if !defined($opt_m); +$opt_m = lc($opt_m); + +my $ls; + +if($opt_m eq 'ftp') { + my $ls_ftp = ftp(); + + $ls = [ grep { /^$opt_p.*\.$opt_e$/i } $ls_ftp->ls ]; +} +elsif($opt_m eq 'sftp') { + my $ls_sftp = sftp(); + + $ls_sftp->setcwd($opt_r) or die "can't chdir to $opt_r\n" + if $opt_r; + + $ls = $ls_sftp->ls('.', wanted => qr/^$opt_p.*\.$opt_e$/i, + names_only => 1 ); +} +else { + die "Method '$opt_m' not supported; must be ftp or sftp\n"; +} + +### +# import each file +### + +foreach my $filename ( @$ls ) { + + warn "Downloading $filename\n" if $opt_v; + + #get the file + if($opt_m eq 'ftp') { + my $ftp = ftp(); + $ftp->get($filename, "$cachedir/$filename") + or die "Can't get $filename: ". $ftp->message . "\n"; + } + else { + my $sftp = sftp(); + $sftp->get($filename, "$cachedir/$filename") + or die "Can't get $filename: ". $sftp->error . "\n"; + } + + warn "Processing $filename\n" if $opt_v; + + my $error = FS::cdr::batch_import( { + 'file' => "$cachedir/$filename", + 'format' => $format, + 'params' => { 'cdrbatch' => $filename, }, + 'empty_ok' => 1, + } ); + die $error if $error; + + if ( $opt_d ) { + if($opt_m eq 'ftp') { + my $ftp = ftp(); + $ftp->rename($filename, "$opt_d/$filename") + or die "Can't move $filename to $opt_d: ".$ftp->message . "\n"; + } + else { + my $sftp = sftp(); + $sftp->rename($filename, "$opt_d/$filename") + or die "can't move $filename to $opt_d: ". $sftp->error . "\n"; + } + } + + unlink "$cachedir/$filename"; + +} + +### +# subs +### + +sub usage { + "Usage: \n cdr.import user format servername\n"; +} + +use vars qw( $sftp $ftp ); + +sub ftp { + return $ftp if $ftp && $ftp->pwd; + + my ($hostname, $user) = reverse split('@', $servername); + my ($user, $pass) = split(':', $user); + + my $ftp = Net::FTP->new($hostname) or die "FTP connection to '$hostname' failed."; + $ftp->login($user, $pass) or die "FTP login failed: ".$ftp->message; + $ftp->cwd($opt_r) or die "can't chdir to $opt_r\n" if $opt_r; + return $ftp; +} + +sub sftp { + + #reuse connections + return $sftp if $sftp && $sftp->cwd; + + my %sftp = ( host => $servername ); + + $sftp = Net::SFTP::Foreign->new(%sftp); + $sftp->error and die "SFTP connection failed: ". $sftp->error; + + $sftp; +} + +=head1 NAME + +cdr.sftp_and_import - Download CDR files from a remote server via SFTP + +=head1 SYNOPSIS + + cdr.sftp_and_import [ -m method ][ -p prefix ] [ -e extension ] [ -r remotefolder ] [ -d donefolder ] [ -v ] user format [sftpuser@]servername + +=head1 DESCRIPTION + +Command line tool to download CDR files from a remote server via SFTP or FTP and then +import them into the database. + +-m: transfer method (sftp or ftp), defaults to sftp + +-p: file prefix, if specified + +-e: file extension, defaults to .csv + +-r: if specified, changes into this remote folder before starting + +-d: if specified, moves files to the specified folder when done + +-v: verbose + +user: freeside username + +format: CDR format name + +[sftpuser@]servername: remote server +(or ftpuser:ftppass@servername) + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::cdr> + +=cut + +1; + diff --git a/FS/bin/freeside-check b/FS/bin/freeside-check new file mode 100644 index 0000000..9930aae --- /dev/null +++ b/FS/bin/freeside-check @@ -0,0 +1,31 @@ +#!/usr/bin/perl +#!/usr/bin/perl -w + +use strict; +use FS::UID qw( adminsuidsetup ); +use FS::Cron::check qw( + check_queued check_selfservice check_apache check_bop_failures + check_sg check_sg_login check_sgng + alert error_msg +); + +my $user = shift or die &usage; +my @emails = @ARGV; +#die "no notification email given" unless @emails; + +eval { adminsuidsetup $user }; + +if ( $@ ) { alert("Database down: $@", @emails); exit; } + +check_queued or alert('Queue daemon not running', @emails); +check_selfservice or alert(error_msg(), @emails); +check_apache or alert('Apache not running: '. error_msg(), @emails); + +#no-ops unless you are sg +my $sg = 'FS::ClientAPI::SG'; +check_sg or alert("$sg not responding: ". error_msg(), @emails); +check_sg_login or alert("$sg login errort: ". error_msg(), @emails); +check_sgng or alert("${sg}NG not responding: ". error_msg(), @emails); + +check_bop_failures or alert(error_msg(), @emails); + diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 13079b4..728fa96 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -3,10 +3,11 @@ use strict; use Getopt::Std; use FS::UID qw(adminsuidsetup); +use FS::Conf; &untaint_argv; #what it sounds like (eww) use vars qw(%opt); -getopts("p:a:d:vl:sy:nm", \%opt); +getopts("p:a:d:vl:sy:nmrkg:", \%opt); my $user = shift or die &usage; adminsuidsetup $user; @@ -14,17 +15,33 @@ adminsuidsetup $user; use FS::Cron::bill qw(bill); bill(%opt); -#what to do about the below when using -m? that is the question. +#you can skip this just by not having the config +use FS::Cron::upload qw(upload); +upload(%opt); + +# Send alerts about upcoming credit card expiration. +use FS::Cron::alert_expiration qw(alert_expiration); +my $conf = new FS::Conf; +alert_expiration(%opt) if($conf->exists('alert_expiration')); -use FS::Cron::notify qw(notify_flat_delay); -notify_flat_delay(%opt); +#what to do about the below when using -m? that is the question. +#you don't want to skip this, besides, it should be cheap use FS::Cron::expire_user_pref qw(expire_user_pref); expire_user_pref(); -use FS::Cron::vacuum qw(vacuum); -vacuum(); +unless ( $opt{k} ) { + + use FS::Cron::notify qw(notify_flat_delay); + notify_flat_delay(%opt); + + #Pg 8.1+ auto-vaccums, 7.4 w/postgresql-contrib + #use FS::Cron::vacuum qw(vacuum); + #vacuum(); +} + +#you can skip this just by not having the config use FS::Cron::backup qw(backup_scp); backup_scp(); @@ -42,7 +59,7 @@ sub untaint_argv { } sub usage { - die "Usage:\n\n freeside-daily [ -d 'date' ] user [ custnum custnum ... ]\n"; + die "Usage:\n\n freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] [ -v ] [ -l level ] [ -m ] [ -k ] user [ custnum custnum ... ]\n"; } ### @@ -55,7 +72,7 @@ freeside-daily - Run daily billing and invoice collection events. =head1 SYNOPSIS - freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] [ -v ] [ -l level ] [ -m ] user [ custnum custnum ... ] + freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] [ -v ] [ -l level ] [ -m ] [ -r ] [ -k ] user [ custnum custnum ... ] =head1 DESCRIPTION @@ -81,6 +98,9 @@ the bill and collect methods of a cust_main object. See L<FS::cust_main>. -a: Only process customers with the specified agentnum + -g: Don't process the provided pkgpart (or pkgparts, specified as a comma- + separated list). + -s: re-charge setup fees -v: enable debugging @@ -89,6 +109,10 @@ the bill and collect methods of a cust_main object. See L<FS::cust_main>. -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing. + -r: Multi-process mode dry run option + + -k: skip notify_flat_delay and vacuum + user: From the mapsecrets file - see config.html from the base documentation custnum: if one or more customer numbers are specified, only bills those diff --git a/FS/bin/freeside-expiration-alerter b/FS/bin/freeside-expiration-alerter deleted file mode 100755 index 0bb61db..0000000 --- a/FS/bin/freeside-expiration-alerter +++ /dev/null @@ -1,241 +0,0 @@ -#!/usr/bin/perl -Tw - -use strict; -use Date::Format; -use Time::Local; -use Text::Template; -use Getopt::Std; -use Net::SMTP; -use Mail::Header; -use Mail::Internet; -use FS::Conf; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch); -use FS::cust_main; - -use vars qw($smtpmachine %agent_failure_body); - -#hush, perl! -$FS::alerter::_template::first = ""; -$FS::alerter::_template::last = ""; -$FS::alerter::_template::company = ""; -$FS::alerter::_template::payby = ""; -$FS::alerter::_template::expdate = ""; - -# Set the mail program and other variables -my $mail_sender = "billing\@mydomain.tld"; # or invoice_from if available -my $failure_recipient = "postmaster"; # or invoice_from if available -my $warning_time = 30 * 24 * 60 * 60; -my $urgent_time = 15 * 24 * 60 * 60; -my $panic_time = 5 * 24 * 60 * 60; -my $window_time = 24 * 60 * 60; - -&untaint_argv; #what it sounds like (eww) - -#we're at now now (and later). -my($_date)= $^T; - -# Get the current month -my ($sec,$min,$hour,$mday,$mon,$year) = - (localtime($_date) )[0,1,2,3,4,5]; -$mon++; - -# Login to the database -my $user = shift or die &usage; -adminsuidsetup $user; - -# Get the needed configuration files -my $conf = new FS::Conf; -$smtpmachine = $conf->config('smtpmachine'); - -my(@customers)=qsearch('cust_main',{}); -if (scalar(@customers) == 0) -{ - exit 1; -} - -# Now I can start looping -foreach my $customer (@customers) -{ - my $paydate = $customer->getfield('paydate'); - next if $paydate =~ /^\s*$/; #skip empty expiration dates - - my $custnum = $customer->getfield('custnum'); - my $first = $customer->getfield('first'); - my $last = $customer->getfield('last'); - my $company = $customer->getfield('company'); - my $payby = $customer->getfield('payby'); - my $payinfo = $customer->getfield('payinfo'); - my $daytime = $customer->getfield('daytime'); - my $night = $customer->getfield('night'); - - my ($payyear,$paymonth,$payday) = split (/-/,$paydate); - - my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear); - - #credit cards expire at the end of the month/year of their exp date - if ($payby eq 'CARD' || $payby eq 'DCRD') { - ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++); - $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear); - $expire_time--; - } - - if (($expire_time < $_date + $warning_time && - $expire_time > $_date + $warning_time - $window_time) || - ($expire_time < $_date + $urgent_time && - $expire_time > $_date + $urgent_time - $window_time) || - ($expire_time < $_date + $panic_time && - $expire_time > $_date + $panic_time - $window_time)) { - - # Prepare for sending email, now inside the customer loop so i can be agent - # virtualized - - my $agentnum = $customer->agentnum; - - $mail_sender = $conf->config('invoice_from', $agentnum ) - if $conf->exists('invoice_from', $agentnum); - $failure_recipient = $conf->config('invoice_from', $agentnum) - if $conf->exists('invoice_from', $agentnum); - - $ENV{MAILADDRESS} = $mail_sender; - - my @alerter_template = $conf->config('alerter_template', $agentnum) - or die "cannot load config file alerter_template"; - - my $alerter = new Text::Template TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @alerter_template ] - or die "can't create new Text::Template object: $Text::Template::ERROR"; - - $alerter->compile() or die "can't compile template: $Text::Template::ERROR"; - - my @packages = $customer->ncancelled_pkgs; - if (scalar(@packages) != 0) { - my @invoicing_list = $customer->invoicing_list; - if ( grep { $_ ne 'POST' } @invoicing_list ) { - my $header = new Mail::Header ( [ - "From: $mail_sender", - "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), - "Sender: $mail_sender", - "Reply-To: $mail_sender", - "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: Billing Arrangement Expiration", - ] ); - $FS::alerter::_template::first = $first; - $FS::alerter::_template::last = $last; - $FS::alerter::_template::company = $company; - if ($payby eq 'CARD' || $payby eq 'DCRD') { - $FS::alerter::_template::payby = "credit card (" . - substr($payinfo, 0, 2) . "xxxxxxxxxx" . - substr($payinfo, -4) . ")"; - }elsif ($payby eq 'COMP') { - $FS::alerter::_template::payby = "complimentary account"; - }else{ - $FS::alerter::_template::payby = "current method"; - } - $FS::alerter::_template::expdate = $expire_time; - - $FS::alerter::_template::company_name = - $conf->config('company_name', $agentnum); - $FS::alerter::_template::company_address = - join("\n", $conf->config('company_address', $agentnum) ). "\n"; - - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ $alerter->fill_in( PACKAGE => 'FS::alerter::_template' ) ], - ); - $!=0; - $message->smtpsend( Host => $smtpmachine ) - or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or die "Can't send expiration email: $!"; - - } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { - push @{$agent_failure_body{$customer->agentnum}}, - sprintf(qq{%5d %-32.32s %4s %10s %12s %12s}, - $custnum, - $first . " " . $last . " " . $company, - $payby, - $paydate, - $daytime, - $night - ); - } - } - } -} - -# Now I need to send failure EMAIL - -foreach my $agentnum ( keys %agent_failure_body ) { - - $mail_sender = $conf->config('invoice_from', $agentnum ) - if $conf->exists('invoice_from', $agentnum); - $failure_recipient = $conf->config('invoice_from', $agentnum) - if $conf->exists('invoice_from', $agentnum); - - $ENV{MAILADDRESS} = $mail_sender; - my $header = new Mail::Header ( [ - "From: Account Processor", - "To: $failure_recipient", - "Sender: $mail_sender", - "Reply-To: $mail_sender", - "Subject: Unnotified Billing Arrangement Expirations", - ] ); - - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ @{$agent_failure_body{$agentnum}} ], - ); - $!=0; - $message->smtpsend( Host => $smtpmachine ) - or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or die "can't send alerter failure email to $failure_recipient". - " via server $smtpmachine with SMTP: $!"; -} - -# subroutines -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal argument \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-expiration-alerter user\n"; -} - -=head1 NAME - -freeside-expiration-alerter - Emails notifications of credit card expirations. - -=head1 SYNOPSIS - - freeside-expiration-alerter user - -=head1 DESCRIPTION - -Emails customers notice that their credit card or other billing arrangement -is about to expire. Usually run as a cron job. - -user: From the mapsecrets file - see config.html from the base documentation - -=head1 BUGS - -Yes..... Use at your own risk. No guarantees or warrantees of any -kind apply to this program. Parts of this program are hacked from -other GNU licensed software created mainly by Ivan Kohler. - -This is released under the GNU Public License. See www.gnu.org -for more information regarding this license. - -=head1 SEE ALSO - -L<FS::cust_main>, config.html from the base documentation - -=head1 AUTHOR - -Jeff Finucane <jeff@cmh.net> - -=cut - - diff --git a/FS/bin/freeside-monthly b/FS/bin/freeside-monthly index 1e41b78..a81e3e9 100755 --- a/FS/bin/freeside-monthly +++ b/FS/bin/freeside-monthly @@ -15,6 +15,9 @@ adminsuidsetup $user; use FS::Cron::bill qw(bill); bill(%opt, 'check_freq'=>'1m' ); +use FS::Cron::upload qw(upload); +upload(%opt); + ### # subroutines ### diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index d4f09c1..e97a52c 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -4,9 +4,11 @@ use strict; use vars qw( $DEBUG $kids $max_kids %kids ); use POSIX qw(:sys_wait_h); use IO::File; +use Getopt::Std; use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh myconnect); use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); -use FS::Record qw(qsearch qsearchs); +use FS::Conf; +use FS::Record qw(qsearch); use FS::queue; use FS::queue_depend; @@ -15,9 +17,12 @@ use Net::SSH 0.07; $DEBUG = 0; -$max_kids = '10'; #guess it should be a config file... $kids = 0; +&untaint_argv; #what it sounds like (eww) +use vars qw(%opt); +getopts('sn', \%opt ); + my $user = shift or die &usage; warn "starting daemonization (forking)\n" if $DEBUG; @@ -27,7 +32,6 @@ daemonize1('freeside-queued'); warn "dropping privledges\n" if $DEBUG; drop_root(); - $ENV{HOME} = (getpwuid($>))[7]; #for ssh warn "connecting to database\n" if $DEBUG; @@ -48,6 +52,9 @@ daemonize2(); #-- +my $conf = new FS::Conf; +$max_kids = $conf->config('queued-max_kids') || 10; + my $warnkids=0; while (1) { @@ -81,114 +88,135 @@ while (1) { # local $FS::UID::AutoCommit = 0; $FS::UID::AutoCommit = 0; - my $nodepend = 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. + my $nodepend = 'AND NOT EXISTS( SELECT 1 FROM queue_depend'. ' WHERE queue_depend.jobnum = queue.jobnum )'; - my $order_by = "ORDER BY jobnum ". ( driver_name eq 'mysql' - ? 'LIMIT 1 FOR UPDATE' - : 'FOR UPDATE LIMIT 1' ); + #anything with a priority goes after stuff without one + my $order_by = ' ORDER BY COALESCE(priority,0) ASC, jobnum ASC '; + + my $limit = $max_kids - $kids; + + $order_by .= ( driver_name eq 'mysql' + ? " LIMIT $limit FOR UPDATE " + : " FOR UPDATE LIMIT $limit " ); - my $job = qsearchs({ + my $hashref = { 'status' => 'new' }; + if ( $opt{'s'} ) { + $hashref->{'secure'} = 'Y'; + } elsif ( $opt{'n'} ) { + $hashref->{'secure'} = ''; + } + + my @jobs = qsearch({ 'table' => 'queue', - 'hashref' => { 'status' => 'new' }, + 'hashref' => $hashref, 'extra_sql' => $nodepend, 'order_by' => $order_by, - }) or do { - # if $oldAutoCommit { + }); + + unless ( @jobs ) { dbh->commit or do { warn "WARNING: database error, closing connection: ". dbh->errstr; undef $FS::UID::dbh; next; }; - # } sleep 1; next; - }; - - my %hash = $job->hash; - $hash{'status'} = 'locked'; - my $ljob = new FS::queue ( \%hash ); - my $error = $ljob->replace($job); - if ( $error ) { - warn "WARNING: database error locking job, closing connection: ". - dbh->errstr; - undef $FS::UID::dbh; - next; } - # if $oldAutoCommit { - dbh->commit or do { - warn "WARNING: database error, closing connection: ". dbh->errstr; - undef $FS::UID::dbh; - next; - }; - # } - - $FS::UID::AutoCommit = 1; - #} - - my @args = $ljob->args; - splice @args, 0, 1, $ljob if $args[0] eq '_JOB'; + foreach my $job ( @jobs ) { - defined( my $pid = fork ) or do { - warn "WARNING: can't fork: $!\n"; my %hash = $job->hash; - $hash{'status'} = 'failed'; - $hash{'statustext'} = "[freeside-queued] can't fork: $!"; + $hash{'status'} = 'locked'; my $ljob = new FS::queue ( \%hash ); my $error = $ljob->replace($job); - die $error if $error; - next; #don't increment the kid counter - }; - - if ( $pid ) { - $kids++; - $kids{$pid} = 1; - } else { #kid time - - #get new db handle - $FS::UID::dbh->{InactiveDestroy} = 1; - - forksuidsetup($user); - - #auto-use classes... - #if ( $ljob->job =~ /(FS::part_export::\w+)::/ ) { - if ( $ljob->job =~ /(FS::(part_export|cust_main)::\w+)::/ - || $ljob->job =~ /(FS::\w+)::/ - ) - { - my $class = $1; - eval "use $class;"; + if ( $error ) { + warn "WARNING: database error locking job, closing connection: ". + dbh->errstr; + undef $FS::UID::dbh; + next; + } + + dbh->commit or do { + warn "WARNING: database error, closing connection: ". dbh->errstr; + undef $FS::UID::dbh; + next; + }; + + $FS::UID::AutoCommit = 1; + + my @args = $ljob->args; + splice @args, 0, 1, $ljob if $args[0] eq '_JOB'; + + defined( my $pid = fork ) or do { + warn "WARNING: can't fork: $!\n"; + my %hash = $job->hash; + $hash{'status'} = 'failed'; + $hash{'statustext'} = "[freeside-queued] can't fork: $!"; + my $ljob = new FS::queue ( \%hash ); + my $error = $ljob->replace($job); + die $error if $error; + next; #don't increment the kid counter + }; + + if ( $pid ) { + $kids++; + $kids{$pid} = 1; + } else { #kid time + + #get new db handle + $FS::UID::dbh->{InactiveDestroy} = 1; + + forksuidsetup($user); + + dbh->{'private_profile'} = {} if UNIVERSAL::can(dbh, 'sprintProfile'); + + #auto-use classes... + if ( $ljob->job =~ /(FS::(part_export|cust_main)::\w+)::/ + || $ljob->job =~ /(FS::\w+)::/ + ) + { + my $class = $1; + eval "use $class;"; + if ( $@ ) { + warn "job use $class failed"; + my %hash = $ljob->hash; + $hash{'status'} = 'failed'; + $hash{'statustext'} = $@; + my $fjob = new FS::queue( \%hash ); + my $error = $fjob->replace($ljob); + die $error if $error; + exit; #end-of-kid + }; + } + + my $eval = "&". $ljob->job. '(@args);'; + warn 'running "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG; + eval $eval; #throw away return value? suppose so if ( $@ ) { - warn "job use $class failed"; + warn "job $eval failed"; my %hash = $ljob->hash; $hash{'status'} = 'failed'; $hash{'statustext'} = $@; my $fjob = new FS::queue( \%hash ); my $error = $fjob->replace($ljob); die $error if $error; - exit; #end-of-kid - }; - } - - my $eval = "&". $ljob->job. '(@args);'; - warn 'running "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG; - eval $eval; #throw away return value? suppose so - if ( $@ ) { - warn "job $eval failed"; - my %hash = $ljob->hash; - $hash{'status'} = 'failed'; - $hash{'statustext'} = $@; - my $fjob = new FS::queue( \%hash ); - my $error = $fjob->replace($ljob); - die $error if $error; - } else { - $ljob->delete; + } else { + $ljob->delete; + } + + if ( UNIVERSAL::can(dbh, 'sprintProfile') ) { + open(PROFILE,">%%%FREESIDE_LOG%%%/queueprofile.$$.".time) + or die "can't open profile file: $!"; + print PROFILE dbh->sprintProfile(); + close PROFILE or die "can't close profile file: $!"; + } + + exit; + #end-of-kid } - exit; - #end-of-kid - } + } #foreach my $job } continue { if ( sigterm() ) { @@ -201,6 +229,15 @@ while (1) { } } +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + # Date::Parse + $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + sub usage { die "Usage:\n\n freeside-queued user\n"; } @@ -221,12 +258,16 @@ freeside-queued - Job queue daemon =head1 SYNOPSIS - freeside-queued user + freeside-queued [ -s | -n ] user =head1 DESCRIPTION Job queue daemon. Should be running at all times. +-s: "secure" jobs only (queued billing jobs) + +-n: non-"secure" jobs only (other jobs) + user: from the mapsecrets file - see config.html from the base documentation =head1 VERSION diff --git a/FS/bin/freeside-selfservice-server b/FS/bin/freeside-selfservice-server index 2087e71..544f307 100644 --- a/FS/bin/freeside-selfservice-server +++ b/FS/bin/freeside-selfservice-server @@ -15,9 +15,11 @@ use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); use FS::UID qw(adminsuidsetup forksuidsetup); use FS::ClientAPI; use FS::ClientAPI_SessionCache; +use FS::Record qw( qsearch qsearchs ); use FS::Conf; use FS::cust_svc; +use FS::agent; $FREESIDE_LOG = "%%%FREESIDE_LOG%%%"; $FREESIDE_LOCK = "%%%FREESIDE_LOCK%%%"; @@ -97,7 +99,28 @@ while (1) { if ( $keepalives && $keepalive_count++ > 10 ) { $keepalive_count = 0; lock_write; + nstore_fd( { _token => '_keepalive' }, $writer ); + foreach my $agent ( qsearch( 'agent', { disabled => '' } ) ) { + my $config = qsearchs( 'conf', { name => 'selfservice-bulk_ftp_dir', + agentnum => $agent->agentnum, + } ) + or next; + + my $session = + FS::ClientAPI->dispatch( 'Agent/agent_login', + { username => $agent->username, + password => $agent->_password, + } + ); + + nstore_fd( { _token => '_ftp_scan', + dir => $config->value, + session_id => $session->{session_id}, + }, + $writer + ); + } unlock_write; } next; diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset index 7d1d343..a77bad6 100755 --- a/FS/bin/freeside-sqlradius-reset +++ b/FS/bin/freeside-sqlradius-reset @@ -42,6 +42,10 @@ unless ( $opt_n ) { } } +use FS::svc_Common; +$FS::svc_Common::overlimit_missing_cust_svc_nonfatal_kludge = 1; +$FS::svc_Common::overlimit_missing_cust_svc_nonfatal_kludge = 1; + foreach my $export ( @exports ) { #my @svcparts = map { $_->svcpart } $export->export_svc; @@ -49,14 +53,25 @@ foreach my $export ( @exports ) { my @svc_x = map { $_->svc_x } - map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } - grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + #map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + #grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + # $export->export_svc; + map { @{ $_->[1] } } + grep { scalar( @{ $_->[1] } ) } + map { [ $_, [ qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) ] ] } $export->export_svc; + foreach my $svc_x ( @svc_x ) { - $svc_x->check; #set any fixed usergroup so it'll export even if all - #svc_acct records don't have the group yet + #$svc_x->check; #set any fixed usergroup so it'll export even if all + # #svc_acct records don't have the group yet + #more efficient? + my $x = $svc_x->setfixed( $svc_x->_fieldhandlers); + unless ( ref($x) ) { + warn "WARNING: can't set fixed usergroups for svcnum ". $svc_x->svcnum. + "\n"; + } if ($overlimit_groups && $svc_x->overlimit) { $svc_x->usergroup( &{ $svc_x->_fieldhandlers->{'usergroup'} } diff --git a/FS/bin/freeside-upgrade b/FS/bin/freeside-upgrade index c988e13..6ced372 100755 --- a/FS/bin/freeside-upgrade +++ b/FS/bin/freeside-upgrade @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use strict; -use vars qw($opt_d $opt_s $opt_q $opt_v); +use vars qw($opt_d $opt_s $opt_q $opt_v $opt_r); use vars qw($DEBUG $DRY_RUN); use Getopt::Std; use DBIx::DBSchema 0.31; @@ -17,7 +17,7 @@ my $start = time; die "Not running uid freeside!" unless checkeuid(); -getopts("dqs"); +getopts("dqrs"); $DEBUG = !$opt_q; #$DEBUG = $opt_v; @@ -60,20 +60,24 @@ if (dbdef->table('cust_main')->column('agent_custid') && ! $opt_s) { #from 1.3 to 1.4... if not, it needs to be hooked into -upgrade here or #you'll lose all the part_svc settings it migrates to part_svc_column +my @statements = + grep { $_ !~ /^CREATE +INDEX +h_queue/ } #useless, holds up queue insertion + dbdef->sql_update_schema( dbdef_dist(datasrc), $dbh ); + if ( $DRY_RUN ) { print - join(";\n", @bugfix, dbdef->sql_update_schema( dbdef_dist(datasrc), $dbh ) ). ";\n"; + join(";\n", @bugfix, @statements ). ";\n"; exit; } else { - foreach my $statement ( @bugfix ) { + foreach my $statement ( @bugfix, @statements ) { $dbh->do( $statement ) or die "Error: ". $dbh->errstr. "\n executing: $statement"; } - warn "Pre-schema change upgrades completed in ". (time-$start). " seconds\n"; # if $DEBUG; - $start = time; +# warn "Pre-schema change upgrades completed in ". (time-$start). " seconds\n"; # if $DEBUG; +# $start = time; - dbdef->update_schema( dbdef_dist(datasrc), $dbh ); +# dbdef->update_schema( dbdef_dist(datasrc), $dbh ); } warn "Schema upgrade completed in ". (time-$start). " seconds\n"; # if $DEBUG; @@ -127,7 +131,7 @@ $FS::UID::AutoCommit = 0; $FS::UID::callback_hack = 1; $dbh = adminsuidsetup($user); $FS::UID::callback_hack = 0; -unless ( $DRY_RUN ) { +unless ( $DRY_RUN || $opt_s ) { my $dir = "%%%FREESIDE_CONF%%%/conf.". datasrc; if (!scalar(qsearch('conf', {}))) { my $error = FS::Conf::init_config($dir); @@ -149,11 +153,13 @@ $start = time; upgrade() unless $DRY_RUN || $opt_s; +$dbh->commit or die $dbh->errstr; + warn "Table updates completed in ". (time-$start). " seconds\n"; # if $DEBUG; $start = time; upgrade_sqlradius() - unless $DRY_RUN || $opt_s; + unless $DRY_RUN || $opt_s || $opt_r; warn "SQL RADIUS updates completed in ". (time-$start). " seconds\n"; # if $DEBUG; $start = time; @@ -161,7 +167,7 @@ $start = time; $dbh->commit or die $dbh->errstr; $dbh->disconnect or die $dbh->errstr; -warn "Commit and disconnection completed in ". (time-$start). " seconds; upgrade done!\n"; # if $DEBUG; +warn "Final commit and disconnection completed in ". (time-$start). " seconds; upgrade done!\n"; # if $DEBUG; ### @@ -172,7 +178,7 @@ sub dbdef_create { # reverse engineer the schema from the DB and save to file } sub usage { - die "Usage:\n freeside-upgrade [ -d ] [ -s ] [ -q | -v ] user\n"; + die "Usage:\n freeside-upgrade [ -d ] [ -r ] [ -s ] [ -q | -v ] user\n"; } =head1 NAME @@ -181,7 +187,7 @@ freeside-upgrade - Upgrades database schema for new freeside verisons. =head1 SYNOPSIS - freeside-upgrade [ -d ] [ -s ] [ -q | -v ] + freeside-upgrade [ -d ] [ -r ] [ -s ] [ -q | -v ] =head1 DESCRIPTION @@ -203,6 +209,9 @@ Also performs other upgrade functions: [ -q ]: Run quietly. This may become the default at some point. + [ -r ]: Skip sqlradius updates. Useful for occassions where the sqlradius + databases may be inaccessible. + [ -v ]: Run verbosely, sending debugging information to STDERR. This is the current default. diff --git a/FS/bin/freeside-void-payments b/FS/bin/freeside-void-payments new file mode 100755 index 0000000..412033c --- /dev/null +++ b/FS/bin/freeside-void-payments @@ -0,0 +1,222 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( $user $cust_main @customers ); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::Conf; +use FS::cust_main; +use FS::cust_pay; +use FS::cust_pay_void; +use Business::OnlinePayment; # For retrieving the void list only. +use Time::Local; +use Date::Parse 'str2time'; +use Date::Format 'time2str'; + +my %opt; +getopts("r:f:ca:g:s:e:vnX:", \%opt); + +$user = shift or die &usage; +&adminsuidsetup( $user ); + +# The -g and -a options need to override this. +my $method = $opt{'c'} ? 'ECHECK' : 'CARD'; +my $gateway; +if($opt{'g'}) { + $gateway = FS::payment_gateway->by_key($opt{'g'}) + or die "Payment gateway not found: '".$opt{'g'}."'."; +} +elsif($opt{'a'}) { + my $agent = FS::agent->by_key($opt{'a'}) + or die "Agent not found: '".$opt{'a'}."'."; + $gateway = $agent->payment_gateway(method => $method) + or die "Agent has no payment gateway for method '$method'."; +} + +if(defined($opt{'X'})) { + die "Cancellation reason not found: '".$opt{'X'}."'" + if(! qsearchs('reason', { reasonnum => $opt{'X'} } ) ); +} + +my ($processor, $login, $password, $action, @bop_options) = + FS::cust_main->default_payment_gateway($method); +my $gatewaynum = ''; + +if($gateway) { +# override the default gateway + $gatewaynum = $gateway->gatewaynum . '-' if $gateway->gatewaynum; + $processor = $gateway->gateway_module; + $login = $gateway->gateway_username; + $password = $gateway->gateway_password; + $action = $gateway->gateway_action; + @bop_options = $gateway->options; +} + +my @auths; +if($opt{'f'}) { +# Read the list of authorization numbers from a file. + my $in; + open($in, '< '. $opt{'f'}) or die "Unable to open file: '".$opt{'f'}."'."; + @auths = grep /^\d+$/, <$in>; + chomp @auths; +} +else { +# Get the list from the processor. This requires the processor module to +# support get_returns. + my $transaction = new Business::OnlinePayment ( $processor, @bop_options ); + if(! $transaction->can('get_returns')) { + die "'$processor' does not provide an automated void list."; + } + my @local = localtime; +# Start and end dates for this can be set via -s and -e. If they're not, +# end defaults to midnight today and start defaults to one day before end. + my $end = defined($opt{'e'}) ? + str2time($opt{'e'}) : timelocal(0, 0, 0, @local[3,4,5]); + my $start = defined($opt{'s'}) ? + str2time($opt{'s'}) : $end - 86400; + die "Invalid date range: '$start'-'$end'" if not ($start and $end); + $transaction->content ( + login => $login, + password => $password, + start => time2str("%Y-%m-%d",$start), + end => time2str("%Y-%m-%d",$end), + ); + @auths = $transaction->get_returns; +} + +$opt{'r'} ||= 'freeside-void-payments'; +my $success = 0; +my $notfound = 0; +my $canceled = 0; +print "Voiding ".scalar(@auths)." transactions:\n" if $opt{'v'}; +foreach my $authnum (@auths) { + my $paybatch = $gatewaynum . $processor . ':' . $authnum; + my $cust_pay = qsearchs('cust_pay', { paybatch => $paybatch } ); + my $error; + my $cancel_error; + if($cust_pay) { + $error = $cust_pay->void($opt{'r'}); + $success++ if not $error; + if($opt{'X'} and not $error) { + $cancel_error = join(';',$cust_pay->cust_main->cancel('reason' => $opt{'X'})); + $canceled++ if !$cancel_error; + } + } + else { + my $cpv = qsearchs('cust_pay_void', { paybatch => $paybatch }); + if($cpv) { + $error = 'already voided '.time2str('%Y-%m-%d', $cpv->void_date) . + ' by ' . $cpv->otaker; + } + else { + $error = 'not found'; + $notfound++; + } + } + if($opt{'v'}) { + print $authnum; + if($error) { + print "\t($error)"; + } + elsif($opt{'X'}) { + print "\t(canceled service)" if !$cancel_error; + print "\n\t(cancellation failed: $cancel_error)" if $cancel_error; + } + print "\n"; + } +} + +if($opt{'v'}) { + print scalar(@auths)." transactions: $success voided, $notfound not found\n"; + print "$canceled customer".($canceled == 1 ? '' : 's')." canceled\n" if $opt{'X'}; +} + +sub usage { + die "Usage:\n\n freeside-void-payments [ -f file | [ -s start-date ] [ -e end-date ] ] [ -r 'reason' ] [ -g gatewaynum | -a agentnum ] [ -c ] [ -v ] [ -n ] [-X reasonnum ] user\n"; +} + +__END__ + +# Documentation + +=head1 NAME + +freeside-void-payments - Automatically void a list of returned payments. + +=head1 SYNOPSIS + + freeside-void-payments [ -f file | [ -s start-date ] [ -e end-date ] ] [ -r 'reason' ] [ -g gatewaynum | -a agentnum ] [ -c ] [ -v ] [ -n ] user + +=head1 DESCRIPTION + +Voids payments that were returned by the payment processor. Can be +run periodically from crontab or manually after receiving a list of +returned payments. Normally this is a meaningful operation only for +electronic checks. + +This script voids payments based on the combination of gateway (see +L<FS::payment_gateway>) and authorization number, since this is +generally how the processor will identify them later. + + -f: Read the list of authorization numbers from the specified file. + If they are not from the default payment gateway, -g or -a + must be given to identify the gateway. + + If -f is not given, the script will attempt to contact the gateway + and download a list of returned transactions. To support this, + the Business::OnlinePayment module for the processor must implement + the I<get_returns()> method. For an example, see + L<Business::OnlinePayment::WesternACH>. + + -s, -e: Specify the starting and ending dates for the void list. + This has no effect if -f is given. The end date defaults to + today, and the start date defaults to one day before the end date. + + -r: The reason for voiding the payments, to be stored in the database. + + -g: The L<FS::payment_gateway> number for the gateway that handled + these payments. If -f is not given, this determines which + gateway will be contacted. This overrides -a. + + -a: The agentnum whose default gateway will be used. If neither -a + nor -g is given, the system default gateway will be used. + + -c: Use the default gateway for check transactions rather than + credit cards. + + -v: Be verbose. + + -X: Automatically cancel all packages belonging to customers whose payments + were returned. Requires a cancellation reasonnum (from L<FS::reason>). + +A warning will be emitted for each transaction that can't be found. +This may happen if it's already been voided, or if the gateway +doesn't match. + +=head1 EXAMPLE + +Given 'returns.txt', which contains one authorization number on each +line, provided by your default e-check processor: + + freeside-void-payments -f returns.txt -c -r 'Returned check' + +If your default processor is Western ACH, which supports automated +returns processing, this voids all returned payments since 2009-06-01: + + freeside-void-payments -r 'Returned check' -s 2009-06-01 + +This, in your crontab, will void returned payments for the last +day at 8:30 every morning: + + 30 8 * * * /usr/local/bin/freeside-void-payments -r 'Returned check' + +=head1 BUGS + +Most payment gateways don't support it, making the script largely useless. + +=head1 SEE ALSO + +L<Business::OnlinePayment>, L<FS::cust_pay> + +=cut diff --git a/FS/t/cdr_upstream_rate.t b/FS/t/cdr_termination.t index f9458c5..7167bf2 100644 --- a/FS/t/cdr_upstream_rate.t +++ b/FS/t/cdr_termination.t @@ -1,5 +1,5 @@ BEGIN { $| = 1; print "1..1\n" } END {print "not ok 1\n" unless $loaded;} -use FS::cdr_upstream_rate; +use FS::cdr_termination; $loaded=1; print "ok 1\n"; diff --git a/FS/t/cust_attachment.t b/FS/t/cust_attachment.t new file mode 100644 index 0000000..5986204 --- /dev/null +++ b/FS/t/cust_attachment.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_attachment; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_bill_pkg_tax_rate_location.t b/FS/t/cust_bill_pkg_tax_rate_location.t new file mode 100644 index 0000000..3250db9 --- /dev/null +++ b/FS/t/cust_bill_pkg_tax_rate_location.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_bill_pkg_tax_rate_location; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_main_exemption.t b/FS/t/cust_main_exemption.t new file mode 100644 index 0000000..fec6d19 --- /dev/null +++ b/FS/t/cust_main_exemption.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_main_exemption; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_recon.t b/FS/t/cust_recon.t new file mode 100644 index 0000000..3724736 --- /dev/null +++ b/FS/t/cust_recon.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_recon; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_statement.t b/FS/t/cust_statement.t new file mode 100644 index 0000000..c57d94c --- /dev/null +++ b/FS/t/cust_statement.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_statement; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_tax_adjustment.t b/FS/t/cust_tax_adjustment.t new file mode 100644 index 0000000..cc5719a --- /dev/null +++ b/FS/t/cust_tax_adjustment.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_tax_adjustment; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_device.t b/FS/t/part_device.t new file mode 100644 index 0000000..5696868 --- /dev/null +++ b/FS/t/part_device.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_device; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg_report_option.t b/FS/t/part_pkg_report_option.t new file mode 100644 index 0000000..622bb38 --- /dev/null +++ b/FS/t/part_pkg_report_option.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg_report_option; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/phone_device.t b/FS/t/phone_device.t new file mode 100644 index 0000000..3070314 --- /dev/null +++ b/FS/t/phone_device.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::phone_device; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/tax_rate_location.t b/FS/t/tax_rate_location.t new file mode 100644 index 0000000..f4ee910 --- /dev/null +++ b/FS/t/tax_rate_location.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::tax_rate_location; +$loaded=1; +print "ok 1\n"; |