diff options
Diffstat (limited to 'FS')
246 files changed, 19831 insertions, 4777 deletions
@@ -3,7 +3,7 @@ package FS; use strict; use vars qw($VERSION); -$VERSION = '3.0git'; +$VERSION = '4.0git'; #find missing entries in this file with: # for a in `ls *pm | cut -d. -f1`; do grep 'L<FS::'$a'>' ../FS.pm >/dev/null || echo "missing $a" ; done @@ -87,6 +87,8 @@ L<FS::payinfo_Mixin> - Mixin class for records in tables that contain payinfo. L<FS::access_user> - Employees / internal users +L<FS::access_user_session> - Access sessions + L<FS::access_user_pref> - Employee preferences L<FS::access_group> - Employee groups @@ -208,6 +210,8 @@ L<FS::svc_cert> - Certificate service class L<FS::svc_dish> - Dish network service class +L<FS::svc_cable> - Cable service class + L<FS::inventory_class> - Inventory classes L<FS::inventory_item> - Inventory items @@ -231,6 +235,12 @@ L<FS::pkg_class> - Package class class L<FS::part_pkg> - Package definition class +L<FS::part_pkg_msgcat> - Package definition localization class + +L<FS::part_pkg_currency> - Package definition local currency prices + +L<FS::currency_exchange> - Currency exchange rates + L<FS::part_pkg_link> - Package definition link class L<FS::part_pkg_taxclass> - Tax class class @@ -270,6 +280,8 @@ L<FS::sales> - Sales person class L<FS::agent> - Agent (reseller) class +L<FS::agent_currency> - Agent (reseller) currency class + L<FS::agent_pkg_class> - Agent (reseller) package class commission class L<FS::agent_type> - Agent type class diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index b38c2671d..3f6073e14 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -118,7 +118,6 @@ tie my %rights, 'Tie::IxHash', 'Complimentary customer', #aka users-allow_comp 'Merge customer', 'Merge customer across agents', - { 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 'Bill customer now', #NEW 'Bulk send customer notices', #NEW { rightname=>'View customers of all agents', global=>1 }, @@ -132,6 +131,7 @@ tie my %rights, 'Tie::IxHash', 'Order customer package', 'One-time charge', 'Change customer package', + 'Detach customer package', 'Bulk change customer packages', 'Edit customer package dates', 'Discount customer package', #NEW @@ -159,9 +159,11 @@ tie my %rights, 'Tie::IxHash', 'View customer services', #NEW 'Provision customer service', 'Bulk provision customer service', + 'Bulk move customer services', #NEWNEW 'Recharge customer service', #NEW 'Unprovision customer service', 'Change customer service', #NEWNEW + 'Edit password', 'Edit usage', #NEW 'Edit home dir', #NEW 'Edit www config', #NEW @@ -182,6 +184,7 @@ tie my %rights, 'Tie::IxHash', 'Unvoid invoices', 'Delete invoices', 'View customer tax exemptions', #yow + 'Edit customer tax exemptions', #NEWNEW 'Add customer tax adjustment', #new, but no need to phase in 'View customer batched payments', #NEW 'View customer pending payments', #NEW @@ -212,6 +215,7 @@ tie my %rights, 'Tie::IxHash', ### 'Customer credit and refund rights' => [ 'Post credit', + 'Credit line items', #NEWNEWNEW 'Apply credit', #NEWNEW { rightname=>'Unapply credit', desc=>'Enable "unapplication" of unclosed credits.' }, #aka unapplycredits { rightname=>'Delete credit', desc=>'Enable deletion of unclosed credits. Be very careful! Only delete credits that were data-entry errors, not adjustments.' }, #aka. deletecredits Optionally specify one or more comma-separated email addresses to be notified when a credit is deleted. @@ -277,6 +281,7 @@ tie my %rights, 'Tie::IxHash', 'Financial reports', { rightname=> 'List inventory', global=>1 }, { rightname=>'View email logs', global=>1 }, + { rightname=>'View system logs' }, 'Download report data', 'Services: Accounts', @@ -288,10 +293,12 @@ tie my %rights, 'Tie::IxHash', 'Services: Wireless broadband services', 'Services: Wireless broadband services: Advanced search', 'Services: DSLs', + 'Services: Cable subscribers', 'Services: Dish services', 'Services: Hardware', 'Services: Hardware: Advanced search', 'Services: Phone numbers', + 'Services: Phone numbers: Advanced search', 'Services: PBXs', 'Services: Ports', 'Services: Mailing lists', @@ -300,6 +307,8 @@ tie my %rights, 'Tie::IxHash', 'Usage: Call Detail Records (CDRs)', 'Usage: Unrateable CDRs', 'Usage: Time worked', + { rightname=>'Employees: Commission Report', global=>1 }, + { rightname=>'Employees: Audit Report', global=>1 }, #{ rightname => 'List customers of all agents', global=>1 }, ], @@ -338,6 +347,8 @@ tie my %rights, 'Tie::IxHash', 'Edit package definitions', { rightname=>'Edit global package definitions', global=>1 }, + 'Bulk edit package definitions', + 'Edit billing events', { rightname=>'Edit global billing events', global=>1 }, @@ -393,7 +404,6 @@ Most (but not all) right names. sub default_superuser_rights { my $class = shift; my %omit = map { $_=>1 } ( - 'Delete customer', 'Delete invoices', 'Delete payment', 'Delete credit', #? diff --git a/FS/FS/Auth.pm b/FS/FS/Auth.pm new file mode 100644 index 000000000..543978e8b --- /dev/null +++ b/FS/FS/Auth.pm @@ -0,0 +1,25 @@ +package FS::Auth; + +use strict; +use FS::Conf; + +sub authenticate { + my $class = shift; + + $class->auth_class->authenticate(@_); +} + +sub auth_class { + #my($class) = @_; + + my $conf = new FS::Conf; + my $module = lc($conf->config('authentication_module')) || 'internal'; + + my $auth_class = 'FS::Auth::'.$module; + eval "use $auth_class;"; + die $@ if $@; + + $auth_class; +} + +1; diff --git a/FS/FS/Auth/external.pm b/FS/FS/Auth/external.pm new file mode 100644 index 000000000..51f1f0496 --- /dev/null +++ b/FS/FS/Auth/external.pm @@ -0,0 +1,9 @@ +package FS::Auth::external; +#use base qw( FS::Auth ); + +use strict; + +sub autocreate { 1; } + +1; + diff --git a/FS/FS/Auth/internal.pm b/FS/FS/Auth/internal.pm new file mode 100644 index 000000000..f6d1a0086 --- /dev/null +++ b/FS/FS/Auth/internal.pm @@ -0,0 +1,78 @@ +package FS::Auth::internal; +#use base qw( FS::Auth ); + +use strict; +use Crypt::Eksblowfish::Bcrypt qw(bcrypt_hash en_base64 de_base64); +use FS::Record qw( qsearchs ); +use FS::access_user; + +sub authenticate { + my($self, $username, $check_password ) = @_; + + my $access_user = + ref($username) ? $username + : qsearchs('access_user', { 'username' => $username, + 'disabled' => '', + } + ) + or return 0; + + if ( $access_user->_password_encoding eq 'bcrypt' ) { + + my( $cost, $salt, $hash ) = split(',', $access_user->_password); + + my $check_hash = en_base64( bcrypt_hash( { key_nul => 1, + cost => $cost, + salt => de_base64($salt), + }, + $check_password + ) + ); + + $hash eq $check_hash; + + } else { + + return 0 if $access_user->_password eq 'notyet' + || $access_user->_password eq ''; + + $access_user->_password eq $check_password; + + } + +} + +sub autocreate { 0; } + +sub change_password { + my($self, $access_user, $new_password) = @_; + + $self->change_password_fields( $access_user, $new_password ); + + $access_user->replace; + +} + +sub change_password_fields { + my($self, $access_user, $new_password) = @_; + + $access_user->_password_encoding('bcrypt'); + + my $cost = 8; + + my $salt = pack( 'C*', map int(rand(256)), 1..16 ); + + my $hash = bcrypt_hash( { key_nul => 1, + cost => $cost, + salt => $salt, + }, + $new_password, + ); + + $access_user->_password( + join(',', $cost, en_base64($salt), en_base64($hash) ) + ); + +} + +1; diff --git a/FS/FS/Auth/legacy.pm b/FS/FS/Auth/legacy.pm new file mode 100644 index 000000000..1133197bc --- /dev/null +++ b/FS/FS/Auth/legacy.pm @@ -0,0 +1,27 @@ +package FS::Auth::legacy; +#use base qw( FS::Auth ); #::internal ? + +use strict; +use Apache::Htpasswd; + +#substitute in? we're trying to make it go away... +my $htpasswd_file = '/usr/local/etc/freeside/htpasswd'; + +sub authenticate { + my($self, $username, $check_password ) = @_; + + Apache::Htpasswd->new( { passwdFile => $htpasswd_file, + ReadOnly => 1, + } + )->htCheckPassword($username, $check_password); +} + +sub autocreate { 0; } + +#don't support this in legacy? change in both htpasswd and database like 3.x +# for easier transitioning? hoping its really only me+employees that have a +# mismatch in htpasswd vs access_user, so maybe that's not necessary +#sub change_password { +#} + +1; diff --git a/FS/FS/AuthCookieHandler.pm b/FS/FS/AuthCookieHandler.pm new file mode 100644 index 000000000..b571e4705 --- /dev/null +++ b/FS/FS/AuthCookieHandler.pm @@ -0,0 +1,46 @@ +package FS::AuthCookieHandler; +use base qw( Apache2::AuthCookie ); + +use strict; +use FS::UID qw( adminsuidsetup preuser_setup ); +use FS::CurrentUser; +use FS::Auth; + +sub authen_cred { + my( $self, $r, $username, $password ) = @_; + + preuser_setup(); + + my $info = {}; + + unless ( FS::Auth->authenticate($username, $password, $info) ) { + warn "failed auth $username from ". $r->connection->remote_ip. "\n"; + return undef; + } + + warn "authenticated $username from ". $r->connection->remote_ip. "\n"; + + FS::CurrentUser->load_user( $username, + 'autocreate' => FS::Auth->auth_class->autocreate, + %$info, + ); + + FS::CurrentUser->new_session; +} + +sub authen_ses_key { + my( $self, $r, $sessionkey ) = @_; + + preuser_setup(); + + my $curuser = FS::CurrentUser->load_user_session( $sessionkey ); + + unless ( $curuser ) { + warn "bad session $sessionkey from ". $r->connection->remote_ip. "\n"; + return undef; + } + + $curuser->username; +} + +1; diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index 972625ff6..5ac31dbec 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -6,7 +6,7 @@ use Exporter; use CGI; use URI::URL; #use CGI::Carp qw(fatalsToBrowser); -use FS::UID; +use FS::UID qw( cgi ); @ISA = qw(Exporter); @EXPORT_OK = qw( header menubar idiot eidiot popurl rooturl table itable ntable @@ -232,7 +232,7 @@ sub rooturl { $url_string = shift; } else { # better to start with the client-provided URL - my $cgi = &FS::UID::cgi; + my $cgi = cgi; $url_string = $cgi->isa('Apache') ? $cgi->uri : $cgi->url; } @@ -244,7 +244,7 @@ sub rooturl { $url_string =~ s{ / - (browse|config|docs|edit|graph|misc|search|view|pref|elements|rt|torrus) + (browse|config|docs|edit|graph|misc|search|view|loginout|pref|elements|rt|torrus) (/process)? ([\w\-\.\/]*) $ diff --git a/FS/FS/ClientAPI/Bulk.pm b/FS/FS/ClientAPI/Bulk.pm deleted file mode 100644 index ec617df76..000000000 --- a/FS/FS/ClientAPI/Bulk.pm +++ /dev/null @@ -1,384 +0,0 @@ -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/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 3f7c00432..77a4683e5 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -45,12 +45,12 @@ use FS::payby; use FS::acct_rt_transaction; use FS::msg_template; -$DEBUG = 0; +$DEBUG = 1; $me = '[FS::ClientAPI::MyAccount]'; use vars qw( @cust_main_editable_fields @location_editable_fields ); @cust_main_editable_fields = qw( - first last daytime night fax mobile + first last company daytime night fax mobile locale payby payinfo payname paystart_month paystart_year payissue payip ss paytype paystate stateid stateid_state @@ -121,6 +121,7 @@ sub skin_info { font title_color title_align title_size menu_bgcolor menu_fontsize ) ), + 'menu_disable' => [ $conf->config('selfservice-menu_disable',$agentnum) ], ( map { $_ => $conf->exists("selfservice-$_", $agentnum ) } qw( menu_skipblanks menu_skipheadings menu_nounderline no_logo ) ), @@ -132,6 +133,36 @@ sub skin_info { 'logo' => scalar($conf->config_binary('logo.png', $agentnum )), ( map { $_ => join("\n", $conf->config("selfservice-$_", $agentnum ) ) } qw( head body_header body_footer company_address ) ), + 'menu' => join("\n", $conf->config("ng_selfservice-menu", $agentnum ) ) || + 'main.php Home + + services.php Services + services.php My Services + services_new.php Order a new service + + personal.php Profile + personal.php Personal Information + password.php Change Password + + payment.php Payments + payment_cc.php Credit Card Payment + payment_ach.php Electronic Check Payment + payment_paypal.php PayPal Payment + payment_webpay.php Webpay Payments + + usage.php Usage + usage_data.php Data usage + usage_cdr.php Call usage + + tickets.php Help Desk + tickets.php Open Tickets + tickets_resolved.php Resolved Tickets + ticket_create.php Create a new ticket + + docs.php FAQs + + logout.php Logout + ', }; _cache->set("skin_info_cache_agent$agentnum", $skin_info_cache_agent); @@ -348,6 +379,8 @@ sub access_info { $conf->exists('ticket_system-selfservice_edit_subject') && $cust_main->edit_subject; + $info->{'timeout'} = $conf->config('selfservice-timeout') || 3600; + return { %$info, 'custnum' => $custnum, 'access_pkgnum' => $session->{'pkgnum'}, @@ -364,57 +397,29 @@ sub customer_info { my %return; my $conf = new FS::Conf; - if ($conf->exists('cust_main-require_address2')) { - $return{'require_address2'} = '1'; - }else{ - $return{'require_address2'} = ''; - } + $return{'require_address2'} = $conf->exists('cust_main-require_address2'); - if ( $FS::TicketSystem::system ) { - warn "$me customer_info: initializing ticket system\n" if $DEBUG; - FS::TicketSystem->init(); - } +# if ( $FS::TicketSystem::system ) { +# warn "$me customer_info: initializing ticket system\n" if $DEBUG; +# FS::TicketSystem->init(); +# } if ( $custnum ) { #customer record + %return = ( %return, %{ customer_info_short($p) } ); + + #redundant with customer_info_short, but we need it for several things below my $search = { 'custnum' => $custnum }; $search->{'agentnum'} = $session->{'agentnum'} if $context eq 'agent'; my $cust_main = qsearchs('cust_main', $search ) or return { 'error' => "unknown custnum $custnum" }; - $return{display_custnum} = $cust_main->display_custnum; + my $list_tickets = list_tickets($p); + $return{'tickets'} = $list_tickets->{'tickets'}; - if ( $session->{'pkgnum'} ) { - $return{balance} = $cust_main->balance_pkgnum( $session->{'pkgnum'} ); - #next_bill_date from cust_pkg? + if ( $session->{'pkgnum'} ) { + #XXX open invoices in the pkg-balances case } else { - $return{balance} = $cust_main->balance; - $return{next_bill_date} = $cust_main->next_bill_date; - $return{next_bill_date_pretty} = - time2str('%m/%d/%Y', $return{next_bill_date} ); - } - - my @tickets = $cust_main->tickets; - # unavoidable false laziness w/ httemplate/view/cust_main/tickets.html - if ( FS::TicketSystem->selfservice_priority ) { - my $dir = $conf->exists('ticket_system-priority_reverse') ? -1 : 1; - $return{tickets} = [ - sort { - ( - ($a->{'_selfservice_priority'} eq '') <=> - ($b->{'_selfservice_priority'} eq '') - ) || - ( $dir * - ($b->{'_selfservice_priority'} <=> $a->{'_selfservice_priority'}) - ) - } @tickets - ]; - } - else { - $return{tickets} = \@tickets; - } - - unless ( $session->{'pkgnum'} ) { my @open = map { { invnum => $_->invnum, @@ -432,29 +437,17 @@ sub customer_info { time2str('%m/%d/%Y', $return{'last_invoice_date'} ); } - $return{countrydefault} = scalar($conf->config('countrydefault')); - + #customer_info_short always has nobalance on.. $return{small_custview} = small_custview( $cust_main, $return{countrydefault}, ( $session->{'pkgnum'} ? 1 : 0 ), #nobalance ); - $return{name} = $cust_main->first. ' '. $cust_main->get('last'); - $return{has_ship_address} = $cust_main->has_ship_address; $return{status} = $cust_main->status; $return{statuscolor} = $cust_main->statuscolor; - for (@cust_main_editable_fields) { - $return{$_} = $cust_main->get($_); - } - - for (@location_editable_fields) { - $return{$_} = $cust_main->bill_location->get($_); - $return{'ship_'.$_} = $cust_main->ship_location->get($_); - } - $return{has_ship_address} = $cust_main->has_ship_address; # compatibility: some places in selfservice use this to determine # if there's a ship address if ( $return{has_ship_address} ) { @@ -462,16 +455,6 @@ sub customer_info { $return{ship_first} = $cust_main->first; } - if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) { - $return{payinfo} = $cust_main->paymask; - @return{'month', 'year'} = $cust_main->paydate_monthyear; - } - - $return{'invoicing_list'} = - join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list ); - $return{'postal_invoicing'} = - 0 < ( grep { $_ eq 'POST' } $cust_main->invoicing_list ); - if (scalar($conf->config('support_packages'))) { my @support_services = (); foreach ($cust_main->support_services) { @@ -498,12 +481,6 @@ sub customer_info { $return{discount_terms_hash} = { $cust_main->discount_terms_hash }; } - if ( $session->{'svcnum'} ) { - my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $session->{'svcnum'} }); - $return{'svc_label'} = ($cust_svc->label)[1] if $cust_svc; - $return{'svcnum'} = $session->{'svcnum'}; - } - } elsif ( $session->{'svcnum'} ) { #no customer record my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $session->{'svcnum'} } ) @@ -542,6 +519,17 @@ sub customer_info_short { $return{display_custnum} = $cust_main->display_custnum; + if ( $session->{'pkgnum'} ) { + $return{balance} = $cust_main->balance_pkgnum( $session->{'pkgnum'} ); + #next_bill_date from cust_pkg? + } else { + $return{balance} = $cust_main->balance; + $return{next_bill_date} = $cust_main->next_bill_date; + $return{next_bill_date_pretty} = + $return{next_bill_date} ? time2str('%m/%d/%Y', $return{next_bill_date} ) + : '(none)'; + } + $return{countrydefault} = scalar($conf->config('countrydefault')); $return{small_custview} = @@ -569,10 +557,11 @@ sub customer_info_short { @return{'month', 'year'} = $cust_main->paydate_monthyear; } + my @invoicing_list = $cust_main->invoicing_list; $return{'invoicing_list'} = - join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list ); - #$return{'postal_invoicing'} = - # 0 < ( grep { $_ eq 'POST' } $cust_main->invoicing_list ); + join(', ', grep { $_ !~ /^(POST|FAX)$/ } @invoicing_list ); + $return{'postal_invoicing'} = + 0 < ( grep { $_ eq 'POST' } @invoicing_list ); if ( $session->{'svcnum'} ) { my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $session->{'svcnum'} }); @@ -621,7 +610,8 @@ sub billing_history { $return{balance} = $cust_main->balance; $return{next_bill_date} = $cust_main->next_bill_date; $return{next_bill_date_pretty} = - time2str('%m/%d/%Y', $return{next_bill_date} ); + $return{next_bill_date} ? time2str('%m/%d/%Y', $return{next_bill_date} ) + : '(none)'; my @history = (); @@ -633,11 +623,12 @@ sub billing_history { push @history, { 'type' => 'Line item', - 'description' => $_->desc. ( $_->sdate && $_->edate - ? ' '. time2str('%d-%b-%Y', $_->sdate). - ' To '. time2str('%d-%b-%Y', $_->edate) - : '' - ), + 'description' => $_->desc( $cust_main->locale ). + ( $_->sdate && $_->edate + ? ' '. time2str('%d-%b-%Y', $_->sdate). + ' To '. time2str('%d-%b-%Y', $_->edate) + : '' + ), 'amount' => sprintf('%.2f', $_->setup + $_->recur ), 'date' => $cust_bill->_date, 'date_pretty' => time2str('%m/%d/%Y', $cust_bill->_date ), @@ -841,7 +832,7 @@ sub payment_info { 'save_unchecked' => $conf->exists('selfservice-save_unchecked'), - 'credit_card_surcharge_percentage' => $conf->config('credit-card-surcharge-percentage'), + 'credit_card_surcharge_percentage' => scalar($conf->config('credit-card-surcharge-percentage')), }; } @@ -1263,6 +1254,50 @@ sub realtime_collect { return { 'error' => '', amount => $amount, %$error }; } +sub start_thirdparty { + 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 = FS::cust_main->by_key($custnum); + + my $amount = $p->{'amount'} + or return { error => 'no amount' }; + + my $result = $cust_main->create_payment( + 'method' => $p->{'method'}, + 'amount' => $p->{'amount'}, + 'pkgnum' => $session->{'pkgnum'}, + 'session_id' => $p->{'session_id'}, + ); + + if ( ref($result) ) { # hashref or error + return $result; + } else { + return { error => $result }; + } +} + +sub finish_thirdparty { + my $p = shift; + my $session_id = delete $p->{'session_id'}; + my $session = _cache->get($session_id) + or return { 'error' => "Can't resume session" }; + my $custnum = $session->{'custnum'}; + my $cust_main = FS::cust_main->by_key($custnum); + + if ( $p->{_cancel} ) { + # customer backed out of making a payment + return $cust_main->cancel_payment( $session_id ); + } + my $result = $cust_main->execute_payment( $session_id, %$p ); + if ( ref($result) ) { + return $result; + } else { + return { error => $result }; + } +} + sub process_payment_order_pkg { my $p = shift; @@ -1581,10 +1616,14 @@ sub list_pkgs { my $primary_cust_svc = $_->primary_cust_svc; +{ $_->hash, $_->part_pkg->hash, - pkg_label => $_->pkg_label, - status => $_->status, + pkg_label => $_->pkg_locale, + status => $_->status, + statuscolor => $_->statuscolor, part_svc => - [ map $_->hashref, $_->available_part_svc ], + [ map { $_->hashref } + grep { $_->selfservice_access ne 'hidden' } + $_->available_part_svc + ], cust_svc => [ map { my $ref = { $_->hash, label => [ $_->label ], @@ -1598,7 +1637,9 @@ sub list_pkgs { $ref->{svchash}->{svcpart} = $_->part_svc->svcpart if $_->part_svc->svcdb eq 'svc_phone'; # hack $ref; - } $_->cust_svc + } + grep { $_->part_svc->selfservice_access ne 'hidden' } + $_->cust_svc ], primary_cust_svc => $primary_cust_svc @@ -1613,6 +1654,7 @@ sub list_pkgs { ], 'small_custview' => small_custview( $cust_main, $conf->config('countrydefault') ), + 'date_format' => $conf->config('date_format') || '%m/%d/%Y', }; } @@ -1635,15 +1677,26 @@ sub list_svcs { } my @cust_svc = (); + my @cust_pkg_usage = (); #foreach my $cust_pkg ( $cust_main->ncancelled_pkgs ) { foreach my $cust_pkg ( $p->{'ncancelled'} ? $cust_main->ncancelled_pkgs : $cust_main->unsuspended_pkgs ) { next if $pkgnum && $cust_pkg->pkgnum != $pkgnum; push @cust_svc, @{[ $cust_pkg->cust_svc ]}; #@{[ ]} to force array context + push @cust_pkg_usage, $cust_pkg->cust_pkg_usage; } @cust_svc = grep { $_->part_svc->selfservice_access ne 'hidden' } @cust_svc; + my %usage_pools; + foreach (@cust_pkg_usage) { + my $part = $_->part_pkg_usage; + my $tag = $part->description . ($part->shared ? 1 : 0); + my $row = $usage_pools{$tag} + ||= [ $part->description, 0, 0, $part->shared ? 1 : 0 ]; + $row->[1] += $_->minutes; # minutes remaining + $row->[2] += $part->minutes; # minutes total + } if ( $p->{'svcdb'} ) { my $svcdb = ref($p->{'svcdb'}) eq 'HASH' @@ -1679,7 +1732,7 @@ sub list_svcs { 'svcdb' => $svcdb, 'label' => $label, 'value' => $value, - 'pkg_label' => $cust_pkg->pkg_label, + 'pkg_label' => $cust_pkg->pkg_locale, 'pkg_status' => $cust_pkg->status, 'readonly' => ($part_svc->selfservice_access eq 'readonly'), ); @@ -1715,7 +1768,34 @@ sub list_svcs { } else { $hash{'name'} = $cust_main->name; } + } elsif ( $svcdb eq 'svc_phone' ) { + # could potentially show lots of things... + $hash{'outbound'} = 1; + $hash{'inbound'} = 0; + if ( $part_pkg->plan eq 'voip_inbound' ) { + $hash{'outbound'} = 0; + $hash{'inbound'} = 1; + } elsif ( $part_pkg->option('selfservice_inbound_format') + or $conf->config('selfservice-default_inbound_cdr_format') + ) { + $hash{'inbound'} = 1; + } + foreach (qw(inbound outbound)) { + # hmm...we can't filter by status here, because there might + # not be cdr_terminations at all. have to go by date. + # find all since the last bill date. + # XXX cdr types? we are going to need them. + if ( $hash{$_} ) { + my $sum_cdr = $svc_x->sum_cdrs( + 'inbound' => ( $_ eq 'inbound' ? 1 : 0 ), + 'begin' => ($cust_pkg->last_bill || 0), + 'nonzero' => 1, + ); + $hash{$_} = $sum_cdr->hashref; + } + } } + # elsif ( $svcdb eq 'svc_phone' || $svcdb eq 'svc_port' ) { # %hash = ( # %hash, @@ -1726,6 +1806,11 @@ sub list_svcs { } @cust_svc ], + 'usage_pools' => [ + map { $usage_pools{$_} } + sort { $a cmp $b } + keys %usage_pools + ], }; } @@ -1780,8 +1865,14 @@ sub svc_status_hash { } -sub set_svc_status_hash { - my $p = shift; +sub set_svc_status_hash { _svc_method_X(shift, 'export_setstatus') } +sub set_svc_status_listadd { _svc_method_X(shift, 'export_setstatus_listadd') } +sub set_svc_status_listdel { _svc_method_X(shift, 'export_setstatus_listdel') } +sub set_svc_status_vacationadd { _svc_method_X(shift, 'export_setstatus_vacationadd') } +sub set_svc_status_vacationdel { _svc_method_X(shift, 'export_setstatus_vacationdel') } + +sub _svc_method_X { + my( $p, $method ) = @_; my($context, $session, $custnum) = _custoragent_session_custnum($p); return { 'error' => $session } if $context eq 'error'; @@ -1790,16 +1881,15 @@ sub set_svc_status_hash { my $svc_x = _customer_svc_x( $custnum, $p->{'svcnum'}, 'svc_acct') or return { 'error' => "Service not found" }; - warn "set_svc_status_hash ". join(' / ', map "$_=>".$p->{$_}, keys %$p ) + warn "$method ". join(' / ', map "$_=>".$p->{$_}, keys %$p ) if $DEBUG; - my $error = $svc_x->export_setstatus($p); #$p? returns error? + my $error = $svc_x->$method($p); #$p? returns error? return { 'error' => $error } if $error; return {}; #? { 'error' => '' } } - sub acct_forward_info { my $p = shift; @@ -1983,7 +2073,7 @@ sub _list_cdr_usage { # we have to return the results all at once... my($svc_phone, $begin, $end, %opt) = @_; map [ $_->downstream_csv(%opt, 'keeparray' => 1) ], - $svc_phone->get_cdrs( 'begin'=>$begin, 'end'=>$end, ); + $svc_phone->get_cdrs( 'begin'=>$begin, 'end'=>$end, %opt ); } sub list_cdr_usage { @@ -2013,18 +2103,21 @@ sub _usage_details { my %callback_opt; my $header = []; if ( $svcdb eq 'svc_phone' ) { - my $format = $cust_pkg->part_pkg->option('output_format') || ''; - $format = '' if $format =~ /^sum_/; - # sensible default if there is no format or it's a summary format - if ( $cust_pkg->part_pkg->plan eq 'voip_inbound' ) { - $format ||= 'source_default'; + my $conf = FS::Conf->new; + my $format = ''; + if ( $p->{inbound} ) { + $format = $cust_pkg->part_pkg->option('selfservice_inbound_format') + || $conf->config('selfservice-default_inbound_cdr_format') + || 'source_default'; $callback_opt{inbound} = 1; + } else { + $format = $cust_pkg->part_pkg->option('selfservice_format') + || $conf->config('selfservice-default_cdr_format') + || 'default'; } - else { - $format ||= 'default'; - } - + $callback_opt{format} = $format; + $callback_opt{use_clid} = 1; $header = [ split(',', FS::cdr::invoice_header($format) ) ]; } @@ -2037,6 +2130,9 @@ sub _usage_details { $p->{ending} = $end; } + die "illegal beginning" if $p->{beginning} !~ /^\d*$/; + die "illegal ending" if $p->{ending} !~ /^\d*$/; + my (@usage) = &$callback($svc_x, $p->{beginning}, $p->{ending}, %callback_opt ); @@ -2080,6 +2176,7 @@ sub _usage_details { 'svcnum' => $p->{svcnum}, 'beginning' => $p->{beginning}, 'ending' => $p->{ending}, + 'inbound' => $p->{inbound}, 'previous' => ($previous > $start) ? $previous : $start, 'next' => ($next < $end) ? $next : $end, 'header' => $header, @@ -2862,13 +2959,59 @@ sub process_reset_passwd { } +sub list_tickets { + my $p = shift; + my($context, $session, $custnum) = _custoragent_session_custnum($p); + return { 'error' => $session } if $context eq 'error'; + + my @tickets = (); + if ( $session->{'pkgnum'} ) { + + #tickets for specific service with pkg-balances on + my $cust_pkg = qsearchs('cust_pkg', { 'custnum' => $custnum, + 'pkgnum' => $session->{'pkgnum'} }) + or return { 'error' => 'unknown package' }; + foreach my $cust_svc ( $cust_pkg->cust_svc ) { + push @tickets, $cust_svc->tickets( $p->{status} ); + } + + } else { + + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or return { 'error' => "unknown custnum $custnum" }; + + @tickets = $cust_main->tickets( $p->{status} ); + } + + # unavoidable false laziness w/ httemplate/view/cust_main/tickets.html + if ( $FS::TicketSystem::system && FS::TicketSystem->selfservice_priority ) { + my $conf = new FS::Conf; + my $dir = $conf->exists('ticket_system-priority_reverse') ? -1 : 1; + +{ tickets => [ + sort { + ( + ($a->{'_selfservice_priority'} eq '') <=> + ($b->{'_selfservice_priority'} eq '') + ) || + ( $dir * + ($b->{'_selfservice_priority'} <=> $a->{'_selfservice_priority'}) + ) + } @tickets + ] + }; + } else { + +{ tickets => \@tickets }; + } + +} + sub create_ticket { my $p = shift; my($context, $session, $custnum) = _custoragent_session_custnum($p); return { 'error' => $session } if $context eq 'error'; - warn "$me create_ticket: initializing ticket system\n" if $DEBUG; - FS::TicketSystem->init(); +# warn "$me create_ticket: initializing ticket system\n" if $DEBUG; +# FS::TicketSystem->init(); my $conf = new FS::Conf; my $queue = $p->{'queue'} @@ -2983,10 +3126,10 @@ sub get_ticket { my($context, $session, $custnum) = _custoragent_session_custnum($p); return { 'error' => $session } if $context eq 'error'; - warn "$me get_ticket: initializing ticket system\n" if $DEBUG; - FS::TicketSystem->init(); - return { 'error' => 'get_ticket configuration error' } - if $FS::TicketSystem::system ne 'RT_Internal'; +# warn "$me get_ticket: initializing ticket system\n" if $DEBUG; +# FS::TicketSystem->init(); +# return { 'error' => 'get_ticket configuration error' } +# if $FS::TicketSystem::system ne 'RT_Internal'; # check existence and ownership as part of this warn "$me get_ticket: fetching ticket\n" if $DEBUG; @@ -3058,8 +3201,8 @@ sub adjust_ticket_priority { my($context, $session, $custnum) = _custoragent_session_custnum($p); return { 'error' => $session } if $context eq 'error'; - warn "$me adjust_ticket_priority: initializing ticket system\n" if $DEBUG; - FS::TicketSystem->init; +# warn "$me adjust_ticket_priority: initializing ticket system\n" if $DEBUG; +# FS::TicketSystem->init; my $ss_priority = FS::TicketSystem->selfservice_priority; return { 'error' => 'adjust_ticket_priority configuration error' } diff --git a/FS/FS/ClientAPI/PrepaidPhone.pm b/FS/FS/ClientAPI/PrepaidPhone.pm index c34617922..c7317ea23 100644 --- a/FS/FS/ClientAPI/PrepaidPhone.pm +++ b/FS/FS/ClientAPI/PrepaidPhone.pm @@ -3,6 +3,7 @@ package FS::ClientAPI::PrepaidPhone; use strict; use vars qw($DEBUG $me); use FS::Record qw(qsearchs); +use FS::Conf; use FS::rate; use FS::svc_phone; @@ -156,11 +157,15 @@ sub call_time { return \%return; } + my $conf = new FS::Conf; + my $balance = $conf->config_bool('pkg-balances') ? $cust_pkg->balance + : $cust_main->balance; + #XXX granularity? included minutes? another day... - if ( $cust_main->balance >= 0 ) { + if ( $balance >= 0 ) { return { 'error'=>'No balance' }; } else { - $return{'seconds'} = int(60 * abs($cust_main->balance) / $rate_detail->min_charge); + $return{'seconds'} = int(60 * abs($balance) / $rate_detail->min_charge); } warn "$me returning seconds: ". $return{'seconds'}; @@ -248,13 +253,18 @@ sub phonenum_balance { my $cust_pkg = $svc_phone->cust_svc->cust_pkg; - warn "$me returning ". $cust_pkg->cust_main->balance. - " balance for custnum ". $cust_pkg->custnum + my $conf = new FS::Conf; + my $balance = $conf->config_bool('pkg-balances') + ? $cust_pkg->balance + : $cust_pkg->cust_main->balance; + + warn "$me returning $balance balance for pkgnum ". $cust_pkg->pkgnum. + ", custnum ". $cust_pkg->custnum if $DEBUG; return { 'custnum' => $cust_pkg->custnum, - 'balance' => $cust_pkg->cust_main->balance, + 'balance' => $balance, }; } diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm index b7dcdbb64..57091c4fe 100644 --- a/FS/FS/ClientAPI/Signup.pm +++ b/FS/FS/ClientAPI/Signup.pm @@ -98,7 +98,7 @@ sub signup_info { my @signup_bools = qw( no_company recommend_daytime recommend_email ); - my @signup_server_scalars = qw( default_pkgpart default_svcpart ); + my @signup_server_scalars = qw( default_pkgpart default_svcpart default_domsvc ); my @selfservice_textareas = qw( head body_header body_footer ); @@ -524,20 +524,13 @@ sub new_customer { my $template_cust = qsearchs('cust_main', { 'custnum' => $template_custnum } ); return { 'error' => 'Configuration error' } unless $template_cust; - #XXX Copy template customer's locations $cust_main = new FS::cust_main ( { 'agentnum' => $agentnum, 'refnum' => $packet->{refnum} || $conf->config('signup_server-default_refnum'), ( map { $_ => $template_cust->$_ } qw( - last first company address1 address2 - city county state zip country - daytime night fax - - ship_last ship_first ship_company ship_address1 ship_address2 - ship_city ship_county ship_state ship_zip ship_country - ship_daytime ship_night ship_fax + last first company daytime night fax ) ), @@ -555,6 +548,9 @@ sub new_customer { } ); + $bill_hash = { $template_cust->bill_location->location_hash }; + $ship_hash = { $template_cust->ship_location->location_hash }; + } else { $cust_main = new FS::cust_main ( { @@ -674,7 +670,7 @@ sub new_customer { my $svc = new FS::svc_acct { 'svcpart' => $svcpart, map { $_ => $packet->{$_} } - qw( username _password sec_phrase popnum ), + qw( username _password sec_phrase popnum domsvc ), }; my @acct_snarf; @@ -777,13 +773,15 @@ sub new_customer { # " new customer: $bill_error" # if $bill_error; - $bill_error = $cust_main->realtime_collect( - method => FS::payby->payby2bop( $packet->{payby} ), - depend_jobnum => $placeholder->jobnum, - selfservice => 1, - ); - #warn "$me error collecting from new customer: $bill_error" - # if $bill_error; + unless ( $packet->{payby} eq 'PREPAY' ) { + $bill_error = $cust_main->realtime_collect( + method => FS::payby->payby2bop( $packet->{payby} ), + depend_jobnum => $placeholder->jobnum, + selfservice => 1, + ); + #warn "$me error collecting from new customer: $bill_error" + # if $bill_error; + } if ($bill_error && ref($bill_error) eq 'HASH') { return { 'error' => '_collect', @@ -948,15 +946,27 @@ sub capture_payment { } my $cust_main = $cust_pay_pending->cust_main; - my $bill_error = - $cust_main->realtime_botpp_capture( $cust_pay_pending, - %{$packet->{data}}, - apply => 1, - ); + if ( $packet->{cancel} ) { + # the user has chosen not to make this payment + # (probably should be a separate API call, but I don't want to duplicate + # all of the above...which should eventually go away) + my $error = $cust_pay_pending->delete; + # don't show any errors related to this; they're not meaningful + warn "error canceling pending payment $paypendingnum: $error\n" if $error; + return { 'error' => '_cancel', + 'session_id' => $cust_pay_pending->session_id }; + } else { + # create the payment + my $bill_error = + $cust_main->realtime_botpp_capture( $cust_pay_pending, + %{$packet->{data}}, + apply => 1, + ); - return { 'error' => ( $bill_error->{bill_error} ? '_decline' : '' ), - %$bill_error, - }; + return { 'error' => ( $bill_error->{bill_error} ? '_decline' : '' ), + %$bill_error, + }; + } } diff --git a/FS/FS/ClientAPI_XMLRPC.pm b/FS/FS/ClientAPI_XMLRPC.pm index 7dd20c652..50b205687 100644 --- a/FS/FS/ClientAPI_XMLRPC.pm +++ b/FS/FS/ClientAPI_XMLRPC.pm @@ -129,6 +129,10 @@ sub ss2clientapi { 'svc_status_html' => 'MyAccount/svc_status_html', 'svc_status_hash' => 'MyAccount/svc_status_hash', 'set_svc_status_hash' => 'MyAccount/set_svc_status_hash', + 'set_svc_status_listadd' => 'MyAccount/set_svc_status_listadd', + 'set_svc_status_listdel' => 'MyAccount/set_svc_status_listdel', + 'set_svc_status_vacationadd'=> 'MyAccount/set_svc_status_vacationadd', + 'set_svc_status_vacationdel'=> 'MyAccount/set_svc_status_vacationdel', 'acct_forward_info' => 'MyAccount/acct_forward_info', 'process_acct_forward' => 'MyAccount/process_acct_forward', 'list_dsl_devices' => 'MyAccount/list_dsl_devices', @@ -154,6 +158,7 @@ sub ss2clientapi { 'reset_passwd' => 'MyAccount/reset_passwd', 'check_reset_passwd' => 'MyAccount/check_reset_passwd', 'process_reset_passwd' => 'MyAccount/process_reset_passwd', + 'list_tickets' => 'MyAccount/list_tickets', 'create_ticket' => 'MyAccount/create_ticket', 'get_ticket' => 'MyAccount/get_ticket', 'adjust_ticket_priority' => 'MyAccount/adjust_ticket_priority', diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 5c43b3ac9..f76c72ff4 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -5,6 +5,7 @@ use Carp; use IO::File; use File::Basename; use MIME::Base64; +use Locale::Currency; use FS::ConfItem; use FS::ConfDefaults; use FS::Conf_compat17; @@ -14,7 +15,6 @@ use FS::conf; use FS::Record qw(qsearch qsearchs); use FS::UID qw(dbh datasrc use_confcompat); use FS::Misc::Invoicing qw( spool_formats ); -use FS::Misc::Geo; $base_dir = '%%%FREESIDE_CONF%%%'; @@ -718,6 +718,18 @@ my %batch_gateway_options = ( }, ); +my @cdr_formats = ( + '' => '', + 'default' => 'Default', + 'source_default' => 'Default with source', + 'accountcode_default' => 'Default plus accountcode', + 'description_default' => 'Default with description field as destination', + 'basic' => 'Basic', + 'simple' => 'Simple', + 'simple2' => 'Simple with source', + 'accountcode_simple' => 'Simple with accountcode', +); + # takes the reason class (C, R, S) as an argument sub reason_type_options { my $reason_class = shift; @@ -750,6 +762,15 @@ sub reason_type_options { }, { + 'key' => 'event_log_level', + 'section' => 'notification', + 'description' => 'Store events in the internal log if they are at least this severe. "info" is the default, "debug" is very detailed and noisy.', + 'type' => 'select', + 'select_enum' => [ '', 'debug', 'info', 'notice', 'warning', 'error', ], + # don't bother with higher levels + }, + + { 'key' => 'log_sent_mail', 'section' => 'notification', 'description' => 'Enable logging of template-generated email.', @@ -846,6 +867,13 @@ sub reason_type_options { }, { + 'key' => 'anniversary-rollback', + 'section' => 'billing', + 'description' => 'When billing an anniversary package ordered after the 28th, roll the anniversary date back to the 28th instead of forward into the following month.', + 'type' => 'checkbox', + }, + + { 'key' => 'encryption', 'section' => 'billing', 'description' => 'Enable encryption of credit cards and echeck numbers', @@ -977,6 +1005,27 @@ sub reason_type_options { }, { + 'key' => 'currency', + 'section' => 'billing', + 'description' => 'Main accounting currency', + 'type' => 'select', + 'select_enum' => [ '', qw( USD AUD CAD DKK EUR GBP ILS JPY NZD XAF ) ], + }, + + { + 'key' => 'currencies', + 'section' => 'billing', + 'description' => 'Additional accepted currencies', + 'type' => 'select-sub', + 'multiple' => 1, + 'options_sub' => sub { + map { $_ => code2currency($_) } all_currency_codes(); + }, + 'sort_sub' => sub ($$) { $_[0] cmp $_[1]; }, + 'option_sub' => sub { code2currency(shift); }, + }, + + { 'key' => 'business-batchpayment-test_transaction', 'section' => 'billing', 'description' => 'Turns on the Business::BatchPayment test_mode flag. Note that not all gateway modules support this flag; if yours does not, using the batch gateway will fail.', @@ -1010,31 +1059,20 @@ sub reason_type_options { 'select_hash' => [ '%b %o, %Y' => 'Mon DDth, YYYY', '%e %b %Y' => 'DD Mon YYYY', + '%m/%d/%Y' => 'MM/DD/YYYY', + '%d/%m/%Y' => 'DD/MM/YYYY', + '%Y/%m/%d' => 'YYYY/MM/DD', ], }, { - 'key' => 'deletecustomers', - 'section' => 'UI', - '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? + 'description' => 'Enable invoices deletions. Be very careful! Deleting an invoice will remove all traces that the invoice ever existed! Normally, you would void or apply a credit against the invoice instead.', 'type' => 'checkbox', }, { - 'key' => 'deletepayments', - 'section' => 'billing', - 'description' => 'Enable deletion of unclosed payments. Really, with voids this is pretty much not recommended in any situation anymore. Be very careful! Only delete payments that were data-entry errors, not adjustments. Optionally specify one or more comma-separated email addresses to be notified when a payment is deleted.', - 'type' => [qw( checkbox text )], - }, - - { 'key' => 'deletecredits', #not actually deprecated yet #'section' => 'deprecated', @@ -1136,6 +1174,13 @@ sub reason_type_options { }, { + 'key' => 'svc_acct-ip_addr', + 'section' => '', + 'description' => 'Enable IP address management on login services like for broadband services.', + 'type' => 'checkbox', + }, + + { 'key' => 'exclude_ip_addr', 'section' => '', 'description' => 'Exclude these from the list of available broadband service IP addresses. (One per line)', @@ -1472,7 +1517,7 @@ and customer address. Include units.', 'section' => 'invoicing', 'description' => 'Optional default invoice term, used to calculate a due date printed on invoices.', 'type' => 'select', - 'select_enum' => [ '', 'Payable upon receipt', 'Net 0', 'Net 3', 'Net 9', 'Net 10', 'Net 15', 'Net 20', 'Net 21', 'Net 30', 'Net 45', 'Net 60', 'Net 90' ], + 'select_enum' => [ '', 'Payable upon receipt', 'Net 0', 'Net 3', 'Net 9', 'Net 10', 'Net 15', 'Net 18', 'Net 20', 'Net 21', 'Net 30', 'Net 45', 'Net 60', 'Net 90' ], }, { @@ -1494,8 +1539,18 @@ and customer address. Include units.', 'section' => 'invoicing', 'description' => 'Split invoice into sections and label according to package category when enabled.', 'type' => 'checkbox', + 'per_agent' => 1, }, + #quotations seem broken-ish with sections ATM? + #{ + # 'key' => 'quotation_sections', + # 'section' => 'invoicing', + # 'description' => 'Split quotations into sections and label according to package category when enabled.', + # 'type' => 'checkbox', + # 'per_agent' => 1, + #}, + { 'key' => 'usage_class_as_a_section', 'section' => 'invoicing', @@ -1593,6 +1648,7 @@ and customer address. Include units.', 'section' => 'required', 'description' => 'Print command for paper invoices, for example `lpr -h\'', 'type' => 'text', + 'per_agent' => 1, }, { @@ -2038,7 +2094,7 @@ and customer address. Include units.', 'key' => 'locale', 'section' => 'UI', 'description' => 'Default locale', - 'type' => 'select', + 'type' => 'select-sub', 'options_sub' => sub { map { $_ => FS::Locales->description($_) } FS::Locales->locales; }, @@ -2052,7 +2108,7 @@ and customer address. Include units.', 'section' => 'self-service', 'description' => 'Acceptable payment types for the signup server', 'type' => 'selectmultiple', - 'select_enum' => [ qw(CARD DCRD CHEK DCHK LECB PREPAY BILL COMP) ], + 'select_enum' => [ qw(CARD DCRD CHEK DCHK LECB PREPAY PPAL BILL COMP) ], }, { @@ -2113,11 +2169,18 @@ and customer address. Include units.', { 'key' => 'signup_server-default_svcpart', 'section' => 'self-service', - 'description' => 'Default service definition for the signup server - only necessary for services that trigger special provisioning widgets (such as DID provisioning).', + 'description' => 'Default service definition for the signup server - only necessary for services that trigger special provisioning widgets (such as DID provisioning or domain selection).', 'type' => 'select-part_svc', }, { + 'key' => 'signup_server-default_domsvc', + 'section' => 'self-service', + 'description' => 'If specified, the default domain svcpart for signup (useful when domain is set to selectable choice).', + 'type' => 'text', + }, + + { 'key' => 'signup_server-mac_addr_svcparts', 'section' => 'self-service', 'description' => 'Service definitions which can receive mac addresses (current mapped to username for svc_acct).', @@ -2209,6 +2272,13 @@ and customer address. Include units.', }, { + 'key' => 'selfservice-timeout', + 'section' => 'self-service', + 'description' => 'Timeout for the self-service login cookie, in seconds. Defaults to 1 hour.', + 'type' => 'text', + }, + + { 'key' => 'backend-realtime', 'section' => 'billing', 'description' => 'Run billing for backend signups immediately.', @@ -2426,7 +2496,7 @@ and customer address. Include units.', 'section' => 'billing', 'description' => 'Available payment types.', 'type' => 'selectmultiple', - 'select_enum' => [ qw(CARD DCRD CHEK DCHK LECB BILL CASH WEST MCRD COMP) ], + 'select_enum' => [ qw(CARD DCRD CHEK DCHK LECB BILL CASH WEST MCRD PPAL COMP) ], }, { @@ -2434,7 +2504,7 @@ and customer address. Include units.', 'section' => 'UI', 'description' => 'Default payment type. HIDE disables display of billing information and sets customers to BILL.', 'type' => 'select', - 'select_enum' => [ '', qw(CARD DCRD CHEK DCHK LECB BILL CASH WEST MCRD COMP HIDE) ], + 'select_enum' => [ '', qw(CARD DCRD CHEK DCHK LECB BILL CASH WEST MCRD PPAL COMP HIDE) ], }, { @@ -3220,6 +3290,14 @@ and customer address. Include units.', }, { + 'key' => 'ics-confirm_template', + 'section' => '', + 'description' => 'Confirmation email template for uploading to ICS invoice printing. Text::Template format, with variables "%count" and "%sum".', + 'type' => 'textarea', + 'per_agent' => 1, + }, + + { 'key' => 'svc_acct-usage_suspend', 'section' => 'billing', 'description' => 'Suspends the package an account belongs to when svc_acct.seconds or a bytecount is decremented to 0 or below (accounts with an empty seconds and up|down|totalbytes value are ignored). Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.', @@ -3343,13 +3421,6 @@ and customer address. Include units.', }, { - 'key' => 'echeck-nonus', - 'section' => 'billing', - 'description' => 'Disable ABA-format account checking for Electronic Check payment info', - 'type' => 'checkbox', - }, - - { 'key' => 'echeck-country', 'section' => 'billing', 'description' => 'Format electronic check information for the specified country.', @@ -3502,7 +3573,7 @@ and customer address. Include units.', 'section' => 'billing', 'description' => 'Default format for batches.', 'type' => 'select', - 'select_enum' => [ 'csv-td_canada_trust-merchant_pc_batch', + 'select_enum' => [ 'NACHA', 'csv-td_canada_trust-merchant_pc_batch', 'csv-chase_canada-E-xactBatch', 'BoM', 'PAP', 'paymentech', 'ach-spiritone', 'RBC' ] @@ -3564,9 +3635,9 @@ and customer address. Include units.', 'section' => 'billing', 'description' => 'Fixed (unchangeable) format for electronic check batches.', 'type' => 'select', - 'select_enum' => [ 'csv-td_canada_trust-merchant_pc_batch', 'BoM', 'PAP', - 'paymentech', 'ach-spiritone', 'RBC', 'td_eft1464', - 'eft_canada' + 'select_enum' => [ 'NACHA', 'csv-td_canada_trust-merchant_pc_batch', 'BoM', + 'PAP', 'paymentech', 'ach-spiritone', 'RBC', + 'td_eft1464', 'eft_canada' ] }, @@ -3601,7 +3672,7 @@ and customer address. Include units.', { 'key' => 'batchconfig-paymentech', 'section' => 'billing', - 'description' => 'Configuration for Chase Paymentech batching, five lines: 1. BIN, 2. Terminal ID, 3. Merchant ID, 4. Username, 5. Password (for batch uploads)', + 'description' => 'Configuration for Chase Paymentech batching, six lines: 1. BIN, 2. Terminal ID, 3. Merchant ID, 4. Username, 5. Password (for batch uploads), 6. Flag to send recurring indicator.', 'type' => 'textarea', }, @@ -3620,18 +3691,39 @@ and customer address. Include units.', }, { - 'key' => 'batch-manual_approval', + 'key' => 'batchconfig-eft_canada', 'section' => 'billing', - 'description' => 'Allow manual batch closure, which will approve all payments that do not yet have a status. This is not advised, but is needed for payment processors that provide a report of rejected rather than approved payments.', - 'type' => 'checkbox', + 'description' => 'Configuration for EFT Canada batching, four lines: 1. SFTP username, 2. SFTP password, 3. Transaction code, 4. Number of days to delay process date. If you are using separate per-agent batches (batch-spoolagent), you must set this option separately for each agent, as the global setting will be ignored.', + 'type' => 'textarea', + 'per_agent' => 1, }, { - 'key' => 'batchconfig-eft_canada', + 'key' => 'batchconfig-nacha-destination', 'section' => 'billing', - 'description' => 'Configuration for EFT Canada batching, four lines: 1. SFTP username, 2. SFTP password, 3. Transaction code, 4. Number of days to delay process date.', - 'type' => 'textarea', - 'per_agent' => 1, + 'description' => 'Configuration for NACHA batching, Destination (9 digit transit routing number).', + 'type' => 'text', + }, + + { + 'key' => 'batchconfig-nacha-destination_name', + 'section' => 'billing', + 'description' => 'Configuration for NACHA batching, Destination (Bank Name, up to 23 characters).', + 'type' => 'text', + }, + + { + 'key' => 'batchconfig-nacha-origin', + 'section' => 'billing', + 'description' => 'Configuration for NACHA batching, Origin (your 10-digit company number, IRS tax ID recommended).', + 'type' => 'text', + }, + + { + 'key' => 'batch-manual_approval', + 'section' => 'billing', + 'description' => 'Allow manual batch closure, which will approve all payments that do not yet have a status. This is not advised unless needed for specific payment processors that provide a report of rejected rather than approved payments.', + 'type' => 'checkbox', }, { @@ -3699,20 +3791,6 @@ and customer address. Include units.', }, { - 'key' => 'cust_main-skeleton_tables', - 'section' => '', - 'description' => 'Tables which will have skeleton records inserted into them for each customer. Syntax for specifying tables is unfortunately a tricky perl data structure for now.', - 'type' => 'textarea', - }, - - { - 'key' => 'cust_main-skeleton_custnum', - 'section' => '', - 'description' => 'Customer number specifying the source data to copy into skeleton tables for new customers.', - 'type' => 'text', - }, - - { 'key' => 'cust_main-enable_birthdate', 'section' => 'UI', 'description' => 'Enable tracking of a birth date with each customer record', @@ -3762,6 +3840,13 @@ and customer address. Include units.', 'type' => 'checkbox', }, + { + 'key' => 'fuzzy-fuzziness', + 'section' => 'UI', + 'description' => 'Set the "fuzziness" of fuzzy searching (see the String::Approx manpage for details). Defaults to 10%', + 'type' => 'text', + }, + { 'key' => 'pkg_referral', 'section' => '', 'description' => 'Enable package-specific advertising sources.', @@ -3893,6 +3978,19 @@ and customer address. Include units.', }, { + 'key' => 'cust_bill-line_item-date_style-non_monthly', + 'section' => 'billing', + 'description' => 'If set, override cust_bill-line_item-date_style for non-monthly charges.', + 'type' => 'select', + 'select_hash' => [ '' => 'Default', + 'start_end' => 'STARTDATE-ENDDATE', + 'month_of' => 'Month of MONTHNAME', + 'X_month' => 'DATE_DESC MONTHNAME', + ], + 'per_agent' => 1, + }, + + { 'key' => 'cust_bill-line_item-date_description', 'section' => 'billing', 'description' => 'Text to display for "DATE_DESC" when using cust_bill-line_item-date_style DATE_DESC MONTHNAME.', @@ -3931,7 +4029,7 @@ and customer address. Include units.', 'type' => 'select', 'multiple' => 1, 'select_hash' => [ - 'address1' => 'Billing address', + #'address1' => 'Billing address', ], }, @@ -4050,6 +4148,24 @@ and customer address. Include units.', }, { + 'key' => 'always_show_tax', + 'section' => 'invoicing', + 'description' => 'Show a line for tax on the invoice even when the tax is zero. Optionally provide text for the tax name to show.', + 'type' => [ qw(checkbox text) ], + }, + + { + 'key' => 'address_standardize_method', + 'section' => 'UI', #??? + 'description' => 'Method for standardizing customer addresses.', + 'type' => 'select', + 'select_hash' => [ '' => '', + 'usps' => 'U.S. Postal Service', + 'ezlocate' => 'EZLocate', + ], + }, + + { '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.', @@ -4064,6 +4180,20 @@ and customer address. Include units.', }, { + 'key' => 'ezlocate-userid', + 'section' => 'UI', + 'description' => 'User ID for EZ-Locate service. See <a href="http://www.geocode.com/">the TomTom website</a> for access and pricing information.', + 'type' => 'text', + }, + + { + 'key' => 'ezlocate-password', + 'section' => 'UI', + 'description' => 'Password for EZ-Locate service.', + 'type' => 'text' + }, + + { 'key' => 'cust_main-auto_standardize_address', 'section' => 'UI', 'description' => 'When using USPS web tools, automatically standardize the address without asking.', @@ -4080,7 +4210,7 @@ and customer address. Include units.', { 'key' => 'census_year', 'section' => 'UI', - 'description' => 'The year to use in census tract lookups', + 'description' => 'The year to use in census tract lookups. NOTE: you need to select 2012 for Year 2010 Census tract codes. A selection of 2011 or 2010 provides Year 2000 Census tract codes. Use the freeside-censustract-update tool if exisitng customers need to be changed.', 'type' => 'select', 'select_enum' => [ qw( 2012 2011 2010 ) ], }, @@ -4090,7 +4220,12 @@ and customer address. Include units.', 'section' => 'UI', 'description' => 'The method to use to look up tax district codes.', 'type' => 'select', - 'select_hash' => [ FS::Misc::Geo::get_district_methods() ], + #'select_hash' => [ FS::Misc::Geo::get_district_methods() ], + #after RT#13763, using FS::Misc::Geo here now causes a dependancy loop :/ + 'select_hash' => [ + '' => '', + 'wa_sales' => 'Washington sales tax', + ], }, { @@ -4409,6 +4544,31 @@ and customer address. Include units.', }, { + 'key' => 'selfservice-menu_disable', + 'section' => 'self-service', + 'description' => 'Disable the selected menu entries in the self-service menu', + 'type' => 'selectmultiple', + 'select_enum' => [ #false laziness w/myaccount_menu.html + 'Overview', + 'Purchase', + 'Purchase additional package', + 'Recharge my account with a credit card', + 'Recharge my account with a check', + 'Recharge my account with a prepaid card', + 'View my usage', + 'Create a ticket', + 'Setup my services', + 'Change my information', + 'Change billing address', + 'Change service address', + 'Change payment information', + 'Change password(s)', + 'Logout', + ], + 'per_agent' => 1, + }, + + { 'key' => 'selfservice-menu_skipblanks', 'section' => 'self-service', 'description' => 'Skip blank (spacer) entries in the self-service menu', @@ -4494,20 +4654,10 @@ and customer address. Include units.', }, { - 'key' => 'selfservice-bulk_format', - 'section' => 'deprecated', - 'description' => 'Parameter arrangement for selfservice bulk features', - 'type' => 'select', - 'select_enum' => [ '', 'izoom-soap', 'izoom-ftp' ], - 'per_agent' => 1, - }, - - { - 'key' => 'selfservice-bulk_ftp_dir', - 'section' => 'deprecated', - 'description' => 'Enable bulk ftp provisioning in this folder', - 'type' => 'text', - 'per_agent' => 1, + 'key' => 'ng_selfservice-menu', + 'section' => 'self-service', + 'description' => 'Custom menu for the next-generation self-service interface. Each line is in the format "link Label", for example "main.php Home". Sub-menu items are listed on subsequent lines. Blank lines terminate the submenu.', #more docs/examples would be helpful + 'type' => 'textarea', }, { @@ -4653,6 +4803,13 @@ and customer address. Include units.', }, { + 'key' => 'cdr-taqua-callerid_rewrite', + 'section' => 'telephony', + 'description' => 'For the Taqua CDR format, pull Caller ID blocking information from secondary CDRs.', + 'type' => 'checkbox', + }, + + { 'key' => 'cdr-asterisk_australia_rewrite', 'section' => 'telephony', 'description' => 'For Asterisk CDRs, assign CDR type numbers based on Australian conventions.', @@ -4660,6 +4817,13 @@ and customer address. Include units.', }, { + 'key' => 'cdr-gsm_tap3-sender', + 'section' => 'telephony', + 'description' => 'GSM TAP3 Sender network (5 letter code)', + 'type' => 'text', + }, + + { 'key' => 'cust_pkg-show_autosuspend', 'section' => 'UI', 'description' => 'Show package auto-suspend dates. Use with caution for now; can slow down customer view for large insallations.', @@ -4719,7 +4883,7 @@ and customer address. Include units.', { 'key' => 'svc_broadband-manage_link', 'section' => 'UI', - 'description' => 'URL for svc_broadband "Manage Device" link. The following substitutions are available: $ip_addr.', + 'description' => 'URL for svc_broadband "Manage Device" link. The following substitutions are available: $ip_addr and $mac_addr.', 'type' => 'text', }, @@ -4818,7 +4982,7 @@ and customer address. Include units.', { 'key' => 'pkg-balances', 'section' => 'billing', - 'description' => 'Enable experimental package balances. Not recommended for general use.', + 'description' => 'Enable per-package balances.', 'type' => 'checkbox', }, @@ -4928,13 +5092,6 @@ and customer address. Include units.', }, { - 'key' => 'maestro-status_test', - 'section' => 'UI', - 'description' => 'Display a link to the maestro status test page on the customer view page', - 'type' => 'checkbox', - }, - - { 'key' => 'cust_main-custom_link', 'section' => 'UI', 'description' => 'URL to use as source for the "Custom" tab in the View Customer page. The customer number will be appended, or you can insert "$custnum" to have it inserted elsewhere. "$agentnum" will be replaced with the agent number, and "$usernum" will be replaced with the employee number.', @@ -5072,6 +5229,13 @@ and customer address. Include units.', }, { + 'key' => 'invoice_payment_details', + 'section' => 'invoicing', + 'description' => 'When displaying payments on an invoice, show the payment method used, including the check or credit card number. Credit card numbers will be masked.', + 'type' => 'checkbox', + }, + + { 'key' => 'cust_main-status_module', 'section' => 'UI', 'description' => 'Which module to use for customer status display. The "Classic" module (the default) considers accounts with cancelled recurring packages but un-cancelled one-time charges Inactive. The "Recurring" module considers those customers Cancelled. Similarly for customers with suspended recurring packages but one-time charges.', #other differences? @@ -5079,17 +5243,17 @@ and customer address. Include units.', 'select_enum' => [ 'Classic', 'Recurring' ], }, - { - 'key' => 'cust_main-print_statement_link', - 'section' => 'UI', - 'description' => 'Show a link to download a current statement for the customer.', + { + 'key' => 'username-pound', + 'section' => 'username', + 'description' => 'Allow the pound character (#) in usernames.', 'type' => 'checkbox', }, { - 'key' => 'username-pound', + 'key' => 'username-exclamation', 'section' => 'username', - 'description' => 'Allow the pound character (#) in usernames.', + 'description' => 'Allow the exclamation character (!) in usernames.', 'type' => 'checkbox', }, @@ -5207,6 +5371,19 @@ and customer address. Include units.', $cdr_type ? $cdr_type->cdrtypename : ''; }, }, + + { + 'key' => 'cdr-minutes_priority', + 'section' => 'telephony', + 'description' => 'Priority rule for assigning included minutes to CDRs.', + 'type' => 'select', + 'select_hash' => [ + '' => 'No specific order', + 'time' => 'Chronological', + 'rate_high' => 'Highest rate first', + 'rate_low' => 'Lowest rate first', + ], + }, { 'key' => 'brand-agent', @@ -5230,6 +5407,22 @@ and customer address. Include units.', }, { + 'key' => 'selfservice-default_cdr_format', + 'section' => 'self-service', + 'description' => 'Format for showing outbound CDRs in self-service. The per-package option overrides this.', + 'type' => 'select', + 'select_hash' => \@cdr_formats, + }, + + { + 'key' => 'selfservice-default_inbound_cdr_format', + 'section' => 'self-service', + 'description' => 'Format for showing inbound CDRs in self-service. The per-package option overrides this. Leave blank to avoid showing these CDRs.', + 'type' => 'select', + 'select_hash' => \@cdr_formats, + }, + + { 'key' => 'logout-timeout', 'section' => 'UI', 'description' => 'If set, automatically log users out of the backoffice after this many minutes.', @@ -5254,6 +5447,28 @@ and customer address. Include units.', 'type' => 'text', }, + { + 'key' => 'report-cust_pay-select_time', + 'section' => 'UI', + 'description' => 'Enable time selection on payment and refund reports.', + 'type' => 'checkbox', + }, + + { + 'key' => 'authentication_module', + 'section' => 'UI', + 'description' => '"Internal" is the default , which authenticates against the internal database. "Legacy" is similar, but matches passwords against a legacy htpasswd file.', + 'type' => 'select', + 'select_enum' => [qw( Internal Legacy )], + }, + + { + 'key' => 'external_auth-access_group-template_user', + 'section' => 'UI', + 'description' => 'When using an external authentication module, specifies the default access groups for autocreated users, via a template user.', + 'type' => 'text', + }, + { key => "apacheroot", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "apachemachine", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "apachemachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, diff --git a/FS/FS/Cron/bill.pm b/FS/FS/Cron/bill.pm index a9df376dc..d04693049 100644 --- a/FS/FS/Cron/bill.pm +++ b/FS/FS/Cron/bill.pm @@ -13,6 +13,8 @@ use FS::cust_main; use FS::part_event; use FS::part_event_condition; +use FS::Log; + @ISA = qw( Exporter ); @EXPORT_OK = qw ( bill bill_where ); @@ -27,6 +29,9 @@ use FS::part_event_condition; sub bill { my %opt = @_; + my $log = FS::Log->new('Cron::bill'); + $log->info('start'); + my $check_freq = $opt{'check_freq'} || '1d'; my $debug = 0; @@ -36,9 +41,10 @@ sub bill { #$FS::cust_event::DEBUG = $opt{'l'} if $opt{'l'}; my $conf = new FS::Conf; + my $disable_bill = 0; if ( $conf->exists('disable_cron_billing') ) { warn "disable_cron_billing set, skipping billing\n" if $debug; - return; + $disable_bill = 1; } #we're at now now (and later). @@ -122,7 +128,11 @@ sub bill { } else { my $cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } ); - $cust_main->bill_and_collect( %args, 'debug' => $debug ); + if ( $disable_bill ) { + $cust_main->collect( %args, 'debug' => $debug ); + } else { + $cust_main->bill_and_collect( %args, 'debug' => $debug ); + } } @@ -134,6 +144,7 @@ sub bill { $cursor_dbh->commit or die $cursor_dbh->errstr; + $log->info('finish'); } # freeside-daily %opt: @@ -195,7 +206,8 @@ sub bill_where { # generate where_pkg/where_event search clause ### - my $billtime = day_end($time); + my $conf = new FS::Conf; + my $billtime = $conf->exists('next-bill-ignore-time') ? day_end($time) : $time; # select * from cust_main where my $where_pkg = <<"END"; diff --git a/FS/FS/Cron/cleanup.pm b/FS/FS/Cron/cleanup.pm new file mode 100644 index 000000000..4c5cff278 --- /dev/null +++ b/FS/FS/Cron/cleanup.pm @@ -0,0 +1,18 @@ +package FS::Cron::cleanup; +use base 'Exporter'; +use vars '@EXPORT_OK'; +use FS::queue; + +@EXPORT_OK = qw( cleanup ); + +# start janitor jobs +sub cleanup { +# fix locations that are missing coordinates + my $job = FS::queue->new({ + 'job' => 'FS::cust_location::process_set_coord', + 'status' => 'new' + }); + $job->insert('_JOB'); +} + +1; diff --git a/FS/FS/Cron/upload.pm b/FS/FS/Cron/upload.pm index 51e0d6868..03ed366e2 100644 --- a/FS/FS/Cron/upload.pm +++ b/FS/FS/Cron/upload.pm @@ -9,13 +9,15 @@ use FS::Record qw( qsearch qsearchs ); use FS::Conf; use FS::queue; use FS::agent; +use FS::Log; use FS::Misc qw( send_email ); #for bridgestone -use FS::ftp_target; +use FS::upload_target; use LWP::UserAgent; use HTTP::Request; use HTTP::Request::Common; use HTTP::Response; use Net::FTP; +use List::Util qw( sum ); @ISA = qw( Exporter ); @EXPORT_OK = qw ( upload ); @@ -32,6 +34,8 @@ $me = '[FS::Cron::upload]'; sub upload { my %opt = @_; + my $log = FS::Log->new('Cron::upload'); + $log->info('start'); my $debug = 0; $debug = 1 if $opt{'v'}; @@ -58,7 +62,7 @@ sub upload { my @agentnums = ('', map {$_->agentnum} @agents); - foreach my $target (qsearch('ftp_target', {})) { + foreach my $target (qsearch('upload_target', {})) { # We don't know here if it's spooled on a per-agent basis or not. # (It could even be both, via different events.) So queue up an # upload for each agent, plus one with null agentnum, and we'll @@ -94,6 +98,32 @@ sub upload { } } # foreach @agents + # if there's nothing to do, don't hold up the rest of the process + if (!@tasks) { + $log->info('finish (nothing to upload)'); + return ''; + } + + # wait for any ongoing billing jobs to complete + if ($opt{m}) { + my $dbh = dbh; + my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ". + "WHERE queue.job='FS::cust_main::queued_bill' AND status != 'failed'"; + if (@agents) { + $sql .= ' AND cust_main.agentnum IN('. + join(',', map {$_->agentnum} @agents). + ')'; + } + my $sth = $dbh->prepare($sql) or die $dbh->errstr; + while (1) { + $sth->execute() + or die "Unexpected error executing statement $sql: ". $sth->errstr; + last if $sth->fetchrow_arrayref->[0] == 0; + warn "Waiting 5min for billing to complete...\n" if $DEBUG; + sleep 300; + } + } + foreach (@tasks) { my $agentnum = $_->{agentnum}; @@ -118,11 +148,13 @@ sub upload { } } + $log->info('finish'); } sub spool_upload { my %opt = @_; + my $log = FS::Log->new('spool_upload'); warn "$me spool_upload called\n" if $DEBUG; my $conf = new FS::Conf; @@ -142,6 +174,8 @@ sub spool_upload { my $dbh = dbh; my $agentnum = $opt{agentnum}; + $log->debug('start', agentnum => $agentnum); + my $agent; if ( $agentnum ) { $agent = qsearchs( 'agent', { agentnum => $agentnum } ) @@ -159,6 +193,8 @@ sub spool_upload { { warn "$me neither $dir/$file-header.csv nor ". "$dir/$file-detail.csv found\n" if $DEBUG > 1; + $log->debug("finish (neither $file-header.csv nor ". + "$file-detail.csv found)"); $dbh->commit or die $dbh->errstr if $oldAutoCommit; return; } @@ -169,19 +205,6 @@ sub spool_upload { my $username = $opt{username} or die "no username for agent $agentnum\n"; my $password = $opt{password} or die "no password for agent $agentnum\n"; - # a better way? - if ($opt{m}) { - my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ". - "WHERE queue.job='FS::cust_main::queued_bill' AND cust_main.agentnum = ?"; - my $sth = $dbh->prepare($sql) or die $dbh->errstr; - while (1) { - $sth->execute( $agentnum ) - or die "Unexpected error executing statement $sql: ". $sth->errstr; - last if $sth->fetchrow_arrayref->[0]; - sleep 300; - } - } - foreach ( qw ( header detail ) ) { rename "$dir/$file-$_.csv", "$dir/$file-$date-$_.csv"; @@ -241,7 +264,7 @@ sub spool_upload { else { #not billco my $targetnum = $opt{targetnum}; - my $ftp_target = FS::ftp_target->by_key($targetnum) + my $upload_target = FS::upload_target->by_key($targetnum) or die "FTP target $targetnum not found\n"; $dir .= "/target$targetnum"; @@ -251,6 +274,7 @@ sub spool_upload { unless ( -f "$dir/$file.csv" ) { warn "$me $dir/$file.csv not found\n" if $DEBUG > 1; + $log->debug("finish ($dir/$file.csv not found)"); $dbh->commit or die $dbh->errstr if $oldAutoCommit; return; } @@ -316,57 +340,179 @@ sub spool_upload { warn "compressing to $zipfile\n$command\n" if $DEBUG; system($command) and die "$command failed\n"; - my $connection = $ftp_target->connect; # dies on error - $connection->put($zipfile); + my $error = $upload_target->put($zipfile); + if ( $error ) { + foreach ( qw ( header detail ) ) { + rename "$dir/$file-$date-$_.csv", + "$dir/$file-$_.csv"; + die $error; + } + } - my $template = join("\n",$conf->config('bridgestone-confirm_template')); - if ( $template ) { - my $tmpl_obj = Text::Template->new( - TYPE => 'STRING', SOURCE => $template - ); - my $content = $tmpl_obj->fill_in( HASH => + send_email( + prepare_report('bridgestone-confirm_template', { + agentnum=> $agentnum, zipfile => $zipfile, prefix => $prefix, seq => $seq, rows => $rows, } - ); - my ($head, $body) = split("\n\n", $content, 2); - $head =~ /^subject:\s*(.*)$/im; - my $subject = $1; - - $head =~ /^to:\s*(.*)$/im; - my $to = $1; - - send_email( - to => $to, - from => $conf->config('invoice_from', $agentnum), - subject => $subject, - body => $body, - ); - } else { #!$template - warn "$me agent $agentnum has no bridgestone-confirm_template, no email sent\n"; - } + ) + ); $seq++; warn "setting batch counter to $seq\n" if $DEBUG; $conf->set('bridgestone-batch_counter', $seq, $agentnum); - } else { # not bridgestone + } elsif ( $opt{'handling'} eq 'ics' ) { + + my ($basename, $regfile, $bigfile); + $basename = sprintf('c%sc1', time2str('%m%d', time)); + $regfile = $basename . 'i.txt'; # for "regular" (short) invoices + $bigfile = $basename . 'b.txt'; # for "big" invoices + + warn "copying spool to $regfile, $bigfile\n" if $DEBUG; + + my ($in, $reg, $big); #filehandles + my %count = (B => 0, 1 => 0, 2 => 0); # number of invoices + my %sum = (B => 0, R => 0); # total of charges field + open $in, '<', "$dir/$file-$date.csv" + or die "unable to read $file-$date.csv\n"; + + open $reg, '>', "$dir/$regfile" or die "unable to write $regfile\n"; + open $big, '>', "$dir/$bigfile" or die "unable to write $bigfile\n"; + + while (my $line = <$in>) { + chomp($line); + my $tag = substr($line, -1, 1, ''); + my $charge = substr($line, 252, 10); + if ( $tag eq 'B' ) { + print $big $line, "\n"; + $count{B}++; + $sum{B} += $charge; + } else { + print $reg $line, "\n"; + $count{$tag}++; + $sum{R} += $charge; + } + } + close $in; + close $reg; + close $big; + + # zip up all three files for transport + my $zipfile = "$basename" . '.zip'; + my $command = "cd $dir; zip $zipfile $regfile $bigfile"; + system($command) and die "'$command' failed\n"; + + # upload them, unless we're using email, in which case + # the zip file will ride along with the report. yes, this + # kind of defeats the purpose of the upload_target interface, + # but at least we have a place to store the configuration. + my $error = ''; + if ( $upload_target->protocol ne 'email' ) { + $error = $upload_target->put("$dir/$zipfile"); + } + + # create the report + for (values %sum) { + $_ = sprintf('%.2f', $_); + } + + my %report = prepare_report('ics-confirm_template', + { + agentnum => $agentnum, + count => \%count, + sum => \%sum, + error => $error, + } + ); + if ( $upload_target->protocol eq 'email' ) { + $report{'to'} = + join('@', $upload_target->username, $upload_target->hostname); + $report{'subject'} = $upload_target->subject; + $report{'mimeparts'} = [ + { Path => "$dir/$zipfile", + Type => 'application/zip', + Encoding => 'base64', + Filename => $zipfile, + Disposition => 'attachment', + } + ]; + } + $error = send_email(%report); + + if ( $error ) { + # put the original spool file back + rename "$dir/$file-$date.csv", "$dir/$file.csv"; + die $error; + } + + } else { # not bridgestone or ics # this is the usual case - my $connection = $ftp_target->connect; # dies on error - $connection->put("$file-$date.csv"); + my $error = $upload_target->put("$file-$date.csv"); + if ( $error ) { + rename "$dir/$file-$date.csv", "$dir/$file.csv"; + die $error; + } } } #opt{handling} + $log->debug('finish', agentnum => $agentnum); + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } +=item prepare_report CONFIG PARAMS + +Retrieves the config value named CONFIG, parses it as a Text::Template, +extracts "to" and "subject" headers, and returns a hash that can be passed +to L<FS::Misc::send_email>. + +PARAMS is a hashref to be passed to C<fill_in>. It must contain +'agentnum' to look up the per-agent config. + +=cut + +# we used it twice, so it's now a subroutine + +sub prepare_report { + + my ($config, $params) = @_; + my $agentnum = $params->{agentnum}; + my $conf = FS::Conf->new; + + my $template = join("\n", $conf->config($config, $agentnum)); + if (!$template) { + warn "$me agent $agentnum has no $config, no email report sent\n"; + return; + } + + my $tmpl_obj = Text::Template->new( + TYPE => 'STRING', SOURCE => $template + ); + my $content = $tmpl_obj->fill_in( HASH => $params ); + my ($head, $body) = split("\n\n", $content, 2); + $head =~ /^subject:\s*(.*)$/im; + my $subject = $1; + + $head =~ /^to:\s*(.*)$/im; + my $to = $1; + + ( + to => $to, + from => $conf->config('invoice_from', $agentnum), + subject => $subject, + body => $body, + ); + +} + 1; diff --git a/FS/FS/CurrentUser.pm b/FS/FS/CurrentUser.pm index bcd337d2c..d272066e0 100644 --- a/FS/FS/CurrentUser.pm +++ b/FS/FS/CurrentUser.pm @@ -1,6 +1,6 @@ package FS::CurrentUser; -use vars qw($CurrentUser $upgrade_hack); +use vars qw($CurrentUser $CurrentSession $upgrade_hack); #not at compile-time, circular dependancey causes trouble #use FS::Record qw(qsearchs); @@ -10,22 +10,30 @@ $upgrade_hack = 0; =head1 NAME -FS::CurrentUser - Package representing the current user +FS::CurrentUser - Package representing the current user (and session) =head1 SYNOPSIS =head1 DESCRIPTION +=head1 CLASS METHODS + +=over 4 + +=item load_user USERNAME + +Sets the current user to the provided username + =cut sub load_user { - my( $class, $user ) = @_; #, $pass + my( $class, $username, %opt ) = @_; if ( $upgrade_hack ) { return $CurrentUser = new FS::CurrentUser::BootstrapUser; } - #return "" if $user =~ /^fs_(queue|selfservice)$/; + #return "" if $username =~ /^fs_(queue|selfservice)$/; #not the best thing in the world... eval "use FS::Record qw(qsearchs);"; @@ -33,20 +41,115 @@ sub load_user { eval "use FS::access_user;"; die $@ if $@; - $CurrentUser = qsearchs('access_user', { - 'username' => $user, - #'_password' => - 'disabled' => '', - } ); + my %hash = ( 'username' => $username, + 'disabled' => '', + ); + + $CurrentUser = qsearchs('access_user', \%hash) and return $CurrentUser; + + die "unknown user: $username" unless $opt{'autocreate'}; + + $CurrentUser = new FS::access_user \%hash; + $CurrentUser->set($_, $opt{$_}) foreach qw( first last ); + my $error = $CurrentUser->insert; + die $error if $error; #better way to handle this error? + + my $template_user = + $opt{'template_user'} + || FS::Conf->new->config('external_auth-access_group-template_user'); + + if ( $template_user ) { + + my $tmpl_access_user = + qsearchs('access_user', { 'username' => $template_user } ); + + if ( $tmpl_access_user ) { + eval "use FS::access_usergroup;"; + die $@ if $@; - die "unknown user: $user" unless $CurrentUser; # or bad password + foreach my $tmpl_access_usergroup + ($tmpl_access_user->access_usergroup) { + my $access_usergroup = new FS::access_usergroup { + 'usernum' => $CurrentUser->usernum, + 'groupnum' => $tmpl_access_usergroup->groupnum, + }; + my $error = $access_usergroup->insert; + if ( $error ) { + #shouldn't happen, but seems better to proceed than to die + warn "error inserting access_usergroup: $error"; + }; + } + + } else { + warn "template username $template_user not found\n"; + } + + } else { + warn "no access template user for autocreated user $username\n"; + } $CurrentUser; } +=item new_session + +Creates a new session for the current user and returns the session key + +=cut + +use vars qw( @saltset ); +@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '+' , '/' ); + +sub new_session { + my( $class ) = @_; + + #not the best thing in the world... + eval "use FS::access_user_session;"; + die $@ if $@; + + my $sessionkey = join('', map $saltset[int(rand(scalar @saltset))], 0..39); + + my $access_user_session = new FS::access_user_session { + 'sessionkey' => $sessionkey, + 'usernum' => $CurrentUser->usernum, + 'start_date' => time, + }; + my $error = $access_user_session->insert; + die $error if $error; + + return $sessionkey; + +} + +=item load_user_session SESSION_KEY + +Sets the current user via the provided session key + +=cut + +sub load_user_session { + my( $class, $sessionkey ) = @_; + + #not the best thing in the world... + eval "use FS::Record qw(qsearchs);"; + die $@ if $@; + eval "use FS::access_user_session;"; + die $@ if $@; + + $CurrentSession = qsearchs('access_user_session', { + 'sessionkey' => $sessionkey, + #XXX check for timed out but not-yet deleted sessions here + }) or return ''; + + $CurrentSession->touch_last_date; + + $CurrentUser = $CurrentSession->access_user; + +} + =head1 BUGS -Creepy crawlies +Minimal docs =head1 SEE ALSO diff --git a/FS/FS/GeocodeCache.pm b/FS/FS/GeocodeCache.pm new file mode 100644 index 000000000..7829c4df2 --- /dev/null +++ b/FS/FS/GeocodeCache.pm @@ -0,0 +1,209 @@ +package FS::GeocodeCache; + +use strict; +use vars qw($conf $DEBUG); +use base qw( FS::geocode_Mixin ); +use FS::Record qw( qsearch qsearchs ); +use FS::Conf; +use FS::Misc::Geo; + +use Data::Dumper; + +FS::UID->install_callback( sub { $conf = new FS::Conf; } ); + +$DEBUG = 0; + +=head1 NAME + +FS::GeocodeCache - An address undergoing the geocode process. + +=head1 SYNOPSIS + + use FS::GeocodeCache; + + $record = FS::GeocodeCache->standardize(%location_hash); + +=head1 DESCRIPTION + +An FS::GeocodeCache object represents a street address in the process of +being geocoded. FS::GeocodeCache inherits from FS::geocode_Mixin. + +Most methods on this object throw an exception on error. + +FS::GeocodeCache has the following fields, with the same meaning as in +L<FS::cust_location>: + +=over 4 + +=item address1 + +=item address2 + +=item city + +=item county + +=item state + +=item zip + +=item latitude + +=item longitude + +=item addr_clean + +=item country + +=item censustract + +=item geocode + +=item district + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new cache object. For internal use. See C<standardize>. + +=cut + +# minimalist constructor +sub new { + my $class = shift; + my $self = { + company => '', + address1 => '', + address2 => '', + city => '', + state => '', + zip => '', + country => '', + latitude => '', + longitude => '', + addr_clean => '', + censustract => '', + @_ + }; + bless $self, $class; +} + +# minimalist accessor, for compatibility with geocode_Mixin +sub get { + $_[0]->{$_[1]} +} + +sub set { + $_[0]->{$_[1]} = $_[2]; +} + +sub location_hash { %{$_[0]} }; + +=item set_censustract + +Look up the censustract, if it's not already filled in, and return it. +On error, sets 'error' and returns nothing. + +This uses the "get_censustract_*" methods in L<FS::Misc::Geo>; currently +the only one is 'ffiec'. + +=cut + +sub set_censustract { + my $self = shift; + + if ( $self->get('censustract') =~ /^\d{9}\.\d{2}$/ ) { + return $self->get('censustract'); + } + my $censusyear = $conf->config('census_year'); + return if !$censusyear; + + my $method = 'ffiec'; + # configurable censustract-only lookup goes here if it's ever needed. + $method = "get_censustract_$method"; + my $censustract = eval { FS::Misc::Geo->$method($self, $censusyear) }; + $self->set("censustract_error", $@); + $self->set("censustract", $censustract); +} + +=item set_coord + +Set the latitude and longitude fields if they're not already set. Returns +those values, in order. + +=cut + +sub set_coord { # the one in geocode_Mixin will suffice + my $self = shift; + if ( !$self->get('latitude') || !$self->get('longitude') ) { + $self->SUPER::set_coord; + $self->set('coord_error', $@); + } + return $self->get('latitude'), $self->get('longitude'); +} + +=head1 CLASS METHODS + +=over 4 + +=item standardize LOCATION + +Given a location hash or L<FS::geocode_Mixin> object, standardize the +address using the configured method and return an L<FS::GeocodeCache> +object. + +The methods are the "standardize_*" functions in L<FS::Geo::Misc>. + +=cut + +sub standardize { + my $class = shift; + my $location = shift; + $location = { $location->location_hash } + if UNIVERSAL::can($location, 'location_hash'); + + local $Data::Dumper::Terse = 1; + warn "standardizing location:\n".Dumper($location) if $DEBUG; + + my $method = $conf->config('address_standardize_method'); + + if ( $method ) { + $method = "standardize_$method"; + my $new_location = eval { FS::Misc::Geo->$method( $location ) }; + if ( $new_location ) { + $location = { + addr_clean => 'Y', + %$new_location + # standardize_* can return an address with addr_clean => '' if + # the address is somehow questionable + } + } + else { + # XXX need an option to decide what to do on error + $location->{'addr_clean'} = ''; + $location->{'error'} = $@; + } + warn "result:\n".Dumper($location) if $DEBUG; + } + # else $location = $location + my $cache = $class->new(%$location); + return $cache; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/IP_Mixin.pm b/FS/FS/IP_Mixin.pm new file mode 100644 index 000000000..fdeb51da7 --- /dev/null +++ b/FS/FS/IP_Mixin.pm @@ -0,0 +1,305 @@ +package FS::IP_Mixin; + +use strict; +use NetAddr::IP; +use FS::addr_block; +use FS::router; +use FS::Record qw(qsearch); +use FS::Conf; +# careful about importing anything here--it will end up in a LOT of +# namespaces + +use vars qw(@subclasses $DEBUG $conf); + +$DEBUG = 0; + +# any subclass that can have IP addresses needs to be added here +@subclasses = (qw(FS::svc_broadband FS::svc_acct)); + +sub conf { + $conf ||= FS::Conf->new; +} + +=head1 NAME + +FS::IP_Mixin - Mixin class for objects that have IP addresses assigned. + +=head1 INTERFACE + +The inheritor may provide the following methods: + +=over 4 + +=item ip_addr [ ADDRESS ] + +Get/set the IP address, as a string. If the inheritor is also an +L<FS::Record> subclass and has an 'ip_addr' field, that field will be +used. Otherwise an C<ip_addr> method must be defined. + +=item addr_block [ BLOCK ] + +Get/set the address block, as an L<FS::addr_block> object. By default, +the 'blocknum' field will be used. + +=item router [ ROUTER ] + +Get/set the router, as an L<FS::router> object. By default, the +'routernum' field will be used. This is strictly optional; if present +the IP address can be assigned from all those available on a router, +rather than in a specific block. + +=item _used_addresses [ BLOCK ] + +Return a list of all addresses in use (within BLOCK, if it's specified). +The inheritor should cache this if possible. + +=item _is_used ADDRESS + +Test a specific address for availability. Should return an empty string +if it's free, or else a description of who or what is using it. + +=back + +=head1 METHODS + +=over 4 + +=item ip_check + +The method that should be called from check() in the subclass. This does +the following: + +- In an C<auto_router> situation, sets the router and block to match the + object's IP address. +- Otherwise, if the router and IP address are both set, validate the + choice of router and set the block correctly. +- Otherwise, if the router is set, assign an address (in the selected + block if there is one). +- Check the IP address for availability. + +Returns an error if this fails for some reason (an address can't be +assigned from the requested router/block, or the requested address is +unavailable, or doesn't seem to be an IP address). + +If router and IP address are both empty, this will do nothing. The +object's check() method should decide whether to allow a null IP address. + +=cut + +sub ip_check { + my $self = shift; + + if ( $self->ip_addr eq '0.0.0.0' ) { #ipv6? + $self->ip_addr(''); + } + + if ( $self->ip_addr + and !$self->router + and $self->conf->exists('auto_router') ) { + # assign a router that matches this IP address + return $self->check_ip_addr || $self->assign_router; + } + if ( my $router = $self->router ) { + if ( $router->manual_addr ) { + # Router is set, and it's set to manual addressing, so + # clear blocknum and don't tamper with ip_addr. + $self->addr_block(undef); + } else { + my $block = $self->addr_block; + if ( !$block or !$block->manual_flag ) { + my $error = $self->assign_ip_addr; + return $error if $error; + } + # otherwise block is set to manual addressing + } + } + return $self->check_ip_addr; +} + +=item assign_ip_addr + +Set the IP address to a free address in the selected block (C<addr_block>) +or router (C<router>) for this object. A block or router MUST be selected. +If the object already has an IP address and it is in that block/router's +address space, it won't be changed. + +=cut + +sub assign_ip_addr { + my $self = shift; + my %opt = @_; + + my @blocks; + my $na = $self->NetAddr; + + if ( $self->addr_block ) { + # choose an address in a specific block. + @blocks = ( $self->addr_block ); + } elsif ( $self->router ) { + # choose an address from any block on a specific router. + @blocks = $self->router->auto_addr_block; + } else { + # what else should we do, search ALL blocks? that's crazy. + die "no block or router specified for assign_ip_addr\n"; + } + + my $new_addr; + my $new_block; + foreach my $block (@blocks) { + if ( $self->ip_addr and $block->NetAddr->contains($na) ) { + return ''; + } + # don't exit early on assigning a free address--check the rest of + # the blocks to see if the current address is in one of them. + if (!$new_addr) { + $new_addr = $block->next_free_addr->addr; + $new_block = $block; + } + } + + return 'No IP address available on this router' unless $new_addr; + + $self->ip_addr($new_addr); + $self->addr_block($new_block); + ''; +} + +=item assign_router + +If the IP address is set, set the router and block accordingly. If there +is no block containing that address, returns an error. + +=cut + +sub assign_router { + my $self = shift; + return '' unless $self->ip_addr; + my $na = $self->NetAddr; + foreach my $router (qsearch('router', {})) { + foreach my $block ($router->addr_block) { + if ( $block->NetAddr->contains($na) ) { + $self->addr_block($block); + $self->router($router); + return ''; + } + } + } + return $self->ip_addr . ' is not in an allowed block.'; +} + +=item check_ip_addr + +Validate the IP address. Returns an empty string if it's correct and +available (or null), otherwise an error message. + +=cut + +sub check_ip_addr { + my $self = shift; + my $addr = $self->ip_addr; + return '' if $addr eq ''; + my $na = $self->NetAddr + or return "Can't parse address '$addr'"; + if ( my $block = $self->addr_block ) { + if ( !$block->NetAddr->contains($na) ) { + return "Address $addr not in block ".$block->cidr; + } + } + # this returns '' if the address is in use by $self. + if ( my $dup = $self->is_used($self->ip_addr) ) { + return "Address $addr in use by $dup"; + } + ''; +} + +# sensible defaults +sub addr_block { + my $self = shift; + if ( @_ ) { + my $new = shift; + if ( defined $new ) { + die "addr_block() must take an address block" + unless $new->isa('FS::addr_block'); + $self->blocknum($new->blocknum); + return $new; + } else { + #$new is undef + $self->blocknum(''); + return undef; + } + } + # could cache this... + FS::addr_block->by_key($self->blocknum); +} + +sub router { + my $self = shift; + if ( @_ ) { + my $new = shift; + if ( defined $new ) { + die "router() must take a router" + unless $new->isa('FS::router'); + $self->routernum($new->routernum); + return $new; + } else { + #$new is undef + $self->routernum(''); + return undef; + } + } + FS::router->by_key($self->routernum); +} + +=item used_addresses [ BLOCK ] + +Returns a list of all addresses (in BLOCK, or in all blocks) +that are in use. If called as an instance method, excludes +that instance from the search. + +=cut + +sub used_addresses { + my $self = shift; + my $block = shift; + return ( map { $_->_used_addresses($block, $self) } @subclasses ); +} + +sub _used_addresses { + my $class = shift; + die "$class->_used_addresses not implemented"; +} + +=item is_used ADDRESS + +Returns a string describing what object is using ADDRESS, or +an empty string if it's not in use. + +=cut + +sub is_used { + my $self = shift; + my $addr = shift; + for (@subclasses) { + my $used = $_->_is_used($addr, $self); + return $used if $used; + } + ''; +} + +sub _is_used { + my $class = shift; + die "$class->_is_used not implemented"; +} + +=back + +=head1 BUGS + +We can't reliably check for duplicate addresses across tables. A +more robust implementation would be to put all assigned IP addresses +in a single table with a unique index. We do a best-effort check +anyway, but it has a race condition. + +=cut + +1; diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm deleted file mode 100644 index 5038cf352..000000000 --- a/FS/FS/InitHandler.pm +++ /dev/null @@ -1,91 +0,0 @@ -package FS::InitHandler; - -# this leaks memory under graceful restarts and i wouldn't use it on any -# modern server. useful for very slow machines with memory to spare, just -# always do a full restart - -use strict; -use vars qw($DEBUG); -use FS::UID qw(adminsuidsetup); -use FS::Record; - -$DEBUG = 1; - -sub handler { - - use Date::Format; - use Date::Parse; - use Tie::IxHash; - use HTML::Entities; - use IO::Handle; - use IO::File; - use String::Approx; - use HTML::Widgets::SelectLayers 0.02; - #use FS::UID; - #use FS::Record; - use FS::Conf; - use FS::CGI; - use FS::Msgcat; - - use FS::agent; - use FS::agent_type; - use FS::domain_record; - use FS::cust_bill; - use FS::cust_bill_pay; - use FS::cust_credit; - use FS::cust_credit_bill; - use FS::cust_main; - use FS::cust_main_county; - use FS::cust_pay; - use FS::cust_pkg; - use FS::cust_refund; - use FS::cust_svc; - use FS::nas; - use FS::part_bill_event; - use FS::part_pkg; - use FS::part_referral; - use FS::part_svc; - use FS::pkg_svc; - use FS::port; - use FS::queue; - use FS::raddb; - use FS::session; - use FS::svc_acct; - use FS::svc_acct_pop; - use FS::svc_domain; - use FS::svc_forward; - use FS::svc_www; - use FS::type_pkgs; - use FS::part_export; - use FS::part_export_option; - use FS::export_svc; - use FS::msgcat; - - warn "[FS::InitHandler] handler called\n" if $DEBUG; - - #this is sure to be broken on freebsd - $> = $FS::UID::freeside_uid; - - open(MAPSECRETS,"<$FS::UID::conf_dir/mapsecrets") - or die "can't read $FS::UID::conf_dir/mapsecrets: $!"; - - my %seen; - while (<MAPSECRETS>) { - next if /^\s*(#|$)/; - /^([\w\-\.]+)\s(.*)$/ - or do { warn "strange line in mapsecrets: $_"; next; }; - my($user, $datasrc) = ($1, $2); - next if $seen{$datasrc}++; - warn "[FS::InitHandler] preloading $datasrc for $user\n" if $DEBUG; - adminsuidsetup($user); - } - - close MAPSECRETS; - - #lalala probably broken on freebsd - ($<, $>) = ($>, $<); - $< = 0; - -} - -1; diff --git a/FS/FS/L10N/en_us.pm b/FS/FS/L10N/en_us.pm index 6ad136be0..ed936a5d4 100644 --- a/FS/FS/L10N/en_us.pm +++ b/FS/FS/L10N/en_us.pm @@ -1,6 +1,8 @@ package FS::L10N::en_us; -use base qw(FS::L10N); +use base qw(FS::L10N::DBI); -our %Lexicon = ( _AUTO=>1 ); +#prevents english "translation" via FS::L10N::DBI, FS::Msgcat::_gettext already +# does the same sort of fallback +#our %Lexicon = ( _AUTO=>1 ); 1; diff --git a/FS/FS/Log.pm b/FS/FS/Log.pm new file mode 100644 index 000000000..b11630bc9 --- /dev/null +++ b/FS/FS/Log.pm @@ -0,0 +1,103 @@ +package FS::Log; + +use base 'Log::Dispatch'; +use FS::Record qw(qsearch qsearchs); +use FS::Conf; +use FS::Log::Output; +use FS::log; +use vars qw(@STACK @LEVELS); + +# override the stringification of @_ with something more sensible. +BEGIN { + @LEVELS = qw(debug info notice warning error critical alert emergency); + + foreach my $l (@LEVELS) { + my $sub = sub { + my $self = shift; + $self->log( level => $l, message => @_ ); + }; + no strict 'refs'; + *{$l} = $sub; + } +} + +=head1 NAME + +FS::Log - Freeside event log + +=head1 SYNOPSIS + +use FS::Log; + +sub do_something { + my $log = FS::Log->new('do_something'); # set log context to 'do_something' + + ... + if ( $error ) { + $log->error('something is wrong: '.$error); + return $error; + } + # at this scope exit, do_something is removed from context +} + +=head1 DESCRIPTION + +FS::Log provides an interface for logging errors and profiling information +to the database. FS::Log inherits from L<Log::Dispatch>. + +=head1 CLASS METHODS + +=over 4 + +new CONTEXT + +Constructs and returns a log handle. CONTEXT must be a known context tag +indicating what activity is going on, such as the name of the function or +script that is executing. + +Log context is a stack, and each element is removed from the stack when it +goes out of scope. So don't keep log handles in persistent places (i.e. +package variables or class-scoped lexicals). + +=cut + +sub new { + my $class = shift; + my $context = shift; + + my $min_level = FS::Conf->new->config('event_log_level') || 'info'; + + my $self = $class->SUPER::new( + outputs => [ [ '+FS::Log::Output', min_level => $min_level ] ], + ); + $self->{'index'} = scalar(@STACK); + push @STACK, $context; + return $self; +} + +=item context + +Returns the current context stack. + +=cut + +sub context { @STACK }; + +=item log LEVEL, MESSAGE[, OPTIONS ] + +Like L<Log::Dispatch::log>, but OPTIONS may include: + +- agentnum +- object (an <FS::Record> object to reference in this log message) +- tablename and tablenum (an alternate way of specifying 'object') + +=cut + +# inherited + +sub DESTROY { + my $self = shift; + splice(@STACK, $self->{'index'}, 1); # delete the stack entry +} + +1; diff --git a/FS/FS/Log/Output.pm b/FS/FS/Log/Output.pm new file mode 100644 index 000000000..18d7f1b43 --- /dev/null +++ b/FS/FS/Log/Output.pm @@ -0,0 +1,50 @@ +package FS::Log::Output; + +use base Log::Dispatch::Output; +use FS::Record qw( dbdef ); + +sub new { # exactly by the book + my $proto = shift; + my $class = ref $proto || $proto; + + my %p = @_; + + my $self = bless {}, $class; + + $self->_basic_init(%p); + + return $self; +} + +sub log_message { + my $self = shift; + my %m = @_; + + my $object = $m{'object'}; + my ($tablename, $tablenum) = @m{'tablename', 'tablenum'}; + if ( $object and $object->isa('FS::Record') ) { + $tablename = $object->table; + $tablenum = $object->get( dbdef->table($tablename)->primary_key ); + + # get the agentnum from the object if it has one + $m{'agentnum'} ||= $object->get('agentnum'); + # maybe FS::cust_main_Mixin objects should use the customer's agentnum? + # I'm trying not to do database lookups in here, though. + } + + my $entry = FS::log->new({ + _date => time, + agentnum => $m{'agentnum'}, + tablename => ($tablename || ''), + tablenum => ($tablenum || ''), + level => $self->_level_as_number($m{'level'}), + message => $m{'message'}, + }); + my $error = $entry->insert( FS::Log->context ); + if ( $error ) { + # guh? + warn "Error writing log entry: $error"; + } +} + +1; diff --git a/FS/FS/Maestro.pm b/FS/FS/Maestro.pm deleted file mode 100644 index 399e7406f..000000000 --- a/FS/FS/Maestro.pm +++ /dev/null @@ -1,249 +0,0 @@ -package FS::Maestro; - -use strict; -use Date::Format; -use FS::Conf; -use FS::Record qw( qsearchs ); -use FS::cust_main; -use FS::cust_pkg; -use FS::part_svc; - -#i guess this is kind of deprecated in favor of service_status, but keeping it -#around until they say they don't need it. -sub customer_status { - my( $custnum ) = shift; #@_; - my $svcnum = @_ ? shift : ''; - - my $curuser = $FS::CurrentUser::CurrentUser; - - my $cust_main = qsearchs({ - 'table' => 'cust_main', - 'hashref' => { 'custnum' => $custnum }, - 'extra_sql' => ' AND '. $curuser->agentnums_sql, - }) - or return { 'status' => 'E', - 'error' => "custnum $custnum not found" }; - - return service_status($svcnum) if $svcnum; - - ### - # regular customer to maestro (single package) - ### - - my %result = (); - - my @cust_pkg = $cust_main->cust_pkg; - - #things specific to the non-reseller scenario - - $result{'status'} = substr($cust_main->ucfirst_status,0,1); - - $result{'products'} = - [ map $_->pkgpart, grep !$_->get('cancel'), @cust_pkg ]; - - #find svc_pbx - - my @cust_svc = map $_->cust_svc, @cust_pkg; - - my @cust_svc_pbx = - grep { my($n,$l,$t) = $_->label; $t eq 'svc_pbx' } - @cust_svc; - - if ( ! @cust_svc_pbx ) { - return { 'status' => 'E', - 'error' => "customer $custnum has no conference service" }; - } elsif ( scalar(@cust_svc_pbx) > 1 ) { - return { 'status' => 'E', - 'error' => - "customer $custnum has more than one conference". - " service (reseller?); specify a svcnum as a second argument", - }; - } - - my $cust_svc_pbx = $cust_svc_pbx[0]; - - my $svc_pbx = $cust_svc_pbx->svc_x; - - # find "outbound service" y/n - - my $conf = new FS::Conf; - my %outbound_pkgs = map { $_=>1 } $conf->config('mc-outbound_packages'); - $result{'outbound_service'} = - scalar( grep { $outbound_pkgs{ $_->pkgpart } - && !$_->get('cancel') - } - @cust_pkg - ) - ? 1 : 0; - - # find "good till" date/time stamp - - my @active_cust_pkg = - sort { $a->bill <=> $b->bill } - grep { !$_->get('cancel') && $_->part_pkg->freq ne '0' } - @cust_pkg; - $result{'good_till'} = time2str('%c', $active_cust_pkg[0]->bill || time ); - - return { - 'name' => $cust_main->name, - 'email' => $cust_main->invoicing_list_emailonly_scalar, - #'agentnum' => $cust_main->agentnum, - #'agent' => $cust_main->agent->agent, - 'max_lines' => $svc_pbx ? $svc_pbx->max_extensions : '', - 'max_simultaneous' => $svc_pbx ? $svc_pbx->max_simultaneous : '', - %result, - }; - -} - -sub service_status { - my $svcnum = shift; - - my $svc_pbx = qsearchs({ - 'table' => 'svc_pbx', - 'addl_from' => ' LEFT JOIN cust_svc USING ( svcnum ) '. - ' LEFT JOIN cust_pkg USING ( pkgnum ) ', - 'hashref' => { 'svcnum' => $svcnum }, - #'extra_sql' => " AND custnum = $custnum", - }) - or return { 'status' => 'E', - 'error' => "svcnum $svcnum not found" }; - - my $cust_pkg = $svc_pbx->cust_svc->cust_pkg; - my $cust_main = $cust_pkg->cust_main; - - my %result = (); - - #status in the reseller scenario - $result{'status'} = substr($cust_pkg->ucfirst_status,0,1); - $result{'status'} = 'A' if $result{'status'} eq 'N'; - - # find "outbound service" y/n - my @cust_pkg = $cust_main->cust_pkg; - #XXX what about outbound service per-reseller ? - my $conf = new FS::Conf; - my %outbound_pkgs = map { $_=>1 } $conf->config('mc-outbound_packages'); - $result{'outbound_service'} = - scalar( grep { $outbound_pkgs{ $_->pkgpart } - && !$_->get('cancel') - } - @cust_pkg - ) - ? 1 : 0; - - # find "good till" date/time stamp (this package) - $result{'good_till'} = time2str('%c', $cust_pkg->bill || time ); - - return { - 'custnum' => $cust_main->custnum, - 'name' => ( $svc_pbx->title || $cust_main->name ), - 'email' => $cust_main->invoicing_list_emailonly_scalar, - #'agentnum' => $cust_main->agentnum, - #'agent' => $cust_main->agent->agent, - 'max_lines' => $svc_pbx->max_extensions, - 'max_simultaneous' => $svc_pbx->max_simultaneous, - %result, - }; - -} - -#some false laziness w/ MyAccount order_pkg -sub order_pkg { - my $opt = ref($_[0]) ? shift : { @_ }; - - $opt->{'title'} = delete $opt->{'name'} - if !exists($opt->{'title'}) && exists($opt->{'name'}); - - my $custnum = $opt->{'custnum'}; - - my $curuser = $FS::CurrentUser::CurrentUser; - - my $cust_main = qsearchs({ - 'table' => 'cust_main', - 'hashref' => { 'custnum' => $custnum }, - 'extra_sql' => ' AND '. $curuser->agentnums_sql, - }) - or return { 'error' => "custnum $custnum not found" }; - - my $status = $cust_main->status; - #false laziness w/ClientAPI/Signup.pm - - my $cust_pkg = new FS::cust_pkg ( { - 'custnum' => $custnum, - 'pkgpart' => $opt->{'pkgpart'}, - } ); - my $error = $cust_pkg->check; - return { 'error' => $error } if $error; - - my @svc = (); - unless ( $opt->{'svcpart'} eq 'none' ) { - - my $svcpart = ''; - if ( $opt->{'svcpart'} =~ /^(\d+)$/ ) { - $svcpart = $1; - } else { - $svcpart = $cust_pkg->part_pkg->svcpart; #($svcdb); - } - - my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } ); - return { 'error' => "Unknown svcpart $svcpart" } unless $part_svc; - - my $svcdb = $part_svc->svcdb; - - my %fields = ( - 'svc_acct' => [ qw( username domsvc _password sec_phrase popnum ) ], - 'svc_domain' => [ qw( domain ) ], - 'svc_phone' => [ qw( phonenum pin sip_password phone_name ) ], - 'svc_external' => [ qw( id title ) ], - 'svc_pbx' => [ qw( id title ) ], - ); - - my $svc_x = "FS::$svcdb"->new( { - 'svcpart' => $svcpart, - map { $_ => $opt->{$_} } @{$fields{$svcdb}} - } ); - - #snarf processing not necessary here (or probably at all, anymore) - - my $y = $svc_x->setdefault; # arguably should be in new method - return { 'error' => $y } if $y && !ref($y); - - $error = $svc_x->check; - return { 'error' => $error } if $error; - - push @svc, $svc_x; - - } - - use Tie::RefHash; - tie my %hash, 'Tie::RefHash'; - %hash = ( $cust_pkg => \@svc ); - #msgcat - $error = $cust_main->order_pkgs( \%hash, 'noexport' => 1 ); - return { 'error' => $error } if $error; - -# currently they're using this in the reseller scenario, so don't -# bill the package immediately -# my $conf = new FS::Conf; -# if ( $conf->exists('signup_server-realtime') ) { -# -# my $bill_error = _do_bop_realtime( $cust_main, $status ); -# -# if ($bill_error) { -# $cust_pkg->cancel('quiet'=>1); -# return $bill_error; -# } else { -# $cust_pkg->reexport; -# } -# -# } else { - $cust_pkg->reexport; -# } - - my $svcnum = $svc[0] ? $svc[0]->svcnum : ''; - - return { error=>'', pkgnum=>$cust_pkg->pkgnum, svcnum=>$svcnum }; - -} - -1; diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 11af25efa..6c12e8110 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -56,6 +56,8 @@ if ( -e $addl_handler_use_file ) { #use CGI::Carp qw(fatalsToBrowser); use CGI::Cookie; use List::Util qw( max min sum ); + use List::MoreUtils qw( first_index uniq ); + use Scalar::Util qw( blessed ); use Data::Dumper; use Date::Format; use Time::Local; @@ -64,7 +66,7 @@ if ( -e $addl_handler_use_file ) { use DateTime; use DateTime::Format::Strptime; use FS::Misc::DateTime qw( parse_datetime ); - use FS::Misc::Geo qw( get_censustract get_district ); + use FS::Misc::Geo qw( get_district ); use Lingua::EN::Inflect qw(PL); Lingua::EN::Inflect::classical names=>0; #Categorys use Tie::IxHash; @@ -75,13 +77,14 @@ if ( -e $addl_handler_use_file ) { use HTML::TableExtract qw(tree); use HTML::FormatText; use HTML::Defang; - use JSON; + use JSON::XS; # use XMLRPC::Transport::HTTP; # use XMLRPC::Lite; # for XMLRPC::Serializer use MIME::Base64; use IO::Handle; use IO::File; use IO::Scalar; + use IO::String; #not actually using this yet anyway...# use IPC::Run3 0.036; use Net::Whois::Raw qw(whois); if ( $] < 5.006 ) { @@ -118,12 +121,14 @@ if ( -e $addl_handler_use_file ) { use HTML::Widgets::SelectLayers 0.07; #should go away in favor of #selectlayers.html use Locale::Country; + use Locale::Currency; + use Locale::Currency::Format; use Business::US::USPS::WebTools::AddressStandardization; use Geo::GoogleEarth::Pluggable; use LWP::UserAgent; use Storable qw( nfreeze thaw ); use FS; - use FS::UID qw( getotaker dbh datasrc driver_name ); + use FS::UID qw( dbh datasrc driver_name ); use FS::Record qw( qsearch qsearchs fields dbdef str2time_sql str2time_sql_closing midnight_sql @@ -157,6 +162,7 @@ if ( -e $addl_handler_use_file ) { use FS::cust_credit; use FS::cust_credit_bill; use FS::cust_main; + use FS::h_cust_main; use FS::cust_main::Search qw(smart_search); use FS::cust_main::Import; use FS::cust_main_county; @@ -312,7 +318,7 @@ if ( -e $addl_handler_use_file ) { use FS::access_groupsales; use FS::contact_class; use FS::part_svc_class; - use FS::ftp_target; + use FS::upload_target; use FS::quotation; use FS::quotation_pkg; use FS::quotation_pkg_discount; @@ -326,6 +332,20 @@ if ( -e $addl_handler_use_file ) { use FS::cust_bill_pkg_discount_void; use FS::agent_pkg_class; use FS::svc_export_machine; + use FS::GeocodeCache; + use FS::log; + use FS::log_context; + use FS::part_pkg_usage_class; + use FS::cust_pkg_usage; + use FS::part_pkg_usage_class; + use FS::part_pkg_usage; + use FS::cdr_cust_pkg_usage; + use FS::part_pkg_msgcat; + use FS::svc_cable; + use FS::cable_device; + use FS::agent_currency; + use FS::currency_exchange; + use FS::part_pkg_currency; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Mason/Request.pm b/FS/FS/Mason/Request.pm index 36c46dc41..5d6fc4cd4 100644 --- a/FS/FS/Mason/Request.pm +++ b/FS/FS/Mason/Request.pm @@ -69,7 +69,7 @@ sub freeside_setup { FS::Trace->log(' handling RT REST/NoAuth file'); package HTML::Mason::Commands; #? - use FS::UID qw( adminsuidsetup ); + use FS::UID qw( adminsuidsetup setcgi ); #need to log somebody in for the mail gw @@ -86,14 +86,15 @@ sub freeside_setup { package HTML::Mason::Commands; use vars qw( $cgi $p $fsurl ); # $lh ); #not using /mt use Encode; - use FS::UID qw( cgisuidsetup ); + #use FS::UID qw( cgisuidsetup ); use FS::CGI qw( popurl rooturl ); if ( $mode eq 'apache' ) { $cgi = new CGI; - FS::Trace->log(' cgisuidsetup'); - &cgisuidsetup($cgi); - #&cgisuidsetup($r); + setcgi($cgi); + + #cgisuidsetup is gone, equivalent is now done in AuthCookieHandler + $fsurl = rooturl(); $p = popurl(2); } elsif ( $mode eq 'standalone' ) { @@ -106,19 +107,19 @@ sub freeside_setup { die "unknown mode $mode"; } - FS::Trace->log(' UTF-8-decoding form data'); - # - foreach my $param ( $cgi->param ) { - my @values = $cgi->param($param); - next if $cgi->uploadInfo($values[0]); - #warn $param; - @values = map decode(utf8=>$_), @values; - $cgi->param($param, @values); + FS::Trace->log(' UTF-8-decoding form data'); + # + foreach my $param ( $cgi->param ) { + my @values = $cgi->param($param); + next if $cgi->uploadInfo($values[0]); + #warn $param; + @values = map decode(utf8=>$_), @values; + $cgi->param($param, @values); + } + } - - } - FS::Trace->log(' done'); + FS::Trace->log(' done'); } diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index a1c15fdf8..9c18961ea 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -108,7 +108,7 @@ use Date::Format; use MIME::Entity; use Email::Sender::Simple qw(sendmail); use Email::Sender::Transport::SMTP; -use Email::Sender::Transport::SMTP::TLS; +use Email::Sender::Transport::SMTP::TLS 0.11; use FS::UID; FS::UID->install_callback( sub { @@ -171,8 +171,15 @@ sub send_email { } + my $from = $options{from}; + $from =~ s/^\s*//; $from =~ s/\s*$//; + if ( $from =~ /^(.*)\s*<(.*@.*)>$/ ) { + # a common idiom + $from = $2; + } + my $domain; - if ( $options{'from'} =~ /\@([\w\.\-]+)/ ) { + if ( $from =~ /\@([\w\.\-]+)/ ) { $domain = $1; } else { warn 'no domain found in invoice from address '. $options{'from'}. @@ -247,7 +254,7 @@ sub send_email { push @to, $options{bcc} if defined($options{bcc}); local $@; # just in case eval { sendmail($message, { transport => $transport, - from => $options{from}, + from => $from, to => \@to }) }; my $error = ''; @@ -274,6 +281,7 @@ sub send_email { }); $cust_msg->insert; # ignore errors } + $error; } @@ -413,6 +421,20 @@ sub process_send_email { ''; } +=item process_send_generated_email OPTION => VALUE ... + +Takes arguments as per send_email() and sends the message. This +will die on any error and can be used in the job queue. + +=cut + +sub process_send_generated_email { + my %args = @_; + my $error = send_email(%args); + die "$error\n" if $error; + ''; +} + =item send_fax OPTION => VALUE ... Options: @@ -698,7 +720,8 @@ sub generate_ps { open(POSTSCRIPT, "<$file.ps") or die "can't open $file.ps: $! (error in LaTeX template?)\n"; - unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex"); + unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex") + unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting'); my $ps = ''; @@ -756,7 +779,8 @@ sub generate_pdf { open(PDF, "<$file.pdf") or die "can't open $file.pdf: $! (error in LaTeX template?)\n"; - unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex"); + unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex") + unless $FS::CurrentUser::CurrentUser->option('save_tmp_typesetting'); my $pdf = ''; while (<PDF>) { @@ -799,16 +823,32 @@ sub _pslatex { } -=item do_print ARRAYREF +=item do_print ARRAYREF [, OPTION => VALUE ... ] Sends the lines in ARRAYREF to the printer. +Options available are: + +=over 4 + +=item agentnum + +Uses this agent's 'lpr' configuration setting override instead of the global +value. + +=item lpr + +Uses this command instead of the configured lpr command (overrides both the +global value and agentnum). + =cut sub do_print { - my $data = shift; + my( $data, %opt ) = @_; - my $lpr = $conf->config('lpr'); + my $lpr = ( exists($opt{'lpr'}) && $opt{'lpr'} ) + ? $opt{'lpr'} + : $conf->config('lpr', $opt{'agentnum'} ); my $outerr = ''; run3 $lpr, $data, \$outerr, \$outerr; diff --git a/FS/FS/Misc/DateTime.pm b/FS/FS/Misc/DateTime.pm index e36f3a95a..2fff90647 100644 --- a/FS/FS/Misc/DateTime.pm +++ b/FS/FS/Misc/DateTime.pm @@ -2,8 +2,8 @@ package FS::Misc::DateTime; use base qw( Exporter ); use vars qw( @EXPORT_OK ); -use POSIX; use Carp; +use Time::Local; use Date::Parse; use DateTime::Format::Natural; use FS::Conf; @@ -32,13 +32,14 @@ the date as an integer UNIX timestamp. sub parse_datetime { my $string = shift; return '' unless $string =~ /\S/; + my $tz = shift || 'local'; my $conf = new FS::Conf; my $format = $conf->config('date_format') || '%m/%d/%Y'; if ( $format eq '%d/%m/%Y' ) { # =~ /\%d.*\%m/ ) { #$format =~ s/\%//g; - my $parser = DateTime::Format::Natural->new( 'time_zone' => 'local', + my $parser = DateTime::Format::Natural->new( 'time_zone' => $tz, #'format'=>'d/m/y',#lc($format) ); $dt = $parser->parse_datetime($string); @@ -48,34 +49,27 @@ sub parse_datetime { #carp "WARNING: can't parse date: ". $parser->error; #return ''; #huh, very common, we still need the "partially" (fully enough for our purposes) parsed date. - $dt->epoch; + return $dt->epoch; } } else { - return str2time($string); + return str2time($string, $tz); } } =item day_end TIME -If the next-bill-ignore-time configuration setting is turned off, just -returns the passed-in value. - -If the next-bill-ignore-time configuration setting is turned on, parses TIME -as an integer UNIX timestamp and returns a new timestamp with the same date but -23:59:59 for the time. +Parses TIME as an integer UNIX timestamp and returns a new timestamp with the +same date but 23:59:59 for the time. =cut sub day_end { my $time = shift; - my $conf = new FS::Conf; - return $time unless $conf->exists('next-bill-ignore-time'); - my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time); - mktime(59,59,23,$mday,$mon,$year,$wday,$yday,$isdst); + timelocal(59,59,23,$mday,$mon,$year); } =back diff --git a/FS/FS/Misc/Geo.pm b/FS/FS/Misc/Geo.pm index 5d6f33cb7..a93d98f93 100644 --- a/FS/FS/Misc/Geo.pm +++ b/FS/FS/Misc/Geo.pm @@ -2,23 +2,28 @@ package FS::Misc::Geo; use strict; use base qw( Exporter ); -use vars qw( $DEBUG @EXPORT_OK ); +use vars qw( $DEBUG @EXPORT_OK $conf ); use LWP::UserAgent; use HTTP::Request; use HTTP::Request::Common qw( GET POST ); use HTML::TokeParser; use URI::Escape 3.31; use Data::Dumper; +use FS::Conf; + +FS::UID->install_callback( sub { + $conf = new FS::Conf; +} ); $DEBUG = 0; -@EXPORT_OK = qw( get_censustract get_district ); +@EXPORT_OK = qw( get_district ); =head1 NAME FS::Misc::Geo - routines to fetch geographic information -=head1 FUNCTIONS +=head1 CLASS METHODS =over 4 @@ -30,7 +35,8 @@ codes) or an error message. =cut -sub get_censustract { +sub get_censustract_ffiec { + my $class = shift; my $location = shift; my $year = shift; @@ -45,7 +51,7 @@ sub get_censustract { my $res = $ua->request( GET( $url ) ); warn $res->as_string - if $DEBUG > 1; + if $DEBUG > 2; unless ($res->code eq '200') { @@ -75,7 +81,7 @@ sub get_censustract { my($zip5, $zip4) = split('-',$location->{zip}); - $year ||= '2011'; #2012 per http://transition.fcc.gov/form477/techfaqs.html soon/now? + $year ||= '2012'; my @ffiec_args = ( __VIEWSTATE => $viewstate, __EVENTVALIDATION => $eventvalidation, @@ -87,12 +93,12 @@ sub get_censustract { btnSearch => 'Search', ); warn join("\n", @ffiec_args ) - if $DEBUG; + if $DEBUG > 1; push @{ $ua->requests_redirectable }, 'POST'; $res = $ua->request( POST( $url, \@ffiec_args ) ); warn $res->as_string - if $DEBUG > 1; + if $DEBUG > 2; unless ($res->code eq '200') { @@ -102,7 +108,7 @@ sub get_censustract { my @id = qw( MSACode StateCode CountyCode TractCode ); $content = $res->content; - warn $res->content if $DEBUG > 1; + warn $res->content if $DEBUG > 2; $p = new HTML::TokeParser \$content; my $prefix = 'UcGeoResult11_lb'; my $compare = @@ -127,15 +133,15 @@ sub get_censustract { } #unless ($res->code eq '200') - return "FFIEC Geocoding error: $error" if $error; + die "FFIEC Geocoding error: $error\n" if $error; $return->{'statecode'} . $return->{'countycode'} . $return->{'tractcode'}; } -sub get_district_methods { - '' => '', - 'wa_sales' => 'Washington sales tax', -}; +#sub get_district_methods { +# '' => '', +# 'wa_sales' => 'Washington sales tax', +#}; =item get_district LOCATION METHOD @@ -201,12 +207,12 @@ sub wa_sales { my $query_string = join($delim, @args ); $url .= "?$query_string"; - warn "\nrequest: $url\n\n" if $DEBUG; + warn "\nrequest: $url\n\n" if $DEBUG > 1; my $res = $ua->request( GET( "$url?$query_string" ) ); warn $res->as_string - if $DEBUG > 1; + if $DEBUG > 2; if ($res->code ne '200') { $error = $res->message; @@ -253,7 +259,7 @@ sub wa_sales { # just to make sure if ( $return->{'district'} =~ /^\d+$/ and $return->{'tax'} =~ /^.\d+$/ ) { $return->{'tax'} *= 100; #percentage - warn Dumper($return) if $DEBUG; + warn Dumper($return) if $DEBUG > 1; return $return; } else { @@ -267,6 +273,143 @@ sub wa_sales { die "WA tax district lookup error: $error"; } +sub standardize_usps { + my $class = shift; + + eval "use Business::US::USPS::WebTools::AddressStandardization"; + die $@ if $@; + + my $location = shift; + if ( $location->{country} ne 'US' ) { + # soft failure + warn "standardize_usps not for use in country ".$location->{country}."\n"; + $location->{addr_clean} = ''; + return $location; + } + my $userid = $conf->config('usps_webtools-userid'); + my $password = $conf->config('usps_webtools-password'); + my $verifier = Business::US::USPS::WebTools::AddressStandardization->new( { + UserID => $userid, + Password => $password, + Testing => 0, + } ) or die "error starting USPS WebTools\n"; + + my($zip5, $zip4) = split('-',$location->{'zip'}); + + my %usps_args = ( + FirmName => $location->{company}, + Address2 => $location->{address1}, + Address1 => $location->{address2}, + City => $location->{city}, + State => $location->{state}, + Zip5 => $zip5, + Zip4 => $zip4, + ); + warn join('', map "$_: $usps_args{$_}\n", keys %usps_args ) + if $DEBUG > 1; + + my $hash = $verifier->verify_address( %usps_args ); + + warn $verifier->response + if $DEBUG > 1; + + die "USPS WebTools error: ".$verifier->{error}{description} ."\n" + if $verifier->is_error; + + my $zip = $hash->{Zip5}; + $zip .= '-' . $hash->{Zip4} if $hash->{Zip4} =~ /\d/; + + { company => $hash->{FirmName}, + address1 => $hash->{Address2}, + address2 => $hash->{Address1}, + city => $hash->{City}, + state => $hash->{State}, + zip => $zip, + country => 'US', + addr_clean=> 'Y' } +} + +my %ezlocate_error = ( # USA_Geo_002 documentation + 10 => 'State not found', + 11 => 'City not found', + 12 => 'Invalid street address', + 14 => 'Street name not found', + 15 => 'Address range does not exist', + 16 => 'Ambiguous address', + 17 => 'Intersection not found', #unused? +); + +sub standardize_ezlocate { + my $self = shift; + my $location = shift; + my $class; + #if ( $location->{country} eq 'US' ) { + # $class = 'USA_Geo_004Tool'; + #} + #elsif ( $location->{country} eq 'CA' ) { + # $class = 'CAN_Geo_001Tool'; + #} + #else { # shouldn't be a fatal error, just pass through unverified address + # warn "standardize_teleatlas: address lookup in '".$location->{country}. + # "' not available\n"; + # return $location; + #} + #my $path = $conf->config('teleatlas-path') || ''; + #local @INC = (@INC, $path); + #eval "use $class;"; + #if ( $@ ) { + # die "Loading $class failed:\n$@". + # "\nMake sure the TeleAtlas Perl SDK is installed correctly.\n"; + #} + + $class = 'Geo::EZLocate'; # use our own library + eval "use $class 0.02"; #Geo::EZLocate 0.02 for error handling + die $@ if $@; + + my $userid = $conf->config('ezlocate-userid') + or die "no ezlocate-userid configured\n"; + my $password = $conf->config('ezlocate-password') + or die "no ezlocate-password configured\n"; + + my $tool = $class->new($userid, $password); + my $match = $tool->findAddress( + $location->{address1}, + $location->{city}, + $location->{state}, + $location->{zip}, #12345-6789 format is allowed + ); + warn "ezlocate returned match:\n".Dumper($match) if $DEBUG > 1; + # error handling - B codes indicate success + die $ezlocate_error{$match->{MAT_STAT}}."\n" + unless $match->{MAT_STAT} =~ /^B\d$/; + + my %result = ( + address1 => $match->{MAT_ADDR}, + address2 => $location->{address2}, + city => $match->{MAT_CITY}, + state => $match->{MAT_ST}, + country => $location->{country}, + zip => $match->{MAT_ZIP}, + latitude => $match->{MAT_LAT}, + longitude => $match->{MAT_LON}, + censustract => $match->{FIPS_ST}.$match->{FIPS_CTY}. + sprintf('%07.2f',$match->{CEN_TRCT}), + addr_clean => 'Y', + ); + if ( $match->{STD_ADDR} ) { + # then they have a postal standardized address for us + %result = ( %result, + address1 => $match->{STD_ADDR}, + address2 => $location->{address2}, + city => $match->{STD_CITY}, + state => $match->{STD_ST}, + zip => $match->{STD_ZIP}.'-'.$match->{STD_P4}, + ); + } + + \%result; +} + =back =cut diff --git a/FS/FS/Misc/Invoicing.pm b/FS/FS/Misc/Invoicing.pm index 2fc52a99b..92138c2a7 100644 --- a/FS/FS/Misc/Invoicing.pm +++ b/FS/FS/Misc/Invoicing.pm @@ -19,7 +19,7 @@ Returns a list of the invoice spool formats. =cut sub spool_formats { - qw(default oneline billco bridgestone) + qw(default oneline billco bridgestone ics) } 1; diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index ca68c3596..be355213f 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -12,19 +12,19 @@ use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG use Exporter; use Carp qw(carp cluck croak confess); use Scalar::Util qw( blessed ); +use File::Slurp qw( slurp ); use File::CounterFile; -use Locale::Country; use Text::CSV_XS; -use File::Slurp qw( slurp ); use DBI qw(:sql_types); use DBIx::DBSchema 0.38; -use FS::UID qw(dbh getotaker datasrc driver_name); +use Locale::Country; +use Locale::Currency; +use NetAddr::IP; # for validation +use FS::UID qw(dbh datasrc driver_name); use FS::CurrentUser; use FS::Schema qw(dbdef); use FS::SearchCache; use FS::Msgcat qw(gettext); -use NetAddr::IP; # for validation -use Data::Dumper; #use FS::Conf; #dependency loop bs, in install_callback below instead use FS::part_virtual_field; @@ -458,7 +458,13 @@ sub qsearch { # grep defined( $record->{$_} ) && $record->{$_} ne '', @fields # ) or croak "Error executing \"$statement\": ". $sth->errstr; - $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr; + my $ok = $sth->execute; + if (!$ok) { + my $error = "Error executing \"$statement\""; + $error .= ' (' . join(', ', map {"'$_'"} @value) . ')' if @value; + $error .= ': '. $sth->errstr; + croak $error; + } my $table = $stable[0]; my $pkey = ''; @@ -1451,6 +1457,7 @@ sub process_batch_import { format_sep_chars => $opt->{format_sep_chars}, format_fixedlength_formats => $opt->{format_fixedlength_formats}, format_xml_formats => $opt->{format_xml_formats}, + format_asn_formats => $opt->{format_asn_formats}, format_row_callbacks => $opt->{format_row_callbacks}, #per-import job => $job, @@ -1521,6 +1528,7 @@ csv, xls, fixedlength, xml =cut +use Data::Dumper; sub batch_import { my $param = shift; @@ -1533,8 +1541,9 @@ sub batch_import { my $file = $param->{file}; my $params = $param->{params} || {}; - my( $type, $header, $sep_char, $fixedlength_format, - $xml_format, $row_callback, @fields ); + my( $type, $header, $sep_char, + $fixedlength_format, $xml_format, $asn_format, + $row_callback, @fields ); my $postinsert_callback = ''; $postinsert_callback = $param->{'postinsert_callback'} @@ -1572,6 +1581,11 @@ sub batch_import { ? $param->{'format_xml_formats'}{ $param->{'format'} } : ''; + $asn_format = + $param->{'format_asn_formats'} + ? $param->{'format_asn_formats'}{ $param->{'format'} } + : ''; + $row_callback = $param->{'format_row_callbacks'} ? $param->{'format_row_callbacks'}{ $param->{'format'} } @@ -1611,11 +1625,12 @@ sub batch_import { my $count; my $parser; my @buffer = (); + my $asn_header_buffer; if ( $type eq 'csv' || $type eq 'fixedlength' ) { if ( $type eq 'csv' ) { - my %attr = (); + my %attr = ( 'binary' => 1, ); $attr{sep_char} = $sep_char if $sep_char; $parser = new Text::CSV_XS \%attr; @@ -1652,7 +1667,9 @@ sub batch_import { $count++; $row = $header || 0; + } elsif ( $type eq 'xml' ) { + # FS::pay_batch eval "use XML::Simple;"; die $@ if $@; @@ -1668,6 +1685,26 @@ sub batch_import { $rows = $rows->{$_} foreach @$xmlrow; $rows = [ $rows ] if ref($rows) ne 'ARRAY'; $count = @buffer = @$rows; + + } elsif ( $type eq 'asn.1' ) { + + eval "use Convert::ASN1"; + die $@ if $@; + + my $asn = Convert::ASN1->new; + $asn->prepare( $asn_format->{'spec'} ) or die $asn->error; + + $parser = $asn->find( $asn_format->{'macro'} ) or die $asn->error; + + my $data = slurp($file); + my $asn_output = $parser->decode( $data ) + or return "No ". $asn_format->{'macro'}. " found\n"; + + $asn_header_buffer = &{ $asn_format->{'header_buffer'} }( $asn_output ); + + my $rows = &{ $asn_format->{'arrayref'} }( $asn_output ); + $count = @buffer = @$rows; + } else { die "Unknown file type $type\n"; } @@ -1711,6 +1748,7 @@ sub batch_import { while (1) { my @columns = (); + my %hash = %$params; if ( $type eq 'csv' ) { last unless scalar(@buffer); @@ -1747,16 +1785,27 @@ sub batch_import { #warn $z++. ": $_\n" for @columns; } elsif ( $type eq 'xml' ) { + # $parser = [ 'Column0Key', 'Column1Key' ... ] last unless scalar(@buffer); my $row = shift @buffer; @columns = @{ $row }{ @$parser }; + + } elsif ( $type eq 'asn.1' ) { + + last unless scalar(@buffer); + my $row = shift @buffer; + &{ $asn_format->{row_callback} }( $row, $asn_header_buffer ) + if $asn_format->{row_callback}; + foreach my $key ( keys %{ $asn_format->{map} } ) { + $hash{$key} = &{ $asn_format->{map}{$key} }( $row, $asn_header_buffer ); + } + } else { die "Unknown file type $type\n"; } my @later = (); - my %hash = %$params; foreach my $field ( @fields ) { @@ -1833,7 +1882,7 @@ sub batch_import { return "Empty file!"; } - $dbh->commit or die $dbh->errstr if $oldAutoCommit;; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error @@ -1859,9 +1908,13 @@ sub _h_statement { my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields; "INSERT INTO h_". $self->table. " ( ". - join(', ', qw(history_date history_user history_action), @fields ). + join(', ', qw(history_date history_usernum history_action), @fields ). ") VALUES (". - join(', ', $time, dbh->quote(getotaker()), dbh->quote($action), @values). + join(', ', $time, + $FS::CurrentUser::CurrentUser->usernum, + dbh->quote($action), + @values + ). ")" ; } @@ -1892,11 +1945,6 @@ sub unique { #warn "field $field is tainted" if is_tainted($field); my($counter) = new File::CounterFile "$table.$field",0; -# hack for web demo -# getotaker() =~ /^([\w\-]{1,16})$/ or die "Illegal CGI REMOTE_USER!"; -# my($user)=$1; -# my($counter) = new File::CounterFile "$user/$table.$field",0; -# endhack my $index = $counter->inc; $index = $counter->inc while qsearchs($table, { $field=>$index } ); @@ -2051,11 +2099,18 @@ is an error, returns the error, otherwise returns false. sub ut_money { my($self,$field)=@_; - $self->setfield($field, 0) if $self->getfield($field) eq ''; - $self->getfield($field) =~ /^\s*(\-)?\s*(\d*)(\.\d{2})?\s*$/ - or return "Illegal (money) $field: ". $self->getfield($field); - #$self->setfield($field, "$1$2$3" || 0); - $self->setfield($field, ( ($1||''). ($2||''). ($3||'') ) || 0); + + if ( $self->getfield($field) eq '' ) { + $self->setfield($field, 0); + } elsif ( $self->getfield($field) =~ /^\s*(\-)?\s*(\d*)(\.\d{1})\s*$/ ) { + #handle one decimal place without barfing out + $self->setfield($field, ( ($1||''). ($2||''). ($3.'0') ) || 0); + } elsif ( $self->getfield($field) =~ /^\s*(\-)?\s*(\d*)(\.\d{2})?\s*$/ ) { + $self->setfield($field, ( ($1||''). ($2||''). ($3||'') ) || 0); + } else { + return "Illegal (money) $field: ". $self->getfield($field); + } + ''; } @@ -2075,6 +2130,41 @@ sub ut_moneyn { $self->ut_money($field); } +=item ut_currencyn COLUMN + +Check/untaint currency indicators, such as USD or EUR. May be null. If there +is an error, returns the error, otherwise returns false. + +=cut + +sub ut_currencyn { + my($self, $field) = @_; + if ($self->getfield($field) eq '') { #can be null + $self->setfield($field, ''); + return ''; + } + $self->ut_currency($field); +} + +=item ut_currency COLUMN + +Check/untaint currency indicators, such as USD or EUR. May not be null. If +there is an error, returns the error, otherwise returns false. + +=cut + +sub ut_currency { + my($self, $field) = @_; + my $value = uc( $self->getfield($field) ); + if ( code2currency($value) ) { + $self->setfield($value); + } else { + return "Unknown currency $value"; + } + + ''; +} + =item ut_text COLUMN Check/untaint text. Alphanumerics, spaces, and the following punctuation @@ -2466,10 +2556,29 @@ sub ut_name { # warn "ut_name allowed alphanumerics: +(sort grep /\w/, map { chr() } 0..255), "\n"; $self->getfield($field) =~ /^([\w \,\.\-\']+)$/ or return gettext('illegal_name'). " $field: ". $self->getfield($field); - $self->setfield($field,$1); + my $name = $1; + $name =~ s/^\s+//; + $name =~ s/\s+$//; + $name =~ s/\s+/ /g; + $self->setfield($field, $name); ''; } +=item ut_namen COLUMN + +Check/untaint proper names; allows alphanumerics, spaces and the following +punctuation: , . - ' + +May not be null. + +=cut + +sub ut_namen { + my( $self, $field ) = @_; + return $self->setfield($field, '') if $self->getfield($field) =~ /^$/; + $self->ut_name($field); +} + =item ut_zip COLUMN Check/untaint zip codes. diff --git a/FS/FS/Report/FCC_477.pm b/FS/FS/Report/FCC_477.pm index 49bb8a852..fd088148b 100644 --- a/FS/FS/Report/FCC_477.pm +++ b/FS/FS/Report/FCC_477.pm @@ -22,26 +22,26 @@ Documentation. =cut @upload = qw( - <200kpbs - 200-768kpbs + <200kbps + 200-768kbps 768kbps-1.5mbps 1.5-3mpbs 3-6mbps 6-10mbps 10-25mbps 25-100mbps - >100bmps + >100mbps ); @download = qw( - 200-768kpbs + 200-768kbps 768kbps-1.5mbps - 1.5-3mpbs + 1.5-3mbps 3-6mbps 6-10mbps 10-25mbps 25-100mbps - >100bmps + >100mbps ); @technology = ( diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm index 73eed6e0c..2e202e5d9 100644 --- a/FS/FS/Report/Table.pm +++ b/FS/FS/Report/Table.pm @@ -56,6 +56,13 @@ sub signups { push @where, "refnum = ".$opt{'refnum'}; } + if ( $opt{'cust_classnum'} ) { + my $classnums = $opt{'cust_classnum'}; + $classnums = [ $classnums ] if !ref($classnums); + @$classnums = grep /^\d+$/, @$classnums; + push @where, 'cust_main.classnum in('. join(',',@$classnums) .')'; + } + $self->scalar_sql( "SELECT COUNT(*) FROM cust_main $join WHERE ".join(' AND ', @where) ); @@ -68,9 +75,15 @@ sub signups { sub invoiced { #invoiced my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; + my $sql = 'SELECT SUM(cust_bill.charged) FROM cust_bill'; + if ( $opt{'setuprecur'} ) { + $sql = 'SELECT SUM('. + FS::cust_bill_pkg->charged_sql($speriod, $eperiod, %opt). + ') FROM cust_bill_pkg JOIN cust_bill USING (invnum)'; + } + $self->scalar_sql(" - SELECT SUM(charged) - FROM cust_bill + $sql LEFT JOIN cust_main USING ( custnum ) WHERE ". $self->in_time_period_and_agent($speriod, $eperiod, $agentnum). $self->for_opts(%opt) @@ -162,9 +175,16 @@ sub refunds { sub netcredits { my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; + + my $sql = 'SELECT SUM(cust_credit_bill.amount) FROM cust_credit_bill'; + if ( $opt{'setuprecur'} ) { + $sql = 'SELECT SUM('. + FS::cust_bill_pkg->credited_sql($speriod, $eperiod, %opt). + ') FROM cust_bill_pkg'; + } + $self->scalar_sql(" - SELECT SUM(cust_credit_bill.amount) - FROM cust_credit_bill + $sql LEFT JOIN cust_bill USING ( invnum ) LEFT JOIN cust_main USING ( custnum ) WHERE ". $self->in_time_period_and_agent( $speriod, @@ -182,9 +202,16 @@ sub netcredits { sub receipts { #net payments my( $self, $speriod, $eperiod, $agentnum, %opt ) = @_; + + my $sql = 'SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay'; + if ( $opt{'setuprecur'} ) { + $sql = 'SELECT SUM('. + FS::cust_bill_pkg->paid_sql($speriod, $eperiod, %opt). + ') FROM cust_bill_pkg'; + } + $self->scalar_sql(" - SELECT SUM(cust_bill_pay.amount) - FROM cust_bill_pay + $sql LEFT JOIN cust_bill USING ( invnum ) LEFT JOIN cust_main USING ( custnum ) WHERE ". $self->in_time_period_and_agent( $speriod, @@ -419,7 +446,15 @@ sub cust_bill_pkg_setup { $self->in_time_period_and_agent($speriod, $eperiod, $agentnum), ); - push @where, 'cust_main.refnum = '. $opt{'refnum'} if $opt{'refnum'}; + # yuck, false laziness + push @where, "cust_main.refnum = ". $opt{'refnum'} if $opt{'refnum'}; + + if ( $opt{'cust_classnum'} ) { + my $classnums = $opt{'cust_classnum'}; + $classnums = [ $classnums ] if !ref($classnums); + @$classnums = grep /^\d+$/, @$classnums; + push @where, 'cust_main.classnum in('. join(',',@$classnums) .')'; + } my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0) FROM cust_bill_pkg @@ -443,6 +478,13 @@ sub cust_bill_pkg_recur { push @where, 'cust_main.refnum = '. $opt{'refnum'} if $opt{'refnum'}; + if ( $opt{'cust_classnum'} ) { + my $classnums = $opt{'cust_classnum'}; + $classnums = [ $classnums ] if !ref($classnums); + @$classnums = grep /^\d+$/, @$classnums; + push @where, 'cust_main.classnum in('. join(',',@$classnums) .')'; + } + # subtract all usage from the line item regardless of date my $item_usage; if ( $opt{'project'} ) { @@ -498,6 +540,13 @@ sub cust_bill_pkg_detail { push @where, 'cust_main.refnum = '. $opt{'refnum'} if $opt{'refnum'}; + if ( $opt{'cust_classnum'} ) { + my $classnums = $opt{'cust_classnum'}; + $classnums = [ $classnums ] if !ref($classnums); + @$classnums = grep /^\d+$/, @$classnums; + push @where, 'cust_main.classnum in('. join(',',@$classnums) .')'; + } + $agentnum ||= $opt{'agentnum'}; push @where, @@ -637,6 +686,14 @@ sub for_opts { if ( $opt{'refnum'} =~ /^(\d+)$/ ) { $sql .= " and refnum = $1 "; } + if ( $opt{'cust_classnum'} ) { + my $classnums = $opt{'cust_classnum'}; + $classnums = [ $classnums ] if !ref($classnums); + @$classnums = grep /^\d+$/, @$classnums; + $sql .= ' and cust_main.classnum in('. join(',',@$classnums) .')' + if @$classnums; + } + $sql; } diff --git a/FS/FS/Report/Table/Monthly.pm b/FS/FS/Report/Table/Monthly.pm index 86ab19b74..b8e52ae63 100644 --- a/FS/FS/Report/Table/Monthly.pm +++ b/FS/FS/Report/Table/Monthly.pm @@ -25,6 +25,7 @@ FS::Report::Table::Monthly - Tables of report data, indexed monthly #opt 'agentnum' => 54 'refnum' => 54 + 'cust_classnum' => [ 1,2,4 ], 'params' => [ [ 'paramsfor', 'item_one' ], [ 'item', 'two' ] ], # ... 'remove_empty' => 1, #collapse empty rows, default 0 'item_labels' => [ ], #useful with remove_empty @@ -32,13 +33,94 @@ FS::Report::Table::Monthly - Tables of report data, indexed monthly my $data = $report->data; -=head1 METHODS +=head1 PARAMETERS + +=head2 TIME PERIOD + +C<start_month>, C<start_year>, C<end_month>, and C<end_year> specify the date +range to be included in the report. The start and end months are included. +Each month's values are summed from midnight on the first of the month to +23:59:59 on the last day of the month. + +=head2 REPORT ITEMS + +=over 4 + +=item items: An arrayref of observables to calculate for each month. See +L<FS::Report::Table> for a list of observables and their parameters. + +=item params: An arrayref, parallel to C<items>, of arrayrefs of parameters +(in paired name/value form) to be passed to the observables. + +=item cross_params: Cross-product parameters. This must be an arrayref of +arrayrefs of parameters (paired name/value form). This creates an additional +"axis" (orthogonal to the time and C<items> axes) in which the item is +calculated once with each set of parameters in C<cross_params>. These +parameters are merged with those in C<params>. Instead of being nested two +levels, C<data> will be nested three levels, with the third level +corresponding to this arrayref. + +=back + +=head2 FILTERING =over 4 +=item agentnum: Limit to customers with this agent. + +=item refnum: Limit to customers with this advertising source. + +=item cust_classnum: Limit to customers with this classnum; can be an +arrayref. + +=item remove_empty: Set this to a true value to hide rows that contain +only zeroes. The C<indices> array in the returned data will list the item +indices that are actually present in the output so that you know what they +are. Ignored if C<cross_params> is in effect. + +=back + +=head2 PASS-THROUGH + +C<item_labels>, C<colors>, and C<links> may be specified as arrayrefs +parallel to C<items>. Those values will be returned in C<data>, with any +hidden rows (due to C<remove_empty>) filtered out, which is the only +reason to do this. Now that we have C<indices> it's probably better to +use that. + +=head1 RETURNED DATA + +The C<data> method runs the report and returns a hashref of the following: + +=over 4 + +=item label + +Month labels, in MM/YYYY format. + +=item speriod, eperiod + +Absolute start and end times of each month, in unix time format. + +=item items + +The values passed in as C<items>, with any suppressed rows deleted. + +=item indices + +The indices of items in the input C<items> list that appear in the result +set. Useful for figuring out what they are when C<remove_empty> has deleted +some items. + +=item item_labels, colors, links - see PASS-THROUGH above + =item data -Returns a hashref of data (!! describe) +The actual results. An arrayref corresponding to C<label> (the time axis), +containing arrayrefs corresponding to C<items>, containing either numbers +or, if C<cross_params> is given, arrayrefs corresponding to C<cross_params>. + +=back =cut @@ -61,6 +143,8 @@ sub data { my $agentnum = $self->{'agentnum'}; my $refnum = $self->{'refnum'}; + my $cust_classnum = $self->{'cust_classnum'} || []; + $cust_classnum = [ $cust_classnum ] if !ref($cust_classnum); if ( $projecting ) { @@ -88,14 +172,7 @@ sub data { while ( $syear < $max_year || ( $syear == $max_year && $smonth < $max_month+1 ) ) { - if ( $self->{'doublemonths'} ) { - my($firstLabel,$secondLabel) = @{$self->{'doublemonths'}}; - push @{$data{label}}, "$smonth/$syear $firstLabel"; - push @{$data{label}}, "$smonth/$syear $secondLabel"; - } - else { - push @{$data{label}}, "$smonth/$syear"; - } + push @{$data{label}}, "$smonth/$syear"; # sprintf? my $speriod = timelocal(0,0,0,1,$smonth-1,$syear); push @{$data{speriod}}, $speriod; @@ -108,30 +185,27 @@ sub data { my $i; for ( $i = 0; $i < scalar(@items); $i++ ) { - if ( $self->{'doublemonths'} ) { - my $item = $items[$i]; - my @param = $self->{'params'} ? @{ $self->{'params'}[$i] }: (); - push @param, 'project', $projecting; - push @param, 'refnum' => $refnum if $refnum; - my $value = $self->$item($speriod, $eperiod, $agentnum, @param); - push @{$data{data}->[$col]}, $value; - $item = $items[$i+1]; - @param = $self->{'params'} ? @{ $self->{'params'}[++$i] }: (); - push @param, 'project', $projecting; - push @param, 'refnum' => $refnum if $refnum; - $value = $self->$item($speriod, $eperiod, $agentnum, @param); - push @{$data{data}->[$col++]}, $value; - } - else { - my $item = $items[$i]; - my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: (); - push @param, 'project', $projecting; - push @param, 'refnum' => $refnum if $refnum; + my $item = $items[$i]; + my @param = $self->{'params'} ? @{ $self->{'params'}[$col] }: (); + push @param, 'project', $projecting; + push @param, 'refnum' => $refnum if $refnum; + push @param, 'cust_classnum' => $cust_classnum if @$cust_classnum; + + if ( $self->{'cross_params'} ) { + my @xdata; + foreach my $xparam (@{ $self->{'cross_params'} }) { + # @$xparam is a list of additional params to merge into the list + my $value = $self->$item($speriod, $eperiod, $agentnum, + @param, + @$xparam); + push @xdata, $value; + } + push @{$data{data}->[$col++]}, \@xdata; + } else { my $value = $self->$item($speriod, $eperiod, $agentnum, @param); push @{$data{data}->[$col++]}, $value; } } - } #these need to get generalized, sheesh @@ -140,7 +214,7 @@ sub data { $data{'colors'} = $self->{'colors'}; $data{'links'} = $self->{'links'} || []; - if ( $self->{'remove_empty'} ) { + if ( !$self->{'cross_params'} and $self->{'remove_empty'} ) { my $col = 0; #these need to get generalized, sheesh @@ -186,8 +260,6 @@ sub data { =head1 BUGS -Documentation. - =head1 SEE ALSO =cut diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index fb1f1d69b..6df45e2b1 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -187,10 +187,11 @@ sub dbdef_dist { my $tables_hashref_torrus = tables_hashref_torrus(); - #create history tables (false laziness w/create-history-tables) + #create history tables foreach my $table ( - grep { ! /^clientapi_session/ + grep { ! /^(clientapi|access_user)_session/ && ! /^h_/ + && ! /^log(_context)?$/ && ! $tables_hashref_torrus->{$_} } $dbdef->tables @@ -235,6 +236,12 @@ sub dbdef_dist { } + my $historynum_type = ( $tableobj->column($tableobj->primary_key)->type + =~ /^(bigserial|bigint|int8)$/i + ? 'bigserial' + : 'serial' + ); + my $h_tableobj = DBIx::DBSchema::Table->new( { 'name' => "h_$table", 'primary_key' => 'historynum', @@ -243,7 +250,7 @@ sub dbdef_dist { 'columns' => [ DBIx::DBSchema::Column->new( { 'name' => 'historynum', - 'type' => 'serial', + 'type' => $historynum_type, 'null' => 'NOT NULL', 'length' => '', 'default' => '', @@ -260,12 +267,20 @@ sub dbdef_dist { DBIx::DBSchema::Column->new( { 'name' => 'history_user', 'type' => 'varchar', - 'null' => 'NOT NULL', + 'null' => 'NULL', 'length' => '80', 'default' => '', 'local' => '', } ), DBIx::DBSchema::Column->new( { + 'name' => 'history_usernum', + 'type' => 'int', + 'null' => 'NULL', + 'length' => '', + 'default' => '', + 'local' => '', + } ), + DBIx::DBSchema::Column->new( { 'name' => 'history_action', 'type' => 'varchar', 'null' => 'NOT NULL', @@ -518,6 +533,17 @@ sub tables_hashref { 'index' => [ ['salesnum'], ['disabled'] ], }, + 'agent_currency' => { + 'columns' => [ + 'agentcurrencynum', 'serial', '', '', '', '', + 'agentnum', 'int', '', '', '', '', + 'currency', 'char', '', 3, '', '', + ], + 'primary_key' => 'agentcurrencynum', + 'unique' => [], + 'index' => [ ['agentnum'] ], + }, + 'cust_attachment' => { 'columns' => [ 'attachnum', 'serial', '', '', '', '', @@ -539,10 +565,11 @@ sub tables_hashref { 'cust_bill' => { 'columns' => [ #regular fields - 'invnum', 'serial', '', '', '', '', - 'custnum', 'int', '', '', '', '', - '_date', @date_type, '', '', - 'charged', @money_type, '', '', + 'invnum', 'serial', '', '', '', '', + 'custnum', 'int', '', '', '', '', + '_date', @date_type, '', '', + 'charged', @money_type, '', '', + 'currency', 'char', 'NULL', 3, '', '', 'invoice_terms', 'varchar', 'NULL', $char_d, '', '', #customer balance info at invoice generation time @@ -566,10 +593,11 @@ sub tables_hashref { 'cust_bill_void' => { 'columns' => [ #regular fields - 'invnum', 'int', '', '', '', '', - 'custnum', 'int', '', '', '', '', - '_date', @date_type, '', '', - 'charged', @money_type, '', '', + 'invnum', 'int', '', '', '', '', + 'custnum', 'int', '', '', '', '', + '_date', @date_type, '', '', + 'charged', @money_type, '', '', + 'currency', 'char', 'NULL', 3, '', '', 'invoice_terms', 'varchar', 'NULL', $char_d, '', '', #customer balance info at invoice generation time @@ -601,6 +629,7 @@ sub tables_hashref { 'custnum', 'int', '', '', '', '', '_date', @date_type, '', '', 'charged', @money_type, '', '', + 'currency', 'char', 'NULL', 3, '', '', 'content_pdf', 'blob', 'NULL', '', '', '', 'content_html', 'text', 'NULL', '', '', '', 'locale', 'varchar', 'NULL', 16, '', '', @@ -739,22 +768,26 @@ sub tables_hashref { 'cust_bill_pkg' => { 'columns' => [ - 'billpkgnum', 'serial', '', '', '', '', - 'invnum', 'int', '', '', '', '', - 'pkgnum', 'int', '', '', '', '', - 'pkgpart_override', 'int', 'NULL', '', '', '', - 'setup', @money_type, '', '', - 'recur', @money_type, '', '', - 'sdate', @date_type, '', '', - 'edate', @date_type, '', '', - 'itemdesc', 'varchar', 'NULL', $char_d, '', '', - 'itemcomment', 'varchar', 'NULL', $char_d, '', '', - 'section', 'varchar', 'NULL', $char_d, '', '', - 'freq', 'varchar', 'NULL', $char_d, '', '', - 'quantity', 'int', 'NULL', '', '', '', - 'unitsetup', @money_typen, '', '', - 'unitrecur', @money_typen, '', '', - 'hidden', 'char', 'NULL', 1, '', '', + 'billpkgnum', 'serial', '', '', '', '', + 'invnum', 'int', '', '', '', '', + 'pkgnum', 'int', '', '', '', '', + 'pkgpart_override', 'int', 'NULL', '', '', '', + 'setup', @money_type, '', '', + 'unitsetup', @money_typen, '', '', + 'setup_billed_currency', 'char', 'NULL', 3, '', '', + 'setup_billed_amount', @money_typen, '', '', + 'recur', @money_type, '', '', + 'unitrecur', @money_typen, '', '', + 'recur_billed_currency', 'char', 'NULL', 3, '', '', + 'recur_billed_amount', @money_typen, '', '', + 'sdate', @date_type, '', '', + 'edate', @date_type, '', '', + 'itemdesc', 'varchar', 'NULL', $char_d, '', '', + 'itemcomment', 'varchar', 'NULL', $char_d, '', '', + 'section', 'varchar', 'NULL', $char_d, '', '', + 'freq', 'varchar', 'NULL', $char_d, '', '', + 'quantity', 'int', 'NULL', '', '', '', + 'hidden', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'billpkgnum', 'unique' => [], @@ -771,7 +804,7 @@ sub tables_hashref { 'format', 'char', 'NULL', 1, '', '', 'classnum', 'int', 'NULL', '', '', '', 'duration', 'int', 'NULL', '', 0, '', - 'phonenum', 'varchar', 'NULL', 15, '', '', + 'phonenum', 'varchar', 'NULL', 25, '', '', 'accountcode', 'varchar', 'NULL', 20, '', '', 'startdate', @date_type, '', '', 'regionname', 'varchar', 'NULL', $char_d, '', '', @@ -800,32 +833,43 @@ sub tables_hashref { 'cust_bill_pkg_tax_location' => { 'columns' => [ - 'billpkgtaxlocationnum', 'serial', '', '', '', '', - 'billpkgnum', 'int', '', '', '', '', - 'taxnum', 'int', '', '', '', '', - 'taxtype', 'varchar', '', $char_d, '', '', - 'pkgnum', 'int', '', '', '', '', - 'locationnum', 'int', '', '', '', '', #redundant? - 'amount', @money_type, '', '', + 'billpkgtaxlocationnum', 'serial', '', '', '', '', + 'billpkgnum', 'int', '', '', '', '', + 'taxnum', 'int', '', '', '', '', + 'taxtype', 'varchar', '', $char_d, '', '', + 'pkgnum', 'int', '', '', '', '', #redundant + 'locationnum', 'int', '', '', '', '', #redundant + 'amount', @money_type, '', '', + 'currency', 'char', 'NULL', 3, '', '', + 'amount', @money_type, '', '', + 'taxable_billpkgnum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'billpkgtaxlocationnum', 'unique' => [], - 'index' => [ [ 'billpkgnum' ], [ 'taxnum' ], [ 'pkgnum' ], [ 'locationnum' ] ], + 'index' => [ [ 'billpkgnum' ], + [ 'taxnum' ], + [ 'pkgnum' ], + [ 'locationnum' ], + [ 'taxable_billpkgnum' ], + ], }, 'cust_bill_pkg_tax_rate_location' => { 'columns' => [ - 'billpkgtaxratelocationnum', 'serial', '', '', '', '', - 'billpkgnum', 'int', '', '', '', '', - 'taxnum', 'int', '', '', '', '', + 'billpkgtaxratelocationnum', 'serial', '', '', '', '', + 'billpkgnum', 'int', '', '', '', '', + 'taxnum', 'int', '', '', '', '', 'taxtype', 'varchar', '', $char_d, '', '', 'locationtaxid', 'varchar', 'NULL', $char_d, '', '', - 'taxratelocationnum', 'int', '', '', '', '', - 'amount', @money_type, '', '', + 'taxratelocationnum', 'int', '', '', '', '', + 'amount', @money_type, '', '', + 'currency', 'char', 'NULL', 3, '', '', + 'taxable_billpkgnum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'billpkgtaxratelocationnum', 'unique' => [], - 'index' => [ [ 'billpkgnum' ], [ 'taxnum' ], [ 'taxratelocationnum' ] ], + 'index' => [ [ 'billpkgnum' ], [ 'taxnum' ], [ 'taxratelocationnum' ], + [ 'taxable_billpkgnum' ], ], }, 'cust_bill_pkg_void' => { @@ -836,6 +880,8 @@ sub tables_hashref { 'pkgpart_override', 'int', 'NULL', '', '', '', 'setup', @money_type, '', '', 'recur', @money_type, '', '', + #XXX a currency for a line item? or just one for the entire invoice + #'currency', 'char', 'NULL', 3, '', '', 'sdate', @date_type, '', '', 'edate', @date_type, '', '', 'itemdesc', 'varchar', 'NULL', $char_d, '', '', @@ -866,7 +912,7 @@ sub tables_hashref { 'format', 'char', 'NULL', 1, '', '', 'classnum', 'int', 'NULL', '', '', '', 'duration', 'int', 'NULL', '', 0, '', - 'phonenum', 'varchar', 'NULL', 15, '', '', + 'phonenum', 'varchar', 'NULL', 25, '', '', 'accountcode', 'varchar', 'NULL', 20, '', '', 'startdate', @date_type, '', '', 'regionname', 'varchar', 'NULL', $char_d, '', '', @@ -895,13 +941,14 @@ sub tables_hashref { 'cust_bill_pkg_tax_location_void' => { 'columns' => [ - 'billpkgtaxlocationnum', 'int', '', '', '', '', - 'billpkgnum', 'int', '', '', '', '', - 'taxnum', 'int', '', '', '', '', - 'taxtype', 'varchar', '', $char_d, '', '', - 'pkgnum', 'int', '', '', '', '', - 'locationnum', 'int', '', '', '', '', #redundant? - 'amount', @money_type, '', '', + 'billpkgtaxlocationnum', 'int', '', '', '', '', + 'billpkgnum', 'int', '', '', '', '', + 'taxnum', 'int', '', '', '', '', + 'taxtype', 'varchar', '', $char_d, '', '', + 'pkgnum', 'int', '', '', '', '', + 'locationnum', 'int', '', '', '', '', #redundant? + 'amount', @money_type, '', '', + 'currency', 'char', 'NULL', 3, '', '', ], 'primary_key' => 'billpkgtaxlocationnum', 'unique' => [], @@ -910,13 +957,14 @@ sub tables_hashref { 'cust_bill_pkg_tax_rate_location_void' => { 'columns' => [ - 'billpkgtaxratelocationnum', 'int', '', '', '', '', - 'billpkgnum', 'int', '', '', '', '', - 'taxnum', 'int', '', '', '', '', - 'taxtype', 'varchar', '', $char_d, '', '', - 'locationtaxid', 'varchar', 'NULL', $char_d, '', '', - 'taxratelocationnum', 'int', '', '', '', '', - 'amount', @money_type, '', '', + 'billpkgtaxratelocationnum', 'int', '', '', '', '', + 'billpkgnum', 'int', '', '', '', '', + 'taxnum', 'int', '', '', '', '', + 'taxtype', 'varchar', '', $char_d, '', '', + 'locationtaxid', 'varchar', 'NULL', $char_d, '', '', + 'taxratelocationnum', 'int', '', '', '', '', + 'amount', @money_type, '', '', + 'currency', 'char', 'NULL', 3, '', '', ], 'primary_key' => 'billpkgtaxratelocationnum', 'unique' => [], @@ -925,18 +973,19 @@ sub tables_hashref { 'cust_credit' => { 'columns' => [ - 'crednum', 'serial', '', '', '', '', - 'custnum', 'int', '', '', '', '', - '_date', @date_type, '', '', - 'amount', @money_type, '', '', - 'otaker', 'varchar', 'NULL', 32, '', '', - 'usernum', 'int', 'NULL', '', '', '', - 'reason', 'text', 'NULL', '', '', '', - 'reasonnum', 'int', 'NULL', '', '', '', - 'addlinfo', 'text', 'NULL', '', '', '', - 'closed', 'char', 'NULL', 1, '', '', - 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances - 'eventnum', 'int', 'NULL', '', '', '', #triggering event for commission + 'crednum', 'serial', '', '', '', '', + 'custnum', 'int', '', '', '', '', + '_date', @date_type, '', '', + 'amount',@money_type, '', '', + 'currency', 'char', 'NULL', 3, '', '', + 'otaker', 'varchar', 'NULL', 32, '', '', + 'usernum', 'int', 'NULL', '', '', '', + 'reason', 'text', 'NULL', '', '', '', + 'reasonnum', 'int', 'NULL', '', '', '', + 'addlinfo', 'text', 'NULL', '', '', '', + 'closed', 'char', 'NULL', 1, '', '', + 'pkgnum', 'int', 'NULL', '', '','',#desired pkgnum for pkg-balances + 'eventnum', 'int', 'NULL', '', '','',#triggering event for commission #'commission_agentnum', 'int', 'NULL', '', '', '', # ], 'primary_key' => 'crednum', @@ -1010,6 +1059,7 @@ sub tables_hashref { 'latitude', 'decimal', 'NULL', '10,7', '', '', 'longitude','decimal', 'NULL', '10,7', '', '', 'coord_auto', 'char', 'NULL', 1, '', '', + 'addr_clean', 'char', 'NULL', 1, '', '', 'daytime', 'varchar', 'NULL', 20, '', '', 'night', 'varchar', 'NULL', 20, '', '', 'fax', 'varchar', 'NULL', 12, '', '', @@ -1028,10 +1078,12 @@ sub tables_hashref { 'ship_latitude', 'decimal', 'NULL', '10,7', '', '', 'ship_longitude','decimal', 'NULL', '10,7', '', '', 'ship_coord_auto', 'char', 'NULL', 1, '', '', + 'ship_addr_clean', 'char', 'NULL', 1, '', '', 'ship_daytime', 'varchar', 'NULL', 20, '', '', 'ship_night', 'varchar', 'NULL', 20, '', '', 'ship_fax', 'varchar', 'NULL', 12, '', '', 'ship_mobile', 'varchar', 'NULL', 12, '', '', + 'currency', 'char', 'NULL', 3, '', '', 'payby', 'char', '', 4, '', '', 'payinfo', 'varchar', 'NULL', 512, '', '', 'paycvv', 'varchar', 'NULL', 512, '', '', @@ -1060,6 +1112,7 @@ sub tables_hashref { 'cdr_termination_percentage', 'decimal', 'NULL', '7,4', '', '', 'invoice_terms', 'varchar', 'NULL', $char_d, '', '', 'credit_limit', @money_typen, '', '', + 'credit_limit_currency', 'char', 'NULL', 3, '', '', 'archived', 'char', 'NULL', 1, '', '', 'email_csv_cdr', 'char', 'NULL', 1, '', '', 'accountcode_cdr', 'char', 'NULL', 1, '', '', @@ -1069,6 +1122,7 @@ sub tables_hashref { 'locale', 'varchar', 'NULL', 16, '', '', 'calling_list_exempt', 'char', 'NULL', 1, '', '', 'invoice_noemail', 'char', 'NULL', 1, '', '', + 'message_noemail', 'char', 'NULL', 1, '', '', 'bill_locationnum', 'int', 'NULL', '', '', '', 'ship_locationnum', 'int', 'NULL', '', '', '', ], @@ -1214,6 +1268,8 @@ sub tables_hashref { 'quotation_pkg' => { 'columns' => [ 'quotationpkgnum', 'serial', '', '', '', '', + 'quotationnum', 'int', 'NULL', '', '', '', #shouldn't be null, + # but history... 'pkgpart', 'int', '', '', '', '', 'locationnum', 'int', 'NULL', '', '', '', 'start_date', @date_type, '', '', @@ -1252,6 +1308,7 @@ sub tables_hashref { 'latitude', 'decimal', 'NULL', '10,7', '', '', 'longitude', 'decimal', 'NULL', '10,7', '', '', 'coord_auto', 'char', 'NULL', 1, '', '', + 'addr_clean', 'char', 'NULL', 1, '', '', 'country', 'char', '', 2, '', '', 'geocode', 'varchar', 'NULL', 20, '', '', 'district', 'varchar', 'NULL', 20, '', '', @@ -1375,8 +1432,9 @@ sub tables_hashref { 'adjustmentnum', 'serial', '', '', '', '', 'custnum', 'int', '', '', '', '', 'taxname', 'varchar', '', $char_d, '', '', - 'amount', @money_type, '', '', - 'comment', 'varchar', 'NULL', $char_d, '', '', + 'amount', @money_type, '', '', + 'currency', 'char', 'NULL', 3, '', '', + 'comment', 'varchar', 'NULL', $char_d, '', '', 'billpkgnum', 'int', 'NULL', '', '', '', #more? no cust_bill_pkg_tax_location? ], @@ -1389,18 +1447,19 @@ sub tables_hashref { #off the cust_main_county for validation and to #provide a tax rate. 'columns' => [ - 'taxnum', 'serial', '', '', '', '', - 'district', 'varchar', 'NULL', 20, '', '', - 'city', 'varchar', 'NULL', $char_d, '', '', - 'county', 'varchar', 'NULL', $char_d, '', '', - 'state', 'varchar', 'NULL', $char_d, '', '', - 'country', 'char', '', 2, '', '', - 'taxclass', 'varchar', 'NULL', $char_d, '', '', - 'exempt_amount', @money_type, '', '', - 'tax', 'real', '', '', '', '', #tax % - 'taxname', 'varchar', 'NULL', $char_d, '', '', - 'setuptax', 'char', 'NULL', 1, '', '', # Y = setup tax exempt - 'recurtax', 'char', 'NULL', 1, '', '', # Y = recur tax exempt + 'taxnum', 'serial', '', '', '', '', + 'district', 'varchar', 'NULL', 20, '', '', + 'city', 'varchar', 'NULL', $char_d, '', '', + 'county', 'varchar', 'NULL', $char_d, '', '', + 'state', 'varchar', 'NULL', $char_d, '', '', + 'country', 'char', '', 2, '', '', + 'taxclass', 'varchar', 'NULL', $char_d, '', '', + 'exempt_amount', @money_type, '', '', + 'exempt_amount_currency', 'char', 'NULL', 3, '', '', + 'tax', 'real', '', '', '', '', #tax % + 'taxname', 'varchar', 'NULL', $char_d, '', '', + 'setuptax', 'char', 'NULL', 1, '', '', # Y = setup tax exempt + 'recurtax', 'char', 'NULL', 1, '', '', # Y = recur tax exempt ], 'primary_key' => 'taxnum', 'unique' => [], @@ -1497,19 +1556,17 @@ sub tables_hashref { 'cust_pay_pending' => { 'columns' => [ - 'paypendingnum','serial', '', '', '', '', - 'custnum', 'int', '', '', '', '', - 'paid', @money_type, '', '', - '_date', @date_type, '', '', - 'payby', 'char', '', 4, '', '', #CARD/BILL/COMP, should - # be index into payby - # table eventually - 'payinfo', 'varchar', 'NULL', 512, '', '', #see cust_main above - 'paymask', 'varchar', 'NULL', $char_d, '', '', - 'paydate', 'varchar', 'NULL', 10, '', '', + 'paypendingnum', 'serial', '', '', '', '', + 'custnum', 'int', '', '', '', '', + 'paid', @money_type, '', '', + 'currency', 'char', 'NULL', 3, '', '', + '_date', @date_type, '', '', + 'payby', 'char', '', 4, '', '', + 'payinfo', 'varchar', 'NULL', 512, '', '', + '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 + 'payunique', 'varchar', 'NULL', $char_d, '', '', #separate paybatch "unique" functions from current usage 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances 'status', 'varchar', '', $char_d, '', '', @@ -1518,7 +1575,10 @@ sub tables_hashref { 'gatewaynum', 'int', 'NULL', '', '', '', #'cust_balance', @money_type, '', '', 'paynum', 'int', 'NULL', '', '', '', - 'jobnum', 'int', 'NULL', '', '', '', + 'jobnum', 'bigint', 'NULL', '', '', '', + 'invnum', 'int', 'NULL', '', '', '', + 'manual', 'char', 'NULL', 1, '', '', + 'discount_term','int', 'NULL', '', '', '', ], 'primary_key' => 'paypendingnum', 'unique' => [ [ 'payunique' ] ], @@ -1527,28 +1587,35 @@ sub tables_hashref { 'cust_pay' => { 'columns' => [ - 'paynum', 'serial', '', '', '', '', - 'custnum', 'int', '', '', '', '', - '_date', @date_type, '', '', - 'paid', @money_type, '', '', - 'otaker', 'varchar', 'NULL', 32, '', '', - 'usernum', 'int', 'NULL', '', '', '', - 'payby', 'char', '', 4, '', '', # CARD/BILL/COMP, should be - # index into payby table - # eventually - 'payinfo', 'varchar', 'NULL', 512, '', '', #see cust_main above - 'paymask', 'varchar', 'NULL', $char_d, '', '', - 'paydate', 'varchar', 'NULL', 10, '', '', - 'paybatch', 'varchar', 'NULL', $char_d, '', '', #for auditing purposes. - 'payunique', 'varchar', 'NULL', $char_d, '', '', #separate paybatch "unique" functions from current usage - 'closed', 'char', 'NULL', 1, '', '', + 'paynum', 'serial', '', '', '', '', + 'custnum', 'int', '', '', '', '', + '_date', @date_type, '', '', + 'paid', @money_type, '', '', + 'currency', 'char', 'NULL', 3, '', '', + 'otaker', 'varchar', 'NULL', 32, '', '', + 'usernum', 'int', 'NULL', '', '', '', + 'payby', 'char', '', 4, '', '', + 'payinfo', 'varchar', 'NULL', 512, '', '', + 'paymask', 'varchar', 'NULL', $char_d, '', '', + 'paydate', 'varchar', 'NULL', 10, '', '', + '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 + # cash/check deposit info fields - 'bank', 'varchar', 'NULL', $char_d, '', '', - 'depositor', 'varchar', 'NULL', $char_d, '', '', - 'account', 'varchar', 'NULL', 20, '', '', - 'teller', 'varchar', 'NULL', 20, '', '', - 'batchnum', 'int', 'NULL', '', '', '', #pay_batch foreign key + 'bank', 'varchar', 'NULL', $char_d, '', '', + 'depositor', 'varchar', 'NULL', $char_d, '', '', + 'account', 'varchar', 'NULL', 20, '', '', + 'teller', 'varchar', 'NULL', 20, '', '', + + 'batchnum', 'int', 'NULL', '', '', '',#pay_batch foreign key + + # credit card/EFT fields (formerly in paybatch) + 'gatewaynum', 'int', 'NULL', '', '', '', # payment_gateway FK + 'processor', 'varchar', 'NULL', $char_d, '', '', # module name + 'auth', 'varchar', 'NULL', 16, '', '', # CC auth number + 'order_number','varchar', 'NULL', $char_d, '', '', # transaction number ], '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' ] ], @@ -1557,32 +1624,38 @@ sub tables_hashref { 'cust_pay_void' => { 'columns' => [ - 'paynum', 'int', '', '', '', '', - 'custnum', 'int', '', '', '', '', - '_date', @date_type, '', '', - 'paid', @money_type, '', '', - 'otaker', 'varchar', 'NULL', 32, '', '', - 'usernum', 'int', 'NULL', '', '', '', - 'payby', 'char', '', 4, '', '', # CARD/BILL/COMP, should be - # index into payby table - # eventually - 'payinfo', 'varchar', 'NULL', 512, '', '', #see cust_main above - 'paymask', 'varchar', 'NULL', $char_d, '', '', + 'paynum', 'int', '', '', '', '', + 'custnum', 'int', '', '', '', '', + '_date', @date_type, '', '', + 'paid', @money_type, '', '', + 'currency', 'char', 'NULL', 3, '', '', + 'otaker', 'varchar', 'NULL', 32, '', '', + 'usernum', 'int', 'NULL', '', '', '', + 'payby', 'char', '', 4, '', '', + 'payinfo', 'varchar', 'NULL', 512, '', '', + 'paymask', 'varchar', 'NULL', $char_d, '', '', #'paydate' ? - 'paybatch', 'varchar', 'NULL', $char_d, '', '', #for auditing purposes. - 'closed', 'char', 'NULL', 1, '', '', - 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances + 'paybatch', 'varchar', 'NULL', $char_d, '', '', #for auditing purposes. + 'closed', 'char', 'NULL', 1, '', '', + 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances + # cash/check deposit info fields 'bank', 'varchar', 'NULL', $char_d, '', '', 'depositor', 'varchar', 'NULL', $char_d, '', '', - 'account', 'varchar', 'NULL', 20, '', '', - 'teller', 'varchar', 'NULL', 20, '', '', - 'batchnum', 'int', 'NULL', '', '', '', #pay_batch foreign key + 'account', 'varchar', 'NULL', 20, '', '', + 'teller', 'varchar', 'NULL', 20, '', '', + 'batchnum', 'int', 'NULL', '', '', '', #pay_batch foreign key + + # credit card/EFT fields (formerly in paybatch) + 'gatewaynum', 'int', 'NULL', '', '', '', # payment_gateway FK + 'processor', 'varchar', 'NULL', $char_d, '', '', # module name + 'auth', 'varchar', 'NULL', 16, '', '', # CC auth number + 'order_number','varchar', 'NULL', $char_d, '', '', # transaction number #void fields - 'void_date', @date_type, '', '', - 'reason', 'varchar', 'NULL', $char_d, '', '', - 'void_usernum', 'int', 'NULL', '', '', '', + 'void_date', @date_type, '', '', + 'reason', 'varchar', 'NULL', $char_d, '', '', + 'void_usernum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'paynum', 'unique' => [], @@ -1650,26 +1723,27 @@ sub tables_hashref { 'cust_pay_batch' => { #list of customers in current CARD/CHEK batch 'columns' => [ - 'paybatchnum', 'serial', '', '', '', '', - 'batchnum', 'int', '', '', '', '', - 'invnum', 'int', '', '', '', '', - 'custnum', '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, '', '', - 'country', 'char', '', 2, '', '', - # 'trancode', 'int', '', '', '', '' - 'payby', 'char', '', 4, '', '', # CARD/BILL/COMP, should be - 'payinfo', 'varchar', '', 512, '', '', - #'exp', @date_type, '', '' - 'exp', 'varchar', 'NULL', 11, '', '', - 'payname', 'varchar', 'NULL', $char_d, '', '', - 'amount', @money_type, '', '', - 'status', 'varchar', 'NULL', $char_d, '', '', + 'paybatchnum', 'serial', '', '', '', '', + 'batchnum', 'int', '', '', '', '', + 'invnum', 'int', '', '', '', '', + 'custnum', '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, '', '', + 'country', 'char', '', 2, '', '', + 'payby', 'char', '', 4, '', '', + 'payinfo', 'varchar', 'NULL', 512, '', '', + #'exp', @date_type, '', '', + 'exp', 'varchar', 'NULL', 11, '', '', + 'payname', 'varchar', 'NULL', $char_d, '', '', + 'amount', @money_type, '', '', + 'currency', 'char', 'NULL', 3, '', '', + 'status', 'varchar', 'NULL', $char_d, '', '', + 'error_message', 'varchar', 'NULL', $char_d, '', '', ], 'primary_key' => 'paybatchnum', 'unique' => [], @@ -1692,6 +1766,7 @@ sub tables_hashref { 'custnum', 'int', '', '', '', '', 'pkgpart', 'int', '', '', '', '', 'pkgbatch', 'varchar', 'NULL', $char_d, '', '', + 'contactnum', 'int', 'NULL', '', '', '', 'locationnum', 'int', 'NULL', '', '', '', 'otaker', 'varchar', 'NULL', 32, '', '', 'usernum', 'int', 'NULL', '', '', '', @@ -1713,6 +1788,9 @@ sub tables_hashref { 'change_pkgnum', 'int', 'NULL', '', '', '', 'change_pkgpart', 'int', 'NULL', '', '', '', 'change_locationnum', 'int', 'NULL', '', '', '', + 'change_custnum', 'int', 'NULL', '', '', '', + 'main_pkgnum', 'int', 'NULL', '', '', '', + 'pkglinknum', 'int', 'NULL', '', '', '', 'manual_flag', 'char', 'NULL', 1, '', '', 'no_auto', 'char', 'NULL', 1, '', '', 'quantity', 'int', 'NULL', '', '', '', @@ -1787,6 +1865,30 @@ sub tables_hashref { 'index' => [ [ 'pkgnum' ], [ 'discountnum' ], [ 'usernum' ], ], }, + 'cust_pkg_usage' => { + 'columns' => [ + 'pkgusagenum', 'serial', '', '', '', '', + 'pkgnum', 'int', '', '', '', '', + 'minutes', 'int', '', '', '', '', + 'pkgusagepart', 'int', '', '', '', '', + ], + 'primary_key' => 'pkgusagenum', + 'unique' => [], + 'index' => [ [ 'pkgnum' ], [ 'pkgusagepart' ] ], + }, + + 'cdr_cust_pkg_usage' => { + 'columns' => [ + 'cdrusagenum', 'bigserial', '', '', '', '', + 'acctid', 'bigint', '', '', '', '', + 'pkgusagenum', 'int', '', '', '', '', + 'minutes', 'int', '', '', '', '', + ], + 'primary_key' => 'cdrusagenum', + 'unique' => [], + 'index' => [ [ 'pkgusagenum' ], [ 'acctid' ] ], + }, + 'cust_bill_pkg_discount' => { 'columns' => [ 'billpkgdiscountnum', 'serial', '', '', '', '', @@ -1846,6 +1948,11 @@ sub tables_hashref { 'paymask', 'varchar', 'NULL', $char_d, '', '', 'paybatch', 'varchar', 'NULL', $char_d, '', '', 'closed', 'char', 'NULL', 1, '', '', + # credit card/EFT fields (formerly in paybatch) + 'gatewaynum', 'int', 'NULL', '', '', '', # payment_gateway FK + 'processor', 'varchar', 'NULL', $char_d, '', '', # module name + 'auth', 'varchar','NULL',16, '', '', # CC auth number + 'order_number', 'varchar','NULL',$char_d, '', '', # transaction number ], 'primary_key' => 'refundnum', 'unique' => [], @@ -1951,6 +2058,44 @@ sub tables_hashref { ], }, + 'part_pkg_msgcat' => { + 'columns' => [ + 'pkgpartmsgnum', 'serial', '', '', '', '', + 'pkgpart', 'int', '', '', '', '', + 'locale', 'varchar', '', 16, '', '', + 'pkg', 'varchar', '', $char_d, '', '', #longer/no limit? + 'comment', 'varchar', 'NULL', 2*$char_d, '', '', #longer/no limit? + ], + 'primary_key' => 'pkgpartmsgnum', + 'unique' => [ [ 'pkgpart', 'locale' ] ], + 'index' => [], + }, + + 'part_pkg_currency' => { + 'columns' => [ + 'pkgcurrencynum', 'serial', '', '', '', '', + 'pkgpart', 'int', '', '', '', '', + 'currency', 'char', '', 3, '', '', + 'optionname', 'varchar', '', $char_d, '', '', + 'optionvalue', 'text', '', '', '', '', + ], + 'primary_key' => 'pkgcurrencynum', + 'unique' => [ [ 'pkgpart', 'currency', 'optionname' ] ], + 'index' => [ ['pkgpart'] ], + }, + + 'currency_exchange' => { + 'columns' => [ + 'currencyratenum', 'serial', '', '', '', '', + 'from_currency', 'char', '', 3, '', '', + 'to_currency', 'char', '', 3, '', '', + 'rate', 'decimal', '', '7,6', '', '', + ], + 'primary_key' => 'currencyratenum', + 'unique' => [ [ 'from_currency', 'to_currency' ] ], + 'index' => [], + }, + 'part_pkg_link' => { 'columns' => [ 'pkglinknum', 'serial', '', '', '', '', @@ -2079,7 +2224,8 @@ sub tables_hashref { 'preserve', 'char', 'NULL', 1, '', '', 'selfservice_access', 'varchar', 'NULL', $char_d, '', '', 'classnum', 'int', 'NULL', '', '', '', - ], + 'restrict_edit_password','char', 'NULL', 1, '', '', +], 'primary_key' => 'svcpart', 'unique' => [], 'index' => [ [ 'disabled' ] ], @@ -2184,6 +2330,9 @@ sub tables_hashref { 'shell', 'varchar', 'NULL', $char_d, '', '', 'quota', 'varchar', 'NULL', $char_d, '', '', 'slipip', 'varchar', 'NULL', 15, '', '', #four TINYINTs, bah. + # IP address mgmt + 'routernum', 'int', 'NULL', '', '', '', + 'blocknum', 'int', 'NULL', '', '', '', 'seconds', 'int', 'NULL', '', '', '', #uhhhh 'seconds_threshold', 'int', 'NULL', '', '', '', 'upbytes', 'bigint', 'NULL', '', '', '', @@ -2224,6 +2373,7 @@ sub tables_hashref { 'cgp_sendmdnmode', 'varchar', 'NULL', $char_d, '', '',#SendMDNMode #mail #XXX RPOP settings + # ], 'primary_key' => 'svcnum', #'unique' => [ [ 'username', 'domsvc' ] ], @@ -2584,7 +2734,7 @@ sub tables_hashref { 'queue' => { 'columns' => [ - 'jobnum', 'serial', '', '', '', '', + 'jobnum', 'bigserial', '', '', '', '', 'job', 'varchar', '', 512, '', '', '_date', 'int', '', '', '', '', 'status', 'varchar', '', $char_d, '', '', @@ -2603,10 +2753,10 @@ sub tables_hashref { 'queue_arg' => { 'columns' => [ - 'argnum', 'serial', '', '', '', '', - 'jobnum', 'int', '', '', '', '', - 'frozen', 'char', 'NULL', 1, '', '', - 'arg', 'text', 'NULL', '', '', '', + 'argnum', 'bigserial', '', '', '', '', + 'jobnum', 'bigint', '', '', '', '', + 'frozen', 'char', 'NULL', 1, '', '', + 'arg', 'text', 'NULL', '', '', '', ], 'primary_key' => 'argnum', 'unique' => [], @@ -2615,9 +2765,9 @@ sub tables_hashref { 'queue_depend' => { 'columns' => [ - 'dependnum', 'serial', '', '', '', '', - 'jobnum', 'int', '', '', '', '', - 'depend_jobnum', 'int', '', '', '', '', + 'dependnum', 'bigserial', '', '', '', '', + 'jobnum', 'bigint', '', '', '', '', + 'depend_jobnum', 'bigint', '', '', '', '', ], 'primary_key' => 'dependnum', 'unique' => [], @@ -2650,9 +2800,10 @@ sub tables_hashref { 'columns' => [ 'exportnum', 'serial', '', '', '', '', 'exportname', 'varchar', 'NULL', $char_d, '', '', - 'machine', 'varchar', 'NULL', $char_d, '', '', + 'machine', 'varchar', 'NULL', $char_d, '', '', 'exporttype', 'varchar', '', $char_d, '', '', 'nodomain', 'char', 'NULL', 1, '', '', + 'default_machine','int', 'NULL', '', '', '', ], 'primary_key' => 'exportnum', 'unique' => [], @@ -2829,22 +2980,28 @@ sub tables_hashref { 'svc_broadband' => { 'columns' => [ - 'svcnum', 'int', '', '', '', '', - 'description', 'varchar', 'NULL', $char_d, '', '', - 'routernum', 'int', 'NULL', '', '', '', - 'blocknum', 'int', 'NULL', '', '', '', - 'sectornum', 'int', 'NULL', '', '', '', - 'speed_up', 'int', 'NULL', '', '', '', - 'speed_down', 'int', 'NULL', '', '', '', - 'ip_addr', 'varchar', 'NULL', 15, '', '', - 'mac_addr', 'varchar', 'NULL', 12, '', '', - 'authkey', 'varchar', 'NULL', 32, '', '', - 'latitude', 'decimal', 'NULL', '10,7', '', '', - 'longitude', 'decimal', 'NULL', '10,7', '', '', - 'altitude', 'decimal', 'NULL', '', '', '', - 'vlan_profile', 'varchar', 'NULL', $char_d, '', '', - 'performance_profile', 'varchar', 'NULL', $char_d, '', '', - 'plan_id', 'varchar', 'NULL', $char_d, '', '', + 'svcnum', 'int', '', '', '', '', + 'description', 'varchar', 'NULL', $char_d, '', '', + 'routernum', 'int', 'NULL', '', '', '', + 'blocknum', 'int', 'NULL', '', '', '', + 'sectornum', 'int', 'NULL', '', '', '', + 'speed_up', 'int', 'NULL', '', '', '', + 'speed_down', 'int', 'NULL', '', '', '', + 'ip_addr', 'varchar', 'NULL', 15, '', '', + 'mac_addr', 'varchar', 'NULL', 12, '', '', + 'authkey', 'varchar', 'NULL', 32, '', '', + 'latitude', 'decimal', 'NULL', '10,7', '', '', + 'longitude', 'decimal', 'NULL', '10,7', '', '', + 'altitude', 'decimal', 'NULL', '', '', '', + 'vlan_profile', 'varchar', 'NULL', $char_d, '', '', + 'performance_profile', 'varchar', 'NULL', $char_d, '', '', + 'plan_id', 'varchar', 'NULL', $char_d, '', '', + 'radio_serialnum', 'varchar', 'NULL', $char_d, '', '', + 'radio_location', 'varchar', 'NULL', 2*$char_d, '', '', + 'poe_location', 'varchar', 'NULL', 2*$char_d, '', '', + 'rssi', 'int', 'NULL', '', '', '', + 'suid', 'int', 'NULL', '', '', '', + 'shared_svcnum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'svcnum', 'unique' => [ [ 'ip_addr' ], [ 'mac_addr' ] ], @@ -2983,6 +3140,32 @@ sub tables_hashref { 'index' => [ [ 'disabled' ] ], }, + 'part_pkg_usage' => { + 'columns' => [ + 'pkgusagepart', 'serial', '', '', '', '', + 'pkgpart', 'int', '', '', '', '', + 'minutes', 'int', '', '', '', '', + 'priority', 'int', 'NULL', '', '', '', + 'shared', 'char', 'NULL', 1, '', '', + 'rollover', 'char', 'NULL', 1, '', '', + 'description', 'varchar', 'NULL', $char_d, '', '', + ], + 'primary_key' => 'pkgusagepart', + 'unique' => [], + 'index' => [ [ 'pkgpart' ] ], + }, + + 'part_pkg_usage_class' => { + 'columns' => [ + 'num', 'serial', '', '', '', '', + 'pkgusagepart', 'int', '', '', '', '', + 'classnum', 'int','NULL', '', '', '', + ], + 'primary_key' => 'num', + 'unique' => [ [ 'pkgusagepart', 'classnum' ] ], + 'index' => [], + }, + 'rate' => { 'columns' => [ 'ratenum', 'serial', '', '', '', '', @@ -3020,6 +3203,7 @@ sub tables_hashref { 'columns' => [ 'regionnum', 'serial', '', '', '', '', 'regionname', 'varchar', '', $char_d, '', '', + 'exact_match', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'regionnum', 'unique' => [], @@ -3154,7 +3338,8 @@ sub tables_hashref { '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, '', '', + 'gateway_callback_url', 'varchar', 'NULL', 255, '', '', + 'gateway_cancel_url', 'varchar', 'NULL', 255, '', '', 'disabled', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'gatewaynum', @@ -3249,7 +3434,7 @@ sub tables_hashref { 'channel', 'varchar', '', $char_d, \"''", '', 'dstchannel', 'varchar', '', $char_d, \"''", '', 'lastapp', 'varchar', '', $char_d, \"''", '', - 'lastdata', 'varchar', '', $char_d, \"''", '', + 'lastdata', 'varchar', '', 255, \"''", '', #currently only opensips 'src_ip_addr', 'varchar', 'NULL', 15, '', '', @@ -3300,6 +3485,12 @@ sub tables_hashref { 'quantity', 'int', 'NULL', '', '', '', 'upstream_rateid', 'int', 'NULL', '', '', '', + + ### + # more fields, for GSM imports + ### + 'servicecode', 'int', 'NULL', '', '', '', + 'quantity_able', 'int', 'NULL', '', '', '', ### #and now for our own fields @@ -3308,8 +3499,9 @@ sub tables_hashref { 'cdrtypenum', 'int', 'NULL', '', '', '', 'charged_party', 'varchar', 'NULL', $char_d, '', '', + 'charged_party_imsi', 'varchar', 'NULL', $char_d, '', '', - 'upstream_price', 'decimal', 'NULL', '10,4', '', '', + 'upstream_price', 'decimal', 'NULL', '10,5', '', '', 'upstream_src_regionname', 'varchar', 'NULL', $char_d, '', '', 'upstream_dst_regionname', 'varchar', 'NULL', $char_d, '', '', @@ -3324,7 +3516,7 @@ sub tables_hashref { 'rated_classnum', 'int', 'NULL', '', '', '', 'rated_ratename', 'varchar', 'NULL', $char_d, '', '', - 'carrierid', 'int', 'NULL', '', '', '', + 'carrierid', 'bigint', 'NULL', '', '', '', # service it was matched to 'svcnum', 'int', 'NULL', '', '', '', @@ -3423,8 +3615,9 @@ sub tables_hashref { 'cdr_carrier' => { 'columns' => [ - 'carrierid' => 'serial', '', '', '', '', - 'carriername' => 'varchar', '', $char_d, '', '', + 'carrierid' => 'serial', '', '', '', '', + 'carriername' => 'varchar', '', $char_d, '', '', + 'disabled' => 'char', 'NULL', 1, '', '', ], 'primary_key' => 'carrierid', 'unique' => [], @@ -3470,15 +3663,29 @@ sub tables_hashref { 'index' => [], }, + 'access_user_session' => { + 'columns' => [ + 'sessionnum', 'serial', '', '', '', '', + 'sessionkey', 'varchar', '', $char_d, '', '', + 'usernum', 'int', '', '', '', '', + 'start_date', @date_type, '', '', + 'last_date', @date_type, '', '', + ], + 'primary_key' => 'sessionnum', + 'unique' => [ [ 'sessionkey' ] ], + 'index' => [], + }, + 'access_user' => { 'columns' => [ - 'usernum', 'serial', '', '', '', '', - 'username', 'varchar', '', $char_d, '', '', - '_password', 'varchar', '', $char_d, '', '', - 'last', 'varchar', '', $char_d, '', '', - 'first', 'varchar', '', $char_d, '', '', - 'user_custnum', 'int', 'NULL', '', '', '', - 'disabled', 'char', 'NULL', 1, '', '', + 'usernum', 'serial', '', '', '', '', + 'username', 'varchar', '', $char_d, '', '', + '_password', 'varchar', 'NULL', $char_d, '', '', + '_password_encoding', 'varchar', 'NULL', $char_d, '', '', + 'last', 'varchar', 'NULL', $char_d, '', '', + 'first', 'varchar', 'NULL', $char_d, '', '', + 'user_custnum', 'int', 'NULL', '', '', '', + 'disabled', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'usernum', 'unique' => [ [ 'username' ] ], @@ -3555,30 +3762,34 @@ sub tables_hashref { 'svc_phone' => { 'columns' => [ - 'svcnum', 'int', '', '', '', '', - 'countrycode', 'varchar', '', 3, '', '', - 'phonenum', 'varchar', '', 15, '', '', #12 ? - 'pin', 'varchar', 'NULL', $char_d, '', '', - 'sip_password', 'varchar', 'NULL', $char_d, '', '', - 'phone_name', 'varchar', 'NULL', $char_d, '', '', - 'pbxsvc', 'int', 'NULL', '', '', '', - 'domsvc', 'int', 'NULL', '', '', '', - 'locationnum', 'int', 'NULL', '', '', '', - 'forwarddst', 'varchar', 'NULL', 15, '', '', - 'email', 'varchar', 'NULL', 255, '', '', - 'lnp_status', 'varchar', 'NULL', $char_d, '', '', - 'portable', 'char', 'NULL', 1, '', '', - 'lrn', 'char', 'NULL', 10, '', '', - 'lnp_desired_due_date', 'int', 'NULL', '', '', '', - 'lnp_due_date', 'int', 'NULL', '', '', '', - 'lnp_other_provider', 'varchar', 'NULL', $char_d, '', '', - 'lnp_other_provider_account', 'varchar', 'NULL', $char_d, '', '', - 'lnp_reject_reason', 'varchar', 'NULL', $char_d, '', '', + 'svcnum', 'int', '', '', '', '', + 'countrycode', 'varchar', '', 3, '', '', + 'phonenum', 'varchar', '', 25, '', '', #12 ? + 'sim_imsi', 'varchar', 'NULL', 15, '', '', + 'pin', 'varchar', 'NULL', $char_d, '', '', + 'sip_password', 'varchar', 'NULL', $char_d, '', '', + 'phone_name', 'varchar', 'NULL', $char_d, '', '', + 'pbxsvc', 'int', 'NULL', '', '', '', + 'domsvc', 'int', 'NULL', '', '', '', + 'locationnum', 'int', 'NULL', '', '', '', + 'forwarddst', 'varchar', 'NULL', 15, '', '', + 'email', 'varchar', 'NULL', 255, '', '', + 'lnp_status', 'varchar', 'NULL', $char_d, '', '', + 'portable', 'char', 'NULL', 1, '', '', + 'lrn', 'char', 'NULL', 10, '', '', + 'lnp_desired_due_date', 'int', 'NULL', '', '', '', + 'lnp_due_date', 'int', 'NULL', '', '', '', + 'lnp_other_provider', 'varchar', 'NULL', $char_d, '', '', + 'lnp_other_provider_account', 'varchar', 'NULL', $char_d, '', '', + 'lnp_reject_reason', 'varchar', 'NULL', $char_d, '', '', + 'sms_carrierid', 'int', 'NULL', '', '', '', + 'sms_account', 'varchar', 'NULL', $char_d, '', '', + 'max_simultaneous', 'int', 'NULL', '', '', '', ], 'primary_key' => 'svcnum', - 'unique' => [], + 'unique' => [ [ 'sms_carrierid', 'sms_account'] ], 'index' => [ ['countrycode', 'phonenum'], ['pbxsvc'], ['domsvc'], - ['locationnum'], + ['locationnum'], ['sms_carrierid'], ], }, @@ -3948,16 +4159,17 @@ sub tables_hashref { 'index' => [ [ 'upgrade' ] ], }, - 'ftp_target' => { + 'upload_target' => { 'columns' => [ 'targetnum', 'serial', '', '', '', '', 'agentnum', 'int', 'NULL', '', '', '', + 'protocol', 'varchar', '', 10, '', '', 'hostname', 'varchar', '', $char_d, '', '', - 'port', 'int', '', '', '', '', + 'port', 'int', 'NULL', '', '', '', 'username', 'varchar', '', $char_d, '', '', - 'password', 'varchar', '', $char_d, '', '', - 'path', 'varchar', '', $char_d, '', '', - 'secure', 'char', 'NULL', 1, '', '', + 'password', 'varchar', 'NULL', $char_d, '', '', + 'path', 'varchar', 'NULL', $char_d, '', '', + 'subject', 'varchar', 'NULL', '255', '', '', 'handling', 'varchar', 'NULL', $char_d, '', '', ], 'primary_key' => 'targetnum', @@ -3965,6 +4177,56 @@ sub tables_hashref { 'index' => [], }, + 'log' => { + 'columns' => [ + 'lognum', 'serial', '', '', '', '', + '_date', 'int', '', '', '', '', + 'agentnum', 'int', 'NULL', '', '', '', + 'tablename', 'varchar', 'NULL', $char_d, '', '', + 'tablenum', 'int', 'NULL', '', '', '', + 'level', 'int', '', '', '', '', + 'message', 'text', '', '', '', '', + ], + 'primary_key' => 'lognum', + 'unique' => [], + 'index' => [ ['_date'], ['level'] ], + }, + + 'log_context' => { + 'columns' => [ + 'logcontextnum', 'serial', '', '', '', '', + 'lognum', 'int', '', '', '', '', + 'context', 'varchar', '', 32, '', '', + ], + 'primary_key' => 'logcontextnum', + 'unique' => [ [ 'lognum', 'context' ] ], + 'index' => [], + }, + + 'svc_cable' => { + 'columns' => [ + 'svcnum', 'int', '', '', '', '', + #nothing so far... there should be _something_ uniquely identifying + # each subscriber besides the device info...? + ], + 'primary_key' => 'svcnum', + 'unique' => [], + 'index' => [], + }, + + 'cable_device' => { + 'columns' => [ + 'devicenum', 'serial', '', '', '', '', + 'devicepart', 'int', '', '', '', '', + 'svcnum', 'int', '', '', '', '', + 'mac_addr', 'varchar', 'NULL', 12, '', '', + 'serial', 'varchar', 'NULL', $char_d, '', '', + ], + 'primary_key' => 'devicenum', + 'unique' => [ [ 'mac_addr' ], ], + 'index' => [ [ 'devicepart' ], [ 'svcnum' ], ], + }, + %{ tables_hashref_torrus() }, # tables of ours for doing torrus virtual port combining diff --git a/FS/FS/TemplateItem_Mixin.pm b/FS/FS/TemplateItem_Mixin.pm index 6d7ea26bc..8b0e16a2d 100644 --- a/FS/FS/TemplateItem_Mixin.pm +++ b/FS/FS/TemplateItem_Mixin.pm @@ -52,10 +52,10 @@ line item, and for generic taxes, simply returns "Tax". =cut sub desc { - my $self = shift; + my( $self, $locale ) = @_; if ( $self->pkgnum > 0 ) { - $self->itemdesc || $self->part_pkg->pkg; + $self->itemdesc || $self->part_pkg->pkg_locale($locale); } else { my $desc = $self->itemdesc || 'Tax'; $desc .= ' '. $self->itemcomment if $self->itemcomment =~ /\S/; @@ -271,10 +271,12 @@ sub cust_bill_pkg_display { } else { my $hashref = { 'billpkgnum' => $self->billpkgnum }; $hashref->{type} = $type if defined($type); + + my $order_by = $self->display_table_orderby || 'billpkgdisplaynum'; @result = qsearch ({ 'table' => $self->display_table, - 'hashref' => { 'billpkgnum' => $self->billpkgnum }, - 'order_by' => 'ORDER BY billpkgdisplaynum', + 'hashref' => $hashref, + 'order_by' => "ORDER BY $order_by", }); } diff --git a/FS/FS/Template_Mixin.pm b/FS/FS/Template_Mixin.pm index 146e95f1c..e597e73a3 100644 --- a/FS/FS/Template_Mixin.pm +++ b/FS/FS/Template_Mixin.pm @@ -106,7 +106,7 @@ sub print_latex { $params{'time'} = $today if $today; $params{'template'} = $template if $template; $params{$_} = $opt{$_} - foreach grep $opt{$_}, qw( unsquelch_cdr notice_name ); + foreach grep $opt{$_}, qw( unsquelch_cdr notice_name no_date no_number ); $template ||= $self->_agent_template if $self->can('_agent_template'); @@ -122,7 +122,7 @@ sub print_latex { UNLINK => 0, ) or die "can't open temp file: $!\n"; - my $agentnum = $self->cust_main->agentnum; + my $agentnum = $self->agentnum; if ( $template && $conf->exists("logo_${template}.eps", $agentnum) ) { print $lh $conf->config_binary("logo_${template}.eps", $agentnum) @@ -174,6 +174,12 @@ sub print_latex { } +sub agentnum { + my $self = shift; + my $cust_main = $self->cust_main; + $cust_main ? $cust_main->agentnum : $self->prospect_main->agentnum; +} + =item print_generic OPTION => VALUE ... Internal method - returns a filled-in template for this invoice as a scalar. @@ -363,14 +369,6 @@ sub print_generic { my $date_format = $date_formats{$format}; - my %embolden_functions = ( 'latex' => sub { return '\textbf{'. shift(). '}' - }, - 'html' => sub { return '<b>'. shift(). '</b>' - }, - 'template' => sub { shift }, - ); - my $embolden_function = $embolden_functions{$format}; - my %newline_tokens = ( 'latex' => '\\\\', 'html' => '<br>', 'template' => "\n", @@ -447,9 +445,15 @@ sub print_generic { 'agent' => &$escape_function($cust_main->agent->agent), #invoice/quotation info - 'invnum' => $self->invnum, + 'no_number' => $params{'no_number'}, + 'invnum' => ( $params{'no_number'} ? '' : $self->invnum ), 'quotationnum' => $self->quotationnum, - 'date' => time2str($date_format, $self->_date), + 'no_date' => $params{'no_date'}, + '_date' => ( $params{'no_date'} ? '' : $self->_date ), + 'date' => ( $params{'no_date'} + ? '' + : time2str($date_format, $self->_date) + ), 'today' => time2str($date_format_long, $today), 'terms' => $self->terms, 'template' => $template, #params{'template'}, @@ -584,27 +588,79 @@ sub print_generic { #my $balance_due = $self->owed + $pr_total - $cr_total; my $balance_due = $self->owed + $pr_total; - # the customer's current balance as shown on the invoice before this one - $invoice_data{'true_previous_balance'} = sprintf("%.2f", ($self->previous_balance || 0) ); + #these are used on the summary page only + + # the customer's current balance as shown on the invoice before this one + $invoice_data{'true_previous_balance'} = sprintf("%.2f", ($self->previous_balance || 0) ); - # the change in balance from that invoice to this one - $invoice_data{'balance_adjustments'} = sprintf("%.2f", ($self->previous_balance || 0) - ($self->billing_balance || 0) ); + # the change in balance from that invoice to this one + $invoice_data{'balance_adjustments'} = sprintf("%.2f", ($self->previous_balance || 0) - ($self->billing_balance || 0) ); - # the sum of amount owed on all previous invoices - $invoice_data{'previous_balance'} = sprintf("%.2f", $pr_total); + # the sum of amount owed on all previous invoices + # ($pr_total is used elsewhere but not as $previous_balance) + $invoice_data{'previous_balance'} = sprintf("%.2f", $pr_total); # the sum of amount owed on all invoices + # (this is used in the summary & on the payment coupon) $invoice_data{'balance'} = sprintf("%.2f", $balance_due); # info from customer's last invoice before this one, for some # summary formats $invoice_data{'last_bill'} = {}; - my $last_bill = $pr_cust_bill[-1]; - if ( $last_bill ) { - $invoice_data{'last_bill'} = { - '_date' => $last_bill->_date, #unformatted - # all we need for now - }; + + # returns the last unpaid bill, not the last bill + #my $last_bill = $pr_cust_bill[-1]; + + if ( $self->custnum && $self->invnum ) { + + # THIS returns the customer's last bill before this one + my $last_bill = qsearchs({ + 'table' => 'cust_bill', + 'hashref' => { 'custnum' => $self->custnum, + 'invnum' => { op => '<', value => $self->invnum }, + }, + 'order_by' => ' ORDER BY invnum DESC LIMIT 1' + }); + if ( $last_bill ) { + $invoice_data{'last_bill'} = { + '_date' => $last_bill->_date, #unformatted + # all we need for now + }; + my (@payments, @credits); + # for formats that itemize previous payments + foreach my $cust_pay ( qsearch('cust_pay', { + 'custnum' => $self->custnum, + '_date' => { op => '>=', + value => $last_bill->_date } + } ) ) + { + next if $cust_pay->_date > $self->_date; + push @payments, { + '_date' => $cust_pay->_date, + 'date' => time2str($date_format, $cust_pay->_date), + 'payinfo' => $cust_pay->payby_payinfo_pretty, + 'amount' => sprintf('%.2f', $cust_pay->paid), + }; + # not concerned about applications + } + foreach my $cust_credit ( qsearch('cust_credit', { + 'custnum' => $self->custnum, + '_date' => { op => '>=', + value => $last_bill->_date } + } ) ) + { + next if $cust_credit->_date > $self->_date; + push @credits, { + '_date' => $cust_credit->_date, + 'date' => time2str($date_format, $cust_credit->_date), + 'creditreason'=> $cust_credit->reason, + 'amount' => sprintf('%.2f', $cust_credit->amount), + }; + } + $invoice_data{'previous_payments'} = \@payments; + $invoice_data{'previous_credits'} = \@credits; + } + } my $summarypage = ''; @@ -689,6 +745,11 @@ sub print_generic { my $other_money_char = $other_money_chars{$format}; $invoice_data{'dollar'} = $other_money_char; + my %minus_signs = ( 'latex' => '$-$', + 'html' => '−', + 'template' => '- ' ); + my $minus = $minus_signs{$format}; + my @detail_items = (); my @total_items = (); my @buf = (); @@ -727,10 +788,11 @@ sub print_generic { my $adjusttotal = 0; - my $adjust_section = { 'description' => - $self->mt('Credits, Payments, and Adjustments'), - 'subtotal' => 0, # adjusted below - }; + my $adjust_section = { + 'description' => $self->mt('Credits, Payments, and Adjustments'), + 'adjust_section' => 1, + 'subtotal' => 0, # adjusted below + }; my $adjust_weight = _pkg_category($adjust_section->{description}) ? _pkg_category($adjust_section->{description})->weight : 0; @@ -738,7 +800,7 @@ sub print_generic { $adjust_section->{'sort_weight'} = $adjust_weight; my $unsquelched = $params{unsquelch_cdr} || $cust_main->squelch_cdr ne 'Y'; - my $multisection = $conf->exists('invoice_sections', $cust_main->agentnum); + my $multisection = $conf->exists($tc.'sections', $cust_main->agentnum); $invoice_data{'multisection'} = $multisection; my $late_sections = []; my $extra_sections = []; @@ -821,6 +883,7 @@ sub print_generic { ext_description => [], }; $detail->{'ref'} = $line_item->{'pkgnum'}; + $detail->{'pkgpart'} = $line_item->{'pkgpart'}; $detail->{'quantity'} = 1; $detail->{'section'} = $multisection ? $previous_section : $default_section; @@ -917,6 +980,7 @@ sub print_generic { ext_description => [], }; $detail->{'ref'} = $line_item->{'pkgnum'}; + $detail->{'pkgpart'} = $line_item->{'pkgpart'}; $detail->{'quantity'} = $line_item->{'quantity'}; $detail->{'section'} = $section; $detail->{'description'} = &$escape_function($line_item->{'description'}); @@ -934,6 +998,7 @@ sub print_generic { $detail->{'sdate'} = $line_item->{'sdate'}; $detail->{'edate'} = $line_item->{'edate'}; $detail->{'seconds'} = $line_item->{'seconds'}; + $detail->{'svc_label'} = $line_item->{'svc_label'}; push @detail_items, $detail; push @buf, ( [ $detail->{'description'}, @@ -969,7 +1034,8 @@ sub print_generic { warn "$me adding taxes\n" if $DEBUG > 1; - foreach my $tax ( $self->_items_tax ) { + my @items_tax = $self->_items_tax; + foreach my $tax ( @items_tax ) { $taxtotal += $tax->{'amount'}; @@ -1004,7 +1070,7 @@ sub print_generic { } - if ( $taxtotal ) { + if ( @items_tax ) { my $total = {}; $total->{'total_item'} = $self->mt('Sub-total'); $total->{'total_amount'} = @@ -1031,9 +1097,33 @@ sub print_generic { $money_char. sprintf("%10.2f",$self->charged) ]; push @buf,['','']; - # calculate total, possibly including total owed on previous - # invoices - { + + ### + # Totals + ### + + my %embolden_functions = ( + 'latex' => sub { return '\textbf{'. shift(). '}' }, + 'html' => sub { return '<b>'. shift(). '</b>' }, + 'template' => sub { shift }, + ); + my $embolden_function = $embolden_functions{$format}; + + if ( $self->can('_items_total') ) { # quotations + + $self->_items_total(\@total_items); + + foreach ( @total_items ) { + $_->{'total_item'} = &$embolden_function( $_->{'total_item'} ); + $_->{'total_amount'} = &$embolden_function( $other_money_char. + $_->{'total_amount'} + ); + } + + } else { #normal invoice case + + # calculate total, possibly including total owed on previous + # invoices my $total = {}; my $item = 'Total'; $item = $conf->config('previous_balance-exclude_from_total') @@ -1064,126 +1154,128 @@ sub print_generic { sprintf( '%10.2f', $amount ) ]; push @buf,['','']; - } - # if we're showing previous invoices, also show previous - # credits and payments - if ( $self->enable_previous - and $self->can('_items_credits') - and $self->can('_items_payments') ) - { - #foreach my $thing ( sort { $a->_date <=> $b->_date } $self->_items_credits, $self->_items_payments - - # credits - my $credittotal = 0; - foreach my $credit ( $self->_items_credits('trim_len'=>60) ) { + # if we're showing previous invoices, also show previous + # credits and payments + if ( $self->enable_previous + and $self->can('_items_credits') + and $self->can('_items_payments') ) + { + #foreach my $thing ( sort { $a->_date <=> $b->_date } $self->_items_credits, $self->_items_payments + + # credits + my $credittotal = 0; + foreach my $credit ( $self->_items_credits('trim_len'=>60) ) { + + my $total; + $total->{'total_item'} = &$escape_function($credit->{'description'}); + $credittotal += $credit->{'amount'}; + $total->{'total_amount'} = $minus.$other_money_char.$credit->{'amount'}; + $adjusttotal += $credit->{'amount'}; + if ( $multisection ) { + my $money = $old_latex ? '' : $money_char; + push @detail_items, { + ext_description => [], + ref => '', + quantity => '', + description => &$escape_function($credit->{'description'}), + amount => $money. $credit->{'amount'}, + product_code => '', + section => $adjust_section, + }; + } else { + push @total_items, $total; + } - my $total; - $total->{'total_item'} = &$escape_function($credit->{'description'}); - $credittotal += $credit->{'amount'}; - $total->{'total_amount'} = '-'. $other_money_char. $credit->{'amount'}; - $adjusttotal += $credit->{'amount'}; - if ( $multisection ) { - my $money = $old_latex ? '' : $money_char; - push @detail_items, { - ext_description => [], - ref => '', - quantity => '', - description => &$escape_function($credit->{'description'}), - amount => $money. $credit->{'amount'}, - product_code => '', - section => $adjust_section, - }; - } else { - push @total_items, $total; } + $invoice_data{'credittotal'} = sprintf('%.2f', $credittotal); - } - $invoice_data{'credittotal'} = sprintf('%.2f', $credittotal); - - #credits (again) - foreach my $credit ( $self->_items_credits('trim_len'=>32) ) { - push @buf, [ $credit->{'description'}, $money_char.$credit->{'amount'} ]; - } + #credits (again) + foreach my $credit ( $self->_items_credits('trim_len'=>32) ) { + push @buf, [ $credit->{'description'}, $money_char.$credit->{'amount'} ]; + } - # payments - my $paymenttotal = 0; - foreach my $payment ( $self->_items_payments ) { - my $total = {}; - $total->{'total_item'} = &$escape_function($payment->{'description'}); - $paymenttotal += $payment->{'amount'}; - $total->{'total_amount'} = '-'. $other_money_char. $payment->{'amount'}; - $adjusttotal += $payment->{'amount'}; + # payments + my $paymenttotal = 0; + foreach my $payment ( $self->_items_payments ) { + my $total = {}; + $total->{'total_item'} = &$escape_function($payment->{'description'}); + $paymenttotal += $payment->{'amount'}; + $total->{'total_amount'} = $minus.$other_money_char.$payment->{'amount'}; + $adjusttotal += $payment->{'amount'}; + if ( $multisection ) { + my $money = $old_latex ? '' : $money_char; + push @detail_items, { + ext_description => [], + ref => '', + quantity => '', + description => &$escape_function($payment->{'description'}), + amount => $money. $payment->{'amount'}, + product_code => '', + section => $adjust_section, + }; + }else{ + push @total_items, $total; + } + push @buf, [ $payment->{'description'}, + $money_char. sprintf("%10.2f", $payment->{'amount'}), + ]; + } + $invoice_data{'paymenttotal'} = sprintf('%.2f', $paymenttotal); + if ( $multisection ) { - my $money = $old_latex ? '' : $money_char; - push @detail_items, { - ext_description => [], - ref => '', - quantity => '', - description => &$escape_function($payment->{'description'}), - amount => $money. $payment->{'amount'}, - product_code => '', - section => $adjust_section, - }; - }else{ - push @total_items, $total; + $adjust_section->{'subtotal'} = $other_money_char. + sprintf('%.2f', $adjusttotal); + push @sections, $adjust_section + unless $adjust_section->{sort_weight}; } - push @buf, [ $payment->{'description'}, - $money_char. sprintf("%10.2f", $payment->{'amount'}), - ]; - } - $invoice_data{'paymenttotal'} = sprintf('%.2f', $paymenttotal); - - if ( $multisection ) { - $adjust_section->{'subtotal'} = $other_money_char. - sprintf('%.2f', $adjusttotal); - push @sections, $adjust_section - unless $adjust_section->{sort_weight}; - } - # create Balance Due message - { - my $total; - $total->{'total_item'} = &$embolden_function($self->balance_due_msg); - $total->{'total_amount'} = - &$embolden_function( - $other_money_char. sprintf('%.2f', $summarypage - ? $self->charged + - $self->billing_balance - : $self->owed + $pr_total - ) - ); - if ( $multisection && !$adjust_section->{sort_weight} ) { - $adjust_section->{'posttotal'} = $total->{'total_item'}. ' '. - $total->{'total_amount'}; - }else{ - push @total_items, $total; + # create Balance Due message + { + my $total; + $total->{'total_item'} = &$embolden_function($self->balance_due_msg); + $total->{'total_amount'} = + &$embolden_function( + $other_money_char. sprintf('%.2f', #why? $summarypage + # ? $self->charged + + # $self->billing_balance + # : + $self->owed + $pr_total + ) + ); + if ( $multisection && !$adjust_section->{sort_weight} ) { + $adjust_section->{'posttotal'} = $total->{'total_item'}. ' '. + $total->{'total_amount'}; + }else{ + push @total_items, $total; + } + push @buf,['','-----------']; + push @buf,[$self->balance_due_msg, $money_char. + sprintf("%10.2f", $balance_due ) ]; } - push @buf,['','-----------']; - push @buf,[$self->balance_due_msg, $money_char. - sprintf("%10.2f", $balance_due ) ]; - } - if ( $conf->exists('previous_balance-show_credit') - and $cust_main->balance < 0 ) { - my $credit_total = { - 'total_item' => &$embolden_function($self->credit_balance_msg), - 'total_amount' => &$embolden_function( - $other_money_char. sprintf('%.2f', -$cust_main->balance) - ), - }; - if ( $multisection ) { - $adjust_section->{'posttotal'} .= $newline_token . - $credit_total->{'total_item'} . ' ' . $credit_total->{'total_amount'}; - } - else { - push @total_items, $credit_total; + if ( $conf->exists('previous_balance-show_credit') + and $cust_main->balance < 0 ) { + my $credit_total = { + 'total_item' => &$embolden_function($self->credit_balance_msg), + 'total_amount' => &$embolden_function( + $other_money_char. sprintf('%.2f', -$cust_main->balance) + ), + }; + if ( $multisection ) { + $adjust_section->{'posttotal'} .= $newline_token . + $credit_total->{'total_item'} . ' ' . $credit_total->{'total_amount'}; + } + else { + push @total_items, $credit_total; + } + push @buf,['','-----------']; + push @buf,[$self->credit_balance_msg, $money_char. + sprintf("%10.2f", -$cust_main->balance ) ]; } - push @buf,['','-----------']; - push @buf,[$self->credit_balance_msg, $money_char. - sprintf("%10.2f", -$cust_main->balance ) ]; } - } + + } #end of default total adding ! can('_items_total') if ( $multisection ) { if ( $conf->exists('svc_phone_sections') @@ -1224,6 +1316,10 @@ sub print_generic { } } @discounts_avail; } + # debugging hook: call this with 'diag' => 1 to just get a hash of + # the invoice variables + return \%invoice_data if ( $params{'diag'} ); + # All sections and items are built; now fill in templates. my @includelist = (); push @includelist, 'summary' if $summarypage; @@ -1662,6 +1758,13 @@ sub _items_sections { $not_tax{$section} = 1 unless $cust_bill_pkg->pkgnum == 0; + # there's actually a very important piece of logic buried in here: + # incrementing $late_subtotal{$section} CREATES + # $late_subtotal{$section}. keys(%late_subtotal) is later used + # to define the list of late sections, and likewise keys(%subtotal). + # When _items_cust_bill_pkg is called to generate line items for + # real, it will be called with 'section' => $section for each + # of these. if ( $display->post_total && !$summarypage ) { if (! $type || $type eq 'S') { $late_subtotal{$section} += $cust_bill_pkg->setup @@ -2029,6 +2132,11 @@ separate quantities, for some reason). =cut +sub _items_nontax { + my $self = shift; + grep { $_->pkgnum } $self->cust_bill_pkg; +} + sub _items_pkg { my $self = shift; my %options = @_; @@ -2036,7 +2144,7 @@ sub _items_pkg { warn "$me _items_pkg searching for all package line items\n" if $DEBUG > 1; - my @cust_bill_pkg = grep { $_->pkgnum } $self->cust_bill_pkg; + my @cust_bill_pkg = $self->_items_nontax; warn "$me _items_pkg filtering line items\n" if $DEBUG > 1; @@ -2085,7 +2193,17 @@ sub _taxsort { sub _items_tax { my $self = shift; my @cust_bill_pkg = sort _taxsort grep { ! $_->pkgnum } $self->cust_bill_pkg; - $self->_items_cust_bill_pkg(\@cust_bill_pkg, @_); + my @items = $self->_items_cust_bill_pkg(\@cust_bill_pkg, @_); + + if ( $self->conf->exists('always_show_tax') ) { + my $itemdesc = $self->conf->config('always_show_tax') || 'Tax'; + if (0 == grep { $_->{description} eq $itemdesc } @items) { + push @items, + { 'description' => $itemdesc, + 'amount' => 0.00 }; + } + } + @items; } =item _items_cust_bill_pkg CUST_BILL_PKGS OPTIONS @@ -2111,7 +2229,7 @@ which does something complicated. Returns a list of hashrefs, each of which may contain: -pkgnum, description, amount, unit_amount, quantity, _is_setup, and +pkgnum, description, amount, unit_amount, quantity, pkgpart, _is_setup, and ext_description, which is an arrayref of detail lines to show below the package line. @@ -2167,14 +2285,13 @@ sub _items_cust_bill_pkg { if $DEBUG > 1; foreach my $display ( grep { defined($section) - ? $_->section eq $section - : 1 - } - #grep { !$_->summary || !$summary_page } # bunk! + ? $_->section eq $section + : 1 + } grep { !$_->summary || $multisection } @cust_bill_pkg_display ) - { + { warn "$me _items_cust_bill_pkg considering cust_bill_pkg_display ". $display->billpkgdisplaynum. "\n" @@ -2182,7 +2299,7 @@ sub _items_cust_bill_pkg { my $type = $display->type; - my $desc = $cust_bill_pkg->desc; + my $desc = $cust_bill_pkg->desc( $cust_main ? $cust_main->locale : '' ); $desc = substr($desc, 0, $maxlength). '...' if $format eq 'latex' && length($desc) > $maxlength; @@ -2222,9 +2339,14 @@ sub _items_cust_bill_pkg { my $cust_pkg = $cust_bill_pkg->cust_pkg; + # which pkgpart to show for display purposes? + my $pkgpart = $cust_bill_pkg->pkgpart_override || $cust_pkg->pkgpart; + # start/end dates for invoice formats that do nonstandard # things with them - my %item_dates = map { $_ => $cust_bill_pkg->$_ } ('sdate', 'edate'); + my %item_dates = (); + %item_dates = map { $_ => $cust_bill_pkg->$_ } ('sdate', 'edate') + unless $cust_pkg->part_pkg->option('disable_line_item_date_ranges',1); if ( (!$type || $type eq 'S') && ( $cust_bill_pkg->setup != 0 @@ -2243,16 +2365,20 @@ sub _items_cust_bill_pkg { || $cust_bill_pkg->recur_show_zero; my @d = (); + my $svc_label; unless ( $cust_pkg->part_pkg->hide_svc_detail || $cust_bill_pkg->hidden ) { - push @d, map &{$escape_function}($_), - $cust_pkg->h_labels_short($self->_date, undef, 'I') + my @svc_labels = map &{$escape_function}($_), + $cust_pkg->h_labels_short($self->_date, undef, 'I'); + push @d, @svc_labels unless $cust_bill_pkg->pkgpart_override; #don't redisplay services + $svc_label = $svc_labels[0]; - if ( ! $cust_pkg->locationnum or - $cust_pkg->locationnum != $cust_main->ship_locationnum ) { + my $lnum = $cust_main ? $cust_main->ship_locationnum + : $self->prospect_main->locationnum; + if ( ! $cust_pkg->locationnum or $cust_pkg->locationnum != $lnum ) { my $loc = $cust_pkg->location_label; $loc = substr($loc, 0, $maxlength). '...' if $format eq 'latex' && length($loc) > $maxlength; @@ -2272,13 +2398,14 @@ sub _items_cust_bill_pkg { $s = { _is_setup => 1, description => $description, - #pkgpart => $part_pkg->pkgpart, + pkgpart => $pkgpart, pkgnum => $cust_bill_pkg->pkgnum, amount => $cust_bill_pkg->setup, setup_show_zero => $cust_bill_pkg->setup_show_zero, unit_amount => $cust_bill_pkg->unitsetup, quantity => $cust_bill_pkg->quantity, ext_description => \@d, + svc_label => ($svc_label || ''), }; }; @@ -2301,21 +2428,30 @@ sub _items_cust_bill_pkg { my $description = ($is_summary && $type && $type eq 'U') ? "Usage charges" : $desc; + my $part_pkg = $cust_pkg->part_pkg; + #pry be a bit more efficient to look some of this conf stuff up # outside the loop unless ( $conf->exists('disable_line_item_date_ranges') - || $cust_pkg->part_pkg->option('disable_line_item_date_ranges',1) + || $part_pkg->option('disable_line_item_date_ranges',1) + || ! $cust_bill_pkg->sdate + || ! $cust_bill_pkg->edate ) { my $time_period; - my $date_style = $conf->config( 'cust_bill-line_item-date_style', - $cust_main->agentnum - ); + my $date_style = ''; + $date_style = $conf->config( 'cust_bill-line_item-date_style-non_monhtly', + $self->agentnum + ) + if $part_pkg && $part_pkg->freq !~ /^1m?$/; + $date_style ||= $conf->config( 'cust_bill-line_item-date_style', + $self->agentnum + ); if ( defined($date_style) && $date_style eq 'month_of' ) { $time_period = time2str('The month of %B', $cust_bill_pkg->sdate); } elsif ( defined($date_style) && $date_style eq 'X_month' ) { my $desc = $conf->config( 'cust_bill-line_item-date_description', - $cust_main->agentnum + $self->agentnum ); $desc .= ' ' unless $desc =~ /\s$/; $time_period = $desc. time2str('%B', $cust_bill_pkg->sdate); @@ -2328,6 +2464,7 @@ sub _items_cust_bill_pkg { my @d = (); my @seconds = (); # for display of usage info + my $svc_label = ''; #at least until cust_bill_pkg has "past" ranges in addition to #the "future" sdate/edate ones... see #3032 @@ -2336,25 +2473,28 @@ sub _items_cust_bill_pkg { push @dates, $prev->sdate if $prev; push @dates, undef if !$prev; - unless ( $cust_pkg->part_pkg->hide_svc_detail + unless ( $part_pkg->hide_svc_detail || $cust_bill_pkg->itemdesc || $cust_bill_pkg->hidden - || $is_summary && $type && $type eq 'U' ) + || $is_summary && $type && $type eq 'U' + ) { warn "$me _items_cust_bill_pkg adding service details\n" if $DEBUG > 1; - push @d, map &{$escape_function}($_), - $cust_pkg->h_labels_short(@dates, 'I') - #$cust_bill_pkg->edate, - #$cust_bill_pkg->sdate) + my @svc_labels = map &{$escape_function}($_), + $cust_pkg->h_labels_short($self->_date, undef, 'I'); + push @d, @svc_labels unless $cust_bill_pkg->pkgpart_override; #don't redisplay services + $svc_label = $svc_labels[0]; warn "$me _items_cust_bill_pkg done adding service details\n" if $DEBUG > 1; - if ( $cust_pkg->locationnum != $cust_main->ship_locationnum ) { + my $lnum = $cust_main ? $cust_main->ship_locationnum + : $self->prospect_main->locationnum; + if ( $cust_pkg->locationnum != $lnum ) { my $loc = $cust_pkg->location_label; $loc = substr($loc, 0, $maxlength). '...' if $format eq 'latex' && length($loc) > $maxlength; @@ -2424,7 +2564,7 @@ sub _items_cust_bill_pkg { } else { $r = { description => $description, - #pkgpart => $part_pkg->pkgpart, + pkgpart => $pkgpart, pkgnum => $cust_bill_pkg->pkgnum, amount => $amount, recur_show_zero => $cust_bill_pkg->recur_show_zero, @@ -2432,6 +2572,7 @@ sub _items_cust_bill_pkg { quantity => $cust_bill_pkg->quantity, %item_dates, ext_description => \@d, + svc_label => ($svc_label || ''), }; $r->{'seconds'} = \@seconds if grep {defined $_} @seconds; } @@ -2448,7 +2589,7 @@ sub _items_cust_bill_pkg { } else { $u = { description => $description, - #pkgpart => $part_pkg->pkgpart, + pkgpart => $pkgpart, pkgnum => $cust_bill_pkg->pkgnum, amount => $amount, recur_show_zero => $cust_bill_pkg->recur_show_zero, diff --git a/FS/FS/TicketSystem.pm b/FS/FS/TicketSystem.pm index c1553f17a..7b1857527 100644 --- a/FS/FS/TicketSystem.pm +++ b/FS/FS/TicketSystem.pm @@ -87,6 +87,8 @@ sub _upgrade_data { # bypass RT ACLs--we're going to do lots of things my $CurrentUser = $RT::SystemUser; + my $dbh = dbh; + # selfservice and cron users foreach my $username ('%%%SELFSERVICE_USER%%%', 'fs_daily') { my $User = RT::User->new($CurrentUser); @@ -252,6 +254,82 @@ sub _upgrade_data { die $msg if !$val; } #foreach (@Scrips) + # one-time fix: accumulator fields (support time, etc.) that had values + # entered on ticket creation need OCFV records attached to their Create + # transactions + my $sql = 'SELECT first_ocfv.ObjectId, first_ocfv.Created, Content '. + 'FROM ObjectCustomFieldValues as first_ocfv '. + 'JOIN ('. + # subquery to get the first OCFV with a certain name for each ticket + 'SELECT min(ObjectCustomFieldValues.Id) AS Id '. + 'FROM ObjectCustomFieldValues '. + 'JOIN CustomFields '. + 'ON (ObjectCustomFieldValues.CustomField = CustomFields.Id) '. + 'WHERE ObjectType = \'RT::Ticket\' '. + 'AND CustomFields.Name = ? '. + 'GROUP BY ObjectId'. + ') AS first_ocfv_id USING (Id) '. + 'JOIN ('. + # subquery to get the first transaction date for each ticket + # other than the Create + 'SELECT ObjectId, min(Created) AS Created FROM Transactions '. + 'WHERE ObjectType = \'RT::Ticket\' '. + 'AND Type != \'Create\' '. + 'GROUP BY ObjectId'. + ') AS first_txn ON (first_ocfv.ObjectId = first_txn.ObjectId) '. + # where the ticket custom field acquired a value before any transactions + # on the ticket (i.e. it was set on ticket creation) + 'WHERE first_ocfv.Created < first_txn.Created '. + # and we haven't already fixed the ticket + 'AND NOT EXISTS('. + 'SELECT 1 FROM Transactions JOIN ObjectCustomFieldValues '. + 'ON (Transactions.Id = ObjectCustomFieldValues.ObjectId) '. + 'JOIN CustomFields '. + 'ON (ObjectCustomFieldValues.CustomField = CustomFields.Id) '. + 'WHERE ObjectCustomFieldValues.ObjectType = \'RT::Transaction\' '. + 'AND CustomFields.Name = ? '. + 'AND Transactions.Type = \'Create\''. + 'AND Transactions.ObjectType = \'RT::Ticket\''. + 'AND Transactions.ObjectId = first_ocfv.ObjectId'. + ')'; + #whew + + # prior to this fix, the only name an accumulate field could possibly have + # was "Support time". + my $sth = $dbh->prepare($sql); + $sth->execute('Support time', 'Support time'); + my $rows = $sth->rows; + warn "Fixing support time on $rows rows...\n" if $rows > 0; + while ( my $row = $sth->fetchrow_arrayref ) { + my ($tid, $created, $content) = @$row; + my $Txns = RT::Transactions->new($CurrentUser); + $Txns->Limit(FIELD => 'ObjectId', VALUE => $tid); + $Txns->Limit(FIELD => 'ObjectType', VALUE => 'RT::Ticket'); + $Txns->Limit(FIELD => 'Type', VALUE => 'Create'); + my $CreateTxn = $Txns->First; + if ($CreateTxn) { + my ($val, $msg) = $CreateTxn->AddCustomFieldValue( + Field => 'Support time', + Value => $content, + RecordTransaction => 0, + ); + warn "Error setting transaction support time: $msg\n" unless $val; + } else { + warn "Create transaction not found for ticket $tid.\n"; + } + } + + #Pg-specific + my $cve_2013_3373_sql = q( + UPDATE Tickets SET Subject = REPLACE(Subject,E'\n','') + ); + #need this for mysql + #UPDATE Tickets SET Subject = REPLACE(Subject,'\n',''); + + my $cve_2013_3373_sth = $dbh->prepare( $cve_2013_3373_sql) + or die $dbh->errstr; + $cve_2013_3373_sth->execute or die $cve_2013_3373_sth->errstr; + return; } diff --git a/FS/FS/TicketSystem/RT_Internal.pm b/FS/FS/TicketSystem/RT_Internal.pm index 01e2e2966..d0913d84d 100644 --- a/FS/FS/TicketSystem/RT_Internal.pm +++ b/FS/FS/TicketSystem/RT_Internal.pm @@ -111,7 +111,7 @@ properly. # create an RT::Tickets object for a specified custnum or svcnum sub _tickets_search { - my ( $self, $type, $number, $limit, $priority ) = @_; + my( $self, $type, $number, $limit, $priority, $status ) = @_; $type =~ /^Customer|Service$/ or die "invalid type: $type"; $number =~ /^\d+$/ or die "invalid custnum/svcnum: $number"; @@ -136,9 +136,28 @@ sub _tickets_search { } } - $rtql .= ' AND ( ' . - join(' OR ', map { "Status = '$_'" } $self->statuses) . - ' )'; + my @statuses; + if ( defined($status) && $status ) { + if ( ref($status) ) { + if ( ref($status) eq 'HASH' ) { + @statuses = grep $status->{$_}, keys %$status; + } elsif ( ref($status) eq 'ARRAY' ) { + @statuses = @$status; + } else { + #what should be the failure mode here? die? return no tickets? + die 'unknown status ref '. ref($status); + } + } else { + @statuses = ( $status ); + } + @statuses = grep /^\w+$/, @statuses; #injection prevention + } else { + @statuses = $self->statuses; + } + + $rtql .= ' AND ( '. + join(' OR ', map { "Status = '$_'" } @statuses). + ' ) '; warn "$me _customer_tickets_search:\n$rtql\n" if $DEBUG; $Tickets->FromSQL($rtql); @@ -589,7 +608,7 @@ sub _web_external_auth { # 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 :/ + die "can't auto-create RT user: $msg"; #an error message would be nice :/ #$m->abort() unless $RT::WebFallbackToInternalAuth; #$m->comp( '/Elements/Login', %ARGS, # Error => loc( 'Cannot create user: [_1]', $msg ) ); diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm index 1cc539a9f..ccba1de3a 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -3,9 +3,10 @@ package FS::UI::Web; use strict; use vars qw($DEBUG @ISA @EXPORT_OK $me); use Exporter; -use Carp qw( confess );; +use Carp qw( confess ); +use HTML::Entities; use FS::Conf; -use FS::Misc::DateTime qw( parse_datetime ); +use FS::Misc::DateTime qw( parse_datetime day_end ); use FS::Record qw(dbdef); use FS::cust_main; # are sql_balance and sql_date_balance in the right module? @@ -31,16 +32,16 @@ sub parse_beginning_ending { my $beginning = 0; if ( $cgi->param($prefix.'begin') =~ /^(\d+)$/ ) { $beginning = $1; - } elsif ( $cgi->param($prefix.'beginning') =~ /^([ 0-9\-\/]{1,64})$/ ) { + } elsif ( $cgi->param($prefix.'beginning') =~ /^([ 0-9\-\/\:]{1,64})$/ ) { $beginning = parse_datetime($1) || 0; } my $ending = 4294967295; #2^32-1 if ( $cgi->param($prefix.'end') =~ /^(\d+)$/ ) { $ending = $1 - 1; - } elsif ( $cgi->param($prefix.'ending') =~ /^([ 0-9\-\/]{1,64})$/ ) { - #probably need an option to turn off the + 86399 - $ending = parse_datetime($1) + 86399; + } elsif ( $cgi->param($prefix.'ending') =~ /^([ 0-9\-\/\:]{1,64})$/ ) { + $ending = parse_datetime($1); + $ending = day_end($ending) unless $ending =~ /:/; } ( $beginning, $ending ); @@ -234,20 +235,20 @@ sub cust_header { '(service) Name' => 'ship_contact', '(bill) Company' => 'company', '(service) Company' => 'ship_company', - 'Address 1' => 'address1', - 'Address 2' => 'address2', - 'City' => 'city', - 'State' => 'state', - 'Zip' => 'zip', + 'Address 1' => 'bill_address1', + 'Address 2' => 'bill_address2', + 'City' => 'bill_city', + 'State' => 'bill_state', + 'Zip' => 'bill_zip', 'Country' => 'country_full', 'Day phone' => 'daytime', # XXX should use msgcat, but how? 'Night phone' => 'night', # XXX should use msgcat, but how? 'Fax number' => 'fax', - '(bill) Address 1' => 'address1', - '(bill) Address 2' => 'address2', - '(bill) City' => 'city', - '(bill) State' => 'state', - '(bill) Zip' => 'zip', + '(bill) Address 1' => 'bill_address1', + '(bill) Address 2' => 'bill_address2', + '(bill) City' => 'bill_city', + '(bill) State' => 'bill_state', + '(bill) Zip' => 'bill_zip', '(bill) Country' => 'country_full', '(bill) Day phone' => 'daytime', # XXX should use msgcat, but how? '(bill) Night phone' => 'night', # XXX should use msgcat, but how? @@ -334,17 +335,21 @@ setting is supplied, the <B>cust-fields</B> configuration value. sub cust_sql_fields { my @fields = qw( last first company ); - push @fields, map "ship_$_", @fields; - push @fields, 'country'; +# push @fields, map "ship_$_", @fields; cust_header(@_); #inefficientish, but tiny lists and only run once per page - my @add_fields = qw( address1 address2 city state zip daytime night fax ); - push @fields, - grep { my $field = $_; grep { $_ eq $field } @cust_fields } - ( @add_fields, ( map "ship_$_", @add_fields ), 'payby' ); - + my @location_fields; + foreach my $field (qw( address1 address2 city state zip )) { + foreach my $pre ('bill_','ship_') { + if ( grep { $_ eq $pre.$field } @cust_fields ) { + push @location_fields, $pre.'location.'.$field.' AS '.$pre.$field; + } + } + } + + push @fields, 'payby' if grep { $_ eq 'payby'} @cust_fields; push @fields, 'agent_custid'; my @extra_fields = (); @@ -352,7 +357,71 @@ sub cust_sql_fields { push @extra_fields, FS::cust_main->balance_sql . " AS current_balance"; } - map("cust_main.$_", @fields), @extra_fields; + map("cust_main.$_", @fields), @location_fields, @extra_fields; +} + +=item join_cust_main [ TABLE[.CUSTNUM] ] [ LOCATION_TABLE[.LOCATIONNUM] ] + +Returns an SQL join phrase for the FROM clause so that the fields listed +in L<cust_sql_fields> will be available. Currently joins to cust_main +itself, as well as cust_location (under the aliases 'bill_location' and +'ship_location') if address fields are needed. L<cust_header()> should have +been called already. + +All of these will be left joins; if you want to exclude rows with no linked +cust_main record (or bill_location/ship_location), you can do so in the +WHERE clause. + +TABLE is the table containing the custnum field. If CUSTNUM (a field name +in that table) is specified, that field will be joined to cust_main.custnum. +Otherwise, this function will assume the field is named "custnum". If the +argument isn't present at all, the join will just say "USING (custnum)", +which might work. + +As a special case, if TABLE is 'cust_main', only the joins to cust_location +will be returned. + +LOCATION_TABLE is an optional table name to use for joining ship_location, +in case your query also includes package information and you want the +"service address" columns to reflect package addresses. + +=cut + +sub join_cust_main { + my ($cust_table, $location_table) = @_; + my ($custnum, $locationnum); + ($cust_table, $custnum) = split(/\./, $cust_table); + $custnum ||= 'custnum'; + ($location_table, $locationnum) = split(/\./, $location_table); + $locationnum ||= 'locationnum'; + + my $sql = ''; + if ( $cust_table ) { + $sql = " LEFT JOIN cust_main ON (cust_main.custnum = $cust_table.$custnum)" + unless $cust_table eq 'cust_main'; + } else { + $sql = " LEFT JOIN cust_main USING (custnum)"; + } + + if ( !@cust_fields or grep /^bill_/, @cust_fields ) { + + $sql .= ' LEFT JOIN cust_location bill_location'. + ' ON (bill_location.locationnum = cust_main.bill_locationnum)'; + + } + + if ( !@cust_fields or grep /^ship_/, @cust_fields ) { + + if (!$location_table) { + $location_table = 'cust_main'; + $locationnum = 'ship_locationnum'; + } + + $sql .= ' LEFT JOIN cust_location ship_location'. + " ON (ship_location.locationnum = $location_table.$locationnum) "; + } + + $sql; } =item cust_fields OBJECT [ CUST_FIELDS_VALUE ] @@ -383,7 +452,7 @@ sub cust_fields { map { if ( $record->custnum ) { warn " $record -> $_" if $DEBUG > 1; - $record->$_(@_); + encode_entities( $record->$_(@_) ); } else { warn " ($record unlinked)" if $DEBUG > 1; $seen_unlinked++ ? '' : '(unlinked)'; @@ -403,23 +472,26 @@ sub cust_fields_subs { my $unlinked_warn = 0; return map { my $f = $_; - if( $unlinked_warn++ ) { + if ( $unlinked_warn++ ) { + sub { my $record = shift; - if( $record->custnum ) { - $record->$f(@_); - } - else { + if ( $record->custnum ) { + encode_entities( $record->$f(@_) ); + } else { '(unlinked)' }; - } - } - else { + }; + + } else { + sub { my $record = shift; - $record->$f(@_) if $record->custnum; - } + $record->custnum ? encode_entities( $record->$f(@_) ) : ''; + }; + } + } @cust_fields; } @@ -509,8 +581,8 @@ use vars qw($DEBUG); use Carp; use Storable qw(nfreeze); use MIME::Base64; -use JSON; -use FS::UID qw(getotaker); +use JSON::XS; +use FS::CurrentUser; use FS::Record qw(qsearchs); use FS::queue; use FS::CGI qw(rooturl); @@ -584,7 +656,7 @@ sub start_job { push @{$param{$field}}, $value; } } - $param{CurrentUser} = getotaker(); + $param{CurrentUser} = $FS::CurrentUser::CurrentUser->username; $param{RootURL} = rooturl($self->{cgi}->self_url); warn "FS::UI::Web::start_job\n". join('', map { @@ -606,6 +678,10 @@ sub start_job { #warn 'froze string of size '. length(nfreeze(\%param)). " for job args\n" # if $DEBUG; + # + # XXX FS::queue::insert knows how to do this. + # not changing it here because that requires changing it everywhere else, + # too, but we should eventually fix it my $error = $job->insert( '_JOB', encode_base64(nfreeze(\%param)) ); @@ -654,10 +730,7 @@ sub job_status { @return = ( 'error', $job ? $job->statustext : $jobnum ); } - #to_json(\@return); #waiting on deb 5.0 for new JSON.pm? - #silence the warning though - my $to_json = JSON->can('to_json') || JSON->can('objToJson'); - &$to_json(\@return); + encode_json \@return; } diff --git a/FS/FS/UI/Web/small_custview.pm b/FS/FS/UI/Web/small_custview.pm index 2c42a6b46..ae0a4211b 100644 --- a/FS/FS/UI/Web/small_custview.pm +++ b/FS/FS/UI/Web/small_custview.pm @@ -29,7 +29,7 @@ sub small_custview { : qsearchs('cust_main', { 'custnum' => $arg } ) or die "unknown custnum $arg"; - my $html = '<DIV ID="fs_small_custview">'; + my $html = '<DIV ID="fs_small_custview" CLASS="small_custview">'; $html = qq!View <A HREF="$url?! . $cust_main->custnum . '">' if $url; @@ -58,12 +58,13 @@ sub small_custview { $html .= ntable('#e8e8e8'). '<TR><TD VALIGN="top">'. ntable("#cccccc",2). '<TR><TD ALIGN="right" VALIGN="top">Billing<BR>Address</TD><TD BGCOLOR="#ffffff">'. - $cust_main->getfield('last'). ', '. $cust_main->first. '<BR>'; + encode_entities($cust_main->getfield('last')). ', '. + encode_entities($cust_main->first). '<BR>'; - $html .= $cust_main->company. '<BR>' if $cust_main->company; - $html .= $cust_main->address1. '<BR>'; - $html .= $cust_main->address2. '<BR>' if $cust_main->address2; - $html .= $cust_main->city. ', '. $cust_main->state. ' '. $cust_main->zip. '<BR>'; + $html .= encode_entities($cust_main->company). '<BR>' if $cust_main->company; + $html .= encode_entities($cust_main->address1). '<BR>'; + $html .= encode_entities($cust_main->address2). '<BR>' if $cust_main->address2; + $html .= encode_entities($cust_main->city). ', '. $cust_main->state. ' '. $cust_main->zip. '<BR>'; $html .= $cust_main->country. '<BR>' if $cust_main->country && $cust_main->country ne $countrydefault; @@ -87,7 +88,7 @@ sub small_custview { $html .= '<TD VALIGN="top">'. ntable("#cccccc",2). '<TR><TD ALIGN="right" VALIGN="top">Service<BR>Address</TD><TD BGCOLOR="#ffffff">'; $html .= join('<BR>', - grep $_, + map encode_entities($_), grep $_, $cust_main->contact, $cust_main->company, $ship->address1, diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index 67bb75fe3..9c52f0883 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -2,23 +2,23 @@ package FS::UID; use strict; use vars qw( - @ISA @EXPORT_OK $DEBUG $me $cgi $freeside_uid $user $conf_dir $cache_dir + @ISA @EXPORT_OK $DEBUG $me $cgi $freeside_uid $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 -); +use subs qw( getsecrets ); use Exporter; -use Carp qw(carp croak cluck confess); +use Carp qw( carp croak cluck confess ); use DBI; use IO::File; use FS::CurrentUser; @ISA = qw(Exporter); -@EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup - getotaker dbh datasrc getsecrets driver_name myconnect - use_confcompat); +@EXPORT_OK = qw( checkeuid checkruid cgi setcgi adminsuidsetup forksuidsetup + preuser_setup + getotaker dbh datasrc getsecrets driver_name myconnect + use_confcompat + ); $DEBUG = 0; $me = '[FS::UID]'; @@ -38,13 +38,9 @@ FS::UID - Subroutines for database login and assorted other stuff =head1 SYNOPSIS - use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker - checkeuid checkruid); - - adminsuidsetup $user; + use FS::UID qw(adminsuidsetup dbh datasrc checkeuid checkruid); - $cgi = new CGI; - $dbh = cgisuidsetup($cgi); + $dbh = adminsuidsetup $user; $dbh = dbh; @@ -66,7 +62,6 @@ Sets the user to USER (see config.html from the base documentation). Cleans the environment. Make sure the script is running as freeside, or setuid freeside. Opens a connection to the database. -Swaps real and effective UIDs. Runs any defined callbacks (see below). Returns the DBI database handle (usually you don't need this). @@ -78,7 +73,7 @@ sub adminsuidsetup { } sub forksuidsetup { - $user = shift; + my $user = shift; my $olduser = $user; warn "$me forksuidsetup starting for $user\n" if $DEBUG; @@ -91,13 +86,40 @@ sub forksuidsetup { $user = $1; } - $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin'; + env_setup(); + + db_setup($olduser); + + callback_setup(); + + warn "$me forksuidsetup loading user\n" if $DEBUG; + FS::CurrentUser->load_user($user); + + $dbh; +} + +sub preuser_setup { + $dbh->disconnect if $dbh; + env_setup(); + db_setup(); + callback_setup(); + $dbh; +} + +sub env_setup { + + $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/bin'; $ENV{'SHELL'} = '/bin/sh'; $ENV{'IFS'} = " \t\n"; $ENV{'CDPATH'} = ''; $ENV{'ENV'} = ''; $ENV{'BASH_ENV'} = ''; +} + +sub db_setup { + my $olduser = shift; + croak "Not running uid freeside (\$>=$>, \$<=$<)\n" unless checkeuid(); warn "$me forksuidsetup connecting to database\n" if $DEBUG; @@ -131,6 +153,11 @@ sub forksuidsetup { die "NO CONFIGURATION TABLE FOUND" unless $FS::Schema::setup_hack; } + +} + +sub callback_setup { + unless ( $callback_hack ) { warn "$me calling callbacks\n" if $DEBUG; foreach ( keys %callback ) { @@ -143,19 +170,15 @@ sub forksuidsetup { warn "$me skipping callbacks (callback_hack set)\n" if $DEBUG; } - warn "$me forksuidsetup loading user\n" if $DEBUG; - FS::CurrentUser->load_user($user); - - $dbh; } sub myconnect { - my $handle = DBI->connect( getsecrets(@_), { 'AutoCommit' => 0, - 'ChopBlanks' => 1, - 'ShowErrorStatement' => 1, - 'pg_enable_utf8' => 1, - #'mysql_enable_utf8' => 1, - } + my $handle = DBI->connect( getsecrets(), { 'AutoCommit' => 0, + 'ChopBlanks' => 1, + 'ShowErrorStatement' => 1, + 'pg_enable_utf8' => 1, + #'mysql_enable_utf8' => 1, + } ) or die "DBI->connect error: $DBI::errstr\n"; @@ -194,35 +217,26 @@ sub install_callback { &{$callback} if $dbh; } -=item cgisuidsetup CGI_object +=item cgi -Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>) -object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup. +Returns the CGI (see L<CGI>) object. =cut -sub cgisuidsetup { - $cgi=shift; - if ( $cgi->isa('CGI::Base') ) { - carp "Use of CGI::Base is depriciated"; - } elsif ( $cgi->isa('Apache') ) { - - } elsif ( ! $cgi->isa('CGI') ) { - croak "fatal: unrecognized object $cgi"; - } - cgisetotaker; - adminsuidsetup($user); +sub cgi { + carp "warning: \$FS::UID::cgi is undefined" unless defined($cgi); + #carp "warning: \$FS::UID::cgi isa Apache" if $cgi && $cgi->isa('Apache'); + $cgi; } -=item cgi +=item cgi CGI_OBJECT -Returns the CGI (see L<CGI>) object. +Sets the CGI (see L<CGI>) object. =cut -sub cgi { - carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache'); - $cgi; +sub setcgi { + $cgi = shift; } =item dbh @@ -262,35 +276,13 @@ sub suidsetup { =item getotaker -Returns the current Freeside user. +(Deprecated) Returns the current Freeside user's username. =cut sub getotaker { - $user; -} - -=item cgisetotaker - -Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm -object (see L<CGI>) or an Apache object (see L<Apache>). Support for CGI::Base -and derived classes is depriciated. - -=cut - -sub cgisetotaker { - if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) { - carp "Use of CGI::Base is depriciated"; - $user = lc ( $cgi->var('REMOTE_USER') ); - } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) { - $user = lc ( $cgi->remote_user ); - } elsif ( $cgi && $cgi->isa('Apache') ) { - $user = lc ( $cgi->connection->user ); - } else { - die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ". - "Apache user authentication as documented in the installation instructions"; - } - $user; + carp "FS::UID::getotaker deprecated"; + $FS::CurrentUser::CurrentUser->username; } =item checkeuid @@ -314,34 +306,18 @@ sub checkruid { ( $< == $freeside_uid ); } -=item getsecrets [ USER ] +=item getsecrets -Sets the user to USER, if supplied. -Sets and returns the DBI datasource, username and password for this user from -the `/usr/local/etc/freeside/mapsecrets' file. +Sets and returns the DBI datasource, username and password from +the `/usr/local/etc/freeside/secrets' file. =cut sub getsecrets { - my($setuser) = shift; - $user = $setuser if $setuser; - - if ( -e "$conf_dir/mapsecrets" ) { - die "No user!" unless $user; - my($line) = grep /^\s*($user|\*)\s/, - map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/mapsecrets"); - confess "User $user not found in mapsecrets!" unless $line; - $line =~ /^\s*($user|\*)\s+(.*)$/; - $secrets = $2; - die "Illegal mapsecrets line for user?!" unless $secrets; - } else { - # no mapsecrets file at all, so do the default thing - $secrets = 'secrets'; - } ($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"; + 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); @@ -390,8 +366,7 @@ Too many package-global variables. Not OO. -No capabilities yet. When mod_perl and Authen::DBI are implemented, -cgisuidsetup will go away as well. +No capabilities yet. (What does this mean again?) Goes through contortions to support non-OO syntax with multiple datasrc's. diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm index 3f76f5116..cda3198eb 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -84,6 +84,13 @@ sub upgrade_config { } } + # if there's a USPS tools login, assume that's the standardization method + # you want to use + if ( length($conf->config('usps_webtools-userid')) > 0 and + !$conf->exists('address_standardize_method') ) { + $conf->set('address_standardize_method', 'usps'); + } + } sub upgrade_overlimit_groups { @@ -287,6 +294,9 @@ sub upgrade_data { #insert default tower_sector if not present 'tower' => [], + #repair improperly deleted services + 'cust_svc' => [], + #routernum/blocknum 'svc_broadband' => [], @@ -298,6 +308,9 @@ sub upgrade_data { #kick off tax location history upgrade 'cust_bill_pkg' => [], + + #fix taxable line item links + 'cust_bill_pkg_tax_location' => [], ; \%hash; diff --git a/FS/FS/XMLRPC.pm b/FS/FS/XMLRPC.pm index 73ce13f7a..62ae43d18 100644 --- a/FS/FS/XMLRPC.pm +++ b/FS/FS/XMLRPC.pm @@ -11,8 +11,6 @@ use FS::Conf; use FS::Record; use FS::cust_main; -use FS::Maestro; - use Data::Dumper; $DEBUG = 0; diff --git a/FS/FS/access_right.pm b/FS/FS/access_right.pm index 397b456ce..f8e30d0d2 100644 --- a/FS/FS/access_right.pm +++ b/FS/FS/access_right.pm @@ -198,6 +198,10 @@ sub _upgrade_data { # class method 'New prospect' => 'Generate quotation', 'Delete invoices' => 'Void invoices', 'List invoices' => 'List quotations', + 'Post credit' => 'Credit line items', + #'View customer tax exemptions' => 'Edit customer tax exemptions', + 'Edit customer' => 'Edit customer tax exemptions', + 'Edit package definitions' => 'Bulk edit package definitions', 'List services' => [ 'Services: Accounts', 'Services: Domains', @@ -218,12 +222,20 @@ sub _upgrade_data { # class method 'Services: Accounts' => 'Services: Accounts: Advanced search', 'Services: Wireless broadband services' => 'Services: Wireless broadband services: Advanced search', 'Services: Hardware' => 'Services: Hardware: Advanced search', + 'Services: Phone numbers' => 'Services: Phone numbers: Advanced search', 'List rating data' => [ 'Usage: RADIUS sessions', 'Usage: Call Detail Records (CDRs)', 'Usage: Unrateable CDRs', ], - ; + 'Provision customer service' => [ 'Edit password' ], + 'Financial reports' => [ 'Employees: Commission Report', + 'Employees: Audit Report', + ], + 'Change customer package' => 'Detach customer package', + 'Services: Accounts' => 'Services: Cable Subscribers', + 'Bulk change customer packages' => 'Bulk move customer services', +; foreach my $old_acl ( keys %onetime ) { diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm index 509cc0950..7c25acbe3 100644 --- a/FS/FS/access_user.pm +++ b/FS/FS/access_user.pm @@ -2,8 +2,9 @@ package FS::access_user; use strict; use base qw( FS::m2m_Common FS::option_Common ); -use vars qw( $DEBUG $me $conf $htpasswd_file ); +use vars qw( $DEBUG $me $conf ); use FS::UID; +use FS::Auth; use FS::Conf; use FS::Record qw( qsearch qsearchs dbh ); use FS::access_user_pref; @@ -14,12 +15,6 @@ use FS::cust_main; $DEBUG = 0; $me = '[FS::access_user]'; -#kludge htpasswd for now (i hope this bootstraps okay) -FS::UID->install_callback( sub { - $conf = new FS::Conf; - $htpasswd_file = $conf->base_dir. '/htpasswd'; -} ); - =head1 NAME FS::access_user - Object methods for access_user records @@ -105,7 +100,6 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - $error = $self->htpasswd_kludge(); if ( $error ) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; return $error; @@ -115,14 +109,7 @@ sub insert { if ( $error ) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - - #make sure it isn't a dup username? or you could nuke people's passwords - #blah. really just should do our own login w/cookies - #and auth out of the db in the first place - #my $hterror = $self->htpasswd_kludge('-D'); - #$error .= " - additionally received error cleaning up htpasswd file: $hterror" return $error; - } else { $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -130,26 +117,6 @@ sub insert { } -sub htpasswd_kludge { - my $self = shift; - - return '' if $self->is_system_user; - - unshift @_, '-c' unless -e $htpasswd_file; - if ( - system('htpasswd', '-b', @_, - $htpasswd_file, - $self->username, - $self->_password, - ) == 0 - ) - { - return ''; - } else { - return 'htpasswd exited unsucessfully'; - } -} - =item delete Delete this record from the database. @@ -170,10 +137,7 @@ sub delete { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = - $self->SUPER::delete(@_) - || $self->htpasswd_kludge('-D') - ; + my $error = $self->SUPER::delete(@_); if ( $error ) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; @@ -210,16 +174,11 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - if ( $new->_password ne $old->_password ) { - my $error = $new->htpasswd_kludge(); - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - return $error; - } - } elsif ( $old->disabled && !$new->disabled - && $new->_password =~ /changeme/i ) { - return "Must change password when enabling this account"; - } + return "Must change password when enabling this account" + if $old->disabled && !$new->disabled + && ( $new->_password =~ /changeme/i + || $new->_password eq 'notyet' + ); my $error = $new->SUPER::replace($old, @_); @@ -250,9 +209,9 @@ sub check { my $error = $self->ut_numbern('usernum') || $self->ut_alpha_lower('username') - || $self->ut_text('_password') - || $self->ut_text('last') - || $self->ut_text('first') + || $self->ut_textn('_password') + || $self->ut_textn('last') + || $self->ut_textn('first') || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum') || $self->ut_enum('disabled', [ '', 'Y' ] ) ; @@ -270,7 +229,8 @@ Returns a name string for this user: "Last, First". sub name { my $self = shift; return $self->username - if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname'; + if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname' + or $self->get('last') eq '' && $self->first eq ''; return $self->get('last'). ', '. $self->first; } @@ -550,7 +510,7 @@ sub spreadsheet_format { =item is_system_user Returns true if this user has the name of a known system account. These -users will not appear in the htpasswd file and can't have passwords set. +users cannot log into the web interface and can't have passwords set. =cut @@ -563,7 +523,27 @@ sub is_system_user { fs_signup fs_bootstrap fs_selfserv -) ); + ) ); +} + +=item change_password NEW_PASSWORD + +=cut + +sub change_password { + #my( $self, $password ) = @_; + #FS::Auth->auth_class->change_password( $self, $password ); + FS::Auth->auth_class->change_password( @_ ); +} + +=item change_password_fields NEW_PASSWORD + +=cut + +sub change_password_fields { + #my( $self, $password ) = @_; + #FS::Auth->auth_class->change_password_fields( $self, $password ); + FS::Auth->auth_class->change_password_fields( @_ ); } =back diff --git a/FS/FS/access_user_session.pm b/FS/FS/access_user_session.pm new file mode 100644 index 000000000..df112f984 --- /dev/null +++ b/FS/FS/access_user_session.pm @@ -0,0 +1,158 @@ +package FS::access_user_session; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearchs ); # qsearch ); +use FS::access_user; + +=head1 NAME + +FS::access_user_session - Object methods for access_user_session records + +=head1 SYNOPSIS + + use FS::access_user_session; + + $record = new FS::access_user_session \%hash; + $record = new FS::access_user_session { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::access_user_session object represents a backoffice web session. +FS::access_user_session inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item sessionnum + +Database primary key + +=item sessionkey + +Session key + +=item usernum + +Employee (see L<FS::access_user>) + +=item start_date + +Session start timestamp + +=item last_date + +Last session activity timestamp + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new session. To add the session 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 { 'access_user_session'; } + +=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 session. 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('sessionnum') + || $self->ut_text('sessionkey') + || $self->ut_foreign_key('usernum', 'access_user', 'usernum') + || $self->ut_number('start_date') + || $self->ut_numbern('last_date') + ; + return $error if $error; + + $self->last_date( $self->start_date ) unless $self->last_date; + + $self->SUPER::check; +} + +=item access_user + +Returns the employee (see L<FS::access_user>) for this session. + +=cut + +sub access_user { + my $self = shift; + qsearchs('access_user', { 'usernum' => $self->usernum }); +} + +=item touch_last_date + +=cut + +sub touch_last_date { + my $self = shift; + my $old_last_date = $self->last_date; + $self->last_date(time); + return if $old_last_date >= $self->last_date; + my $error = $self->replace; + die $error if $error; +} + +=item logout + +=cut + +sub logout { + my $self = shift; + my $error = $self->delete; + die $error if $error; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/addr_block.pm b/FS/FS/addr_block.pm index 686bdbd18..6a62777be 100755 --- a/FS/FS/addr_block.pm +++ b/FS/FS/addr_block.pm @@ -6,6 +6,7 @@ use FS::Record qw( qsearchs qsearch dbh ); use FS::router; use FS::svc_broadband; use FS::Conf; +use FS::IP_Mixin; use NetAddr::IP; use Carp qw( carp ); use List::Util qw( first ); @@ -238,7 +239,7 @@ sub next_free_addr { my $self = shift; my $selfaddr = $self->NetAddr; - return if $self->manual_flag; + return () if $self->manual_flag; my $conf = new FS::Conf; my @excludeaddr = $conf->config('exclude_ip_addr'); @@ -249,9 +250,7 @@ sub next_free_addr { $selfaddr->addr, $selfaddr->network->addr, $selfaddr->broadcast->addr, - (map { $_->NetAddr->addr } - qsearch('svc_broadband', { blocknum => $self->blocknum }) - ), @excludeaddr + FS::IP_Mixin->used_addresses($self) ); # just do a linear search of the block diff --git a/FS/FS/agent.pm b/FS/FS/agent.pm index 3794d3f1d..57093e329 100644 --- a/FS/FS/agent.pm +++ b/FS/FS/agent.pm @@ -1,19 +1,18 @@ package FS::agent; +use base qw( FS::m2m_Common FS::m2name_Common FS::Record ); 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::agent_currency; use FS::reg_code; use FS::TicketSystem; use FS::Conf; -@ISA = qw( FS::m2m_Common FS::Record ); - =head1 NAME FS::agent - Object methods for agent records @@ -177,6 +176,31 @@ sub agent_cust_main { qsearchs( 'cust_main', { 'custnum' => $self->agent_custnum } ); } +=item agent_currency + +Returns the FS::agent_currency objects (see L<FS::agent_currency>), if any, for +this agent. + +=cut + +sub agent_currency { + my $self = shift; + qsearch('agent_currency', { 'agentnum' => $self->agentnum } ); +} + +=item agent_currency_hashref + +Returns a hash references of supported additional currencies for this agent. + +=cut + +sub agent_currency_hashref { + my $self = shift; + +{ map { $_->currency => 1 } + $self->agent_currency + }; +} + =item pkgpart_hashref Returns a hash reference. The keys of the hash are pkgparts. The value is @@ -206,7 +230,8 @@ sub ticketing_queue { 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>. +Currently available options are I<nofatal>, I<invnum>, I<method>, +I<payinfo>, and I<thirdparty>. If I<nofatal> is set, and no gateway is available, then the empty string will be returned instead of throwing a fatal exception. @@ -216,15 +241,39 @@ 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. +as well. Presently only 'CC', 'ECHECK', and 'PAYPAL' 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. +If I<thirdparty> is set, the defined self-service payment gateway will +be returned. + =cut sub payment_gateway { my ( $self, %options ) = @_; + + my $conf = new FS::Conf; + + if ( $options{thirdparty} ) { + # still a kludge, but it gets the job done + # and the 'cardtype' semantics don't really apply to thirdparty + # gateways because we have to choose a gateway without ever + # seeing the card number + my $gatewaynum = + $conf->config('selfservice-payment_gateway', $self->agentnum); + my $gateway = FS::payment_gateway->by_key($gatewaynum) + if $gatewaynum; + + if ( $gateway ) { + return $gateway; + } elsif ( $options{'nofatal'} ) { + return ''; + } else { + die "no third-party gateway configured\n"; + } + } my $taxclass = ''; if ( $options{invnum} ) { @@ -246,13 +295,15 @@ sub payment_gateway { } #look for an agent gateway override first - my $cardtype; - if ( $options{method} && $options{method} eq 'CC' && $options{payinfo} ) { - $cardtype = cardtype($options{payinfo}); - } elsif ( $options{method} && $options{method} eq 'ECHECK' ) { - $cardtype = 'ACH'; - } else { - $cardtype = $options{method} || ''; + my $cardtype = ''; + if ( $options{method} ) { + if ( $options{method} eq 'CC' && $options{payinfo} ) { + $cardtype = cardtype($options{payinfo}); + } elsif ( $options{method} eq 'ECHECK' ) { + $cardtype = 'ACH'; + } else { + $cardtype = $options{method} + } } my $override = @@ -270,7 +321,6 @@ sub payment_gateway { taxclass => '', } ); my $payment_gateway; - my $conf = new FS::Conf; if ( $override ) { #use a payment gateway override $payment_gateway = $override->payment_gateway; diff --git a/FS/FS/agent_currency.pm b/FS/FS/agent_currency.pm new file mode 100644 index 000000000..e387844bf --- /dev/null +++ b/FS/FS/agent_currency.pm @@ -0,0 +1,110 @@ +package FS::agent_currency; +use base qw( FS::Record ); + +use strict; +#use FS::Record qw( qsearch qsearchs ); +use FS::agent; + +=head1 NAME + +FS::agent_currency - Object methods for agent_currency records + +=head1 SYNOPSIS + + use FS::agent_currency; + + $record = new FS::agent_currency \%hash; + $record = new FS::agent_currency { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::agent_currency object represents an agent's ability to sell +in a specific non-default currency. FS::agent_currency inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item agentcurrencynum + +primary key + +=item agentnum + +Agent (see L<FS::agent>) + +=item currency + +3 letter currency code + +=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 { 'agent_currency'; } + +=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 + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('agentcurrencynum') + || $self->ut_foreign_key('agentnum', 'agent', 'agentnum') + || $self->ut_currency('currency') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, L<FS::agent> + +=cut + +1; + diff --git a/FS/FS/banned_pay.pm b/FS/FS/banned_pay.pm index b93f67bbe..713c81adf 100644 --- a/FS/FS/banned_pay.pm +++ b/FS/FS/banned_pay.pm @@ -4,7 +4,6 @@ use strict; use base qw( FS::otaker_Mixin FS::Record ); use Digest::MD5 qw(md5_base64); use FS::Record qw( qsearch qsearchs ); -use FS::UID qw( getotaker ); use FS::CurrentUser; =head1 NAME diff --git a/FS/FS/cable_device.pm b/FS/FS/cable_device.pm new file mode 100644 index 000000000..1a0f1b998 --- /dev/null +++ b/FS/FS/cable_device.pm @@ -0,0 +1,140 @@ +package FS::cable_device; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearchs ); # qsearch ); +use FS::part_device; +use FS::svc_cable; + +=head1 NAME + +FS::cable_device - Object methods for cable_device records + +=head1 SYNOPSIS + + use FS::cable_device; + + $record = new FS::cable_device \%hash; + $record = new FS::cable_device { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cable_device object represents a specific customer cable modem. +FS::cable_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 + +=item serial + +serial + + +=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 { 'cable_device'; } + +=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 + +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_number('devicepart') + || $self->ut_foreign_key('devicepart', 'part_device', 'devicepart') + || $self->ut_foreign_key('svcnum', 'svc_cable', 'svcnum' ) #cust_svc? + || $self->ut_hexn('mac_addr') + || $self->ut_textn('serial') + ; + 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 } ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record> + +=cut + +1; + diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm index fdec921ee..3ebe6c420 100644 --- a/FS/FS/cdr.pm +++ b/FS/FS/cdr.pm @@ -11,6 +11,7 @@ use Date::Parse; use Date::Format; use Time::Local; use List::Util qw( first min ); +use Text::CSV_XS; use FS::UID qw( dbh ); use FS::Conf; use FS::Record qw( qsearch qsearchs ); @@ -325,6 +326,10 @@ sub check { $self->billsec( $self->enddate - $self->answerdate ); } + if ( ! $self->enddate && $self->startdate && $self->duration ) { + $self->enddate( $self->startdate + $self->duration ); + } + $self->set_charged_party; #check the foreign keys even? @@ -421,12 +426,25 @@ sub set_charged_party { Sets the status to the provided string. If there is an error, returns the error, otherwise returns false. +If status is being changed from 'rated' to some other status, also removes +any usage allocations to this CDR. + =cut sub set_status { my($self, $status) = @_; + my $old_status = $self->freesidestatus; $self->freesidestatus($status); - $self->replace; + my $error = $self->replace; + if ( $old_status eq 'rated' and $status ne 'done' ) { + # deallocate any usage + foreach (qsearch('cdr_cust_pkg_usage', {acctid => $self->acctid})) { + my $cust_pkg_usage = $_->cust_pkg_usage; + $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $_->minutes); + $error ||= $cust_pkg_usage->replace || $_->delete; + } + } + $error; } =item set_status_and_rated_price STATUS RATED_PRICE [ SVCNUM [ OPTION => VALUE ... ] ] @@ -573,7 +591,7 @@ reference of the number of included minutes and will be decremented by the rated minutes of this CDR. region_group_included_minutes_hashref is required for prefix price plans which -have included minues (otehrwise unused/ignored). It should be set to an empty +have included minues (otherwise unused/ignored). It should be set to an empty hashref at the start of a month's rating and then preserved across CDRs. =cut @@ -598,6 +616,7 @@ our %interval_cache = (); # for timed rates sub rate_prefix { my( $self, %opt ) = @_; my $part_pkg = $opt{'part_pkg'} or return "No part_pkg specified"; + my $cust_pkg = $opt{'cust_pkg'}; my $da_rewrote = 0; # this will result in those CDRs being marked as done... is that @@ -625,7 +644,34 @@ sub rate_prefix { ); } + if ( $part_pkg->option_cacheable('skip_same_customer') + and ! $self->is_tollfree ) { + my ($dst_countrycode, $dst_number) = $self->parse_number( + column => 'dst', + international_prefix => $part_pkg->option_cacheable('international_prefix'), + domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'), + ); + my $dst_same_cust = FS::Record->scalar_sql( + 'SELECT COUNT(svc_phone.svcnum) AS count '. + 'FROM cust_pkg ' . + 'JOIN cust_svc USING (pkgnum) ' . + 'JOIN svc_phone USING (svcnum) ' . + 'WHERE svc_phone.countrycode = ' . dbh->quote($dst_countrycode) . + ' AND svc_phone.phonenum = ' . dbh->quote($dst_number) . + ' AND cust_pkg.custnum = ' . $cust_pkg->custnum, + ); + if ( $dst_same_cust > 0 ) { + warn "not charging for CDR (same source and destination customer)\n" if $DEBUG; + return $self->set_status_and_rated_price( 'skipped', + 0, + $opt{'svcnum'}, + ); + } + } + + + ### # look up rate details based on called station id # (or calling station id for toll free calls) @@ -823,11 +869,6 @@ sub rate_prefix { $seconds_left -= $charge_sec; - my $included_min = $opt{'region_group_included_min_hashref'} || {}; - - $included_min->{$regionnum}{$ratetimenum} = $rate_detail->min_included - unless exists $included_min->{$regionnum}{$ratetimenum}; - my $granularity = $rate_detail->sec_granularity; my $minutes; @@ -845,20 +886,40 @@ sub rate_prefix { $seconds += $charge_sec; + if ( $rate_detail->min_included ) { + # the old, kind of deprecated way to do this + my $included_min = $opt{'region_group_included_min_hashref'} || {}; - my $region_group = ($part_pkg->option_cacheable('min_included') || 0) > 0; + # by default, set the included minutes for this region/time to + # what's in the rate_detail + $included_min->{$regionnum}{$ratetimenum} = $rate_detail->min_included + unless exists $included_min->{$regionnum}{$ratetimenum}; - ${$opt{region_group_included_min}} -= $minutes - if $region_group && $rate_detail->region_group; + # the way that doesn't work + #my $region_group = ($part_pkg->option_cacheable('min_included') || 0) > 0; + + #${$opt{region_group_included_min}} -= $minutes + # if $region_group && $rate_detail->region_group; + + if ( $included_min->{$regionnum}{$ratetimenum} > $minutes ) { + $charge_sec = 0; + $included_min->{$regionnum}{$ratetimenum} -= $minutes; + } else { + $charge_sec -= ($included_min->{$regionnum}{$ratetimenum} * 60); + $included_min->{$regionnum}{$ratetimenum} = 0; + } + } else { + # the new way! + my $applied_min = $cust_pkg->apply_usage( + 'cdr' => $self, + 'rate_detail' => $rate_detail, + 'minutes' => $minutes + ); + # for now, usage pools deal only in whole minutes + $charge_sec -= $applied_min * 60; + } - $included_min->{$regionnum}{$ratetimenum} -= $minutes; - if ( - $included_min->{$regionnum}{$ratetimenum} <= 0 - && ( ${$opt{region_group_included_min}} <= 0 - || ! $rate_detail->region_group - ) - ) - { + if ( $charge_sec > 0 ) { #NOW do connection charges here... right? #my $conn_seconds = min($seconds_left, $rate_detail->conn_sec); @@ -871,16 +932,9 @@ sub rate_prefix { } #should preserve (display?) this - my $charge_min = 0 - $included_min->{$regionnum}{$ratetimenum} - ( $conn_seconds / 60 ); - $included_min->{$regionnum}{$ratetimenum} = 0; + my $charge_min = ( $charge_sec - $conn_seconds ) / 60; $charge += ($rate_detail->min_charge * $charge_min) if $charge_min > 0; #still not rounded - } elsif ( ${$opt{region_group_included_min}} > 0 - && $region_group - && $rate_detail->region_group - ) - { - $included_min->{$regionnum}{$ratetimenum} = 0 } # choose next rate_detail @@ -1168,6 +1222,8 @@ sub export_formats { length($price) ? ($opt{money_char} . $price) : ''; }; + my $src_sub = sub { $_[0]->clid || $_[0]->src }; + %export_formats = ( 'simple' => [ sub { time2str($date_format, shift->calldate_unix ) }, #DATE @@ -1182,7 +1238,7 @@ sub export_formats { sub { time2str($date_format, shift->calldate_unix ) }, #DATE sub { time2str('%r', shift->calldate_unix ) }, #TIME #'userfield', #USER - 'src', #called from + $src_sub, #called from 'dst', #NUMBER_DIALED $duration_sub, #DURATION #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE @@ -1191,7 +1247,7 @@ sub export_formats { 'accountcode_simple' => [ sub { time2str($date_format, shift->calldate_unix ) }, #DATE sub { time2str('%r', shift->calldate_unix ) }, #TIME - 'src', #called from + $src_sub, #called from 'accountcode', #NUMBER_DIALED $duration_sub, #DURATION $price_sub, @@ -1199,14 +1255,14 @@ sub export_formats { 'sum_duration' => [ # for summary formats, the CDR is a fictitious object containing the # total billsec and the phone number of the service - 'src', + $src_sub, sub { my($cdr, %opt) = @_; $opt{ratename} }, sub { my($cdr, %opt) = @_; $opt{count} }, sub { my($cdr, %opt) = @_; int($opt{seconds}/60).'m' }, $price_sub, ], 'sum_count' => [ - 'src', + $src_sub, sub { my($cdr, %opt) = @_; $opt{ratename} }, sub { my($cdr, %opt) = @_; $opt{count} }, $price_sub, @@ -1240,7 +1296,7 @@ sub export_formats { $price_sub, ], ); - $export_formats{'source_default'} = [ 'src', @{ $export_formats{'default'} }, ]; + $export_formats{'source_default'} = [ $src_sub, @{ $export_formats{'default'} }, ]; $export_formats{'accountcode_default'} = [ @{ $export_formats{'default'} }[0,1], 'accountcode', @@ -1248,7 +1304,7 @@ sub export_formats { ]; my @default = @{ $export_formats{'default'} }; $export_formats{'description_default'} = - [ 'src', @default[0..2], + [ $src_sub, @default[0..2], sub { my($cdr, %opt) = @_; $cdr->description }, @default[4,5] ]; @@ -1286,8 +1342,6 @@ sub downstream_csv { #$opt{'money_char'} ||= $conf->config('money_char') || '$'; $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$'; - eval "use Text::CSV_XS;"; - die $@ if $@; my $csv = new Text::CSV_XS; my @columns = @@ -1578,6 +1632,11 @@ my %import_options = ( keys %cdr_info }, + 'format_asn_formats' => + { map { $_ => $cdr_info{$_}->{'asn_format'}; } + keys %cdr_info + }, + 'format_row_callbacks' => { map { $_ => $cdr_info{$_}->{'row_callback'}; } keys %cdr_info }, diff --git a/FS/FS/cdr/asterisk_skip_clid.pm b/FS/FS/cdr/asterisk_skip_clid.pm new file mode 100644 index 000000000..1a105b399 --- /dev/null +++ b/FS/FS/cdr/asterisk_skip_clid.pm @@ -0,0 +1,45 @@ +package FS::cdr::asterisk_skip_clid; + +use strict; +use vars qw(@ISA %info); +use FS::cdr qw(_cdr_date_parser_maker); + +@ISA = qw(FS::cdr); + +#http://www.the-asterisk-book.com/unstable/funktionen-cdr.html +my %amaflags = ( + DEFAULT => 0, + OMIT => 1, #asterisk 1.4+ + IGNORE => 1, #asterisk 1.2 + BILLING => 2, #asterisk 1.4+ + BILL => 2, #asterisk 1.2 + DOCUMENTATION => 3, + #? '' => 0, +); + +%info = ( + 'name' => 'Asterisk (skip Caller ID)', + 'weight' => 11, + 'import_fields' => [ + 'accountcode', + 'src', + 'dst', + 'dcontext', + 'SKIP_clid', + 'channel', + 'dstchannel', + 'lastapp', + 'lastdata', + _cdr_date_parser_maker('startdate'), + _cdr_date_parser_maker('answerdate'), + _cdr_date_parser_maker('enddate'), + 'duration', + 'billsec', + 'disposition', + sub { my($cdr, $amaflags) = @_; $cdr->amaflags($amaflags{$amaflags}); }, + 'uniqueid', + 'userfield', + ], +); + +1; diff --git a/FS/FS/cdr/gsm_tap3_12.pm b/FS/FS/cdr/gsm_tap3_12.pm new file mode 100644 index 000000000..275e7b35c --- /dev/null +++ b/FS/FS/cdr/gsm_tap3_12.pm @@ -0,0 +1,2079 @@ +package FS::cdr::gsm_tap3_12; +use base qw( FS::cdr ); + +use strict; +use vars qw( %info %TZ ); +use Time::Local; +#use Data::Dumper; + +#false laziness w/huawei_softx3000.pm +%TZ = ( + '+0000' => 'XXX-0', + '+0100' => 'XXX-1', + '+0200' => 'XXX-2', + '+0300' => 'XXX-3', + '+0400' => 'XXX-4', + '+0500' => 'XXX-5', + '+0600' => 'XXX-6', + '+0700' => 'XXX-7', + '+0800' => 'XXX-8', + '+0900' => 'XXX-9', + '+1000' => 'XXX-10', + '+1100' => 'XXX-11', + '+1200' => 'XXX-12', + '-0000' => 'XXX+0', + '-0100' => 'XXX+1', + '-0200' => 'XXX+2', + '-0300' => 'XXX+3', + '-0400' => 'XXX+4', + '-0500' => 'XXX+5', + '-0600' => 'XXX+6', + '-0700' => 'XXX+7', + '-0800' => 'XXX+8', + '-0900' => 'XXX+9', + '-1000' => 'XXX+10', + '-1100' => 'XXX+11', + '-1200' => 'XXX+12', +); + +%info = ( + 'name' => 'GSM TAP3 release 12', + 'weight' => 50, + 'type' => 'asn.1', + 'import_fields' => [], + 'asn_format' => { + 'spec' => _asn_spec(), + 'macro' => 'TransferBatch', #XXX & skip the Notification ones? + 'header_buffer' => sub { + my $TransferBatch = shift; + + my $networkInfo = $TransferBatch->{networkInfo}; + + my $recEntityInfo = $networkInfo->{recEntityInfo}; + my %recEntity = map { $_->{recEntityCode} => $_->{recEntityId} } @$recEntityInfo; + + my $utcTimeOffsetInfo = $networkInfo->{utcTimeOffsetInfo}; + my %utcTimeOffset = map { $_->{utcTimeOffsetCode} => $_->{utcTimeOffset} } @$utcTimeOffsetInfo; + + { recEntity => \%recEntity, + utcTimeOffset => \%utcTimeOffset, + tapDecimalPlaces => $TransferBatch->{accountingInfo}{tapDecimalPlaces}, + }; + }, + 'arrayref' => sub { shift->{'callEventDetails'}; }, + 'map' => { + 'startdate' => sub { my($row, $buffer) = @_; + my $callinfo = $row->{mobileOriginatedCall}{basicCallInformation}; + my $timestamp = $callinfo->{callEventStartTimeStamp}; + + my $localTimeStamp = $timestamp->{localTimeStamp}; + $localTimeStamp =~ /^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/ + or die "unparsable timestamp: $localTimeStamp\n"; #. Dumper($callinfo); + my($year, $mon, $day, $hour, $min, $sec) = ($1, $2, $3, $4, $5, $6); + + my $utcTimeOffsetCode = $timestamp->{utcTimeOffsetCode}; + my $utcTimeOffset = $buffer->{utcTimeOffset}{ $utcTimeOffsetCode }; + local($ENV{TZ}) = $TZ{ $utcTimeOffset }; + + timelocal($sec, $min, $hour, $day, $mon-1, $year); + }, + 'duration' => sub { shift->{mobileOriginatedCall}{basicCallInformation}{totalCallEventDuration} }, + 'billsec' => sub { shift->{mobileOriginatedCall}{basicCallInformation}{totalCallEventDuration} }, #same.. + 'src' => sub { shift->{mobileOriginatedCall}{basicCallInformation}{chargeableSubscriber}{simChargeableSubscriber}{msisdn} }, + 'charged_party_imsi' => sub { shift->{mobileOriginatedCall}{basicCallInformation}{chargeableSubscriber}{simChargeableSubscriber}{imsi} }, + 'dst' => sub { shift->{mobileOriginatedCall}{basicCallInformation}{destination}{calledNumber} }, #dialledDigits? + 'carrierid' => sub { my( $row, $buffer ) = @_; + my $recEntityCode = $row->{mobileOriginatedCall}{locationInformation}{networkLocation}{recEntityCode}; + $buffer->{recEntity}{ $recEntityCode }; + }, + 'userfield' => sub { shift->{mobileOriginatedCall}{operatorSpecInformation}[0] }, + 'servicecode' => sub { shift->{mobileOriginatedCall}{basicServiceUsedList}[0]{basicService}{serviceCode}{teleServiceCode} }, + 'upstream_price' => sub { my($row, $buffer) = @_; + sprintf('%.'.$buffer->{tapDecimalPlaces}.'f', + $row->{mobileOriginatedCall}{basicServiceUsedList}[0]{chargeInformationList}[0]{chargeDetailList}[0]{charge} + / ( 10 ** $buffer->{tapDecimalPlaces} ) + ) + }, + 'calltypenum' => sub { shift->{mobileOriginatedCall}{basicServiceUsedList}[0]{chargeInformationList}[0]{callTypeGroup}{callTypelevel1} }, + 'quantity' => sub { shift->{mobileOriginatedCall}{basicServiceUsedList}[0]{chargeInformationList}[0]{chargedUnits} }, + 'quantity_able' => sub { shift->{mobileOriginatedCall}{basicServiceUsedList}[0]{chargeInformationList}[0]{chargeableUnits} }, + }, + }, +); + +#accepts qsearch parameters as a hash or list of name/value pairs, but not +#old-style qsearch('cdr', { field=>'value' }) + +use Date::Format; +use FS::Conf; +sub tap3_12_export { + my %qsearch = (); + if ( ref($_[0]) eq 'HASH' ) { + %qsearch = %{ $_[0] }; + } else { + %qsearch = @_; + } + + #if these get huge we might need to get a count and do a paged search + my @cdrs = qsearch({ 'table'=>'cdr', %qsearch, 'order_by'=>'calldate ASC' }); + + my $conf = new FS::Conf; + + eval "use Convert::ASN1"; + die $@ if $@; + + my $asn = Convert::ASN1->new; + $asn->prepare( _asn_spec() ) or die $asn->error; + + my $TransferBatch = $asn->find('TransferBatch') or die $asn->error; + + my %hash = _TransferBatch(); #static information etc. + + my $now = time; + my $utcTimeOffset = time2str('%z', $now); + + ### + # accountingInfo + ### + + #mandatory + $hash{localCurrency} = $conf->config('currency') || 'USD'; + + ### + # batchControlInfo + ### + + #optional + $hash{batchControlInfo}->{fileCreationTimeStamp} = { 'localTimeStamp' => time2str('%Y%m%d%H%M%S', $now), + 'utcTimeOffset' => $utcTimeOffset, + }; + + #The timestamp used to select calls for transfer. All call records available prior to the timestamp are transferred. + # This gives an indication to the HPMN as to how ‘up-to-date’ the information is. + $hash{batchControlInfo}->{transferCutOffTimeStamp} = { 'localTimeStamp' => time2str('%Y%m%d%H%M%S', $cdrs[-1]->calldate_unix ), + 'utcTimeOffset' => $utcTimeOffset, + }; + + #The date and time at which the file was made available to the Recipient PMN. + # Physically this will normally be the timestamp when the file transfer + # commenced to the Recipient PMN, i.e. start of push, however on some systems + # this will be the timestamp when the file was made available to be pulled. + $hash{batchControlInfo}->{fileAvailableTimeStamp} = { 'localTimeStamp' => time2str('%Y%m%d%H%M%S', $now), + 'utcTimeOffset' => $utcTimeOffset, + }; + + # A unique identifier used to determine the network which is the Sender of the data. + # The full list of codes in use is given in TADIG PRD TD.13: PMN Naming Conventions. + $hash{batchControlInfo}->{sender} = $conf->config('cdr-gsm_tap3-sender') || 'ZZZZZ'; #reserved: Y*, ZO-ZZ + + #XXX customer or agent field of some sort + # A unique identifier used to determine which network the data is being sent to, + # i.e. the Recipient. + # Derivation: GSM Association PRD TD.13: PMN Naming Conventions. + $hash{batchControlInfo}->{recipient} = 'GNQHT'; + + #XXX + #A unique reference which identifies each TAP Data Interchange sent by one PMN to another, specific, PMN. + # The sequence commences at 1 and is incremented by one for each subsequent TAP Data Interchange sent by the Sender PMN to a particular Recipient PMN. + # Separate sequence numbering must be used for Test Data and Chargeable Data. Having reached the maximum value (99999) the number must recycle to 1. + $hash{batchControlInfo}->{fileSequenceNumber} = '00178'; + + ### + # networkInfo + ### + + $hash{networkInfo}->{utcTimeOffsetInfo}[0]{utcTimeOffset} = $utcTimeOffset; + + #XXX recording entity IDs, referenced by recEntityCode + #$hash->{networkInfo}->{recEntityInfo}[0]{recEntityId} = '340010100'; + #$hash->{networkInfo}->{recEntityInfo}[1]{recEntityId} = '240556000000'; + + ### + # auditControlInfo + ### + + #mandatory + $hash{auditControlInfo}->{callEventDetailsCount} = scalar(@cdrs); + + #these two are optional + $hash{auditControlInfo}->{earliestCallTimeStamp} = { 'localTimeStamp' => time2str('%Y%m%d%H%M%S', $cdrs[0]->calldate_unix), + 'utcTimeOffset' => $utcTimeOffset, + }; + $hash{auditControlInfo}->{latestCallTimeStamp} = { 'localTimeStamp' => time2str('%Y%m%d%H%M%S', $cdrs[-1]->calldate_unix), + 'utcTimeOffset' => $utcTimeOffset, + }; + + #mandatory + my $totalCharge = 0; + $totalCharge += $_->rated_price foreach @cdrs; + $hash{totalCharge} = sprintf('%.5f', $totalCharge); + + ### + # callEventDetails + ### + + $hash{callEventDetails} = [ map tap3_12_export_cdr($_), @cdrs ]; + + ### + + $TransferBatch->encode( \%hash ); + +} + +sub _TransferBatch { + + #accounting related information + 'accountingInfo' => { + #mandatory + #'localCurrency' => 'USD', + 'tapDecimalPlaces' => 5, + 'currencyConversionInfo' => [ + { + 'numberOfDecimalPlaces' => 5, + 'exchangeRate' => 152549, #XXX ??? "exchange rate +VAT" ? + 'exchangeRateCode' => 1 + } + ], + #optional: may conditionally include taxation and discounting tables, and, optionally, TAP currency + }, + + 'batchControlInfo' => { + #mandatory + 'specificationVersionNumber' => 3, + 'releaseVersionNumber' => 12, + + #'sender' => 'MDGTM', + #'recipient' => 'GNQHT', + #'fileSequenceNumber' => '00178', + + #'transferCutOffTimeStamp' => { + # 'localTimeStamp' => '20121230050222', + # 'utcTimeOffset' => '+0300' + # }, + #'fileAvailableTimeStamp' => { + # 'localTimeStamp' => '20121230035052', + # 'utcTimeOffset' => '+0100' + # } + + #optional + #'fileCreationTimeStamp' => { + # 'localTimeStamp' => '20121230050222', + # 'utcTimeOffset' => '+0300' + # }, + + #optional: file type indicator which will only be present where the file represents test data + #optional: RAP File Sequence Number (used where the batch has previously been returned with a fatal error and is now being resubmitted) (not fileSequenceNumber?) + + #optional: beyond the scope of TAP and has been bilaterally agreed + #'operatorSpecInformation' => [ + # '', # '|File proc MTH LUXMA: 1285348027|' Operator Specific Information + # # probably just leave out + # ], + + + }, + + #Network Information is a group of related information which pertains to the Sender PMN + 'networkInfo' => { + #must be present where Recording Entity Codes are present within the TAP file + 'recEntityInfo' => [ + { + 'recEntityCode' => 1, + 'recEntityType' => 1, #MSC + #'recEntityId' => '340010100', + }, + { + 'recEntityCode' => 2, + 'recEntityType' => 2, #SMSC + #'recEntityId' => '240556000000', + }, + ], + #mandatory + 'utcTimeOffsetInfo' => [ + { + 'utcTimeOffsetCode' => 1, + #'utcTimeOffset' => '+0300', + } + ] + }, + + #identifies the end of the Transfer Batch + 'auditControlInfo' => { + #mandatory + #'callEventDetailsCount' => 4, + 'totalTaxValue' => 0, + 'totalDiscountValue' => 0, + #'totalCharge' => 50474, + + #these two are optional + #'earliestCallTimeStamp' => { + # 'localTimeStamp' => '20121229102501', + # 'utcTimeOffset' => '+0300' + # }, + #'latestCallTimeStamp' => { + # 'localTimeStamp' => '20121229102807', + # 'utcTimeOffset' => '+0300' + # } + #optional: beyond the scope of TAP and has been bilaterally agreed + #'operatorSpecInformation' => [ + # '', + # ], + }, +} + +sub tap3_12_export_cdr { + my $self = shift; + + #one of Mobile Originated Call, Mobile Terminated Call, Mobile Session, Messaging Event, Supplementary Service Event, Service Centre Usage, GPRS Call, Content Transaction or Location Service + # Each occurrence must have no more than one of these present + + { #either tele or bearer service usage originated by the mobile subscription (others?) + 'mobileOriginatedCall' => { + + #identifies the Network Location, which includes the MSC responsible for handling + # the call and, where appropriate, the Geographical Location of the mobile + 'locationInformation' => { + 'networkLocation' => { + 'recEntityCode' => $self->carrierid, #XXX Recording Entity (per 2.5, from "Reference Tables") + } + }, + + #Operator Specific Information: beyond the scope of TAP and has been bilaterally agreed + 'operatorSpecInformation' => [ + $self->userfield, ##'|Seq: 178 Loc: 1|' + ], + + #The type of service used together with all related charging information + 'basicServiceUsedList' => [ + { + #identifies the actual Basic Service used + 'basicService' => { + #one of Teleservice Code or Bearer Service Code as determined by the service type used + 'serviceCode' => { + #XXX + #00 All teleservices + #10 All Speech transmission services + #11 Telephony + #12 Emergency calls + #20 All SMS Services + #21 Short Message MT/PP + #22 Short Message MO/PP + #60 All Fax Services + #61 Facsimile Group 3 & alternative speech + #62 Automatic Facsimile Group 3 + #63 Automatic Facsimile Group 4 + #70 All data teleservices (compound) + #80 All teleservices except SMS (compound) + #90 All voice group call services + #91 Voice group call + #92 Voice broadcast call + 'teleServiceCode' => $self->servicecode, #'11' + + #Bearer Service Code + # Must be present within group Service Code where the type of service used + # was a bearer service. Must not be present when the type of service used + # was a tele service and, therefore, Teleservice Code is present. + # Group Bearer Codes, identifiable by the description ‘All’, should only + # be used where details of the specific services affected are not + # available from the network. + #00 All Bearer Services + #20 All Data Circuit Asynchronous Services + #21 Duplex Asynch. 300bps data circuit + #22 Duplex Asynch. 1200bps data circuit + #23 Duplex Asynch. 1200/75bps data circuit + #24 Duplex Asynch. 2400bps data circuit + #25 Duplex Asynch. 4800bps data circuit + #26 Duplex Asynch. 9600bps data circuit + #27 General Data Circuit Asynchronous Service + #30 All Data Circuit Synchronous Services + #32 Duplex Synch. 1200bps data circuit + #34 Duplex Synch. 2400bps data circuit + #35 Duplex Synch. 4800bps data circuit + #36 Duplex Synch. 9600bps data circuit + #37 General Data Circuit Synchronous Service + #40 All Dedicated PAD Access Services + #41 Duplex Asynch. 300bps PAD access + #42 Duplex Asynch. 1200bps PAD access + #43 Duplex Asynch. 1200/75bps PAD access + #44 Duplex Asynch. 2400bps PAD access + #45 Duplex Asynch. 4800bps PAD access + #46 Duplex Asynch. 9600bps PAD access + #47 General PAD Access Service + #50 All Dedicated Packet Access Services + #54 Duplex Synch. 2400bps PAD access + #55 Duplex Synch. 4800bps PAD access + #56 Duplex Synch. 9600bps PAD access + #57 General Packet Access Service + #60 All Alternat Speech/Asynchronous Services + #70 All Alternate Speech/Synchronous Services + #80 All Speech followed by Data Asynchronous Services + #90 All Speech followed by Data Synchronous Services + #A0 All Data Circuit Asynchronous Services (compound) + #B0 All Data Circuit Synchronous Services (compound) + #C0 All Asynchronous Services (compound) + } + #conditionally also contain the following for UMTS: Transparency Indicator, Fixed Network User + # Rate, User Protocol Indicator, Guaranteed Bit Rate and Maximum Bit Rate + }, + + #Charge information is provided for all chargeable elements except within Messaging Event and Mobile Session call events + # must contain Charged Item and at least one occurrence of Charge Detail + 'chargeInformationList' => [ + { + #XXX + #mandatory + # the charging principle applied and the unitisation of Chargeable Units. It + # is not intended to identify the service used. + #A: Call set up attempt + #C: Content + #D: Duration based charge + #E: Event based charge + #F: Fixed (one-off) charge + #L: Calendar (for example daily usage charge) + #V: Volume (outgoing) based charge + #W: Volume (incoming) based charge + #X: Volume (total volume) based charge + #(?? fields to be used as a basis for the calculation of the correct Charge + # A: Chargeable Units (if present) + # D,V,W,X: Chargeable Units + # C: Depends on the content + # E: Not Applicable + # F: Not Applicable + # L: Call Event Start Timestamp) + 'chargedItem' => 'D', + + # the IOT used by the VPMN to price the call + 'callTypeGroup' => { + + #The highest category call type in respect of the destination of the call + #0: Unknown/Not Applicable + #1: National + #2: International + #10: HGGSN/HP-GW + #11: VGGSN/VP-GW + #12: Other GGSN/Other P-GW + #100: WLAN + 'callTypeLevel1' => $self->calltypenum, + + #the sub category of Call Type Level 1 + #0: Unknown/Not Applicable + #1: Mobile + #2: PSTN + #3: Non Geographic + #4: Premium Rate + #5: Satellite destination + #6: Forwarded call + #7: Non forwarded call + #10: Broadband + #11: Narrowband + #12: Conversational + #13: Streaming + #14: Interactive + #15: Background + 'callTypeLevel2' => 0, + + #the sub category of Call Type Level 2 + 'callTypeLevel3' => 0, + }, + + #mandatory, at least one occurence must be present + #A repeating group detailing the Charge and/or charge element + # Note that, where a Charge has been levied, even where that Charge is zero, + # there must be one occurance, and only one, with a Charge Type of '00' + 'chargeDetailList' => [ + { + #mandatory + # after discounts have been deducted but before any tax is added + 'charge' => $self->rated_price * 100000, #XXX numberOfDecimalPlaces + + #mandatory + # the type of charge represented + #00: Total charge for Charge Information (the invoiceable value) + #01: Airtime charge + #02: reserved + #03: Toll charge + #04: Directory assistance + #05–20: reserved + #21: VPMN surcharge + #50: Total charge for Charge Information according to the published IOT + # Note that the use of value 50 is only for use by bilateral agreement, use without + # bilateral agreement can be treated as per reserved values, that is ‘out of range’ + #69–99: reserved + 'chargeType' => '00', + + #conditional + # the number of units which are chargeable within the Charge Detail, this may not + # correspond to the number of rounded units charged. + # The item Charged Item defines what the units represent. + 'chargeableUnits' => $self->quantity_able, + + #optional + # the rounded number of units which are actually charged for + 'chargedUnits' => $self->quantity, + } + ], + 'exchangeRateCode' => 1, #from header + } + ] + } + ], + + #MO Basic Call Information provides the basic detail of who made the call and where to in respect of mobile originated traffic. + 'basicCallInformation' => { + #mandatory + # the identification of the chargeable subscriber. + # The group must contain either the IMSI or the MIN of the Chargeable Subscriber, but not both. + 'chargeableSubscriber' => { + 'simChargeableSubscriber' => { + 'msisdn' => $self->charged_party, #src + 'imsi' => $self->charged_party_imsi, + } + }, + # the start of the call event + 'callEventStartTimeStamp' => { + 'localTimeStamp' => time2str('%Y%m%d%H%M%S', $self->startdate), + 'utcTimeOffsetCode' => 1 + }, + + # the actual total duration of a call event as a number of seconds + 'totalCallEventDuration' => $self->duration, + + #conditional + # the number dialled by the subscriber (Called Number) + # or the SMSC Address in case of SMS usage or in cases involving supplementary services + # such as call forwarding or transfer etc., the number to which the call is routed + 'destination' => { + #the international representation of the destination + 'calledNumber' => $self->dst, + + #the actual digits as dialled by the subscriber, i.e. unmodified, in establishing a call + # This will contain ‘+’ and ‘#’ where appropriate. + #'dialledDigits' => '322221350' + }, + } + } + }; + +} + +sub _asn_spec { + <<'END'; +-- +-- +-- The following ASN.1 specification defines the abstract syntax for +-- +-- Data Record Format Version 03 +-- Release 12 +-- +-- The specification is structured as follows: +-- (1) structure of the Tap batch +-- (2) definition of the individual Tap ‘records’ +-- (3) Tap data items and groups of data items used within (2) +-- (4) Common, non-Tap data types +-- (5) Tap data items for content charging +-- +-- It is mainly a translation from the logical structure +-- diagrams. Where appropriate, names used within the +-- logical structure diagrams have been shortened. +-- For repeating data items the name as used within the logical +-- structure have been extended by adding ‘list’ or ‘table’ +-- (in some instances). +-- + + +-- TAP-0312 DEFINITIONS IMPLICIT TAGS ::= + +-- BEGIN + +-- +-- Structure of a Tap batch +-- + +DataInterChange ::= CHOICE +{ + transferBatch TransferBatch, + notification Notification, +... +} + +-- Batch Control Information must always, both logically and physically, +-- be the first group/item within Transfer Batch – this ensures that the +-- TAP release version can be readily identified. Any new groups/items +-- required may be inserted at any point after Batch Control Information + +TransferBatch ::= [APPLICATION 1] SEQUENCE +{ + batchControlInfo BatchControlInfo OPTIONAL, -- *m.m. + accountingInfo AccountingInfo OPTIONAL, + networkInfo NetworkInfo OPTIONAL, -- *m.m. + messageDescriptionInfo MessageDescriptionInfoList OPTIONAL, + callEventDetails CallEventDetailList OPTIONAL, -- *m.m. + auditControlInfo AuditControlInfo OPTIONAL, -- *m.m. +... +} + +Notification ::= [APPLICATION 2] SEQUENCE +{ + sender Sender OPTIONAL, -- *m.m. + recipient Recipient OPTIONAL, -- *m.m. + fileSequenceNumber FileSequenceNumber OPTIONAL, -- *m.m. + rapFileSequenceNumber RapFileSequenceNumber OPTIONAL, + fileCreationTimeStamp FileCreationTimeStamp OPTIONAL, + fileAvailableTimeStamp FileAvailableTimeStamp OPTIONAL, -- *m.m. + transferCutOffTimeStamp TransferCutOffTimeStamp OPTIONAL, -- *m.m. + specificationVersionNumber SpecificationVersionNumber OPTIONAL, -- *m.m. + releaseVersionNumber ReleaseVersionNumber OPTIONAL, -- *m.m. + fileTypeIndicator FileTypeIndicator OPTIONAL, + operatorSpecInformation OperatorSpecInfoList OPTIONAL, +... +} + +CallEventDetailList ::= [APPLICATION 3] SEQUENCE OF CallEventDetail + +CallEventDetail ::= CHOICE +{ + mobileOriginatedCall MobileOriginatedCall, + mobileTerminatedCall MobileTerminatedCall, + supplServiceEvent SupplServiceEvent, + serviceCentreUsage ServiceCentreUsage, + gprsCall GprsCall, + contentTransaction ContentTransaction, + locationService LocationService, + messagingEvent MessagingEvent, + mobileSession MobileSession, +... +} + +-- +-- Structure of the individual Tap records +-- + +BatchControlInfo ::= [APPLICATION 4] SEQUENCE +{ + sender Sender OPTIONAL, -- *m.m. + recipient Recipient OPTIONAL, -- *m.m. + fileSequenceNumber FileSequenceNumber OPTIONAL, -- *m.m. + fileCreationTimeStamp FileCreationTimeStamp OPTIONAL, + transferCutOffTimeStamp TransferCutOffTimeStamp OPTIONAL, -- *m.m. + fileAvailableTimeStamp FileAvailableTimeStamp OPTIONAL, -- *m.m. + specificationVersionNumber SpecificationVersionNumber OPTIONAL, -- *m.m. + releaseVersionNumber ReleaseVersionNumber OPTIONAL, -- *m.m. + fileTypeIndicator FileTypeIndicator OPTIONAL, + rapFileSequenceNumber RapFileSequenceNumber OPTIONAL, + operatorSpecInformation OperatorSpecInfoList OPTIONAL, +... +} + +AccountingInfo ::= [APPLICATION 5] SEQUENCE +{ + taxation TaxationList OPTIONAL, + discounting DiscountingList OPTIONAL, + localCurrency LocalCurrency OPTIONAL, -- *m.m. + tapCurrency TapCurrency OPTIONAL, + currencyConversionInfo CurrencyConversionList OPTIONAL, + tapDecimalPlaces TapDecimalPlaces OPTIONAL, -- *m.m. +... +} + +NetworkInfo ::= [APPLICATION 6] SEQUENCE +{ + utcTimeOffsetInfo UtcTimeOffsetInfoList OPTIONAL, -- *m.m. + recEntityInfo RecEntityInfoList OPTIONAL, +... +} + +MessageDescriptionInfoList ::= [APPLICATION 8] SEQUENCE OF MessageDescriptionInformation + +MobileOriginatedCall ::= [APPLICATION 9] SEQUENCE +{ + basicCallInformation MoBasicCallInformation OPTIONAL, -- *m.m. + locationInformation LocationInformation OPTIONAL, -- *m.m. + equipmentIdentifier ImeiOrEsn OPTIONAL, + basicServiceUsedList BasicServiceUsedList OPTIONAL, -- *m.m. + supplServiceCode SupplServiceCode OPTIONAL, + thirdPartyInformation ThirdPartyInformation OPTIONAL, + camelServiceUsed CamelServiceUsed OPTIONAL, + operatorSpecInformation OperatorSpecInfoList OPTIONAL, +... +} + +MobileTerminatedCall ::= [APPLICATION 10] SEQUENCE +{ + basicCallInformation MtBasicCallInformation OPTIONAL, -- *m.m. + locationInformation LocationInformation OPTIONAL, -- *m.m. + equipmentIdentifier ImeiOrEsn OPTIONAL, + basicServiceUsedList BasicServiceUsedList OPTIONAL, -- *m.m. + camelServiceUsed CamelServiceUsed OPTIONAL, + operatorSpecInformation OperatorSpecInfoList OPTIONAL, +... +} + + +SupplServiceEvent ::= [APPLICATION 11] SEQUENCE +{ + chargeableSubscriber ChargeableSubscriber OPTIONAL, -- *m.m. + rapFileSequenceNumber RapFileSequenceNumber OPTIONAL, + locationInformation LocationInformation OPTIONAL, -- *m.m. + equipmentIdentifier ImeiOrEsn OPTIONAL, + supplServiceUsed SupplServiceUsed OPTIONAL, -- *m.m. + operatorSpecInformation OperatorSpecInfoList OPTIONAL, +... +} + + +ServiceCentreUsage ::= [APPLICATION 12] SEQUENCE +{ + basicInformation ScuBasicInformation OPTIONAL, -- *m.m. + rapFileSequenceNumber RapFileSequenceNumber OPTIONAL, + servingNetwork ServingNetwork OPTIONAL, + recEntityCode RecEntityCode OPTIONAL, -- *m.m. + chargeInformation ChargeInformation OPTIONAL, -- *m.m. + scuChargeType ScuChargeType OPTIONAL, -- *m.m. + scuTimeStamps ScuTimeStamps OPTIONAL, -- *m.m. + operatorSpecInformation OperatorSpecInfoList OPTIONAL, +... +} + +GprsCall ::= [APPLICATION 14] SEQUENCE +{ + gprsBasicCallInformation GprsBasicCallInformation OPTIONAL, -- *m.m. + gprsLocationInformation GprsLocationInformation OPTIONAL, -- *m.m. + equipmentIdentifier ImeiOrEsn OPTIONAL, + gprsServiceUsed GprsServiceUsed OPTIONAL, -- *m.m. + camelServiceUsed CamelServiceUsed OPTIONAL, + operatorSpecInformation OperatorSpecInfoList OPTIONAL, +... +} + +ContentTransaction ::= [APPLICATION 17] SEQUENCE +{ + contentTransactionBasicInfo ContentTransactionBasicInfo OPTIONAL, -- *m.m. + chargedPartyInformation ChargedPartyInformation OPTIONAL, -- *m.m. + servingPartiesInformation ServingPartiesInformation OPTIONAL, -- *m.m. + contentServiceUsed ContentServiceUsedList OPTIONAL, -- *m.m. + operatorSpecInformation OperatorSpecInfoList OPTIONAL, +... +} + +LocationService ::= [APPLICATION 297] SEQUENCE +{ + rapFileSequenceNumber RapFileSequenceNumber OPTIONAL, + recEntityCode RecEntityCode OPTIONAL, -- *m.m. + callReference CallReference OPTIONAL, + trackingCustomerInformation TrackingCustomerInformation OPTIONAL, + lCSSPInformation LCSSPInformation OPTIONAL, + trackedCustomerInformation TrackedCustomerInformation OPTIONAL, + locationServiceUsage LocationServiceUsage OPTIONAL, -- *m.m. + operatorSpecInformation OperatorSpecInfoList OPTIONAL, +... +} + +MessagingEvent ::= [APPLICATION 433] SEQUENCE +{ + messagingEventService MessagingEventService OPTIONAL, -- *m.m. + chargedParty ChargedParty OPTIONAL, -- *m.m. + rapFileSequenceNumber RapFileSequenceNumber OPTIONAL, + simToolkitIndicator SimToolkitIndicator OPTIONAL, + geographicalLocation GeographicalLocation OPTIONAL, + eventReference EventReference OPTIONAL, -- *m.m. + + recEntityCodeList RecEntityCodeList OPTIONAL, -- *m.m. + networkElementList NetworkElementList OPTIONAL, + locationArea LocationArea OPTIONAL, + cellId CellId OPTIONAL, + serviceStartTimestamp ServiceStartTimestamp OPTIONAL, -- *m.m. + nonChargedParty NonChargedParty OPTIONAL, + exchangeRateCode ExchangeRateCode OPTIONAL, + callTypeGroup CallTypeGroup OPTIONAL, -- *m.m. + charge Charge OPTIONAL, -- *m.m. + taxInformationList TaxInformationList OPTIONAL, + operatorSpecInformation OperatorSpecInfoList OPTIONAL, +... +} + +MobileSession ::= [APPLICATION 434] SEQUENCE +{ + mobileSessionService MobileSessionService OPTIONAL, -- *m.m. + chargedParty ChargedParty OPTIONAL, -- *m.m. + rapFileSequenceNumber RapFileSequenceNumber OPTIONAL, + simToolkitIndicator SimToolkitIndicator OPTIONAL, + geographicalLocation GeographicalLocation OPTIONAL, + locationArea LocationArea OPTIONAL, + cellId CellId OPTIONAL, + eventReference EventReference OPTIONAL, -- *m.m. + + recEntityCodeList RecEntityCodeList OPTIONAL, -- *m.m. + serviceStartTimestamp ServiceStartTimestamp OPTIONAL, -- *m.m. + causeForTerm CauseForTerm OPTIONAL, + totalCallEventDuration TotalCallEventDuration OPTIONAL, -- *m.m. + nonChargedParty NonChargedParty OPTIONAL, + sessionChargeInfoList SessionChargeInfoList OPTIONAL, -- *m.m. + operatorSpecInformation OperatorSpecInfoList OPTIONAL, +... +} + +AuditControlInfo ::= [APPLICATION 15] SEQUENCE +{ + earliestCallTimeStamp EarliestCallTimeStamp OPTIONAL, + latestCallTimeStamp LatestCallTimeStamp OPTIONAL, + totalCharge TotalCharge OPTIONAL, -- *m.m. + totalChargeRefund TotalChargeRefund OPTIONAL, + totalTaxRefund TotalTaxRefund OPTIONAL, + totalTaxValue TotalTaxValue OPTIONAL, -- *m.m. + totalDiscountValue TotalDiscountValue OPTIONAL, -- *m.m. + totalDiscountRefund TotalDiscountRefund OPTIONAL, + totalAdvisedChargeValueList TotalAdvisedChargeValueList OPTIONAL, + callEventDetailsCount CallEventDetailsCount OPTIONAL, -- *m.m. + operatorSpecInformation OperatorSpecInfoList OPTIONAL, +... +} + + +-- +-- Tap data items and groups of data items +-- + +AccessPointNameNI ::= [APPLICATION 261] AsciiString --(SIZE(1..63)) + +AccessPointNameOI ::= [APPLICATION 262] AsciiString --(SIZE(1..37)) + +ActualDeliveryTimeStamp ::= [APPLICATION 302] DateTime + +AddressStringDigits ::= BCDString + +AdvisedCharge ::= [APPLICATION 349] Charge + +AdvisedChargeCurrency ::= [APPLICATION 348] Currency + +AdvisedChargeInformation ::= [APPLICATION 351] SEQUENCE +{ + paidIndicator PaidIndicator OPTIONAL, + paymentMethod PaymentMethod OPTIONAL, + advisedChargeCurrency AdvisedChargeCurrency OPTIONAL, + advisedCharge AdvisedCharge OPTIONAL, -- *m.m. + commission Commission OPTIONAL, +... +} + +AgeOfLocation ::= [APPLICATION 396] INTEGER + +BasicService ::= [APPLICATION 36] SEQUENCE +{ + serviceCode BasicServiceCode OPTIONAL, -- *m.m. + transparencyIndicator TransparencyIndicator OPTIONAL, + fnur Fnur OPTIONAL, + userProtocolIndicator UserProtocolIndicator OPTIONAL, + guaranteedBitRate GuaranteedBitRate OPTIONAL, + maximumBitRate MaximumBitRate OPTIONAL, +... +} + +BasicServiceCode ::= [APPLICATION 426] CHOICE +{ + teleServiceCode TeleServiceCode, + bearerServiceCode BearerServiceCode, +... +} + +BasicServiceCodeList ::= [APPLICATION 37] SEQUENCE OF BasicServiceCode + +BasicServiceUsed ::= [APPLICATION 39] SEQUENCE +{ + basicService BasicService OPTIONAL, -- *m.m. + chargingTimeStamp ChargingTimeStamp OPTIONAL, + chargeInformationList ChargeInformationList OPTIONAL, -- *m.m. + hSCSDIndicator HSCSDIndicator OPTIONAL, +... +} + +BasicServiceUsedList ::= [APPLICATION 38] SEQUENCE OF BasicServiceUsed + +BearerServiceCode ::= [APPLICATION 40] HexString --(SIZE(2)) + +EventReference ::= [APPLICATION 435] AsciiString + + +CalledNumber ::= [APPLICATION 407] AddressStringDigits + +CalledPlace ::= [APPLICATION 42] AsciiString + +CalledRegion ::= [APPLICATION 46] AsciiString + +CallEventDetailsCount ::= [APPLICATION 43] INTEGER + +CallEventStartTimeStamp ::= [APPLICATION 44] DateTime + +CallingNumber ::= [APPLICATION 405] AddressStringDigits + +CallOriginator ::= [APPLICATION 41] SEQUENCE +{ + callingNumber CallingNumber OPTIONAL, + clirIndicator ClirIndicator OPTIONAL, + sMSOriginator SMSOriginator OPTIONAL, +... +} + +CallReference ::= [APPLICATION 45] OCTET STRING --(SIZE(1..8)) + +CallTypeGroup ::= [APPLICATION 258] SEQUENCE +{ + callTypeLevel1 CallTypeLevel1 OPTIONAL, -- *m.m. + callTypeLevel2 CallTypeLevel2 OPTIONAL, -- *m.m. + callTypeLevel3 CallTypeLevel3 OPTIONAL, -- *m.m. +... +} + +CallTypeLevel1 ::= [APPLICATION 259] INTEGER + +CallTypeLevel2 ::= [APPLICATION 255] INTEGER + +CallTypeLevel3 ::= [APPLICATION 256] INTEGER + +CamelDestinationNumber ::= [APPLICATION 404] AddressStringDigits + +CamelInvocationFee ::= [APPLICATION 422] AbsoluteAmount + +CamelServiceKey ::= [APPLICATION 55] INTEGER + +CamelServiceLevel ::= [APPLICATION 56] INTEGER + +CamelServiceUsed ::= [APPLICATION 57] SEQUENCE +{ + camelServiceLevel CamelServiceLevel OPTIONAL, + camelServiceKey CamelServiceKey OPTIONAL, -- *m.m. + defaultCallHandling DefaultCallHandlingIndicator OPTIONAL, + exchangeRateCode ExchangeRateCode OPTIONAL, + taxInformation TaxInformationList OPTIONAL, + discountInformation DiscountInformation OPTIONAL, + camelInvocationFee CamelInvocationFee OPTIONAL, + threeGcamelDestination ThreeGcamelDestination OPTIONAL, + cseInformation CseInformation OPTIONAL, +... +} + +CauseForTerm ::= [APPLICATION 58] INTEGER + +CellId ::= [APPLICATION 59] INTEGER + +Charge ::= [APPLICATION 62] AbsoluteAmount + +ChargeableSubscriber ::= [APPLICATION 427] CHOICE +{ + simChargeableSubscriber SimChargeableSubscriber, + minChargeableSubscriber MinChargeableSubscriber, +... +} + +ChargeableUnits ::= [APPLICATION 65] INTEGER + +ChargeDetail ::= [APPLICATION 63] SEQUENCE +{ + chargeType ChargeType OPTIONAL, -- *m.m. + charge Charge OPTIONAL, -- *m.m. + chargeableUnits ChargeableUnits OPTIONAL, + chargedUnits ChargedUnits OPTIONAL, + chargeDetailTimeStamp ChargeDetailTimeStamp OPTIONAL, +... +} + +ChargeDetailList ::= [APPLICATION 64] SEQUENCE OF ChargeDetail + +ChargeDetailTimeStamp ::= [APPLICATION 410] ChargingTimeStamp + +ChargedItem ::= [APPLICATION 66] AsciiString --(SIZE(1)) + +ChargedParty ::= [APPLICATION 436] SEQUENCE +{ + imsi Imsi OPTIONAL, -- *m.m. + msisdn Msisdn OPTIONAL, + publicUserId PublicUserId OPTIONAL, + homeBid HomeBid OPTIONAL, + homeLocationDescription HomeLocationDescription OPTIONAL, + imei Imei OPTIONAL, +... +} + +ChargedPartyEquipment ::= [APPLICATION 323] SEQUENCE +{ + equipmentIdType EquipmentIdType OPTIONAL, -- *m.m. + equipmentId EquipmentId OPTIONAL, -- *m.m. +... +} + +ChargedPartyHomeIdentification ::= [APPLICATION 313] SEQUENCE +{ + homeIdType HomeIdType OPTIONAL, -- *m.m. + homeIdentifier HomeIdentifier OPTIONAL, -- *m.m. +... +} + +ChargedPartyHomeIdList ::= [APPLICATION 314] SEQUENCE OF + ChargedPartyHomeIdentification + +ChargedPartyIdentification ::= [APPLICATION 309] SEQUENCE +{ + chargedPartyIdType ChargedPartyIdType OPTIONAL, -- *m.m. + chargedPartyIdentifier ChargedPartyIdentifier OPTIONAL, -- *m.m. +... +} + +ChargedPartyIdentifier ::= [APPLICATION 287] AsciiString + +ChargedPartyIdList ::= [APPLICATION 310] SEQUENCE OF ChargedPartyIdentification + +ChargedPartyIdType ::= [APPLICATION 305] INTEGER + +ChargedPartyInformation ::= [APPLICATION 324] SEQUENCE +{ + chargedPartyIdList ChargedPartyIdList OPTIONAL, -- *m.m. + chargedPartyHomeIdList ChargedPartyHomeIdList OPTIONAL, + chargedPartyLocationList ChargedPartyLocationList OPTIONAL, + chargedPartyEquipment ChargedPartyEquipment OPTIONAL, +... +} + +ChargedPartyLocation ::= [APPLICATION 320] SEQUENCE +{ + locationIdType LocationIdType OPTIONAL, -- *m.m. + locationIdentifier LocationIdentifier OPTIONAL, -- *m.m. +... +} + +ChargedPartyLocationList ::= [APPLICATION 321] SEQUENCE OF ChargedPartyLocation + +ChargedPartyStatus ::= [APPLICATION 67] INTEGER + +ChargedUnits ::= [APPLICATION 68] INTEGER + +ChargeInformation ::= [APPLICATION 69] SEQUENCE +{ + chargedItem ChargedItem OPTIONAL, -- *m.m. + exchangeRateCode ExchangeRateCode OPTIONAL, + callTypeGroup CallTypeGroup OPTIONAL, + chargeDetailList ChargeDetailList OPTIONAL, -- *m.m. + taxInformation TaxInformationList OPTIONAL, + discountInformation DiscountInformation OPTIONAL, +... +} + +ChargeInformationList ::= [APPLICATION 70] SEQUENCE OF ChargeInformation + +ChargeRefundIndicator ::= [APPLICATION 344] INTEGER + +ChargeType ::= [APPLICATION 71] NumberString --(SIZE(2..3)) + +ChargingId ::= [APPLICATION 72] INTEGER + +ChargingPoint ::= [APPLICATION 73] AsciiString --(SIZE(1)) + +ChargingTimeStamp ::= [APPLICATION 74] DateTime + +ClirIndicator ::= [APPLICATION 75] INTEGER + +Commission ::= [APPLICATION 350] Charge + +CompletionTimeStamp ::= [APPLICATION 76] DateTime + +ContentChargingPoint ::= [APPLICATION 345] INTEGER + +ContentProvider ::= [APPLICATION 327] SEQUENCE +{ + contentProviderIdType ContentProviderIdType OPTIONAL, -- *m.m. + contentProviderIdentifier ContentProviderIdentifier OPTIONAL, -- *m.m. +... +} + +ContentProviderIdentifier ::= [APPLICATION 292] AsciiString + +ContentProviderIdList ::= [APPLICATION 328] SEQUENCE OF ContentProvider + +ContentProviderIdType ::= [APPLICATION 291] INTEGER + +ContentProviderName ::= [APPLICATION 334] AsciiString + +ContentServiceUsed ::= [APPLICATION 352] SEQUENCE +{ + contentTransactionCode ContentTransactionCode OPTIONAL, -- *m.m. + contentTransactionType ContentTransactionType OPTIONAL, -- *m.m. + objectType ObjectType OPTIONAL, + transactionDescriptionSupp TransactionDescriptionSupp OPTIONAL, + transactionShortDescription TransactionShortDescription OPTIONAL, -- *m.m. + transactionDetailDescription TransactionDetailDescription OPTIONAL, + transactionIdentifier TransactionIdentifier OPTIONAL, -- *m.m. + transactionAuthCode TransactionAuthCode OPTIONAL, + dataVolumeIncoming DataVolumeIncoming OPTIONAL, + dataVolumeOutgoing DataVolumeOutgoing OPTIONAL, + totalDataVolume TotalDataVolume OPTIONAL, + chargeRefundIndicator ChargeRefundIndicator OPTIONAL, + contentChargingPoint ContentChargingPoint OPTIONAL, + chargeInformationList ChargeInformationList OPTIONAL, + advisedChargeInformation AdvisedChargeInformation OPTIONAL, +... +} + +ContentServiceUsedList ::= [APPLICATION 285] SEQUENCE OF ContentServiceUsed + +ContentTransactionBasicInfo ::= [APPLICATION 304] SEQUENCE +{ + rapFileSequenceNumber RapFileSequenceNumber OPTIONAL, + orderPlacedTimeStamp OrderPlacedTimeStamp OPTIONAL, + requestedDeliveryTimeStamp RequestedDeliveryTimeStamp OPTIONAL, + actualDeliveryTimeStamp ActualDeliveryTimeStamp OPTIONAL, + totalTransactionDuration TotalTransactionDuration OPTIONAL, + transactionStatus TransactionStatus OPTIONAL, +... +} + +ContentTransactionCode ::= [APPLICATION 336] INTEGER + +ContentTransactionType ::= [APPLICATION 337] INTEGER + +CseInformation ::= [APPLICATION 79] OCTET STRING --(SIZE(1..40)) + +CurrencyConversion ::= [APPLICATION 106] SEQUENCE +{ + exchangeRateCode ExchangeRateCode OPTIONAL, -- *m.m. + numberOfDecimalPlaces NumberOfDecimalPlaces OPTIONAL, -- *m.m. + exchangeRate ExchangeRate OPTIONAL, -- *m.m. +... +} + +CurrencyConversionList ::= [APPLICATION 80] SEQUENCE OF CurrencyConversion + +CustomerIdentifier ::= [APPLICATION 364] AsciiString + +CustomerIdType ::= [APPLICATION 363] INTEGER + +DataVolume ::= INTEGER + +DataVolumeIncoming ::= [APPLICATION 250] DataVolume + +DataVolumeOutgoing ::= [APPLICATION 251] DataVolume + +-- +-- The following datatypes are used to denote timestamps. +-- Each timestamp consists of a local timestamp and a +-- corresponding UTC time offset. +-- Except for the timestamps used within the Batch Control +-- Information and the Audit Control Information +-- the UTC time offset is identified by a code referencing +-- the UtcTimeOffsetInfo. +-- + +-- +-- We start with the “short” datatype referencing the +-- UtcTimeOffsetInfo. +-- + +DateTime ::= SEQUENCE +{ + -- + -- Local timestamps are noted in the format + -- + -- CCYYMMDDhhmmss + -- + -- where CC = century (‘19’, ‘20’,...) + -- YY = year (‘00’ – ‘99’) + -- MM = month (‘01’, ‘02’, ... , ‘12’) + -- DD = day (‘01’, ‘02’, ... , ‘31’) + -- hh = hour (‘00’, ‘01’, ... , ‘23’) + -- mm = minutes (‘00’, ‘01’, ... , ‘59’) + -- ss = seconds (‘00’, ‘01’, ... , ‘59’) + -- + localTimeStamp LocalTimeStamp OPTIONAL, -- *m.m. + utcTimeOffsetCode UtcTimeOffsetCode OPTIONAL, -- *m.m. +... +} + +-- +-- The following version is the “long” datatype +-- containing the UTC time offset directly. +-- + +DateTimeLong ::= SEQUENCE +{ + localTimeStamp LocalTimeStamp OPTIONAL, -- *m.m. + utcTimeOffset UtcTimeOffset OPTIONAL, -- *m.m. +... +} + +DefaultCallHandlingIndicator ::= [APPLICATION 87] INTEGER + +DepositTimeStamp ::= [APPLICATION 88] DateTime + +Destination ::= [APPLICATION 89] SEQUENCE +{ + calledNumber CalledNumber OPTIONAL, + dialledDigits DialledDigits OPTIONAL, + calledPlace CalledPlace OPTIONAL, + calledRegion CalledRegion OPTIONAL, + sMSDestinationNumber SMSDestinationNumber OPTIONAL, +... +} + +DestinationNetwork ::= [APPLICATION 90] NetworkId + +DialledDigits ::= [APPLICATION 279] AsciiString + +Discount ::= [APPLICATION 412] DiscountValue + +DiscountableAmount ::= [APPLICATION 423] AbsoluteAmount + +DiscountApplied ::= [APPLICATION 428] CHOICE +{ + fixedDiscountValue FixedDiscountValue, + discountRate DiscountRate, +... +} + +DiscountCode ::= [APPLICATION 91] INTEGER + +DiscountInformation ::= [APPLICATION 96] SEQUENCE +{ + discountCode DiscountCode OPTIONAL, -- *m.m. + discount Discount OPTIONAL, + discountableAmount DiscountableAmount OPTIONAL, +... +} + +Discounting ::= [APPLICATION 94] SEQUENCE +{ + discountCode DiscountCode OPTIONAL, -- *m.m. + discountApplied DiscountApplied OPTIONAL, -- *m.m. +... +} + +DiscountingList ::= [APPLICATION 95] SEQUENCE OF Discounting + +DiscountRate ::= [APPLICATION 92] PercentageRate + +DiscountValue ::= AbsoluteAmount + +DistanceChargeBandCode ::= [APPLICATION 98] AsciiString --(SIZE(1)) + +EarliestCallTimeStamp ::= [APPLICATION 101] DateTimeLong + +ElementId ::= [APPLICATION 437] AsciiString + +ElementType ::= [APPLICATION 438] INTEGER + +EquipmentId ::= [APPLICATION 290] AsciiString + +EquipmentIdType ::= [APPLICATION 322] INTEGER + +Esn ::= [APPLICATION 103] NumberString + +ExchangeRate ::= [APPLICATION 104] INTEGER + +ExchangeRateCode ::= [APPLICATION 105] Code + +FileAvailableTimeStamp ::= [APPLICATION 107] DateTimeLong + +FileCreationTimeStamp ::= [APPLICATION 108] DateTimeLong + +FileSequenceNumber ::= [APPLICATION 109] NumberString --(SIZE(5)) + +FileTypeIndicator ::= [APPLICATION 110] AsciiString --(SIZE(1)) + +FixedDiscountValue ::= [APPLICATION 411] DiscountValue + +Fnur ::= [APPLICATION 111] INTEGER + +GeographicalLocation ::= [APPLICATION 113] SEQUENCE +{ + servingNetwork ServingNetwork OPTIONAL, + servingBid ServingBid OPTIONAL, + servingLocationDescription ServingLocationDescription OPTIONAL, +... +} + +GprsBasicCallInformation ::= [APPLICATION 114] SEQUENCE +{ + gprsChargeableSubscriber GprsChargeableSubscriber OPTIONAL, -- *m.m. + rapFileSequenceNumber RapFileSequenceNumber OPTIONAL, + gprsDestination GprsDestination OPTIONAL, -- *m.m. + callEventStartTimeStamp CallEventStartTimeStamp OPTIONAL, -- *m.m. + totalCallEventDuration TotalCallEventDuration OPTIONAL, -- *m.m. + causeForTerm CauseForTerm OPTIONAL, + partialTypeIndicator PartialTypeIndicator OPTIONAL, + pDPContextStartTimestamp PDPContextStartTimestamp OPTIONAL, + networkInitPDPContext NetworkInitPDPContext OPTIONAL, + chargingId ChargingId OPTIONAL, -- *m.m. +... +} + +GprsChargeableSubscriber ::= [APPLICATION 115] SEQUENCE +{ + chargeableSubscriber ChargeableSubscriber OPTIONAL, + pdpAddress PdpAddress OPTIONAL, + networkAccessIdentifier NetworkAccessIdentifier OPTIONAL, +... +} + +GprsDestination ::= [APPLICATION 116] SEQUENCE +{ + accessPointNameNI AccessPointNameNI OPTIONAL, -- *m.m. + accessPointNameOI AccessPointNameOI OPTIONAL, +... +} + +GprsLocationInformation ::= [APPLICATION 117] SEQUENCE +{ + gprsNetworkLocation GprsNetworkLocation OPTIONAL, -- *m.m. + homeLocationInformation HomeLocationInformation OPTIONAL, + geographicalLocation GeographicalLocation OPTIONAL, +... +} + +GprsNetworkLocation ::= [APPLICATION 118] SEQUENCE +{ + recEntity RecEntityCodeList OPTIONAL, -- *m.m. + locationArea LocationArea OPTIONAL, + cellId CellId OPTIONAL, +... +} + +GprsServiceUsed ::= [APPLICATION 121] SEQUENCE +{ + iMSSignallingContext IMSSignallingContext OPTIONAL, + dataVolumeIncoming DataVolumeIncoming OPTIONAL, -- *m.m. + dataVolumeOutgoing DataVolumeOutgoing OPTIONAL, -- *m.m. + chargeInformationList ChargeInformationList OPTIONAL, -- *m.m. +... +} + +GsmChargeableSubscriber ::= [APPLICATION 286] SEQUENCE +{ + imsi Imsi OPTIONAL, + msisdn Msisdn OPTIONAL, +... +} + +GuaranteedBitRate ::= [APPLICATION 420] OCTET STRING --(SIZE (1)) + +HomeBid ::= [APPLICATION 122] Bid + +HomeIdentifier ::= [APPLICATION 288] AsciiString + +HomeIdType ::= [APPLICATION 311] INTEGER + +HomeLocationDescription ::= [APPLICATION 413] LocationDescription + +HomeLocationInformation ::= [APPLICATION 123] SEQUENCE +{ + homeBid HomeBid OPTIONAL, -- *m.m. + homeLocationDescription HomeLocationDescription OPTIONAL, -- *m.m. +... +} + +HorizontalAccuracyDelivered ::= [APPLICATION 392] INTEGER + +HorizontalAccuracyRequested ::= [APPLICATION 385] INTEGER + +HSCSDIndicator ::= [APPLICATION 424] AsciiString --(SIZE(1)) + +Imei ::= [APPLICATION 128] BCDString --(SIZE(7..8)) + +ImeiOrEsn ::= [APPLICATION 429] CHOICE +{ + imei Imei, + esn Esn, +... +} + +Imsi ::= [APPLICATION 129] BCDString --(SIZE(3..8)) + +IMSSignallingContext ::= [APPLICATION 418] INTEGER + +InternetServiceProvider ::= [APPLICATION 329] SEQUENCE +{ + ispIdType IspIdType OPTIONAL, -- *m.m. + ispIdentifier IspIdentifier OPTIONAL, -- *m.m. +... +} + +InternetServiceProviderIdList ::= [APPLICATION 330] SEQUENCE OF InternetServiceProvider + +IspIdentifier ::= [APPLICATION 294] AsciiString + +IspIdType ::= [APPLICATION 293] INTEGER + +ISPList ::= [APPLICATION 378] SEQUENCE OF InternetServiceProvider + +NetworkIdType ::= [APPLICATION 331] INTEGER + +NetworkIdentifier ::= [APPLICATION 295] AsciiString + +Network ::= [APPLICATION 332] SEQUENCE +{ + networkIdType NetworkIdType OPTIONAL, -- *m.m. + networkIdentifier NetworkIdentifier OPTIONAL, -- *m.m. +... +} + +NetworkList ::= [APPLICATION 333] SEQUENCE OF Network + +LatestCallTimeStamp ::= [APPLICATION 133] DateTimeLong + +LCSQosDelivered ::= [APPLICATION 390] SEQUENCE +{ + lCSTransactionStatus LCSTransactionStatus OPTIONAL, + horizontalAccuracyDelivered HorizontalAccuracyDelivered OPTIONAL, + verticalAccuracyDelivered VerticalAccuracyDelivered OPTIONAL, + responseTime ResponseTime OPTIONAL, + positioningMethod PositioningMethod OPTIONAL, + trackingPeriod TrackingPeriod OPTIONAL, + trackingFrequency TrackingFrequency OPTIONAL, + ageOfLocation AgeOfLocation OPTIONAL, +... +} + +LCSQosRequested ::= [APPLICATION 383] SEQUENCE +{ + lCSRequestTimestamp LCSRequestTimestamp OPTIONAL, -- *m.m. + horizontalAccuracyRequested HorizontalAccuracyRequested OPTIONAL, + verticalAccuracyRequested VerticalAccuracyRequested OPTIONAL, + responseTimeCategory ResponseTimeCategory OPTIONAL, + trackingPeriod TrackingPeriod OPTIONAL, + trackingFrequency TrackingFrequency OPTIONAL, +... +} + +LCSRequestTimestamp ::= [APPLICATION 384] DateTime + +LCSSPIdentification ::= [APPLICATION 375] SEQUENCE +{ + contentProviderIdType ContentProviderIdType OPTIONAL, -- *m.m. + contentProviderIdentifier ContentProviderIdentifier OPTIONAL, -- *m.m. +... +} + +LCSSPIdentificationList ::= [APPLICATION 374] SEQUENCE OF LCSSPIdentification + +LCSSPInformation ::= [APPLICATION 373] SEQUENCE +{ + lCSSPIdentificationList LCSSPIdentificationList OPTIONAL, -- *m.m. + iSPList ISPList OPTIONAL, + networkList NetworkList OPTIONAL, +... +} + +LCSTransactionStatus ::= [APPLICATION 391] INTEGER + +LocalCurrency ::= [APPLICATION 135] Currency + +LocalTimeStamp ::= [APPLICATION 16] NumberString --(SIZE(14)) + +LocationArea ::= [APPLICATION 136] INTEGER + +LocationDescription ::= AsciiString + +LocationIdentifier ::= [APPLICATION 289] AsciiString + +LocationIdType ::= [APPLICATION 315] INTEGER + +LocationInformation ::= [APPLICATION 138] SEQUENCE +{ + networkLocation NetworkLocation OPTIONAL, -- *m.m. + homeLocationInformation HomeLocationInformation OPTIONAL, + geographicalLocation GeographicalLocation OPTIONAL, +... +} + +LocationServiceUsage ::= [APPLICATION 382] SEQUENCE +{ + lCSQosRequested LCSQosRequested OPTIONAL, -- *m.m. + lCSQosDelivered LCSQosDelivered OPTIONAL, + chargingTimeStamp ChargingTimeStamp OPTIONAL, + chargeInformationList ChargeInformationList OPTIONAL, -- *m.m. +... +} + +MaximumBitRate ::= [APPLICATION 421] OCTET STRING --(SIZE (1)) + +Mdn ::= [APPLICATION 253] NumberString + +MessageDescription ::= [APPLICATION 142] AsciiString + +MessageDescriptionCode ::= [APPLICATION 141] Code + +MessageDescriptionInformation ::= [APPLICATION 143] SEQUENCE +{ + messageDescriptionCode MessageDescriptionCode OPTIONAL, -- *m.m. + messageDescription MessageDescription OPTIONAL, -- *m.m. +... +} + +MessageStatus ::= [APPLICATION 144] INTEGER + +MessageType ::= [APPLICATION 145] INTEGER + +MessagingEventService ::= [APPLICATION 439] INTEGER + +Min ::= [APPLICATION 146] NumberString --(SIZE(2..15)) + +MinChargeableSubscriber ::= [APPLICATION 254] SEQUENCE +{ + min Min OPTIONAL, -- *m.m. + mdn Mdn OPTIONAL, +... +} + +MoBasicCallInformation ::= [APPLICATION 147] SEQUENCE +{ + chargeableSubscriber ChargeableSubscriber OPTIONAL, -- *m.m. + rapFileSequenceNumber RapFileSequenceNumber OPTIONAL, + destination Destination OPTIONAL, + destinationNetwork DestinationNetwork OPTIONAL, + callEventStartTimeStamp CallEventStartTimeStamp OPTIONAL, -- *m.m. + totalCallEventDuration TotalCallEventDuration OPTIONAL, -- *m.m. + simToolkitIndicator SimToolkitIndicator OPTIONAL, + causeForTerm CauseForTerm OPTIONAL, +... +} + +MobileSessionService ::= [APPLICATION 440] INTEGER + +Msisdn ::= [APPLICATION 152] BCDString --(SIZE(1..9)) + +MtBasicCallInformation ::= [APPLICATION 153] SEQUENCE +{ + chargeableSubscriber ChargeableSubscriber OPTIONAL, -- *m.m. + rapFileSequenceNumber RapFileSequenceNumber OPTIONAL, + callOriginator CallOriginator OPTIONAL, + originatingNetwork OriginatingNetwork OPTIONAL, + callEventStartTimeStamp CallEventStartTimeStamp OPTIONAL, -- *m.m. + totalCallEventDuration TotalCallEventDuration OPTIONAL, -- *m.m. + simToolkitIndicator SimToolkitIndicator OPTIONAL, + causeForTerm CauseForTerm OPTIONAL, +... +} + +NetworkAccessIdentifier ::= [APPLICATION 417] AsciiString + +NetworkElement ::= [APPLICATION 441] SEQUENCE +{ +elementType ElementType OPTIONAL, -- *m.m. +elementId ElementId OPTIONAL, -- *m.m. +... +} + +NetworkElementList ::= [APPLICATION 442] SEQUENCE OF NetworkElement + +NetworkId ::= AsciiString --(SIZE(1..6)) + +NetworkInitPDPContext ::= [APPLICATION 245] INTEGER + +NetworkLocation ::= [APPLICATION 156] SEQUENCE +{ + recEntityCode RecEntityCode OPTIONAL, -- *m.m. + callReference CallReference OPTIONAL, + locationArea LocationArea OPTIONAL, + cellId CellId OPTIONAL, +... +} + +NonChargedNumber ::= [APPLICATION 402] AsciiString + +NonChargedParty ::= [APPLICATION 443] SEQUENCE +{ + nonChargedPartyNumber NonChargedPartyNumber OPTIONAL, + nonChargedPublicUserId NonChargedPublicUserId OPTIONAL, +... +} + +NonChargedPartyNumber ::= [APPLICATION 444] AddressStringDigits + +NonChargedPublicUserId ::= [APPLICATION 445] AsciiString + +NumberOfDecimalPlaces ::= [APPLICATION 159] INTEGER + +ObjectType ::= [APPLICATION 281] INTEGER + +OperatorSpecInfoList ::= [APPLICATION 162] SEQUENCE OF OperatorSpecInformation + +OperatorSpecInformation ::= [APPLICATION 163] AsciiString + +OrderPlacedTimeStamp ::= [APPLICATION 300] DateTime + +OriginatingNetwork ::= [APPLICATION 164] NetworkId + +PacketDataProtocolAddress ::= [APPLICATION 165] AsciiString + +PaidIndicator ::= [APPLICATION 346] INTEGER + +PartialTypeIndicator ::= [APPLICATION 166] AsciiString --(SIZE(1)) + +PaymentMethod ::= [APPLICATION 347] INTEGER + +PdpAddress ::= [APPLICATION 167] PacketDataProtocolAddress + +PDPContextStartTimestamp ::= [APPLICATION 260] DateTime + +PlmnId ::= [APPLICATION 169] AsciiString --(SIZE(5)) + +PositioningMethod ::= [APPLICATION 395] INTEGER + +PriorityCode ::= [APPLICATION 170] INTEGER + +PublicUserId ::= [APPLICATION 446] AsciiString + +RapFileSequenceNumber ::= [APPLICATION 181] FileSequenceNumber + +RecEntityCode ::= [APPLICATION 184] Code + +RecEntityCodeList ::= [APPLICATION 185] SEQUENCE OF RecEntityCode + +RecEntityId ::= [APPLICATION 400] AsciiString + +RecEntityInfoList ::= [APPLICATION 188] SEQUENCE OF RecEntityInformation + +RecEntityInformation ::= [APPLICATION 183] SEQUENCE +{ + recEntityCode RecEntityCode OPTIONAL, -- *m.m. + recEntityType RecEntityType OPTIONAL, -- *m.m. + recEntityId RecEntityId OPTIONAL, -- *m.m. +... +} + +RecEntityType ::= [APPLICATION 186] INTEGER + +Recipient ::= [APPLICATION 182] PlmnId + +ReleaseVersionNumber ::= [APPLICATION 189] INTEGER + +RequestedDeliveryTimeStamp ::= [APPLICATION 301] DateTime + +ResponseTime ::= [APPLICATION 394] INTEGER + +ResponseTimeCategory ::= [APPLICATION 387] INTEGER + +ScuBasicInformation ::= [APPLICATION 191] SEQUENCE +{ + chargeableSubscriber ScuChargeableSubscriber OPTIONAL, -- *m.m. + chargedPartyStatus ChargedPartyStatus OPTIONAL, -- *m.m. + nonChargedNumber NonChargedNumber OPTIONAL, -- *m.m. + clirIndicator ClirIndicator OPTIONAL, + originatingNetwork OriginatingNetwork OPTIONAL, + destinationNetwork DestinationNetwork OPTIONAL, +... +} + +ScuChargeType ::= [APPLICATION 192] SEQUENCE +{ + messageStatus MessageStatus OPTIONAL, -- *m.m. + priorityCode PriorityCode OPTIONAL, -- *m.m. + distanceChargeBandCode DistanceChargeBandCode OPTIONAL, + messageType MessageType OPTIONAL, -- *m.m. + messageDescriptionCode MessageDescriptionCode OPTIONAL, -- *m.m. +... +} + +ScuTimeStamps ::= [APPLICATION 193] SEQUENCE +{ + depositTimeStamp DepositTimeStamp OPTIONAL, -- *m.m. + completionTimeStamp CompletionTimeStamp OPTIONAL, -- *m.m. + chargingPoint ChargingPoint OPTIONAL, -- *m.m. +... +} + +ScuChargeableSubscriber ::= [APPLICATION 430] CHOICE +{ + gsmChargeableSubscriber GsmChargeableSubscriber, + minChargeableSubscriber MinChargeableSubscriber, +... +} + +Sender ::= [APPLICATION 196] PlmnId + +ServiceStartTimestamp ::= [APPLICATION 447] DateTime + +ServingBid ::= [APPLICATION 198] Bid + +ServingLocationDescription ::= [APPLICATION 414] LocationDescription + +ServingNetwork ::= [APPLICATION 195] AsciiString + +ServingPartiesInformation ::= [APPLICATION 335] SEQUENCE +{ + contentProviderName ContentProviderName OPTIONAL, -- *m.m. + contentProviderIdList ContentProviderIdList OPTIONAL, + internetServiceProviderIdList InternetServiceProviderIdList OPTIONAL, + networkList NetworkList OPTIONAL, +... +} + +SessionChargeInfoList ::= [APPLICATION 448] SEQUENCE OF SessionChargeInformation + +SessionChargeInformation ::= [APPLICATION 449] SEQUENCE +{ +chargedItem ChargedItem OPTIONAL, -- *m.m. +exchangeRateCode ExchangeRateCode OPTIONAL, + callTypeGroup CallTypeGroup OPTIONAL, -- *m.m. + chargeDetailList ChargeDetailList OPTIONAL, -- *m.m. + taxInformationList TaxInformationList OPTIONAL, +... +} + +SimChargeableSubscriber ::= [APPLICATION 199] SEQUENCE +{ + imsi Imsi OPTIONAL, -- *m.m. + msisdn Msisdn OPTIONAL, +... +} + +SimToolkitIndicator ::= [APPLICATION 200] AsciiString --(SIZE(1)) + +SMSDestinationNumber ::= [APPLICATION 419] AsciiString + +SMSOriginator ::= [APPLICATION 425] AsciiString + +SpecificationVersionNumber ::= [APPLICATION 201] INTEGER + +SsParameters ::= [APPLICATION 204] AsciiString --(SIZE(1..40)) + +SupplServiceActionCode ::= [APPLICATION 208] INTEGER + +SupplServiceCode ::= [APPLICATION 209] HexString --(SIZE(2)) + +SupplServiceUsed ::= [APPLICATION 206] SEQUENCE +{ + supplServiceCode SupplServiceCode OPTIONAL, -- *m.m. + supplServiceActionCode SupplServiceActionCode OPTIONAL, -- *m.m. + ssParameters SsParameters OPTIONAL, + chargingTimeStamp ChargingTimeStamp OPTIONAL, + chargeInformation ChargeInformation OPTIONAL, + basicServiceCodeList BasicServiceCodeList OPTIONAL, +... +} + +TapCurrency ::= [APPLICATION 210] Currency + +TapDecimalPlaces ::= [APPLICATION 244] INTEGER + +TaxableAmount ::= [APPLICATION 398] AbsoluteAmount + +Taxation ::= [APPLICATION 216] SEQUENCE +{ + taxCode TaxCode OPTIONAL, -- *m.m. + taxType TaxType OPTIONAL, -- *m.m. + taxRate TaxRate OPTIONAL, + chargeType ChargeType OPTIONAL, + taxIndicator TaxIndicator OPTIONAL, +... +} + +TaxationList ::= [APPLICATION 211] SEQUENCE OF Taxation + +TaxCode ::= [APPLICATION 212] INTEGER + +TaxIndicator ::= [APPLICATION 432] AsciiString --(SIZE(1)) + +TaxInformation ::= [APPLICATION 213] SEQUENCE +{ + taxCode TaxCode OPTIONAL, -- *m.m. + taxValue TaxValue OPTIONAL, -- *m.m. + taxableAmount TaxableAmount OPTIONAL, +... +} + +TaxInformationList ::= [APPLICATION 214] SEQUENCE OF TaxInformation + +-- The TaxRate item is of a fixed length to ensure that the full 5 +-- decimal places is provided. + +TaxRate ::= [APPLICATION 215] NumberString --(SIZE(7)) + +TaxType ::= [APPLICATION 217] AsciiString --(SIZE(2)) + +TaxValue ::= [APPLICATION 397] AbsoluteAmount + +TeleServiceCode ::= [APPLICATION 218] HexString --(SIZE(2)) + +ThirdPartyInformation ::= [APPLICATION 219] SEQUENCE +{ + thirdPartyNumber ThirdPartyNumber OPTIONAL, + clirIndicator ClirIndicator OPTIONAL, +... +} + +ThirdPartyNumber ::= [APPLICATION 403] AddressStringDigits + +ThreeGcamelDestination ::= [APPLICATION 431] CHOICE +{ + camelDestinationNumber CamelDestinationNumber, + gprsDestination GprsDestination, +... +} + +TotalAdvisedCharge ::= [APPLICATION 356] AbsoluteAmount + +TotalAdvisedChargeRefund ::= [APPLICATION 357] AbsoluteAmount + +TotalAdvisedChargeValue ::= [APPLICATION 360] SEQUENCE +{ + advisedChargeCurrency AdvisedChargeCurrency OPTIONAL, + totalAdvisedCharge TotalAdvisedCharge OPTIONAL, -- *m.m. + totalAdvisedChargeRefund TotalAdvisedChargeRefund OPTIONAL, + totalCommission TotalCommission OPTIONAL, + totalCommissionRefund TotalCommissionRefund OPTIONAL, +... +} + +TotalAdvisedChargeValueList ::= [APPLICATION 361] SEQUENCE OF TotalAdvisedChargeValue + +TotalCallEventDuration ::= [APPLICATION 223] INTEGER + +TotalCharge ::= [APPLICATION 415] AbsoluteAmount + +TotalChargeRefund ::= [APPLICATION 355] AbsoluteAmount + +TotalCommission ::= [APPLICATION 358] AbsoluteAmount + +TotalCommissionRefund ::= [APPLICATION 359] AbsoluteAmount + +TotalDataVolume ::= [APPLICATION 343] DataVolume + +TotalDiscountRefund ::= [APPLICATION 354] AbsoluteAmount + +TotalDiscountValue ::= [APPLICATION 225] AbsoluteAmount + +TotalTaxRefund ::= [APPLICATION 353] AbsoluteAmount + +TotalTaxValue ::= [APPLICATION 226] AbsoluteAmount + +TotalTransactionDuration ::= [APPLICATION 416] TotalCallEventDuration + +TrackedCustomerEquipment ::= [APPLICATION 381] SEQUENCE +{ + equipmentIdType EquipmentIdType OPTIONAL, -- *m.m. + equipmentId EquipmentId OPTIONAL, -- *m.m. +... +} + +TrackedCustomerHomeId ::= [APPLICATION 377] SEQUENCE +{ + homeIdType HomeIdType OPTIONAL, -- *m.m. + homeIdentifier HomeIdentifier OPTIONAL, -- *m.m. +... +} + +TrackedCustomerHomeIdList ::= [APPLICATION 376] SEQUENCE OF TrackedCustomerHomeId + +TrackedCustomerIdentification ::= [APPLICATION 372] SEQUENCE +{ + customerIdType CustomerIdType OPTIONAL, -- *m.m. + customerIdentifier CustomerIdentifier OPTIONAL, -- *m.m. +... +} + +TrackedCustomerIdList ::= [APPLICATION 370] SEQUENCE OF TrackedCustomerIdentification + +TrackedCustomerInformation ::= [APPLICATION 367] SEQUENCE +{ + trackedCustomerIdList TrackedCustomerIdList OPTIONAL, -- *m.m. + trackedCustomerHomeIdList TrackedCustomerHomeIdList OPTIONAL, + trackedCustomerLocList TrackedCustomerLocList OPTIONAL, + trackedCustomerEquipment TrackedCustomerEquipment OPTIONAL, +... +} + +TrackedCustomerLocation ::= [APPLICATION 380] SEQUENCE +{ + locationIdType LocationIdType OPTIONAL, -- *m.m. + locationIdentifier LocationIdentifier OPTIONAL, -- *m.m. +... +} + +TrackedCustomerLocList ::= [APPLICATION 379] SEQUENCE OF TrackedCustomerLocation + +TrackingCustomerEquipment ::= [APPLICATION 371] SEQUENCE +{ + equipmentIdType EquipmentIdType OPTIONAL, -- *m.m. + equipmentId EquipmentId OPTIONAL, -- *m.m. +... +} + +TrackingCustomerHomeId ::= [APPLICATION 366] SEQUENCE +{ + homeIdType HomeIdType OPTIONAL, -- *m.m. + homeIdentifier HomeIdentifier OPTIONAL, -- *m.m. +... +} + +TrackingCustomerHomeIdList ::= [APPLICATION 365] SEQUENCE OF TrackingCustomerHomeId + +TrackingCustomerIdentification ::= [APPLICATION 362] SEQUENCE +{ + customerIdType CustomerIdType OPTIONAL, -- *m.m. + customerIdentifier CustomerIdentifier OPTIONAL, -- *m.m. +... +} + +TrackingCustomerIdList ::= [APPLICATION 299] SEQUENCE OF TrackingCustomerIdentification + +TrackingCustomerInformation ::= [APPLICATION 298] SEQUENCE +{ + trackingCustomerIdList TrackingCustomerIdList OPTIONAL, -- *m.m. + trackingCustomerHomeIdList TrackingCustomerHomeIdList OPTIONAL, + trackingCustomerLocList TrackingCustomerLocList OPTIONAL, + trackingCustomerEquipment TrackingCustomerEquipment OPTIONAL, +... +} + +TrackingCustomerLocation ::= [APPLICATION 369] SEQUENCE +{ + locationIdType LocationIdType OPTIONAL, -- *m.m. + locationIdentifier LocationIdentifier OPTIONAL, -- *m.m. +... +} + +TrackingCustomerLocList ::= [APPLICATION 368] SEQUENCE OF TrackingCustomerLocation + +TrackingFrequency ::= [APPLICATION 389] INTEGER + +TrackingPeriod ::= [APPLICATION 388] INTEGER + +TransactionAuthCode ::= [APPLICATION 342] AsciiString + +TransactionDescriptionSupp ::= [APPLICATION 338] INTEGER + +TransactionDetailDescription ::= [APPLICATION 339] AsciiString + +TransactionIdentifier ::= [APPLICATION 341] AsciiString + +TransactionShortDescription ::= [APPLICATION 340] AsciiString + +TransactionStatus ::= [APPLICATION 303] INTEGER + +TransferCutOffTimeStamp ::= [APPLICATION 227] DateTimeLong + +TransparencyIndicator ::= [APPLICATION 228] INTEGER + +UserProtocolIndicator ::= [APPLICATION 280] INTEGER + +UtcTimeOffset ::= [APPLICATION 231] AsciiString --(SIZE(5)) + +UtcTimeOffsetCode ::= [APPLICATION 232] Code + +UtcTimeOffsetInfo ::= [APPLICATION 233] SEQUENCE +{ + utcTimeOffsetCode UtcTimeOffsetCode OPTIONAL, -- *m.m. + utcTimeOffset UtcTimeOffset OPTIONAL, -- *m.m. +... +} + +UtcTimeOffsetInfoList ::= [APPLICATION 234] SEQUENCE OF UtcTimeOffsetInfo + +VerticalAccuracyDelivered ::= [APPLICATION 393] INTEGER + +VerticalAccuracyRequested ::= [APPLICATION 386] INTEGER + + +-- +-- Tagged common data types +-- + +-- +-- The AbsoluteAmount data type is used to +-- encode absolute revenue amounts. +-- The accuracy of all absolute amount values is defined +-- by the value of TapDecimalPlaces within the group +-- AccountingInfo for the entire TAP batch. +-- Note, that only amounts greater than or equal to zero are allowed. +-- The decimal number representing the amount is +-- derived from the encoded integer +-- value by division by 10^TapDecimalPlaces. +-- for example for TapDecimalPlaces = 3 the following values +-- will be derived: +-- 0 represents 0.000 +-- 12 represents 0.012 +-- 1234 represents 1.234 +-- for TapDecimalPlaces = 5 the following values will be +-- derived: +-- 0 represents 0.00000 +-- 1234 represents 0.01234 +-- 123456 represents 1.23456 +-- This data type is used to encode (total) +-- charges, (total) discount values and +-- (total) tax values. +-- +AbsoluteAmount ::= INTEGER + +Bid ::= AsciiString --(SIZE(5)) + +Code ::= INTEGER + +-- +-- Non-tagged common data types +-- +-- +-- Recommended common data types to be used for file encoding: +-- +-- The following definitions should be used for TAP file creation instead of +-- the default specifications (OCTET STRING) +-- +-- AsciiString ::= VisibleString +-- +-- Currency ::= VisibleString +-- +-- HexString ::= VisibleString +-- +-- NumberString ::= NumericString +-- +-- AsciiString contains visible ISO 646 characters. +-- Leading and trailing spaces must be discarded during processing. +-- An AsciiString cannot contain only spaces. + +AsciiString ::= OCTET STRING + +-- +-- The BCDString data type (Binary Coded Decimal String) is used to represent +-- several digits from 0 through 9, a, b, c, d, e. +-- Two digits are encoded per octet. The four leftmost bits of the octet represent +-- the first digit while the four remaining bits represent the following digit. +-- A single f must be used as a filler when the total number of digits to be +-- encoded is odd. +-- No other filler is allowed. + +BCDString ::= OCTET STRING + + +-- +-- The currency codes from ISO 4217 +-- are used to identify a currency +-- +Currency ::= OCTET STRING + +-- +-- HexString contains ISO 646 characters from 0 through 9, A, B, C, D, E, F. +-- + +HexString ::= OCTET STRING + +-- +-- NumberString contains ISO 646 characters from 0 through 9. +-- + +NumberString ::= OCTET STRING + + +-- +-- The PercentageRate data type is used to +-- encode percentage rates with an accuracy of 2 decimal places. +-- This data type is used to encode discount rates. +-- The decimal number representing the percentage +-- rate is obtained by dividing the integer value by 100 +-- Examples: +-- +-- 1500 represents 15.00 percent +-- 1 represents 0.01 percent +-- +PercentageRate ::= INTEGER + + +-- END +END +} + +1; diff --git a/FS/FS/cdr/huawei_softx3000.pm b/FS/FS/cdr/huawei_softx3000.pm new file mode 100644 index 000000000..e66af43a9 --- /dev/null +++ b/FS/FS/cdr/huawei_softx3000.pm @@ -0,0 +1,2689 @@ +package FS::cdr::huawei_softx3000; +use base qw( FS::cdr ); + +use strict; +use vars qw( %info %TZ ); +use subs qw( ts24008_number TimeStamp ); +use Time::Local; +use FS::Record qw( qsearch ); +use FS::cdr_calltype; + +#false laziness w/gsm_tap3_12.pm +%TZ = ( + '+0000' => 'XXX-0', + '+0100' => 'XXX-1', + '+0200' => 'XXX-2', + '+0300' => 'XXX-3', + '+0400' => 'XXX-4', + '+0500' => 'XXX-5', + '+0600' => 'XXX-6', + '+0700' => 'XXX-7', + '+0800' => 'XXX-8', + '+0900' => 'XXX-9', + '+1000' => 'XXX-10', + '+1100' => 'XXX-11', + '+1200' => 'XXX-12', + '-0000' => 'XXX+0', + '-0100' => 'XXX+1', + '-0200' => 'XXX+2', + '-0300' => 'XXX+3', + '-0400' => 'XXX+4', + '-0500' => 'XXX+5', + '-0600' => 'XXX+6', + '-0700' => 'XXX+7', + '-0800' => 'XXX+8', + '-0900' => 'XXX+9', + '-1000' => 'XXX+10', + '-1100' => 'XXX+11', + '-1200' => 'XXX+12', +); + +%info = ( + 'name' => 'Huawei SoftX3000', #V100R006C05 ? + 'weight' => 160, + 'type' => 'asn.1', + 'import_fields' => [], + 'asn_format' => { + 'spec' => _asn_spec(), + 'macro' => 'CallEventDataFile', + 'header_buffer' => sub { + #my $CallEventDataFile = shift; + + my %cdr_calltype = ( map { $_->calltypename => $_->calltypenum } + qsearch('cdr_calltype', {}) + ); + + { cdr_calltype => \%cdr_calltype, + }; + + }, + 'arrayref' => sub { shift->{'callEventRecords'} }, + 'row_callback' => sub { + my( $row, $buffer ) = @_; + my @keys = keys %$row; + $buffer->{'key'} = $keys[0]; + }, + 'map' => { + 'src' => huawei_field('callingNumber', ts24008_number, ), + + 'dst' => huawei_field('calledNumber', ts24008_number, ), + + 'startdate' => huawei_field(['answerTime','deliveryTime'], TimeStamp), + 'answerdate' => huawei_field(['answerTime','deliveryTime'], TimeStamp), + 'enddate' => huawei_field('releaseTime', TimeStamp), + 'duration' => huawei_field('callDuration'), + 'billsec' => huawei_field('callDuration'), + #'disposition' => #diagnostics? + #'accountcode' + #'charged_party' => # 0 or 1, do something with this? + 'calltypenum' => sub { + my($rec, $buf) = @_; + my $key = $buf->{key}; + $buf->{'cdr_calltype'}{ $key }; + }, + #'carrierid' => + }, + + }, +); + +sub huawei_field { + my $field = shift; + my $decode = $_[0] ? shift : ''; + return sub { + my($rec, $buf) = @_; + + my $key = $buf->{key}; + + $field = ref($field) ? $field : [ $field ]; + my $value = ''; + foreach my $f (@$field) { + $value = $rec->{$key}{$f} and last; + } + + $decode + ? &{ $decode }( $value ) + : $value; + + }; +} + +sub ts24008_number { + # This type contains the binary coded decimal representation of + # a directory number e.g. calling/called/connected/translated number. + # The encoding of the octet string is in accordance with the + # the elements "Calling party BCD number", "Called party BCD number" + # and "Connected number" defined in TS 24.008. + # This encoding includes type of number and number plan information + # together with a BCD encoded digit string. + # It may also contain both a presentation and screening indicator + # (octet 3a). + # For the avoidance of doubt, this field does not include + # octets 1 and 2, the element name and length, as this would be + # redundant. + # + #type id (per TS 24.008 page 490): + # low nybble: "numbering plan identification" + # high nybble: "type of number" + # 0 unknown + # 1 international + # 2 national + # 3 network specific + # 4 dedicated access, short code + # 5 reserved + # 6 reserved + # 7 reserved for extension + # (bit 8 "extension") + return sub { + my( $type_id, $value ) = unpack 'Ch*', shift; + $value =~ s/f$//; # If the called party BCD number contains an odd number + # of digits, bits 5 to 8 of the last octet shall be + # filled with an end mark coded as "1111". + $value; + }; +} + +sub TimeStamp { + # The contents of this field are a compact form of the UTCTime format + # containing local time plus an offset to universal time. Binary coded + # decimal encoding is employed for the digits to reduce the storage and + # transmission overhead + # e.g. YYMMDDhhmmssShhmm + # where + # YY = Year 00 to 99 BCD encoded + # MM = Month 01 to 12 BCD encoded + # DD = Day 01 to 31 BCD encoded + # hh = hour 00 to 23 BCD encoded + # mm = minute 00 to 59 BCD encoded + # ss = second 00 to 59 BCD encoded + # S = Sign 0 = "+", "-" ASCII encoded + # hh = hour 00 to 23 BCD encoded + # mm = minute 00 to 59 BCD encoded + return sub { + my($year, $mon, $day, $hour, $min, $sec, $tz_sign, $tz_hour, $tz_min, $dst)= + unpack 'H2H2H2H2H2H2AH2H2C', shift; + #warn "$year/$mon/$day $hour:$min:$sec $tz_sign$tz_hour$tz_min $dst\n"; + return 0 unless $year; #y2100 bug + local($ENV{TZ}) = $TZ{ "$tz_sign$tz_hour$tz_min" }; + timelocal($sec, $min, $hour, $day, $mon-1, $year); + }; +} + +sub _asn_spec { + <<'END'; + +--DEFINITIONS IMPLICIT TAGS ::= + +--BEGIN + +-------------------------------------------------------------------------------- +-- +-- CALL AND EVENT RECORDS +-- +------------------------------------------------------------------------------ +--Font: verdana 8 + +CallEventRecord ::= CHOICE +{ + moCallRecord [0] MOCallRecord, + mtCallRecord [1] MTCallRecord, + roamingRecord [2] RoamingRecord, + incGatewayRecord [3] IncGatewayRecord, + outGatewayRecord [4] OutGatewayRecord, + transitRecord [5] TransitCallRecord, + moSMSRecord [6] MOSMSRecord, + mtSMSRecord [7] MTSMSRecord, + ssActionRecord [10] SSActionRecord, + hlrIntRecord [11] HLRIntRecord, + commonEquipRecord [14] CommonEquipRecord, + recTypeExtensions [15] ManagementExtensions, + termCAMELRecord [16] TermCAMELRecord, + mtLCSRecord [17] MTLCSRecord, + moLCSRecord [18] MOLCSRecord, + niLCSRecord [19] NILCSRecord, + forwardCallRecord [100] MOCallRecord +} + +MOCallRecord ::= SET +{ + recordType [0] CallEventRecordType OPTIONAL, + servedIMSI [1] IMSI OPTIONAL, + servedIMEI [2] IMEI OPTIONAL, + servedMSISDN [3] MSISDN OPTIONAL, + callingNumber [4] CallingNumber OPTIONAL, + calledNumber [5] CalledNumber OPTIONAL, + translatedNumber [6] TranslatedNumber OPTIONAL, + connectedNumber [7] ConnectedNumber OPTIONAL, + roamingNumber [8] RoamingNumber OPTIONAL, + recordingEntity [9] RecordingEntity OPTIONAL, + mscIncomingROUTE [10] ROUTE OPTIONAL, + mscOutgoingROUTE [11] ROUTE OPTIONAL, + location [12] LocationAreaAndCell OPTIONAL, + changeOfLocation [13] SEQUENCE OF LocationChange OPTIONAL, + basicService [14] BasicServiceCode OPTIONAL, + transparencyIndicator [15] TransparencyInd OPTIONAL, + changeOfService [16] SEQUENCE OF ChangeOfService OPTIONAL, + supplServicesUsed [17] SEQUENCE OF SuppServiceUsed OPTIONAL, + aocParameters [18] AOCParameters OPTIONAL, + changeOfAOCParms [19] SEQUENCE OF AOCParmChange OPTIONAL, + msClassmark [20] Classmark OPTIONAL, + changeOfClassmark [21] ChangeOfClassmark OPTIONAL, + seizureTime [22] TimeStamp OPTIONAL, + answerTime [23] TimeStamp OPTIONAL, + releaseTime [24] TimeStamp OPTIONAL, + callDuration [25] CallDuration OPTIONAL, + radioChanRequested [27] RadioChanRequested OPTIONAL, + radioChanUsed [28] TrafficChannel OPTIONAL, + changeOfRadioChan [29] ChangeOfRadioChannel OPTIONAL, + causeForTerm [30] CauseForTerm OPTIONAL, + diagnostics [31] Diagnostics OPTIONAL, + callReference [32] CallReference OPTIONAL, + sequenceNumber [33] SequenceNumber OPTIONAL, + additionalChgInfo [34] AdditionalChgInfo OPTIONAL, + recordExtensions [35] ManagementExtensions OPTIONAL, + gsm-SCFAddress [36] Gsm-SCFAddress OPTIONAL, + serviceKey [37] ServiceKey OPTIONAL, + networkCallReference [38] NetworkCallReference OPTIONAL, + mSCAddress [39] MSCAddress OPTIONAL, + cAMELInitCFIndicator [40] CAMELInitCFIndicator OPTIONAL, + defaultCallHandling [41] DefaultCallHandling OPTIONAL, + fnur [45] Fnur OPTIONAL, + aiurRequested [46] AiurRequested OPTIONAL, + speechVersionSupported [49] SpeechVersionIdentifier OPTIONAL, + speechVersionUsed [50] SpeechVersionIdentifier OPTIONAL, + numberOfDPEncountered [51] INTEGER OPTIONAL, + levelOfCAMELService [52] LevelOfCAMELService OPTIONAL, + freeFormatData [53] FreeFormatData OPTIONAL, + cAMELCallLegInformation [54] SEQUENCE OF CAMELInformation OPTIONAL, + freeFormatDataAppend [55] BOOLEAN OPTIONAL, + defaultCallHandling-2 [56] DefaultCallHandling OPTIONAL, + gsm-SCFAddress-2 [57] Gsm-SCFAddress OPTIONAL, + serviceKey-2 [58] ServiceKey OPTIONAL, + freeFormatData-2 [59] FreeFormatData OPTIONAL, + freeFormatDataAppend-2 [60] BOOLEAN OPTIONAL, + systemType [61] SystemType OPTIONAL, + rateIndication [62] RateIndication OPTIONAL, + partialRecordType [69] PartialRecordType OPTIONAL, + guaranteedBitRate [70] GuaranteedBitRate OPTIONAL, + maximumBitRate [71] MaximumBitRate OPTIONAL, + modemType [139] ModemType OPTIONAL, + classmark3 [140] Classmark3 OPTIONAL, + chargedParty [141] ChargedParty OPTIONAL, + originalCalledNumber [142] OriginalCalledNumber OPTIONAL, + callingChargeAreaCode [145] ChargeAreaCode OPTIONAL, + calledChargeAreaCode [146] ChargeAreaCode OPTIONAL, + mscOutgoingCircuit [166] MSCCIC OPTIONAL, + orgRNCorBSCId [167] RNCorBSCId OPTIONAL, + orgMSCId [168] MSCId OPTIONAL, + callEmlppPriority [170] EmlppPriority OPTIONAL, + callerDefaultEmlppPriority [171] EmlppPriority OPTIONAL, + eaSubscriberInfo [174] EASubscriberInfo OPTIONAL, + selectedCIC [175] SelectedCIC OPTIONAL, + optimalRoutingFlag [177] NULL OPTIONAL, + optimalRoutingLateForwardFlag [178] NULL OPTIONAL, + optimalRoutingEarlyForwardFlag [179] NULL OPTIONAL, + portedflag [180] PortedFlag OPTIONAL, + calledIMSI [181] IMSI OPTIONAL, + globalAreaID [188] GAI OPTIONAL, + changeOfglobalAreaID [189] SEQUENCE OF ChangeOfglobalAreaID OPTIONAL, + subscriberCategory [190] SubscriberCategory OPTIONAL, + firstmccmnc [192] MCCMNC OPTIONAL, + intermediatemccmnc [193] MCCMNC OPTIONAL, + lastmccmnc [194] MCCMNC OPTIONAL, + cUGOutgoingAccessIndicator [195] CUGOutgoingAccessIndicator OPTIONAL, + cUGInterlockCode [196] CUGInterlockCode OPTIONAL, + cUGOutgoingAccessUsed [197] CUGOutgoingAccessUsed OPTIONAL, + cUGIndex [198] CUGIndex OPTIONAL, + interactionWithIP [199] InteractionWithIP OPTIONAL, + hotBillingTag [200] HotBillingTag OPTIONAL, + setupTime [201] TimeStamp OPTIONAL, + alertingTime [202] TimeStamp OPTIONAL, + voiceIndicator [203] VoiceIndicator OPTIONAL, + bCategory [204] BCategory OPTIONAL, + callType [205] CallType OPTIONAL +} + +--at moc callingNumber is the same as served msisdn except basic msisdn != calling number such as MSP service + +MTCallRecord ::= SET +{ + recordType [0] CallEventRecordType OPTIONAL, + servedIMSI [1] IMSI OPTIONAL, + servedIMEI [2] IMEI OPTIONAL, + servedMSISDN [3] CalledNumber OPTIONAL, + callingNumber [4] CallingNumber OPTIONAL, + connectedNumber [5] ConnectedNumber OPTIONAL, + recordingEntity [6] RecordingEntity OPTIONAL, + mscIncomingROUTE [7] ROUTE OPTIONAL, + mscOutgoingROUTE [8] ROUTE OPTIONAL, + location [9] LocationAreaAndCell OPTIONAL, + changeOfLocation [10] SEQUENCE OF LocationChange OPTIONAL, + basicService [11] BasicServiceCode OPTIONAL, + transparencyIndicator [12] TransparencyInd OPTIONAL, + changeOfService [13] SEQUENCE OF ChangeOfService OPTIONAL, + supplServicesUsed [14] SEQUENCE OF SuppServiceUsed OPTIONAL, + aocParameters [15] AOCParameters OPTIONAL, + changeOfAOCParms [16] SEQUENCE OF AOCParmChange OPTIONAL, + msClassmark [17] Classmark OPTIONAL, + changeOfClassmark [18] ChangeOfClassmark OPTIONAL, + seizureTime [19] TimeStamp OPTIONAL, + answerTime [20] TimeStamp OPTIONAL, + releaseTime [21] TimeStamp OPTIONAL, + callDuration [22] CallDuration OPTIONAL, + radioChanRequested [24] RadioChanRequested OPTIONAL, + radioChanUsed [25] TrafficChannel OPTIONAL, + changeOfRadioChan [26] ChangeOfRadioChannel OPTIONAL, + causeForTerm [27] CauseForTerm OPTIONAL, + diagnostics [28] Diagnostics OPTIONAL, + callReference [29] CallReference OPTIONAL, + sequenceNumber [30] SequenceNumber OPTIONAL, + additionalChgInfo [31] AdditionalChgInfo OPTIONAL, + recordExtensions [32] ManagementExtensions OPTIONAL, + networkCallReference [33] NetworkCallReference OPTIONAL, + mSCAddress [34] MSCAddress OPTIONAL, + fnur [38] Fnur OPTIONAL, + aiurRequested [39] AiurRequested OPTIONAL, + speechVersionSupported [42] SpeechVersionIdentifier OPTIONAL, + speechVersionUsed [43] SpeechVersionIdentifier OPTIONAL, + gsm-SCFAddress [44] Gsm-SCFAddress OPTIONAL, + serviceKey [45] ServiceKey OPTIONAL, + systemType [46] SystemType OPTIONAL, + rateIndication [47] RateIndication OPTIONAL, + partialRecordType [54] PartialRecordType OPTIONAL, + guaranteedBitRate [55] GuaranteedBitRate OPTIONAL, + maximumBitRate [56] MaximumBitRate OPTIONAL, + initialCallAttemptFlag [137] NULL OPTIONAL, + ussdCallBackFlag [138] NULL OPTIONAL, + modemType [139] ModemType OPTIONAL, + classmark3 [140] Classmark3 OPTIONAL, + chargedParty [141] ChargedParty OPTIONAL, + originalCalledNumber [142] OriginalCalledNumber OPTIONAL, + callingChargeAreaCode [145]ChargeAreaCode OPTIONAL, + calledChargeAreaCode [146]ChargeAreaCode OPTIONAL, + defaultCallHandling [150] DefaultCallHandling OPTIONAL, + freeFormatData [151] FreeFormatData OPTIONAL, + freeFormatDataAppend [152] BOOLEAN OPTIONAL, + numberOfDPEncountered [153] INTEGER OPTIONAL, + levelOfCAMELService [154] LevelOfCAMELService OPTIONAL, + roamingNumber [160] RoamingNumber OPTIONAL, + mscIncomingCircuit [166] MSCCIC OPTIONAL, + orgRNCorBSCId [167] RNCorBSCId OPTIONAL, + orgMSCId [168] MSCId OPTIONAL, + callEmlppPriority [170] EmlppPriority OPTIONAL, + calledDefaultEmlppPriority [171] EmlppPriority OPTIONAL, + eaSubscriberInfo [174] EASubscriberInfo OPTIONAL, + selectedCIC [175] SelectedCIC OPTIONAL, + optimalRoutingFlag [177] NULL OPTIONAL, + portedflag [180] PortedFlag OPTIONAL, + globalAreaID [188] GAI OPTIONAL, + changeOfglobalAreaID [189] SEQUENCE OF ChangeOfglobalAreaID OPTIONAL, + subscriberCategory [190] SubscriberCategory OPTIONAL, + firstmccmnc [192] MCCMNC OPTIONAL, + intermediatemccmnc [193] MCCMNC OPTIONAL, + lastmccmnc [194] MCCMNC OPTIONAL, + cUGOutgoingAccessIndicator [195] CUGOutgoingAccessIndicator OPTIONAL, + cUGInterlockCode [196] CUGInterlockCode OPTIONAL, + cUGIncomingAccessUsed [197] CUGIncomingAccessUsed OPTIONAL, + cUGIndex [198] CUGIndex OPTIONAL, + hotBillingTag [200] HotBillingTag OPTIONAL, + redirectingnumber [201] RedirectingNumber OPTIONAL, + redirectingcounter [202] RedirectingCounter OPTIONAL, + setupTime [203] TimeStamp OPTIONAL, + alertingTime [204] TimeStamp OPTIONAL, + calledNumber [205] CalledNumber OPTIONAL, + voiceIndicator [206] VoiceIndicator OPTIONAL, + bCategory [207] BCategory OPTIONAL, + callType [208] CallType OPTIONAL +} + +RoamingRecord ::= SET +{ + recordType [0] CallEventRecordType OPTIONAL, + servedIMSI [1] IMSI OPTIONAL, + servedMSISDN [2] MSISDN OPTIONAL, + callingNumber [3] CallingNumber OPTIONAL, + roamingNumber [4] RoamingNumber OPTIONAL, + recordingEntity [5] RecordingEntity OPTIONAL, + mscIncomingROUTE [6] ROUTE OPTIONAL, + mscOutgoingROUTE [7] ROUTE OPTIONAL, + basicService [8] BasicServiceCode OPTIONAL, + transparencyIndicator [9] TransparencyInd OPTIONAL, + changeOfService [10] SEQUENCE OF ChangeOfService OPTIONAL, + supplServicesUsed [11] SEQUENCE OF SuppServiceUsed OPTIONAL, + seizureTime [12] TimeStamp OPTIONAL, + answerTime [13] TimeStamp OPTIONAL, + releaseTime [14] TimeStamp OPTIONAL, + callDuration [15] CallDuration OPTIONAL, + causeForTerm [17] CauseForTerm OPTIONAL, + diagnostics [18] Diagnostics OPTIONAL, + callReference [19] CallReference OPTIONAL, + sequenceNumber [20] SequenceNumber OPTIONAL, + recordExtensions [21] ManagementExtensions OPTIONAL, + networkCallReference [22] NetworkCallReference OPTIONAL, + mSCAddress [23] MSCAddress OPTIONAL, + partialRecordType [30] PartialRecordType OPTIONAL, + additionalChgInfo [133] AdditionalChgInfo OPTIONAL, + chargedParty [141] ChargedParty OPTIONAL, + originalCalledNumber [142] OriginalCalledNumber OPTIONAL, + callingChargeAreaCode [145] ChargeAreaCode OPTIONAL, + calledChargeAreaCode [146] ChargeAreaCode OPTIONAL, + mscOutgoingCircuit [166] MSCCIC OPTIONAL, + mscIncomingCircuit [167] MSCCIC OPTIONAL, + orgMSCId [168] MSCId OPTIONAL, + callEmlppPriority [170] EmlppPriority OPTIONAL, + eaSubscriberInfo [174] EASubscriberInfo OPTIONAL, + selectedCIC [175] SelectedCIC OPTIONAL, + optimalRoutingFlag [177] NULL OPTIONAL, + subscriberCategory [190] SubscriberCategory OPTIONAL, + cUGOutgoingAccessIndicator [195] CUGOutgoingAccessIndicator OPTIONAL, + cUGInterlockCode [196] CUGInterlockCode OPTIONAL, + hotBillingTag [200] HotBillingTag OPTIONAL +} + +TermCAMELRecord ::= SET +{ + recordtype [0] CallEventRecordType OPTIONAL, + servedIMSI [1] IMSI OPTIONAL, + servedMSISDN [2] MSISDN OPTIONAL, + recordingEntity [3] RecordingEntity OPTIONAL, + interrogationTime [4] TimeStamp OPTIONAL, + destinationRoutingAddress [5] DestinationRoutingAddress OPTIONAL, + gsm-SCFAddress [6] Gsm-SCFAddress OPTIONAL, + serviceKey [7] ServiceKey OPTIONAL, + networkCallReference [8] NetworkCallReference OPTIONAL, + mSCAddress [9] MSCAddress OPTIONAL, + defaultCallHandling [10] DefaultCallHandling OPTIONAL, + recordExtensions [11] ManagementExtensions OPTIONAL, + calledNumber [12] CalledNumber OPTIONAL, + callingNumber [13] CallingNumber OPTIONAL, + mscIncomingROUTE [14] ROUTE OPTIONAL, + mscOutgoingROUTE [15] ROUTE OPTIONAL, + seizureTime [16] TimeStamp OPTIONAL, + answerTime [17] TimeStamp OPTIONAL, + releaseTime [18] TimeStamp OPTIONAL, + callDuration [19] CallDuration OPTIONAL, + causeForTerm [21] CauseForTerm OPTIONAL, + diagnostics [22] Diagnostics OPTIONAL, + callReference [23] CallReference OPTIONAL, + sequenceNumber [24] SequenceNumber OPTIONAL, + numberOfDPEncountered [25] INTEGER OPTIONAL, + levelOfCAMELService [26] LevelOfCAMELService OPTIONAL, + freeFormatData [27] FreeFormatData OPTIONAL, + cAMELCallLegInformation [28] SEQUENCE OF CAMELInformation OPTIONAL, + freeFormatDataAppend [29] BOOLEAN OPTIONAL, + mscServerIndication [30] BOOLEAN OPTIONAL, + defaultCallHandling-2 [31] DefaultCallHandling OPTIONAL, + gsm-SCFAddress-2 [32] Gsm-SCFAddress OPTIONAL, + serviceKey-2 [33] ServiceKey OPTIONAL, + freeFormatData-2 [34] FreeFormatData OPTIONAL, + freeFormatDataAppend-2 [35] BOOLEAN OPTIONAL, + partialRecordType [42] PartialRecordType OPTIONAL, + basicService [130] BasicServiceCode OPTIONAL, + additionalChgInfo [133] AdditionalChgInfo OPTIONAL, + chargedParty [141] ChargedParty OPTIONAL, + originalCalledNumber [142] OriginalCalledNumber OPTIONAL, + orgMSCId [168] MSCId OPTIONAL, + subscriberCategory [190] SubscriberCategory OPTIONAL, + hotBillingTag [200] HotBillingTag OPTIONAL +} + +IncGatewayRecord ::= SET +{ + recordType [0] CallEventRecordType OPTIONAL, + callingNumber [1] CallingNumber OPTIONAL, + calledNumber [2] CalledNumber OPTIONAL, + recordingEntity [3] RecordingEntity OPTIONAL, + mscIncomingROUTE [4] ROUTE OPTIONAL, + mscOutgoingROUTE [5] ROUTE OPTIONAL, + seizureTime [6] TimeStamp OPTIONAL, + answerTime [7] TimeStamp OPTIONAL, + releaseTime [8] TimeStamp OPTIONAL, + callDuration [9] CallDuration OPTIONAL, + causeForTerm [11] CauseForTerm OPTIONAL, + diagnostics [12] Diagnostics OPTIONAL, + callReference [13] CallReference OPTIONAL, + sequenceNumber [14] SequenceNumber OPTIONAL, + recordExtensions [15] ManagementExtensions OPTIONAL, + partialRecordType [22] PartialRecordType OPTIONAL, + iSDN-BC [23] ISDN-BC OPTIONAL, + lLC [24] LLC OPTIONAL, + hLC [25] HLC OPTIONAL, + basicService [130] BasicServiceCode OPTIONAL, + additionalChgInfo [133] AdditionalChgInfo OPTIONAL, + chargedParty [141] ChargedParty OPTIONAL, + originalCalledNumber [142] OriginalCalledNumber OPTIONAL, + rateIndication [159] RateIndication OPTIONAL, + roamingNumber [160] RoamingNumber OPTIONAL, + mscIncomingCircuit [167] MSCCIC OPTIONAL, + orgMSCId [168] MSCId OPTIONAL, + callEmlppPriority [170] EmlppPriority OPTIONAL, + eaSubscriberInfo [174] EASubscriberInfo OPTIONAL, + selectedCIC [175] SelectedCIC OPTIONAL, + cUGOutgoingAccessIndicator [195] CUGOutgoingAccessIndicator OPTIONAL, + cUGInterlockCode [196] CUGInterlockCode OPTIONAL, + cUGIncomingAccessUsed [197] CUGIncomingAccessUsed OPTIONAL, + mscIncomingRouteAttribute [198] RouteAttribute OPTIONAL, + mscOutgoingRouteAttribute [199] RouteAttribute OPTIONAL, + networkCallReference [200] NetworkCallReference OPTIONAL, + setupTime [201] TimeStamp OPTIONAL, + alertingTime [202] TimeStamp OPTIONAL, + voiceIndicator [203] VoiceIndicator OPTIONAL, + bCategory [204] BCategory OPTIONAL, + callType [205] CallType OPTIONAL +} + +OutGatewayRecord ::= SET +{ + recordType [0] CallEventRecordType OPTIONAL, + callingNumber [1] CallingNumber OPTIONAL, + calledNumber [2] CalledNumber OPTIONAL, + recordingEntity [3] RecordingEntity OPTIONAL, + mscIncomingROUTE [4] ROUTE OPTIONAL, + mscOutgoingROUTE [5] ROUTE OPTIONAL, + seizureTime [6] TimeStamp OPTIONAL, + answerTime [7] TimeStamp OPTIONAL, + releaseTime [8] TimeStamp OPTIONAL, + callDuration [9] CallDuration OPTIONAL, + causeForTerm [11] CauseForTerm OPTIONAL, + diagnostics [12] Diagnostics OPTIONAL, + callReference [13] CallReference OPTIONAL, + sequenceNumber [14] SequenceNumber OPTIONAL, + recordExtensions [15] ManagementExtensions OPTIONAL, + partialRecordType [22] PartialRecordType OPTIONAL, + basicService [130] BasicServiceCode OPTIONAL, + additionalChgInfo [133] AdditionalChgInfo OPTIONAL, + chargedParty [141] ChargedParty OPTIONAL, + originalCalledNumber [142] OriginalCalledNumber OPTIONAL, + rateIndication [159] RateIndication OPTIONAL, + roamingNumber [160] RoamingNumber OPTIONAL, + mscOutgoingCircuit [166] MSCCIC OPTIONAL, + orgMSCId [168] MSCId OPTIONAL, + eaSubscriberInfo [174] EASubscriberInfo OPTIONAL, + selectedCIC [175] SelectedCIC OPTIONAL, + callEmlppPriority [170] EmlppPriority OPTIONAL, + cUGOutgoingAccessIndicator [195] CUGOutgoingAccessIndicator OPTIONAL, + cUGInterlockCode [196] CUGInterlockCode OPTIONAL, + cUGIncomingAccessUsed [197] CUGIncomingAccessUsed OPTIONAL, + mscIncomingRouteAttribute [198] RouteAttribute OPTIONAL, + mscOutgoingRouteAttribute [199] RouteAttribute OPTIONAL, + networkCallReference [200] NetworkCallReference OPTIONAL, + setupTime [201] TimeStamp OPTIONAL, + alertingTime [202] TimeStamp OPTIONAL, + voiceIndicator [203] VoiceIndicator OPTIONAL, + bCategory [204] BCategory OPTIONAL, + callType [205] CallType OPTIONAL +} + +TransitCallRecord ::= SET +{ + recordType [0] CallEventRecordType OPTIONAL, + recordingEntity [1] RecordingEntity OPTIONAL, + mscIncomingROUTE [2] ROUTE OPTIONAL, + mscOutgoingROUTE [3] ROUTE OPTIONAL, + callingNumber [4] CallingNumber OPTIONAL, + calledNumber [5] CalledNumber OPTIONAL, + isdnBasicService [6] BasicService OPTIONAL, + seizureTime [7] TimeStamp OPTIONAL, + answerTime [8] TimeStamp OPTIONAL, + releaseTime [9] TimeStamp OPTIONAL, + callDuration [10] CallDuration OPTIONAL, + causeForTerm [12] CauseForTerm OPTIONAL, + diagnostics [13] Diagnostics OPTIONAL, + callReference [14] CallReference OPTIONAL, + sequenceNumber [15] SequenceNumber OPTIONAL, + recordExtensions [16] ManagementExtensions OPTIONAL, + partialRecordType [23] PartialRecordType OPTIONAL, + basicService [130] BasicServiceCode OPTIONAL, + additionalChgInfo [133] AdditionalChgInfo OPTIONAL, + originalCalledNumber [142] OriginalCalledNumber OPTIONAL, + rateIndication [159] RateIndication OPTIONAL, + mscOutgoingCircuit [166] MSCCIC OPTIONAL, + mscIncomingCircuit [167] MSCCIC OPTIONAL, + orgMSCId [168] MSCId OPTIONAL, + callEmlppPriority [170] EmlppPriority OPTIONAL, + eaSubscriberInfo [174] EASubscriberInfo OPTIONAL, + selectedCIC [175] SelectedCIC OPTIONAL, + cUGOutgoingAccessIndicator [195] CUGOutgoingAccessIndicator OPTIONAL, + cUGInterlockCode [196] CUGInterlockCode OPTIONAL, + cUGIncomingAccessUsed [197] CUGIncomingAccessUsed OPTIONAL, + mscIncomingRouteAttribute [198] RouteAttribute OPTIONAL, + mscOutgoingRouteAttribute [199] RouteAttribute OPTIONAL, + networkCallReference [200] NetworkCallReference OPTIONAL, + setupTime [201] TimeStamp OPTIONAL, + alertingTime [202] TimeStamp OPTIONAL, + voiceIndicator [203] VoiceIndicator OPTIONAL, + bCategory [204] BCategory OPTIONAL, + callType [205] CallType OPTIONAL +} + +MOSMSRecord ::= SET +{ + recordType [0] CallEventRecordType OPTIONAL, + servedIMSI [1] IMSI OPTIONAL, + servedIMEI [2] IMEI OPTIONAL, + servedMSISDN [3] MSISDN OPTIONAL, + msClassmark [4] Classmark OPTIONAL, + serviceCentre [5] AddressString OPTIONAL, + recordingEntity [6] RecordingEntity OPTIONAL, + location [7] LocationAreaAndCell OPTIONAL, + messageReference [8] MessageReference OPTIONAL, + originationTime [9] TimeStamp OPTIONAL, + smsResult [10] SMSResult OPTIONAL, + recordExtensions [11] ManagementExtensions OPTIONAL, + destinationNumber [12] SmsTpDestinationNumber OPTIONAL, + cAMELSMSInformation [13] CAMELSMSInformation OPTIONAL, + systemType [14] SystemType OPTIONAL, + basicService [130] BasicServiceCode OPTIONAL, + additionalChgInfo [133] AdditionalChgInfo OPTIONAL, + classmark3 [140] Classmark3 OPTIONAL, + chargedParty [141] ChargedParty OPTIONAL, + orgRNCorBSCId [167] RNCorBSCId OPTIONAL, + orgMSCId [168] MSCId OPTIONAL, + globalAreaID [188] GAI OPTIONAL, + subscriberCategory [190] SubscriberCategory OPTIONAL, + firstmccmnc [192] MCCMNC OPTIONAL, + smsUserDataType [195] SmsUserDataType OPTIONAL, + smstext [196] SMSTEXT OPTIONAL, + maximumNumberOfSMSInTheConcatenatedSMS [197] MaximumNumberOfSMSInTheConcatenatedSMS OPTIONAL, + concatenatedSMSReferenceNumber [198] ConcatenatedSMSReferenceNumber OPTIONAL, + sequenceNumberOfTheCurrentSMS [199] SequenceNumberOfTheCurrentSMS OPTIONAL, + hotBillingTag [200] HotBillingTag OPTIONAL, + callReference [201] CallReference OPTIONAL +} + +MTSMSRecord ::= SET +{ + recordType [0] CallEventRecordType OPTIONAL, + serviceCentre [1] AddressString OPTIONAL, + servedIMSI [2] IMSI OPTIONAL, + servedIMEI [3] IMEI OPTIONAL, + servedMSISDN [4] MSISDN OPTIONAL, + msClassmark [5] Classmark OPTIONAL, + recordingEntity [6] RecordingEntity OPTIONAL, + location [7] LocationAreaAndCell OPTIONAL, + deliveryTime [8] TimeStamp OPTIONAL, + smsResult [9] SMSResult OPTIONAL, + recordExtensions [10] ManagementExtensions OPTIONAL, + systemType [11] SystemType OPTIONAL, + cAMELSMSInformation [12] CAMELSMSInformation OPTIONAL, + basicService [130] BasicServiceCode OPTIONAL, + additionalChgInfo [133] AdditionalChgInfo OPTIONAL, + classmark3 [140] Classmark3 OPTIONAL, + chargedParty [141] ChargedParty OPTIONAL, + orgRNCorBSCId [167] RNCorBSCId OPTIONAL, + orgMSCId [168] MSCId OPTIONAL, + globalAreaID [188] GAI OPTIONAL, + subscriberCategory [190] SubscriberCategory OPTIONAL, + firstmccmnc [192] MCCMNC OPTIONAL, + smsUserDataType [195] SmsUserDataType OPTIONAL, + smstext [196] SMSTEXT OPTIONAL, + maximumNumberOfSMSInTheConcatenatedSMS [197] MaximumNumberOfSMSInTheConcatenatedSMS OPTIONAL, + concatenatedSMSReferenceNumber [198] ConcatenatedSMSReferenceNumber OPTIONAL, + sequenceNumberOfTheCurrentSMS [199] SequenceNumberOfTheCurrentSMS OPTIONAL, + hotBillingTag [200] HotBillingTag OPTIONAL, + origination [201] CallingNumber OPTIONAL, + callReference [202] CallReference OPTIONAL +} + +HLRIntRecord ::= SET +{ + recordType [0] CallEventRecordType OPTIONAL, + servedIMSI [1] IMSI OPTIONAL, + servedMSISDN [2] MSISDN OPTIONAL, + recordingEntity [3] RecordingEntity OPTIONAL, + basicService [4] BasicServiceCode OPTIONAL, + routingNumber [5] RoutingNumber OPTIONAL, + interrogationTime [6] TimeStamp OPTIONAL, + numberOfForwarding [7] NumberOfForwarding OPTIONAL, + interrogationResult [8] HLRIntResult OPTIONAL, + recordExtensions [9] ManagementExtensions OPTIONAL, + orgMSCId [168] MSCId OPTIONAL, + callReference [169] CallReference OPTIONAL +} + +SSActionRecord ::= SET +{ + recordType [0] CallEventRecordType OPTIONAL, + servedIMSI [1] IMSI OPTIONAL, + servedIMEI [2] IMEI OPTIONAL, + servedMSISDN [3] MSISDN OPTIONAL, + msClassmark [4] Classmark OPTIONAL, + recordingEntity [5] RecordingEntity OPTIONAL, + location [6] LocationAreaAndCell OPTIONAL, + basicServices [7] BasicServices OPTIONAL, + supplService [8] SS-Code OPTIONAL, + ssAction [9] SSActionType OPTIONAL, + ssActionTime [10] TimeStamp OPTIONAL, + ssParameters [11] SSParameters OPTIONAL, + ssActionResult [12] SSActionResult OPTIONAL, + callReference [13] CallReference OPTIONAL, + recordExtensions [14] ManagementExtensions OPTIONAL, + systemType [15] SystemType OPTIONAL, + ussdCodingScheme [126] UssdCodingScheme OPTIONAL, + ussdString [127] SEQUENCE OF UssdString OPTIONAL, + ussdNotifyCounter [128] UssdNotifyCounter OPTIONAL, + ussdRequestCounter [129] UssdRequestCounter OPTIONAL, + additionalChgInfo [133] AdditionalChgInfo OPTIONAL, + classmark3 [140] Classmark3 OPTIONAL, + chargedParty [141] ChargedParty OPTIONAL, + orgRNCorBSCId [167] RNCorBSCId OPTIONAL, + orgMSCId [168] MSCId OPTIONAL, + globalAreaID [188] GAI OPTIONAL, + subscriberCategory [190] SubscriberCategory OPTIONAL, + firstmccmnc [192] MCCMNC OPTIONAL, + hotBillingTag [200] HotBillingTag OPTIONAL +} + +CommonEquipRecord ::= SET +{ + recordType [0] CallEventRecordType OPTIONAL, + equipmentType [1] EquipmentType OPTIONAL, + equipmentId [2] EquipmentId OPTIONAL, + servedIMSI [3] IMSI OPTIONAL, + servedMSISDN [4] MSISDN OPTIONAL, + recordingEntity [5] RecordingEntity OPTIONAL, + basicService [6] BasicServiceCode OPTIONAL, + changeOfService [7] SEQUENCE OF ChangeOfService OPTIONAL, + supplServicesUsed [8] SEQUENCE OF SuppServiceUsed OPTIONAL, + seizureTime [9] TimeStamp OPTIONAL, + releaseTime [10] TimeStamp OPTIONAL, + callDuration [11] CallDuration OPTIONAL, + callReference [12] CallReference OPTIONAL, + sequenceNumber [13] SequenceNumber OPTIONAL, + recordExtensions [14] ManagementExtensions OPTIONAL, + systemType [15] SystemType OPTIONAL, + rateIndication [16] RateIndication OPTIONAL, + fnur [17] Fnur OPTIONAL, + partialRecordType [18] PartialRecordType OPTIONAL, + causeForTerm [100] CauseForTerm OPTIONAL, + diagnostics [101] Diagnostics OPTIONAL, + servedIMEI [102] IMEI OPTIONAL, + additionalChgInfo [133] AdditionalChgInfo OPTIONAL, + orgRNCorBSCId [167] RNCorBSCId OPTIONAL, + orgMSCId [168] MSCId OPTIONAL, + subscriberCategory [190] SubscriberCategory OPTIONAL, + hotBillingTag [200] HotBillingTag OPTIONAL +} + +------------------------------------------------------------------------------ +-- +-- OBSERVED IMEI TICKETS +-- +------------------------------------------------------------------------------ + +ObservedIMEITicket ::= SET +{ + servedIMEI [0] IMEI, + imeiStatus [1] IMEIStatus, + servedIMSI [2] IMSI, + servedMSISDN [3] MSISDN OPTIONAL, + recordingEntity [4] RecordingEntity, + eventTime [5] TimeStamp, + location [6] LocationAreaAndCell, + imeiCheckEvent [7] IMEICheckEvent OPTIONAL, + callReference [8] CallReference OPTIONAL, + recordExtensions [9] ManagementExtensions OPTIONAL, + orgMSCId [168] MSCId OPTIONAL +} + + + +------------------------------------------------------------------------------ +-- +-- LOCATION SERICE TICKETS +-- +------------------------------------------------------------------------------ + +MTLCSRecord ::= SET +{ + recordType [0] CallEventRecordType OPTIONAL, + recordingEntity [1] RecordingEntity OPTIONAL, + lcsClientType [2] LCSClientType OPTIONAL, + lcsClientIdentity [3] LCSClientIdentity OPTIONAL, + servedIMSI [4] IMSI OPTIONAL, + servedMSISDN [5] MSISDN OPTIONAL, + locationType [6] LocationType OPTIONAL, + lcsQos [7] LCSQoSInfo OPTIONAL, + lcsPriority [8] LCS-Priority OPTIONAL, + mlc-Number [9] ISDN-AddressString OPTIONAL, + eventTimeStamp [10] TimeStamp OPTIONAL, + measureDuration [11] CallDuration OPTIONAL, + notificationToMSUser [12] NotificationToMSUser OPTIONAL, + privacyOverride [13] NULL OPTIONAL, + location [14] LocationAreaAndCell OPTIONAL, + locationEstimate [15] Ext-GeographicalInformation OPTIONAL, + positioningData [16] PositioningData OPTIONAL, + lcsCause [17] LCSCause OPTIONAL, + diagnostics [18] Diagnostics OPTIONAL, + systemType [19] SystemType OPTIONAL, + recordExtensions [20] ManagementExtensions OPTIONAL, + causeForTerm [21] CauseForTerm OPTIONAL, + lcsReferenceNumber [101] CallReferenceNumber OPTIONAL, + servedIMEI [102] IMEI OPTIONAL, + additionalChgInfo [133] AdditionalChgInfo OPTIONAL, + chargedParty [141] ChargedParty OPTIONAL, + orgRNCorBSCId [167] RNCorBSCId OPTIONAL, + orgMSCId [168] MSCId OPTIONAL, + globalAreaID [188] GAI OPTIONAL, + subscriberCategory [190] SubscriberCategory OPTIONAL, + firstmccmnc [192] MCCMNC OPTIONAL, + hotBillingTag [200] HotBillingTag OPTIONAL, + callReference [201] CallReference OPTIONAL +} + +MOLCSRecord ::= SET +{ + recordType [0] CallEventRecordType OPTIONAL, + recordingEntity [1] RecordingEntity OPTIONAL, + lcsClientType [2] LCSClientType OPTIONAL, + lcsClientIdentity [3] LCSClientIdentity OPTIONAL, + servedIMSI [4] IMSI OPTIONAL, + servedMSISDN [5] MSISDN OPTIONAL, + molr-Type [6] MOLR-Type OPTIONAL, + lcsQos [7] LCSQoSInfo OPTIONAL, + lcsPriority [8] LCS-Priority OPTIONAL, + mlc-Number [9] ISDN-AddressString OPTIONAL, + eventTimeStamp [10] TimeStamp OPTIONAL, + measureDuration [11] CallDuration OPTIONAL, + location [12] LocationAreaAndCell OPTIONAL, + locationEstimate [13] Ext-GeographicalInformation OPTIONAL, + positioningData [14] PositioningData OPTIONAL, + lcsCause [15] LCSCause OPTIONAL, + diagnostics [16] Diagnostics OPTIONAL, + systemType [17] SystemType OPTIONAL, + recordExtensions [18] ManagementExtensions OPTIONAL, + causeForTerm [19] CauseForTerm OPTIONAL, + lcsReferenceNumber [101] CallReferenceNumber OPTIONAL, + servedIMEI [102] IMEI OPTIONAL, + additionalChgInfo [133] AdditionalChgInfo OPTIONAL, + chargedParty [141] ChargedParty OPTIONAL, + orgRNCorBSCId [167] RNCorBSCId OPTIONAL, + orgMSCId [168] MSCId OPTIONAL, + globalAreaID [188] GAI OPTIONAL, + subscriberCategory [190] SubscriberCategory OPTIONAL, + firstmccmnc [192] MCCMNC OPTIONAL, + hotBillingTag [200] HotBillingTag OPTIONAL, + callReference [201] CallReference OPTIONAL +} + +NILCSRecord ::= SET +{ + recordType [0] CallEventRecordType OPTIONAL, + recordingEntity [1] RecordingEntity OPTIONAL, + lcsClientType [2] LCSClientType OPTIONAL, + lcsClientIdentity [3] LCSClientIdentity OPTIONAL, + servedIMSI [4] IMSI OPTIONAL, + servedMSISDN [5] MSISDN OPTIONAL, + servedIMEI [6] IMEI OPTIONAL, + emsDigits [7] ISDN-AddressString OPTIONAL, + emsKey [8] ISDN-AddressString OPTIONAL, + lcsQos [9] LCSQoSInfo OPTIONAL, + lcsPriority [10] LCS-Priority OPTIONAL, + mlc-Number [11] ISDN-AddressString OPTIONAL, + eventTimeStamp [12] TimeStamp OPTIONAL, + measureDuration [13] CallDuration OPTIONAL, + location [14] LocationAreaAndCell OPTIONAL, + locationEstimate [15] Ext-GeographicalInformation OPTIONAL, + positioningData [16] PositioningData OPTIONAL, + lcsCause [17] LCSCause OPTIONAL, + diagnostics [18] Diagnostics OPTIONAL, + systemType [19] SystemType OPTIONAL, + recordExtensions [20] ManagementExtensions OPTIONAL, + causeForTerm [21] CauseForTerm OPTIONAL, + lcsReferenceNumber [101] CallReferenceNumber OPTIONAL, + additionalChgInfo [133] AdditionalChgInfo OPTIONAL, + chargedParty [141] ChargedParty OPTIONAL, + orgRNCorBSCId [167] RNCorBSCId OPTIONAL, + orgMSCId [168] MSCId OPTIONAL, + globalAreaID [188] GAI OPTIONAL, + subscriberCategory [190] SubscriberCategory OPTIONAL, + firstmccmnc [192] MCCMNC OPTIONAL, + hotBillingTag [200] HotBillingTag OPTIONAL, + callReference [201] CallReference OPTIONAL +} + + +------------------------------------------------------------------------------ +-- +-- FTAM / FTP / TFTP FILE CONTENTS +-- +------------------------------------------------------------------------------ + +CallEventDataFile ::= SEQUENCE +{ + headerRecord [0] HeaderRecord, + callEventRecords [1] SEQUENCE OF CallEventRecord, + trailerRecord [2] TrailerRecord, + extensions [3] ManagementExtensions +} + +ObservedIMEITicketFile ::= SEQUENCE +{ + productionDateTime [0] TimeStamp, + observedIMEITickets [1] SEQUENCE OF ObservedIMEITicket, + noOfRecords [2] INTEGER, + extensions [3] ManagementExtensions +} + +HeaderRecord ::= SEQUENCE +{ + productionDateTime [0] TimeStamp, + recordingEntity [1] RecordingEntity, + extensions [2] ManagementExtensions +} + +TrailerRecord ::= SEQUENCE +{ + productionDateTime [0] TimeStamp, + recordingEntity [1] RecordingEntity, + firstCallDateTime [2] TimeStamp, + lastCallDateTime [3] TimeStamp, + noOfRecords [4] INTEGER, + extensions [5] ManagementExtensions +} + + +------------------------------------------------------------------------------ +-- +-- COMMON DATA TYPES +-- +------------------------------------------------------------------------------ + +AdditionalChgInfo ::= SEQUENCE +{ + chargeIndicator [0] ChargeIndicator OPTIONAL, + chargeParameters [1] OCTET STRING OPTIONAL +} + +AddressString ::= OCTET STRING -- (SIZE (1..maxAddressLength)) + -- This type is used to represent a number for addressing + -- purposes. It is composed of + -- a) one octet for nature of address, and numbering plan + -- indicator. + -- b) digits of an address encoded as TBCD-String. + + -- a) The first octet includes a one bit extension indicator, a + -- 3 bits nature of address indicator and a 4 bits numbering + -- plan indicator, encoded as follows: + + -- bit 8: 1 (no extension) + + -- bits 765: nature of address indicator + -- 000 unknown + -- 001 international number + -- 010 national significant number + -- 011 network specific number + -- 100 subscriber number + -- 101 reserved + -- 110 abbreviated number + -- 111 reserved for extension + + -- bits 4321: numbering plan indicator + -- 0000 unknown + -- 0001 ISDN/Telephony Numbering Plan (Rec CCITT E.164) + -- 0010 spare + -- 0011 data numbering plan (CCITT Rec X.121) + -- 0100 telex numbering plan (CCITT Rec F.69) + -- 0101 spare + -- 0110 land mobile numbering plan (CCITT Rec E.212) + -- 0111 spare + -- 1000 national numbering plan + -- 1001 private numbering plan + -- 1111 reserved for extension + + -- all other values are reserved. + + -- b) The following octets representing digits of an address + -- encoded as a TBCD-STRING. + +-- maxAddressLength INTEGER ::= 20 + +AiurRequested ::= ENUMERATED +{ + -- + -- See Bearer Capability TS 24.008 + -- (note that value "4" is intentionally missing + -- because it is not used in TS 24.008) + -- + + aiur09600BitsPerSecond (1), + aiur14400BitsPerSecond (2), + aiur19200BitsPerSecond (3), + aiur28800BitsPerSecond (5), + aiur38400BitsPerSecond (6), + aiur43200BitsPerSecond (7), + aiur57600BitsPerSecond (8), + aiur38400BitsPerSecond1 (9), + aiur38400BitsPerSecond2 (10), + aiur38400BitsPerSecond3 (11), + aiur38400BitsPerSecond4 (12) +} + +AOCParameters ::= SEQUENCE +{ + -- + -- See TS 22.024. + -- + e1 [1] EParameter OPTIONAL, + e2 [2] EParameter OPTIONAL, + e3 [3] EParameter OPTIONAL, + e4 [4] EParameter OPTIONAL, + e5 [5] EParameter OPTIONAL, + e6 [6] EParameter OPTIONAL, + e7 [7] EParameter OPTIONAL +} + +AOCParmChange ::= SEQUENCE +{ + changeTime [0] TimeStamp, + newParameters [1] AOCParameters +} + +BasicService ::= OCTET STRING -- (SIZE(1)) + +--This parameter identifies the ISDN Basic service as defined in ETSI specification ETS 300 196. +-- allServices '00'h +-- speech '01'h +-- unrestricteDigtalInfo '02'h +-- audio3k1HZ '03'h +-- unrestricteDigtalInfowithtoneandannoucement '04'h +-- telephony3k1HZ '20'h +-- teletext '21'h +-- telefaxGroup4Class1 '22'h +-- videotextSyntaxBased '23'h +-- videotelephony '24'h +-- telefaxGroup2-3 '25'h +-- telephony7kHZ '26'h + + + +BasicServices ::= SET OF BasicServiceCode + +BasicServiceCode ::= CHOICE +{ + bearerService [2] BearerServiceCode, + teleservice [3] TeleserviceCode +} + + +TeleserviceCode ::= OCTET STRING -- (SIZE (1)) + -- This type is used to represent the code identifying a single + -- teleservice, a group of teleservices, or all teleservices. The + -- services are defined in TS GSM 02.03. + -- The internal structure is defined as follows: + + -- bits 87654321: group (bits 8765) and specific service + -- (bits 4321) + +-- allTeleservices (0x00), +-- allSpeechTransmissionServices (0x10), +-- telephony (0x11), +-- emergencyCalls (0x12), +-- +-- allShortMessageServices (0x20), +-- shortMessageMT-PP (0x21), +-- shortMessageMO-PP (0x22), +-- +-- allFacsimileTransmissionServices (0x60), +-- facsimileGroup3AndAlterSpeech (0x61), +-- automaticFacsimileGroup3 (0x62), +-- facsimileGroup4 (0x63), +-- +-- The following non-hierarchical Compound Teleservice Groups +-- are defined in TS GSM 02.30: +-- allDataTeleservices (0x70), +-- covers Teleservice Groups 'allFacsimileTransmissionServices' +-- and 'allShortMessageServices' +-- allTeleservices-ExeptSMS (0x80), +-- covers Teleservice Groups 'allSpeechTransmissionServices' and +-- 'allFacsimileTransmissionServices' +-- +-- Compound Teleservice Group Codes are only used in call +-- independent supplementary service operations, i.e. they +-- are not used in InsertSubscriberData or in +-- DeleteSubscriberData messages. +-- +-- allVoiceGroupCallServices (0x90), +-- voiceGroupCall (0x91), +-- voiceBroadcastCall (0x92), +-- +-- allPLMN-specificTS (0xd0), +-- plmn-specificTS-1 (0xd1), +-- plmn-specificTS-2 (0xd2), +-- plmn-specificTS-3 (0xd3), +-- plmn-specificTS-4 (0xd4), +-- plmn-specificTS-5 (0xd5), +-- plmn-specificTS-6 (0xd6), +-- plmn-specificTS-7 (0xd7), +-- plmn-specificTS-8 (0xd8), +-- plmn-specificTS-9 (0xd9), +-- plmn-specificTS-A (0xda), +-- plmn-specificTS-B (0xdb), +-- plmn-specificTS-C (0xdc), +-- plmn-specificTS-D (0xdd), +-- plmn-specificTS-E (0xde), +-- plmn-specificTS-F (0xdf) + + +BearerServiceCode ::= OCTET STRING -- (SIZE (1)) + -- This type is used to represent the code identifying a single + -- bearer service, a group of bearer services, or all bearer + -- services. The services are defined in TS 3GPP TS 22.002 [3]. + -- The internal structure is defined as follows: + -- + -- plmn-specific bearer services: + -- bits 87654321: defined by the HPLMN operator + + -- rest of bearer services: + -- bit 8: 0 (unused) + -- bits 7654321: group (bits 7654), and rate, if applicable + -- (bits 321) + +-- allBearerServices (0x00), +-- allDataCDA-Services (0x10), +-- dataCDA-300bps (0x11), +-- dataCDA-1200bps (0x12), +-- dataCDA-1200-75bps (0x13), +-- dataCDA-2400bps (0x14), +-- dataCDA-4800bps (0x15), +-- dataCDA-9600bps (0x16), +-- general-dataCDA (0x17), +-- +-- allDataCDS-Services (0x18), +-- dataCDS-1200bps (0x1a), +-- dataCDS-2400bps (0x1c), +-- dataCDS-4800bps (0x1d), +-- dataCDS-9600bps (0x1e), +-- general-dataCDS (0x1f), +-- +-- allPadAccessCA-Services (0x20), +-- padAccessCA-300bps (0x21), +-- padAccessCA-1200bps (0x22), +-- padAccessCA-1200-75bps (0x23), +-- padAccessCA-2400bps (0x24), +-- padAccessCA-4800bps (0x25), +-- padAccessCA-9600bps (0x26), +-- general-padAccessCA (0x27), +-- +-- allDataPDS-Services (0x28), +-- dataPDS-2400bps (0x2c), +-- dataPDS-4800bps (0x2d), +-- dataPDS-9600bps (0x2e), +-- general-dataPDS (0x2f), +-- +-- allAlternateSpeech-DataCDA (0x30), +-- +-- allAlternateSpeech-DataCDS (0x38), +-- +-- allSpeechFollowedByDataCDA (0x40), +-- +-- allSpeechFollowedByDataCDS (0x48), +-- +-- The following non-hierarchical Compound Bearer Service +-- Groups are defined in TS GSM 02.30: +-- allDataCircuitAsynchronous (0x50), +-- covers "allDataCDA-Services", "allAlternateSpeech-DataCDA" and +-- "allSpeechFollowedByDataCDA" +-- allDataCircuitSynchronous (0x58), +-- covers "allDataCDS-Services", "allAlternateSpeech-DataCDS" and +-- "allSpeechFollowedByDataCDS" +-- allAsynchronousServices (0x60), +-- covers "allDataCDA-Services", "allAlternateSpeech-DataCDA", +-- "allSpeechFollowedByDataCDA" and "allPadAccessCDA-Services" +-- allSynchronousServices (0x68), +-- covers "allDataCDS-Services", "allAlternateSpeech-DataCDS", +-- "allSpeechFollowedByDataCDS" and "allDataPDS-Services" +-- +-- Compound Bearer Service Group Codes are only used in call +-- independent supplementary service operations, i.e. they +-- are not used in InsertSubscriberData or in +-- DeleteSubscriberData messages. +-- +-- allPLMN-specificBS (0xd0), +-- plmn-specificBS-1 (0xd1), +-- plmn-specificBS-2 (0xd2), +-- plmn-specificBS-3 (0xd3), +-- plmn-specificBS-4 (0xd4), +-- plmn-specificBS-5 (0xd5), +-- plmn-specificBS-6 (0xd6), +-- plmn-specificBS-7 (0xd7), +-- plmn-specificBS-8 (0xd8), +-- plmn-specificBS-9 (0xd9), +-- plmn-specificBS-A (0xda), +-- plmn-specificBS-B (0xdb), +-- plmn-specificBS-C (0xdc), +-- plmn-specificBS-D (0xdd), +-- plmn-specificBS-E (0xde), +-- plmn-specificBS-F (0xdf) + + +BCDDirectoryNumber ::= OCTET STRING + -- This type contains the binary coded decimal representation of + -- a directory number e.g. calling/called/connected/translated number. + -- The encoding of the octet string is in accordance with the + -- the elements "Calling party BCD number", "Called party BCD number" + -- and "Connected number" defined in TS 24.008. + -- This encoding includes type of number and number plan information + -- together with a BCD encoded digit string. + -- It may also contain both a presentation and screening indicator + -- (octet 3a). + -- For the avoidance of doubt, this field does not include + -- octets 1 and 2, the element name and length, as this would be + -- redundant. + +CallDuration ::= INTEGER + -- + -- The call duration in seconds. + -- For successful calls this is the chargeable duration. + -- For call attempts this is the call holding time. + -- + +CallEventRecordType ::= ENUMERATED -- INTEGER +{ + moCallRecord (0), + mtCallRecord (1), + roamingRecord (2), + incGatewayRecord (3), + outGatewayRecord (4), + transitCallRecord (5), + moSMSRecord (6), + mtSMSRecord (7), + ssActionRecord (10), + hlrIntRecord (11), + commonEquipRecord (14), + moTraceRecord (15), + mtTraceRecord (16), + termCAMELRecord (17), + mtLCSRecord (23), + moLCSRecord (24), + niLCSRecord (25), + forwardCallRecord (100) +} + +CalledNumber ::= BCDDirectoryNumber + +CallingNumber ::= BCDDirectoryNumber + +CallingPartyCategory ::= Category + +CallReference ::= OCTET STRING -- (SIZE (1..8)) + +CallReferenceNumber ::= OCTET STRING -- (SIZE (1..8)) + +CAMELDestinationNumber ::= DestinationRoutingAddress + +CAMELInformation ::= SET +{ + cAMELDestinationNumber [1] CAMELDestinationNumber OPTIONAL, + connectedNumber [2] ConnectedNumber OPTIONAL, + roamingNumber [3] RoamingNumber OPTIONAL, + mscOutgoingROUTE [4] ROUTE OPTIONAL, + seizureTime [5] TimeStamp OPTIONAL, + answerTime [6] TimeStamp OPTIONAL, + releaseTime [7] TimeStamp OPTIONAL, + callDuration [8] CallDuration OPTIONAL, + dataVolume [9] DataVolume OPTIONAL, + cAMELInitCFIndicator [10] CAMELInitCFIndicator OPTIONAL, + causeForTerm [11] CauseForTerm OPTIONAL, + cAMELModification [12] ChangedParameters OPTIONAL, + freeFormatData [13] FreeFormatData OPTIONAL, + diagnostics [14] Diagnostics OPTIONAL, + freeFormatDataAppend [15] BOOLEAN OPTIONAL, + freeFormatData-2 [16] FreeFormatData OPTIONAL, + freeFormatDataAppend-2 [17] BOOLEAN OPTIONAL +} + +CAMELSMSInformation ::= SET +{ + gsm-SCFAddress [1] Gsm-SCFAddress OPTIONAL, + serviceKey [2] ServiceKey OPTIONAL, + defaultSMSHandling [3] DefaultSMS-Handling OPTIONAL, + freeFormatData [4] FreeFormatData OPTIONAL, + callingPartyNumber [5] CallingNumber OPTIONAL, + destinationSubscriberNumber [6] CalledNumber OPTIONAL, + cAMELSMSCAddress [7] AddressString OPTIONAL, + smsReferenceNumber [8] CallReferenceNumber OPTIONAL +} + +CAMELInitCFIndicator ::= ENUMERATED +{ + noCAMELCallForwarding (0), + cAMELCallForwarding (1) +} + +CAMELModificationParameters ::= SET + -- + -- The list contains only parameters changed due to CAMEL call + -- handling. + -- +{ + callingPartyNumber [0] CallingNumber OPTIONAL, + callingPartyCategory [1] CallingPartyCategory OPTIONAL, + originalCalledPartyNumber [2] OriginalCalledNumber OPTIONAL, + genericNumbers [3] GenericNumbers OPTIONAL, + redirectingPartyNumber [4] RedirectingNumber OPTIONAL, + redirectionCounter [5] NumberOfForwarding OPTIONAL +} + + +Category ::= OCTET STRING -- (SIZE(1)) + -- + -- The internal structure is defined in ITU-T Rec Q.763. + --see subscribe category + +CauseForTerm ::= ENUMERATED -- INTEGER + -- + -- Cause codes from 16 up to 31 are defined in TS 32.015 as 'CauseForRecClosing' + -- (cause for record closing). + -- There is no direct correlation between these two types. + -- LCS related causes belong to the MAP error causes acc. TS 29.002. + -- +{ + normalRelease (0), + partialRecord (1), + partialRecordCallReestablishment (2), + unsuccessfulCallAttempt (3), + stableCallAbnormalTermination (4), + cAMELInitCallRelease (5), + unauthorizedRequestingNetwork (52), + unauthorizedLCSClient (53), + positionMethodFailure (54), + unknownOrUnreachableLCSClient (58) +} + +CellId ::= OCTET STRING -- (SIZE(2)) + -- + -- Coded according to TS 24.008 + -- + +ChangedParameters ::= SET +{ + changeFlags [0] ChangeFlags, + changeList [1] CAMELModificationParameters OPTIONAL +} + +ChangeFlags ::= BIT STRING +-- { +-- callingPartyNumberModified (0), +-- callingPartyCategoryModified (1), +-- originalCalledPartyNumberModified (2), +-- genericNumbersModified (3), +-- redirectingPartyNumberModified (4), +-- redirectionCounterModified (5) +-- } + +ChangeOfClassmark ::= SEQUENCE +{ + classmark [0] Classmark, + changeTime [1] TimeStamp +} + +ChangeOfRadioChannel ::= SEQUENCE +{ + radioChannel [0] TrafficChannel, + changeTime [1] TimeStamp, + speechVersionUsed [2] SpeechVersionIdentifier OPTIONAL +} + +ChangeOfService ::= SEQUENCE +{ + basicService [0] BasicServiceCode, + transparencyInd [1] TransparencyInd OPTIONAL, + changeTime [2] TimeStamp, + rateIndication [3] RateIndication OPTIONAL, + fnur [4] Fnur OPTIONAL +} + +ChannelCoding ::= ENUMERATED +{ + tchF4800 (1), + tchF9600 (2), + tchF14400 (3) +} + +ChargeIndicator ::= ENUMERATED -- INTEGER +{ + noIndication (0), + noCharge (1), + charge (2) +} + +Classmark ::= OCTET STRING + -- + -- See Mobile station classmark 2 or 3 TS 24.008 + -- + +ConnectedNumber ::= BCDDirectoryNumber + +DataVolume ::= INTEGER + -- + -- The volume of data transferred in segments of 64 octets. + -- + +Day ::= INTEGER -- (1..31) + +--DayClass ::= ObjectInstance + +--DayClasses ::= SET OF DayClass + +--DayDefinition ::= SEQUENCE +--{ +-- day [0] DayOfTheWeek, +-- dayClass [1] ObjectInstance +--} + +--DayDefinitions ::= SET OF DayDefinition + +--DateDefinition ::= SEQUENCE +--{ +-- month [0] Month, +-- day [1] Day, +-- dayClass [2] ObjectInstance +--} + +--DateDefinitions ::= SET OF DateDefinition + +--DayOfTheWeek ::= ENUMERATED +--{ +-- allDays (0), +-- sunday (1), +-- monday (2), +-- tuesday (3), +-- wednesday (4), +-- thursday (5), +-- friday (6), +-- saturday (7) +--} + +DestinationRoutingAddress ::= BCDDirectoryNumber + +DefaultCallHandling ::= ENUMERATED +{ + continueCall (0), + releaseCall (1) +} + -- exception handling: + -- reception of values in range 2-31 shall be treated as "continueCall" + -- reception of values greater than 31 shall be treated as "releaseCall" + +DeferredLocationEventType ::= BIT STRING +-- { +-- msAvailable (0) +-- } (SIZE (1..16)) + + -- exception handling + -- a ProvideSubscriberLocation-Arg containing other values than listed above in + -- DeferredLocationEventType shall be rejected by the receiver with a return error cause of + -- unexpected data value. + +Diagnostics ::= CHOICE +{ + gsm0408Cause [0] INTEGER, + -- See TS 24.008 + gsm0902MapErrorValue [1] INTEGER, + -- Note: The value to be stored here corresponds to + -- the local values defined in the MAP-Errors and + -- MAP-DialogueInformation modules, for full details + -- see TS 29.002. + ccittQ767Cause [2] INTEGER, + -- See ITU-T Q.767 + networkSpecificCause [3] ManagementExtension, + -- To be defined by network operator + manufacturerSpecificCause [4] ManagementExtension + -- To be defined by manufacturer +} + +DefaultSMS-Handling ::= ENUMERATED +{ + continueTransaction (0) , + releaseTransaction (1) +} +-- exception handling: +-- reception of values in range 2-31 shall be treated as "continueTransaction" +-- reception of values greater than 31 shall be treated as "releaseTransaction" + +--Destinations ::= SET OF AE-title + +EmergencyCallIndEnable ::= BOOLEAN + +EmergencyCallIndication ::= SEQUENCE +{ + cellId [0] CellId, + callerId [1] IMSIorIMEI +} + +EParameter ::= INTEGER -- (0..1023) + -- + -- Coded according to TS 22.024 and TS 24.080 + -- + +EquipmentId ::= INTEGER + +Ext-GeographicalInformation ::= OCTET STRING -- (SIZE (1..maxExt-GeographicalInformation)) + -- Refers to geographical Information defined in 3G TS 23.032. + -- This is composed of 1 or more octets with an internal structure according to + -- 3G TS 23.032 + -- Octet 1: Type of shape, only the following shapes in 3G TS 23.032 are allowed: + -- (a) Ellipsoid point with uncertainty circle + -- (b) Ellipsoid point with uncertainty ellipse + -- (c) Ellipsoid point with altitude and uncertainty ellipsoid + -- (d) Ellipsoid Arc + -- (e) Ellipsoid Point + -- Any other value in octet 1 shall be treated as invalid + -- Octets 2 to 8 for case (a) - Ellipsoid point with uncertainty circle + -- Degrees of Latitude 3 octets + -- Degrees of Longitude 3 octets + -- Uncertainty code 1 octet + -- Octets 2 to 11 for case (b) - Ellipsoid point with uncertainty ellipse: + -- Degrees of Latitude 3 octets + -- Degrees of Longitude 3 octets + -- Uncertainty semi-major axis 1 octet + -- Uncertainty semi-minor axis 1 octet + -- Angle of major axis 1 octet + -- Confidence 1 octet + -- Octets 2 to 14 for case (c) - Ellipsoid point with altitude and uncertainty ellipsoid + -- Degrees of Latitude 3 octets + -- Degrees of Longitude 3 octets + -- Altitude 2 octets + -- Uncertainty semi-major axis 1 octet + -- Uncertainty semi-minor axis 1 octet + -- Angle of major axis 1 octet + -- Uncertainty altitude 1 octet + -- Confidence 1 octet + -- Octets 2 to 13 for case (d) - Ellipsoid Arc + -- Degrees of Latitude 3 octets + -- Degrees of Longitude 3 octets + -- Inner radius 2 octets + -- Uncertainty radius 1 octet + -- Offset angle 1 octet + -- Included angle 1 octet + -- Confidence 1 octet + -- Octets 2 to 7 for case (e) - Ellipsoid Point + -- Degrees of Latitude 3 octets + -- Degrees of Longitude 3 octets + -- + -- An Ext-GeographicalInformation parameter comprising more than one octet and + -- containing any other shape or an incorrect number of octets or coding according + -- to 3G TS 23.032 shall be treated as invalid data by a receiver. + -- + -- An Ext-GeographicalInformation parameter comprising one octet shall be discarded + -- by the receiver if an Add-GeographicalInformation parameter is received + -- in the same message. + -- + -- An Ext-GeographicalInformation parameter comprising one octet shall be treated as + -- invalid data by the receiver if an Add-GeographicalInformation parameter is not + -- received in the same message. + +-- maxExt-GeographicalInformation INTEGER ::= 20 + -- the maximum length allows for further shapes in 3G TS 23.032 to be included in later + -- versions of 3G TS 29.002 + +EquipmentType ::= ENUMERATED -- INTEGER +{ + conferenceBridge (0) +} + +FileType ::= ENUMERATED -- INTEGER +{ + callRecords (1), + traceRecords (9), + observedIMEITicket (14) +} + +Fnur ::= ENUMERATED +{ + -- + -- See Bearer Capability TS 24.008 + -- + fnurNotApplicable (0), + fnur9600-BitsPerSecond (1), + fnur14400BitsPerSecond (2), + fnur19200BitsPerSecond (3), + fnur28800BitsPerSecond (4), + fnur38400BitsPerSecond (5), + fnur48000BitsPerSecond (6), + fnur56000BitsPerSecond (7), + fnur64000BitsPerSecond (8), + fnur33600BitsPerSecond (9), + fnur32000BitsPerSecond (10), + fnur31200BitsPerSecond (11) +} + +ForwardToNumber ::= AddressString + +FreeFormatData ::= OCTET STRING -- (SIZE(1..160)) + -- + -- Free formated data as sent in the FCI message + -- See TS 29.078 + -- + +GenericNumber ::= BCDDirectoryNumber + +GenericNumbers ::= SET OF GenericNumber + +Gsm-SCFAddress ::= ISDNAddressString + -- + -- See TS 29.002 + -- + +HLRIntResult ::= Diagnostics + +Horizontal-Accuracy ::= OCTET STRING -- (SIZE (1)) + -- bit 8 = 0 + -- bits 7-1 = 7 bit Uncertainty Code defined in 3G TS 23.032. The horizontal location + -- error should be less than the error indicated by the uncertainty code with 67% + -- confidence. + +HotBillingTag ::= ENUMERATED --INTEGER +{ + noHotBilling (0), + hotBilling (1) +} + +HSCSDParmsChange ::= SEQUENCE +{ + changeTime [0] TimeStamp, + hSCSDChanAllocated [1] NumOfHSCSDChanAllocated, + initiatingParty [2] InitiatingParty OPTIONAL, + aiurRequested [3] AiurRequested OPTIONAL, + chanCodingUsed [4] ChannelCoding, + hSCSDChanRequested [5] NumOfHSCSDChanRequested OPTIONAL +} + + +IMEI ::= TBCD-STRING -- (SIZE (8)) + -- Refers to International Mobile Station Equipment Identity + -- and Software Version Number (SVN) defined in TS GSM 03.03. + -- If the SVN is not present the last octet shall contain the + -- digit 0 and a filler. + -- If present the SVN shall be included in the last octet. + +IMSI ::= TBCD-STRING -- (SIZE (3..8)) + -- digits of MCC, MNC, MSIN are concatenated in this order. + +IMEICheckEvent ::= ENUMERATED -- INTEGER +{ + mobileOriginatedCall (0), + mobileTerminatedCall (1), + smsMobileOriginating (2), + smsMobileTerminating (3), + ssAction (4), + locationUpdate (5) +} + +IMEIStatus ::= ENUMERATED +{ + greyListedMobileEquipment (0), + blackListedMobileEquipment (1), + nonWhiteListedMobileEquipment (2) +} + +IMSIorIMEI ::= CHOICE +{ + imsi [0] IMSI, + imei [1] IMEI +} + +InitiatingParty ::= ENUMERATED +{ + network (0), + subscriber (1) +} + +ISDN-AddressString ::= AddressString -- (SIZE (1..maxISDN-AddressLength)) + -- This type is used to represent ISDN numbers. + +-- maxISDN-AddressLength INTEGER ::= 9 + +LCSCause ::= OCTET STRING -- (SIZE(1)) + -- + -- See LCS Cause Value, 3GPP TS 49.031 + -- + +LCS-Priority ::= OCTET STRING -- (SIZE (1)) + -- 0 = highest priority + -- 1 = normal priority + -- all other values treated as 1 + +LCSClientIdentity ::= SEQUENCE +{ + lcsClientExternalID [0] LCSClientExternalID OPTIONAL, + lcsClientDialedByMS [1] AddressString OPTIONAL, + lcsClientInternalID [2] LCSClientInternalID OPTIONAL +} + +LCSClientExternalID ::= SEQUENCE +{ + externalAddress [0] AddressString OPTIONAL +-- extensionContainer [1] ExtensionContainer OPTIONAL +} + +LCSClientInternalID ::= ENUMERATED +{ + broadcastService (0), + o-andM-HPLMN (1), + o-andM-VPLMN (2), + anonymousLocation (3), + targetMSsubscribedService (4) +} + -- for a CAMEL phase 3 PLMN operator client, the value targetMSsubscribedService shall be used + +LCSClientType ::= ENUMERATED +{ + emergencyServices (0), + valueAddedServices (1), + plmnOperatorServices (2), + lawfulInterceptServices (3) +} + -- exception handling: + -- unrecognized values may be ignored if the LCS client uses the privacy override + -- otherwise, an unrecognized value shall be treated as unexpected data by a receiver + -- a return error shall then be returned if received in a MAP invoke + +LCSQoSInfo ::= SEQUENCE +{ + horizontal-accuracy [0] Horizontal-Accuracy OPTIONAL, + verticalCoordinateRequest [1] NULL OPTIONAL, + vertical-accuracy [2] Vertical-Accuracy OPTIONAL, + responseTime [3] ResponseTime OPTIONAL +} + +LevelOfCAMELService ::= BIT STRING +-- { +-- basic (0), +-- callDurationSupervision (1), +-- onlineCharging (2) +-- } + +LocationAreaAndCell ::= SEQUENCE +{ + locationAreaCode [0] LocationAreaCode, + cellIdentifier [1] CellId +-- +-- For 2G the content of the Cell Identifier is defined by the Cell Id +-- refer TS 24.008 and for 3G by the Service Area Code refer TS 25.413. +-- + +} + +LocationAreaCode ::= OCTET STRING -- (SIZE(2)) + -- + -- See TS 24.008 + -- + +LocationChange ::= SEQUENCE +{ + location [0] LocationAreaAndCell, + changeTime [1] TimeStamp +} + +Location-info ::= SEQUENCE +{ + mscNumber [1] MscNo OPTIONAL, + location-area [2] LocationAreaCode, + cell-identification [3] CellId OPTIONAL +} + +LocationType ::= SEQUENCE +{ +locationEstimateType [0] LocationEstimateType, + deferredLocationEventType [1] DeferredLocationEventType OPTIONAL +} + +LocationEstimateType ::= ENUMERATED +{ + currentLocation (0), + currentOrLastKnownLocation (1), + initialLocation (2), + activateDeferredLocation (3), + cancelDeferredLocation (4) +} + -- exception handling: + -- a ProvideSubscriberLocation-Arg containing an unrecognized LocationEstimateType + -- shall be rejected by the receiver with a return error cause of unexpected data value + +LocUpdResult ::= Diagnostics + +ManagementExtensions ::= SET OF ManagementExtension + +ManagementExtension ::= SEQUENCE +{ + identifier OBJECT IDENTIFIER, + significance [1] BOOLEAN , -- DEFAULT FALSE, + information [2] OCTET STRING +} + + +MCCMNC ::= OCTET STRING -- (SIZE(3)) + -- + -- This type contains the mobile country code (MCC) and the mobile + -- network code (MNC) of a PLMN. + -- + +RateIndication ::= OCTET STRING -- (SIZE(1)) + +--0 no rate adaption +--1 V.110, I.460/X.30 +--2 ITU-T X.31 flag stuffing +--3 V.120 +--7 H.223 & H.245 +--11 PIAFS + + +MessageReference ::= OCTET STRING + +Month ::= INTEGER -- (1..12) + +MOLR-Type ::= INTEGER +--0 locationEstimate +--1 assistanceData +--2 deCipheringKeys + +MSCAddress ::= AddressString + +MscNo ::= ISDN-AddressString + -- + -- See TS 23.003 + -- + +MSISDN ::= ISDN-AddressString + -- + -- See TS 23.003 + -- + +MSPowerClasses ::= SET OF RFPowerCapability + +NetworkCallReference ::= CallReferenceNumber + -- See TS 29.002 + -- + +NetworkSpecificCode ::= INTEGER + -- + -- To be defined by network operator + -- + +NetworkSpecificServices ::= SET OF NetworkSpecificCode + +NotificationToMSUser ::= ENUMERATED +{ + notifyLocationAllowed (0), + notifyAndVerify-LocationAllowedIfNoResponse (1), + notifyAndVerify-LocationNotAllowedIfNoResponse (2), + locationNotAllowed (3) +} + -- exception handling: + -- At reception of any other value than the ones listed the receiver shall ignore + -- NotificationToMSUser. + +NumberOfForwarding ::= INTEGER -- (1..5) + +NumOfHSCSDChanRequested ::= INTEGER + +NumOfHSCSDChanAllocated ::= INTEGER + +ObservedIMEITicketEnable ::= BOOLEAN + +OriginalCalledNumber ::= BCDDirectoryNumber + +OriginDestCombinations ::= SET OF OriginDestCombination + +OriginDestCombination ::= SEQUENCE +{ + origin [0] INTEGER OPTIONAL, + destination [1] INTEGER OPTIONAL + -- + -- Note that these values correspond to the contents + -- of the attributes originId and destinationId + -- respectively. At least one of the two must be present. + -- +} + +PartialRecordTimer ::= INTEGER + +PartialRecordType ::= ENUMERATED +{ + timeLimit (0), + serviceChange (1), + locationChange (2), + classmarkChange (3), + aocParmChange (4), + radioChannelChange (5), + hSCSDParmChange (6), + changeOfCAMELDestination (7), + firstHotBill (20), + severalSSOperationBill (21) +} + +PartialRecordTypes ::= SET OF PartialRecordType + +PositioningData ::= OCTET STRING -- (SIZE(1..33)) + -- + -- See Positioning Data IE (octet 3..n), 3GPP TS 49.031 + -- + +RadioChannelsRequested ::= SET OF RadioChanRequested + +RadioChanRequested ::= ENUMERATED +{ + -- + -- See Bearer Capability TS 24.008 + -- + halfRateChannel (0), + fullRateChannel (1), + dualHalfRatePreferred (2), + dualFullRatePreferred (3) +} + +--RecordClassDestination ::= CHOICE +--{ +-- osApplication [0] AE-title, +-- fileType [1] FileType +--} + +--RecordClassDestinations ::= SET OF RecordClassDestination + +RecordingEntity ::= AddressString + +RecordingMethod ::= ENUMERATED +{ + inCallRecord (0), + inSSRecord (1) +} + +RedirectingNumber ::= BCDDirectoryNumber + +RedirectingCounter ::= INTEGER + +ResponseTime ::= SEQUENCE +{ + responseTimeCategory ResponseTimeCategory +} + -- note: an expandable SEQUENCE simplifies later addition of a numeric response time. + +ResponseTimeCategory ::= ENUMERATED +{ + lowdelay (0), + delaytolerant (1) +} + -- exception handling: + -- an unrecognized value shall be treated the same as value 1 (delaytolerant) + +RFPowerCapability ::= INTEGER + -- + -- This field contains the RF power capability of the Mobile station + -- classmark 1 and 2 of TS 24.008 expressed as an integer. + -- + +RoamingNumber ::= ISDN-AddressString + -- + -- See TS 23.003 + -- + +RoutingNumber ::= CHOICE +{ + roaming [1] RoamingNumber, + forwarded [2] ForwardToNumber +} + +Service ::= CHOICE +{ + teleservice [1] TeleserviceCode, + bearerService [2] BearerServiceCode, + supplementaryService [3] SS-Code, + networkSpecificService [4] NetworkSpecificCode +} + +ServiceDistanceDependencies ::= SET OF ServiceDistanceDependency + +ServiceDistanceDependency ::= SEQUENCE +{ + aocService [0] INTEGER, + chargingZone [1] INTEGER OPTIONAL + -- + -- Note that these values correspond to the contents + -- of the attributes aocServiceId and zoneId + -- respectively. + -- +} + +ServiceKey ::= INTEGER -- (0..2147483647) + +SimpleIntegerName ::= INTEGER + +SimpleStringName ::= GraphicString + +SMSResult ::= Diagnostics + +SmsTpDestinationNumber ::= OCTET STRING + -- + -- This type contains the binary coded decimal representation of + -- the SMS address field the encoding of the octet string is in + -- accordance with the definition of address fields in TS 23.040. + -- This encoding includes type of number and numbering plan indication + -- together with the address value range. + -- + +SpeechVersionIdentifier ::= OCTET STRING -- (SIZE(1)) +-- see GSM 08.08 + +-- 000 0001 GSM speech full rate version 1 +-- 001 0001 GSM speech full rate version 2 used for enhanced full rate +-- 010 0001 GSM speech full rate version 3 for future use +-- 000 0101 GSM speech half rate version 1 +-- 001 0101 GSM speech half rate version 2 for future use +-- 010 0101 GSM speech half rate version 3 for future use + +SSActionResult ::= Diagnostics + +SSActionType ::= ENUMERATED +{ + registration (0), + erasure (1), + activation (2), + deactivation (3), + interrogation (4), + invocation (5), + passwordRegistration (6), + ussdInvocation (7) +} + +-- ussdInvocation (7) include ussd phase 1,phase 2 + +--SS Request = SSActionType + +SS-Code ::= OCTET STRING -- (SIZE (1)) + -- This type is used to represent the code identifying a single + -- supplementary service, a group of supplementary services, or + -- all supplementary services. The services and abbreviations + -- used are defined in TS 3GPP TS 22.004 [5]. The internal structure is + -- defined as follows: + -- + -- bits 87654321: group (bits 8765), and specific service + -- (bits 4321) ussd = ff + +-- allSS (0x00), +-- reserved for possible future use +-- all SS +-- +-- allLineIdentificationSS (0x10), +-- reserved for possible future use +-- all line identification SS +-- +-- calling-line-identification-presentation (0x11), +-- calling line identification presentation +-- calling-line-identification-restriction (0x12), +-- calling line identification restriction +-- connected-line-identification-presentation (0x13), +-- connected line identification presentation +-- connected-line-identification-restriction (0x14), +-- connected line identification restriction +-- malicious-call-identification (0x15), +-- reserved for possible future use +-- malicious call identification +-- +-- allNameIdentificationSS (0x18), +-- all name identification SS +-- calling-name-presentation (0x19), +-- calling name presentation +-- +-- SS-Codes '00011010'B, to '00011111'B, are reserved for future +-- NameIdentification Supplementary Service use. +-- +-- allForwardingSS (0x20), +-- all forwarding SS +-- call-forwarding-unconditional (0x21), +-- call forwarding unconditional +-- call-deflection (0x24), +-- call deflection +-- allCondForwardingSS (0x28), +-- all conditional forwarding SS +-- call-forwarding-on-mobile-subscriber-busy (0x29), +-- call forwarding on mobile subscriber busy +-- call-forwarding-on-no-reply (0x2a), +-- call forwarding on no reply +-- call-forwarding-on-mobile-subscriber-not-reachable (0x2b), +-- call forwarding on mobile subscriber not reachable +-- +-- allCallOfferingSS (0x30), +-- reserved for possible future use +-- all call offering SS includes also all forwarding SS +-- +-- explicit-call-transfer (0x31), +-- explicit call transfer +-- mobile-access-hunting (0x32), +-- reserved for possible future use +-- mobile access hunting +-- +-- allCallCompletionSS (0x40), +-- reserved for possible future use +-- all Call completion SS +-- +-- call-waiting (0x41), +-- call waiting +-- call-hold (0x42), +-- call hold +-- completion-of-call-to-busy-subscribers-originating-side (0x43), +-- completion of call to busy subscribers, originating side +-- completion-of-call-to-busy-subscribers-destination-side (0x44), +-- completion of call to busy subscribers, destination side +-- this SS-Code is used only in InsertSubscriberData and DeleteSubscriberData +-- +-- multicall (0x45), +-- multicall +-- +-- allMultiPartySS (0x50), +-- reserved for possible future use +-- all multiparty SS +-- +-- multiPTY (0x51), +-- multiparty +-- +-- allCommunityOfInterest-SS (0x60), +-- reserved for possible future use +-- all community of interest SS +-- closed-user-group (0x61), +-- closed user group +-- +-- allChargingSS (0x70), +-- reserved for possible future use +-- all charging SS +-- advice-of-charge-information (0x71), +-- advice of charge information +-- advice-of-charge-charging (0x72), +-- advice of charge charging +-- +-- allAdditionalInfoTransferSS (0x80), +-- reserved for possible future use +-- all additional information transfer SS +-- uUS1-user-to-user-signalling (0x81), +-- UUS1 user-to-user signalling +-- uUS2-user-to-user-signalling (0x82), +-- UUS2 user-to-user signalling +-- uUS3-user-to-user-signalling (0x83), +-- UUS3 user-to-user signalling +-- +-- allBarringSS (0x90), +-- all barring SS +-- barringOfOutgoingCalls (0x91), +-- barring of outgoing calls +-- barring-of-all-outgoing-calls (0x92), +-- barring of all outgoing calls +-- barring-of-outgoing-international-calls (0x93), +-- barring of outgoing international calls +-- boicExHC (0x94), +-- barring of outgoing international calls except those directed +-- to the home PLMN +-- barringOfIncomingCalls (0x99), +-- barring of incoming calls +-- barring-of-all-incoming-calls (0x9a), +-- barring of all incoming calls +-- barring-of-incoming-calls-when-roaming-outside-home-PLMN-Country (0x9b), +-- barring of incoming calls when roaming outside home PLMN +-- Country +-- +-- allCallPrioritySS (0xa0), +-- reserved for possible future use +-- all call priority SS +-- enhanced-Multilevel-Precedence-Pre-emption-EMLPP-service (0xa1), +-- enhanced Multilevel Precedence Pre-emption 'EMLPP) service +-- +-- allLCSPrivacyException (0xb0), +-- all LCS Privacy Exception Classes +-- universal (0xb1), +-- allow location by any LCS client +-- callrelated (0xb2), +-- allow location by any value added LCS client to which a call +-- is established from the target MS +-- callunrelated (0xb3), +-- allow location by designated external value added LCS clients +-- plmnoperator (0xb4), +-- allow location by designated PLMN operator LCS clients +-- +-- allMOLR-SS (0xc0), +-- all Mobile Originating Location Request Classes +-- basicSelfLocation (0xc1), +-- allow an MS to request its own location +-- autonomousSelfLocation (0xc2), +-- allow an MS to perform self location without interaction +-- with the PLMN for a predetermined period of time +-- transferToThirdParty (0xc3), +-- allow an MS to request transfer of its location to another LCS client +-- +-- allPLMN-specificSS (0xf0), +-- plmn-specificSS-1 (0xf1), +-- plmn-specificSS-2 (0xf2), +-- plmn-specificSS-3 (0xf3), +-- plmn-specificSS-4 (0xf4), +-- plmn-specificSS-5 (0xf5), +-- plmn-specificSS-6 (0xf6), +-- plmn-specificSS-7 (0xf7), +-- plmn-specificSS-8 (0xf8), +-- plmn-specificSS-9 (0xf9), +-- plmn-specificSS-A (0xfa), +-- plmn-specificSS-B (0xfb), +-- plmn-specificSS-C (0xfc), +-- plmn-specificSS-D (0xfd), +-- plmn-specificSS-E (0xfe), +-- ussd (0xff) + + +SSParameters ::= CHOICE +{ + forwardedToNumber [0] ForwardToNumber, + unstructuredData [1] OCTET STRING +} + +SupplServices ::= SET OF SS-Code + +SuppServiceUsed ::= SEQUENCE +{ + ssCode [0] SS-Code OPTIONAL, + ssTime [1] TimeStamp OPTIONAL +} + +SwitchoverTime ::= SEQUENCE +{ + hour INTEGER , -- (0..23), + minute INTEGER , -- (0..59), + second INTEGER -- (0..59) +} + +SystemType ::= ENUMERATED + -- "unknown" is not to be used in PS domain. +{ + unknown (0), + iuUTRAN (1), + gERAN (2) +} + +TBCD-STRING ::= OCTET STRING + -- This type (Telephony Binary Coded Decimal String) is used to + -- represent several digits from 0 through 9, *, #, a, b, c, two + -- digits per octet, each digit encoded 0000 to 1001 (0 to 9), + -- 1010 (*), 1011 (#), 1100 (a), 1101 (b) or 1110 (c); 1111 used + -- as filler when there is an odd number of digits. + + -- bits 8765 of octet n encoding digit 2n + -- bits 4321 of octet n encoding digit 2(n-1) +1 + +TariffId ::= INTEGER + +TariffPeriod ::= SEQUENCE +{ + switchoverTime [0] SwitchoverTime, + tariffId [1] INTEGER + -- Note that the value of tariffId corresponds + -- to the attribute tariffId. +} + +TariffPeriods ::= SET OF TariffPeriod + +TariffSystemStatus ::= ENUMERATED +{ + available (0), -- available for modification + checked (1), -- "frozen" and checked + standby (2), -- "frozen" awaiting activation + active (3) -- "frozen" and active +} + + +TimeStamp ::= OCTET STRING -- (SIZE(9)) + -- + -- The contents of this field are a compact form of the UTCTime format + -- containing local time plus an offset to universal time. Binary coded + -- decimal encoding is employed for the digits to reduce the storage and + -- transmission overhead + -- e.g. YYMMDDhhmmssShhmm + -- where + -- YY = Year 00 to 99 BCD encoded + -- MM = Month 01 to 12 BCD encoded + -- DD = Day 01 to 31 BCD encoded + -- hh = hour 00 to 23 BCD encoded + -- mm = minute 00 to 59 BCD encoded + -- ss = second 00 to 59 BCD encoded + -- S = Sign 0 = "+", "-" ASCII encoded + -- hh = hour 00 to 23 BCD encoded + -- mm = minute 00 to 59 BCD encoded + -- + +TrafficChannel ::= ENUMERATED +{ + fullRate (0), + halfRate (1) +} + +TranslatedNumber ::= BCDDirectoryNumber + +TransparencyInd ::= ENUMERATED +{ + transparent (0), + nonTransparent (1) +} + +ROUTE ::= CHOICE +{ + rOUTENumber [0] INTEGER, + rOUTEName [1] GraphicString +} + +--rOUTEName 1 10 octet + +TSChangeover ::= SEQUENCE +{ + newActiveTS [0] INTEGER, + newStandbyTS [1] INTEGER, +-- changeoverTime [2] GeneralizedTime OPTIONAL, + authkey [3] OCTET STRING OPTIONAL, + checksum [4] OCTET STRING OPTIONAL, + versionNumber [5] OCTET STRING OPTIONAL + -- Note that if the changeover time is not + -- specified then the change is immediate. +} + +TSCheckError ::= SEQUENCE +{ + errorId [0] TSCheckErrorId + --fail [1] ANY DEFINED BY errorId OPTIONAL +} + +TSCheckErrorId ::= CHOICE +{ + globalForm [0] OBJECT IDENTIFIER, + localForm [1] INTEGER +} + +TSCheckResult ::= CHOICE +{ + success [0] NULL, + fail [1] SET OF TSCheckError +} + +TSCopyTariffSystem ::= SEQUENCE +{ + oldTS [0] INTEGER, + newTS [1] INTEGER +} + +TSNextChange ::= CHOICE +{ + noChangeover [0] NULL, + tsChangeover [1] TSChangeover +} + +TypeOfSubscribers ::= ENUMERATED +{ + home (0), -- HPLMN subscribers + visiting (1), -- roaming subscribers + all (2) +} + +TypeOfTransaction ::= ENUMERATED +{ + successful (0), + unsuccessful (1), + all (2) +} + +Vertical-Accuracy ::= OCTET STRING -- (SIZE (1)) + -- bit 8 = 0 + -- bits 7-1 = 7 bit Vertical Uncertainty Code defined in 3G TS 23.032. + -- The vertical location error should be less than the error indicated + -- by the uncertainty code with 67% confidence. + +ISDNAddressString ::= AddressString + +EmlppPriority ::= OCTET STRING -- (SIZE (1)) + +--priorityLevelA EMLPP-Priority ::= 6 +--priorityLevelB EMLPP-Priority ::= 5 +--priorityLevel0 EMLPP-Priority ::= 0 +--priorityLevel1 EMLPP-Priority ::= 1 +--priorityLevel2 EMLPP-Priority ::= 2 +--priorityLevel3 EMLPP-Priority ::= 3 +--priorityLevel4 EMLPP-Priority ::= 4 +--See 29.002 + + +EASubscriberInfo ::= OCTET STRING -- (SIZE (3)) + -- The internal structure is defined by the Carrier Identification + -- parameter in ANSI T1.113.3. Carrier codes between "000" and "999" may + -- be encoded as 3 digits using "000" to "999" or as 4 digits using + -- "0000" to "0999". Carrier codes between "1000" and "9999" are encoded + -- using 4 digits. + +SelectedCIC ::= OCTET STRING -- (SIZE (3)) + +PortedFlag ::= ENUMERATED +{ + numberNotPorted (0), + numberPorted (1) +} + +SubscriberCategory ::= OCTET STRING -- (SIZE (1)) +-- unknownuser = 0x00, +-- frenchuser = 0x01, +-- englishuser = 0x02, +-- germanuser = 0x03, +-- russianuser = 0x04, +-- spanishuser = 0x05, +-- specialuser = 0x06, +-- reserveuser = 0x09, +-- commonuser = 0x0a, +-- superioruser = 0x0b, +-- datacalluser = 0x0c, +-- testcalluser = 0x0d, +-- spareuser = 0x0e, +-- payphoneuser = 0x0f, +-- coinuser = 0x20, +-- isup224 = 0xe0 + + +CUGOutgoingAccessIndicator ::= ENUMERATED +{ + notCUGCall (0), + cUGCall (1) +} + +CUGInterlockCode ::= OCTET STRING -- (SIZE (4)) + +-- + +CUGOutgoingAccessUsed ::= ENUMERATED +{ + callInTheSameCUGGroup (0), + callNotInTheSameCUGGroup (1) +} + +SMSTEXT ::= OCTET STRING + +MSCCIC ::= INTEGER -- (0..65535) + +RNCorBSCId ::= OCTET STRING -- (SIZE (3)) +--octet order is the same as RANAP/BSSAP signaling +--if spc is coded as 14bit, then OCTET STRING1 will filled with 00 ,for example rnc id = 123 will be coded as 00 01 23 +--OCTET STRING1 +--OCTET STRING2 +--OCTET STRING3 + +MSCId ::= OCTET STRING -- (SIZE (3)) +--National network format , octet order is the same as ISUP signaling +--if spc is coded as 14bit, then OCTET STRING1 will filled with 00,,for example rnc id = 123 will be coded as 00 01 23 +--OCTET STRING1 +--OCTET STRING2 +--OCTET STRING3 + +EmergencyCallFlag ::= ENUMERATED +{ + notEmergencyCall (0), + emergencyCall (1) +} + +CUGIncomingAccessUsed ::= ENUMERATED +{ + callInTheSameCUGGroup (0), + callNotInTheSameCUGGroup (1) +} + +SmsUserDataType ::= OCTET STRING -- (SIZE (1)) +-- +--00 concatenated-short-messages-8-bit-reference-number +--01 special-sms-message-indication +--02 reserved +--03 Value not used to avoid misinterpretation as <LF> +--04 characterapplication-port-addressing-scheme-8-bit-address +--05 application-port-addressing-scheme-16-bit-address +--06 smsc-control-parameters +--07 udh-source-indicator +--08 concatenated-short-message-16-bit-reference-number +--09 wireless-control-message-protocol +--0A text-formatting +--0B predefined-sound +--0C user-defined-sound-imelody-max-128-bytes +--0D predefined-animation +--0E large-animation-16-16-times-4-32-4-128-bytes +--0F small-animation-8-8-times-4-8-4-32-bytes +--10 large-picture-32-32-128-bytes +--11 small-picture-16-16-32-bytes +--12 variable-picture +--13 User prompt indicator +--14 Extended Object +--15 Reused Extended Object +--16 Compression Control +--17 Object Distribution Indicator +--18 Standard WVG object +--19 Character Size WVG object +--1A Extended Object Data Request Command +--1B-1F Reserved for future EMS features (see subclause 3.10) +--20 RFC 822 E-Mail Header +--21 Hyperlink format element +--22 Reply Address Element +--23 - 6F Reserved for future use +--70 - 7F (U)SIM Toolkit Security Headers +--80 - 9F SME to SME specific use +--A0 - BF Reserved for future use +--C0 - DF SC specific use +--E0 - FE Reserved for future use +--FF normal SMS + +ConcatenatedSMSReferenceNumber ::= INTEGER -- (0..65535) + +MaximumNumberOfSMSInTheConcatenatedSMS ::= INTEGER -- (0..255) + +SequenceNumberOfTheCurrentSMS ::= INTEGER -- (0..255) + +SequenceNumber ::= INTEGER + +--(1... ) +-- + +DisconnectParty ::= ENUMERATED +{ + callingPartyRelease (0), + calledPartyRelease (1), + networkRelease (2) +} + +ChargedParty ::= ENUMERATED +{ + callingParty (0), + calledParty (1) +} + +ChargeAreaCode ::= OCTET STRING -- (SIZE (1..3)) + +CUGIndex ::= OCTET STRING -- (SIZE (2)) + +GuaranteedBitRate ::= ENUMERATED +{ + gBR14400BitsPerSecond (1), -- BS20 non-transparent + gBR28800BitsPerSecond (2), -- BS20 non-transparent and transparent, + -- BS30 transparent and multimedia + gBR32000BitsPerSecond (3), -- BS30 multimedia + gBR33600BitsPerSecond (4), -- BS30 multimedia + gBR56000BitsPerSecond (5), -- BS30 transparent and multimedia + gBR57600BitsPerSecond (6), -- BS20 non-transparent + gBR64000BitsPerSecond (7), -- BS30 transparent and multimedia + + gBR12200BitsPerSecond (106), -- AMR speech + gBR10200BitsPerSecond (107), -- AMR speech + gBR7950BitsPerSecond (108), -- AMR speech + gBR7400BitsPerSecond (109), -- AMR speech + gBR6700BitsPerSecond (110), -- AMR speech + gBR5900BitsPerSecond (111), -- AMR speech + gBR5150BitsPerSecond (112), -- AMR speech + gBR4750BitsPerSecond (113) -- AMR speech +} + +MaximumBitRate ::= ENUMERATED +{ + mBR14400BitsPerSecond (1), -- BS20 non-transparent + mBR28800BitsPerSecond (2), -- BS20 non-transparent and transparent, + -- BS30 transparent and multimedia + mBR32000BitsPerSecond (3), -- BS30 multimedia + mBR33600BitsPerSecond (4), -- BS30 multimedia + mBR56000BitsPerSecond (5), -- BS30 transparent and multimedia + mBR57600BitsPerSecond (6), -- BS20 non-transparent + mBR64000BitsPerSecond (7), -- BS30 transparent and multimedia + + mBR12200BitsPerSecond (106), -- AMR speech + mBR10200BitsPerSecond (107), -- AMR speech + mBR7950BitsPerSecond (108), -- AMR speech + mBR7400BitsPerSecond (109), -- AMR speech + mBR6700BitsPerSecond (110), -- AMR speech + mBR5900BitsPerSecond (111), -- AMR speech + mBR5150BitsPerSecond (112), -- AMR speech + mBR4750BitsPerSecond (113) -- AMR speech +} + + +HLC ::= OCTET STRING + +-- this parameter is a 1:1 copy of the contents (i.e. starting with octet 3) of the "high layer compatibility" parameter of ITU-T Q.931 [35]. + +LLC ::= OCTET STRING + +-- this parameter is a 1:1 copy of the contents (i.e. starting with octet 3) of the "low layer compatibility" parameter of ITU-T Q.931 [35]. + + +ISDN-BC ::= OCTET STRING + +-- this parameter is a 1:1 copy of the contents (i.e. starting with octet 3) of the "bearer capability" parameter of ITU-T Q.931 [35]. + +ModemType ::= ENUMERATED +{ + none-modem (0), + modem-v21 (1), + modem-v22 (2), + modem-v22-bis (3), + modem-v23 (4), + modem-v26-ter (5), + modem-v32 (6), + modem-undef-interface (7), + modem-autobauding1 (8), + no-other-modem-type (31), + modem-v34 (33) +} + +UssdCodingScheme ::= OCTET STRING + +UssdString ::= OCTET STRING + +UssdNotifyCounter ::= INTEGER -- (0..255) + +UssdRequestCounter ::= INTEGER -- (0..255) + +Classmark3 ::= OCTET STRING -- (SIZE(2)) + +OptimalRoutingDestAddress ::= BCDDirectoryNumber + +GAI ::= OCTET STRING -- (SIZE(7)) +--such as 64 F0 00 00 ABCD 1234 + +ChangeOfglobalAreaID ::= SEQUENCE +{ + location [0] GAI, + changeTime [1] TimeStamp +} + +InteractionWithIP ::= NULL + +RouteAttribute ::= ENUMERATED +{ + cas (0), + tup (1), + isup (2), + pra (3), + bicc (4), + sip (5), + others (255) +} + +VoiceIndicator ::= ENUMERATED +{ + sendToneByLocalMsc (0) , + sendToneByOtherMsc (1), + voiceNoIndication (3) +} + +BCategory ::= ENUMERATED +{ + subscriberFree (0), + subscriberBusy (1), + subscriberNoIndication (3) +} + +CallType ::= ENUMERATED +{ + unknown (0), + internal (1), + incoming (2), + outgoing (3), + tandem (4) +} + +-- END +END +} + +1; + diff --git a/FS/FS/cdr/netsapiens.pm b/FS/FS/cdr/netsapiens.pm new file mode 100644 index 000000000..bcaa3496d --- /dev/null +++ b/FS/FS/cdr/netsapiens.pm @@ -0,0 +1,50 @@ +package FS::cdr::netsapiens; + +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' => 'NetSapiens', + 'weight' => 160, + '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 + + 'import_fields' => [ + + sub { my ($cdr, $direction) = @_; + if ($direction =~ /^o/) { # 'origination' + # leave src and dst as they are + } elsif ($direction =~ /^t/) { + my ($local, $remote) = ($cdr->src, $cdr->dst); + $cdr->set('dst', $local); + $cdr->set('src', $remote); + } + }, + '', #Domain + '', #user + 'src', #local party (src/dst, based on direction) + _cdr_date_parser_maker('startddate'), + _cdr_date_parser_maker('answerdate'), + sub { my ($cdr, $duration) = @_; + $cdr->set('duration', $duration); + $cdr->set('billsec', $duration); + $cdr->set('enddate', $duration + $cdr->answerdate) + if $cdr->answerdate; + }, + 'dst', #remote party + '', #dialed number + 'uniqueid', #CallID (timestamp + '-' + 32 char hex string) + 'src_ip_addr', + 'dst_ip_addr', + 'disposition', + ], + +); + +1; + diff --git a/FS/FS/cdr/taqua62.pm b/FS/FS/cdr/taqua62.pm index 862018e9c..aa9463008 100644 --- a/FS/FS/cdr/taqua62.pm +++ b/FS/FS/cdr/taqua62.pm @@ -20,7 +20,9 @@ use FS::cdr qw(_cdr_date_parser_maker); my($cdr, $field, $conf, $hashref) = @_; $hashref->{skiprow} = 1 unless ($field == 0 && $cdr->disposition == 100 ) #regular CDR - || ($field == 1 && $cdr->lastapp eq 'acctcode'); #accountcode + || ($field == 1 && $cdr->lastapp eq 'acctcode') #accountcode + || ($field == 1 && $cdr->lastapp eq 'CallerId') #CID blocking + ; $cdr->cdrtypenum($field); }, diff --git a/FS/FS/cdr/telstra.pm b/FS/FS/cdr/telstra.pm index 9e644dbc8..603d5c40b 100644 --- a/FS/FS/cdr/telstra.pm +++ b/FS/FS/cdr/telstra.pm @@ -19,7 +19,7 @@ my %cdr_type_of = ( %info = ( 'name' => 'Telstra LinxOnline', - 'weight' => 20, + 'weight' => 215, 'header' => 1, 'type' => 'fixedlength', # Wholesale Usage Information Record format diff --git a/FS/FS/cdr/troop2.pm b/FS/FS/cdr/troop2.pm index ee6474061..17a8b2a4a 100644 --- a/FS/FS/cdr/troop2.pm +++ b/FS/FS/cdr/troop2.pm @@ -2,11 +2,12 @@ package FS::cdr::troop2; use strict; use base qw( FS::cdr ); -use vars qw( %info $tmp_date $tmp_src_city $tmp_dst_city ); -use Date::Parse; -#use Time::Local; +use vars qw( %info $tmp_mon $tmp_mday $tmp_year $tmp_src_city $tmp_dst_city ); +use Time::Local; ##use FS::cdr qw( _cdr_date_parser_maker _cdr_min_parser_maker ); +use Data::Dumper; + %info = ( 'name' => 'Troop', 'weight' => 219, @@ -17,16 +18,27 @@ use Date::Parse; 'userfield', #account_num (userfield?) + # XXX false laziness w/bell_west.pm #call_date sub { my($cdr, $date) = @_; - #is this an excel date? or just text? - $tmp_date = $date; + + my $datetime = DateTime::Format::Excel->parse_datetime( $date ); + $tmp_mon = $datetime->mon_0; + $tmp_mday = $datetime->mday; + $tmp_year = $datetime->year; }, #call_time sub { my($cdr, $time) = @_; - #is this an excel time? or just text? - $cdr->startdate( str2time("$tmp_date $time") ); + #my($sec, $min, $hour, $mday, $mon, $year)= localtime($cdr->startdate); + + #$sec = $time * 86400; + my $sec = int( $time * 86400 + .5); + + #$cdr->startdate( timelocal($3, $2, $1 ,$mday, $mon, $year) ); + $cdr->startdate( + timelocal(0, 0, 0, $tmp_mday, $tmp_mon, $tmp_year) + $sec + ); }, 'src', #orig_tn diff --git a/FS/FS/cdr/u4.pm b/FS/FS/cdr/u4.pm new file mode 100644 index 000000000..1b7a660e7 --- /dev/null +++ b/FS/FS/cdr/u4.pm @@ -0,0 +1,104 @@ +package FS::cdr::u4; + +use strict; +use vars qw(@ISA %info); +use FS::cdr qw(_cdr_date_parser_maker); + +@ISA = qw(FS::cdr); + +%info = ( + 'name' => 'U4', + 'weight' => 490, + 'type' => 'fixedlength', + 'fixedlength_format' => [qw( + CDRType:3:1:3 + MasterAccountID:12:4:15 + SubAccountID:12:16:27 + BillToNumber:18:28:45 + AccountCode:12:46:57 + CallDateStartTime:14:58:71 + TimeOfDay:1:72:72 + CalculatedSeconds:12:73:84 + City:30:85:114 + State:2:115:116 + Country:40:117:156 + Charges:21:157:177 + CallDirection:1:178:178 + CallIndicator:1:179:179 + ReportIndicator:1:180:180 + ANI:10:181:190 + DNIS:10:191:200 + PIN:16:201:216 + OrigNumber:10:217:226 + TermNumber:10:227:236 + DialedNumber:18:237:254 + DisplayNumber:18:255:272 + RecordSource:1:273:273 + LECInfoDigits:2:274:275 + OrigNPA:4:276:279 + OrigNXX:5:280:284 + OrigLATA:3:285:287 + OrigZone:1:288:288 + OrigCircuit:12:289:300 + OrigTrunkGroupCLLI:12:301:312 + TermNPA:4:313:316 + TermNXX:5:317:321 + TermLATA:3:322:324 + TermZone:1:325:325 + TermCircuit:12:326:337 + TermTrunkGroupCLLI:12:338:349 + TermOCN:5:350:354 + )], + # at least that's how they're defined in the spec we have. + # the real CDRs have several differences. + 'import_fields' => [ + '', #CDRType (for now always 'V') + '', #MasterAccountID + '', #SubAccountID + 'charged_party', #BillToNumber + 'accountcode', #AccountCode + _cdr_date_parser_maker('startdate'), + #CallDateTime + '', #TimeOfDay (always 'S') + sub { #CalculatedSeconds + my($cdr, $sec) = @_; + $cdr->duration($sec); + $cdr->billsec($sec); + }, + '', #City + '', #State + '', #Country + 'upstream_price', #Charges + sub { #CallDirection + my ($cdr, $dir) = @_; + $cdr->set('direction', $dir); + if ( $dir eq 'O' ) { + $cdr->set('src', $cdr->charged_party); + } elsif ( $dir eq 'I' ) { + $cdr->set('dst', $cdr->charged_party); + } + }, + '', #CallIndicator #calltype? + '', #ReportIndicator + sub { #ANI + # it appears that it's the "other" number, not necessarily ANI. + my ($cdr, $number) = @_; + if ( $cdr->direction eq 'O' ) { + $cdr->set('dst', $number); + } elsif ( $cdr->direction eq 'I' ) { + $cdr->set('src', $number); + } + }, + '', #DNIS + '', #PIN + '', #OrigNumber + '', #TermNumber + '', #DialedNumber + '', #DisplayNumber + '', #RecordSource + '', #LECInfoDigits + ('') x 13, + ], +); + +1; diff --git a/FS/FS/cdr/windstream.pm b/FS/FS/cdr/windstream.pm new file mode 100644 index 000000000..a6200b2cd --- /dev/null +++ b/FS/FS/cdr/windstream.pm @@ -0,0 +1,77 @@ +package FS::cdr::windstream; + +use strict; +use vars qw( @ISA %info %calltypes ); +use FS::cdr qw(_cdr_date_parser_maker); + +@ISA = qw(FS::cdr); + +%calltypes = ( + # numbers are arbitrary + 'IntraLata Calling' => 1 , + 'Intrastate Calling' => 2 , + 'Interstate Calling' => 3 , + 'International Calling' => 4 , + 'Intrastate Toll Free' => 5 , + 'Interstate Toll Free' => 6 , + 'Toll Free Canada' => 7 , + 'Toll Free NANP' => 8 , + 'IntraLata Directory Assistance' => 9 , + 'LD Directory Assistance' => 10 , + 'Message Local Usage' => 11 , + 'Operator Assistance' => 12 , + 'Operator Services' => 13 , + 'O- Assistance (Minus)' => 14 , + 'O+ Assistance (Plus)' => 15 , + 'IntraLata Toll 3rd Party' => 16 , + 'IntraLata Toll Collect' => 17 , + 'Third Number Billing' => 18 , + 'Third Number Billing - Assisted' => 19 , + 'Three Way Calling (per use)' => 20 , + 'Busy Connect (per use)' => 21 , + 'Busy Line Interrupt (per use)' => 22 , + 'Busy Line Verification (per use)' => 23 , + 'Call Forwarding Variable per access' => 24 , + 'Call Return (*69 per use)' => 25 , + 'Call Trace (*per use)' => 26 , + 'Conference Calling Feature' => 27 , + 'Directory Assistance Call Completion (per use)' => 28 , +); + +$_ = lc($_) for keys(%calltypes); + +%info = ( + 'name' => 'Windstream', + 'weight' => 520, + 'header' => 0, + 'sep_char' => "\t", + 'import_fields' => [ + + 'accountcode', # Account Number + 'uniqueid', # Reference Number + '', # Call Type (see Service Type below) + _cdr_date_parser_maker('answerdate'), # Answer Date + '', # Account Code--unused? + '', # CPN_DID + 'src', # From Number + 'upstream_src_regionname', # From Location + '', # From Country + 'dst', # To Number + 'upstream_dst_regionname', # To Location + '', # To Country Code + '', # Units + 'upstream_price', # Amount + sub { # Service Type + my ($cdr, $field) = @_; + $cdr->calltypenum($calltypes{$field} || '') + }, + '', # Payphone Indicator + sub { # TF Service Number + # replace the To Number with this, if there is one + my ($cdr, $field) = @_; + $cdr->dst($field) if ( $field ); + }, + ], +); + +1; diff --git a/FS/FS/cdr_cust_pkg_usage.pm b/FS/FS/cdr_cust_pkg_usage.pm new file mode 100644 index 000000000..6ef7f2dea --- /dev/null +++ b/FS/FS/cdr_cust_pkg_usage.pm @@ -0,0 +1,124 @@ +package FS::cdr_cust_pkg_usage; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::cdr_cust_pkg_usage - Object methods for cdr_cust_pkg_usage records + +=head1 SYNOPSIS + + use FS::cdr_cust_pkg_usage; + + $record = new FS::cdr_cust_pkg_usage \%hash; + $record = new FS::cdr_cust_pkg_usage { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cdr_cust_pkg_usage object represents an allocation of included +usage minutes to a call. FS::cdr_cust_pkg_usage inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item cdrusagenum - primary key + +=item acctid - foreign key to cdr.acctid + +=item pkgusagenum - foreign key to cust_pkg_usage.pkgusagenum + +=item minutes - the number of minutes allocated + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new example. To add the example to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'cdr_cust_pkg_usage'; } + +=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 example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('cdrusagenum') + || $self->ut_foreign_key('acctid', 'cdr', 'acctid') + || $self->ut_foreign_key('pkgusagenum', 'cust_pkg_usage', 'pkgusagenum') + || $self->ut_number('minutes') + ; + return $error if $error; + + $self->SUPER::check; +} + +=item cust_pkg_usage + +Returns the L<FS::cust_pkg_usage> object that this usage allocation came from. + +=item cdr + +Returns the L<FS::cdr> object that the usage was applied to. + +=cut + +sub cust_pkg_usage { + FS::cust_pkg_usage->by_key($_[0]->pkgusagenum); +} + +sub cdr { + FS::cdr->by_key($_[0]->acctid); +} + +=back + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/contact.pm b/FS/FS/contact.pm index f84af425b..8fcd724a0 100644 --- a/FS/FS/contact.pm +++ b/FS/FS/contact.pm @@ -326,8 +326,8 @@ sub check { || $self->ut_foreign_keyn('custnum', 'cust_main', 'custnum') || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum') || $self->ut_foreign_keyn('classnum', 'contact_class', 'classnum') - || $self->ut_textn('last') - || $self->ut_textn('first') + || $self->ut_namen('last') + || $self->ut_namen('first') || $self->ut_textn('title') || $self->ut_textn('comment') || $self->ut_enum('disabled', [ '', 'Y' ]) diff --git a/FS/FS/contact_Mixin.pm b/FS/FS/contact_Mixin.pm new file mode 100644 index 000000000..6e8f315b9 --- /dev/null +++ b/FS/FS/contact_Mixin.pm @@ -0,0 +1,19 @@ +package FS::contact_Mixin; + +use strict; +use FS::Record qw( qsearchs ); +use FS::contact; + +=item contact_obj + +Returns the contact object, if any (see L<FS::contact>). + +=cut + +sub contact_obj { + my $self = shift; + return '' unless $self->contactnum; + qsearchs( 'contact', { 'contactnum' => $self->contactnum } ); +} + +1; diff --git a/FS/FS/currency_exchange.pm b/FS/FS/currency_exchange.pm new file mode 100644 index 000000000..68832b62d --- /dev/null +++ b/FS/FS/currency_exchange.pm @@ -0,0 +1,116 @@ +package FS::currency_exchange; +use base qw( FS::Record ); + +use strict; +#use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::currency_exchange - Object methods for currency_exchange records + +=head1 SYNOPSIS + + use FS::currency_exchange; + + $record = new FS::currency_exchange \%hash; + $record = new FS::currency_exchange { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::currency_exchange object represents an exchange rate between currencies. +FS::currency_exchange inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item currencyratenum + +primary key + +=item from_currency + +from_currency + +=item to_currency + +to_currency + +=item rate + +rate + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new exchange rate. To add the exchange rate 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 { 'currency_exchange'; } + +=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 exchange rate. 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('currencyratenum') + || $self->ut_currency('from_currency') + || $self->ut_currency('to_currency') + || $self->ut_float('rate') #good enough for untainting + ; + 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_bill.pm b/FS/FS/cust_bill.pm index c48c80627..fc6a7ddbe 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -6,7 +6,7 @@ use vars qw( $DEBUG $me $date_format ); # but NOT $conf use Fcntl qw(:flock); #for spool_csv use Cwd; -use List::Util qw(min max); +use List::Util qw(min max sum); use Date::Format; use File::Temp 0.14; use HTML::Entities; @@ -110,9 +110,11 @@ Customer info at invoice generation time =over 4 -=item previous_balance +=item billing_balance - the customer's balance at the time the invoice was +generated (not including charges on this invoice) -=item billing_balance +=item previous_balance - the billing_balance of this customer's previous +invoice plus the charges on that invoice =back @@ -1330,6 +1332,8 @@ 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) +I<lpr>, if specified, is passed to + =cut sub queueable_send { @@ -1354,6 +1358,7 @@ sub send { my( $template, $invoice_from, $notice_name ); my $agentnums = ''; my $balance_over = 0; + my $lpr = ''; if ( ref($_[0]) ) { my $opt = shift; @@ -1364,6 +1369,7 @@ sub send { $invoice_from = $opt->{'invoice_from'}; $balance_over = $opt->{'balance_over'} if $opt->{'balance_over'}; $notice_name = $opt->{'notice_name'}; + $lpr = $opt->{'lpr'} } else { $template = scalar(@_) ? shift : ''; if ( scalar(@_) && $_[0] ) { @@ -1397,10 +1403,12 @@ sub send { if ( grep { $_ !~ /^(POST|FAX)$/ } @invoicing_list or !@invoicing_list ) && ! $self->invoice_noemail; + $opt{'lpr'} = $lpr; #$self->print_invoice(\%opt) $self->print(\%opt) if grep { $_ eq 'POST' } @invoicing_list; #postal + #this has never been used post-$ORIGINAL_ISP afaik $self->fax_invoice(\%opt) if grep { $_ eq 'FAX' } @invoicing_list; #fax @@ -1564,14 +1572,16 @@ sub print { return if $self->hide; my $conf = $self->conf; - my( $template, $notice_name ); + my( $template, $notice_name, $lpr ); if ( ref($_[0]) ) { my $opt = shift; $template = $opt->{'template'} || ''; $notice_name = $opt->{'notice_name'} || 'Invoice'; + $lpr = $opt->{'lpr'} } else { $template = scalar(@_) ? shift : ''; $notice_name = 'Invoice'; + $lpr = ''; } my %opt = ( @@ -1584,7 +1594,11 @@ sub print { $self->batch_invoice(\%opt); } else { - do_print $self->lpr_data(\%opt); + do_print( + $self->lpr_data(\%opt), + 'agentnum' => $self->cust_main->agentnum, + 'lpr' => $lpr, + ); } } @@ -1819,13 +1833,16 @@ L<FS::cust_main_invoice>). =item agent_spools - if set to a true value, will spool to per-agent files rather than a single global file -=item ftp_targetnum - if set to an FTP target (see L<FS::ftp_target>), will +=item upload_targetnum - if set to a target (see L<FS::upload_target>), will append to that spool. L<FS::Cron::upload> will then send the spool file to that destination. =item balanceover - if set, only spools the invoice if the total amount owed on this invoice and all older invoices is greater than the specified amount. +=item time - the "current time". Controls the printing of past due messages +in the ICS format. + =back =cut @@ -1833,6 +1850,7 @@ this invoice and all older invoices is greater than the specified amount. sub spool_csv { my($self, %opt) = @_; + my $time = $opt{'time'} || time; my $cust_main = $self->cust_main; if ( $opt{'dest'} ) { @@ -1850,7 +1868,7 @@ sub spool_csv { my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/cust_bill"; mkdir $spooldir, 0700 unless -d $spooldir; - my $tracctnum = $self->invnum. time2str('-%Y%m%d%H%M%S', time); + my $tracctnum = $self->invnum. time2str('-%Y%m%d%H%M%S', $time); my $file; if ( $opt{'agent_spools'} ) { @@ -1859,8 +1877,8 @@ sub spool_csv { $file = 'spool'; } - if ( $opt{'ftp_targetnum'} ) { - $spooldir .= '/target'.$opt{'ftp_targetnum'}; + if ( $opt{'upload_targetnum'} ) { + $spooldir .= '/target'.$opt{'upload_targetnum'}; mkdir $spooldir, 0700 unless -d $spooldir; } # otherwise it just goes into export.xxx/cust_bill @@ -1870,7 +1888,7 @@ sub spool_csv { $file = "$spooldir/$file.csv"; - my ( $header, $detail ) = $self->print_csv(%opt, 'tracctnum' => $tracctnum ); + my ( $header, $detail ) = $self->print_csv(%opt, 'tracctnum' => $tracctnum); open(CSV, ">>$file") or die "can't open $file: $!"; flock(CSV, LOCK_EX); @@ -1890,7 +1908,7 @@ sub spool_csv { seek(CSV, 0, 2); } - print CSV $detail; + print CSV $detail if defined($detail); flock(CSV, LOCK_UN); close CSV; @@ -2025,7 +2043,7 @@ header line only, with the fields: Agent number, agent name, customer number, first name, last name, address line 1, address line 2, city, state, zip, invoice date, invoice number, -amount charged, amount due, +amount charged, amount due, previous balance, due date. and then, for each line item, three columns containing the package number, description, and amount. @@ -2051,8 +2069,11 @@ sub print_csv { my $cust_main = $self->cust_main; my $csv = Text::CSV_XS->new({'always_quote'=>1}); + my $format = lc($opt{'format'}); - if ( lc($opt{'format'}) eq 'billco' ) { + my $time = $opt{'time'} || time; + + if ( $format eq 'billco' ) { my $taxtotal = 0; $taxtotal += $_->{'amount'} foreach $self->_items_tax; @@ -2105,15 +2126,19 @@ sub print_csv { '0', # 29 | Other Taxes & Fees*** NUM* 9 ); - } elsif ( lc($opt{'format'}) eq 'oneline' ) { #name? + } elsif ( $format eq 'oneline' ) { #name my ($previous_balance) = $self->previous; + $previous_balance = sprintf('%.2f', $previous_balance); my $totaldue = sprintf('%.2f', $self->owed + $previous_balance); my @items = map { - ($_->{pkgnum} || ''), - $_->{description}, - $_->{amount} - } $self->_items_pkg; + $_->{pkgnum}, + $_->{description}, + $_->{amount} + } + $self->_items_pkg, #_items_nontax? no sections or anything + # with this format + $self->_items_tax; $csv->combine( $cust_main->agentnum, @@ -2121,6 +2146,7 @@ sub print_csv { $self->custnum, $cust_main->first, $cust_main->last, + $cust_main->company, $cust_main->address1, $cust_main->address2, $cust_main->city, @@ -2132,14 +2158,16 @@ sub print_csv { $self->invnum, $self->charged, $totaldue, + $previous_balance, + $self->due_date2str("%x"), @items, ); - } elsif ( lc($opt{'format'}) eq 'bridgestone' ) { + } elsif ( $format eq 'bridgestone' ) { # bypass the CSV stuff and just return this - my $longdate = time2str('%B %d, %Y', time); #current time, right? + my $longdate = time2str('%B %d, %Y', $time); #current time, right? my $zip = $cust_main->zip; $zip =~ s/\D//; my $prefix = $self->conf->config('bridgestone-prefix', $cust_main->agentnum) @@ -2161,7 +2189,121 @@ sub print_csv { '' #detail ); - } else { + } elsif ( $format eq 'ics' ) { + + my $bill = $cust_main->bill_location; + my $zip = $bill->zip; + my $zip4 = ''; + + $zip =~ s/\D//; + if ( $zip =~ /^(\d{5})(\d{4})$/ ) { + $zip = $1; + $zip4 = $2; + } + + # minor false laziness with print_generic + my ($previous_balance) = $self->previous; + my $balance_due = $self->owed + $previous_balance; + my $payment_total = sum(0, map { $_->{'amount'} } $self->_items_payments); + my $credit_total = sum(0, map { $_->{'amount'} } $self->_items_credits); + + my $past_due = ''; + if ( $self->due_date and $time >= $self->due_date ) { + $past_due = sprintf('Past due:$%0.2f Due Immediately', $balance_due); + } + + # again, bypass CSV + my $header = sprintf( + '%-10s%-30s%-48s%-2s%-50s%-30s%-30s%-25s%-2s%-5s%-4s%-8s%-8s%-10s%-10s%-10s%-10s%-10s%-10s%-480s%-35s', + $cust_main->display_custnum, #BID + uc($cust_main->first), #FNAME + uc($cust_main->last), #LNAME + '00', #BATCH, should this ever be anything else? + uc($cust_main->company), #COMP + uc($bill->address1), #STREET1 + uc($bill->address2), #STREET2 + uc($bill->city), #CITY + uc($bill->state), #STATE + $zip, + $zip4, + time2str('%Y%m%d', $self->_date), #BILL_DATE + $self->due_date2str('%Y%m%d'), #DUE_DATE, + ( map {sprintf('%0.2f', $_)} + $balance_due, #AMNT_DUE + $previous_balance, #PREV_BAL + $payment_total, #PYMT_RCVD + $credit_total, #CREDITS + $previous_balance, #BEG_BAL--is this correct? + $self->charged, #NEW_CHRG + ), + 'img01', #MRKT_MSG? + $past_due, #PAST_MSG + ); + + my @details; + my %svc_class = ('' => ''); # maybe cache this more persistently? + + foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) { + + my $show_pkgnum = $cust_bill_pkg->pkgnum || ''; + my $cust_pkg = $cust_bill_pkg->cust_pkg if $show_pkgnum; + + if ( $cust_pkg ) { + + my @dates = ( $self->_date, undef ); + if ( my $prev = $cust_bill_pkg->previous_cust_bill_pkg ) { + $dates[1] = $prev->sdate; #questionable + } + + # generate an 01 detail for each service + my @svcs = $cust_pkg->h_cust_svc(@dates, 'I'); + foreach my $cust_svc ( @svcs ) { + $show_pkgnum = ''; # hide it if we're showing svcnums + + my $svcpart = $cust_svc->svcpart; + if (!exists($svc_class{$svcpart})) { + my $classnum = $cust_svc->part_svc->classnum; + my $part_svc_class = FS::part_svc_class->by_key($classnum) + if $classnum; + $svc_class{$svcpart} = $part_svc_class ? + $part_svc_class->classname : + ''; + } + + my @h_label = $cust_svc->label(@dates, 'I'); + push @details, sprintf('01%-9s%-20s%-47s', + $cust_svc->svcnum, + $svc_class{$svcpart}, + $h_label[1], + ); + } #foreach $cust_svc + } #if $cust_pkg + + my $desc = $cust_bill_pkg->desc; # itemdesc or part_pkg.pkg + if ($cust_bill_pkg->recur > 0) { + $desc .= ' '.time2str('%d-%b-%Y', $cust_bill_pkg->sdate).' to '. + time2str('%d-%b-%Y', $cust_bill_pkg->edate - 86400); + } + push @details, sprintf('02%-6s%-60s%-10s', + $show_pkgnum, + $desc, + sprintf('%0.2f', $cust_bill_pkg->setup + $cust_bill_pkg->recur), + ); + } #foreach $cust_bill_pkg + + # Tag this row so that we know whether this is one page (1), two pages + # (2), # or "big" (B). The tag will be stripped off before uploading. + if ( scalar(@details) < 12 ) { + push @details, '1'; + } elsif ( scalar(@details) < 58 ) { + push @details, '2'; + } else { + push @details, 'B'; + } + + return join('', $header, @details, "\n"); + + } else { # default $csv->combine( 'cust_bill', @@ -2998,11 +3140,16 @@ sub _items_payments { #something more elaborate if $_->amount ne ->cust_pay->paid ? + my $desc = $self->mt('Payment received').' '. + time2str($date_format,$_->cust_pay->_date ); + $desc .= $self->mt(' via ' . $_->cust_pay->payby_payinfo_pretty) + if ( $self->conf->exists('invoice_payment_details') ); + push @b, { - 'description' => $self->mt('Payment received').' '. - time2str($date_format,$_->cust_pay->_date ), + 'description' => $desc, 'amount' => sprintf("%.2f", $_->amount ) }; + } @b; @@ -3305,6 +3452,15 @@ sub search_sql_where { push @search, "cust_bill.custnum = $1"; } + #customer classnum + if ( $param->{'cust_classnum'} ) { + my $classnums = $param->{'cust_classnum'}; + $classnums = [ $classnums ] if !ref($classnums); + $classnums = [ grep /^\d+$/, @$classnums ]; + push @search, 'cust_main.classnum in ('.join(',',@$classnums).')' + if @$classnums; + } + #_date if ( $param->{_date} ) { my($beginning, $ending) = @{$param->{_date}}; diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index 20c8e5a55..572fe7973 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -201,16 +201,50 @@ sub insert { my $tax_location = $self->get('cust_bill_pkg_tax_location'); if ( $tax_location ) { - foreach my $cust_bill_pkg_tax_location ( @$tax_location ) { - $cust_bill_pkg_tax_location->billpkgnum($self->billpkgnum); - $error = $cust_bill_pkg_tax_location->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error inserting cust_bill_pkg_tax_location: $error"; + foreach my $link ( @$tax_location ) { + next if $link->billpkgtaxlocationnum; # don't try to double-insert + # This cust_bill_pkg can be linked on either side (i.e. it can be the + # tax or the taxed item). If the other side is already inserted, + # then set billpkgnum to ours, and insert the link. Otherwise, + # set billpkgnum to ours and pass the link off to the cust_bill_pkg + # on the other side, to be inserted later. + + my $tax_cust_bill_pkg = $link->get('tax_cust_bill_pkg'); + if ( $tax_cust_bill_pkg && $tax_cust_bill_pkg->billpkgnum ) { + $link->set('billpkgnum', $tax_cust_bill_pkg->billpkgnum); + # break circular links when doing this + $link->set('tax_cust_bill_pkg', ''); } - } + my $taxable_cust_bill_pkg = $link->get('taxable_cust_bill_pkg'); + if ( $taxable_cust_bill_pkg && $taxable_cust_bill_pkg->billpkgnum ) { + $link->set('taxable_billpkgnum', $taxable_cust_bill_pkg->billpkgnum); + # XXX if we ever do tax-on-tax for these, this will have to change + # since pkgnum will be zero + $link->set('pkgnum', $taxable_cust_bill_pkg->pkgnum); + $link->set('locationnum', + $taxable_cust_bill_pkg->cust_pkg->tax_locationnum); + $link->set('taxable_cust_bill_pkg', ''); + } + + if ( $link->billpkgnum and $link->taxable_billpkgnum ) { + $error = $link->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error inserting cust_bill_pkg_tax_location: $error"; + } + } else { # handoff + my $other; + $other = $link->billpkgnum ? $link->get('taxable_cust_bill_pkg') + : $link->get('tax_cust_bill_pkg'); + my $link_array = $other->get('cust_bill_pkg_tax_location') || []; + push @$link_array, $link; + $other->set('cust_bill_pkg_tax_location' => $link_array); + } + } #foreach my $link } + # someday you will be as awesome as cust_bill_pkg_tax_location... + # but not today 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 ) { @@ -400,7 +434,13 @@ sub check { || $self->ut_snumber('pkgnum') || $self->ut_number('invnum') || $self->ut_money('setup') + || $self->ut_moneyn('unitsetup') + || $self->ut_currencyn('setup_billed_currency') + || $self->ut_moneyn('setup_billed_amount') || $self->ut_money('recur') + || $self->ut_moneyn('unitrecur') + || $self->ut_currencyn('recur_billed_currency') + || $self->ut_moneyn('recur_billed_amount') || $self->ut_numbern('sdate') || $self->ut_numbern('edate') || $self->ut_textn('itemdesc') @@ -581,9 +621,10 @@ appropriate FS::cust_bill_pkg_display objects. Options are passed as a list of name/value pairs. Options are: -part_pkg: FS::part_pkg object from the +part_pkg: FS::part_pkg object from this line item's package. -real_pkgpart: if this line item comes from a bundled package, the pkgpart of the owning package. Otherwise the same as the part_pkg's pkgpart above. +real_pkgpart: if this line item comes from a bundled package, the pkgpart +of the owning package. Otherwise the same as the part_pkg's pkgpart above. =cut @@ -594,13 +635,19 @@ sub set_display { my $conf = new FS::Conf; + # whether to break this down into setup/recur/usage my $separate = $conf->exists('separate_usage'); + my $usage_mandate = $part_pkg->option('usage_mandate', 'Hush!') || $cust_pkg->part_pkg->option('usage_mandate', 'Hush!'); # or use the category from $opt{'part_pkg'} if its not bundled? my $categoryname = $cust_pkg->part_pkg->categoryname; + # if we don't have to separate setup/recur/usage, or put this in a + # package-specific section, or display a usage summary, then don't + # even create one of these. The item will just display in the unnamed + # section as a single line plus details. return $self->set('display', []) unless $separate || $categoryname || $usage_mandate; @@ -608,34 +655,46 @@ sub set_display { my %hash = ( 'section' => $categoryname ); + # whether to put usage details in a separate section, and if so, which one my $usage_section = $part_pkg->option('usage_section', 'Hush!') || $cust_pkg->part_pkg->option('usage_section', 'Hush!'); + # whether to show a usage summary line (total usage charges, no details) my $summary = $part_pkg->option('summarize_usage', 'Hush!') || $cust_pkg->part_pkg->option('summarize_usage', 'Hush!'); if ( $separate ) { + # create lines for setup and (non-usage) recur, in the main section push @display, new FS::cust_bill_pkg_display { type => 'S', %hash }; push @display, new FS::cust_bill_pkg_display { type => 'R', %hash }; } else { + # display everything in a single line push @display, new FS::cust_bill_pkg_display { type => '', %hash, + # and if usage_mandate is enabled, hide details + # (this only works on multisection invoices...) ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ), }; } if ($separate && $usage_section && $summary) { + # create a line for the usage summary in the main section push @display, new FS::cust_bill_pkg_display { type => 'U', summary => 'Y', %hash, }; } + if ($usage_mandate || ($usage_section && $summary) ) { $hash{post_total} = 'Y'; } if ($separate || $usage_mandate) { + # show call details for this line item in the usage section. + # if usage_mandate is on, this will display below the section subtotal. + # this also happens if usage is in a separate section and there's a + # summary in the main section, though I'm not sure why. $hash{section} = $usage_section if $usage_section; push @display, new FS::cust_bill_pkg_display { type => 'U', %hash }; } @@ -646,8 +705,9 @@ sub set_display { =item disintegrate -Returns a list of cust_bill_pkg objects each with no more than a single class -(including setup or recur) of charge. +Returns a hash: keys are "setup", "recur" or usage classnum, values are +FS::cust_bill_pkg objects, each with no more than a single class (setup or +recur) of charge. =cut @@ -824,6 +884,18 @@ sub _X_show_zero { $self->cust_pkg->_X_show_zero($what); } +=item credited [ BEFORE, AFTER, OPTIONS ] + +Returns the sum of credits applied to this item. Arguments are the same as +owed_sql/paid_sql/credited_sql. + +=cut + +sub credited { + my $self = shift; + $self->scalar_sql('SELECT '. $self->credited_sql(@_).' FROM cust_bill_pkg WHERE billpkgnum = ?', $self->billpkgnum); +} + =back =head1 CLASS METHODS @@ -894,7 +966,7 @@ sub paid_sql { my $paid = "( SELECT COALESCE(SUM(cust_bill_pay_pkg.amount),0) FROM cust_bill_pay_pkg JOIN cust_bill_pay USING (billpaynum) WHERE cust_bill_pay_pkg.billpkgnum = cust_bill_pkg.billpkgnum - $s $e$setuprecur )"; + $s $e $setuprecur )"; if ( $opt{no_usage} ) { # cap the amount paid at the sum of non-usage charges, @@ -1038,16 +1110,12 @@ sub upgrade_tax_location { delete @hash{qw(censustract censusyear latitude longitude coord_auto)}; $hash{custnum} = $h_cust_main->custnum; - my $tax_loc = qsearchs('cust_location', \%hash) # unlikely - || FS::cust_location->new({ %hash }); - if ( !$tax_loc->locationnum ) { - $tax_loc->disabled('Y'); - my $error = $tax_loc->insert; - if ( $error ) { - warn "couldn't create historical location record for cust#". - $h_cust_main->custnum.": $error\n"; - next INVOICE; - } + my $tax_loc = FS::cust_location->new(\%hash); + my $error = $tax_loc->find_or_insert || $tax_loc->disable_if_unused; + if ( $error ) { + warn "couldn't create historical location record for cust#". + $h_cust_main->custnum.": $error\n"; + next INVOICE; } my $exempt_cust = 1 if $h_cust_main->tax; @@ -1278,9 +1346,10 @@ sub upgrade_tax_location { ); $cents_remaining -= $part; push @tax_links, { - taxnum => $taxdef->taxnum, - pkgnum => $nontax->pkgnum, - cents => $part, + taxnum => $taxdef->taxnum, + pkgnum => $nontax->pkgnum, + billpkgnum => $nontax->billpkgnum, + cents => $part, }; } #foreach $nontax } #foreach $taxclass @@ -1323,6 +1392,7 @@ sub upgrade_tax_location { taxnum => $_->{taxnum}, pkgnum => $_->{pkgnum}, amount => sprintf('%.2f', $_->{cents} / 100), + taxable_billpkgnum => $_->{billpkgnum}, }); my $error = $link->insert; if ( $error ) { @@ -1411,6 +1481,9 @@ sub _upgrade_data { # Then mark the upgrade as done, so that we don't queue the job twice # and somehow run two of them concurrently. FS::upgrade_journal->set_done($upgrade); + # This upgrade now does the job of assigning taxable_billpkgnums to + # cust_bill_pkg_tax_location, so set that task done also. + FS::upgrade_journal->set_done('tax_location_taxable_billpkgnum'); } =back diff --git a/FS/FS/cust_bill_pkg_display.pm b/FS/FS/cust_bill_pkg_display.pm index a864ec114..d7c147281 100644 --- a/FS/FS/cust_bill_pkg_display.pm +++ b/FS/FS/cust_bill_pkg_display.pm @@ -27,26 +27,26 @@ FS::cust_bill_pkg_display - Object methods for cust_bill_pkg_display records =head1 DESCRIPTION -An FS::cust_bill_pkg_display object represents line item display information. -FS::cust_bill_pkg_display inherits from FS::Record. The following fields are -currently supported: +An FS::cust_bill_pkg_display object represents an instruction to display a +line item in a specific invoice section. FS::cust_bill_pkg_display inherits +from FS::Record and is many-to-one with FS::cust_bill_pkg (invoice line +items). -=over 4 - -=item billpkgdisplaynum +The following fields are currently supported: -primary key - -=item billpkgnum +=over 4 -billpkgnum +=item billpkgdisplaynum - primary key -=item section +=item billpkgnum - the line item number (L<FS::cust_bill_pkg> foreign key) -section +=item section - the section name where this item should be shown. Defaults +to the package category name, if there is one. =cut +# actually it defaults to null, but then calling ->section will return the +# category name. sub section { my ( $self, $value ) = @_; if ( defined($value) ) { @@ -64,17 +64,19 @@ sub section { } } -=item post_total +=item post_total - 'Y' to have this item shown in a "late" section (below +the invoice totals). -post_total +=item type - Which portion of the item's charges to show in the specified +position. 'S' to show setup fees (including tax and one-time charge), +'R' to show the non-usage recurring charge, 'U' to show the usage charge, +null to show all three as a single amount. -=item type - -type - -=item summary - -summary +=item summary - 'Y' to show a usage summary of this line item. This has +the following effects if type = 'U': +- The description will always be "Usage charges" rather than the package name. +- Service labels and usage details (CDRs) are hidden. +- It will only display on multisection invoices. =back @@ -84,7 +86,8 @@ summary =item new HASHREF -Creates a new line item display object. To add the record to the database, see L<"insert">. +Creates a new line item display object. 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. @@ -155,7 +158,6 @@ sub cust_bill_pkg { =head1 BUGS - =head1 SEE ALSO L<FS::Record>, L<FS::cust_bill_pkg>, schema.html from the base documentation. diff --git a/FS/FS/cust_bill_pkg_tax_location.pm b/FS/FS/cust_bill_pkg_tax_location.pm index 44dd6e3c4..140982e53 100644 --- a/FS/FS/cust_bill_pkg_tax_location.pm +++ b/FS/FS/cust_bill_pkg_tax_location.pm @@ -9,6 +9,9 @@ use FS::cust_location; use FS::cust_bill_pay_pkg; use FS::cust_credit_bill_pkg; use FS::cust_main_county; +use FS::Log; + +use List::Util qw(sum min); =head1 NAME @@ -65,6 +68,11 @@ locationnum amount +=item taxable_billpkgnum + +The billpkgnum of the L<FS::cust_bill_pkg> that this tax was charged on. +It may specifically be on any portion of that line item (setup, recurring, +or a usage class). =back @@ -119,6 +127,7 @@ sub check { || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum' ) || $self->ut_foreign_key('locationnum', 'cust_location', 'locationnum' ) || $self->ut_money('amount') + || $self->ut_foreign_key('taxable_billpkgnum', 'cust_bill_pkg', 'billpkgnum') ; return $error if $error; @@ -127,7 +136,7 @@ sub check { =item cust_bill_pkg -Returns the associated cust_bill_pkg object +Returns the associated cust_bill_pkg object (i.e. the tax charge). =cut @@ -136,6 +145,10 @@ sub cust_bill_pkg { qsearchs( 'cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum } ); } +=item taxable_cust_bill_pkg + +Returns the cust_bill_pkg object for the I<taxable> charge. + =item cust_location Returns the associated cust_location object @@ -202,18 +215,278 @@ sub cust_credit_bill_pkg { sub cust_main_county { my $self = shift; - my $result; - if ( $self->taxtype eq 'FS::cust_main_county' ) { - $result = qsearchs( 'cust_main_county', { 'taxnum' => $self->taxnum } ); + return '' unless $self->taxtype eq 'FS::cust_main_county'; + qsearchs( 'cust_main_county', { 'taxnum' => $self->taxnum } ); +} + +sub _upgrade_data { + eval { + use FS::queue; + use Date::Parse 'str2time'; + }; + my $class = shift; + my $upgrade = 'tax_location_taxable_billpkgnum'; + return if FS::upgrade_journal->is_done($upgrade); + my $job = FS::queue->new({ job => + 'FS::cust_bill_pkg_tax_location::upgrade_taxable_billpkgnum' + }); + $job->insert($class, 's' => str2time('2012-01-01')); + FS::upgrade_journal->set_done($upgrade); +} + +sub upgrade_taxable_billpkgnum { + # Associate these records to the correct taxable line items. + # The cust_bill_pkg upgrade now does this also for pre-3.0 records that + # aren't broken out by pkgnum, so we only need to deal with the case of + # multiple line items for the same pkgnum. + # Despite appearances, this has almost no relation to the upgrade in + # FS::cust_bill_pkg. + + my ($class, %opt) = @_; + my $dbh = FS::UID::dbh(); + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $log = FS::Log->new('upgrade_taxable_billpkgnum'); + + my $date_where = ''; + if ( $opt{s} ) { + $date_where .= " AND cust_bill._date >= $opt{s}"; + } + if ( $opt{e} ) { + $date_where .= " AND cust_bill._date < $opt{e}"; + } + + my @need_to_upgrade = qsearch({ + select => 'cust_bill_pkg_tax_location.*', + table => 'cust_bill_pkg_tax_location', + hashref => { taxable_billpkgnum => '' }, + addl_from => 'JOIN cust_bill_pkg USING (billpkgnum)'. + 'JOIN cust_bill USING (invnum)', + extra_sql => $date_where, + }); + $log->info('Starting upgrade of '.scalar(@need_to_upgrade). + ' cust_bill_pkg_tax_location records.'); + + # keys are billpkgnums + my %cust_bill_pkg; + my %tax_location; + foreach (@need_to_upgrade) { + my $tax_billpkgnum = $_->billpkgnum; + $cust_bill_pkg{ $tax_billpkgnum } ||= FS::cust_bill_pkg->by_key($tax_billpkgnum); + $tax_location{ $tax_billpkgnum } ||= []; + push @{ $tax_location{ $tax_billpkgnum } }, $_; } + + TAX_ITEM: foreach my $tax_item (values %cust_bill_pkg) { + my $tax_locations = $tax_location{ $tax_item->billpkgnum }; + my $invnum = $tax_item->invnum; + my $cust_bill = FS::cust_bill->by_key($tax_item->invnum); + my %tax_on_pkg; # keys are tax identifiers + TAX_LOCATION: foreach my $tax_location (@$tax_locations) { + # recapitulate the "cust_main_county $taxnum $pkgnum" tax identifier, + # in a way + my $taxid = join(' ', + $tax_location->taxtype, + $tax_location->taxnum, + $tax_location->pkgnum, + $tax_location->locationnum + ); + $tax_on_pkg{$taxid} ||= []; + push @{ $tax_on_pkg{$taxid} }, $tax_location; + } + PKGNUM: foreach my $taxid (keys %tax_on_pkg) { + my ($taxtype, $taxnum, $pkgnum, $locationnum) = split(' ', $taxid); + $log->info("tax#$taxnum, pkg#$pkgnum", object => $cust_bill); + my @pkg_items = $cust_bill->cust_bill_pkg_pkgnum($pkgnum); + if (!@pkg_items) { + # then how is there tax on it? should never happen + $log->error("no line items with pkg#$pkgnum", object => $cust_bill); + next PKGNUM; + } + my $pkg_amount = 0; + foreach my $pkg_item (@pkg_items) { + # find the taxable amount of each one + my $amount = $pkg_item->setup + $pkg_item->recur; + # subtract any exemptions that apply to this taxdef + foreach (qsearch('cust_tax_exempt_pkg', { + taxnum => $taxnum, + billpkgnum => $pkg_item->billpkgnum + }) ) + { + $amount -= $_->amount; + } + $pkg_item->set('amount' => $pkg_item->setup + $pkg_item->recur); + $pkg_amount += $amount; + } #$pkg_item + next PKGNUM if $pkg_amount == 0; # probably because it's fully exempted + # now sort them descending by taxable amount + @pkg_items = sort { $b->amount <=> $a->amount } + @pkg_items; + # and do the same with the tax links + # (there should be one per taxed item) + my @tax_links = sort { $b->amount <=> $a->amount } + @{ $tax_on_pkg{$taxid} }; + + if (scalar(@tax_links) == scalar(@pkg_items)) { + # the relatively simple case: they match 1:1 + for my $i (0 .. scalar(@tax_links) - 1) { + $tax_links[$i]->set('taxable_billpkgnum', + $pkg_items[$i]->billpkgnum); + my $error = $tax_links[$i]->replace; + if ( $error ) { + $log->error("failed to set taxable_billpkgnum in tax on pkg#$pkgnum", + object => $cust_bill); + next PKGNUM; + } + } #for $i + } else { + # the more complicated case + $log->warn("mismatched charges and tax links in pkg#$pkgnum", + object => $cust_bill); + my $tax_amount = sum(map {$_->amount} @tax_links); + # remove all tax link records and recreate them to be 1:1 with + # taxable items + my (%billpaynum, %creditbillnum); + my $link_type; + foreach my $tax_link (@tax_links) { + $link_type ||= ref($tax_link); + my $error = $tax_link->delete; + if ( $error ) { + $log->error("error unlinking tax#$taxnum pkg#$pkgnum", + object => $cust_bill); + next PKGNUM; + } + my $pkey = $tax_link->primary_key; + # also remove all applications that reference this tax link + # (they will be applications to the tax item) + my %hash = ($pkey => $tax_link->get($pkey)); + foreach (qsearch('cust_bill_pay_pkg', \%hash)) { + $billpaynum{$_->billpaynum} += $_->amount; + my $error = $_->delete; + die "error unapplying payment: $error" if ( $error ); + } + foreach (qsearch('cust_credit_bill_pkg', \%hash)) { + $creditbillnum{$_->creditbillnum} += $_->amount; + my $error = $_->delete; + die "error unapplying credit: $error" if ( $error ); + } + } + @tax_links = (); + my $cents_remaining = int(100 * $tax_amount); + foreach my $pkg_item (@pkg_items) { + my $cents = int(100 * $pkg_item->amount * $tax_amount / $pkg_amount); + my $tax_link = $link_type->new({ + taxable_billpkgnum => $pkg_item->billpkgnum, + billpkgnum => $tax_item->billpkgnum, + taxnum => $taxnum, + taxtype => $taxtype, + pkgnum => $pkgnum, + locationnum => $locationnum, + cents => $cents, + }); + push @tax_links, $tax_link; + $cents_remaining -= $cents; + } + my $nlinks = scalar @tax_links; + my $i = 0; + while ($cents_remaining) { + $tax_links[$i % $nlinks]->set('cents' => + $tax_links[$i % $nlinks]->cents + 1 + ); + $cents_remaining--; + $i++; + } + foreach my $tax_link (@tax_links) { + $tax_link->set('amount' => sprintf('%.2f', $tax_link->cents / 100)); + my $error = $tax_link->insert; + if ( $error ) { + $log->error("error relinking tax#$taxnum pkg#$pkgnum", + object => $cust_bill); + next PKGNUM; + } + } + + $i = 0; + my $error; + my $left = 0; # the amount "left" on the last tax link after + # applying payments, but before credits, so that + # it can receive both a payment and a credit if + # necessary + # reapply payments/credits...this sucks + foreach my $billpaynum (keys %billpaynum) { + my $pay_amount = $billpaynum{$billpaynum}; + while ($i < $nlinks and $pay_amount > 0) { + my $this_amount = min($pay_amount, $tax_links[$i]->amount); + $left = $tax_links[$i]->amount - $this_amount; + my $app = FS::cust_bill_pay_pkg->new({ + billpaynum => $billpaynum, + billpkgnum => $tax_links[$i]->billpkgnum, + billpkgtaxlocationnum => $tax_links[$i]->billpkgtaxlocationnum, + amount => $this_amount, + setuprecur => 'setup', + # sdate/edate are null + }); + my $error ||= $app->insert; + $pay_amount -= $this_amount; + $i++ if $left == 0; + } + } + foreach my $creditbillnum (keys %creditbillnum) { + my $credit_amount = $creditbillnum{$creditbillnum}; + while ($i < $nlinks and $credit_amount > 0) { + my $this_amount = min($left, $credit_amount, $tax_links[$i]->amount); + $left = $credit_amount * 2; # just so it can't be selected twice + $i++ if $this_amount == $left + or $this_amount == $tax_links[$i]->amount; + my $app = FS::cust_credit_bill_pkg->new({ + creditbillnum => $creditbillnum, + billpkgnum => $tax_links[$i]->billpkgnum, + billpkgtaxlocationnum => $tax_links[$i]->billpkgtaxlocationnum, + amount => $this_amount, + setuprecur => 'setup', + # sdate/edate are null + }); + my $error ||= $app->insert; + $credit_amount -= $this_amount; + } + } + if ( $error ) { + # we've just unapplied a bunch of stuff, so if it won't reapply + # we really need to revert the whole transaction + die "error reapplying payments/credits: $error; upgrade halted"; + } + } # scalar(@tax_links) ?= scalar(@pkg_items) + } #taxnum/pkgnum + } #TAX_ITEM + + $log->info('finish'); + + $dbh->commit if $oldAutoCommit; + return; } +=cut + =back =head1 BUGS -The presense of FS::cust_main_county::delete makes the cust_main_county method -unreliable +The presence of FS::cust_main_county::delete makes the cust_main_county method +unreliable. + +Pre-3.0 versions of Freeside would only create one cust_bill_pkg_tax_location +per tax definition (taxtype/taxnum) per invoice. The pkgnum and locationnum +fields were arbitrarily set to those of the first line item subject to the +tax. This created problems if the tax contribution of each line item ever +needed to be determined (for example, when applying credits). For several +months in 2012, this was changed to create one record per tax definition +per I<package> per invoice, which was still not specific enough to identify +a line item. + +The current behavior is to create one record per tax definition per taxable +line item, and to store the billpkgnum of the taxed line item in the record. +The upgrade will try to convert existing records to the new format, but this +is not perfectly reliable. =head1 SEE ALSO diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 6185fc472..0376f1dc4 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -5,8 +5,9 @@ use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record ); use vars qw( $conf $unsuspendauto $me $DEBUG $otaker_upgrade_kludge $ignore_empty_reasonnum ); +use List::Util qw( min ); use Date::Format; -use FS::UID qw( dbh getotaker ); +use FS::UID qw( dbh ); use FS::Misc qw(send_email); use FS::Record qw( qsearch qsearchs dbdef ); use FS::CurrentUser; @@ -172,7 +173,7 @@ sub insert { $dbh->commit or die $dbh->errstr if $oldAutoCommit; - #false laziness w/ cust_credit::insert + #false laziness w/ cust_pay::insert if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) { my @errors = $cust_main->unsuspend; #return @@ -618,6 +619,347 @@ sub credited_sql { unapplied_sql(); } +=item credit_lineitems + +Example: + + my $error = FS::cust_credit->credit_lineitems( + + #the lineitems to credit + 'billpkgnums' => \@billpkgnums, + 'setuprecurs' => \@setuprecurs, + 'amounts' => \@amounts, + 'apply' => 1, #0 leaves the credit unapplied + + #the credit + 'newreasonnum' => scalar($cgi->param('newreasonnum')), + 'newreasonnum_type' => scalar($cgi->param('newreasonnumT')), + map { $_ => scalar($cgi->param($_)) } + #fields('cust_credit') + qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum + + ); + +=cut + +#maybe i should just be an insert with extra args instead of a class method +use FS::cust_bill_pkg; +sub credit_lineitems { + my( $class, %arg ) = @_; + my $curuser = $FS::CurrentUser::CurrentUser; + + #some false laziness w/misc/xmlhttp-cust_bill_pkg-calculate_taxes.html + + my $cust_main = qsearchs({ + 'table' => 'cust_main', + 'hashref' => { 'custnum' => $arg{custnum} }, + 'extra_sql' => ' AND '. $curuser->agentnums_sql, + }) or return 'unknown customer'; + + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + #my @cust_bill_pkg = qsearch({ + # 'select' => 'cust_bill_pkg.*', + # 'table' => 'cust_bill_pkg', + # 'addl_from' => ' LEFT JOIN cust_bill USING (invnum) '. + # ' LEFT JOIN cust_main USING (custnum) ', + # 'extra_sql' => ' WHERE custnum = $custnum AND billpkgnum IN ('. + # join( ',', @{$arg{billpkgnums}} ). ')', + # 'order_by' => 'ORDER BY invnum ASC, billpkgnum ASC', + #}); + + my $error = ''; + if ($arg{reasonnum} == -1) { + + $error = 'Enter a new reason (or select an existing one)' + unless $arg{newreasonnum} !~ /^\s*$/; + my $reason = new FS::reason { + 'reason' => $arg{newreasonnum}, + 'reason_type' => $arg{newreasonnum_type}, + }; + $error ||= $reason->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error inserting reason: $error"; + } + $arg{reasonnum} = $reason->reasonnum; + } + + my $cust_credit = new FS::cust_credit ( { + map { $_ => $arg{$_} } + #fields('cust_credit') + qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum + } ); + $error = $cust_credit->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error inserting credit: $error"; + } + + unless ( $arg{'apply'} ) { + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return ''; + } + + #my $subtotal = 0; + # keys in all of these are invoice numbers + my %cust_credit_bill = (); + my %cust_bill_pkg = (); + my %cust_credit_bill_pkg = (); + my %taxlisthash = (); + my %unapplied_payments = (); #invoice numbers, and then billpaynums + foreach my $billpkgnum ( @{$arg{billpkgnums}} ) { + my $setuprecur = shift @{$arg{setuprecurs}}; + my $amount = shift @{$arg{amounts}}; + + my $cust_bill_pkg = qsearchs({ + 'table' => 'cust_bill_pkg', + 'hashref' => { 'billpkgnum' => $billpkgnum }, + 'addl_from' => 'LEFT JOIN cust_bill USING (invnum)', + 'extra_sql' => 'AND custnum = '. $cust_main->custnum, + }) or die "unknown billpkgnum $billpkgnum"; + + my $invnum = $cust_bill_pkg->invnum; + + if ( $setuprecur eq 'setup' ) { + $cust_bill_pkg->setup($amount); + $cust_bill_pkg->recur(0); + $cust_bill_pkg->unitrecur(0); + $cust_bill_pkg->type(''); + } else { + $setuprecur = 'recur'; #in case its a usage classnum? + $cust_bill_pkg->recur($amount); + $cust_bill_pkg->setup(0); + $cust_bill_pkg->unitsetup(0); + } + + push @{$cust_bill_pkg{$invnum}}, $cust_bill_pkg; + + #unapply any payments applied to this line item (other credits too?) + foreach my $cust_bill_pay_pkg ( $cust_bill_pkg->cust_bill_pay_pkg($setuprecur) ) { + $error = $cust_bill_pay_pkg->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error unapplying payment: $error"; + } + $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum} + += $cust_bill_pay_pkg->amount; + } + + #$subtotal += $amount; + $cust_credit_bill{$invnum} += $amount; + push @{ $cust_credit_bill_pkg{$invnum} }, + new FS::cust_credit_bill_pkg { + 'billpkgnum' => $cust_bill_pkg->billpkgnum, + 'amount' => sprintf('%.2f',$amount), + 'setuprecur' => $setuprecur, + 'sdate' => $cust_bill_pkg->sdate, + 'edate' => $cust_bill_pkg->edate, + }; + + # recalculate taxes with new amounts + $taxlisthash{$invnum} ||= {}; + my $part_pkg = $cust_bill_pkg->part_pkg; + $cust_main->_handle_taxes( $part_pkg, + $taxlisthash{$invnum}, + $cust_bill_pkg, + $cust_bill_pkg->cust_pkg, + $cust_bill_pkg->cust_bill->_date, #invoice time + $cust_bill_pkg->cust_pkg->pkgpart, + ); + } + + ### + # now loop through %cust_credit_bill and insert those + ### + + # (hack to prevent cust_credit_bill_pkg insertion) + local($FS::cust_bill_ApplicationCommon::skip_apply_to_lineitems_hack) = 1; + + foreach my $invnum ( sort { $a <=> $b } keys %cust_credit_bill ) { + + my $arrayref_or_error = + $cust_main->calculate_taxes( + $cust_bill_pkg{$invnum}, # list of taxable items that we're crediting + $taxlisthash{$invnum}, # list of tax-item bindings + $cust_bill_pkg{$invnum}->[0]->cust_bill->_date, # invoice time + ); + + unless ( ref( $arrayref_or_error ) ) { + $dbh->rollback if $oldAutoCommit; + return "Error calculating taxes: $arrayref_or_error"; + } + + my %tax_links; # {tax billpkgnum}{nontax billpkgnum} + + #taxes + foreach my $cust_bill_pkg ( @{ $cust_bill_pkg{$invnum} } ) { + my $billpkgnum = $cust_bill_pkg->billpkgnum; + my %hash = ( 'taxable_billpkgnum' => $billpkgnum ); + # gather up existing tax links (we need their billpkgtaxlocationnums) + my @tax_links = qsearch('cust_bill_pkg_tax_location', \%hash), + qsearch('cust_bill_pkg_tax_rate_location', \%hash); + + foreach ( @tax_links ) { + $tax_links{$_->billpkgnum} ||= {}; + $tax_links{$_->billpkgnum}{$_->taxable_billpkgnum} = $_; + } + } + + foreach my $taxline ( @$arrayref_or_error ) { + + my $amount = $taxline->setup; + + # find equivalent tax line item on the existing invoice + my $tax_item = qsearchs('cust_bill_pkg', { + 'invnum' => $invnum, + 'pkgnum' => 0, + 'itemdesc' => $taxline->desc, + }); + if (!$tax_item) { + # or should we just exit if this happens? + $cust_credit->set('amount', + sprintf('%.2f', $cust_credit->get('amount') - $amount) + ); + my $error = $cust_credit->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error correcting credit for missing tax line: $error"; + } + } + + # but in the new era, we no longer have the problem of uniquely + # identifying the tax_Xlocation record. The billpkgnums of the + # tax and the taxed item are known. + foreach my $new_loc + ( @{ $taxline->get('cust_bill_pkg_tax_location') }, + @{ $taxline->get('cust_bill_pkg_tax_rate_location') } ) + { + # the existing tax_Xlocation object + my $old_loc = + $tax_links{$tax_item->billpkgnum}{$new_loc->taxable_billpkgnum}; + + next if !$old_loc; # apply the leftover amount nonspecifically + + #support partial credits: use $amount if smaller + # (so just distribute to the first location? perhaps should + # do so evenly...) + my $loc_amount = min( $amount, $new_loc->amount); + + $amount -= $loc_amount; + + $cust_credit_bill{$invnum} += $loc_amount; + push @{ $cust_credit_bill_pkg{$invnum} }, + new FS::cust_credit_bill_pkg { + 'billpkgnum' => $tax_item->billpkgnum, + 'amount' => $loc_amount, + 'setuprecur' => 'setup', + 'billpkgtaxlocationnum' => $old_loc->billpkgtaxlocationnum, + 'billpkgtaxratelocationnum' => $old_loc->billpkgtaxratelocationnum, + }; + + } #foreach my $new_loc + + # we still have to deal with the possibility that the tax links don't + # cover the whole amount of tax because of an incomplete upgrade... + if ($amount > 0) { + $cust_credit_bill{$invnum} += $amount; + push @{ $cust_credit_bill_pkg{$invnum} }, + new FS::cust_credit_bill_pkg { + 'billpkgnum' => $tax_item->billpkgnum, + 'amount' => $amount, + 'setuprecur' => 'setup', + }; + + } # if $amount > 0 + + #unapply any payments applied to the tax + foreach my $cust_bill_pay_pkg + ( $tax_item->cust_bill_pay_pkg('setup') ) + { + $error = $cust_bill_pay_pkg->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error unapplying payment: $error"; + } + $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum} + += $cust_bill_pay_pkg->amount; + } + } #foreach $taxline + + # if we unapplied any payments from line items, also unapply that + # amount from the invoice + foreach my $billpaynum (keys %{$unapplied_payments{$invnum}}) { + my $cust_bill_pay = FS::cust_bill_pay->by_key($billpaynum) + or die "broken payment application $billpaynum"; + my @subapps = $cust_bill_pay->lineitem_applications; + $error = $cust_bill_pay->delete; # can't replace + + my $new_cust_bill_pay = FS::cust_bill_pay->new({ + $cust_bill_pay->hash, + billpaynum => '', + amount => sprintf('%.2f', + $cust_bill_pay->amount + - $unapplied_payments{$invnum}{$billpaynum}), + }); + + if ( $new_cust_bill_pay->amount > 0 ) { + $error ||= $new_cust_bill_pay->insert; + # Also reapply it to everything it was applied to before. + # Note that we've already deleted cust_bill_pay_pkg records for the + # items we're crediting, so they aren't on this list. + foreach my $cust_bill_pay_pkg (@subapps) { + $cust_bill_pay_pkg->billpaypkgnum(''); + $cust_bill_pay_pkg->billpaynum($new_cust_bill_pay->billpaynum); + $error ||= $cust_bill_pay_pkg->insert; + } + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error unapplying payment: $error"; + } + } + #insert cust_credit_bill + + my $cust_credit_bill = new FS::cust_credit_bill { + 'crednum' => $cust_credit->crednum, + 'invnum' => $invnum, + 'amount' => sprintf('%.2f', $cust_credit_bill{$invnum}), + }; + $error = $cust_credit_bill->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error applying credit of $cust_credit_bill{$invnum} ". + " to invoice $invnum: $error"; + } + + #and then insert cust_credit_bill_pkg for each cust_bill_pkg + foreach my $cust_credit_bill_pkg ( @{$cust_credit_bill_pkg{$invnum}} ) { + $cust_credit_bill_pkg->creditbillnum( $cust_credit_bill->creditbillnum ); + $error = $cust_credit_bill_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error applying credit to line item: $error"; + } + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =back =head1 BUGS diff --git a/FS/FS/cust_credit_bill.pm b/FS/FS/cust_credit_bill.pm index 900a5c0d5..9ecb7e048 100644 --- a/FS/FS/cust_credit_bill.pm +++ b/FS/FS/cust_credit_bill.pm @@ -2,7 +2,6 @@ package FS::cust_credit_bill; use strict; use vars qw( @ISA $conf ); -use FS::UID qw( getotaker ); use FS::Record qw( qsearch qsearchs ); use FS::cust_main_Mixin; use FS::cust_bill_ApplicationCommon; diff --git a/FS/FS/cust_credit_bill_pkg.pm b/FS/FS/cust_credit_bill_pkg.pm index 418900785..657a88904 100644 --- a/FS/FS/cust_credit_bill_pkg.pm +++ b/FS/FS/cust_credit_bill_pkg.pm @@ -223,65 +223,21 @@ sub delete { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $original_cust_bill_pkg = $self->cust_bill_pkg; - my $cust_bill = $original_cust_bill_pkg->cust_bill; - - my %hash = $original_cust_bill_pkg->hash; - delete $hash{$_} for qw( billpkgnum setup recur ); - $hash{$self->setuprecur} = $self->amount; - my $cust_bill_pkg = new FS::cust_bill_pkg { %hash }; - - use Data::Dumper; - my @exemptions = qsearch( 'cust_tax_exempt_pkg', - { creditbillpkgnum => $self->creditbillpkgnum } - ); - my %seen = (); - my @generated_exemptions = (); - my @unseen_exemptions = (); - foreach my $exemption ( @exemptions ) { - my $error = $exemption->delete; + my @negative_exemptions = qsearch('cust_tax_exempt_pkg', { + 'creditbillpkgnum' => $self->creditbillpkgnum + }); + + # de-anti-exempt those negative exemptions + my $error; + foreach (@negative_exemptions) { + $error = $_->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "error deleting cust_tax_exempt_pkg: $error"; + return $error; } - - next if $seen{$exemption->taxnum}; - $seen{$exemption->taxnum} = 1; - push @unseen_exemptions, $exemption; } - foreach my $exemption ( @unseen_exemptions ) { - my $tax_object = $exemption->cust_main_county; - unless ($tax_object) { - $dbh->rollback if $oldAutoCommit; - return "can't find exempted tax"; - } - - my $hashref_or_error = - $tax_object->taxline( [ $cust_bill_pkg ], - 'custnum' => $cust_bill->custnum, - 'invoice_time' => $cust_bill->_date, - ); - unless (ref($hashref_or_error)) { - $dbh->rollback if $oldAutoCommit; - return "error calculating taxes: $hashref_or_error"; - } - - push @generated_exemptions, @{ $cust_bill_pkg->cust_tax_exempt_pkg }; - } - - foreach my $taxnum ( keys %seen ) { - my $sum = 0; - $sum += $_->amount for grep {$_->taxnum == $taxnum} @exemptions; - $sum -= $_->amount for grep {$_->taxnum == $taxnum} @generated_exemptions; - $sum = sprintf("%.2f", $sum); - unless ($sum eq '0.00' || $sum eq '-0.00') { - $dbh->rollback if $oldAutoCommit; - return "Can't unapply credit without charging tax"; - } - } - - my $error = $self->SUPER::delete(@_); + $error = $self->SUPER::delete(@_); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -348,13 +304,13 @@ sub cust_bill_pkg { sub cust_bill_pkg_tax_Xlocation { my $self = shift; - if ($self->billpkg_tax_locationnum) { + if ($self->billpkgtaxlocationnum) { return qsearchs( 'cust_bill_pkg_tax_location', { 'billpkgtaxlocationnum' => $self->billpkgtaxlocationnum }, ); - } elsif ($self->billpkg_tax_rate_locationnum) { + } elsif ($self->billpkgtaxratelocationnum) { return qsearchs( 'cust_bill_pkg_tax_rate_location', { 'billpkgtaxratelocationnum' => $self->billpkgtaxratelocationnum }, diff --git a/FS/FS/cust_location.pm b/FS/FS/cust_location.pm index 2810dc957..b98ade157 100644 --- a/FS/FS/cust_location.pm +++ b/FS/FS/cust_location.pm @@ -5,7 +5,7 @@ use strict; use vars qw( $import ); use Locale::Country; use FS::UID qw( dbh driver_name ); -use FS::Record qw( qsearch ); #qsearchs ); +use FS::Record qw( qsearch qsearchs ); use FS::Conf; use FS::prospect_main; use FS::cust_main; @@ -104,6 +104,95 @@ points to. You can ask the object for a copy with the I<hash> method. sub table { 'cust_location'; } +=item find_or_insert + +Finds an existing location matching the customer and address values in this +location, if one exists, and sets the contents of this location equal to that +one (including its locationnum). + +If an existing location is not found, this one I<will> be inserted. (This is a +change from the "new_or_existing" method that this replaces.) + +The following fields are considered "essential" and I<must> match: custnum, +address1, address2, city, county, state, zip, country, location_number, +location_type, location_kind. Disabled locations will be found only if this +location is set to disabled. + +If 'coord_auto' is null, and latitude and longitude are not null, then +latitude and longitude are also essential fields. + +All other fields are considered "non-essential". If a non-essential field is +empty in this location, it will be ignored in determining whether an existing +location matches. + +If a non-essential field is non-empty in this location, existing locations +that contain a different non-empty value for that field will not match. An +existing location in which the field is I<empty> will match, but will be +updated in-place with the value of that field. + +Returns an error string if inserting or updating a location failed. + +It is unfortunately hard to determine if this created a new location or not. + +=cut + +sub find_or_insert { + my $self = shift; + + my @essential = (qw(custnum address1 address2 city county state zip country + location_number location_type location_kind disabled)); + + if ( !$self->coord_auto and $self->latitude and $self->longitude ) { + push @essential, qw(latitude longitude); + # but NOT coord_auto; if the latitude and longitude match the geocoded + # values then that's good enough + } + + # put nonempty, nonessential fields/values into this hash + my %nonempty = map { $_ => $self->get($_) } + grep {$self->get($_)} $self->fields; + delete @nonempty{@essential}; + delete $nonempty{'locationnum'}; + + my %hash = map { $_ => $self->get($_) } @essential; + my @matches = qsearch('cust_location', \%hash); + + # consider candidate locations + MATCH: foreach my $old (@matches) { + my $reject = 0; + foreach my $field (keys %nonempty) { + my $old_value = $old->get($field); + if ( length($old_value) > 0 ) { + if ( $field eq 'latitude' or $field eq 'longitude' ) { + # special case, because these are decimals + if ( abs($old_value - $nonempty{$field}) > 0.000001 ) { + $reject = 1; + } + } elsif ( $old_value ne $nonempty{$field} ) { + $reject = 1; + } + } else { + # it's empty in $old, has a value in $self + $old->set($field, $nonempty{$field}); + } + next MATCH if $reject; + } # foreach $field + + if ( $old->modified ) { + my $error = $old->replace; + return $error if $error; + } + # set $self equal to $old + foreach ($self->fields) { + $self->set($_, $old->get($_)); + } + return ""; + } + + # didn't find a match + return $self->insert; +} + =item insert Adds this record to the database. If there is an error, returns the error, @@ -168,12 +257,12 @@ and replace methods. =cut -#some false laziness w/cust_main, but since it should eventually lose these -#fields anyway... sub check { my $self = shift; my $conf = new FS::Conf; + return '' if $self->disabled; # so that disabling locations never fails + my $error = $self->ut_numbern('locationnum') || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum') @@ -188,6 +277,7 @@ sub check { || $self->ut_coordn('latitude') || $self->ut_coordn('longitude') || $self->ut_enum('coord_auto', [ '', 'Y' ]) + || $self->ut_enum('addr_clean', [ '', 'Y' ]) || $self->ut_alphan('location_type') || $self->ut_textn('location_number') || $self->ut_enum('location_kind', [ '', 'R', 'B' ] ) @@ -208,9 +298,6 @@ sub check { return "Unit # is required"; } - $self->set_coord - unless $import || ($self->latitude && $self->longitude); - # tricky...we have to allow for the customer to not be inserted yet return "No prospect or customer!" unless $self->prospectnum || $self->custnum @@ -235,6 +322,11 @@ sub check { } ); } + # set coordinates, unless we already have them + if (!$import and !$self->latitude and !$self->longitude) { + $self->set_coord; + } + $self->SUPER::check; } @@ -326,6 +418,9 @@ sub move_to { my $dbh = dbh; my $error = ''; + # prevent this from failing because of pkg_svc quantity limits + local( $FS::cust_svc::ignore_quantity ) = 1; + if ( !$new->locationnum ) { $error = $new->insert; if ( $error ) { @@ -334,9 +429,13 @@ sub move_to { } } + # find all packages that have the old location as their service address, + # and aren't canceled, + # and aren't supplemental to another package. my @pkgs = qsearch('cust_pkg', { 'locationnum' => $old->locationnum, - 'cancel' => '' + 'cancel' => '', + 'main_pkgnum' => '', }); foreach my $cust_pkg (@pkgs) { $error = $cust_pkg->change( @@ -478,6 +577,20 @@ sub location_label { $prefix . $self->SUPER::location_label(%opt); } +=item county_state_county + +Returns a string consisting of just the county, state and country. + +=cut + +sub county_state_country { + my $self = shift; + my $label = $self->country; + $label = $self->state.", $label" if $self->state; + $label = $self->county." County, $label" if $self->county; + $label; +} + =back =head1 CLASS METHODS @@ -530,6 +643,79 @@ sub in_county_sql { } } +=back + +=head2 SUBROUTINES + +=over 4 + +=item process_censustract_update LOCATIONNUM + +Queueable function to update the census tract to the current year (as set in +the 'census_year' configuration variable) and retrieve the new tract code. + +=cut + +sub process_censustract_update { + eval "use FS::GeocodeCache"; + die $@ if $@; + my $locationnum = shift; + my $cust_location = + qsearchs( 'cust_location', { locationnum => $locationnum }) + or die "locationnum '$locationnum' not found!\n"; + + my $conf = FS::Conf->new; + my $new_year = $conf->config('census_year') or return; + my $loc = FS::GeocodeCache->new( $cust_location->location_hash ); + $loc->set_censustract; + my $error = $loc->get('censustract_error'); + die $error if $error; + $cust_location->set('censustract', $loc->get('censustract')); + $cust_location->set('censusyear', $new_year); + $error = $cust_location->replace; + die $error if $error; + return; +} + + +sub process_set_coord { + my $job = shift; + # avoid starting multiple instances of this job + my @others = qsearch('queue', { + 'status' => 'locked', + 'job' => $job->job, + 'jobnum' => {op=>'!=', value=>$job->jobnum}, + }); + return if @others; + + $job->update_statustext('finding locations to update'); + my @missing_coords = qsearch('cust_location', { + 'disabled' => '', + 'latitude' => '', + 'longitude' => '', + }); + my $i = 0; + my $n = scalar @missing_coords; + for my $cust_location (@missing_coords) { + $cust_location->set_coord; + my $error = $cust_location->replace; + if ( $error ) { + warn "error geocoding location#".$cust_location->locationnum.": $error\n"; + } else { + $i++; + $job->update_statustext("updated $i / $n locations"); + dbh->commit; # so that we don't have to wait for the whole thing to finish + # Rate-limit to stay under the Google Maps usage limit (2500/day). + # 86,400 / 35 = 2,468 lookups per day. + } + sleep 35; + } + if ( $i < $n ) { + die "failed to update ".$n-$i." locations\n"; + } + return; +} + =head1 BUGS =head1 SEE ALSO diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 9e39b3006..7c7c9e2b5 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,11 +2,11 @@ package FS::cust_main; require 5.006; use strict; - #FS::cust_main:_Marketgear when they're ready to move to 2.1 use base qw( FS::cust_main::Packages FS::cust_main::Status FS::cust_main::NationalID FS::cust_main::Billing FS::cust_main::Billing_Realtime FS::cust_main::Billing_Discount + FS::cust_main::Billing_ThirdParty FS::cust_main::Location FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin FS::geocode_Mixin FS::Quotable_Mixin @@ -33,7 +33,7 @@ use Date::Format; use File::Temp; #qw( tempfile ); use Business::CreditCard 0.28; use Locale::Country; -use FS::UID qw( getotaker dbh driver_name ); +use FS::UID qw( dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); use FS::Misc qw( generate_email send_email generate_ps do_print ); use FS::Msgcat qw(gettext); @@ -59,6 +59,7 @@ use FS::cust_main_exemption; use FS::cust_tax_adjustment; use FS::cust_tax_location; use FS::agent; +use FS::agent_currency; use FS::cust_main_invoice; use FS::cust_tag; use FS::prepay_credit; @@ -391,7 +392,7 @@ sub insert { $payby = 'PREP' if $amount; - } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) { + } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|PPAL)$/ ) { $payby = $1; $self->payby('BILL'); @@ -551,14 +552,6 @@ sub insert { } } - if ( $self->can('start_copy_skel') ) { - my $error = $self->start_copy_skel; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - warn " ordering packages\n" if $DEBUG > 1; @@ -981,47 +974,6 @@ sub insert_cust_pay { } -=item reexport - -This method is deprecated. See the I<depend_jobnum> option to the insert and -order_pkgs methods for a better way to defer provisioning. - -Re-schedules all exports by calling the B<reexport> method of all associated -packages (see L<FS::cust_pkg>). If there is an error, returns the error; -otherwise returns false. - -=cut - -sub reexport { - my $self = shift; - - carp "WARNING: FS::cust_main::reexport is deprectated; ". - "use the depend_jobnum option to insert or order_pkgs to delay export"; - - 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 $cust_pkg ( $self->ncancelled_pkgs ) { - my $error = $cust_pkg->reexport; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - =item delete [ OPTION => VALUE ... ] This deletes the customer. If there is an error, returns the error, otherwise @@ -1488,20 +1440,6 @@ sub replace { return "You are not permitted to create complimentary accounts."; } - # should be unnecessary--geocode will default to null on new locations - #if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode') - # && $conf->exists('enable_taxproducts') - # ) - #{ - # my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip) - # ? 'ship_' : ''; - # $self->set('geocode', '') - # if $old->get($pre.'zip') ne $self->get($pre.'zip') - # && length($self->get($pre.'zip')) >= 10; - #} - - # set_coord/coord_auto stuff is now handled by cust_location - local($ignore_expired_card) = 1 if $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/ @@ -1532,43 +1470,17 @@ sub replace { my $old_loc = $old->$l; my $new_loc = $self->$l; - if ( !$new_loc->locationnum ) { - # changing location - # If the new location is all empty fields, or if it's identical to - # the old location in all fields, don't replace. - my @nonempty = grep { $new_loc->$_ } $self->location_fields; - next if !@nonempty; - my @unlike = grep { $new_loc->$_ ne $old_loc->$_ } $self->location_fields; - - if ( @unlike or $old_loc->disabled ) { - warn " changed $l fields: ".join(',',@unlike)."\n" - if $DEBUG; - $new_loc->set(custnum => $self->custnum); - - # insert it--the old location will be disabled later - my $error = $new_loc->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - } else { - # no fields have changed and $old_loc isn't disabled, so don't change it - next; - } - - } - elsif ( $new_loc->custnum ne $self->custnum or $new_loc->prospectnum ) { + # find the existing location if there is one + $new_loc->set('custnum' => $self->custnum); + my $error = $new_loc->find_or_insert; + if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "$l belongs to customer ".$new_loc->custnum; + return $error; } - # else the new location belongs to this customer so we're good - - # set the foo_locationnum now that we have one. $self->set($l.'num', $new_loc->locationnum); - } #for $l + # replace the customer record my $error = $self->SUPER::replace($old); if ( $error ) { @@ -1801,19 +1713,36 @@ sub check { || $self->ut_floatn('credit_limit') || $self->ut_numbern('billday') || $self->ut_numbern('prorate_day') - || $self->ut_enum('edit_subject', [ '', 'Y' ] ) - || $self->ut_enum('calling_list_exempt', [ '', 'Y' ] ) - || $self->ut_enum('invoice_noemail', [ '', 'Y' ] ) + || $self->ut_flag('edit_subject') + || $self->ut_flag('calling_list_exempt') + || $self->ut_flag('invoice_noemail') + || $self->ut_flag('message_noemail') || $self->ut_enum('locale', [ '', FS::Locales->locales ]) + || $self->ut_currencyn('currency') ; + my $company = $self->company; + $company =~ s/^\s+//; + $company =~ s/\s+$//; + $company =~ s/\s+/ /g; + $self->company($company); + #barf. need message catalogs. i18n. etc. $error .= "Please select an advertising source." if $error =~ /^Illegal or empty \(numeric\) refnum: /; return $error if $error; - return "Unknown agent" - unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); + my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } ) + or return "Unknown agent"; + + if ( $self->currency ) { + my $agent_currency = qsearchs( 'agent_currency', { + 'agentnum' => $agent->agentnum, + 'currency' => $self->currency, + }) + or return "Agent ". $agent->agent. + " not permitted to offer ". $self->currency. " invoicing"; + } return "Unknown refnum" unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } ); @@ -1862,8 +1791,6 @@ sub check { } - #ship_ fields are gone - #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/ # or return "Illegal payby: ". $self->payby; #$self->payby($1); @@ -2039,7 +1966,8 @@ sub check { if ( $self->paydate eq '' || $self->paydate eq '-' ) { return "Expiration date required" - unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/; + # shouldn't payinfo_check do this? + unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/; $self->paydate(''); } else { my( $m, $y ); @@ -3419,6 +3347,8 @@ New-style, with a hashref of options: 'setuptax' => '', # or 'Y' for tax exempt + 'locationnum'=> 1234, # optional + #internal taxation 'taxclass' => 'Tax class', @@ -3450,6 +3380,7 @@ sub charge { my $no_auto = ''; my $cust_pkg_ref = ''; my ( $bill_now, $invoice_terms ) = ( 0, '' ); + my $locationnum; if ( ref( $_[0] ) ) { $amount = $_[0]->{amount}; $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1; @@ -3467,6 +3398,7 @@ sub charge { $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} : ''; + $locationnum = $_[0]->{locationnum} || $self->ship_locationnum; } else { $amount = shift; $quantity = 1; @@ -3533,6 +3465,7 @@ sub charge { 'quantity' => $quantity, 'start_date' => $start_date, 'no_auto' => $no_auto, + 'locationnum'=> $locationnum, } ); $error = $cust_pkg->insert; @@ -4097,15 +4030,34 @@ sub ship_contact_firstlast { $contact->get('first') . ' '. $contact->get('last'); } -=item country_full +#XXX this doesn't work in 3.x+ +#=item country_full +# +#Returns this customer's full country name +# +#=cut +# +#sub country_full { +# my $self = shift; +# code2country($self->country); +#} -Returns this customer's full country name +=item county_state_county [ PREFIX ] + +Returns a string consisting of just the county, state and country. =cut -sub country_full { +sub county_state_country { my $self = shift; - code2country($self->country); + my $locationnum; + if ( @_ && $_[0] && $self->has_ship_address ) { + $locationnum = $self->ship_locationnum; + } else { + $locationnum = $self->bill_locationnum; + } + my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum }); + $cust_location->county_state_country; } =item geocode DATA_VENDOR @@ -4184,14 +4136,17 @@ sub cust_statuscolor { __PACKAGE__->statuscolors->{$self->cust_status}; } -=item tickets +=item tickets [ STATUS ] Returns an array of hashes representing the customer's RT tickets. +An optional status (or arrayref or hashref of statuses) may be specified. + =cut sub tickets { my $self = shift; + my $status = ( @_ && $_[0] ) ? shift : ''; my $num = $conf->config('cust_main-max_tickets') || 10; my @tickets = (); @@ -4199,7 +4154,12 @@ sub tickets { if ( $conf->config('ticket_system') ) { unless ( $conf->config('ticket_system-custom_priority_field') ) { - @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) }; + @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum, + $num, + undef, + $status, + ) + }; } else { @@ -4211,6 +4171,7 @@ sub tickets { @{ FS::TicketSystem->customer_tickets( $self->custnum, $num - scalar(@tickets), $priority, + $status, ) }; } @@ -4928,7 +4889,10 @@ sub queueable_print { sub print { my ($self, $template) = (shift, shift); - do_print [ $self->print_ps($template) ]; + do_print( + [ $self->print_ps($template) ], + 'agentnum' => $self->agentnum, + ); } #these three subs should just go away once agent stuff is all config overrides @@ -5033,49 +4997,13 @@ sub process_bill_and_collect { $cust_main->bill_and_collect( %$param ); } -=item process_censustract_update CUSTNUM - -Queueable function to update the census tract to the current year (as set in -the 'census_year' configuration variable) and retrieve the new tract code. - -=cut - -sub process_censustract_update { - eval "use FS::Misc::Geo qw(get_censustract)"; - die $@ if $@; - my $custnum = shift; - my $cust_main = qsearchs( 'cust_main', { custnum => $custnum }) - or die "custnum '$custnum' not found!\n"; - - my $new_year = $conf->config('census_year') or return; - my $new_tract = get_censustract({ $cust_main->location_hash }, $new_year); - if ( $new_tract =~ /^\d/ ) { - # then it's a tract code - $cust_main->set('censustract', $new_tract); - $cust_main->set('censusyear', $new_year); - - local($ignore_expired_card) = 1; - local($ignore_illegal_zip) = 1; - local($ignore_banned_card) = 1; - local($skip_fuzzyfiles) = 1; - local($import) = 1; #prevent automatic geocoding (need its own variable?) - my $error = $cust_main->replace; - die $error if $error; - } - else { - # it's an error message - die $new_tract; - } - return; -} - #starting to take quite a while for big dbs +# (JRNL: journaled so it only happens once per database) # - seq scan of h_cust_main (yuck), but not going to index paycvv, so -# - seq scan of cust_main on signupdate... index signupdate? will that help? -# - seq scan of cust_main on paydate... index on substrings? maybe set an -# upgrade journal flag now that we have that, yyyy-m-dd paydates are ancient -# - seq scan of cust_main on payinfo.. certainly not going toi ndex that... -# upgrade journal again? this is also an ancient problem +# JRNL seq scan of cust_main on signupdate... index signupdate? will that help? +# JRNL seq scan of cust_main on paydate... index on substrings? maybe set an +# JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that... +# JRNL leading/trailing spaces in first, last, company # - otaker upgrade? journal and call it good? (double check to make sure # we're not still setting otaker here) # @@ -5130,10 +5058,30 @@ sub _upgrade_data { #class method local($ignore_banned_card) = 1; local($skip_fuzzyfiles) = 1; local($import) = 1; #prevent automatic geocoding (need its own variable?) - $class->_upgrade_otaker(%opts); FS::cust_main::Location->_upgrade_data(%opts); + unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) { + + foreach my $cust_main ( qsearch({ + 'table' => 'cust_main', + 'hashref' => {}, + 'extra_sql' => 'WHERE '. + join(' OR ', + map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'", + qw( first last company ) + ), + }) ) { + my $error = $cust_main->replace; + die $error if $error; + } + + FS::upgrade_journal->set_done('cust_main__trimspaces'); + + } + + $class->_upgrade_otaker(%opts); + } =back diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm index 11247a28f..220f66a0c 100644 --- a/FS/FS/cust_main/Billing.pm +++ b/FS/FS/cust_main/Billing.pm @@ -21,6 +21,7 @@ use FS::cust_bill_pkg_tax_rate_location; use FS::part_event; use FS::part_event_condition; use FS::pkg_category; +use FS::Log; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -104,6 +105,9 @@ options of those methods are also available. sub bill_and_collect { my( $self, %options ) = @_; + my $log = FS::Log->new('bill_and_collect'); + $log->debug('start', object => $self, agentnum => $self->agentnum); + my $error; #$options{actual_time} not $options{time} because freeside-daily -d is for @@ -112,8 +116,13 @@ sub bill_and_collect { $options{'actual_time'} ||= time; my $job = $options{'job'}; + my $actual_time = ( $conf->exists('next-bill-ignore-time') + ? day_end( $options{actual_time} ) + : $options{actual_time} + ); + $job->update_statustext('0,cleaning expired packages') if $job; - $error = $self->cancel_expired_pkgs( day_end( $options{actual_time} ) ); + $error = $self->cancel_expired_pkgs( $actual_time ); if ( $error ) { $error = "Error expiring custnum ". $self->custnum. ": $error"; if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; } @@ -121,7 +130,7 @@ sub bill_and_collect { else { warn $error; } } - $error = $self->suspend_adjourned_pkgs( day_end( $options{actual_time} ) ); + $error = $self->suspend_adjourned_pkgs( $actual_time ); if ( $error ) { $error = "Error adjourning custnum ". $self->custnum. ": $error"; if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; } @@ -129,7 +138,7 @@ sub bill_and_collect { else { warn $error; } } - $error = $self->unsuspend_resumed_pkgs( day_end( $options{actual_time} ) ); + $error = $self->unsuspend_resumed_pkgs( $actual_time ); if ( $error ) { $error = "Error resuming custnum ".$self->custnum. ": $error"; if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; } @@ -168,6 +177,7 @@ sub bill_and_collect { } } $job->update_statustext('100,finished') if $job; + $log->debug('finish', object => $self, agentnum => $self->agentnum); ''; @@ -405,6 +415,7 @@ sub bill { my @precommit_hooks = (); $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks? + foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) { next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart}; @@ -426,6 +437,24 @@ sub bill { my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked; $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden); + # if this package was changed from another package, + # and it hasn't been billed since then, + # and package balances are enabled, + if ( $cust_pkg->change_pkgnum + and $cust_pkg->change_date >= ($cust_pkg->last_bill || 0) + and $cust_pkg->change_date < $invoice_time + and $conf->exists('pkg-balances') ) + { + # _transfer_balance will also create the appropriate credit + my @transfer_items = $self->_transfer_balance($cust_pkg); + # $part_pkg[0] is the "real" part_pkg + my $pass = ($cust_pkg->no_auto || $part_pkg[0]->no_auto) ? + 'no_auto' : ''; + push @{ $cust_bill_pkg{$pass} }, @transfer_items; + # treating this as recur, just because most charges are recur... + ${$total_recur{$pass}} += $_->recur foreach @transfer_items; + } + foreach my $part_pkg ( @part_pkg ) { $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill ); @@ -682,8 +711,6 @@ sub _omit_zero_value_bundles { =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME -This is a weird one. Perhaps it should not even be exposed. - Generates tax line items (see L<FS::cust_bill_pkg>) for this customer. Usually used internally by bill method B<bill>. @@ -750,16 +777,18 @@ sub calculate_taxes { # values are arrayrefs of cust_bill_pkg_tax_rate_location hashrefs my %tax_rate_location = (); - # keys are taxnums (not internal identifiers!) + # keys are taxlisthash keys (internal identifiers!) # values are arrayrefs of cust_tax_exempt_pkg objects my %tax_exemption; foreach my $tax ( keys %$taxlisthash ) { - # $tax is a tax identifier + # $tax is a tax identifier (intersection of a tax definition record + # and a cust_bill_pkg record) my $tax_object = shift @{ $taxlisthash->{$tax} }; # $tax_object is a cust_main_county or tax_rate - # (with pkgnum and locationnum set) - # the rest of @{ $taxlisthash->{$tax} } is cust_bill_pkg objects + # (with billpkgnum, pkgnum, locationnum set) + # the rest of @{ $taxlisthash->{$tax} } is cust_bill_pkg component objects + # (setup, recurring, usage classes) warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2; warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2; # taxline calculates the tax on all cust_bill_pkgs in the @@ -768,44 +797,35 @@ sub calculate_taxes { # It also calculates exemptions and attaches them to the cust_bill_pkgs # in the argument. my $taxables = $taxlisthash->{$tax}; - my $exemptions = $tax_exemption{$tax_object->taxnum} ||= []; - my $hashref_or_error = - $tax_object->taxline( $taxables, + my $exemptions = $tax_exemption{$tax} ||= []; + my $taxline = $tax_object->taxline( + $taxables, 'custnum' => $self->custnum, 'invoice_time' => $invoice_time, 'exemptions' => $exemptions, ); - return $hashref_or_error unless ref($hashref_or_error); - - # then collect any new exemptions generated for this tax - push @$exemptions, @{ $_->cust_tax_exempt_pkg } - foreach @$taxables; + return $taxline unless ref($taxline); unshift @{ $taxlisthash->{$tax} }, $tax_object; - my $name = $hashref_or_error->{'name'}; - my $amount = $hashref_or_error->{'amount'}; + if ( $tax_object->isa('FS::cust_main_county') ) { + # then $taxline is a real line item + push @{ $taxname{ $taxline->itemdesc } }, $taxline; - #warn "adding $amount as $name\n"; - $taxname{ $name } ||= []; - push @{ $taxname{ $name } }, $tax; + } else { + # leave this as is for now - $tax_amount{ $tax } += $amount; + my $name = $taxline->{'name'}; + my $amount = $taxline->{'amount'}; - # link records between cust_main_county/tax_rate and cust_location - $tax_location{ $tax } ||= []; - $tax_rate_location{ $tax } ||= []; - if ( ref($tax_object) eq 'FS::cust_main_county' ) { - push @{ $tax_location{ $tax } }, - { - 'taxnum' => $tax_object->taxnum, - 'taxtype' => ref($tax_object), - 'pkgnum' => $tax_object->get('pkgnum'), - 'locationnum' => $tax_object->get('locationnum'), - 'amount' => sprintf('%.2f', $amount ), - }; - } - elsif ( ref($tax_object) eq 'FS::tax_rate' ) { + #warn "adding $amount as $name\n"; + $taxname{ $name } ||= []; + push @{ $taxname{ $name } }, $tax; + + $tax_amount{ $tax } += $amount; + + # link records between cust_main_county/tax_rate and cust_location + $tax_rate_location{ $tax } ||= []; my $taxratelocationnum = $tax_object->tax_rate_location->taxratelocationnum; push @{ $tax_rate_location{ $tax } }, @@ -816,54 +836,52 @@ sub calculate_taxes { '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 ) { - my $taxables = $taxlisthash->{$tax}; - my $tax_object = shift @$taxables; # the rest are line items - foreach my $cust_bill_pkg ( @$taxables ) { - next unless ref($cust_bill_pkg) eq 'FS::cust_bill_pkg'; - - my @cust_tax_exempt_pkg = splice @{ $cust_bill_pkg->cust_tax_exempt_pkg }; - - next unless @cust_tax_exempt_pkg; - # get the non-disintegrated version - my $real_cust_bill_pkg = $packagemap{$cust_bill_pkg->pkgnum} - or die "can't distribute tax exemptions: no line item for ". - Dumper($_). " in packagemap ". - join(',', sort {$a<=>$b} keys %packagemap). "\n"; - - push @{ $real_cust_bill_pkg->cust_tax_exempt_pkg }, - @cust_tax_exempt_pkg; - } - } + } #if ref($tax_object)... + } #foreach keys %$taxlisthash #consolidate and create tax line items warn "consolidating and generating...\n" if $DEBUG > 2; foreach my $taxname ( keys %taxname ) { + my @cust_bill_pkg_tax_location; + my @cust_bill_pkg_tax_rate_location; + my $tax_cust_bill_pkg = FS::cust_bill_pkg->new({ + 'pkgnum' => 0, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + 'itemdesc' => $taxname, + 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location, + 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location, + }); + my $tax_total = 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}++; - warn "adding $tax_amount{$taxitem}\n" if $DEBUG > 1; - $tax_total += $tax_amount{$taxitem}; - 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 } }; + if ( ref($taxitem) eq 'FS::cust_bill_pkg' ) { + # then we need to transfer the amount and the links from the + # line item to the new one we're creating. + $tax_total += $taxitem->setup; + foreach my $link ( @{ $taxitem->get('cust_bill_pkg_tax_location') } ) { + $link->set('tax_cust_bill_pkg', $tax_cust_bill_pkg); + push @cust_bill_pkg_tax_location, $link; + } + } else { + # the tax_rate way + next if $seen{$taxitem}++; + warn "adding $tax_amount{$taxitem}\n" if $DEBUG > 1; + $tax_total += $tax_amount{$taxitem}; + push @cust_bill_pkg_tax_rate_location, + map { new FS::cust_bill_pkg_tax_rate_location $_ } + @{ $tax_rate_location{ $taxitem } }; + } } next unless $tax_total; + # we should really neverround this up...I guess it's okay if taxline + # already returns amounts with 2 decimal places $tax_total = sprintf('%.2f', $tax_total ); + $tax_cust_bill_pkg->set('setup', $tax_total); my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname, 'disabled' => '', @@ -881,19 +899,9 @@ sub calculate_taxes { push @display, new FS::cust_bill_pkg_display { type => 'S', %hash }; } + $tax_cust_bill_pkg->set('display', \@display); - push @tax_line_items, new FS::cust_bill_pkg { - 'pkgnum' => 0, - 'setup' => $tax_total, - 'recur' => 0, - '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, - }; - + push @tax_line_items, $tax_cust_bill_pkg; } \@tax_line_items; @@ -930,6 +938,11 @@ sub _make_lines { $cust_pkg->pkgpart($part_pkg->pkgpart); + my $cmp_time = ( $conf->exists('next-bill-ignore-time') + ? day_end( $time ) + : $time + ); + ### # bill setup ### @@ -938,12 +951,14 @@ sub _make_lines { my $unitsetup = 0; my @setup_discounts = (); my %setup_param = ( 'discounts' => \@setup_discounts ); + my $setup_billed_currency = ''; + my $setup_billed_amount = 0; if ( ! $options{recurring_only} and ! $options{cancel} and ( $options{'resetup'} || ( ! $cust_pkg->setup && ( ! $cust_pkg->start_date - || $cust_pkg->start_date <= day_end($time) + || $cust_pkg->start_date <= $cmp_time ) && ( ! $conf->exists('disable_setup_suspended_pkgs') || ( $conf->exists('disable_setup_suspended_pkgs') && @@ -964,7 +979,13 @@ sub _make_lines { return "$@ running calc_setup for $cust_pkg\n" if $@; - $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh + $unitsetup = $cust_pkg->base_setup() + || $setup; #XXX uuh + + if ( $setup_param{'billed_currency'} ) { + $setup_billed_currency = delete $setup_param{'billed_currency'}; + $setup_billed_amount = delete $setup_param{'billed_amount'}; + } } $cust_pkg->setfield('setup', $time) @@ -984,6 +1005,8 @@ sub _make_lines { my $recur = 0; my $unitrecur = 0; my @recur_discounts = (); + my $recur_billed_currency = ''; + my $recur_billed_amount = 0; my $sdate; if ( ! $cust_pkg->start_date and ( ! $cust_pkg->susp || $cust_pkg->option('suspend_bill',1) @@ -991,7 +1014,7 @@ sub _make_lines { && ! $cust_pkg->option('no_suspend_bill',1) ) and - ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= day_end($time) ) + ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= $cmp_time ) || ( $part_pkg->plan eq 'voip_cdr' && $part_pkg->option('bill_every_call') ) @@ -1015,7 +1038,7 @@ sub _make_lines { #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 ) <= day_end($time) + && ( $cust_pkg->getfield('bill') || 0 ) <= $cmp_time && !$options{cancel} ); my %param = ( %setup_param, @@ -1043,13 +1066,40 @@ sub _make_lines { if ( $@ ); #base_cancel??? - $unitrecur = $cust_pkg->part_pkg->base_recur || $recur; #XXX uuh + $unitrecur = $cust_pkg->base_recur( \$sdate ) || $recur; #XXX uuh, better + + if ( $param{'billed_currency'} ) { + $recur_billed_currency = delete $param{'billed_currency'}; + $recur_billed_amount = delete $param{'billed_amount'}; + } if ( $increment_next_bill ) { - my $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0); + my $next_bill; + + if ( my $main_pkg = $cust_pkg->main_pkg ) { + # supplemental package + # to keep in sync with the main package, simulate billing at + # its frequency + my $main_pkg_freq = $main_pkg->part_pkg->freq; + my $supp_pkg_freq = $part_pkg->freq; + my $ratio = $supp_pkg_freq / $main_pkg_freq; + if ( $ratio != int($ratio) ) { + # the UI should prevent setting up packages like this, but just + # in case + return "supplemental package period is not an integer multiple of main package period"; + } + $next_bill = $sdate; + for (1..$ratio) { + $next_bill = $part_pkg->add_freq( $next_bill, $main_pkg_freq ); + } + + } else { + # the normal case + $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0); return "unparsable frequency: ". $part_pkg->freq if $next_bill == -1; + } #pro-rating magic - if $recur_prog fiddled $sdate, want to use that # only for figuring next bill date, nothing else, so, reset $sdate again @@ -1138,16 +1188,20 @@ sub _make_lines { push @details, @cust_pkg_detail; my $cust_bill_pkg = new FS::cust_bill_pkg { - 'pkgnum' => $cust_pkg->pkgnum, - 'setup' => $setup, - 'unitsetup' => $unitsetup, - 'recur' => $recur, - 'unitrecur' => $unitrecur, - 'quantity' => $cust_pkg->quantity, - 'details' => \@details, - 'discounts' => [ @setup_discounts, @recur_discounts ], - 'hidden' => $part_pkg->hidden, - 'freq' => $part_pkg->freq, + 'pkgnum' => $cust_pkg->pkgnum, + 'setup' => $setup, + 'unitsetup' => $unitsetup, + 'setup_billed_currency' => $setup_billed_currency, + 'setup_billed_amount' => $setup_billed_amount, + 'recur' => $recur, + 'unitrecur' => $unitrecur, + 'recur_billed_currency' => $recur_billed_currency, + 'recur_billed_amount' => $recur_billed_amount, + 'quantity' => $cust_pkg->quantity, + 'details' => \@details, + 'discounts' => [ @setup_discounts, @recur_discounts ], + 'hidden' => $part_pkg->hidden, + 'freq' => $part_pkg->freq, }; if ( $part_pkg->option('prorate_defer_bill',1) @@ -1159,7 +1213,7 @@ sub _make_lines { $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->recur_temporality eq 'upcoming' ) { + } else { #if ( $part_pkg->recur_temporality eq 'upcoming' ) $cust_bill_pkg->sdate( $sdate ); $cust_bill_pkg->edate( $cust_pkg->bill ); #$cust_bill_pkg->edate( $time ) if $options{cancel}; @@ -1175,11 +1229,23 @@ sub _make_lines { # handle taxes ### - unless ( $discount_show_always ) { - my $error = - $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options); - return $error if $error; - } + #unless ( $discount_show_always ) { # oh, for god's sake + my $error = $self->_handle_taxes( + $part_pkg, + $taxlisthash, + $cust_bill_pkg, + $cust_pkg, + $options{invoice_time}, + $real_pkgpart, + \%options # I have serious objections to this + ); + return $error if $error; + #} + + $cust_bill_pkg->set_display( + part_pkg => $part_pkg, + real_pkgpart => $real_pkgpart, + ); push @$cust_bill_pkgs, $cust_bill_pkg; @@ -1191,6 +1257,108 @@ sub _make_lines { } +=item _transfer_balance TO_PKG [ FROM_PKGNUM ] + +Takes one argument, a cust_pkg object that is being billed. This will +be called only if the package was created by a package change, and has +not been billed since the package change, and package balance tracking +is enabled. The second argument can be an alternate package number to +transfer the balance from; this should not be used externally. + +Transfers the balance from the previous package (now canceled) to +this package, by crediting one package and creating an invoice item for +the other. Inserts the credit and returns the invoice item (so that it +can be added to an invoice that's being built). + +If the previous package was never billed, and was also created by a package +change, then this will also transfer the balance from I<its> previous +package, and so on, until reaching a package that either has been billed +or was not created by a package change. + +=cut + +my $balance_transfer_reason; + +sub _transfer_balance { + my $self = shift; + my $cust_pkg = shift; + my $from_pkgnum = shift || $cust_pkg->change_pkgnum; + my $from_pkg = FS::cust_pkg->by_key($from_pkgnum); + + my @transfers; + + # if $from_pkg is not the first package in the chain, and it was never + # billed, walk back + if ( $from_pkg->change_pkgnum and scalar($from_pkg->cust_bill_pkg) == 0 ) { + @transfers = $self->_transfer_balance($cust_pkg, $from_pkg->change_pkgnum); + } + + my $prev_balance = $self->balance_pkgnum($from_pkgnum); + if ( $prev_balance != 0 ) { + $balance_transfer_reason ||= FS::reason->new_or_existing( + 'reason' => 'Package balance transfer', + 'type' => 'Internal adjustment', + 'class' => 'R' + ); + + my $credit = FS::cust_credit->new({ + 'custnum' => $self->custnum, + 'amount' => abs($prev_balance), + 'reasonnum' => $balance_transfer_reason->reasonnum, + '_date' => $cust_pkg->change_date, + }); + + my $cust_bill_pkg = FS::cust_bill_pkg->new({ + 'setup' => 0, + 'recur' => abs($prev_balance), + #'sdate' => $from_pkg->last_bill, # not sure about this + #'edate' => $cust_pkg->change_date, + 'itemdesc' => $self->mt('Previous Balance, [_1]', + $from_pkg->part_pkg->pkg), + }); + + if ( $prev_balance > 0 ) { + # credit the old package, charge the new one + $credit->set('pkgnum', $from_pkgnum); + $cust_bill_pkg->set('pkgnum', $cust_pkg->pkgnum); + } else { + # the reverse + $credit->set('pkgnum', $cust_pkg->pkgnum); + $cust_bill_pkg->set('pkgnum', $from_pkgnum); + } + my $error = $credit->insert; + die "error transferring package balance from #".$from_pkgnum. + " to #".$cust_pkg->pkgnum.": $error\n" if $error; + + push @transfers, $cust_bill_pkg; + } # $prev_balance != 0 + + return @transfers; +} + +=item _handle_taxes PART_PKG TAXLISTHASH CUST_BILL_PKG CUST_PKG TIME PKGPART [ OPTIONS ] + +This is _handle_taxes. It's called once for each cust_bill_pkg generated +from _make_lines, along with the part_pkg, cust_pkg, invoice time, the +non-overridden pkgpart, a flag indicating whether the package is being +canceled, and a partridge in a pear tree. + +The most important argument is 'taxlisthash'. This is shared across the +entire invoice. It looks like this: +{ + 'cust_main_county 1001' => [ [FS::cust_main_county], ... ], + 'cust_main_county 1002' => [ [FS::cust_main_county], ... ], +} + +'cust_main_county' can also be 'tax_rate'. The first object in the array +is always the cust_main_county or tax_rate identified by the key. + +That "..." is a list of FS::cust_bill_pkg objects that will be fed to +the 'taxline' method to calculate the amount of the tax. This doesn't +happen until calculate_taxes, though. + +=cut + sub _handle_taxes { my $self = shift; my $part_pkg = shift; @@ -1203,171 +1371,152 @@ sub _handle_taxes { local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG; - my %cust_bill_pkg = (); - my %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 && !$options->{cancel}); - push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel}); - - my $exempt = $conf->exists('cust_class-tax_exempt') - ? ( $self->cust_class ? $self->cust_class->tax : '' ) - : $self->tax; - # standardize this just to be sure - $exempt = ($exempt eq 'Y') ? 'Y' : ''; - - #if ( $exempt !~ /Y/i && $self->payby ne 'COMP' ) { - if ( $self->payby ne 'COMP' ) { - - if ( $conf->exists('enable_taxproducts') - && ( scalar($part_pkg->part_pkg_taxoverride) - || $part_pkg->has_taxproduct - ) - ) - { + return if ( $self->payby eq 'COMP' ); #dubious - if ( !$exempt ) { + if ( $conf->exists('enable_taxproducts') + && ( scalar($part_pkg->part_pkg_taxoverride) + || $part_pkg->has_taxproduct + ) + ) + { - foreach my $class (@classes) { - my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $cust_pkg ); - return $err_or_ref unless ref($err_or_ref); - $taxes{$class} = $err_or_ref; - } + # EXTERNAL TAX RATES (via tax_rate) + my %cust_bill_pkg = (); + my %taxes = (); + + my @classes; + #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U'; + push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage; + # debatable + push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel}); + push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel}); + + my $exempt = $conf->exists('cust_class-tax_exempt') + ? ( $self->cust_class ? $self->cust_class->tax : '' ) + : $self->tax; + # standardize this just to be sure + $exempt = ($exempt eq 'Y') ? 'Y' : ''; + + if ( !$exempt ) { - unless (exists $taxes{''}) { - my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $cust_pkg ); - return $err_or_ref unless ref($err_or_ref); - $taxes{''} = $err_or_ref; - } + foreach my $class (@classes) { + my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $cust_pkg ); + return $err_or_ref unless ref($err_or_ref); + $taxes{$class} = $err_or_ref; + } + unless (exists $taxes{''}) { + my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $cust_pkg ); + return $err_or_ref unless ref($err_or_ref); + $taxes{''} = $err_or_ref; } - } else { # cust_main_county tax system + } - # We fetch taxes even if the customer is completely exempt, - # because we need to record that fact. + my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate; + foreach my $key (keys %tax_cust_bill_pkg) { + # $key is "setup", "recur", or a usage class name. ('' is a usage class.) + # $tax_cust_bill_pkg{$key} is a cust_bill_pkg for that component of + # the line item. + # $taxes{$key} is an arrayref of cust_main_county or tax_rate objects that + # apply to $key-class charges. + my @taxes = @{ $taxes{$key} || [] }; + my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key}; + + my %localtaxlisthash = (); + foreach my $tax ( @taxes ) { + + # this is the tax identifier, not the taxname + my $taxname = ref( $tax ). ' '. $tax->taxnum; + $taxname .= ' billpkgnum'. $cust_bill_pkg->billpkgnum; + # We need to create a separate $taxlisthash entry for each billpkgnum + # on the invoice, so that cust_bill_pkg_tax_location records will + # be linked correctly. + + # $taxlisthash: keys are "setup", "recur", and usage classes. + # Values are arrayrefs, first the tax object (cust_main_county + # or tax_rate) and then any cust_bill_pkg objects that the + # tax applies to. + $taxlisthash->{ $taxname } ||= [ $tax ]; + push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg; + + $localtaxlisthash{ $taxname } ||= [ $tax ]; + push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg; - my @loc_keys = qw( district city county state country ); - my $location = $cust_pkg->tax_location; - my %taxhash = map { $_ => $location->$_ } @loc_keys; + } - $taxhash{'taxclass'} = $part_pkg->taxclass; + 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; + # we're calling taxline() right here? wtf? + 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}; - warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2; + } + } + } - my @taxes = (); # entries are cust_main_county objects - my %taxhash_elim = %taxhash; - my @elim = qw( district city county state ); - do { + } else { - #first try a match with taxclass - @taxes = qsearch( 'cust_main_county', \%taxhash_elim ); + # INTERNAL TAX RATES (cust_main_county) - if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) { - #then try a match without taxclass - my %no_taxclass = %taxhash_elim; - $no_taxclass{ 'taxclass' } = ''; - @taxes = qsearch( 'cust_main_county', \%no_taxclass ); - } + # We fetch taxes even if the customer is completely exempt, + # because we need to record that fact. - $taxhash_elim{ shift(@elim) } = ''; + my @loc_keys = qw( district city county state country ); + my $location = $cust_pkg->tax_location; + my %taxhash = map { $_ => $location->$_ } @loc_keys; - } while ( !scalar(@taxes) && scalar(@elim) ); + $taxhash{'taxclass'} = $part_pkg->taxclass; - foreach (@taxes) { - # These could become cust_bill_pkg_tax_location records, - # or cust_tax_exempt_pkg. We'll decide later. - $_->set('pkgnum', $cust_pkg->pkgnum); - $_->set('locationnum', $cust_pkg->tax_locationnum); - } + warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2; - $taxes{''} = [ @taxes ]; - $taxes{'setup'} = [ @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) ); - # } - - } #if $conf->exists('enable_taxproducts') ... - - } # if $self->payby eq 'COMP' - - #what's this doing in the middle of _handle_taxes? probably should split - #this into three parts above in _make_lines - $cust_bill_pkg->set_display( part_pkg => $part_pkg, - real_pkgpart => $real_pkgpart, - ); - - my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate; - foreach my $key (keys %tax_cust_bill_pkg) { - # $key is "setup", "recur", or a usage class name. ('' is a usage class.) - # $tax_cust_bill_pkg{$key} is a cust_bill_pkg for that component of - # the line item. - # $taxes{$key} is an arrayref of cust_main_county or tax_rate objects that - # apply to $key-class charges. - my @taxes = @{ $taxes{$key} || [] }; - my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key}; - - my %localtaxlisthash = (); - foreach my $tax ( @taxes ) { - - # this is the tax identifier, not the taxname - my $taxname = ref( $tax ). ' '. $tax->taxnum; - $taxname .= ' pkgnum'. $cust_pkg->pkgnum; - # We need to create a separate $taxlisthash entry for each pkgnum - # on the invoice, so that cust_bill_pkg_tax_location records will - # be linked correctly. - - # $taxlisthash: keys are "setup", "recur", and usage classes. - # Values are arrayrefs, first the tax object (cust_main_county - # or tax_rate) and then any cust_bill_pkg objects that the - # tax applies to. - $taxlisthash->{ $taxname } ||= [ $tax ]; - push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg; - - $localtaxlisthash{ $taxname } ||= [ $tax ]; - push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg; + my @taxes = (); # entries are cust_main_county objects + my %taxhash_elim = %taxhash; + my @elim = qw( district city county state ); + do { - } + #first try a match with taxclass + @taxes = qsearch( 'cust_main_county', \%taxhash_elim ); - 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'); + if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) { + #then try a match without taxclass + my %no_taxclass = %taxhash_elim; + $no_taxclass{ 'taxclass' } = ''; + @taxes = qsearch( 'cust_main_county', \%no_taxclass ); + } - foreach my $tot ( $tax_object->tax_on_tax( $self ) ) { - my $totname = ref( $tot ). ' '. $tot->taxnum; + $taxhash_elim{ shift(@elim) } = ''; - 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}; + } while ( !scalar(@taxes) && scalar(@elim) ); - } + foreach (@taxes) { + my $tax_id = 'cust_main_county '.$_->taxnum; + $taxlisthash->{$tax_id} ||= [ $_ ]; + push @{ $taxlisthash->{$tax_id} }, $cust_bill_pkg; } } - ''; } @@ -1800,8 +1949,9 @@ sub due_cust_event { #??? #my $DEBUG = $opt{'debug'} + $opt{'debug'} ||= 0; # silence some warnings local($DEBUG) = $opt{'debug'} - if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG; + if $opt{'debug'} > $DEBUG; $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG; warn "$me due_cust_event called with options ". diff --git a/FS/FS/cust_main/Billing_Realtime.pm b/FS/FS/cust_main/Billing_Realtime.pm index f9f90a7dc..1caa3e5af 100644 --- a/FS/FS/cust_main/Billing_Realtime.pm +++ b/FS/FS/cust_main/Billing_Realtime.pm @@ -111,7 +111,7 @@ 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 methods are: I<CC>, I<ECHECK>, I<LEC>, and I<PAYPAL> Available optional arguments are: I<description>, I<invnum>, I<apply>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id> @@ -170,15 +170,8 @@ sub _bop_recurring_billing { } 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 1 if the payinfo has been used for another payment + return $self->payinfo_used($opt{'payinfo'}); # in payinfo_Mixin } @@ -307,7 +300,10 @@ sub _bop_content { ? $options->{country} : $self->country; - $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/ + #3.0 is a good a time as any to get rid of this... add a config to pass it + # if anyone still needs it + #$content{referer} = 'http://cleanwhisker.420.am/'; + $content{phone} = $self->daytime || $self->night; my $currency = $conf->exists('business-onlinepayment-currency') @@ -321,6 +317,7 @@ my %bop_method2payby = ( 'CC' => 'CARD', 'ECHECK' => 'CHEK', 'LEC' => 'LECB', + 'PAYPAL' => 'PPAL', ); sub realtime_bop { @@ -616,6 +613,7 @@ sub realtime_bop { %$bop_content, 'reference' => $cust_pay_pending->paypendingnum, #for now 'callback_url' => $payment_gateway->gateway_callback_url, + 'cancel_url' => $payment_gateway->gateway_cancel_url, 'email' => $email, %content, #after ); @@ -761,19 +759,6 @@ sub fake_bop { return "Error: No error; test failure requested with fake_failure"; } - #my $paybatch = ''; - #if ( $payment_gateway->gatewaynum ) { # agent override - # $paybatch = $payment_gateway->gatewaynum. '-'; - #} - # - #$paybatch .= "$processor:". $transaction->authorization; - # - #$paybatch .= ':'. $transaction->order_number - # if $transaction->can('order_number') - # && length($transaction->order_number); - - my $paybatch = 'FakeProcessor:54:32'; - my $cust_pay = new FS::cust_pay ( { 'custnum' => $self->custnum, 'invnum' => $options{'invnum'}, @@ -782,9 +767,11 @@ sub fake_bop { 'payby' => $bop_method2payby{$options{method}}, #'payinfo' => $payinfo, 'payinfo' => '4111111111111111', - 'paybatch' => $paybatch, #'paydate' => $paydate, 'paydate' => '2012-05-01', + 'processor' => 'FakeProcessor', + 'auth' => '54', + 'order_number' => '32', } ); $cust_pay->payunique( $options{payunique} ) if length($options{payunique}); @@ -845,17 +832,8 @@ sub _realtime_bop_result { 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 $order_number = $transaction->order_number + if $transaction->can('order_number'); my $cust_pay = new FS::cust_pay ( { 'custnum' => $self->custnum, @@ -864,10 +842,14 @@ sub _realtime_bop_result { '_date' => '', 'payby' => $cust_pay_pending->payby, 'payinfo' => $options{'payinfo'}, - 'paybatch' => $paybatch, 'paydate' => $cust_pay_pending->paydate, 'pkgnum' => $cust_pay_pending->pkgnum, - 'discount_term' => $options{'discount_term'}, + 'discount_term' => $options{'discount_term'}, + 'gatewaynum' => ($payment_gateway->gatewaynum || ''), + 'processor' => $payment_gateway->gateway_module, + 'auth' => $transaction->authorization, + 'order_number' => $order_number || '', + } ); #doesn't hurt to know, even though the dup check is in cust_pay_pending now $cust_pay->payunique( $options{payunique} ) @@ -1240,7 +1222,11 @@ sub realtime_botpp_capture { 'amount' => $cust_pay_pending->paid, #'invoice_number' => $options{'invnum'}, 'customer_id' => $self->custnum, - 'referer' => 'http://cleanwhisker.420.am/', + + #3.0 is a good a time as any to get rid of this... add a config to pass it + # if anyone still needs it + #'referer' => 'http://cleanwhisker.420.am/', + 'reference' => $cust_pay_pending->paypendingnum, 'email' => $email, 'phone' => $self->daytime || $self->night, @@ -1363,6 +1349,7 @@ sub realtime_refund_bop { my( $processor, $login, $password, @bop_options, $namespace ) ; my( $auth, $order_number ) = ( '', '', '' ); + my $gatewaynum = ''; if ( $options{'paynum'} ) { @@ -1371,11 +1358,22 @@ sub realtime_refund_bop { 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 ( $cust_pay->get('processor') ) { + ($gatewaynum, $processor, $auth, $order_number) = + ( + $cust_pay->gatewaynum, + $cust_pay->processor, + $cust_pay->auth, + $cust_pay->order_number, + ); + } else { + # this payment wasn't upgraded, which probably means this won't work, + # but try it anyway + $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/ + or return "Can't parse paybatch for paynum $options{'paynum'}: ". + $cust_pay->paybatch; + ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 ); + } if ( $gatewaynum ) { #gateway for the payment to be refunded @@ -1438,12 +1436,19 @@ sub realtime_refund_bop { 'password' => $password, 'order_number' => $order_number, 'amount' => $amount, - 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/ + + #3.0 is a good a time as any to get rid of this... add a config to pass it + # if anyone still needs it + #'referer' => 'http://cleanwhisker.420.am/', ); $content{authorization} = $auth if length($auth); #echeck/ACH transactions have an order # but no auth #(at least with authorize.net) + my $currency = $conf->exists('business-onlinepayment-currency') + && $conf->config('business-onlinepayment-currency'); + $content{currency} = $currency if $currency; + my $disable_void_after; if ($conf->exists('disable_void_after') && $conf->config('disable_void_after') =~ /^(\d+)$/) { @@ -1598,9 +1603,7 @@ sub realtime_refund_bop { return "$processor error: ". $refund->error_message unless $refund->is_success(); - my $paybatch = "$processor:". $refund->authorization; - $paybatch .= ':'. $refund->order_number - if $refund->can('order_number') && $refund->order_number; + $order_number = $refund->order_number if $refund->can('order_number'); while ( $cust_pay && $cust_pay->unapplied < $amount ) { my @cust_bill_pay = $cust_pay->cust_bill_pay; @@ -1617,8 +1620,11 @@ sub realtime_refund_bop { '_date' => '', 'payby' => $bop_method2payby{$options{method}}, 'payinfo' => $payinfo, - 'paybatch' => $paybatch, 'reason' => $options{'reason'} || 'card or ACH refund', + 'gatewaynum' => $gatewaynum, # may be null + 'processor' => $processor, + 'auth' => $refund->authorization, + 'order_number' => $order_number, } ); my $error = $cust_refund->insert; if ( $error ) { diff --git a/FS/FS/cust_main/Billing_ThirdParty.pm b/FS/FS/cust_main/Billing_ThirdParty.pm new file mode 100644 index 000000000..faced8f2b --- /dev/null +++ b/FS/FS/cust_main/Billing_ThirdParty.pm @@ -0,0 +1,266 @@ +package FS::cust_main::Billing_ThirdParty; + +use strict; +use vars qw( $DEBUG $me ); +use FS::Record qw( qsearch qsearchs dbh ); +use FS::cust_pay; +use FS::cust_pay_pending; + +$DEBUG = 0; +$me = '[FS::cust_main::Billing_ThirdParty]'; +# arguably doesn't even belong under cust_main... + +=head1 METHODS + +=over 4 + +=item create_payment OPTIONS + +Create a pending payment for a third-party gateway. OPTIONS must include: +- method: a Business::OnlineThirdPartyPayment method argument. Currently + only supports PAYPAL. +- amount: a decimal amount. Unlike in Billing_Realtime, there is NO default. +- session_id: the customer's self-service session ID. + +and may optionally include: +- invnum: the invoice that this payment will apply to +- pkgnum: the package balance that this payment will apply to. +- description: the transaction description for the gateway. +- payip: the IP address the payment is initiated from + +On failure, returns a simple string error message. On success, returns +a hashref of 'url' => the URL to redirect the user to to complete payment, +and optionally 'post_params' => a hashref of name/value pairs to be POSTed +to that URL. + +=cut + +my @methods = qw(PAYPAL CC); +my %method2payby = ( 'PAYPAL' => 'PPAL', 'CC' => 'MCRD' ); + +sub create_payment { + my $self = shift; + my %opt = @_; + + # avoid duplicating this--we just need description and invnum + my $defaults; + $self->_bop_defaults($defaults); + + my $method = $opt{'method'} or return 'method required'; + my $amount = $opt{'amount'} or return 'amount required'; + return "unknown method '$method'" unless grep {$_ eq $method} @methods; + return "amount must be > 0" unless $amount > 0; + return "session_id required" unless length($opt{'session_id'}); + + my $gateway = $self->agent->payment_gateway( + method => $method, + nofatal => 1, + thirdparty => 1, + ); + return "no third-party gateway enabled for method $method" if !$gateway; + + # create pending record + $self->select_for_update; + my @pending = qsearch('cust_pay_pending', { + 'custnum' => $self->custnum, + 'status' => { op=>'!=', value=>'done' } + }); + + # if there are pending payments in the 'thirdparty' state, + # we can safely remove them + foreach (@pending) { + if ( $_->status eq 'thirdparty' ) { + my $error = $_->delete; + return "Error deleting unfinished payment #". + $_->paypendingnum . ": $error\n" if $error; + } else { + return "A payment is already being processed for this customer."; + } + } + + my $cpp = FS::cust_pay_pending->new({ + 'custnum' => $self->custnum, + 'status' => 'new', + 'gatewaynum' => $gateway->gatewaynum, + 'paid' => sprintf('%.2f',$opt{'amount'}), + 'payby' => $method2payby{ $opt{'method'} }, + 'pkgnum' => $opt{'pkgnum'}, + 'invnum' => $opt{'invnum'} || $defaults->{'invnum'}, + 'session_id' => $opt{'session_id'}, + }); + + my $error = $cpp->insert; + return $error if $error; + + my $transaction = $gateway->processor; + # Not included in this content hash: + # payinfo, paydate, paycvv, any kind of recurring billing indicator, + # paystate, paytype (account type), stateid, ss, payname + # + # Also, unlike bop_realtime, we don't allow the magical %options hash + # to override the customer's information. If they need to enter a + # different address or something for the billing provider, they can do + # that after the redirect. + my %content = ( + 'action' => 'create', + 'description' => $opt{'description'} || $defaults->{'description'}, + 'amount' => $amount, + 'customer_id' => $self->custnum, + 'email' => $self->invoicing_list_emailonly_scalar, + 'customer_ip' => $opt{'payip'}, + 'first_name' => $self->first, + 'last_name' => $self->last, + 'address1' => $self->address1, + 'address2' => $self->address2, + 'city' => $self->city, + 'state' => $self->state, + 'zip' => $self->zip, + 'country' => $self->country, + 'phone' => ($self->daytime || $self->night), + ); + + { + local $@; + eval { $transaction->create(%content) }; + if ( $@ ) { + warn "ERROR: Executing third-party payment:\n$@\n"; + return { error => $@ }; + } + } + + if ($transaction->is_success) { + $cpp->status('thirdparty'); + # for whatever is most identifiable as the "transaction ID" + $cpp->payinfo($transaction->token); + # for anything else the transaction needs to remember + $cpp->statustext($transaction->statustext); + $error = $cpp->replace; + return $error if $error; + + return {url => $transaction->redirect, + post_params => $transaction->post_params}; + + } else { + $cpp->status('done'); + $cpp->statustext($transaction->error_message); + $error = $cpp->replace; + return $error if $error; + + return $transaction->error_message; + } + +} + +=item execute_payment SESSION_ID, PARAMS + +Complete the payment and get the status. Triggered from the return_url +handler; PARAMS are all of the CGI parameters we received in the redirect. +On failure, returns an error message. On success, returns a hashref of +'paynum', 'paid', 'order_number', and 'auth'. + +=cut + +sub execute_payment { + my $self = shift; + my $session_id = shift; + my %params = @_; + + my $cpp = qsearchs('cust_pay_pending', { + 'session_id' => uc($session_id), + 'custnum' => $self->custnum, + 'status' => 'thirdparty', + }) + or return 'no payment in process for this session'; + + my $gateway = FS::payment_gateway->by_key( $cpp->gatewaynum ); + my $transaction = $gateway->processor; + $transaction->token($cpp->payinfo); + $transaction->statustext($cpp->statustext); + + { + local $@; + eval { $transaction->execute(%params) }; + if ( $@ ) { + warn "ERROR: Executing third-party payment:\n$@\n"; + return { error => $@ }; + } + } + + my $error; + + if ( $transaction->is_success ) { + + $error = $cpp->approve( + 'processor' => $gateway->gateway_module, + 'order_number' => $transaction->order_number, + 'auth' => $transaction->authorization, + 'payinfo' => '', + 'apply' => 1, + ); + return $error if $error; + + return { + 'paynum' => $cpp->paynum, + 'paid' => $cpp->paid, + 'order_number' => $transaction->order_number, + 'auth' => $transaction->authorization, + } + + } else { + + my $error = $gateway->gateway_module. " error: ". + $transaction->error_message; + + my $jobnum = $cpp->jobnum; + if ( $jobnum ) { + my $placeholder = FS::queue->by_key($jobnum); + + if ( $placeholder ) { + my $e = $placeholder->depended_delete || $placeholder->delete; + warn "error removing provisioning jobs after declined paypendingnum ". + $cpp->paypendingnum. ": $e\n\n" + if $e; + } else { + warn "error finding job $jobnum for declined paypendingnum ". + $cpp->paypendingnum. "\n\n"; + } + } + + # not needed here: + # the raw HTTP response thing when there's no error message + # decline notices (the customer has already seen the decline message) + + # set the pending status + my $e = $cpp->decline($error); + if ( $e ) { + $e = "WARNING: payment declined but pending payment not resolved - ". + "error updating status for pendingnum :".$cpp->paypendingnum. + ": $e\n\n"; + warn $e; + $error = "$e ($error)"; + } + + return $error; + } + +} + +=item cancel_payment SESSION_ID + +Cancel a pending payment attempt. This just cleans up the cust_pay_pending +record. + +=cut + +sub cancel_payment { + my $self = shift; + my $session_id = shift; + my $cust_pay_pending = qsearchs('cust_pay_pending', { + 'session_id' => uc($session_id), + 'status' => 'thirdparty', + }); + return { 'error' => $cust_pay_pending->delete }; +} + +1; + diff --git a/FS/FS/cust_main/Import.pm b/FS/FS/cust_main/Import.pm index eadcc1a55..e5a4485f9 100644 --- a/FS/FS/cust_main/Import.pm +++ b/FS/FS/cust_main/Import.pm @@ -22,6 +22,8 @@ install_callback FS::UID sub { $conf = new FS::Conf; }; +my %is_location = map { $_ => 1 } FS::cust_main::Location->location_fields; + =head1 NAME FS::cust_main::Import - Batch customer importing @@ -316,13 +318,14 @@ sub batch_import { custbatch => $custbatch, agentnum => $agentnum, refnum => $refnum, - country => $conf->config('countrydefault') || 'US', payby => $payby, #default paydate => '12/2037', #default ); my $billtime = time; my %cust_pkg = ( pkgpart => $pkgpart ); my %svc_x = (); + my %bill_location = (); + my %ship_location = (); foreach my $field ( @fields ) { if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) { @@ -351,6 +354,14 @@ sub batch_import { $svc_x{$1} = shift @columns; + } elsif ( $is_location{$field} ) { + + $bill_location{$field} = shift @columns; + + } elsif ( $field =~ /^ship_(.*)$/ and $is_location{$1} ) { + + $ship_location{$1} = shift @columns; + } else { #refnum interception @@ -379,6 +390,16 @@ sub batch_import { my $value = shift @columns; $cust_main{$field} = $value if length($value); } + } # foreach my $field + # finished importing columns + + $bill_location{'country'} ||= $conf->config('countrydefault') || 'US'; + $cust_main{'bill_location'} = FS::cust_location->new(\%bill_location); + if ( grep $_, values(%ship_location) ) { + $ship_location{'country'} ||= $conf->config('countrydefault') || 'US'; + $cust_main{'ship_location'} = FS::cust_location->new(\%ship_location); + } else { + $cust_main{'ship_location'} = $cust_main{'bill_location'}; } if ( defined $cust_main{'payinfo'} && length $cust_main{'payinfo'} ) { diff --git a/FS/FS/cust_main/Location.pm b/FS/FS/cust_main/Location.pm index 8e30bb65b..22feaf9c8 100644 --- a/FS/FS/cust_main/Location.pm +++ b/FS/FS/cust_main/Location.pm @@ -18,7 +18,8 @@ BEGIN { no strict 'refs'; @location_fields = qw( address1 address2 city county state zip country district - latitude longitude coord_auto censustract censusyear geocode ); + latitude longitude coord_auto censustract censusyear geocode + addr_clean ); foreach my $f (@location_fields) { *{"FS::cust_main::Location::$f"} = sub { @@ -156,27 +157,32 @@ sub _upgrade_data { my $bill_location = FS::cust_location->new( { custnum => $custnum, - map { $_ => $cust_main->get($_) } location_fields() + map { $_ => $cust_main->get($_) } location_fields(), } ); - $error = $bill_location->insert; - die "error migrating billing address for customer $custnum: $error" - if $error; - - $cust_main->set(bill_locationnum => $bill_location->locationnum); + $bill_location->set('censustract', ''); # properly goes with ship_location + my $ship_location = $bill_location; # until proven otherwise if ( $cust_main->get('ship_address1') ) { - my $ship_location = FS::cust_location->new( - { - custnum => $custnum, - map { $_ => $cust_main->get("ship_$_") } location_fields() + # detect duplicates + my $same = 1; + foreach (location_fields()) { + if ( length($cust_main->get("ship_$_")) and + $cust_main->get($_) ne $cust_main->get("ship_$_") ) { + $same = 0; } - ); - $error = $ship_location->insert; - die "error migrating service address for customer $custnum: $error" - if $error; + } + + if ( !$same ) { + $ship_location = FS::cust_location->new( + { + custnum => $custnum, + map { $_ => $cust_main->get("ship_$_") } location_fields() + } + ); + } # else it stays equal to $bill_location - $cust_main->set(ship_locationnum => $ship_location->locationnum); + $ship_location->set('censustract', $cust_main->get('censustract')); # Step 2: Extract shipping address contact fields into contact my %unlike = map { $_ => 1 } @@ -218,10 +224,20 @@ sub _upgrade_data { $cust_main->set("ship_$_" => '') foreach qw(last first company); } #if %unlike } #if ship_address1 - else { - $cust_main->set(ship_locationnum => $bill_location->locationnum); + $error = $bill_location->insert; + die "error migrating billing address for customer $custnum: $error" + if $error; + + $cust_main->set(bill_locationnum => $bill_location->locationnum); + + if (!$ship_location->locationnum) { + $error = $ship_location->insert; + die "error migrating service address for customer $custnum: $error" + if $error; } + $cust_main->set(ship_locationnum => $ship_location->locationnum); + # Step 3: Wipe the migrated fields and update the cust_main $cust_main->set("ship_$_" => '') foreach location_fields(); diff --git a/FS/FS/cust_main/Packages.pm b/FS/FS/cust_main/Packages.pm index 11c13e5dd..152c496d1 100644 --- a/FS/FS/cust_main/Packages.pm +++ b/FS/FS/cust_main/Packages.pm @@ -4,9 +4,11 @@ use strict; use vars qw( $DEBUG $me ); use List::Util qw( min ); use FS::UID qw( dbh ); -use FS::Record qw( qsearch ); +use FS::Record qw( qsearch qsearchs ); use FS::cust_pkg; use FS::cust_svc; +use FS::contact; # for attach_pkgs +use FS::cust_location; # $DEBUG = 0; $me = '[FS::cust_main::Packages]'; @@ -29,6 +31,9 @@ These methods are available on FS::cust_main objects; Orders a single package. +Note that if the package definition has supplemental packages, those will +be ordered as well. + Options may be passed as a list of key/value pairs or as a hash reference. Options are: @@ -58,7 +63,7 @@ action completes (such as running the customer's credit card successfully). Optional subject for a ticket created and attached to this customer -=item ticket_subject +=item ticket_queue Optional queue name for ticket additions @@ -84,7 +89,7 @@ sub order_pkg { if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'}; my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () } - qw( ticket_subject ticket_queue ); + qw( ticket_subject ticket_queue allow_pkgpart ); local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -97,17 +102,45 @@ sub order_pkg { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - if ( $opt->{'cust_location'} && - ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) { - my $error = $opt->{'cust_location'}->insert; + if ( $opt->{'contactnum'} and $opt->{'contactnum'} != -1 ) { + + $cust_pkg->contactnum($opt->{'contactnum'}); + + } elsif ( $opt->{'contact'} ) { + + if ( ! $opt->{'contact'}->contactnum ) { + # not inserted yet + my $error = $opt->{'contact'}->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting contact (transaction rolled back): $error"; + } + } + $cust_pkg->contactnum($opt->{'contact'}->contactnum); + + #} else { + # + # $cust_pkg->contactnum(); + + } + + if ( $opt->{'locationnum'} and $opt->{'locationnum'} != -1 ) { + + $cust_pkg->locationnum($opt->{'locationnum'}); + + } elsif ( $opt->{'cust_location'} ) { + + my $error = $opt->{'cust_location'}->find_or_insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "inserting cust_location (transaction rolled back): $error"; } $cust_pkg->locationnum($opt->{'cust_location'}->locationnum); - } - else { + + } else { + $cust_pkg->locationnum($self->ship_locationnum); + } $cust_pkg->custnum( $self->custnum ); @@ -141,6 +174,35 @@ sub order_pkg { } } + # add supplemental packages, if any are needed + my $part_pkg = FS::part_pkg->by_key($cust_pkg->pkgpart); + foreach my $link ($part_pkg->supp_part_pkg_link) { + #warn "inserting supplemental package ".$link->dst_pkgpart; + my $pkg = FS::cust_pkg->new({ + 'pkgpart' => $link->dst_pkgpart, + 'pkglinknum' => $link->pkglinknum, + 'custnum' => $self->custnum, + 'main_pkgnum' => $cust_pkg->pkgnum, + # try to prevent as many surprises as possible + 'pkgbatch' => $cust_pkg->pkgbatch, + 'start_date' => $cust_pkg->start_date, + 'order_date' => $cust_pkg->order_date, + 'expire' => $cust_pkg->expire, + 'adjourn' => $cust_pkg->adjourn, + 'contract_end' => $cust_pkg->contract_end, + 'refnum' => $cust_pkg->refnum, + 'discountnum' => $cust_pkg->discountnum, + 'waive_setup' => $cust_pkg->waive_setup, + 'allow_pkgpart' => $opt->{'allow_pkgpart'}, + }); + $error = $self->order_pkg('cust_pkg' => $pkg, + 'locationnum' => $cust_pkg->locationnum); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting supplemental package: $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error @@ -228,6 +290,108 @@ sub order_pkgs { ''; #no error } +=item attach_pkgs + +Merges this customer's package's into the target customer and then cancels them. + +=cut + +sub attach_pkgs { + my( $self, $new_custnum ) = @_; + + #mostly false laziness w/ merge + + return "Can't attach packages to self" if $self->custnum == $new_custnum; + + my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) + or return "Invalid new customer number: $new_custnum"; + + return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent' + if $self->agentnum != $new_cust_main->agentnum + && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents'); + + 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; + + if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't merge a master agent customer"; + } + + #use FS::access_user + if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't merge a master employee customer"; + } + + if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum, + 'status' => { op=>'!=', value=>'done' }, + } + ) + ) { + $dbh->rollback if $oldAutoCommit; + return "Can't merge a customer with pending payments"; + } + + #end of false laziness + + #pull in contact + + my %contact_hash = ( 'first' => $self->first, + 'last' => $self->get('last'), + 'custnum' => $new_custnum, + 'disabled' => '', + ); + + my $contact = qsearchs( 'contact', \%contact_hash) + || new FS::contact \%contact_hash; + unless ( $contact->contactnum ) { + my $error = $contact->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + foreach my $cust_pkg ( $self->ncancelled_pkgs ) { + + my $cust_location = $cust_pkg->cust_location || $self->ship_location; + my %loc_hash = $cust_location->hash; + $loc_hash{'locationnum'} = ''; + $loc_hash{'custnum'} = $new_custnum; + $loc_hash{'disabled'} = ''; + my $new_cust_location = qsearchs( 'cust_location', \%loc_hash) + || new FS::cust_location \%loc_hash; + + my $pkg_or_error = $cust_pkg->change( { + 'keep_dates' => 1, + 'cust_main' => $new_cust_main, + 'contactnum' => $contact->contactnum, + 'cust_location' => $new_cust_location, + } ); + + my $error = ref($pkg_or_error) ? '' : $pkg_or_error; + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no error + +} + =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all packages (see L<FS::cust_pkg>) for this customer. diff --git a/FS/FS/cust_main/Search.pm b/FS/FS/cust_main/Search.pm index b07223ec5..e0c7080fe 100644 --- a/FS/FS/cust_main/Search.pm +++ b/FS/FS/cust_main/Search.pm @@ -18,7 +18,8 @@ use FS::svc_acct; $DEBUG = 0; $me = '[FS::cust_main::Search]'; -@fuzzyfields = ( 'first', 'last', 'company', 'address1' ); +@fuzzyfields = ( 'cust_main.first', 'cust_main.last', 'cust_main.company', + 'cust_location.address1' ); install_callback FS::UID sub { $conf = new FS::Conf; @@ -339,7 +340,7 @@ sub smart_search { my %fuzopts = ( 'hashref' => \%options, 'select' => '', - 'extra_sql' => " AND $agentnums_sql", #agent virtualization + 'extra_sql' => "WHERE $agentnums_sql", #agent virtualization ); if ( $first && $last ) { @@ -355,7 +356,8 @@ sub smart_search { } if ( $conf->exists('address1-search') ) { push @cust_main, - FS::cust_main::Search->fuzzy_search( { 'address1' => $value }, %fuzopts ); + FS::cust_main::Search->fuzzy_search( + { 'cust_location.address1' => $value }, %fuzopts ); } } @@ -622,17 +624,48 @@ sub search { # parse without census tract checkbox ## - push @where, "(censustract = '' or censustract is null)" + push @where, "(ship_location.censustract = '' or ship_location.censustract is null)" if $params->{'no_censustract'}; ## # parse with hardcoded tax location checkbox ## - push @where, "geocode is not null" + push @where, "ship_location.geocode is not null" if $params->{'with_geocode'}; ## + # "with email address(es)" checkbox + ## + + push @where, + 'EXISTS ( SELECT 1 FROM cust_main_invoice + WHERE cust_main_invoice.custnum = cust_main.custnum + AND length(dest) > 5 + )' # AND dest LIKE '%@%' + if $params->{'with_email'}; + + ## + # "with postal mail invoices" checkbox + ## + + push @where, + "EXISTS ( SELECT 1 FROM cust_main_invoice + WHERE cust_main_invoice.custnum = cust_main.custnum + AND dest = 'POST' )" + if $params->{'POST'}; + + ## + # "without postal mail invoices" checkbox + ## + + push @where, + "NOT EXISTS ( SELECT 1 FROM cust_main_invoice + WHERE cust_main_invoice.custnum = cust_main.custnum + AND dest = 'POST' )" + if $params->{'no_POST'}; + + ## # dates ## @@ -771,11 +804,19 @@ sub search { @tagnums = grep /^(\d+)$/, @tagnums; if ( @tagnums ) { + if ( $params->{'all_tags'} ) { + foreach ( @tagnums ) { + push @where, 'exists(select 1 from cust_tag where '. + 'cust_tag.custnum = cust_main.custnum and tagnum = '. + $_ . ')'; + } + } else { # matching any tag, not all my $tags_where = "0 < (select count(1) from cust_tag where " . " cust_tag.custnum = cust_main.custnum and tagnum in (" . join(',', @tagnums) . "))"; push @where, $tags_where; + } } } @@ -793,8 +834,14 @@ sub search { my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : ''; my $addl_from = ''; + # always make address fields available in results + for my $pre ('bill_', 'ship_') { + $addl_from .= + 'LEFT JOIN cust_location AS '.$pre.'location '. + 'ON (cust_main.'.$pre.'locationnum = '.$pre.'location.locationnum) '; + } - my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql"; + my $count_query = "SELECT COUNT(*) FROM cust_main $addl_from $extra_sql"; my @select = ( 'cust_main.custnum', @@ -810,7 +857,8 @@ sub search { if ($params->{'flattened_pkgs'}) { #my $pkg_join = ''; - $addl_from .= ' LEFT JOIN cust_pkg USING ( custnum ) '; + $addl_from .= + ' LEFT JOIN cust_pkg ON ( cust_main.custnum = cust_pkg.custnum ) '; if ($dbh->{Driver}->{Name} eq 'Pg') { @@ -879,6 +927,8 @@ sub search { 'extra_headers' => \@extra_headers, 'extra_fields' => \@extra_fields, }; + warn Data::Dumper::Dumper($sql_query); + $sql_query; } @@ -893,7 +943,8 @@ Additional options are the same as FS::Record::qsearch =cut sub fuzzy_search { - my( $self, $fuzzy ) = @_; + my $self = shift; + my $fuzzy = shift; # sensible defaults, then merge in any passed options my %fuzopts = ( 'table' => 'cust_main', @@ -905,6 +956,11 @@ sub fuzzy_search { my @cust_main = (); + my @fuzzy_mod = 'i'; + my $conf = new FS::Conf; + my $fuzziness = $conf->config('fuzzy-fuzziness'); + push @fuzzy_mod, $fuzziness if $fuzziness; + check_and_rebuild_fuzzyfiles(); foreach my $field ( keys %$fuzzy ) { @@ -912,32 +968,31 @@ sub fuzzy_search { next unless scalar(@$all); my %match = (); - $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) ); - - my @fcust = (); - foreach ( keys %match ) { - if ( $field eq 'address1' ) { - #because it lives outside the table - my $addl_from = $fuzopts{addl_from} . - 'JOIN cust_location USING (custnum)'; - my $extra_sql = $fuzopts{extra_sql} . - " AND cust_location.address1 = ".dbh->quote($_); - push @fcust, qsearch({ - %fuzopts, - 'addl_from' => $addl_from, - 'extra_sql' => $extra_sql, - }); - } else { - my $hash = $fuzopts{hashref}; - $hash->{$field} = $_; - push @fcust, qsearch({ - %fuzopts, - 'hashref' => $hash - }); - } + $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, \@fuzzy_mod, @$all ) ); + next if !keys(%match); + + my $in_matches = 'IN (' . + join(',', map { dbh->quote($_) } keys %match) . + ')'; + + my $extra_sql = $fuzopts{extra_sql}; + if ($extra_sql =~ /^\s*where /i or keys %{ $fuzopts{hashref} }) { + $extra_sql .= ' AND '; + } else { + $extra_sql .= 'WHERE '; + } + $extra_sql .= "$field $in_matches"; + + my $addl_from = $fuzopts{addl_from}; + if ( $field =~ /^cust_location/ ) { + $addl_from .= ' JOIN cust_location USING (custnum)'; } - my %fsaw = (); - push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust; + + push @cust_main, qsearch({ + %fuzopts, + 'addl_from' => $addl_from, + 'extra_sql' => $extra_sql, + }); } # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes @@ -976,28 +1031,29 @@ sub rebuild_fuzzyfiles { foreach my $fuzzy ( @fuzzyfields ) { - open(LOCK,">>$dir/cust_main.$fuzzy") - or die "can't open $dir/cust_main.$fuzzy: $!"; - flock(LOCK,LOCK_EX) - or die "can't lock $dir/cust_main.$fuzzy: $!"; + my ($field, $table) = reverse split('\.', $fuzzy); + $table ||= 'cust_main'; - open (CACHE, '>:encoding(UTF-8)', "$dir/cust_main.$fuzzy.tmp") - or die "can't open $dir/cust_main.$fuzzy.tmp: $!"; + open(LOCK,">>$dir/$table.$field") + or die "can't open $dir/$table.$field: $!"; + flock(LOCK,LOCK_EX) + or die "can't lock $dir/$table.$field: $!"; - foreach my $field ( $fuzzy, "ship_$fuzzy" ) { - my $sth = dbh->prepare("SELECT $field FROM cust_main". - " WHERE $field != '' AND $field IS NOT NULL"); - $sth->execute or die $sth->errstr; + open (CACHE, '>:encoding(UTF-8)', "$dir/$table.$field.tmp") + or die "can't open $dir/$table.$field.tmp: $!"; - while ( my $row = $sth->fetchrow_arrayref ) { - print CACHE $row->[0]. "\n"; - } + my $sth = dbh->prepare( + "SELECT $field FROM $table WHERE $field IS NOT NULL AND $field != ''" + ); + $sth->execute or die $sth->errstr; - } + while ( my $row = $sth->fetchrow_arrayref ) { + print CACHE $row->[0]. "\n"; + } - close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!"; + close CACHE or die "can't close $dir/$table.$field.tmp: $!"; - rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy"; + rename "$dir/$table.$field.tmp", "$dir/$table.$field"; close LOCK; } @@ -1016,20 +1072,24 @@ sub append_fuzzyfiles { my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; - foreach my $field (@fuzzyfields) { + foreach my $fuzzy (@fuzzyfields) { + + my ($field, $table) = reverse split('\.', $fuzzy); + $table ||= 'cust_main'; + my $value = shift; if ( $value ) { - open(CACHE, '>>:encoding(UTF-8)', "$dir/cust_main.$field" ) - or die "can't open $dir/cust_main.$field: $!"; + open(CACHE, '>>:encoding(UTF-8)', "$dir/$table.$field" ) + or die "can't open $dir/$table.$field: $!"; flock(CACHE,LOCK_EX) - or die "can't lock $dir/cust_main.$field: $!"; + or die "can't lock $dir/$table.$field: $!"; print CACHE "$value\n"; flock(CACHE,LOCK_UN) - or die "can't unlock $dir/cust_main.$field: $!"; + or die "can't unlock $dir/$table.$field: $!"; close CACHE; } @@ -1043,10 +1103,13 @@ sub append_fuzzyfiles { =cut sub all_X { - my( $self, $field ) = @_; + my( $self, $fuzzy ) = @_; + my ($field, $table) = reverse split('\.', $fuzzy); + $table ||= 'cust_main'; + my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; - open(CACHE, '<:encoding(UTF-8)', "$dir/cust_main.$field") - or die "can't open $dir/cust_main.$field: $!"; + open(CACHE, '<:encoding(UTF-8)', "$dir/$table.$field") + or die "can't open $dir/$table.$field: $!"; my @array = map { chomp; $_; } <CACHE>; close CACHE; \@array; diff --git a/FS/FS/cust_main/Status.pm b/FS/FS/cust_main/Status.pm index e5803e0db..f84ff0f0e 100644 --- a/FS/FS/cust_main/Status.pm +++ b/FS/FS/cust_main/Status.pm @@ -2,13 +2,10 @@ package FS::cust_main::Status; use strict; use vars qw( $conf ); # $module ); #$DEBUG $me ); +use Tie::IxHash; use FS::UID; use FS::cust_pkg; -#use Tie::IxHash; - -use FS::UID qw( getotaker dbh driver_name ); - #$DEBUG = 0; #$me = '[FS::cust_main::Status]'; diff --git a/FS/FS/cust_main/_Marketgear.pm b/FS/FS/cust_main/_Marketgear.pm deleted file mode 100644 index 2d3c9270e..000000000 --- a/FS/FS/cust_main/_Marketgear.pm +++ /dev/null @@ -1,146 +0,0 @@ -package FS::cust_main::_Marketgear; - -use strict; -use vars qw( $DEBUG $me $conf ); - -$DEBUG = 0; -$me = '[FS::cust_main::_Marketgear]'; - -install_callback FS::UID sub { - $conf = new FS::Conf; -}; - -sub start_copy_skel { - my $self = shift; - - return '' unless $conf->config('cust_main-skeleton_tables') - && $conf->config('cust_main-skeleton_custnum'); - - warn " inserting skeleton records\n" - if $DEBUG > 1 || $cust_main::DEBUG > 1; - - #'mg_user_preference' => {}, - #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, }, - #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' }, - #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' }, - #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } }, - my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables'))); - die $@ if $@; - - _copy_skel( 'cust_main', #tablename - $conf->config('cust_main-skeleton_custnum'), #sourceid - $self->custnum, #destid - @tables, #child tables - ); -} - -#recursive subroutine, not a method -sub _copy_skel { - my( $table, $sourceid, $destid, %child_tables ) = @_; - - my $primary_key; - if ( $table =~ /^(\w+)\.(\w+)$/ ) { - ( $table, $primary_key ) = ( $1, $2 ); - } else { - my $dbdef_table = dbdef->table($table); - $primary_key = $dbdef_table->primary_key - or return "$table has no primary key". - " (or do you need to run dbdef-create?)"; - } - - warn " _copy_skel: $table.$primary_key $sourceid to $destid for ". - join (', ', keys %child_tables). "\n" - if $DEBUG > 2; - - foreach my $child_table_def ( keys %child_tables ) { - - my $child_table; - my $child_pkey = ''; - if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) { - ( $child_table, $child_pkey ) = ( $1, $2 ); - } else { - $child_table = $child_table_def; - - $child_pkey = dbdef->table($child_table)->primary_key; - # or return "$table has no primary key". - # " (or do you need to run dbdef-create?)\n"; - } - - my $sequence = ''; - if ( keys %{ $child_tables{$child_table_def} } ) { - - return "$child_table has no primary key". - " (run dbdef-create or try specifying it?)\n" - unless $child_pkey; - - #false laziness w/Record::insert and only works on Pg - #refactor the proper last-inserted-id stuff out of Record::insert if this - # ever gets use for anything besides a quick kludge for one customer - my $default = dbdef->table($child_table)->column($child_pkey)->default; - $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i - or return "can't parse $child_table.$child_pkey default value ". - " for sequence name: $default"; - $sequence = $1; - - } - - my @sel_columns = grep { $_ ne $primary_key } - dbdef->table($child_table)->columns; - my $sel_columns = join(', ', @sel_columns ); - - my @ins_columns = grep { $_ ne $child_pkey } @sel_columns; - my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) '; - my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) '; - - my $sel_st = "SELECT $sel_columns FROM $child_table". - " WHERE $primary_key = $sourceid"; - warn " $sel_st\n" - if $DEBUG > 2; - my $sel_sth = dbh->prepare( $sel_st ) - or return dbh->errstr; - - $sel_sth->execute or return $sel_sth->errstr; - - while ( my $row = $sel_sth->fetchrow_hashref ) { - - warn " selected row: ". - join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n" - if $DEBUG > 2; - - my $statement = - "INSERT INTO $child_table $ins_columns VALUES $placeholders"; - my $ins_sth =dbh->prepare($statement) - or return dbh->errstr; - my @param = ( $destid, map $row->{$_}, @ins_columns ); - warn " $statement: [ ". join(', ', @param). " ]\n" - if $DEBUG > 2; - $ins_sth->execute( @param ) - or return $ins_sth->errstr; - - #next unless keys %{ $child_tables{$child_table} }; - next unless $sequence; - - #another section of that laziness - my $seq_sql = "SELECT currval('$sequence')"; - my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr; - $seq_sth->execute or return $seq_sth->errstr; - my $insertid = $seq_sth->fetchrow_arrayref->[0]; - - # don't drink soap! recurse! recurse! okay! - my $error = - _copy_skel( $child_table_def, - $row->{$child_pkey}, #sourceid - $insertid, #destid - %{ $child_tables{$child_table_def} }, - ); - return $error if $error; - - } - - } - - return ''; - -} - -1; diff --git a/FS/FS/cust_main_Mixin.pm b/FS/FS/cust_main_Mixin.pm index a0677060e..212c04e0f 100644 --- a/FS/FS/cust_main_Mixin.pm +++ b/FS/FS/cust_main_Mixin.pm @@ -539,6 +539,7 @@ sub process_email_search_result { die "error loading FS::$table: $@\n" if $@; my $error = "FS::$table"->email_search_result( $param ); + dbh->commit; # save failed jobs before rethrowing the error die $error if $error; } diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index 143f62ed3..a61d67e11 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -137,33 +137,6 @@ sub check { } -sub taxname { - my $self = shift; - if ( $self->dbdef_table->column('taxname') ) { - return $self->setfield('taxname', $_[0]) if @_; - return $self->getfield('taxname'); - } - return ''; -} - -sub setuptax { - my $self = shift; - if ( $self->dbdef_table->column('setuptax') ) { - return $self->setfield('setuptax', $_[0]) if @_; - return $self->getfield('setuptax'); - } - return ''; -} - -sub recurtax { - my $self = shift; - if ( $self->dbdef_table->column('recurtax') ) { - return $self->setfield('recurtax', $_[0]) if @_; - return $self->getfield('recurtax'); - } - return ''; -} - =item label OPTIONS Returns a label looking like "Anytown, Alameda County, CA, US". @@ -174,13 +147,10 @@ If the taxname field is set, it will look like If the taxclass is set, then it will be "Anytown, Alameda County, CA, US (International)". -Currently it will not contain the district, even if the city+county+state -is not unique. - -OPTIONS may contain "no_taxclass" (hides taxclass) and/or "no_city" -(hides city). It may also contain "out", in which case, if this -region (district+city+county+state+country) contains no non-zero -taxes, the label will read "Out of taxable region(s)". +OPTIONS may contain "with_taxclass", "with_city", and "with_district" to show +those fields. It may also contain "out", in which case, if this region +(district+city+county+state+country) contains no non-zero taxes, the label +will read "Out of taxable region(s)". =cut @@ -202,12 +172,15 @@ sub label { my $label = $self->country; $label = $self->state.", $label" if $self->state; $label = $self->county." County, $label" if $self->county; - if (!$opt{no_city}) { + if ($opt{with_city}) { $label = $self->city.", $label" if $self->city; + if ($opt{with_district} and $self->district) { + $label = $self->district . ", $label"; + } } # ugly labels when taxclass and taxname are both non-null... # but this is how the tax report does it - if (!$opt{no_taxclass}) { + if ($opt{with_taxclass}) { $label = "$label (".$self->taxclass.')' if $self->taxclass; } $label = $self->taxname." ($label)" if $self->taxname; @@ -258,10 +231,15 @@ sub _list_sql { =item taxline TAXABLES_ARRAYREF, [ OPTION => VALUE ... ] -Returns an hashref of a name and an amount of tax calculated for the -line items (L<FS::cust_bill_pkg> objects) in TAXABLES_ARRAYREF. The line -items must come from the same invoice. Returns a scalar error message -on error. +Takes an arrayref of L<FS::cust_bill_pkg> objects representing taxable +line items, and returns a new L<FS::cust_bill_pkg> object representing +the tax on them under this tax rate. + +This will have a pseudo-field, "cust_bill_pkg_tax_location", containing +an arrayref of L<FS::cust_bill_pkg_tax_location> objects. Each of these +will in turn have a "taxable_cust_bill_pkg" pseudo-field linking it to one +of the taxable items. All of these links must be resolved as the objects +are inserted. In addition to calculating the tax for the line items, this will calculate any appropriate tax exemptions and attach them to the line items. @@ -275,8 +253,7 @@ tax exemption limit if there is one. =cut -# XXX this should just return a cust_bill_pkg object for the tax, -# but that requires changing stuff in tax_rate.pm also. +# XXX change tax_rate.pm to work like this sub taxline { my( $self, $taxables, %opt ) = @_; @@ -294,7 +271,8 @@ sub taxline { my $dbh = dbh; my $name = $self->taxname || 'Tax'; - my $amount = 0; + my $taxable_cents = 0; + my $tax_cents = 0; my $cust_bill = $taxables->[0]->cust_bill; my $custnum = $cust_bill ? $cust_bill->custnum : $opt{'custnum'}; @@ -325,6 +303,15 @@ sub taxline { push @existing_exemptions, @{ $_->cust_tax_exempt_pkg } for @$taxables; + my $tax_item = FS::cust_bill_pkg->new({ + 'pkgnum' => 0, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + 'itemdesc' => $name, + }); + my @tax_location; + foreach my $cust_bill_pkg (@$taxables) { my $cust_pkg = $cust_bill_pkg->cust_pkg; @@ -472,34 +459,51 @@ sub taxline { $_->taxnum($self->taxnum) foreach @new_exemptions; - if ( $cust_bill_pkg->billpkgnum ) { - die "tried to calculate tax exemptions on a previously billed line item\n"; - # this is unnecessary -# foreach my $cust_tax_exempt_pkg (@new_exemptions) { -# my $error = $cust_tax_exempt_pkg->insert; -# if ( $error ) { -# $dbh->rollback if $oldAutoCommit; -# return "can't insert cust_tax_exempt_pkg: $error"; -# } -# } - } - # attach them to the line item push @{ $cust_bill_pkg->cust_tax_exempt_pkg }, @new_exemptions; push @existing_exemptions, @new_exemptions; - # If we were smart, we'd also generate a cust_bill_pkg_tax_location - # record at this point, but that would require redesigning more stuff. $taxable_charged = sprintf( "%.2f", $taxable_charged); - - $amount += $taxable_charged * $self->tax / 100; + next if $taxable_charged == 0; + + my $this_tax_cents = int($taxable_charged * $self->tax); + my $location = FS::cust_bill_pkg_tax_location->new({ + 'taxnum' => $self->taxnum, + 'taxtype' => ref($self), + 'cents' => $this_tax_cents, + 'pkgnum' => $cust_bill_pkg->pkgnum, + 'locationnum' => $cust_bill_pkg->cust_pkg->tax_locationnum, + 'taxable_cust_bill_pkg' => $cust_bill_pkg, + 'tax_cust_bill_pkg' => $tax_item, + }); + push @tax_location, $location; + + $taxable_cents += $taxable_charged; + $tax_cents += $this_tax_cents; } #foreach $cust_bill_pkg - - return { - 'name' => $name, - 'amount' => $amount, - }; - + + # now round and distribute + my $extra_cents = sprintf('%.2f', $taxable_cents * $self->tax / 100) * 100 + - $tax_cents; + # make sure we have an integer + $extra_cents = sprintf('%.0f', $extra_cents); + if ( $extra_cents < 0 ) { + die "nonsense extra_cents value $extra_cents"; + } + $tax_cents += $extra_cents; + my $i = 0; + foreach (@tax_location) { # can never require more than a single pass, yes? + my $cents = $_->get('cents'); + if ( $extra_cents > 0 ) { + $cents++; + $extra_cents--; + } + $_->set('amount', sprintf('%.2f', $cents/100)); + } + $tax_item->set('setup' => sprintf('%.2f', $tax_cents / 100)); + $tax_item->set('cust_bill_pkg_tax_location', \@tax_location); + + return $tax_item; } =back diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index d28997ccd..69f4c395a 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -9,8 +9,6 @@ use vars qw( $DEBUG $me $conf @encrypted_fields use Date::Format; use Business::CreditCard; use Text::Template; -use FS::UID qw( getotaker ); -use FS::Misc qw( send_email ); use FS::Record qw( dbh qsearch qsearchs ); use FS::CurrentUser; use FS::payby; @@ -100,7 +98,7 @@ Masked payinfo (See L<FS::payinfo_Mixin> for how this works) =item paybatch -text field for tracking card processing or other batch grouping +obsolete text field for tracking card processing or other batch grouping =item payunique @@ -130,11 +128,32 @@ The deposit account number. The teller number. -=item pay_batch +=item batchnum The number of the batch this payment came from (see L<FS::pay_batch>), or null if it was processed through a realtime gateway or entered manually. +=item gatewaynum + +The number of the realtime or batch gateway L<FS::payment_gateway>) this +payment was processed through. Null if it was entered manually or processed +by the "system default" gateway, which doesn't have a number. + +=item processor + +The name of the processor module (Business::OnlinePayment, ::BatchPayment, +or ::OnlineThirdPartyPayment subclass) used for this payment. Slightly +redundant with C<gatewaynum>. + +=item auth + +The authorization number returned by the credit card network. + +=item order_number + +The transaction ID returned by the gateway, if any. This is usually what +you would use to initiate a void or refund of the payment. + =back =head1 METHODS @@ -171,6 +190,15 @@ 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. +About the "manual" flag: Normally, if the 'payment_receipt' config option +is set, and the customer has an invoice email address, inserting a payment +causes a I<statement> to be emailed to the customer. If the payment is +considered "manual" (or if the customer has no invoices), then it will +instead send a I<payment receipt>. "manual" should be true whenever a +payment is created directly from the web interface, from a user-initiated +realtime payment, or from a third-party payment via self-service. It should +be I<false> when creating a payment from a billing event or from a batch. + =cut sub insert { @@ -439,38 +467,6 @@ sub delete { return $error; } - if ( $conf->exists('deletepayments') - && $conf->config('deletepayments') ne '' ) { - - my $cust_main = $self->cust_main; - - my $error = send_email( - 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), - #invoice_from??? well as good as any - 'to' => $conf->config('deletepayments'), - 'subject' => 'FREESIDE NOTIFICATION: Payment deleted', - 'body' => [ - "This is an automatic message from your Freeside installation\n", - "informing you that the following payment has been deleted:\n", - "\n", - 'paynum: '. $self->paynum. "\n", - 'custnum: '. $self->custnum. - " (". $cust_main->last. ", ". $cust_main->first. ")\n", - 'paid: $'. sprintf("%.2f", $self->paid). "\n", - 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n", - 'payby: '. $self->payby. "\n", - 'payinfo: '. $self->paymask. "\n", - 'paybatch: '. $self->paybatch. "\n", - ], - ); - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't send payment deletion notification: $error"; - } - - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -605,11 +601,18 @@ sub send_receipt { { my $msgnum = $conf->config('payment_receipt_msgnum', $cust_main->agentnum); if ( $msgnum ) { - my $msg_template = FS::msg_template->by_key($msgnum); - $error = $msg_template->send( - 'cust_main' => $cust_main, - 'object' => $self, - 'from_config' => 'payment_receipt_from', + + my $queue = new FS::queue { + 'job' => 'FS::Misc::process_send_email', + 'paynum' => $self->paynum, + 'custnum' => $cust_main->custnum, + }; + $error = $queue->insert( + FS::msg_template->by_key($msgnum)->prepare( + 'cust_main' => $cust_main, + 'object' => $self, + 'from_config' => 'payment_receipt_from', + ) ); } elsif ( $conf->exists('payment_receipt_email') ) { @@ -648,7 +651,12 @@ sub send_receipt { #setup date, other things? } - $error = send_email( + my $queue = new FS::queue { + 'job' => 'FS::Misc::process_send_generated_email', + 'paynum' => $self->paynum, + 'custnum' => $cust_main->custnum, + }; + $error = $queue->insert( 'from' => $conf->config('invoice_from', $cust_main->agentnum), #invoice_from??? well as good as any 'to' => \@invoicing_list, @@ -665,8 +673,9 @@ sub send_receipt { } elsif ( ! $cust_main->invoice_noemail ) { #not manual my $queue = new FS::queue { - 'paynum' => $self->paynum, - 'job' => 'FS::cust_bill::queueable_email', + 'job' => 'FS::cust_bill::queueable_email', + 'paynum' => $self->paynum, + 'custnum' => $cust_main->custnum, }; $error = $queue->insert( @@ -678,7 +687,7 @@ sub send_receipt { } - warn "send_receipt: $error\n" if $error; + warn "send_receipt: $error\n" if $error; } =item cust_bill_pay @@ -878,6 +887,8 @@ sub _upgrade_data { #class method warn "$me upgrading $class\n" if $DEBUG; + local $FS::payinfo_Mixin::ignore_masked_payinfo = 1; + ## # otaker/ivan upgrade ## @@ -1004,6 +1015,63 @@ sub _upgrade_data { #class method if $error; } + ### + # migrate gateway info from the misused 'paybatch' field + ### + + # not only cust_pay, but also voided and refunded payments + if (!FS::upgrade_journal->is_done('cust_pay__parse_paybatch_1')) { + local $FS::Record::nowarn_classload=1; + # really inefficient, but again, only has to run once + foreach my $table (qw(cust_pay cust_pay_void cust_refund)) { + my $and_batchnum_is_null = + ( $table =~ /^cust_pay/ ? ' AND batchnum IS NULL' : '' ); + foreach my $object ( qsearch({ + table => $table, + extra_sql => "WHERE payby IN('CARD','CHEK') ". + "AND (paybatch IS NOT NULL ". + "OR (paybatch IS NULL AND auth IS NULL + $and_batchnum_is_null ) )", + }) ) + { + if ( $object->paybatch eq '' ) { + # repair for a previous upgrade that didn't save 'auth' + my $pkey = $object->primary_key; + # find the last history record that had a paybatch value + my $h = qsearchs({ + table => "h_$table", + hashref => { + $pkey => $object->$pkey, + paybatch => { op=>'!=', value=>''}, + history_action => 'replace_old', + }, + order_by => 'ORDER BY history_date DESC LIMIT 1', + }); + if (!$h) { + warn "couldn't find paybatch history record for $table ".$object->$pkey."\n"; + next; + } + # if the paybatch didn't have an auth string, then it's fine + $h->paybatch =~ /:(\w+):/ or next; + # set paybatch to what it was in that record + $object->set('paybatch', $h->paybatch) + # and then upgrade it like the old records + } + + my $parsed = $object->_parse_paybatch; + if (keys %$parsed) { + $object->set($_ => $parsed->{$_}) foreach keys %$parsed; + $object->set('auth' => $parsed->{authorization}); + $object->set('paybatch', ''); + my $error = $object->replace; + warn "error parsing CARD/CHEK paybatch fields on $object #". + $object->get($object->primary_key).":\n $error\n" + if $error; + } + } #$object + } #$table + FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1'); + } } =back diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm index 9f2e9ddfc..e1e32d3d4 100644 --- a/FS/FS/cust_pay_batch.pm +++ b/FS/FS/cust_pay_batch.pm @@ -9,7 +9,7 @@ use FS::payinfo_Mixin; use FS::cust_main; use FS::cust_bill; -@ISA = qw( FS::payinfo_Mixin FS::Record ); +@ISA = qw( FS::payinfo_Mixin FS::cust_main_Mixin FS::Record ); # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -80,7 +80,9 @@ following fields are currently supported: =item country -=item status +=item status - 'Approved' or 'Declined' + +=item error_message - the error returned by the gateway if any =back @@ -289,19 +291,21 @@ sub retriable { ''; } -=item approve PAYBATCH +=item approve OPTIONS Approve this payment. This will replace the existing record with the same paybatchnum, set its status to 'Approved', and generate a payment record (L<FS::cust_pay>). This should only be called from the batch import process. +OPTIONS may contain "gatewaynum", "processor", "auth", and "order_number". + =cut sub approve { # to break up the Big Wall of Code that is import_results my $new = shift; - my $paybatch = shift; + my %opt = @_; my $paybatchnum = $new->paybatchnum; my $old = qsearchs('cust_pay_batch', { paybatchnum => $paybatchnum }) or return "paybatchnum $paybatchnum not found"; @@ -317,13 +321,17 @@ sub approve { my $cust_pay = new FS::cust_pay ( { 'custnum' => $new->custnum, 'payby' => $new->payby, - 'paybatch' => $paybatch, 'payinfo' => $new->payinfo || $old->payinfo, 'paid' => $new->paid, '_date' => $new->_date, 'usernum' => $new->usernum, 'batchnum' => $new->batchnum, + 'gatewaynum' => $opt{'gatewaynum'}, + 'processor' => $opt{'processor'}, + 'auth' => $opt{'auth'}, + 'order_number' => $opt{'order_number'} } ); + $error = $cust_pay->insert; if ( $error ) { return "error inserting payment for paybatchnum $paybatchnum: $error\n"; @@ -361,6 +369,12 @@ sub decline { # Void the payment my $cust_pay = qsearchs('cust_pay', { custnum => $new->custnum, + batchnum => $new->batchnum + }); + # these should all be migrated over, but if it's not found, look for + # batchnum in the 'paybatch' field also + $cust_pay ||= qsearchs('cust_pay', { + custnum => $new->custnum, paybatch => $new->batchnum }); if ( !$cust_pay ) { @@ -375,6 +389,7 @@ sub decline { } } # !$old->status $new->status('Declined'); + $new->error_message($reason); my $error = $new->replace($old); if ( $error ) { return "error updating status of paybatchnum $paybatchnum: $error\n"; diff --git a/FS/FS/cust_pay_pending.pm b/FS/FS/cust_pay_pending.pm index f03ed1f3a..8e29f08b6 100644 --- a/FS/FS/cust_pay_pending.pm +++ b/FS/FS/cust_pay_pending.pm @@ -128,8 +128,24 @@ Additional status information. L<FS::payment_gateway> id. -=item paynum - +=item paynum +Payment number (L<FS::cust_pay>) of the completed payment. + +=item invnum + +Invoice number (L<FS::cust_bill>) to try to apply this payment to. + +=item manual + +Flag for whether this is a "manual" payment (i.e. initiated through +self-service or the back-office web interface, rather than from an event +or a payment batch). "Manual" payments will cause the customer to be +sent a payment receipt rather than a statement. + +=item discount_term + +Number of months the customer tried to prepay for. =back @@ -203,6 +219,9 @@ sub check { || $self->ut_hexn('session_id') || $self->ut_foreign_keyn('paynum', 'cust_pay', 'paynum' ) || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') + || $self->ut_foreign_keyn('invnum', 'cust_bill', 'invnum') + || $self->ut_flag('manual') + || $self->ut_numbern('discount_term') || $self->payinfo_check() #payby/payinfo/paymask/paydate ; return $error if $error; @@ -296,6 +315,116 @@ sub insert_cust_pay { } +=item approve OPTIONS + +Sets the status of this pending payment to "done" and creates a completed +payment (L<FS::cust_pay>). This should be called when a realtime or +third-party payment has been approved. + +OPTIONS may include any of 'processor', 'payinfo', 'discount_term', 'auth', +and 'order_number' to set those fields on the completed payment, as well as +'apply' to apply payments for this customer after inserting the new payment. + +=cut + +sub approve { + my $self = shift; + my %opt = @_; + + my $dbh = dbh; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + + my $cust_pay = FS::cust_pay->new({ + 'custnum' => $self->custnum, + 'invnum' => $self->invnum, + 'pkgnum' => $self->pkgnum, + 'paid' => $self->paid, + '_date' => '', + 'payby' => $self->payby, + 'payinfo' => $self->payinfo, + 'gatewaynum' => $self->gatewaynum, + }); + foreach my $opt_field (qw(processor payinfo auth order_number)) + { + $cust_pay->set($opt_field, $opt{$opt_field}) if exists $opt{$opt_field}; + } + + my %insert_opt = ( + 'manual' => $self->manual, + 'discount_term' => $self->discount_term, + ); + my $error = $cust_pay->insert( %insert_opt ); + if ( $error ) { + # try it again without invnum or discount + # (both of those can make payments fail to insert, and at this point + # the payment is a done deal and MUST be recorded) + $self->invnum(''); + my $error2 = $cust_pay->insert('manual' => $self->manual); + if ( $error2 ) { + # attempt to void the payment? + # no, we'll just stop digging at this point. + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + my $e = "WARNING: payment captured but not recorded - error inserting ". + "payment (". ($opt{processor} || $self->payby) . + ": $error2\n(previously tried insert with invnum#".$self->invnum. + ": $error)\npending payment saved as paypendingnum#". + $self->paypendingnum."\n\n"; + warn $e; + return $e; + } + } + if ( my $jobnum = $self->jobnum ) { + my $placeholder = FS::queue->by_key($jobnum); + my $error; + if (!$placeholder) { + $error = "not found"; + } else { + $error = $placeholder->delete; + } + + if ($error) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + my $e = "WARNING: payment captured but could not delete job $jobnum ". + "for paypendingnum #" . $self->paypendingnum . ": $error\n\n"; + warn $e; + return $e; + } + } + + if ( $opt{'paynum_ref'} ) { + ${ $opt{'paynum_ref'} } = $cust_pay->paynum; + } + + $self->status('done'); + $self->statustext('captured'); + $self->paynum($cust_pay->paynum); + my $cpp_done_err = $self->replace; + + if ( $cpp_done_err ) { + + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + my $e = "WARNING: payment captured but could not update pending status ". + "for paypendingnum ".$self->paypendingnum.": $cpp_done_err \n\n"; + warn $e; + return $e; + + } else { + + # commit at this stage--we don't want to roll back if applying + # payments fails + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + if ( $opt{'apply'} ) { + my $apply_error = $self->apply_payments_and_credits; + if ( $apply_error ) { + warn "WARNING: error applying payment: $apply_error\n\n"; + } + } + } + ''; +} + =item decline [ STATUSTEXT ] Sets the status of this pending payment to "done" (with statustext diff --git a/FS/FS/cust_pay_refund.pm b/FS/FS/cust_pay_refund.pm index cb9dbcef2..b799f69e7 100644 --- a/FS/FS/cust_pay_refund.pm +++ b/FS/FS/cust_pay_refund.pm @@ -2,7 +2,6 @@ package FS::cust_pay_refund; use strict; use vars qw( @ISA ); #$conf ); -use FS::UID qw( getotaker ); use FS::Record qw( qsearchs ); # qsearch ); use FS::cust_main; use FS::cust_pay; diff --git a/FS/FS/cust_pay_void.pm b/FS/FS/cust_pay_void.pm index bebcfd4cc..92a96cb96 100644 --- a/FS/FS/cust_pay_void.pm +++ b/FS/FS/cust_pay_void.pm @@ -1,11 +1,10 @@ package FS::cust_pay_void; use strict; -use base qw( FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin +use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin FS::Record ); use vars qw( @encrypted_fields $otaker_upgrade_kludge ); use Business::CreditCard; -use FS::UID qw(getotaker); use FS::Record qw(qsearch qsearchs dbh fields); use FS::CurrentUser; use FS::access_user; diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 16adea3d7..ddfab5dcb 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,26 +1,30 @@ package FS::cust_pkg; use strict; -use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin +use base qw( FS::otaker_Mixin FS::cust_main_Mixin + FS::contact_Mixin FS::location_Mixin FS::m2m_Common FS::option_Common ); use vars qw($disable_agentcheck $DEBUG $me); use Carp qw(cluck); use Scalar::Util qw( blessed ); -use List::Util qw(max); +use List::Util qw(min max); use Tie::IxHash; use Time::Local qw( timelocal timelocal_nocheck ); use MIME::Entity; -use FS::UID qw( getotaker dbh driver_name ); +use FS::UID qw( dbh driver_name ); use FS::Misc qw( send_email ); use FS::Record qw( qsearch qsearchs fields ); use FS::CurrentUser; use FS::cust_svc; use FS::part_pkg; use FS::cust_main; +use FS::contact; use FS::cust_location; use FS::pkg_svc; use FS::cust_bill_pkg; use FS::cust_pkg_detail; +use FS::cust_pkg_usage; +use FS::cdr_cust_pkg_usage; use FS::cust_event; use FS::h_cust_svc; use FS::reg_code; @@ -197,6 +201,15 @@ Previous locationnum =item waive_setup +=item main_pkgnum + +The pkgnum of the package that this package is supplemental to, if any. + +=item pkglinknum + +The package link (L<FS::part_pkg_link>) that defines this supplemental +package, if it is one. + =back Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date @@ -214,7 +227,7 @@ Create a new billing item. To add the item to the database, see L<"insert">. =cut sub table { 'cust_pkg'; } -sub cust_linked { $_[0]->cust_main_custnum; } +sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum } sub cust_unlinked_msg { my $self = shift; "WARNING: can't find cust_main.custnum ". $self->custnum. @@ -242,7 +255,8 @@ The following options are available: =item change -If set true, supresses any referral credit to a referring customer. +If set true, supresses actions that should only be taken for new package +orders. (Currently this includes: intro periods when delay_setup is on.) =item options @@ -256,6 +270,12 @@ a ticket will be added to this customer with this subject an optional queue name for ticket additions +=item allow_pkgpart + +Don't check the legality of the package definition. This should be used +when performing a package change that doesn't change the pkgpart (i.e. +a location change). + =back =cut @@ -263,7 +283,8 @@ an optional queue name for ticket additions sub insert { my( $self, %options ) = @_; - my $error = $self->check_pkgpart; + my $error; + $error = $self->check_pkgpart unless $options{'allow_pkgpart'}; return $error if $error; my $part_pkg = $self->part_pkg; @@ -283,8 +304,12 @@ sub insert { } } - my $free_days = $part_pkg->option('free_days',1); - if ( $free_days && $part_pkg->option('delay_setup',1) ) { #&& !$self->start_date + if ( ! $options{'change'} + && ( my $free_days = $part_pkg->option('free_days',1) ) + && $part_pkg->option('delay_setup',1) + #&& ! $self->start_date + ) + { my ($mday,$mon,$year) = (localtime(time) )[3,4,5]; #my $start_date = ($self->start_date || timelocal(0,0,0,$mday,$mon,$year)) + 86400 * $free_days; my $start_date = timelocal(0,0,0,$mday,$mon,$year) + 86400 * $free_days; @@ -556,9 +581,12 @@ sub replace { } - my $error = $new->SUPER::replace($old, - $options->{options} ? $options->{options} : () - ); + my $error = $new->export_pkg_change($old) + || $new->SUPER::replace( $old, + $options->{options} + ? $options->{options} + : () + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -594,13 +622,15 @@ replace methods. sub check { my $self = shift; - $self->locationnum('') if !$self->locationnum || $self->locationnum == -1; + if ( !$self->locationnum or $self->locationnum == -1 ) { + $self->set('locationnum', $self->cust_main->ship_locationnum); + } my $error = $self->ut_numbern('pkgnum') || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') || $self->ut_numbern('pkgpart') - || $self->check_pkgpart + || $self->ut_foreign_keyn('contactnum', 'contact', 'contactnum' ) || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum') || $self->ut_numbern('start_date') || $self->ut_numbern('setup') @@ -616,6 +646,8 @@ sub check { || $self->ut_numbern('agent_pkgid') || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ]) || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ]) + || $self->ut_foreign_keyn('main_pkgnum', 'cust_pkg', 'pkgnum') + || $self->ut_foreign_keyn('pkglinknum', 'part_pkg_link', 'pkglinknum') ; return $error if $error; @@ -639,14 +671,19 @@ sub check { =item check_pkgpart +Check the pkgpart to make sure it's allowed with the reg_code and/or +promo_code of the package (if present) and with the customer's agent. +Called from C<insert>, unless we are doing a package change that doesn't +affect pkgpart. + =cut sub check_pkgpart { my $self = shift; - my $error = $self->ut_numbern('pkgpart'); - return $error if $error; + # my $error = $self->ut_numbern('pkgpart'); # already done + my $error; if ( $self->reg_code ) { unless ( grep { $self->pkgpart == $_->pkgpart } @@ -730,6 +767,11 @@ sub cancel { my( $self, %options ) = @_; my $error; + # pass all suspend/cancel actions to the main package + if ( $self->main_pkgnum and !$options{'from_main'} ) { + return $self->main_pkg->cancel(%options); + } + my $conf = new FS::Conf; warn "cust_pkg::cancel called with options". @@ -828,6 +870,7 @@ sub cancel { my %hash = $self->hash; $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time); + $hash{'change_custnum'} = $options{'change_custnum'}; my $new = new FS::cust_pkg ( \%hash ); $error = $new->replace( $self, options => { $self->options } ); if ( $error ) { @@ -835,6 +878,22 @@ sub cancel { return $error; } + foreach my $supp_pkg ( $self->supplemental_pkgs ) { + $error = $supp_pkg->cancel(%options, 'from_main' => 1); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error"; + } + } + + foreach my $usage ( $self->cust_pkg_usage ) { + $error = $usage->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "deleting usage pools: $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; return '' if $date; #no errors @@ -894,6 +953,9 @@ svc_fatal: service provisioning errors are fatal svc_errors: pass an array reference, will be filled in with any provisioning errors +main_pkgnum: link the package as a supplemental package of this one. For +internal use only. + =cut sub uncancel { @@ -902,6 +964,10 @@ sub uncancel { #in case you try do do $uncancel-date = $cust_pkg->uncacel return '' unless $self->get('cancel'); + if ( $self->main_pkgnum and !$options{'main_pkgnum'} ) { + return $self->main_pkg->uncancel(%options); + } + ## # Transaction-alize ## @@ -926,6 +992,7 @@ sub uncancel { bill => ( $options{'bill'} || $self->get('bill') ), uncancel => time, uncancel_pkgnum => $self->pkgnum, + main_pkgnum => ($options{'main_pkgnum'} || ''), map { $_ => $self->get($_) } qw( custnum pkgpart locationnum setup @@ -937,6 +1004,7 @@ sub uncancel { my $error = $cust_pkg->insert( 'change' => 1, #supresses any referral credit to a referring customer + 'allow_pkgpart' => 1, # allow this even if the package def is disabled ); if ($error) { $dbh->rollback if $oldAutoCommit; @@ -978,15 +1046,20 @@ sub uncancel { $dbh->rollback if $oldAutoCommit; return $svc_error; } else { + # if we've failed to insert the svc_x object, svc_Common->insert + # will have removed the cust_svc already. if not, then both records + # were inserted but we failed for some other reason (export, most + # likely). in that case, report the error and delete the records. push @svc_errors, $svc_error; - # is this necessary? svc_Common::insert already deletes the - # cust_svc if inserting svc_x fails. my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum }); if ( $cust_svc ) { - my $cs_error = $cust_svc->delete; - if ( $cs_error ) { + # except if export_insert failed, export_delete probably won't be + # much better + local $FS::svc_Common::noexport_hack = 1; + my $cleanup_error = $svc_x->delete; # also deletes cust_svc + if ( $cleanup_error ) { # and if THAT fails, then run away $dbh->rollback if $oldAutoCommit; - return $cs_error; + return $cleanup_error; } } } # svc_fatal @@ -1023,6 +1096,20 @@ sub uncancel { } ## + # Uncancel any supplemental packages, and make them supplemental to the + # new one. + ## + + foreach my $supp_pkg ( $self->supplemental_pkgs ) { + my $new_pkg; + $error = $supp_pkg->uncancel(%options, 'main_pkgnum' => $cust_pkg->pkgnum); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error"; + } + } + + ## # Finish ## @@ -1111,6 +1198,9 @@ of final invoices or unused-time credits unsuspended. This may be more convenient than calling C<unsuspend()> separately. +=item from_main - allows a supplemental package to be suspended, rather +than redirecting the method call to its main package. For internal use. + =back If there is an error, returns the error, otherwise returns false. @@ -1121,6 +1211,11 @@ sub suspend { my( $self, %options ) = @_; my $error; + # pass all suspend/cancel actions to the main package + if ( $self->main_pkgnum and !$options{'from_main'} ) { + return $self->main_pkg->suspend(%options); + } + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -1271,6 +1366,14 @@ sub suspend { } + foreach my $supp_pkg ( $self->supplemental_pkgs ) { + $error = $supp_pkg->suspend(%options, 'from_main' => 1); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "suspending supplemental pkg#".$supp_pkg->pkgnum.": $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no errors @@ -1353,6 +1456,11 @@ sub unsuspend { my( $self, %opt ) = @_; my $error; + # pass all suspend/cancel actions to the main package + if ( $self->main_pkgnum and !$opt{'from_main'} ) { + return $self->main_pkg->unsuspend(%opt); + } + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -1511,6 +1619,14 @@ sub unsuspend { } + foreach my $supp_pkg ( $self->supplemental_pkgs ) { + $error = $supp_pkg->unsuspend(%opt, 'from_main' => 1); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "unsuspending supplemental pkg#".$supp_pkg->pkgnum.": $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no errors @@ -1596,6 +1712,11 @@ New locationnum, to change the location for this package. New FS::cust_location object, to create a new location and assign it to this package. +=item cust_main + +New FS::cust_main object, to create a new customer and assign the new package +to it. + =item pkgpart New pkgpart (see L<FS::part_pkg>). @@ -1660,9 +1781,8 @@ sub change { $hash{"change_$_"} = $self->$_() foreach qw( pkgnum pkgpart locationnum ); - if ( $opt->{'cust_location'} && - ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) { - $error = $opt->{'cust_location'}->insert; + if ( $opt->{'cust_location'} ) { + $error = $opt->{'cust_location'}->find_or_insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "inserting cust_location (transaction rolled back): $error"; @@ -1670,15 +1790,23 @@ sub change { $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum; } + # whether to override pkgpart checking on the new package + my $same_pkgpart = 1; + if ( $opt->{'pkgpart'} and ( $opt->{'pkgpart'} != $self->pkgpart ) ) { + $same_pkgpart = 0; + } + my $unused_credit = 0; my $keep_dates = $opt->{'keep_dates'}; # Special case. If the pkgpart is changing, and the customer is # going to be credited for remaining time, don't keep setup, bill, # or last_bill dates, and DO pass the flag to cancel() to credit # the customer. - if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) { + if ( $opt->{'pkgpart'} + and $opt->{'pkgpart'} != $self->pkgpart + and $self->part_pkg->option('unused_credit_change', 1) ) { + $unused_credit = 1; $keep_dates = 0; - $unused_credit = 1 if $self->part_pkg->option('unused_credit_change', 1); $hash{$_} = '' foreach qw(setup bill last_bill); } @@ -1692,16 +1820,37 @@ sub change { # (i.e. customer default location) $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'}); + # usually this doesn't matter. the two cases where it does are: + # 1. unused_credit_change + pkgpart change + setup fee on the new package + # and + # 2. (more importantly) changing a package before it's billed + $hash{'waive_setup'} = $self->waive_setup; + + my $custnum = $self->custnum; + if ( $opt->{cust_main} ) { + my $cust_main = $opt->{cust_main}; + unless ( $cust_main->custnum ) { + my $error = $cust_main->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_main (transaction rolled back): $error"; + } + } + $custnum = $cust_main->custnum; + } + + $hash{'contactnum'} = $opt->{'contactnum'} if $opt->{'contactnum'}; + # Create the new package. my $cust_pkg = new FS::cust_pkg { - custnum => $self->custnum, - pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ), - refnum => ( $opt->{'refnum'} || $self->refnum ), - locationnum => ( $opt->{'locationnum'} ), + custnum => $custnum, + pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ), + refnum => ( $opt->{'refnum'} || $self->refnum ), + locationnum => ( $opt->{'locationnum'} ), %hash, }; - - $error = $cust_pkg->insert( 'change' => 1 ); + $error = $cust_pkg->insert( 'change' => 1, + 'allow_pkgpart' => $same_pkgpart ); if ($error) { $dbh->rollback if $oldAutoCommit; return $error; @@ -1747,6 +1896,96 @@ sub change { $dbh->rollback if $oldAutoCommit; return "Error setting usage values: $error"; } + } else { + # if NOT changing pkgpart, transfer any usage pools over + foreach my $usage ($self->cust_pkg_usage) { + $usage->set('pkgnum', $cust_pkg->pkgnum); + $error = $usage->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error transferring usage pools: $error"; + } + } + } + + # transfer discounts, if we're not changing pkgpart + if ( $same_pkgpart ) { + foreach my $old_discount ($self->cust_pkg_discount_active) { + # don't remove the old discount, we may still need to bill that package. + my $new_discount = new FS::cust_pkg_discount { + 'pkgnum' => $cust_pkg->pkgnum, + 'discountnum' => $old_discount->discountnum, + 'months_used' => $old_discount->months_used, + }; + $error = $new_discount->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error transferring discounts: $error"; + } + } + } + + # transfer (copy) invoice details + foreach my $detail ($self->cust_pkg_detail) { + my $new_detail = FS::cust_pkg_detail->new({ $detail->hash }); + $new_detail->set('pkgdetailnum', ''); + $new_detail->set('pkgnum', $cust_pkg->pkgnum); + $error = $new_detail->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error transferring package notes: $error"; + } + } + + # Order any supplemental packages. + my $part_pkg = $cust_pkg->part_pkg; + my @old_supp_pkgs = $self->supplemental_pkgs; + my @new_supp_pkgs; + foreach my $link ($part_pkg->supp_part_pkg_link) { + my $old; + foreach (@old_supp_pkgs) { + if ($_->pkgpart == $link->dst_pkgpart) { + $old = $_; + $_->pkgpart(0); # so that it can't match more than once + } + last if $old; + } + # false laziness with FS::cust_main::Packages::order_pkg + my $new = FS::cust_pkg->new({ + pkgpart => $link->dst_pkgpart, + pkglinknum => $link->pkglinknum, + custnum => $custnum, + main_pkgnum => $cust_pkg->pkgnum, + locationnum => $cust_pkg->locationnum, + start_date => $cust_pkg->start_date, + order_date => $cust_pkg->order_date, + expire => $cust_pkg->expire, + adjourn => $cust_pkg->adjourn, + contract_end => $cust_pkg->contract_end, + refnum => $cust_pkg->refnum, + discountnum => $cust_pkg->discountnum, + waive_setup => $cust_pkg->waive_setup, + }); + if ( $old and $opt->{'keep_dates'} ) { + foreach (qw(setup bill last_bill)) { + $new->set($_, $old->get($_)); + } + } + $error = $new->insert( allow_pkgpart => $same_pkgpart ); + # transfer services + if ( $old ) { + $error ||= $old->transfer($new); + } + if ( $error and $error > 0 ) { + # no reason why this should ever fail, but still... + $error = "Unable to transfer all services from supplemental package ". + $old->pkgnum; + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + push @new_supp_pkgs, $new; } #Good to go, cancel old package. Notify 'cancel' of whether to credit @@ -1754,10 +1993,12 @@ sub change { #Don't allow billing the package (preceding period packages and/or #outstanding usage) if we are keeping dates (i.e. location changing), #because the new package will be billed for the same date range. + #Supplemental packages are also canceled here. $error = $self->cancel( - quiet => 1, - unused_credit => $unused_credit, - nobill => $keep_dates + quiet => 1, + unused_credit => $unused_credit, + nobill => $keep_dates, + change_custnum => ( $self->custnum != $custnum ? $custnum : '' ), ); if ($error) { $dbh->rollback if $oldAutoCommit; @@ -1766,7 +2007,9 @@ sub change { if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) { #$self->cust_main - my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] ); + my $error = $cust_pkg->cust_main->bill( + 'pkg_list' => [ $cust_pkg, @new_supp_pkgs ] + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -1779,6 +2022,24 @@ sub change { } +=item set_quantity QUANTITY + +Change the package's quantity field. This is the one package property +that can safely be changed without canceling and reordering the package +(because it doesn't affect tax eligibility). Returns an error or an +empty string. + +=cut + +sub set_quantity { + my $self = shift; + $self = $self->replace_old; # just to make sure + my $qty = shift; + ($qty =~ /^\d+$/ and $qty > 0) or return "bad package quantity $qty"; + $self->set('quantity' => $qty); + $self->replace; +} + use Storable 'thaw'; use MIME::Base64; sub process_bulk_cust_pkg { @@ -1909,6 +2170,18 @@ sub old_cust_pkg { qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } ); } +=item change_cust_main + +Returns the customter this package was detached to, if any. + +=cut + +sub change_cust_main { + my $self = shift; + return '' unless $self->change_custnum; + qsearchs('cust_main', { 'custnum' => $self->change_custnum } ); +} + =item calc_setup Calls the I<calc_setup> of the FS::part_pkg object associated with this billing @@ -1933,6 +2206,18 @@ sub calc_recur { $self->part_pkg->calc_recur($self, @_); } +=item base_setup + +Calls the I<base_setup> of the FS::part_pkg object associated with this billing +item. + +=cut + +sub base_setup { + my $self = shift; + $self->part_pkg->base_setup($self, @_); +} + =item base_recur Calls the I<base_recur> of the FS::part_pkg object associated with this billing @@ -2085,6 +2370,26 @@ sub num_cust_event { $sth->fetchrow_arrayref->[0]; } +=item part_pkg_currency_option OPTIONNAME + +Returns a two item list consisting of the currency of this customer, if any, +and a value for the provided option. If the customer has a currency, the value +is the option value the given name and the currency (see +L<FS::part_pkg_currency>). Otherwise, if the customer has no currency, is the +regular option value for the given name (see L<FS::part_pkg_option>). + +=cut + +sub part_pkg_currency_option { + my( $self, $optionname ) = @_; + my $part_pkg = $self->part_pkg; + if ( my $currency = $self->cust_main->currency ) { + ($currency, $part_pkg->part_pkg_currency_option($currency, $optionname) ); + } else { + ('', $part_pkg->option($optionname) ); + } +} + =item cust_svc [ SVCPART ] (old, deprecated usage) =item cust_svc [ OPTION => VALUE ... ] (current usage) @@ -2469,7 +2774,7 @@ sub statuscolor { =item pkg_label Returns a label for this package. (Currently "pkgnum: pkg - comment" or -"pkg-comment" depending on user preference). +"pkg - comment" depending on user preference). =cut @@ -2496,6 +2801,17 @@ sub pkg_label_long { $label; } +=item pkg_locale + +Returns a customer-localized label for this package. + +=cut + +sub pkg_locale { + my $self = shift; + $self->part_pkg->pkg_locale( $self->cust_main->locale ); +} + =item primary_cust_svc Returns a primary service (as FS::cust_svc object) if one can be identified. @@ -2650,6 +2966,18 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } +=item balance + +Returns the balance for this specific package, when using +experimental package balance. + +=cut + +sub balance { + my $self = shift; + $self->cust_main->balance_pkgnum( $self->pkgnum ); +} + #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin =item cust_location @@ -2877,7 +3205,8 @@ sub transfer { } foreach my $cust_svc ($self->cust_svc) { - if($target{$cust_svc->svcpart} > 0) { + if($target{$cust_svc->svcpart} > 0 + or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option $target{$cust_svc->svcpart}--; my $new = new FS::cust_svc { $cust_svc->hash }; $new->pkgnum($dest_pkgnum); @@ -2914,6 +3243,46 @@ sub transfer { return $remaining; } +=item grab_svcnums SVCNUM, SVCNUM ... + +Change the pkgnum for the provided services to this packages. If there is an +error, returns the error, otherwise returns false. + +=cut + +sub grab_svcnums { + my $self = shift; + my @svcnum = @_; + + 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 $svcnum (@svcnum) { + my $cust_svc = qsearchs('cust_svc', { svcnum=>$svcnum } ) or do { + $dbh->rollback if $oldAutoCommit; + return "unknown svcnum $svcnum"; + }; + $cust_svc->pkgnum( $self->pkgnum ); + my $error = $cust_svc->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =item reexport This method is deprecated. See the I<depend_jobnum> option to the insert and @@ -2921,6 +3290,8 @@ order_pkgs methods in FS::cust_main for a better way to defer provisioning. =cut +#looks like this is still used by the order_pkg and change_pkg methods in +# ClientAPI/MyAccount, need to look into those before removing sub reexport { my $self = shift; @@ -2952,6 +3323,39 @@ sub reexport { } +=item export_pkg_change OLD_CUST_PKG + +Calls the "pkg_change" export action for all services attached to this package. + +=cut + +sub export_pkg_change { + my( $self, $old ) = ( shift, 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 $svc_x ( map $_->svc_x, $self->cust_svc ) { + my $error = $svc_x->export('pkg_change', $self, $old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =item insert_reason Associates this package with a (suspension or cancellation) reason (see @@ -3124,6 +3528,207 @@ sub cust_pkg_discount_active { grep { $_->status eq 'active' } $self->cust_pkg_discount; } +=item cust_pkg_usage + +Returns a list of all voice usage counters attached to this package. + +=cut + +sub cust_pkg_usage { + my $self = shift; + qsearch('cust_pkg_usage', { pkgnum => $self->pkgnum }); +} + +=item apply_usage OPTIONS + +Takes the following options: +- cdr: a call detail record (L<FS::cdr>) +- rate_detail: the rate determined for this call (L<FS::rate_detail>) +- minutes: the maximum number of minutes to be charged + +Finds available usage minutes for a call of this class, and subtracts +up to that many minutes from the usage pool. If the usage pool is empty, +and the C<cdr-minutes_priority> global config option is set, minutes may +be taken from other calls as well. Either way, an allocation record will +be created (L<FS::cdr_cust_pkg_usage>) and this method will return the +number of minutes of usage applied to the call. + +=cut + +sub apply_usage { + my ($self, %opt) = @_; + my $cdr = $opt{cdr}; + my $rate_detail = $opt{rate_detail}; + my $minutes = $opt{minutes}; + my $classnum = $rate_detail->classnum; + my $pkgnum = $self->pkgnum; + my $custnum = $self->custnum; + + 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 $order = FS::Conf->new->config('cdr-minutes_priority'); + + my $is_classnum; + if ( $classnum ) { + $is_classnum = ' part_pkg_usage_class.classnum = '.$classnum; + } else { + $is_classnum = ' part_pkg_usage_class.classnum IS NULL'; + } + my @usage_recs = qsearch({ + 'table' => 'cust_pkg_usage', + 'addl_from' => ' JOIN part_pkg_usage USING (pkgusagepart)'. + ' JOIN cust_pkg USING (pkgnum)'. + ' JOIN part_pkg_usage_class USING (pkgusagepart)', + 'select' => 'cust_pkg_usage.*', + 'extra_sql' => " WHERE ( cust_pkg.pkgnum = $pkgnum OR ". + " ( cust_pkg.custnum = $custnum AND ". + " part_pkg_usage.shared IS NOT NULL ) ) AND ". + $is_classnum . ' AND '. + " cust_pkg_usage.minutes > 0", + 'order_by' => " ORDER BY priority ASC", + }); + + my $orig_minutes = $minutes; + my $error; + while (!$error and $minutes > 0 and @usage_recs) { + my $cust_pkg_usage = shift @usage_recs; + $cust_pkg_usage->select_for_update; + my $cdr_cust_pkg_usage = FS::cdr_cust_pkg_usage->new({ + pkgusagenum => $cust_pkg_usage->pkgusagenum, + acctid => $cdr->acctid, + minutes => min($cust_pkg_usage->minutes, $minutes), + }); + $cust_pkg_usage->set('minutes', + sprintf('%.0f', $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes) + ); + $error = $cust_pkg_usage->replace || $cdr_cust_pkg_usage->insert; + $minutes -= $cdr_cust_pkg_usage->minutes; + } + if ( $order and $minutes > 0 and !$error ) { + # then try to steal minutes from another call + my %search = ( + 'table' => 'cdr_cust_pkg_usage', + 'addl_from' => ' JOIN cust_pkg_usage USING (pkgusagenum)'. + ' JOIN part_pkg_usage USING (pkgusagepart)'. + ' JOIN cust_pkg USING (pkgnum)'. + ' JOIN part_pkg_usage_class USING (pkgusagepart)'. + ' JOIN cdr USING (acctid)', + 'select' => 'cdr_cust_pkg_usage.*', + 'extra_sql' => " WHERE cdr.freesidestatus = 'rated' AND ". + " ( cust_pkg.pkgnum = $pkgnum OR ". + " ( cust_pkg.custnum = $custnum AND ". + " part_pkg_usage.shared IS NOT NULL ) ) AND ". + " part_pkg_usage_class.classnum = $classnum", + 'order_by' => ' ORDER BY part_pkg_usage.priority ASC', + ); + if ( $order eq 'time' ) { + # find CDRs that are using minutes, but have a later startdate + # than this call + my $startdate = $cdr->startdate; + if ($startdate !~ /^\d+$/) { + die "bad cdr startdate '$startdate'"; + } + $search{'extra_sql'} .= " AND cdr.startdate > $startdate"; + # minimize needless reshuffling + $search{'order_by'} .= ', cdr.startdate DESC'; + } else { + # XXX may not work correctly with rate_time schedules. Could + # fix this by storing ratedetailnum in cdr_cust_pkg_usage, I + # think... + $search{'addl_from'} .= + ' JOIN rate_detail'. + ' ON (cdr.rated_ratedetailnum = rate_detail.ratedetailnum)'; + if ( $order eq 'rate_high' ) { + $search{'extra_sql'} .= ' AND rate_detail.min_charge < '. + $rate_detail->min_charge; + $search{'order_by'} .= ', rate_detail.min_charge ASC'; + } elsif ( $order eq 'rate_low' ) { + $search{'extra_sql'} .= ' AND rate_detail.min_charge > '. + $rate_detail->min_charge; + $search{'order_by'} .= ', rate_detail.min_charge DESC'; + } else { + # this should really never happen + die "invalid cdr-minutes_priority value '$order'\n"; + } + } + my @cdr_usage_recs = qsearch(\%search); + my %reproc_cdrs; + while (!$error and @cdr_usage_recs and $minutes > 0) { + my $cdr_cust_pkg_usage = shift @cdr_usage_recs; + my $cust_pkg_usage = $cdr_cust_pkg_usage->cust_pkg_usage; + my $old_cdr = $cdr_cust_pkg_usage->cdr; + $reproc_cdrs{$old_cdr->acctid} = $old_cdr; + $cdr_cust_pkg_usage->select_for_update; + $old_cdr->select_for_update; + $cust_pkg_usage->select_for_update; + # in case someone else stole the usage from this CDR + # while waiting for the lock... + next if $old_cdr->acctid != $cdr_cust_pkg_usage->acctid; + # steal the usage allocation and flag the old CDR for reprocessing + $cdr_cust_pkg_usage->set('acctid', $cdr->acctid); + # if the allocation is more minutes than we need, adjust it... + my $delta = $cdr_cust_pkg_usage->minutes - $minutes; + if ( $delta > 0 ) { + $cdr_cust_pkg_usage->set('minutes', $minutes); + $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $delta); + $error = $cust_pkg_usage->replace; + } + #warn 'CDR '.$cdr->acctid . ' stealing allocation '.$cdr_cust_pkg_usage->cdrusagenum.' from CDR '.$old_cdr->acctid."\n"; + $error ||= $cdr_cust_pkg_usage->replace; + # deduct the stolen minutes + $minutes -= $cdr_cust_pkg_usage->minutes; + } + # after all minute-stealing is done, reset the affected CDRs + foreach (values %reproc_cdrs) { + $error ||= $_->set_status(''); + # XXX or should we just call $cdr->rate right here? + # it's not like we can create a loop this way, since the min_charge + # or call time has to go monotonically in one direction. + # we COULD get some very deep recursions going, though... + } + } # if $order and $minutes + if ( $error ) { + $dbh->rollback; + die "error applying included minutes\npkgnum ".$self->pkgnum.", class $classnum, acctid ".$cdr->acctid."\n$error\n" + } else { + $dbh->commit if $oldAutoCommit; + return $orig_minutes - $minutes; + } +} + +=item supplemental_pkgs + +Returns a list of all packages supplemental to this one. + +=cut + +sub supplemental_pkgs { + my $self = shift; + qsearch('cust_pkg', { 'main_pkgnum' => $self->pkgnum }); +} + +=item main_pkg + +Returns the package that this one is supplemental to, if any. + +=cut + +sub main_pkg { + my $self = shift; + if ( $self->main_pkgnum ) { + return FS::cust_pkg->by_key($self->main_pkgnum); + } + return; +} + =back =head1 CLASS METHODS @@ -3651,10 +4256,10 @@ sub search { my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : ''; - my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '. - 'LEFT JOIN part_pkg USING ( pkgpart ) '. + my $addl_from = 'LEFT JOIN part_pkg USING ( pkgpart ) '. 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '. - 'LEFT JOIN cust_location USING ( locationnum ) '; + 'LEFT JOIN cust_location USING ( locationnum ) '. + FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'); my $select; my $count_query; @@ -3938,11 +4543,25 @@ sub order { %hash, }; $error = $cust_pkg->insert( 'change' => $change ); + push @$return_cust_pkg, $cust_pkg; + + foreach my $link ($cust_pkg->part_pkg->supp_part_pkg_link) { + my $supp_pkg = FS::cust_pkg->new({ + custnum => $custnum, + pkgpart => $link->dst_pkgpart, + refnum => $refnum, + main_pkgnum => $cust_pkg->pkgnum, + %hash, + }); + $error ||= $supp_pkg->insert( 'change' => $change ); + push @$return_cust_pkg, $supp_pkg; + } + if ($error) { $dbh->rollback if $oldAutoCommit; return $error; } - push @$return_cust_pkg, $cust_pkg; + } # $return_cust_pkg now contains refs to all of the newly # created packages. diff --git a/FS/FS/cust_pkg_discount.pm b/FS/FS/cust_pkg_discount.pm index 5f4d0dccf..d82d94990 100644 --- a/FS/FS/cust_pkg_discount.pm +++ b/FS/FS/cust_pkg_discount.pm @@ -164,7 +164,7 @@ sub check { $self->ut_numbern('pkgdiscountnum') || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum') || $self->ut_foreign_key('discountnum', 'discount', 'discountnum' ) - || $self->ut_float('months_used') #actually decimal, but this will do + || $self->ut_sfloat('months_used') #actually decimal, but this will do || $self->ut_numbern('end_date') || $self->ut_alphan('otaker') || $self->ut_numbern('usernum') @@ -202,7 +202,7 @@ sub discount { qsearchs('discount', { 'discountnum' => $self->discountnum } ); } -=item increment_months_used +=item increment_months_used MONTHS Increments months_used by the given parameter @@ -216,6 +216,31 @@ sub increment_months_used { $self->replace(); } +=item decrement_months_used MONTHS + +Decrement months_used by the given parameter + +(Note: as in, extending the length of the discount. Typically only used to +stack/extend a discount when the customer package has one active already.) + +=cut + +sub decrement_months_used { + my( $self, $recharged ) = @_; + #UPDATE cust_pkg_discount SET months_used = months_used - ? + #leaves no history, and billing is mutexed per-customer + + #we're run from part_event/Action/referral_pkg_discount on behalf of a + # different customer, so we need to grab this customer's mutex. + # incidentally, that's some inelegant encapsulation breaking shit, and a + # great argument in favor of native-DB trigger history so we can trust + # in normal ACID like the SQL above instead of this + $self->cust_pkg->cust_main->select_for_update; + + $self->months_used( $self->months_used - $recharged ); + $self->replace(); +} + =item status =cut diff --git a/FS/FS/cust_pkg_usage.pm b/FS/FS/cust_pkg_usage.pm new file mode 100644 index 000000000..0eefd7480 --- /dev/null +++ b/FS/FS/cust_pkg_usage.pm @@ -0,0 +1,163 @@ +package FS::cust_pkg_usage; + +use strict; +use base qw( FS::Record ); +use FS::cust_pkg; +use FS::part_pkg_usage; +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::cust_pkg_usage - Object methods for cust_pkg_usage records + +=head1 SYNOPSIS + + use FS::cust_pkg_usage; + + $record = new FS::cust_pkg_usage \%hash; + $record = new FS::cust_pkg_usage { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_pkg_usage object represents a counter of remaining included +minutes on a voice-call package. FS::cust_pkg_usage inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item pkgusagenum - primary key + +=item pkgnum - the package (L<FS::cust_pkg>) containing the usage + +=item pkgusagepart - the usage stock definition (L<FS::part_pkg_usage>). +This record in turn links to the call usage classes that are eligible to +use these minutes. + +=item minutes - the remaining minutes + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +# the new method can be inherited from FS::Record, if a table method is defined + +=cut + +sub table { 'cust_pkg_usage'; } + +=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 + +sub delete { + my $self = shift; + my $error = $self->reset || $self->SUPER::delete; +} + +=item reset + +Remove all allocations of this usage to CDRs. + +=cut + +sub reset { + my $self = shift; + my $error = ''; + foreach (qsearch('cdr_cust_pkg_usage', { pkgusagenum => $self->pkgusagenum })) + { + $error ||= $_->delete; + } + $error; +} + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('pkgusagenum') + || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum') + || $self->ut_numbern('minutes') + || $self->ut_foreign_key('pkgusagepart', 'part_pkg_usage', 'pkgusagepart') + ; + return $error if $error; + + if ( $self->minutes eq '' ) { + $self->set(minutes => $self->part_pkg_usage->minutes); + } + + $self->SUPER::check; +} + +=item cust_pkg + +Return the L<FS::cust_pkg> linked to this record. + +=item part_pkg_usage + +Return the L<FS::part_pkg_usage> linked to this record. + +=cut + +sub cust_pkg { + my $self = shift; + FS::cust_pkg->by_key($self->pkgnum); +} + +sub part_pkg_usage { + my $self = shift; + FS::part_pkg_usage->by_key($self->pkgusagepart); +} + +=back + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm index 7df7a557a..064992955 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -5,7 +5,6 @@ use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin FS::Record ); use vars qw( @encrypted_fields ); use Business::CreditCard; -use FS::UID qw(getotaker); use FS::Record qw( qsearch qsearchs dbh ); use FS::CurrentUser; use FS::cust_credit; @@ -87,6 +86,11 @@ order taker (see L<FS::access_user> books closed flag, empty or `Y' +=item gatewaynum, processor, auth, order_number + +Same as for L<FS::cust_pay>, but specifically the result of realtime +authorization of the refund. + =back =head1 METHODS diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 52069316d..2066a05ac 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -13,6 +13,7 @@ use FS::pkg_svc; use FS::domain_record; use FS::part_export; use FS::cdr; +use FS::UI::Web; #most FS::svc_ classes are autoloaded in svc_x emthod use FS::svc_acct; #this one is used in the cache stuff @@ -294,6 +295,17 @@ sub replace { # } # } + #trigger a pkg_change export on pkgnum changes + if ( $new->pkgnum != $old->pkgnum ) { + my $error = $new->svc_x->export('pkg_change', $new->cust_pkg, + $old->cust_pkg, + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error if $error; + } + } + #my $error = $new->SUPER::replace($old, @_); my $error = $new->SUPER::replace($old); if ( $error ) { @@ -479,7 +491,7 @@ Returns a listref of html elements associated with this service's exports. sub export_links { my $self = shift; my $svc_x = $self->svc_x - or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum; + or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ]; $svc_x->export_links; } @@ -793,14 +805,17 @@ sub get_session_history { } -=item tickets +=item tickets [ STATUS ] Returns an array of hashes representing the tickets linked to this service. +An optional status (or arrayref or hashref of statuses) may be specified. + =cut sub tickets { my $self = shift; + my $status = ( @_ && $_[0] ) ? shift : ''; my $conf = FS::Conf->new; my $num = $conf->config('cust_main-max_tickets') || 10; @@ -809,7 +824,12 @@ sub tickets { if ( $conf->config('ticket_system') ) { unless ( $conf->config('ticket_system-custom_priority_field') ) { - @tickets = @{ FS::TicketSystem->service_tickets($self->svcnum, $num) }; + @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum, + $num, + undef, + $status, + ) + }; } else { @@ -819,10 +839,11 @@ sub tickets { last if scalar(@tickets) >= $num; push @tickets, @{ FS::TicketSystem->service_tickets( $self->svcnum, - $num - scalar(@tickets), - $priority, - ) - }; + $num - scalar(@tickets), + $priority, + $status, + ) + }; } } } @@ -862,38 +883,83 @@ sub smart_search_param { my @or = map { my $table = $_; my $search_sql = "FS::$table"->search_sql($string); - " ( svcdb = '$table' - AND 0 < ( SELECT COUNT(*) FROM $table - WHERE $table.svcnum = cust_svc.svcnum - AND $search_sql - ) - ) "; + + "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ". + "FROM $table WHERE $search_sql"; } FS::part_svc->svc_tables; if ( $string =~ /^(\d+)$/ ) { - unshift @or, " ( agent_svcid IS NOT NULL AND agent_svcid = $1 ) "; + unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1"; } - my @extra_sql = ' ( '. join(' OR ', @or). ' ) '; + my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ". + " ON (svc_all.svcnum = cust_svc.svcnum) "; + + my @extra_sql; push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql( 'null_right' => 'View/link unlinked services' ); my $extra_sql = ' WHERE '.join(' AND ', @extra_sql); #for agentnum - my $addl_from = ' LEFT JOIN cust_pkg USING ( pkgnum )'. - ' LEFT JOIN cust_main USING ( custnum )'. + $addl_from .= ' LEFT JOIN cust_pkg USING ( pkgnum )'. + FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'). ' LEFT JOIN part_svc USING ( svcpart )'; ( 'table' => 'cust_svc', + 'select' => 'svc_all.svcnum AS svcnum, '. + 'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '. + 'cust_svc.*', 'addl_from' => $addl_from, 'hashref' => {}, 'extra_sql' => $extra_sql, ); } +sub _upgrade_data { + my $class = shift; + + # fix missing (deleted by mistake) svc_x records + warn "searching for missing svc_x records...\n"; + my %search = ( + 'table' => 'cust_svc', + 'select' => 'cust_svc.*', + 'addl_from' => ' LEFT JOIN ( ' . + join(' UNION ', + map { "SELECT svcnum FROM $_" } + FS::part_svc->svc_tables + ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum', + 'extra_sql' => ' WHERE svc_all.svcnum IS NULL', + ); + my @svcs = qsearch(\%search); + warn "found ".scalar(@svcs)."\n"; + + local $FS::Record::nowarn_classload = 1; # for h_svc_ + local $FS::svc_Common::noexport_hack = 1; # because we're inserting services + + my %h_search = ( + 'hashref' => { history_action => 'delete' }, + 'order_by' => ' ORDER BY history_date DESC LIMIT 1', + ); + foreach my $cust_svc (@svcs) { + my $svcnum = $cust_svc->svcnum; + my $svcdb = $cust_svc->part_svc->svcdb; + $h_search{'hashref'}{'svcnum'} = $svcnum; + $h_search{'table'} = "h_$svcdb"; + my $h_svc_x = qsearchs(\%h_search) + or next; + my $class = "FS::$svcdb"; + my $new_svc_x = $class->new({ $h_svc_x->hash }); + my $error = $new_svc_x->insert; + warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n" + if $error; + } + + ''; +} + =back =head1 BUGS diff --git a/FS/FS/cust_tax_location.pm b/FS/FS/cust_tax_location.pm index 1a9bf5a41..4293b2c90 100644 --- a/FS/FS/cust_tax_location.pm +++ b/FS/FS/cust_tax_location.pm @@ -199,13 +199,15 @@ sub batch_import { if (exists($hash->{actionflag}) && $hash->{actionflag} eq 'D') { delete($hash->{actionflag}); - my $cust_tax_location = qsearchs('cust_tax_location', $hash); + my @cust_tax_location = qsearch('cust_tax_location', $hash); return "Can't find cust_tax_location to delete: ". join(" ", map { "$_ => ". $hash->{$_} } @fields) - unless $cust_tax_location; + unless scalar(@cust_tax_location) || $param->{'delete_only'} ; - my $error = $cust_tax_location->delete; - return $error if $error; + foreach my $cust_tax_location (@cust_tax_location) { + my $error = $cust_tax_location->delete; + return $error if $error; + } delete($hash->{$_}) foreach (keys %$hash); } @@ -234,13 +236,15 @@ sub batch_import { if (exists($hash->{actionflag}) && $hash->{actionflag} eq 'D') { delete($hash->{actionflag}); - my $cust_tax_location = qsearchs('cust_tax_location', $hash); + my @cust_tax_location = qsearch('cust_tax_location', $hash); return "Can't find cust_tax_location to delete: ". join(" ", map { "$_ => ". $hash->{$_} } @fields) - unless $cust_tax_location; + unless scalar(@cust_tax_location) || $param->{'delete_only'} ; - my $error = $cust_tax_location->delete; - return $error if $error; + foreach my $cust_tax_location (@cust_tax_location) { + my $error = $cust_tax_location->delete; + return $error if $error; + } delete($hash->{$_}) foreach (keys %$hash); } diff --git a/FS/FS/device_Common.pm b/FS/FS/device_Common.pm new file mode 100644 index 000000000..ac00b7669 --- /dev/null +++ b/FS/FS/device_Common.pm @@ -0,0 +1,78 @@ +package FS::device_Common; + +use strict; +use NEXT; +use FS::Record qw( qsearch dbh ); # qsearchs ); + +=head1 NAME + +FS::device_Common - Base class for svc_X classes which have associated X_devices + +=head1 SYNOPSIS + + package FS::svc_newservice + use base qw( FS::device_Common FS::svc_Common ); + +=head1 DESCRIPTION + +=cut + +sub _device_table { + my $self = shift; + ( my $device_table = $self->table ) =~ s/^svc_//; + $device_table.'_device'; +} + +sub device_table { + my $self = shift; + my $device_table = $self->_device_table; + eval "use FS::$device_table;"; + die $@ if $@; + $device_table; +} + +sub device_objects { + my $self = shift; + qsearch($self->device_table, { 'svcnum' => $self->svcnum } ); +} + +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 $device ( $self->device_objects ) { + my $error = $device->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $error = $self->NEXT::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=head1 BUGS + +=head1 SEE ALSO + +=cut + +1; diff --git a/FS/FS/export_svc.pm b/FS/FS/export_svc.pm index 0370f5f0b..b08f8f7c3 100644 --- a/FS/FS/export_svc.pm +++ b/FS/FS/export_svc.pm @@ -5,6 +5,7 @@ use vars qw( @ISA ); use FS::Record qw( qsearch qsearchs dbh ); use FS::part_export; use FS::part_svc; +use FS::svc_export_machine; @ISA = qw(FS::Record); @@ -209,6 +210,19 @@ sub insert { } #end of duplicate check, whew $error = $self->SUPER::insert; + + my $part_export = $self->part_export; + if ( !$error and $part_export->default_machine ) { + foreach my $cust_svc ( $self->part_svc->cust_svc ) { + my $svc_export_machine = FS::svc_export_machine->new({ + 'exportnum' => $self->exportnum, + 'svcnum' => $cust_svc->svcnum, + 'machinenum' => $part_export->default_machine, + }); + $error ||= $svc_export_machine->insert; + } + } + if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -251,7 +265,23 @@ Delete this record from the database. =cut -# the delete method can be inherited from FS::Record +sub delete { + my $self = shift; + my $dbh = dbh; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + + my $error = $self->SUPER::delete; + foreach ($self->svc_export_machine) { + $error ||= $_->delete; + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; +} + =item replace OLD_RECORD @@ -307,6 +337,24 @@ sub part_svc { qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); } +=item svc_export_machine + +Returns all export hostname records (L<FS::svc_export_machine>) for this +combination of svcpart and exportnum. + +=cut + +sub svc_export_machine { + my $self = shift; + qsearch({ + 'table' => 'svc_export_machine', + 'select' => 'svc_export_machine.*', + 'addl_from' => 'JOIN cust_svc USING (svcnum)', + 'hashref' => { 'exportnum' => $self->exportnum }, + 'extra_sql' => ' AND cust_svc.svcpart = '.$self->svcpart, + }); +} + =back =head1 BUGS diff --git a/FS/FS/ftp_target.pm b/FS/FS/ftp_target.pm deleted file mode 100644 index bf9fc891a..000000000 --- a/FS/FS/ftp_target.pm +++ /dev/null @@ -1,194 +0,0 @@ -package FS::ftp_target; - -use strict; -use base qw( FS::Record ); -use FS::Record qw( qsearch qsearchs ); -use vars qw($me $DEBUG); - -$DEBUG = 0; - -=head1 NAME - -FS::ftp_target - Object methods for ftp_target records - -=head1 SYNOPSIS - - use FS::ftp_target; - - $record = new FS::ftp_target \%hash; - $record = new FS::ftp_target { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::ftp_target object represents an account on a remote FTP or SFTP -server for transferring files. FS::ftp_target inherits from FS::Record. - -=over 4 - -=item targetnum - primary key - -=item agentnum - L<FS::agent> foreign key; can be null - -=item hostname - the DNS name of the FTP site - -=item username - username - -=item password - password - -=item path - the working directory to change to upon connecting - -=item secure - a flag ('Y' or null) for whether to use SFTP - -=back - -=head1 METHODS - -=over 4 - -=cut - -sub table { 'ftp_target'; } - -=item new HASHREF - -Creates a new FTP target. To add it to the database, see L<"insert">. - -=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 example. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - - if ( !$self->get('port') ) { - if ( $self->secure ) { - $self->set('port', 22); - } else { - $self->set('port', 21); - } - } - - my $error = - $self->ut_numbern('targetnum') - || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum') - || $self->ut_text('hostname') - || $self->ut_text('username') - || $self->ut_text('password') - || $self->ut_number('port') - || $self->ut_text('path') - || $self->ut_flag('secure') - || $self->ut_enum('handling', [ $self->handling_types ]) - ; - return $error if $error; - - $self->SUPER::check; -} - -=item connect - -Creates a Net::FTP or Net::SFTP::Foreign object (according to the setting -of the 'secure' flag), connects to 'hostname', attempts to log in with -'username' and 'password', and changes the working directory to 'path'. -On success, returns the object. On failure, dies with an error message. - -=cut - -sub connect { - my $self = shift; - if ( $self->secure ) { - eval "use Net::SFTP::Foreign;"; - die $@ if $@; - my %args = ( - port => $self->port, - user => $self->username, - password => $self->password, - more => ($DEBUG ? '-v' : ''), - timeout => 30, - autodie => 1, #we're doing this anyway - ); - my $sftp = Net::SFTP::Foreign->new($self->hostname, %args); - $sftp->setcwd($self->path); - return $sftp; - } - else { - eval "use Net::FTP;"; - die $@ if $@; - my %args = ( - Debug => $DEBUG, - Port => $self->port, - Passive => 1,# optional? - ); - my $ftp = Net::FTP->new($self->hostname, %args) - or die "connect to ".$self->hostname." failed: $@"; - $ftp->login($self->username, $self->password) - or die "login to ".$self->username.'@'.$self->hostname." failed: $@"; - $ftp->binary; #optional? - $ftp->cwd($self->path) - or ($self->path eq '/') - or die "cwd to ".$self->hostname.'/'.$self->path." failed: $@"; - - return $ftp; - } -} - -=item label - -Returns a descriptive label for this target. - -=cut - -sub label { - my $self = shift; - $self->targetnum . ': ' . $self->username . '@' . $self->hostname; -} - -=item handling_types - -Returns a list of values for the "handling" field, corresponding to the -known ways to preprocess a file before uploading. Currently those are -implemented somewhat crudely in L<FS::Cron::upload>. - -=cut - -sub handling_types { - '', - #'billco', #not implemented this way yet - 'bridgestone', -} - -=back - -=head1 SEE ALSO - -L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/h_cust_location.pm b/FS/FS/h_cust_location.pm new file mode 100644 index 000000000..fc3a93061 --- /dev/null +++ b/FS/FS/h_cust_location.pm @@ -0,0 +1,26 @@ +package FS::h_cust_location; + +use strict; +use base qw( FS::h_Common FS::cust_location ); + +sub table { 'h_cust_location' }; + +=head1 NAME + +FS::h_cust_location - Historical customer location records. + +=head1 DESCRIPTION + +An FS::h_cust_location object represents historical changes to a customer +location record. These records normally don't change, so this isn't +terribly useful. + +=head1 SEE ALSO + +L<FS::cust_location>, L<FS::h_Common>, L<FS::Record>, schema.html from the +base documentation. + +=cut + +1; + diff --git a/FS/FS/h_cust_pkg.pm b/FS/FS/h_cust_pkg.pm index e796f4145..99037c22f 100644 --- a/FS/FS/h_cust_pkg.pm +++ b/FS/FS/h_cust_pkg.pm @@ -20,6 +20,79 @@ FS::h_cust_pkg - Historical record of customer package changes An FS::h_cust_pkg object represents historical changes to packages. FS::h_cust_pkg inherits from FS::h_Common and FS::cust_pkg. +=head1 CLASS METHODS + +=over 4 + +=item search HASHREF + +Like L<FS::cust_pkg::search>, but adapted for searching historical records. +Takes the additional parameter "date", which is the timestamp to perform +the search "as of" (i.e. search the most recent insert or replace_new record +for each pkgnum that is not later than that date). + +=cut + +sub search { + my ($class, $params) = @_; + my $date = delete $params->{'date'}; + $date =~ /^\d*$/ or die "invalid search date '$date'\n"; + + my $query = FS::cust_pkg->search($params); + + # allow multiple status criteria + # this might be useful in the base cust_pkg search, but I haven't + # tested it there yet + my $status = delete $params->{'status'}; + if( $status ) { + my @status_where; + foreach ( split(',', $status) ) { + if ( /^active$/ ) { + push @status_where, $class->active_sql(); + } elsif ( /^not[ _]yet[ _]billed$/ ) { + push @status_where, $class->not_yet_billed_sql(); + } elsif ( /^(one-time charge|inactive)$/ ) { + push @status_where, $class->inactive_sql(); + } elsif ( /^suspended$/ ) { + push @status_where, $class->suspended_sql(); + } elsif ( /^cancell?ed$/ ) { + push @status_where, $class->cancelled_sql(); + } + } + if ( @status_where ) { + $query->{'extra_sql'} .= ' AND ('.join(' OR ', @status_where).')'; + $query->{'count_query'} .= ' AND ('.join(' OR ', @status_where).')'; + } + } + + # make some adjustments + $query->{'table'} = 'h_cust_pkg'; + foreach (qw(select addl_from extra_sql count_query)) { + $query->{$_} =~ s/cust_pkg\b/h_cust_pkg/g; + $query->{$_} =~ s/cust_main\b/h_cust_main/g; + } + + my $and_where = " AND h_cust_pkg.historynum = + (SELECT historynum FROM h_cust_pkg AS mostrecent + WHERE mostrecent.pkgnum = h_cust_pkg.pkgnum + AND mostrecent.history_date <= $date + AND mostrecent.history_action IN ('insert', 'replace_new') + ORDER BY history_date DESC,historynum DESC LIMIT 1 + ) AND h_cust_main.historynum = + (SELECT historynum FROM h_cust_main AS mostrecent + WHERE mostrecent.custnum = h_cust_main.custnum + AND mostrecent.history_date <= h_cust_pkg.history_date + AND mostrecent.history_action IN ('insert', 'replace_new') + ORDER BY history_date DESC,historynum DESC LIMIT 1 + )"; + + $query->{'extra_sql'} .= $and_where; + $query->{'count_query'} .= $and_where; + + $query; +} + + =head1 BUGS =head1 SEE ALSO diff --git a/FS/FS/h_svc_cable.pm b/FS/FS/h_svc_cable.pm new file mode 100644 index 000000000..cee290882 --- /dev/null +++ b/FS/FS/h_svc_cable.pm @@ -0,0 +1,32 @@ +package FS::h_svc_cable; + +use strict; +use vars qw( @ISA ); +use FS::h_Common; +use FS::svc_cable; + +@ISA = qw( FS::h_Common FS::svc_cable ); + +sub table { 'h_svc_cable' }; + +=head1 NAME + +FS::h_svc_cable - Historical PBX objects + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +An FS::h_svc_cable object represents a historical cable subscriber. +FS::h_svc_cable inherits from FS::h_Common and FS::svc_cable. + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::h_Common>, L<FS::svc_cable>, L<FS::Record> + +=cut + +1; + diff --git a/FS/FS/log.pm b/FS/FS/log.pm new file mode 100644 index 000000000..a4ad214d0 --- /dev/null +++ b/FS/FS/log.pm @@ -0,0 +1,354 @@ +package FS::log; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs dbdef ); +use FS::UID qw( dbh driver_name ); +use FS::log_context; + +=head1 NAME + +FS::log - Object methods for log records + +=head1 SYNOPSIS + + use FS::log; + + $record = new FS::log \%hash; + $record = new FS::log { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::log object represents a log entry. FS::log inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item lognum - primary key + +=item _date - Unix timestamp + +=item agentnum - L<FS::agent> to which the log pertains. If it involves a +specific customer, package, service, invoice, or other agent-specific object, +this will be set to that agentnum. + +=item tablename - table name to which the log pertains, if any. + +=item tablenum - foreign key to that table. + +=item level - log level: 'debug', 'info', 'notice', 'warning', 'error', +'critical', 'alert', 'emergency'. + +=item message - contents of the log entry + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new log entry. Use FS::Log instead of calling this directly, +please. + +=cut + +sub table { 'log'; } + +=item insert [ CONTEXT... ] + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +CONTEXT may be a list of context tags to attach to this record. + +=cut + +sub insert { + # not using process_o2m for this, because we don't have a web interface + my $self = shift; + my $error = $self->SUPER::insert; + return $error if $error; + foreach ( @_ ) { + my $context = FS::log_context->new({ + 'lognum' => $self->lognum, + 'context' => $_ + }); + $error = $context->insert; + return $error if $error; + } + ''; +} + +# the insert method can be inherited from FS::Record + +sub delete { die "Log entries can't be modified." }; + +sub replace { die "Log entries can't be modified." }; + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('lognum') + || $self->ut_number('_date') + || $self->ut_numbern('agentnum') + || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum') + || $self->ut_textn('tablename') + || $self->ut_numbern('tablenum') + || $self->ut_number('level') + || $self->ut_text('message') + ; + return $error if $error; + + if ( my $tablename = $self->tablename ) { + my $dbdef_table = dbdef->table($tablename) + or return "tablename '$tablename' does not exist"; + $error = $self->ut_foreign_key('tablenum', + $tablename, + $dbdef_table->primary_key); + return $error if $error; + } + + $self->SUPER::check; +} + +=item context + +Returns the context for this log entry, as an array, from least to most +specific. + +=cut + +sub context { + my $self = shift; + map { $_->context } qsearch({ + table => 'log_context', + hashref => { lognum => $self->lognum }, + order_by => 'ORDER BY logcontextnum ASC', + }); +} + +=back + +=head1 CLASS METHODS + +=over 4 + +=item search HASHREF + +Returns a qsearch hash expression to search for parameters specified in +HASHREF. Valid parameters are: + +=over 4 + +=item agentnum + +=item date - arrayref of start and end date + +=item level - either a specific level, or an arrayref of min and max level + +=item context - a context string that the log entry must have. This may +change in the future to allow searching for combinations of context strings. + +=item object - any database object, to find log entries related to it. + +=item tablename, tablenum - alternate way of specifying 'object'. + +=item custnum - a customer number, to find log entries related to the customer +or any of their subordinate objects (invoices, packages, etc.). + +=item message - a text string to search in messages. The search will be +a case-insensitive LIKE with % appended at both ends. + +=back + +=cut + +# used for custnum search: all tables with custnums +my @table_stubs; + +sub _setup_table_stubs { + foreach my $table ( + qw( + contact + cust_attachment + cust_bill + cust_credit + cust_location + cust_main + cust_main_exemption + cust_main_note + cust_msg + cust_pay + cust_pay_batch + cust_pay_pending + cust_pay_void + cust_pkg + cust_refund + cust_statement + cust_tag + cust_tax_adjustment + cust_tax_exempt + did_order_item + qual + queue ) ) + { + my $pkey = dbdef->table($table)->primary_key; + push @table_stubs, + "log.tablename = '$table' AND ". + "EXISTS(SELECT 1 FROM $table WHERE log.tablenum = $table.$pkey AND ". + "$table.custnum = "; # needs a closing ) + } + # plus this case + push @table_stubs, + "(log.tablename LIKE 'svc_%' OR log.tablename = 'cust_svc') AND ". + "EXISTS(SELECT 1 FROM cust_svc JOIN cust_pkg USING (svcnum) WHERE ". + "cust_pkg.custnum = "; # needs a closing ) +} + +sub search { + my ($class, $params) = @_; + my @where; + + ## + # parse agent + ## + + if ( $params->{'agentnum'} =~ /^(\d+)$/ ) { + push @where, + "log.agentnum = $1"; + } + + ## + # parse custnum + ## + + if ( $params->{'custnum'} =~ /^(\d+)$/ ) { + _setup_table_stubs() unless @table_stubs; + my $custnum = $1; + my @orwhere = map { "( $_ $custnum) )" } @table_stubs; + push @where, join(' OR ', @orwhere); + } + + ## + # parse level + ## + + if ( ref $params->{'level'} eq 'ARRAY' ) { + my ($min, $max) = @{ $params->{'level'} }; + if ( $min =~ /^\d+$/ ) { + push @where, "log.level >= $min"; + } + if ( $max =~ /^\d+$/ ) { + push @where, "log.level <= $max"; + } + } elsif ( $params->{'level'} =~ /^(\d+)$/ ) { + push @where, "log.level = $1"; + } + + ## + # parse date + ## + + if ( ref $params->{'date'} eq 'ARRAY' ) { + my ($beg, $end) = @{ $params->{'date'} }; + if ( $beg =~ /^\d+$/ ) { + push @where, "log._date >= $beg"; + } + if ( $end =~ /^\d+$/ ) { + push @where, "log._date <= $end"; + } + } + + ## + # parse object + ## + + if ( $params->{'object'} and $params->{'object'}->isa('FS::Record') ) { + my $table = $params->{'object'}->table; + my $pkey = dbdef->table($table)->primary_key; + my $tablenum = $params->{'object'}->get($pkey); + if ( $table and $tablenum ) { + push @where, "log.tablename = '$table'", "log.tablenum = $tablenum"; + } + } elsif ( $params->{'tablename'} =~ /^(\w+)$/ ) { + my $table = $1; + if ( $params->{'tablenum'} =~ /^(\d+)$/ ) { + push @where, "log.tablename = '$table'", "log.tablenum = $1"; + } + } + + ## + # parse message + ## + + if ( $params->{'message'} ) { # can be anything, really, so escape it + my $quoted_message = dbh->quote('%' . $params->{'message'} . '%'); + my $op = (driver_name eq 'Pg' ? 'ILIKE' : 'LIKE'); + push @where, "log.message $op $quoted_message"; + } + + ## + # parse context + ## + + if ( $params->{'context'} ) { + my $quoted = dbh->quote($params->{'context'}); + push @where, + "EXISTS(SELECT 1 FROM log_context WHERE log.lognum = log_context.lognum ". + "AND log_context.context = $quoted)"; + } + + # agent virtualization + my $access_user = $FS::CurrentUser::CurrentUser; + push @where, $access_user->agentnums_sql( + table => 'log', + viewall_right => 'Configuration', + null => 1, + ); + + # put it together + my $extra_sql = ''; + $extra_sql .= 'WHERE ' . join(' AND ', @where) if @where; + my $count_query = 'SELECT COUNT(*) FROM log '.$extra_sql; + my $sql_query = { + 'table' => 'log', + 'hashref' => {}, + 'select' => 'log.*', + 'extra_sql' => $extra_sql, + 'count_query' => $count_query, + 'order_by' => 'ORDER BY _date ASC', + #addl_from, not needed + }; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/log_context.pm b/FS/FS/log_context.pm new file mode 100644 index 000000000..a25490588 --- /dev/null +++ b/FS/FS/log_context.pm @@ -0,0 +1,147 @@ +package FS::log_context; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +my @contexts = ( qw( + test + bill_and_collect + Cron::bill + Cron::upload + spool_upload + daily + queue + upgrade + upgrade_taxable_billpkgnum +) ); + +=head1 NAME + +FS::log_context - Object methods for log_context records + +=head1 SYNOPSIS + + use FS::log_context; + + $record = new FS::log_context \%hash; + $record = new FS::log_context { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::log_context object represents a context tag attached to a log entry +(L<FS::log>). FS::log_context inherits from FS::Record. The following +fields are currently supported: + +=over 4 + +=item logcontextnum - primary key + +=item lognum - lognum (L<FS::log> foreign key) + +=item context - context + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new context tag. To add the example to the database, see +L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'log_context'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('logcontextnum') + || $self->ut_number('lognum') + || $self->ut_enum('context', \@contexts) + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 CLASS METHODS + +=over 4 + +=item contexts + +Returns a list of all valid contexts. + +=cut + +sub contexts { @contexts } + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Log>, L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/msg_template.pm b/FS/FS/msg_template.pm index e38346a66..2f5e4762a 100644 --- a/FS/FS/msg_template.pm +++ b/FS/FS/msg_template.pm @@ -3,7 +3,7 @@ package FS::msg_template; use strict; use base qw( FS::Record ); use Text::Template; -use FS::Misc qw( generate_email send_email ); +use FS::Misc qw( generate_email send_email do_print ); use FS::Conf; use FS::Record qw( qsearch qsearchs ); use FS::UID qw( dbh ); @@ -457,24 +457,13 @@ sub render { my %hash = $self->prepare(%opt); my $html = $hash{'html_body'}; - my $tmp = 'msg'.$self->msgnum.'-'.time2str('%Y%m%d', time).'-XXXXXXXX'; - my $dir = "$FS::UID::cache_dir/cache.$FS::UID::datasrc"; - # Graphics/stylesheets should probably go in /var/www on the Freeside # machine. my $kit = PDF::WebKit->new(\$html); #%options # hack to use our wrapper script $kit->configure(sub { shift->wkhtmltopdf('freeside-wkhtmltopdf') }); - my $fh = File::Temp->new( - TEMPLATE => $tmp, - DIR => $dir, - UNLINK => 0, - SUFFIX => '.pdf' - ); - print $fh $kit->to_pdf; - close $fh; - return $fh->filename; + $kit->to_pdf; } =item print OPTIONS @@ -484,13 +473,10 @@ Render a PDF and send it to the printer. OPTIONS are as for 'render'. =cut sub print { - my $file = render(@_); - my @lpr = $conf->config('lpr'); - run ([@lpr, '-r'], '<', $file) - or die "lpr error:\n$?\n"; + my( $self, %opt ) = @_; + do_print( [ $self->render(%opt) ], agentnum=>$opt{cust_main}->agentnum ); } - # helper sub for package dates my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' }; diff --git a/FS/FS/part_event/Action/Mixin/credit_agent_pkg_class.pm b/FS/FS/part_event/Action/Mixin/credit_agent_pkg_class.pm index 73d32e0a7..cb61f1b77 100644 --- a/FS/FS/part_event/Action/Mixin/credit_agent_pkg_class.pm +++ b/FS/FS/part_event/Action/Mixin/credit_agent_pkg_class.pm @@ -2,6 +2,7 @@ package FS::part_event::Action::Mixin::credit_agent_pkg_class; use base qw( FS::part_event::Action::Mixin::credit_pkg ); use strict; +use FS::Record qw(qsearchs); sub option_fields { my $class = shift; @@ -15,7 +16,7 @@ sub _calc_credit_percent { my $agent_pkg_class = qsearchs( 'agent_pkg_class', { 'agentnum' => $self->cust_main($cust_pkg)->agentnum, - 'classnum' => $cust_pkg->classnum, + 'classnum' => $cust_pkg->part_pkg->classnum, }); $agent_pkg_class ? $agent_pkg_class->commission_percent : 0; diff --git a/FS/FS/part_event/Action/Mixin/credit_pkg.pm b/FS/FS/part_event/Action/Mixin/credit_pkg.pm index 9dcd701a9..a3c1d6efb 100644 --- a/FS/FS/part_event/Action/Mixin/credit_pkg.pm +++ b/FS/FS/part_event/Action/Mixin/credit_pkg.pm @@ -16,18 +16,24 @@ sub option_fields { 'type' => 'input-percentage', 'default' => '100', }, - 'what' => { 'label' => 'Of', - 'type' => 'select', - #add additional ways to specify in the package def - 'options' => [ qw( base_recur_permonth unit_setup recur_cost_permonth setup_cost ) ], - 'labels' => { 'base_recur_permonth' => 'Base monthly fee', - 'unit_setup' => 'Setup fee', - 'recur_cost_permonth' => 'Monthly cost', - 'setup_cost' => 'Setup cost', - }, - }, + 'what' => { + 'label' => 'Of', + 'type' => 'select', + #add additional ways to specify in the package def + 'options' => [qw( + base_recur_permonth cust_bill_pkg_recur recur_cost_permonth + unit_setup setup_cost + )], + 'labels' => { + 'base_recur_permonth' => 'Base monthly fee', + 'cust_bill_pkg_recur' => 'Actual invoiced amount of most recent'. + ' recurring charge', + 'recur_cost_permonth' => 'Monthly cost', + 'unit_setup' => 'Setup fee', + 'setup_cost' => 'Setup cost', + }, + }, ); - } #my %no_cust_pkg = ( 'setup_cost' => 1 ); diff --git a/FS/FS/part_event/Action/cust_bill_send_reminder.pm b/FS/FS/part_event/Action/cust_bill_send_reminder.pm index 2ba8136dd..073bb8fd3 100644 --- a/FS/FS/part_event/Action/cust_bill_send_reminder.pm +++ b/FS/FS/part_event/Action/cust_bill_send_reminder.pm @@ -11,9 +11,10 @@ sub eventtable_hashref { sub option_fields { ( - 'notice_name' => 'Reminder name', - #'notes' => { 'label' => 'Reminder notes' }, + 'notice_name' => 'Reminder name', + #'notes' => { 'label' => 'Reminder notes' }, #include standard notes? no/prepend/append + 'lpr' => 'Optional alternate print command', ); } @@ -25,7 +26,10 @@ sub do_action { #my $cust_main = $self->cust_main($cust_bill); #my $cust_main = $cust_bill->cust_main; - $cust_bill->send({ 'notice_name' => $self->option('notice_name') }); + $cust_bill->send({ + 'notice_name' => $self->option('notice_name'), + 'lpr' => $self->option('lpr'), + }); } 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 14349a9dd..250c83042 100644 --- a/FS/FS/part_event/Action/cust_bill_spool_csv.pm +++ b/FS/FS/part_event/Action/cust_bill_spool_csv.pm @@ -26,9 +26,9 @@ sub option_fields { type => 'checkbox', value => '1', }, - 'ftp_targetnum' => { label => 'Upload spool to FTP target', + 'upload_targetnum' => { label => 'Upload spool to target', type => 'select-table', - table => 'ftp_target', + table => 'upload_target', name_col => 'label', empty_label => '(do not upload)', order_by => 'targetnum', @@ -39,16 +39,17 @@ sub option_fields { sub default_weight { 50; } sub do_action { - my( $self, $cust_bill ) = @_; + my( $self, $cust_bill, $cust_event ) = @_; #my $cust_main = $self->cust_main($cust_bill); my $cust_main = $cust_bill->cust_main; $cust_bill->spool_csv( + 'time' => $cust_event->_date, 'format' => $self->option('spoolformat'), 'balanceover' => $self->option('spoolbalanceover'), 'agent_spools' => $self->option('spoolagent_spools'), - 'ftp_targetnum'=> $self->option('ftp_targetnum'), + 'upload_targetnum'=> $self->option('upload_targetnum'), ); } diff --git a/FS/FS/part_event/Action/fee.pm b/FS/FS/part_event/Action/fee.pm index 68288d090..cd9e200c8 100644 --- a/FS/FS/part_event/Action/fee.pm +++ b/FS/FS/part_event/Action/fee.pm @@ -17,14 +17,25 @@ sub option_fields { type=>'checkbox', value=>'Y' }, 'nextbill' => { label=>'Hold late fee until next invoice', type=>'checkbox', value=>'Y' }, + 'limit_to_credit'=> + { label=>"Charge no more than the customer's credit balance", + type=>'checkbox', value=>'Y' }, ); } sub default_weight { 10; } sub _calc_fee { - #my( $self, $cust_object ) = @_; - my $self = shift; + my( $self, $cust_object ) = @_; + if ( $self->option('limit_to_credit') ) { + my $balance = $cust_object->cust_main->balance; + if ( $balance >= 0 ) { + return 0; + } elsif ( (-1 * $balance) < $self->option('charge') ) { + return -1 * $balance; + } + } + $self->option('charge'); } @@ -44,6 +55,9 @@ sub do_action { 'setuptax' => $self->option('setuptax'), ); + # amazingly, FS::cust_main::charge will allow a charge of zero + return '' if $charge{'amount'} == 0; + #unless its more than N months away? $charge{'start_date'} = $cust_main->next_bill_date if $self->option('nextbill'); diff --git a/FS/FS/part_event/Action/pkg_unsuspend.pm b/FS/FS/part_event/Action/pkg_unsuspend.pm new file mode 100644 index 000000000..894103896 --- /dev/null +++ b/FS/FS/part_event/Action/pkg_unsuspend.pm @@ -0,0 +1,25 @@ +package FS::part_event::Action::pkg_unsuspend; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { 'Unsuspend this package'; } + +sub eventtable_hashref { + { 'cust_pkg' => 1, + 'svc_acct' => 1, }; +} + +sub default_weight { 20; } + +sub do_action { + my( $self, $object, $cust_event ) = @_; + my $cust_pkg = $self->cust_pkg($object); + + my $error = $cust_pkg->unsuspend(); + die $error if $error; + + ''; +} + +1; diff --git a/FS/FS/part_event/Action/referral_pkg_billdate.pm b/FS/FS/part_event/Action/referral_pkg_billdate.pm new file mode 100644 index 000000000..6b485e59b --- /dev/null +++ b/FS/FS/part_event/Action/referral_pkg_billdate.pm @@ -0,0 +1,59 @@ +package FS::part_event::Action::referral_pkg_billdate; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { "Increment the referring customer's package's next bill date"; } + +#sub eventtable_hashref { +#} + +sub option_fields { + ( + 'if_pkgpart' => { 'label' => 'Only packages', + 'type' => 'select-part_pkg', + 'multiple' => 1, + }, + 'increment' => { 'label' => 'Increment by', + 'type' => 'freq', + 'value' => '1m', + }, + ); +} + +#false laziness w/referral_pkg_discount, probably should make +# Mixin/referral_pkg.pm if we need changes or anything else in this vein +sub do_action { + my( $self, $cust_object, $cust_event ) = @_; + + my $cust_main = $self->cust_main($cust_object); + + return 'No referring customer' unless $cust_main->referral_custnum; + + my $referring_cust_main = $cust_main->referring_cust_main; + #return 'Referring customer is cancelled' + # if $referring_cust_main->status eq 'cancelled'; + + my %if_pkgpart = map { $_=>1 } split(/\s*,\s*/, $self->option('if_pkgpart') ); + my @cust_pkg = grep $if_pkgpart{ $_->pkgpart }, + $referring_cust_main->billing_pkgs; + return 'No qualifying billing package definition' unless @cust_pkg; + + my $cust_pkg = $cust_pkg[0]; #only one + + #end of false laziness + + my $bill = $cust_pkg->bill || $cust_pkg->setup || time; + + $cust_pkg->bill( + $cust_pkg->part_pkg->add_freq( $bill, $self->option('increment') ) + ); + + my $error = $cust_pkg->replace; + die "Error incrementing next bill date: $error" if $error; + + ''; + +} + +1; diff --git a/FS/FS/part_event/Action/referral_pkg_discount.pm b/FS/FS/part_event/Action/referral_pkg_discount.pm new file mode 100644 index 000000000..2ff1b35fb --- /dev/null +++ b/FS/FS/part_event/Action/referral_pkg_discount.pm @@ -0,0 +1,101 @@ +package FS::part_event::Action::referral_pkg_discount; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { "Discount the referring customer's package"; } + +#sub eventtable_hashref { +#} + +sub option_fields { + ( + 'if_pkgpart' => { 'label' => 'Only packages', + 'type' => 'select-part_pkg', + 'multiple' => 1, + }, + 'discountnum' => { 'label' => 'Discount', + 'type' => 'select-table', #we don't handle the select-discount create a discount case + 'table' => 'discount', + 'name_col' => 'description', #well, method + 'order_by' => 'ORDER BY discountnum', #requied because name_col is a method + 'hashref' => { 'disabled' => '', + 'months' => { op=>'!=', value=>'0' }, + }, + 'disable_empty' => 1, + }, + ); +} + +#false laziness w/referral_pkg_billdate, probably should make +# Mixin/referral_pkg.pm if we need changes or anything else in this vein +sub do_action { + my( $self, $cust_object, $cust_event ) = @_; + + my $cust_main = $self->cust_main($cust_object); + + return 'No referring customer' unless $cust_main->referral_custnum; + + my $referring_cust_main = $cust_main->referring_cust_main; + #return 'Referring customer is cancelled' + # if $referring_cust_main->status eq 'cancelled'; + + my %if_pkgpart = map { $_=>1 } split(/\s*,\s*/, $self->option('if_pkgpart') ); + my @cust_pkg = grep $if_pkgpart{ $_->pkgpart }, + $referring_cust_main->billing_pkgs; + return 'No qualifying billing package definition' unless @cust_pkg; + + my $cust_pkg = $cust_pkg[0]; #only one + + #end of false laziness + + my @cust_pkg_discount = $cust_pkg->cust_pkg_discount_active; + my @my_cust_pkg_discount = + grep { $_->discountnum == $self->option('discountnum') } @cust_pkg_discount; + + if ( @my_cust_pkg_discount ) { #increment the existing one instead + + die "guru meditation #and: multiple discounts" + if scalar(@my_cust_pkg_discount) > 1; + + my $cust_pkg_discount = $my_cust_pkg_discount[0]; + my $discount = $cust_pkg_discount->discount; + die "guru meditation #goob: can't extended non-expiring discount" + if $discount->months == 0; + + my $error = $cust_pkg_discount->decrement_months_used( $discount->months ); + die "Error extending discount: $error\n" if $error; + + } elsif ( @cust_pkg_discount ) { + + #"stacked" discount case not possible from UI, not handled, so prevent + # against creating one here. i guess we could try to find a different + # @cust_pkg above if this case needed to be handled better? + die "Can't discount an already discounted package"; + + } else { #normal case, create a new one + + my $cust_pkg_discount = new FS::cust_pkg_discount { + 'pkgnum' => $cust_pkg->pkgnum, + 'discountnum' => $self->option('discountnum'), + 'months_used' => 0, + #'end_date' => '', + #we dont handle the create a new discount case + #'_type' => scalar($cgi->param('discountnum__type')), + #'amount' => scalar($cgi->param('discountnum_amount')), + #'percent' => scalar($cgi->param('discountnum_percent')), + #'months' => scalar($cgi->param('discountnum_months')), + #'setup' => scalar($cgi->param('discountnum_setup')), + ##'linked' => scalar($cgi->param('discountnum_linked')), + ##'disabled' => $self->discountnum_disabled, + }; + my $error = $cust_pkg_discount->insert; + die "Error discounting package: $error\n" if $error; + + } + + ''; + +} + +1; diff --git a/FS/FS/part_event/Action/unsuspend.pm b/FS/FS/part_event/Action/unsuspend.pm new file mode 100644 index 000000000..b8cfbb12c --- /dev/null +++ b/FS/FS/part_event/Action/unsuspend.pm @@ -0,0 +1,23 @@ +package FS::part_event::Action::unsuspend; + +use strict; +use base qw( FS::part_event::Action ); + +sub description { 'Unsuspend all of this customer\'s suspended packages'; } + +sub default_weight { 11; } + +sub do_action { + my( $self, $cust_object ) = @_; + + my $cust_main = $self->cust_main($cust_object); + + my @err = $cust_main->unsuspend(); + + die join(' / ', @err) if scalar(@err); + + ''; + +} + +1; diff --git a/FS/FS/part_event/Condition.pm b/FS/FS/part_event/Condition.pm index fc69f1d0c..60697c196 100644 --- a/FS/FS/part_event/Condition.pm +++ b/FS/FS/part_event/Condition.pm @@ -524,7 +524,7 @@ comparison to other integers is type-correct. sub condition_sql_option_integer { my ($class, $option, $driver_name) = @_; - my $integer = ($driver_name =~ /^mysql/) ? 'UNSIGNED INTEGER' : 'INTEGER'; + my $integer = (driver_name() =~ /^mysql/) ? 'UNSIGNED INTEGER' : 'INTEGER'; 'CAST( COALESCE('. $class->condition_sql_option($option). diff --git a/FS/FS/part_event/Condition/cust_bill_owed_percent.pm b/FS/FS/part_event/Condition/cust_bill_owed_percent.pm new file mode 100644 index 000000000..e06b511ef --- /dev/null +++ b/FS/FS/part_event/Condition/cust_bill_owed_percent.pm @@ -0,0 +1,50 @@ +package FS::part_event::Condition::cust_bill_owed_percent; + +use strict; +use FS::cust_bill; + +use base qw( FS::part_event::Condition ); + +sub description { + 'Percentage owed on specific invoice'; +} + +sub eventtable_hashref { + { 'cust_main' => 0, + 'cust_bill' => 1, + 'cust_pkg' => 0, + }; +} + +sub option_fields { + ( + 'owed' => { 'label' => 'Percentage of invoice owed over', + 'type' => 'percentage', + 'value' => '0', #default + }, + ); +} + +sub condition { + #my($self, $cust_bill, %opt) = @_; + my($self, $cust_bill) = @_; + + my $percent = $self->option('owed') || 0; + my $over = sprintf('%.2f', + $cust_bill->charged * $percent / 100); + + $cust_bill->owed > $over; +} + +sub condition_sql { + my( $class, $table ) = @_; + + # forces the option to be an integer--do we care? + my $percent = $class->condition_sql_option_integer('owed'); + + my $owed_sql = FS::cust_bill->owed_sql; + + "$owed_sql > CAST( cust_bill.charged * $percent / 100 AS DECIMAL(10,2) )"; +} + +1; diff --git a/FS/FS/part_event/Condition/has_pkgpart.pm b/FS/FS/part_event/Condition/has_pkgpart.pm index c54b7e256..d85e1bd43 100644 --- a/FS/FS/part_event/Condition/has_pkgpart.pm +++ b/FS/FS/part_event/Condition/has_pkgpart.pm @@ -4,7 +4,7 @@ use strict; use base qw( FS::part_event::Condition ); -sub description { 'Customer has uncancelled package of specified definitions'; } +sub description { 'Customer has uncancelled specific package(s)'; } sub eventtable_hashref { { 'cust_main' => 1, @@ -27,7 +27,6 @@ sub condition { my $cust_main = $self->cust_main($object); - #XXX test my $if_pkgpart = $self->option('if_pkgpart') || {}; grep $if_pkgpart->{ $_->pkgpart }, $cust_main->ncancelled_pkgs; diff --git a/FS/FS/part_event/Condition/has_referral_custnum.pm b/FS/FS/part_event/Condition/has_referral_custnum.pm index dee240fec..c50579411 100644 --- a/FS/FS/part_event/Condition/has_referral_custnum.pm +++ b/FS/FS/part_event/Condition/has_referral_custnum.pm @@ -13,7 +13,7 @@ sub option_fields { 'type' => 'checkbox', 'value' => 'Y', }, - 'check_bal' => { 'label' => 'Check referring custoemr balance', + 'check_bal' => { 'label' => 'Check referring customer balance', 'type' => 'checkbox', 'value' => 'Y', }, diff --git a/FS/FS/part_event/Condition/has_referral_pkgpart.pm b/FS/FS/part_event/Condition/has_referral_pkgpart.pm new file mode 100644 index 000000000..60ba7ccd5 --- /dev/null +++ b/FS/FS/part_event/Condition/has_referral_pkgpart.pm @@ -0,0 +1,38 @@ +package FS::part_event::Condition::has_referral_pkgpart; +use base qw( FS::part_event::Condition ); + +#maybe i should be incorporated in has_referral_custnum + +use strict; + +sub description { 'Customer has a referring customer with uncancelled specific package(s)'; } + +sub option_fields { + ( + 'if_pkgpart' => { 'label' => 'Only packages: ', + 'type' => 'select-part_pkg', + 'multiple' => 1, + }, + ); +} + +sub condition { + my($self, $object, %opt) = @_; + + my $cust_main = $self->cust_main($object); + + return 0 unless $cust_main->referral_custnum; + + my $if_pkgpart = $self->option('if_pkgpart') || {}; + grep $if_pkgpart->{ $_->pkgpart }, + $cust_main->referral_custnum_cust_main->ncancelled_pkgs; + #maybe billing_pkgs +} + +#XXX +#sub condition_sql { +# +#} + +1; + diff --git a/FS/FS/part_event/Condition/inactive_age.pm b/FS/FS/part_event/Condition/inactive_age.pm new file mode 100644 index 000000000..cbf4b9e0a --- /dev/null +++ b/FS/FS/part_event/Condition/inactive_age.pm @@ -0,0 +1,78 @@ +package FS::part_event::Condition::inactive_age; + +use strict; +use base qw( FS::part_event::Condition ); +use FS::Record qw( qsearch ); + +sub description { 'Days without billing activity' } + +sub option_fields { + ( + 'age' => { 'label' => 'No activity within', + 'type' => 'freq', + }, + 'ignore_pkgclass' => + { 'label' => 'Except charges of class', + 'type' => 'select-pkg_class', + }, + # flags to select kinds of activity, + # like if you just want "no payments since"? + # not relevant yet + ); +} + +sub condition { + my( $self, $obj, %opt ) = @_; + my $custnum = $obj->custnum; + my $age = $self->option_age_from('age', $opt{'time'} ); + + my $ignore_pkgclass = $self->option('ignore_pkgclass'); + + my $where = "custnum = $custnum AND _date >= $age"; + + foreach my $t (qw(cust_pay cust_credit cust_refund)) { + my $class = "FS::$t"; + return 0 if $class->count($where); + } + + # cust_bill: handle the ignore_pkgclass option + if ( $ignore_pkgclass =~ /^\d+$/ ) { + $where .= " AND EXISTS( ". + "SELECT 1 FROM cust_bill_pkg JOIN cust_pkg USING (pkgnum) " . + "JOIN part_pkg USING (pkgpart) " . + "WHERE cust_bill_pkg.invnum = cust_bill.invnum " . + "AND COALESCE(part_pkg.classnum, -1) != $ignore_pkgclass" . + " )"; + } + #warn "$where\n"; + return 0 if FS::cust_bill->count($where); + + 1; +} + +sub condition_sql { + my( $class, $table, %opt ) = @_; + my $age = $class->condition_sql_option_age_from('age', $opt{'time'}); + my $ignore_pkgclass = $class->condition_sql_option_integer('ignore_pkgclass'); + # will evaluate to zero if there isn't one + my @sql; + for my $t (qw(cust_pay cust_credit cust_refund)) { + push @sql, + "NOT EXISTS( SELECT 1 FROM $t ". + "WHERE $t.custnum = cust_main.custnum AND $t._date >= $age". + ")"; + } + #cust_bill + push @sql, + "NOT EXISTS( ". + "SELECT 1 FROM cust_bill JOIN cust_bill_pkg USING (invnum) ". + "JOIN cust_pkg USING (pkgnum) JOIN part_pkg USING (pkgpart) ". + "WHERE cust_bill.custnum = cust_main.custnum ". + "AND cust_bill._date >= $age ". + "AND COALESCE(part_pkg.classnum, -1) != $ignore_pkgclass ". + ")"; + join(' AND ', @sql); +} + +1; + diff --git a/FS/FS/part_event/Condition/message_email.pm b/FS/FS/part_event/Condition/message_email.pm new file mode 100644 index 000000000..7cceba697 --- /dev/null +++ b/FS/FS/part_event/Condition/message_email.pm @@ -0,0 +1,22 @@ +package FS::part_event::Condition::message_email; +use base qw( FS::part_event::Condition ); +use strict; + +sub description { + 'Customer allows email notices' +} + +sub condition { + my( $self, $object ) = @_; + my $cust_main = $self->cust_main($object); + + $cust_main->message_noemail ? 0 : 1; +} + +sub condition_sql { + my( $self, $table ) = @_; + + "cust_main.message_noemail IS NULL" +} + +1; diff --git a/FS/FS/part_event/Condition/once_percust.pm b/FS/FS/part_event/Condition/once_percust.pm index b8a8fbfb6..67767f91b 100644 --- a/FS/FS/part_event/Condition/once_percust.pm +++ b/FS/FS/part_event/Condition/once_percust.pm @@ -45,7 +45,6 @@ sub condition { } -#XXX test? sub condition_sql { my( $self, $table ) = @_; diff --git a/FS/FS/part_event/Condition/once_perinv.pm b/FS/FS/part_event/Condition/once_perinv.pm index f85a05665..1ee53b812 100644 --- a/FS/FS/part_event/Condition/once_perinv.pm +++ b/FS/FS/part_event/Condition/once_perinv.pm @@ -12,6 +12,15 @@ sub description { "Run only once for each time the package has been billed"; } # Run the event, at most, a number of times equal to the number of # distinct invoices that contain line items from this package. +sub option_fields { + ( + 'paid' => { 'label' => 'Only count paid bills', + 'type' => 'checkbox', + 'value' => 'Y', + }, + ) +} + sub eventtable_hashref { { 'cust_main' => 0, 'cust_bill' => 0, @@ -22,9 +31,15 @@ sub eventtable_hashref { sub condition { my($self, $cust_pkg, %opt) = @_; - my %invnum; - $invnum{$_->invnum} = 1 - foreach ( qsearch('cust_bill_pkg', { 'pkgnum' => $cust_pkg->pkgnum }) ); + my @cust_bill_pkg = qsearch('cust_bill_pkg', { pkgnum=>$cust_pkg->pkgnum }); + + @cust_bill_pkg = grep { ($_->owed_setup + $_->owed_recur) == 0 } + @cust_bill_pkg + if $self->option('paid'); + + my %invnum = (); + $invnum{$_->invnum} = 1 foreach @cust_bill_pkg; + my @events = qsearch( { 'table' => 'cust_event', 'hashref' => { 'eventpart' => $self->eventpart, @@ -40,6 +55,9 @@ sub condition { sub condition_sql { my( $self, $table ) = @_; + #paid flag not yet implemented here, but that's okay, a partial optimization + # is better than none + "( ( SELECT COUNT(distinct(invnum)) FROM cust_bill_pkg diff --git a/FS/FS/part_event/Condition/pkg_age.pm b/FS/FS/part_event/Condition/pkg_age.pm index 4a8538780..de5897097 100644 --- a/FS/FS/part_event/Condition/pkg_age.pm +++ b/FS/FS/part_event/Condition/pkg_age.pm @@ -23,16 +23,18 @@ sub option_fields { }, 'field' => { 'label' => 'Compare date', 'type' => 'select', - 'options' => - [qw( setup last_bill bill adjourn susp expire cancel )], + 'options' => [qw( + setup last_bill bill adjourn susp expire cancel contract_end + )], 'labels' => { - 'setup' => 'Setup date', - 'last_bill' => 'Last bill date', - 'bill' => 'Next bill date', - 'adjourn' => 'Adjournment date', - 'susp' => 'Suspension date', - 'expire' => 'Expiration date', - 'cancel' => 'Cancellation date', + 'setup' => 'Setup date', + 'last_bill' => 'Last bill date', + 'bill' => 'Next bill date', + 'adjourn' => 'Adjournment date', + 'susp' => 'Suspension date', + 'expire' => 'Expiration date', + 'cancel' => 'Cancellation date', + 'contract_end' => 'Contract end date', }, }, ); @@ -55,7 +57,7 @@ sub condition_sql { my $field = $class->condition_sql_option('field'); #amazingly, this is actually faster my $sql = '( CASE'; - foreach( qw(setup last_bill bill adjourn susp expire cancel) ) { + foreach( qw(setup last_bill bill adjourn susp expire cancel contract_end) ) { $sql .= " WHEN $field = '$_' THEN (cust_pkg.$_ IS NOT NULL AND cust_pkg.$_ <= $age)"; } $sql .= ' END )'; diff --git a/FS/FS/part_event/Condition/pkg_dundate.pm b/FS/FS/part_event/Condition/pkg_dundate.pm index f25db2ae8..fefee2022 100644 --- a/FS/FS/part_event/Condition/pkg_dundate.pm +++ b/FS/FS/part_event/Condition/pkg_dundate.pm @@ -19,7 +19,7 @@ sub condition { #my $cust_main = $self->cust_main($cust_pkg); - $cust_pkg->dundate <= $opt{time}; + ( $cust_pkg->dundate || 0 ) <= $opt{time}; } diff --git a/FS/FS/part_event/Condition/pkg_not_reason_type.pm b/FS/FS/part_event/Condition/pkg_not_reason_type.pm new file mode 100644 index 000000000..3fa08b762 --- /dev/null +++ b/FS/FS/part_event/Condition/pkg_not_reason_type.pm @@ -0,0 +1,58 @@ +package FS::part_event::Condition::pkg_not_reason_type; +use base qw( FS::part_event::Condition ); + +use strict; +use Tie::IxHash; +#use FS::Record qw( qsearch ); + +sub description { + 'Package Not Reason Type'; +} + +sub eventtable_hashref { + { 'cust_main' => 0, + 'cust_bill' => 0, + 'cust_pkg' => 1, + 'svc_acct' => 1, + }; +} + +tie my %actions, 'Tie::IxHash', + #'adjourn' => + 'susp' => 'Suspension', + #'expire' => + 'cancel' => 'Cancellation' +; + +sub option_fields { + ( + 'action' => { 'label' => 'Package Action', + 'type' => 'select', + 'options' => [ keys %actions ], + 'labels' => \%actions, + }, + 'typenum' => { 'label' => 'Not Reason Type', + 'type' => 'select-reason_type', + 'multiple' => 1, + }, + ); +} + +sub condition { + my( $self, $object ) = @_; + + my $cust_pkg = $self->cust_pkg($object); + + my $reason = $cust_pkg->last_reason( $self->option('action') ) + or return 0; + + my $hashref = $self->option('typenum') || {}; + ! $hashref->{ $reason->reason_type }; +} + +#sub condition_sql { +# my( $self, $table ) = @_; +# +#} + +1; diff --git a/FS/FS/part_event/Condition/pkg_reason_type.pm b/FS/FS/part_event/Condition/pkg_reason_type.pm new file mode 100644 index 000000000..f110e1b04 --- /dev/null +++ b/FS/FS/part_event/Condition/pkg_reason_type.pm @@ -0,0 +1,58 @@ +package FS::part_event::Condition::pkg_reason_type; +use base qw( FS::part_event::Condition ); + +use strict; +use Tie::IxHash; +#use FS::Record qw( qsearch ); + +sub description { + 'Package Reason Type'; +} + +sub eventtable_hashref { + { 'cust_main' => 0, + 'cust_bill' => 0, + 'cust_pkg' => 1, + 'svc_acct' => 1, + }; +} + +tie my %actions, 'Tie::IxHash', + #'adjourn' => + 'susp' => 'Suspension', + #'expire' => + 'cancel' => 'Cancellation' +; + +sub option_fields { + ( + 'action' => { 'label' => 'Package Action', + 'type' => 'select', + 'options' => [ keys %actions ], + 'labels' => \%actions, + }, + 'typenum' => { 'label' => 'Reason Type', + 'type' => 'select-reason_type', + 'multiple' => 1, + }, + ); +} + +sub condition { + my( $self, $object ) = @_; + + my $cust_pkg = $self->cust_pkg($object); + + my $reason = $cust_pkg->last_reason( $self->option('action') ) + or return 0; + + my $hashref = $self->option('typenum') || {}; + $hashref->{ $reason->reason_type }; +} + +#sub condition_sql { +# my( $self, $table ) = @_; +# +#} + +1; diff --git a/FS/FS/part_event/Condition/times_percust.pm b/FS/FS/part_event/Condition/times_percust.pm new file mode 100644 index 000000000..fc7064b7e --- /dev/null +++ b/FS/FS/part_event/Condition/times_percust.pm @@ -0,0 +1,76 @@ +package FS::part_event::Condition::times_percust; + +use strict; +use FS::Record qw( qsearch ); +use FS::part_event; +use FS::cust_event; + +use base qw( FS::part_event::Condition ); + +sub description { "Run this event the specified number of times per customer"; } + +sub option_fields { + ( + 'run_times' => { label=>'Number of times', type=>'text', value=>'1', }, + ); +} + +sub eventtable_hashref { + { 'cust_main' => 0, + 'cust_bill' => 1, + 'cust_pkg' => 1, + }; +} + +sub condition { + my($self, $object, %opt) = @_; + + my $obj_pkey = $object->primary_key; + my $obj_table = $object->table; + my $custnum = $object->custnum; + + my @where = ( + "tablenum IN ( SELECT $obj_pkey FROM $obj_table WHERE custnum = $custnum )" + ); + if ( $opt{'cust_event'}->eventnum =~ /^(\d+)$/ ) { + push @where, " eventnum != $1 "; + } + my $extra_sql = ' AND '. join(' AND ', @where); + + my @existing = qsearch( { + 'table' => 'cust_event', + 'hashref' => { + 'eventpart' => $self->eventpart, + #'tablenum' => $tablenum, + 'status' => { op=>'!=', value=>'failed' }, + }, + 'extra_sql' => $extra_sql, + } ); + + scalar(@existing) < $self->option('run_times'); + +} + +sub condition_sql { + my( $class, $table, %opt ) = @_; + + my %pkey = %{ FS::part_event->eventtable_pkey }; + + my $run_times = + $class->condition_sql_option_integer('run_times', $opt{'driver_name'}); + + my $pkey = $pkey{$table}; + + my $existing = "( SELECT COUNT(*) FROM cust_event + WHERE cust_event.eventpart = part_event.eventpart + AND cust_event.tablenum IN ( + SELECT $pkey FROM $table AS times_percust + WHERE times_percust.custnum = cust_main.custnum ) + AND status != 'failed' + )"; + + "$existing < $run_times"; + +} + +1; diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index b0f708a66..28cb1419d 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -125,31 +125,14 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->SUPER::insert(@_); + my $error = $self->SUPER::insert(@_) + || $self->replace; + # use replace to do all the part_export_machine and default_machine stuff if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - #kinda false laziness with process_m2name - my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ } - grep /\S/, - split /[\n\r]{1,2}/, - $self->part_export_machine_textarea; - - foreach my $machine ( @machines ) { - - my $part_export_machine = new FS::part_export_machine { - 'exportnum' => $self->exportnum, - 'machine' => $machine, - }; - $error = $part_export_machine->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -217,6 +200,7 @@ or modified. sub replace { my $self = shift; + my $old = $self->replace_old; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -228,12 +212,7 @@ sub replace { my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; - - my $error = $self->SUPER::replace(@_); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } + my $error; if ( $self->part_export_machine_textarea ) { @@ -258,6 +237,10 @@ sub replace { } } + if ( $self->default_machine_name eq $machine ) { + $self->default_machine( $part_export_machine{$machine}->machinenum ); + } + delete $part_export_machine{$machine}; #so we don't disable it below } else { @@ -272,11 +255,13 @@ sub replace { return $error; } + if ( $self->default_machine_name eq $machine ) { + $self->default_machine( $part_export_machine->machinenum ); + } } } - foreach my $part_export_machine ( values %part_export_machine ) { $part_export_machine->disabled('Y'); $error = $part_export_machine->replace; @@ -286,6 +271,48 @@ sub replace { } } + if ( $old->machine ne '_SVC_MACHINE' ) { + # then set up the default for any already-attached export_svcs + foreach my $export_svc ( $self->export_svc ) { + my @svcs = qsearch('cust_svc', { 'svcpart' => $export_svc->svcpart }); + foreach my $cust_svc ( @svcs ) { + my $svc_export_machine = FS::svc_export_machine->new({ + 'exportnum' => $self->exportnum, + 'svcnum' => $cust_svc->svcnum, + 'machinenum' => $self->default_machine, + }); + $error ||= $svc_export_machine->insert; + } + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } # if switching to selectable hosts + + } elsif ( $old->machine eq '_SVC_MACHINE' ) { + # then we're switching from selectable to non-selectable + foreach my $svc_export_machine ( + qsearch('svc_export_machine', { 'exportnum' => $self->exportnum }) + ) { + $error ||= $svc_export_machine->delete; + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } + + $error = $self->SUPER::replace(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + if ( $self->machine eq '_SVC_MACHINE' and ! $self->default_machine ) { + $dbh->rollback if $oldAutoCommit; + return "no default export host selected"; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -308,6 +335,13 @@ sub check { || $self->ut_domainn('machine') || $self->ut_alpha('exporttype') ; + + if ( $self->machine eq '_SVC_MACHINE' ) { + $error ||= $self->ut_numbern('default_machine') + } else { + $self->set('default_machine', ''); + } + return $error if $error; $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain; @@ -471,7 +505,9 @@ sub _rebless { $self; } -=item svc_machine +=item svc_machine SVC_X + +Return the export hostname for SVC_X. =cut @@ -483,14 +519,33 @@ sub svc_machine { my $svc_export_machine = qsearchs('svc_export_machine', { 'svcnum' => $svc_x->svcnum, 'exportnum' => $self->exportnum, - }) - #would only happen if you add this export to existing services without a - #machine set then try to run exports without setting it... right? - or die "No hostname selected for ".($self->exportname || $self->exporttype); + }); + + if (!$svc_export_machine) { + warn "No hostname selected for ".($self->exportname || $self->exporttype); + return $self->default_export_machine->machine; + } return $svc_export_machine->part_export_machine->machine; } +=item default_export_machine + +Return the default export hostname for this export. + +=cut + +sub default_export_machine { + my $self = shift; + my $machinenum = $self->default_machine; + if ( $machinenum ) { + my $default_machine = FS::part_export_machine->by_key($machinenum); + return $default_machine->machine if $default_machine; + } + # this should not happen + die "no default export hostname for export ".$self->exportnum; +} + #these should probably all go away, just let the subclasses define em =item export_insert SVC_OBJECT @@ -601,6 +656,17 @@ DEFAULTSREF is a hashref with the same keys where true values indicate the setting is a default (and thus can be displayed in the UI with less emphasis, or hidden by default). +=item actions + +Adds one or more "action" links to the export's display in +browse/part_export.cgi. Should return pairs of values. The first is +the link label; the second is the Mason path to a document to load. +The document will show in a popup. + +=cut + +sub actions { } + =cut =item weight @@ -615,6 +681,27 @@ sub weight { export_info()->{$self->exporttype}->{'weight'} || 0; } +=item info + +Returns a reference to (a copy of) the export's %info hash. + +=cut + +sub info { + my $self = shift; + $self->{_info} ||= { + %{ export_info()->{$self->exporttype} } + }; +} + +#default fallbacks... FS::part_export::DID_Common ? +sub get_dids_can_tollfree { 0; } +sub get_dids_can_manual { 0; } +sub get_dids_can_edit { 0; } #don't use without can_manual, otherwise the + # DID selector provisions a new number from + # inventory each edit +sub get_dids_npa_select { 1; } + =back =head1 SUBROUTINES @@ -671,6 +758,55 @@ sub _upgrade_data { #class method $error = $opt->replace; die $error if $error; } + # for exports that have selectable hostnames, make sure all services + # have a hostname selected + foreach my $part_export ( + qsearch('part_export', { 'machine' => '_SVC_MACHINE' }) + ) { + + my $exportnum = $part_export->exportnum; + my $machinenum = $part_export->default_machine; + if (!$machinenum) { + my ($first) = $part_export->part_export_machine; + if (!$first) { + # user intervention really is required. + die "Export $exportnum has no hostname options defined.\n". + "You must correct this before upgrading.\n"; + } + # warn about this, because we might not choose the right one + warn "Export $exportnum (". $part_export->exporttype. + ") has no default hostname. Setting to ".$first->machine."\n"; + $machinenum = $first->machinenum; + $part_export->set('default_machine', $machinenum); + my $error = $part_export->replace; + die $error if $error; + } + + # the service belongs to a service def that uses this export + # and there is not a hostname selected for this export for that service + my $join = ' JOIN export_svc USING ( svcpart )'. + ' LEFT JOIN svc_export_machine'. + ' ON ( cust_svc.svcnum = svc_export_machine.svcnum'. + ' AND export_svc.exportnum = svc_export_machine.exportnum )'; + + my @svcs = qsearch( { + 'select' => 'cust_svc.*', + 'table' => 'cust_svc', + 'addl_from' => $join, + 'extra_sql' => ' WHERE svcexportmachinenum IS NULL'. + ' AND export_svc.exportnum = '.$part_export->exportnum, + } ); + foreach my $cust_svc (@svcs) { + my $svc_export_machine = FS::svc_export_machine->new({ + 'exportnum' => $exportnum, + 'machinenum' => $machinenum, + 'svcnum' => $cust_svc->svcnum, + }); + my $error = $svc_export_machine->insert; + die $error if $error; + } + } + # pass downstream my %exports_in_use; $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {}); diff --git a/FS/FS/part_export/acct_http.pm b/FS/FS/part_export/acct_http.pm index 23df7b37d..af358997e 100644 --- a/FS/FS/part_export/acct_http.pm +++ b/FS/FS/part_export/acct_http.pm @@ -41,6 +41,18 @@ tie %options, 'Tie::IxHash', "password \$new->_password", ), }, + 'suspend_data' => { + label => 'Suspend data', + type => 'textarea', + default => join("\n", + ), + }, + 'unsuspend_data' => { + label => 'Unsuspend data', + type => 'textarea', + default => join("\n", + ), + }, 'success_regexp' => { label => 'Success Regexp', default => '', diff --git a/FS/FS/part_export/acct_xmlrpc.pm b/FS/FS/part_export/acct_xmlrpc.pm index 4c896b422..acd7ffe5d 100644 --- a/FS/FS/part_export/acct_xmlrpc.pm +++ b/FS/FS/part_export/acct_xmlrpc.pm @@ -48,6 +48,8 @@ The following variables are available for interpolation (prefixed with new_ or old_ for replace operations): <UL> <LI><code>$username</code> + <LI><code>$domain</code> + <LI><code>$email</code> - username@domain <LI><code>$_password</code> <LI><code>$crypt_password</code> - encrypted password <LI><code>$ldap_password</code> - Password in LDAP/RFC2307 format (for example, "{PLAIN}himom", "{CRYPT}94pAVyK/4oIBk" or "{MD5}5426824942db4253f87a1009fd5d2d4") @@ -129,10 +131,10 @@ sub _export_command { sub _export_replace { my( $self, $new, $old ) = (shift, shift, shift); - my $method = $self->option($action.'_method'); + my $method = $self->option('replace_method'); return '' if $method =~ /^\s*$/; - my @params = split("\n", $self->option($action.'_params') ); + my @params = split("\n", $self->option('replace_params') ); my( @x_param ) = (); my( %x_struct ) = (); @@ -196,8 +198,8 @@ sub _export_value { } else { return Frontier::RPC2::String->new( $svc_acct->$value() ); } - } elsif ( $value eq 'domain' ) { - return Frontier::RPC2::String->new( $svc_acct->domain ); + } elsif ( $value =~ /^(domain|email)$/ ) { + return Frontier::RPC2::String->new( $svc_acct->$value() ); } elsif ( $value eq 'crypt_password' ) { return Frontier::RPC2::String->new( $svc_acct->crypt_password( $self->option('crypt') ) ); } elsif ( $value eq 'ldap_password' ) { @@ -207,6 +209,7 @@ sub _export_value { #XXX } +#this is the "cust_main" email, not svc_acct->email # my $cust_pkg = $svc_acct->cust_svc->cust_pkg; # if ( $cust_pkg ) { # no strict 'vars'; diff --git a/FS/FS/part_export/broadband_http.pm b/FS/FS/part_export/broadband_http.pm index c1ed7fca6..5be8b6851 100644 --- a/FS/FS/part_export/broadband_http.pm +++ b/FS/FS/part_export/broadband_http.pm @@ -35,6 +35,18 @@ tie %options, 'Tie::IxHash', type => 'textarea', default => '', }, + 'suspend_data' => { + label => 'Suspend data', + type => 'textarea', + default => join("\n", + ), + }, + 'unsuspend_data' => { + label => 'Unsuspend data', + type => 'textarea', + default => join("\n", + ), + }, 'success_regexp' => { label => 'Success Regexp', default => '', diff --git a/FS/FS/part_export/broadband_nas.pm b/FS/FS/part_export/broadband_nas.pm index 5a8ffac3b..8c152be45 100644 --- a/FS/FS/part_export/broadband_nas.pm +++ b/FS/FS/part_export/broadband_nas.pm @@ -50,6 +50,11 @@ FS::UID->install_callback( address and description of the broadband service. This can be used with 'sqlradius' or 'broadband_sqlradius' exports to maintain entries in the client table on a RADIUS server.</p> +<p>The checkboxes at the bottom of this page correspond to RADIUS server +databases that Freeside knows about (i.e. 'sqlradius' or 'broadband_sqlradius' +exports that you have configured). Check the box for each server that you +want the NAS entries to be exported to. Do not create multiple broadband_nas +exports for the same service definition; this will fail.</p> <p>Most broadband configurations should not use this, even if they use RADIUS for access control.</p> END @@ -67,19 +72,33 @@ will be applied to the attached NAS record. sub export_insert { my $self = shift; my $svc_broadband = shift; - my %hash = map { $_ => $svc_broadband->get($_) } FS::nas->fields; - my $nas = $self->default_nas( - %hash, + my %hash = ( 'nasname' => $svc_broadband->ip_addr, 'description' => $svc_broadband->description, 'svcnum' => $svc_broadband->svcnum, ); - - my $error = - $nas->insert() - || $nas->process_m2m('link_table' => 'export_nas', - 'target_table' => 'part_export', - 'params' => { $self->options }); + foreach (FS::nas->fields) { + if ( length($svc_broadband->get($_)) ) { + $hash{$_} = $svc_broadband->get($_); + } + } + # if there's somehow a completely identical NAS in the table already, + # use that one. + my $nas = qsearchs('nas', \%hash); + my $error; + if ($nas) { + # propagate the export message + foreach my $part_export ($nas->part_export) { + $error = $part_export->export_nas_insert($nas); + die $error if $error; + } + } else { + $nas = $self->default_nas( %hash ); + $error = $nas->insert || + $nas->process_m2m('link_table' => 'export_nas', + 'target_table' => 'part_export', + 'params' => { $self->options }); + } die $error if $error; return; } diff --git a/FS/FS/part_export/broadband_shellcommands.pm b/FS/FS/part_export/broadband_shellcommands.pm index cf9c36c8f..b57267ec5 100644 --- a/FS/FS/part_export/broadband_shellcommands.pm +++ b/FS/FS/part_export/broadband_shellcommands.pm @@ -8,21 +8,26 @@ use FS::part_export; @ISA = qw(FS::part_export); tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'freeside' }, - 'insert' => { label=>'Insert command', - default=>'php provision.php --mac=$mac_addr --plan=$plan_id --account=active', - }, - 'delete' => { label=>'Delete command', - default=>'', - }, - 'suspend' => { label=>'Suspension command', - default=>'php provision.php --mac=$mac_addr --plan=$plan_id --account=suspend', - }, - 'unsuspend'=> { label=>'Unsuspension command', - default=>'', - }, - 'uppercase_mac' => { label => 'Force MACs to uppercase', - type => 'checkbox', } + 'user' => { label => 'Remote username', + default => 'freeside' }, + 'insert' => { label => 'Insert command', + default => 'php provision.php --mac=$mac_addr --plan=$plan_id --account=active', + }, + 'delete' => { label => 'Delete command', + default => '', + }, + 'replace' => { label => 'Modification command', + default => '', + }, + 'suspend' => { label => 'Suspension command', + default => 'php provision.php --mac=$mac_addr --plan=$plan_id --account=suspend', + }, + 'unsuspend' => { label => 'Unsuspension command', + default => '', + }, + 'uppercase_mac' => { label => 'Force MACs to uppercase', + type => 'checkbox', + } ; %info = ( @@ -30,6 +35,10 @@ tie my %options, 'Tie::IxHash', 'desc' => 'Run remote commands via SSH, for svc_broadband services', 'options' => \%options, 'notes' => <<'END' +Run remote commands via SSH, for broadband services. +<BR><BR> +All fields in svc_broadband are available for interpolation (prefixed with +<code>new_</code> or <code>old_</code> for replace operations). END ); @@ -61,28 +70,49 @@ sub _export_command { my $command = $self->option($action); return '' if $command =~ /^\s*$/; - #set variable for the command + #set variables for the command no strict 'vars'; { no strict 'refs'; ${$_} = $svc_broadband->getfield($_) foreach $svc_broadband->fields; } - if ( $self->option('uppercase_mac') ) { - $mac_addr = uc $mac_addr; - } + $mac_addr = uc $mac_addr + if $self->option('uppercase_mac'); #done setting variables for the command $self->shellcommands_queue( $svc_broadband->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), + user => $self->option('user')||'root', + host => $self->machine, + command => eval(qq("$command")), ); } sub _export_replace { - ''; + my($self, $new, $old ) = (shift, shift, shift); + my $command = $self->option('replace'); + + #set variable for the command + no strict 'vars'; + { + no strict 'refs'; + ${"old_$_"} = $old->getfield($_) foreach $old->fields; + ${"new_$_"} = $new->getfield($_) foreach $new->fields; + } + + if ( $self->option('uppercase_mac') ) { + $old_mac_addr = uc $old_mac_addr; + $new_mac_addr = uc $new_mac_addr; + } + + #done setting variables for the command + + $self->shellcommands_queue( $new->svcnum, + user => $self->option('user')||'root', + host => $self->machine, + command => eval(qq("$command")), + ); } #a good idea to queue anything that could fail or take any time diff --git a/FS/FS/part_export/broadband_snmp.pm b/FS/FS/part_export/broadband_snmp.pm index 44b4dbabb..9afca0872 100644 --- a/FS/FS/part_export/broadband_snmp.pm +++ b/FS/FS/part_export/broadband_snmp.pm @@ -3,7 +3,7 @@ package FS::part_export::broadband_snmp; use strict; use vars qw(%info $DEBUG); use base 'FS::part_export'; -use Net::SNMP qw(:asn1 :snmp); +use SNMP; use Tie::IxHash; $DEBUG = 0; @@ -11,21 +11,21 @@ $DEBUG = 0; my $me = '['.__PACKAGE__.']'; tie my %snmp_version, 'Tie::IxHash', - v1 => 'snmpv1', - v2c => 'snmpv2c', - # 3 => 'v3' not implemented + v1 => '1', + v2c => '2c', + # v3 unimplemented ; -tie my %snmp_type, 'Tie::IxHash', - i => INTEGER, - u => UNSIGNED32, - s => OCTET_STRING, - n => NULL, - o => OBJECT_IDENTIFIER, - t => TIMETICKS, - a => IPADDRESS, - # others not implemented yet -; +#tie my %snmp_type, 'Tie::IxHash', +# i => INTEGER, +# u => UNSIGNED32, +# s => OCTET_STRING, +# n => NULL, +# o => OBJECT_IDENTIFIER, +# t => TIMETICKS, +# a => IPADDRESS, +# # others not implemented yet +#; tie my %options, 'Tie::IxHash', 'version' => { label=>'SNMP version', @@ -33,14 +33,11 @@ tie my %options, 'Tie::IxHash', options => [ keys %snmp_version ], }, 'community' => { label=>'Community', default=>'public' }, - ( - map { $_.'_command', - { label => ucfirst($_) . ' commands', - type => 'textarea', - default => '', - } - } qw( insert delete replace suspend unsuspend ) - ), + + 'action' => { multiple=>1 }, + 'oid' => { multiple=>1 }, + 'value' => { multiple=>1 }, + 'ip_addr_change_to_new' => { label=>'Send IP address changes to new address', type=>'checkbox' @@ -51,28 +48,14 @@ tie my %options, 'Tie::IxHash', %info = ( 'svc' => 'svc_broadband', 'desc' => 'Send SNMP requests to the service IP address', + 'config_element' => '/edit/elements/part_export/broadband_snmp.html', 'options' => \%options, 'no_machine' => 1, 'weight' => 10, 'notes' => <<'END' Send one or more SNMP SET requests to the IP address registered to the service. -Enter one command per line. Each command is a target OID, data type flag, -and value, separated by spaces. -The data type flag is one of the following: -<font size="-1"><ul> -<li><i>i</i> = INTEGER</li> -<li><i>u</i> = UNSIGNED32</li> -<li><i>s</i> = OCTET-STRING (as ASCII)</li> -<li><i>a</i> = IPADDRESS</li> -<li><i>n</i> = NULL</li></ul> The value may interpolate fields from svc_broadband by prefixing the field name with <b>$</b>, or <b>$new_</b> and <b>$old_</b> for replace operations. -The value may contain whitespace; quotes are not necessary.<br> -<br> -For example, to set the SNMPv2-MIB "sysName.0" object to the string -"svc_broadband" followed by the service number, use the following -command:<br> -<pre>1.3.6.1.2.1.1.5.0 s svc_broadband$svcnum</pre><br> END ); @@ -105,19 +88,18 @@ sub export_command { my $self = shift; my ($action, $svc_new, $svc_old) = @_; - my $command_text = $self->option($action.'_command'); - return if !length($command_text); - - warn "$me parsing ${action}_command:\n" if $DEBUG; + my @a = split("\n", $self->option('action')); + my @o = split("\n", $self->option('oid')); + my @v = split("\n", $self->option('value')); my @commands; - foreach (split /\n/, $command_text) { - my ($oid, $type, $value) = split /\s/, $_, 3; - $oid =~ /^(\d+\.)*\d+$/ or die "invalid OID '$oid'\n"; - my $typenum = $snmp_type{$type} or die "unknown data type '$type'\n"; - $value = '' if !defined($value); # allow sending an empty string + warn "$me parsing $action commands:\n" if $DEBUG; + while (@a) { + my $oid = shift @o; + my $value = shift @v; + next unless shift(@a) eq $action; # ignore commands for other actions $value = $self->substitute($value, $svc_new, $svc_old); - warn "$me $oid $type $value\n" if $DEBUG; - push @commands, $oid, $typenum, $value; + warn "$me $oid :=$value\n" if $DEBUG; + push @commands, $oid, $value; } my $ip_addr = $svc_new->ip_addr; @@ -128,13 +110,13 @@ sub export_command { warn "$me opening session to $ip_addr\n" if $DEBUG; my %opt = ( - -hostname => $ip_addr, - -community => $self->option('community'), - -timeout => $self->option('timeout') || 20, + DestHost => $ip_addr, + Community => $self->option('community'), + Timeout => ($self->option('timeout') || 20) * 1000, ); my $version = $self->option('version'); - $opt{-version} = $snmp_version{$version} or die 'invalid version'; - $opt{-varbindlist} = \@commands; # just for now + $opt{Version} = $snmp_version{$version} or die 'invalid version'; + $opt{VarList} = \@commands; # for now $self->snmp_queue( $svc_new->svcnum, %opt ); } @@ -151,16 +133,22 @@ sub snmp_queue { sub snmp_request { my %opt = @_; - my $varbindlist = delete $opt{-varbindlist}; - my ($session, $error) = Net::SNMP->session(%opt); - die "Couldn't create SNMP session: $error" if !$session; + my $flatvarlist = delete $opt{VarList}; + my $session = SNMP::Session->new(%opt); warn "$me sending SET request\n" if $DEBUG; - my $result = $session->set_request( -varbindlist => $varbindlist ); - $error = $session->error(); - $session->close(); - if (!defined $result) { + my @varlist; + while (@$flatvarlist) { + my @this = splice(@$flatvarlist, 0, 2); + push @varlist, [ $this[0], 0, $this[1], undef ]; + # XXX new option to choose the IID (array index) of the object? + } + + $session->set(\@varlist); + my $error = $session->{ErrorStr}; + + if ( $session->{ErrorNum} ) { die "SNMP request failed: $error\n"; } } @@ -181,4 +169,46 @@ sub substitute { $value; } +sub _upgrade_exporttype { + eval 'use FS::Record qw(qsearch qsearchs)'; + # change from old style with numeric oid, data type flag, and value + # on consecutive lines + foreach my $export (qsearch('part_export', + { exporttype => 'broadband_snmp' } )) + { + # for the new options + my %new_options = ( + 'action' => [], + 'oid' => [], + 'value' => [], + ); + foreach my $action (qw(insert replace delete suspend unsuspend)) { + my $old_option = qsearchs('part_export_option', + { exportnum => $export->exportnum, + optionname => $action.'_command' } ); + next if !$old_option; + my $text = $old_option->optionvalue; + my @commands = split("\n", $text); + foreach (@commands) { + my ($oid, $type, $value) = split /\s/, $_, 3; + push @{$new_options{action}}, $action; + push @{$new_options{oid}}, $oid; + push @{$new_options{value}}, $value; + } + my $error = $old_option->delete; + warn "error migrating ${action}_command option: $error\n" if $error; + } + foreach (keys(%new_options)) { + my $new_option = FS::part_export_option->new({ + exportnum => $export->exportnum, + optionname => $_, + optionvalue => join("\n", @{ $new_options{$_} }) + }); + my $error = $new_option->insert; + warn "error inserting '$_' option: $error\n" if $error; + } + } #foreach $export + ''; +} + 1; diff --git a/FS/FS/part_export/dma_radiusmanager.pm b/FS/FS/part_export/dma_radiusmanager.pm deleted file mode 100644 index d46a996ca..000000000 --- a/FS/FS/part_export/dma_radiusmanager.pm +++ /dev/null @@ -1,355 +0,0 @@ -package FS::part_export::dma_radiusmanager; - -use strict; -use vars qw($DEBUG %info %options); -use base 'FS::part_export'; -use FS::part_svc; -use FS::svc_acct; -use FS::radius_group; -use Tie::IxHash; -use Digest::MD5 'md5_hex'; - -use Locale::Country qw(code2country); -use Locale::SubCountry; -use Date::Format 'time2str'; - -tie %options, 'Tie::IxHash', - 'dbname' => { label=>'Database name', default=>'radius' }, - 'username' => { label=>'Database username' }, - 'password' => { label=>'Database password' }, - 'manager' => { label=>'Manager name' }, - 'template_name' => { label=>'Template service name' }, - 'service_prefix' => { label=>'Service name prefix' }, - 'debug' => { label=>'Enable debugging', type=>'checkbox' }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Export to DMA Radius Manager', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => '', #XXX -); - -$DEBUG = 0; - -sub connect { - my $self = shift; - my $datasrc = 'dbi:mysql:host='.$self->machine. - ':database='.$self->option('dbname'); - DBI->connect( - $datasrc, - $self->option('username'), - $self->option('password'), - { AutoCommit => 0 } - ) or die $DBI::errstr; -} - -sub export_insert { my $self = shift; $self->dma_rm_queue('insert', @_) } -sub export_delete { my $self = shift; $self->dma_rm_queue('delete', @_) } -sub export_replace { my $self = shift; $self->dma_rm_queue('replace', @_) } -sub export_suspend { my $self = shift; $self->dma_rm_queue('suspend', @_) } -sub export_unsuspend { my $self = shift; $self->dma_rm_queue('unsuspend', @_) } - -sub dma_rm_queue { - my ($self, $action, $svc_acct, $old) = @_; - - my $svcnum = $svc_acct->svcnum; - - my $cust_pkg = $svc_acct->cust_svc->cust_pkg; - my $cust_main = $cust_pkg->cust_main; - my $location = $cust_pkg->cust_location; - - my $address = $location->address1; - $address .= ' '.$location->address2 if $location->address2; - my $country = code2country($location->country); - my $lsc = Locale::SubCountry->new($location->country); - my $state = $lsc->full_name($location->state) if defined($lsc); - - my %params = ( - # for the remote side - username => $svc_acct->username, - password => md5_hex($svc_acct->_password), - groupid => $self->option('groupid'), - enableuser => 1, - firstname => $cust_main->first, - lastname => $cust_main->last, - company => $cust_main->company, - phone => ($cust_main->daytime || $cust_main->night), - mobile => $cust_main->mobile, - address => $location->address1, # address2? - city => $location->city, - state => $state, #full name - zip => $location->zip, - country => $country, #full name - gpslat => $location->latitude, - gpslong => $location->longitude, - comment => 'svcnum'.$svcnum, - createdby => $self->option('manager'), - owner => $self->option('manager'), - email => $cust_main->invoicing_list_emailonly_scalar, - - # used internally by the export - exportnum => $self->exportnum, - svcnum => $svcnum, - action => $action, - svcpart => $svc_acct->cust_svc->svcpart, - _password => $svc_acct->_password, - ); - if ( $action eq 'replace' ) { - $params{'old_username'} = $old->username; - $params{'old_password'} = $old->_password; - } - my $queue = FS::queue->new({ - 'svcnum' => $svcnum, - 'job' => "FS::part_export::dma_radiusmanager::dma_rm_action", - }); - $queue->insert(%params); -} - -sub dma_rm_action { - my %params = @_; - my $svcnum = delete $params{svcnum}; - my $action = delete $params{action}; - my $svcpart = delete $params{svcpart}; - my $exportnum = delete $params{exportnum}; - - my $username = $params{username}; - my $password = delete $params{_password}; - - my $self = FS::part_export->by_key($exportnum); - my $dbh = $self->connect; - local $DEBUG = 1 if $self->option('debug'); - - # export the part_svc if needed, and get its srvid - my $part_svc = FS::part_svc->by_key($svcpart); - my $srvid = $self->export_part_svc($part_svc, $dbh); # dies on error - $params{srvid} = $srvid; - - if ( $action eq 'insert' ) { - $params{'createdon'} = time2str('%Y-%m-%d', time); - $params{'expiration'} = time2str('%Y-%m-%d', time); - warn "rm_users: inserting svcnum$svcnum\n" if $DEBUG; - my $sth = $dbh->prepare( 'INSERT INTO rm_users ( '. - join(', ', keys(%params)). - ') VALUES ('. - join(', ', ('?') x keys(%params)). - ')' - ); - $sth->execute(values(%params)) or die $dbh->errstr; - - # minor false laziness w/ sqlradius_insert - warn "radcheck: inserting $username\n" if $DEBUG; - $sth = $dbh->prepare( 'INSERT INTO radcheck ( - username, attribute, op, value - ) VALUES (?, ?, ?, ?)' ); - $sth->execute( - $username, - 'Cleartext-Password', - ':=', # :=( - $password, - ) or die $dbh->errstr; - - $sth->execute( - $username, - 'Simultaneous-Use', - ':=', - 1, # should this be an option? - ) or die $dbh->errstr; - # also, we don't support exporting any other radius attrs... - # those should go in 'custattr' if we need them - } elsif ( $action eq 'replace' ) { - - my $old_username = delete $params{old_username}; - my $old_password = delete $params{old_password}; - # svcnum is invariant and on the remote side, so we don't need any - # of the old fields to do this - warn "rm_users: updating svcnum$svcnum\n" if $DEBUG; - my $sth = $dbh->prepare( 'UPDATE rm_users SET '. - join(', ', map { "$_ = ?" } keys(%params)). - ' WHERE comment = ?' - ); - $sth->execute(values(%params), $params{comment}) or die $dbh->errstr; - # except for username/password changes - if ( $old_password ne $password ) { - warn "radcheck: changing password for $old_username\n" if $DEBUG; - $sth = $dbh->prepare( 'UPDATE radcheck SET value = ? '. - 'WHERE username = ? and attribute = \'Cleartext-Password\'' - ); - $sth->execute($password, $old_username) or die $dbh->errstr; - } - if ( $old_username ne $username ) { - warn "radcheck: changing username $old_username to $username\n" - if $DEBUG; - $sth = $dbh->prepare( 'UPDATE radcheck SET username = ? '. - 'WHERE username = ?' - ); - $sth->execute($username, $old_username) or die $dbh->errstr; - } - - } elsif ( $action eq 'suspend' ) { - - # this is sufficient - warn "rm_users: disabling svcnum#$svcnum\n" if $DEBUG; - my $sth = $dbh->prepare( 'UPDATE rm_users SET enableuser = 0 '. - 'WHERE comment = ?' - ); - $sth->execute($params{comment}) or die $dbh->errstr; - - } elsif ( $action eq 'unsuspend' ) { - - warn "rm_users: enabling svcnum#$svcnum\n" if $DEBUG; - my $sth = $dbh->prepare( 'UPDATE rm_users SET enableuser = 1 '. - 'WHERE comment = ?' - ); - $sth->execute($params{comment}) or die $dbh->errstr; - - } elsif ( $action eq 'delete' ) { - - warn "rm_users: deleting svcnum#$svcnum\n" if $DEBUG; - my $sth = $dbh->prepare( 'DELETE FROM rm_users WHERE comment = ?' ); - $sth->execute($params{comment}) or die $dbh->errstr; - - warn "radcheck: deleting $username\n" if $DEBUG; - $sth = $dbh->prepare( 'DELETE FROM radcheck WHERE username = ?' ); - $sth->execute($username) or die $dbh->errstr; - - # if this were smarter it would also delete the rm_services record - # if it was no longer in use, but that's not really necessary - } - - $dbh->commit; - ''; -} - -=item export_part_svc PART_SVC DBH - -Query Radius Manager for a service definition matching the name of -PART_SVC (optionally with a prefix defined in the export options). -If there is one, update it to match the attributes of PART_SVC; if -not, create one. Then return its srvid. - -=cut - -sub export_part_svc { - my ($self, $part_svc, $dbh) = @_; - - # if $dbh exists, use the existing transaction - # otherwise create our own and commit when finished - my $commit = 0; - if (!$dbh) { - $dbh = $self->connect; - $commit = 1; - } - - my $name = $self->option('service_prefix').$part_svc->svc; - - my %params = ( - 'srvname' => $name, - 'enableservice' => 1, - 'nextsrvid' => -1, - 'dailynextsrvid' => -1, - # force price-related fields to zero - 'unitprice' => 0, - 'unitpriceadd' => 0, - 'unitpricetax' => 0, - 'unitpriceaddtax' => 0, - ); - my @fixed_groups; - # use speed settings from fixed usergroups configured on this part_svc - if ( my $psc = $part_svc->part_svc_column('usergroup') ) { - # each part_svc really should only have one fixed group with non-null - # speed settings, but go by priority order for consistency - @fixed_groups = - sort { $a->priority <=> $b->priority } - grep { $_ } - map { FS::radius_group->by_key($_) } - split(/\s*,\s*/, $psc->columnvalue); - } # otherwise there are no fixed groups, so leave speed empty - - foreach (qw(down up)) { - my $speed = "speed_$_"; - foreach my $group (@fixed_groups) { - if ( ($group->$speed || 0) > 0 ) { - $params{$_.'rate'} = $group->$speed; - last; - } - } - } - # anything else we need here? poolname, maybe? - - warn "rm_services: looking for '$name'\n" if $DEBUG; - my $sth = $dbh->prepare( - 'SELECT srvid FROM rm_services WHERE srvname = ? AND enableservice = 1' - ); - $sth->execute($name) or die $dbh->errstr; - if ( $sth->rows > 1 ) { - die "Multiple services with name '$name' found in Radius Manager.\n"; - - } elsif ( $sth->rows == 0 ) { - # leave this blank to disable creating new service defs - my $template_name = $self->option('template_name'); - - die "Can't create a new service profile--no template service specified.\n" - unless $template_name; - - warn "rm_services: fetching template '$template_name'\n" if $DEBUG; - $sth = $dbh->prepare('SELECT * FROM rm_services WHERE srvname = ? LIMIT 1'); - $sth->execute($template_name); - die "Can't create a new service profile--template service ". - "'$template_name' not found.\n" unless $sth->rows == 1; - my $template = $sth->fetchrow_hashref; - %params = (%$template, %params); - - # get the next available srvid - $sth = $dbh->prepare('SELECT MAX(srvid) FROM rm_services'); - $sth->execute or die $dbh->errstr; - my $srvid; - if ( $sth->rows ) { - $srvid = $sth->fetchrow_arrayref->[0] + 1; - } - $params{'srvid'} = $srvid; - - # create a new one based on the template - warn "rm_services: inserting '$name' as srvid#$srvid\n" if $DEBUG; - $sth = $dbh->prepare( - 'INSERT INTO rm_services ('.join(', ', keys %params). - ') VALUES ('.join(', ', map {'?'} keys %params).')' - ); - $sth->execute(values(%params)) or die $dbh->errstr; - # also link it to all the managers allowed on the template service - warn "rm_services: linking to manager\n" if $DEBUG; - $sth = $dbh->prepare( - 'INSERT INTO rm_allowedmanagers (srvid, managername) '. - 'SELECT ?, managername FROM rm_allowedmanagers WHERE srvid = ?' - ); - $sth->execute($srvid, $template->{srvid}) or die $dbh->errstr; - # and the same for NASes - warn "rm_services: linking to nas\n" if $DEBUG; - $sth = $dbh->prepare( - 'INSERT INTO rm_allowednases (srvid, nasid) '. - 'SELECT ?, nasid FROM rm_allowednases WHERE srvid = ?' - ); - $sth->execute($srvid, $template->{srvid}) or die $dbh->errstr; - - $dbh->commit if $commit; - return $srvid; - - } else { # $sth->rows == 1, it already exists - - my $row = $sth->fetchrow_arrayref; - my $srvid = $row->[0]; - warn "rm_services: updating srvid#$srvid\n" if $DEBUG; - $sth = $dbh->prepare( - 'UPDATE rm_services SET '.join(', ', map {"$_ = ?"} keys %params) . - ' WHERE srvid = ?' - ); - $sth->execute(values(%params), $srvid) or die $dbh->errstr; - - $dbh->commit if $commit; - return $srvid; - - } -} - -1; diff --git a/FS/FS/part_export/fibernetics_did.pm b/FS/FS/part_export/fibernetics_did.pm new file mode 100644 index 000000000..a51457a03 --- /dev/null +++ b/FS/FS/part_export/fibernetics_did.pm @@ -0,0 +1,179 @@ +package FS::part_export::fibernetics_did; +use base qw( FS::part_export ); + +use strict; +use vars qw( %info $DEBUG ); +use Data::Dumper; +use URI::Escape; +#use Locale::SubCountry; +#use FS::Record qw(qsearch dbh); +use XML::Simple; +#use Net::HTTPS::Any qw( 0.10 https_get ); +use LWP::UserAgent; +use HTTP::Request::Common; + +$DEBUG = 0; + +tie my %options, 'Tie::IxHash', + 'country' => { 'label' => 'Country', 'default' => 'CA', size=>2, }, +; + +%info = ( + 'svc' => 'svc_phone', + 'desc' => 'Provision phone numbers to Fibernetics web services API', + 'options' => \%options, + 'notes' => '', +); + +sub rebless { shift; } + +sub get_dids_can_tollfree { 0; }; +sub get_dids_can_manual { 1; }; +sub get_dids_can_edit { 1; }; +sub get_dids_npa_select { 0; }; + +# i guess we could get em from the API, but since its returning states without +# availability, there's no advantage + # not really needed, we maintain our own list of provinces, but would + # help to hide the ones without availability (need to fix the selector too) +our @states = ( + 'Alberta', + 'British Columbia', + 'Ontario', + 'Quebec', + #'Saskatchewan', + #'The Territories', + #'PEI/Nova Scotia', + #'Manitoba', + #'Newfoundland', + #'New Brunswick', +); + +sub get_dids { + my $self = shift; + my %opt = ref($_[0]) ? %{$_[0]} : @_; + + if ( $opt{'tollfree'} ) { + warn 'Fibernetics DID provisioning does not yet support toll-free numbers'; + return []; + } + + my %query_hash = (); + + #ratecenter + state: return numbers (more structured names, npa selection) + #areacode + exchange: return numbers + #areacode: return city/ratecenter/whatever + #state: return areacodes + + #region + state: return numbers (arbitrary names, no npa selection) + #state: return regions + +# if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers +# +# $query_hash{'region'} = $opt{'exchange'}; +# +# } elsif ( $opt{'areacode'} ) { +# +# $query_hash{'npa'} = $opt{'areacode'}; + + #if ( $opt{'state'} && $opt{'region'} ) { #return numbers + if ( $opt{'region'} ) { #return numbers + + #$query_hash{'province'} = $country->full_name($opt{'state'}); + $query_hash{'region'} = $opt{'region'} + + } elsif ( $opt{'state'} ) { #return regions + + #my $country = new Locale::SubCountry( $self->option('country') ); + #$query_hash{'province'} = $country->full_name($opt{'state'}); + $query_hash{'province'} = $opt{'state'}; + $query_hash{'listregion'} = 1; + + } else { #nothing passed, return states (provinces) + + return \@states; + + } + + + my $url = 'http://'. $self->machine. '/porta/cgi-bin/porta_query.cgi'; + if ( keys %query_hash ) { + $url .= '?'. join('&', map "$_=". uri_escape($query_hash{$_}), + keys %query_hash + ); + } + warn $url if $DEBUG; + + #my( $page, $response, %reply_headers) = https_get( + # 'host' => $self->machine, + #); + + my $ua = LWP::UserAgent->new; + #my $response = $ua->$method( + # $url, \%data, + # 'Content-Type'=>'application/x-www-form-urlencoded' + #); + my $req = HTTP::Request::Common::GET( $url ); + my $response = $ua->request($req); + + die $response->error_as_HTML if $response->is_error; + + my $page = $response->content; + + my $data = XMLin( $page ); + + warn Dumper($data) if $DEBUG; + +# if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers +# +# [ map $_->{'number'}, @{ $data->{'item'} } ]; +# +# } elsif ( $opt{'areacode'} ) { +# +# [ map $_->{'region'}, @{ $data->{'item'} } ]; +# +# } elsif ( $opt{'state'} ) { #return areacodes +# +# [ map $_->{'npa'}, @{ $data->{'item'} } ]; + + #if ( $opt{'state'} && $opt{'region'} ) { #return numbers + if ( $opt{'region'} ) { #return numbers + + [ map { $_ =~ /^(\d?)(\d{3})(\d{3})(\d{4})$/ + #? ($1 ? "$1 " : ''). "$2 $3 $4" + ? "$2 $3 $4" + : $_; + } + sort { $a <=> $b } + map $_->{'phone'}, + @{ $data->{'item'} } + ]; + + } elsif ( $opt{'state'} ) { #return regions + + #[ map $_->{'region'}, @{ $data->{'item'} } ]; + my %regions = map { $_ => 1 } map $_->{'region'}, @{ $data->{'item'} }; + [ sort keys %regions ]; + + #} else { #nothing passed, return states (provinces) + # not really needed, we maintain our own list of provinces, but would + # help to hide the ones without availability (need to fix the selector too) + } + + +} + +#insert, delete, etc... handled with shellcommands + +sub _export_insert { + #my( $self, $svc_phone ) = (shift, shift); +} +sub _export_delete { + #my( $self, $svc_phone ) = (shift, shift); +} + +sub _export_replace { ''; } +sub _export_suspend { ''; } +sub _export_unsuspend { ''; } + +1; diff --git a/FS/FS/part_export/freeswitch_multifile.pm b/FS/FS/part_export/freeswitch_multifile.pm new file mode 100644 index 000000000..90a2b0469 --- /dev/null +++ b/FS/FS/part_export/freeswitch_multifile.pm @@ -0,0 +1,180 @@ +package FS::part_export::freeswitch_multifile; +use base qw( FS::part_export ); + +use vars qw( %info ); # $DEBUG ); +#use Data::Dumper; +use Tie::IxHash; +use Text::Template; +#use FS::Record qw( qsearch qsearchs ); +#use FS::Schema qw( dbdef ); + +#$DEBUG = 1; + +tie my %options, 'Tie::IxHash', + 'user' => { label => 'SSH username', default=>'root', }, + 'directory' => { label => 'Directory to store FreeSWITCH account XML files', + default => '/usr/local/freeswitch/conf/directory/', + }, + 'domain' => { label => 'Optional fixed SIP domain to use, overrides svc_phone domain', }, + 'reload' => { label => 'Reload command', + default => '/usr/local/freeswitch/bin/fs_cli -x reloadxml', + }, + 'user_template' => { label => 'User XML configuration template', + type => 'textarea', + default => <<'END', +<domain name="<% $domain %>"> + <user id="<% $phonenum %>"> + <params> + <param name="password" value="<% $sip_password %>"/> + </params> + </user> +</domain> +END + }, +; + +%info = ( + 'svc' => 'svc_phone', + 'desc' => 'Provision phone services to FreeSWITCH XML configuration files (one file per user)', + 'options' => \%options, + 'notes' => <<'END', +Export XML account configuration files to FreeSWITCH, one per phone services. +<br><br> +You will need to +<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a>. +END +); + +sub rebless { shift; } + +sub _export_insert { + my( $self, $svc_phone ) = ( shift, shift ); + + eval "use Net::SCP;"; + die $@ if $@; + + #create and copy over file + + my $tempdir = '%%%FREESIDE_CONF%%%/cache.'. $FS::UID::datasrc; + + my $svcnum = $svc_phone->svcnum; + + my $fh = new File::Temp( + TEMPLATE => "freeswitch.$svcnum.XXXXXXXX", + DIR => $tempdir, + #UNLINK => 0, + ); + + print $fh $self->freeswitch_template_fillin( $svc_phone, 'user' ) + or die "print to freeswitch template failed: $!"; + close $fh; + + my $scp = new Net::SCP; + my $user = $self->option('user')||'root'; + my $host = $self->machine; + my $dir = $self->option('directory'); + + $scp->scp( $fh->filename, "$user\@$host:$dir/$svcnum.xml" ) + or return $scp->{errstr}; + + #signal freeswitch to reload config + $self->freeswitch_ssh( command => $self->option('reload') ); + + ''; + +} + +sub _export_replace { + my( $self, $new, $old ) = ( shift, shift, shift ); + + $self->_export_insert($new, @_); +} + +sub _export_delete { + my( $self, $svc_phone ) = ( shift, shift ); + + my $dir = $self->option('directory'); + my $svcnum = $svc_phone->svcnum; + + #delete file + $self->freeswitch_ssh( command => "rm $dir/$svcnum.xml" ); + + #signal freeswitch to reload config + $self->freeswitch_ssh( command => $self->option('reload') ); + + ''; +} + +sub freeswitch_template_fillin { + my( $self, $svc_phone, $template ) = (shift, shift, shift); + + $template ||= 'user'; #? + + #cache a %tt hash? + my $tt = new Text::Template ( + TYPE => 'STRING', + SOURCE => $self->option($template.'_template'), + DELIMITERS => [ '<%', '%>' ], + ); + + my $domain = $self->option('domain') + || $svc_phone->domain + || '$${sip_profile}'; + + #false lazinessish w/phone_shellcommands::_export_command + my %hash = ( + 'domain' => $domain, + map { $_ => $svc_phone->getfield($_) } $svc_phone->fields + ); + + #might as well do em all, they're all going in an XML file as attribs + foreach ( keys %hash ) { + $hash{$_} =~ s/'/'/g; + $hash{$_} =~ s/"/"/g; + } + + $tt->fill_in( + HASH => \%hash, + ); +} + +##a good idea to queue anything that could fail or take any time +#sub shellcommands_queue { +# my( $self, $svcnum ) = (shift, shift); +# my $queue = new FS::queue { +# 'svcnum' => $svcnum, +# 'job' => "FS::part_export::freeswitch::ssh_cmd", +# }; +# $queue->insert( @_ ); +#} + +sub freeswitch_ssh { #method + my $self = shift; + ssh_cmd( user => $self->option('user')||'root', + host => $self->machine, + @_, + ); +} + +sub ssh_cmd { #subroutine, not method + use Net::OpenSSH; + my $opt = { @_ }; + open my $def_in, '<', '/dev/null' or die "unable to open /dev/null"; + my $ssh = Net::OpenSSH->new( $opt->{'user'}.'@'.$opt->{'host'}, + default_stdin_fh => $def_in, + ); + die "Couldn't establish SSH connection: ". $ssh->error if $ssh->error; + my ($output, $errput) = $ssh->capture2( #{stdin_discard => 1}, + $opt->{'command'} + ); + die "Error running SSH command: ". $ssh->error if $ssh->error; + + #who the fuck knows what freeswitch reload outputs, probably a fucking + # ascii advertisement for cluecon + #die $errput if $errput; + #die $output if $output; + + ''; +} + +1; diff --git a/FS/FS/part_export/globalpops_voip.pm b/FS/FS/part_export/globalpops_voip.pm index 9fe45ba0a..59e0bc46f 100644 --- a/FS/FS/part_export/globalpops_voip.pm +++ b/FS/FS/part_export/globalpops_voip.pm @@ -5,6 +5,7 @@ use Tie::IxHash; use FS::Record qw(qsearch dbh); use FS::part_export; use FS::phone_avail; +use Data::Dumper; @ISA = qw(FS::part_export); @@ -74,8 +75,13 @@ sub get_dids { if ( $search->{'statuscode'} == 302200 ) { return []; } elsif ( $search->{'statuscode'} != 100 ) { - my $error = "Error running VoIP Innovations getDIDs: ". - $search->{'statuscode'}. ': '. $search->{'status'}. "\n"; + + my $error = "Error running VoIP Innovations getDIDs: "; + if ( $search->{'statuscode'} || $search->{'status'} ) { + $error .= $search->{'statuscode'}. ': '. $search->{'status'}. "\n"; + } else { + $error .= Dumper($search); + } warn $error; die $error; } diff --git a/FS/FS/part_export/http.pm b/FS/FS/part_export/http.pm index c35c89f12..0d62409fc 100644 --- a/FS/FS/part_export/http.pm +++ b/FS/FS/part_export/http.pm @@ -33,6 +33,18 @@ tie %options, 'Tie::IxHash', default => join("\n", ), }, + 'suspend_data' => { + label => 'Suspend data', + type => 'textarea', + default => join("\n", + ), + }, + 'unsuspend_data' => { + label => 'Unsuspend data', + type => 'textarea', + default => join("\n", + ), + }, 'success_regexp' => { label => 'Success Regexp', default => '', @@ -64,6 +76,16 @@ sub _export_delete { $self->_export_command('delete', @_); } +sub _export_suspend { + my $self = shift; + $self->_export_command('suspend', @_); +} + +sub _export_unsuspend { + my $self = shift; + $self->_export_command('unsuspend', @_); +} + sub _export_command { my( $self, $action, $svc_x ) = ( shift, shift, shift ); diff --git a/FS/FS/part_export/http_status.pm b/FS/FS/part_export/http_status.pm index 6fbd3fbe6..5c4a8d074 100644 --- a/FS/FS/part_export/http_status.pm +++ b/FS/FS/part_export/http_status.pm @@ -3,28 +3,53 @@ use base qw( FS::part_export ); use strict; use warnings; -use vars qw( %info ); +use vars qw( %info $DEBUG ); +use URI::Escape; use LWP::UserAgent; use HTTP::Request::Common; +use Email::Valid; tie my %options, 'Tie::IxHash', 'url' => { label => 'URL', }, + 'blacklist_add_url' => { label => 'Optional blacklist add URL', }, + 'blacklist_del_url' => { label => 'Optional blacklist delete URL', }, + 'whitelist_add_url' => { label => 'Optional whitelist add URL', }, + 'whitelist_del_url' => { label => 'Optional whitelist delete URL', }, + 'vacation_add_url' => { label => 'Optional vacation message add URL', }, + 'vacation_del_url' => { label => 'Optional vacation message delete URL', }, + #'user' => { label => 'Username', default=>'' }, #'password' => { label => 'Password', default => '' }, ; %info = ( - 'svc' => 'svc_dsl', + 'svc' => [ 'svc_acct', 'svc_dsl', ], 'desc' => 'Retrieve status information via HTTP or HTTPS', 'options' => \%options, 'no_machine' => 1, 'notes' => <<'END' Fields from the service can be substituted in the URL as $field. + +Optionally, spam black/whitelist addresees and a vacation message may be +modified via HTTP or HTTPS as well. END ); +$DEBUG = 1; + sub rebless { shift; } +our %addl_fields = ( + 'svc_acct' => [qw( email ) ], + 'svc_dsl' => [qw( gateway_access_or_phonenum ) ], +); + +#some NOPs for required subroutines, to avoid throwing the exceptions in the +# part_export.pm fallbacks +sub _export_insert { '' }; +sub _export_replace { '' }; +sub _export_delete { '' }; + sub export_getstatus { my( $self, $svc_x, $htmlref, $hashref ) = @_; @@ -34,10 +59,105 @@ sub export_getstatus { { no strict 'refs'; ${$_} = $svc_x->getfield($_) foreach $svc_x->fields; - if ( $svc_x->table eq 'svc_dsl' ) { - ${$_} = $svc_x->$_() foreach (qw( gateway_access_or_phonenum )); + ${$_} = $svc_x->$_() foreach @{ $addl_fields{ $svc_x->table } }; + $url = eval(qq("$urlopt")); + } + + my $req = HTTP::Request::Common::GET( $url ); + my $ua = LWP::UserAgent->new; + my $response = $ua->request($req); + + if ( $svc_x->table eq 'svc_dsl' ) { + + $$htmlref = $response->is_error ? $response->error_as_HTML + : $response->content; + + #hash data not yet implemented for svc_dsl + + } elsif ( $svc_x->table eq 'svc_acct' ) { + + #this whole section is rather specific to fibernetics and should be an + # option or callback or something + + # to,from,wb_value + + use Text::CSV_XS; + my $csv = Text::CSV_XS->new; + + my @lines = split("\n", $response->content); + pop @lines if $lines[-1] eq ''; + my $header = shift @lines; + $csv->parse($header) or return; + my @header = $csv->fields; + + while ( my $line = shift @lines ) { + $csv->parse($line) or next; + my @fields = $csv->fields; + my %hash = map { $_ => shift(@fields) } @header; + + if ( defined $hash{'wb_value'} ) { + if ( $hash{'wb_value'} =~ /^[WA]/i ) { #Whitelist/Allow + push @{ $hashref->{'whitelist'} }, $hash{'from'}; + } else { # if ( $hash{'wb_value'} =~ /^[BD]/i ) { #Blacklist/Deny + push @{ $hashref->{'blacklist'} }, $hash{'from'}; + } + } + + for (qw( created enddate )) { + $hash{$_} = '' if $hash{$_} =~ /^0000-/; + $hash{$_} = (split(' ', $hash{$_}))[0]; + } + + next unless $hash{'active'}; + $hashref->{"vacation_$_"} = $hash{$_} || '' + foreach qw( active subject body created enddate ); + + } + + } #else { die 'guru meditation #295'; } + +} + +sub export_setstatus_listadd { + my( $self, $svc_x, $hr ) = @_; + $self->export_setstatus_listX( $svc_x, 'add', $hr->{list}, $hr->{address} ); +} + +sub export_setstatus_listdel { + my( $self, $svc_x, $hr ) = @_; + $self->export_setstatus_listX( $svc_x, 'del', $hr->{list}, $hr->{address} ); +} + +sub export_setstatus_listX { + my( $self, $svc_x, $action, $list, $address_item ) = @_; + + my $option; + if ( $list =~ /^[WA]/i ) { #Whitelist/Allow + $option = 'whitelist_'; + } else { # if ( $hash{'wb_value'} =~ /^[BD]/i ) { #Blacklist/Deny + $option = 'blacklist_'; + } + $option .= $action. '_url'; + + my $address; + unless ( $address = Email::Valid->address($address_item) ) { + + if ( $address_item =~ /^(\@[\w\-\.]+\.\w{2,63})$/ ) { # "@domain" + $address = $1; + } else { + die "address failed $Email::Valid::Details check.\n"; } + } + + #some false laziness w/export_getstatus above + my $url; + my $urlopt = $self->option($option) or return; #DIFF + no strict 'vars'; + { + no strict 'refs'; + ${$_} = $svc_x->getfield($_) foreach $svc_x->fields; + ${$_} = $svc_x->$_() foreach @{ $addl_fields{ $svc_x->table } }; $url = eval(qq("$urlopt")); } @@ -45,11 +165,56 @@ sub export_getstatus { my $ua = LWP::UserAgent->new; my $response = $ua->request($req); - $$htmlref = $response->is_error ? $response->error_as_HTML - : $response->content; + die $response->code. ' '. $response->message if $response->is_error; - #hash data note yet implemented for this status export +} +sub export_setstatus_vacationadd { + my( $self, $svc_x, $hr ) = @_; + $self->export_setstatus_vacationX( $svc_x, 'add', $hr ); } +sub export_setstatus_vacationdel { + my( $self, $svc_x, $hr ) = @_; + $self->export_setstatus_vacationX( $svc_x, 'del', $hr ); +} + +sub export_setstatus_vacationX { + my( $self, $svc_x, $action, $hr ) = @_; + + my $option = 'vacation_'. $action. '_url'; + + my $subject = uri_escape($hr->{subject}); + my $body = uri_escape($hr->{body}); + for (qw( created enddate )) { + if ( $hr->{$_} =~ /^(\d{4}-\d{2}-\d{2})$/ ) { + $hr->{$_} = $1; + } else { + $hr->{$_} = ''; + } + } + my $created = $hr->{created}; + my $enddate = $hr->{enddate}; + + #some false laziness w/export_getstatus above + my $url; + my $urlopt = $self->option($option) or return; #DIFF + no strict 'vars'; + { + no strict 'refs'; + ${$_} = $svc_x->getfield($_) foreach $svc_x->fields; + ${$_} = $svc_x->$_() foreach @{ $addl_fields{ $svc_x->table } }; + $url = eval(qq("$urlopt")); + } + + my $req = HTTP::Request::Common::GET( $url ); + my $ua = LWP::UserAgent->new; + my $response = $ua->request($req); + + die $response->code. ' '. $response->message if $response->is_error; + +} + +1; + 1; diff --git a/FS/FS/part_export/huawei_hlr.pm b/FS/FS/part_export/huawei_hlr.pm new file mode 100644 index 000000000..aa09a1c64 --- /dev/null +++ b/FS/FS/part_export/huawei_hlr.pm @@ -0,0 +1,340 @@ +package FS::part_export::huawei_hlr; + +use vars qw(@ISA %info $DEBUG $CACHE); +use Tie::IxHash; +use FS::Record qw(qsearch qsearchs dbh); +use FS::part_export; +use FS::svc_phone; +use FS::inventory_class; +use FS::inventory_item; +use IO::Socket::INET; +use Data::Dumper; +use MIME::Base64 qw(decode_base64); +use Storable qw(thaw); + +use strict; + +$DEBUG = 0; +@ISA = qw(FS::part_export); + +tie my %options, 'Tie::IxHash', + 'opname' => { label=>'Operator login (required)' }, + 'pwd' => { label=>'Operator password (required)' }, + 'tplid' => { label=>'Template number' }, + 'hlrsn' => { label=>'HLR serial number' }, + 'k4sno' => { label=>'K4 serial number' }, + 'cardtype' => { label => 'Card type (required)', + type => 'select', + options=> ['SIM', 'USIM'] + }, + 'alg' => { label => 'Authentication algorithm (required)', + type => 'select', + options=> ['COMP128_1', + 'COMP128_2', + 'COMP128_3', + 'MILENAGE' ], + }, + 'opcvalue' => { label=>'OPC value (for MILENAGE only)' }, + 'opsno' => { label=>'OP serial number (for MILENAGE only)' }, + 'timeout' => { label=>'Timeout (seconds)', default => 120 }, + 'debug' => { label=>'Enable debugging', type=>'checkbox' }, +; + +%info = ( + 'svc' => 'svc_phone', + 'desc' => 'Provision mobile phone service to Huawei HLR9820', + 'options' => \%options, + 'notes' => <<'END' +Connects to a Huawei Subscriber Management Unit via TCP and configures mobile +phone services according to a template. The <i>sim_imsi</i> field must be +set on the service, and the template must exist. +END +); + +sub actions { + 'Import SIMs' => 'misc/part_export/huawei_hlr-import_sim.html' +} + +sub _export_insert { + my( $self, $svc_phone ) = (shift, shift); + # svc_phone::check should ensure phonenum and sim_imsi are numeric + my @command = ( + IMSI => '"'.$svc_phone->sim_imsi.'"', + ISDN => '"'.$svc_phone->countrycode.$svc_phone->phonenum.'"', + TPLID => $self->option('tplid'), + ); + unshift @command, 'HLRSN', $self->option('hlrsn') + if $self->option('hlrsn'); + unshift @command, 'ADD TPLSUB'; + my $err_or_queue = $self->queue_command($svc_phone->svcnum, @command); + ref($err_or_queue) ? '' : $err_or_queue; +} + +sub _export_replace { + my( $self, $new, $old ) = @_; + my $depend_jobnum; + if ( $new->sim_imsi ne $old->sim_imsi ) { + my @command = ( + 'MOD IMSI', + ISDN => '"'.$old->countrycode.$old->phonenum.'"', + IMSI => '"'.$old->sim_imsi.'"', + NEWIMSI => '"'.$new->sim_imsi.'"', + ); + my $err_or_queue = $self->queue_command($new->svcnum, @command); + return $err_or_queue unless ref $err_or_queue; + $depend_jobnum = $err_or_queue->jobnum; + } + if ( $new->countrycode ne $old->countrycode or + $new->phonenum ne $old->phonenum ) { + my @command = ( + 'MOD ISDN', + ISDN => '"'.$old->countrycode.$old->phonenum.'"', + NEWISDN => '"'.$new->countrycode.$new->phonenum.'"', + ); + my $err_or_queue = $self->queue_command($new->svcnum, @command); + return $err_or_queue unless ref $err_or_queue; + if ( $depend_jobnum ) { + my $error = $err_or_queue->depend_insert($depend_jobnum); + return $error if $error; + } + } + # no other svc_phone changes need to be exported + ''; +} + +sub _export_suspend { + my( $self, $svc_phone ) = (shift, shift); + $self->_export_lock($svc_phone, 'TRUE'); +} + +sub _export_unsuspend { + my( $self, $svc_phone ) = (shift, shift); + $self->_export_lock($svc_phone, 'FALSE'); +} + +sub _export_lock { + my ($self, $svc_phone, $lockstate) = @_; + # XXX I'm not sure this actually suspends. Need to test it. + my @command = ( + 'MOD LCK', + IMSI => '"'.$svc_phone->sim_imsi.'"', + ISDN => '"'.$svc_phone->countrycode.$svc_phone->phonenum.'"', + IC => $lockstate, + OC => $lockstate, + GPRSLOCK=> $lockstate, + ); + my $err_or_queue = $self->queue_command($svc_phone->svcnum, @command); + ref($err_or_queue) ? '' : $err_or_queue; +} + +sub _export_delete { + my( $self, $svc_phone ) = (shift, shift); + my @command = ( + 'RMV SUB', + #IMSI => '"'.$svc_phone->sim_imsi.'"', + ISDN => '"'.$svc_phone->countrycode.$svc_phone->phonenum.'"', + ); + my $err_or_queue = $self->queue_command($svc_phone->svcnum, @command); + ref($err_or_queue) ? '' : $err_or_queue; +} + +sub queue_command { + my ($self, $svcnum, @command) = @_; + my $queue = FS::queue->new({ + svcnum => $svcnum, + job => 'FS::part_export::huawei_hlr::run_command', + }); + $queue->insert($self->exportnum, @command) || $queue; +} + +sub run_command { + my ($exportnum, @command) = @_; + my $self = FS::part_export->by_key($exportnum); + my $socket = $self->login; + my $result = $self->command($socket, @command); + $self->logout($socket); + $socket->close; + die $result->{error} if $result->{error}; + ''; +} + +sub login { + my $self = shift; + local $DEBUG = $self->option('debug') || 0; + # Send a command to the SMU. + # The caller is responsible for quoting string parameters. + my %socket_param = ( + PeerAddr => $self->machine, + PeerPort => 7777, + Proto => 'tcp', + Timeout => ($self->option('timeout') || 30), + ); + warn "Connecting to ".$self->machine."...\n" if $DEBUG; + warn Dumper(\%socket_param) if $DEBUG; + my $socket = IO::Socket::INET->new(%socket_param) + or die "Failed to connect: $!\n"; + + warn 'Logging in as "'.$self->option('opname').".\"\n" if $DEBUG; + my @login_param = ( + OPNAME => '"'.$self->option('opname').'"', + PWD => '"'.$self->option('pwd').'"', + ); + if ($self->option('HLRSN')) { + unshift @login_param, 'HLRSN', $self->option('HLRSN'); + } + my $login_result = $self->command($socket, 'LGI', @login_param); + die $login_result->{error} if $login_result->{error}; + return $socket; +} + +sub logout { + warn "Logging out.\n" if $DEBUG; + my $self = shift; + my ($socket) = @_; + $self->command($socket, 'LGO'); + $socket->close; +} + +sub command { + my $self = shift; + my ($socket, $command, @param) = @_; + my $string = $command . ':'; + while (@param) { + $string .= shift(@param) . '=' . shift(@param); + $string .= ',' if @param; + } + $string .= "\n;"; + my @result; + eval { # timeout + local $SIG{ALRM} = sub { die "timeout\n" }; + alarm ($self->option('timeout') || 120); + warn "Sending to server:\n$string\n\n" if $DEBUG; + $socket->print($string); + warn "Received:\n"; + my $line; + local $/ = "\r\n"; + do { + $line = $socket->getline(); + warn $line if $DEBUG; + chomp $line; + push @result, $line if length($line); + } until ( $line =~ /^---\s*END$/ or $socket->eof ); + alarm 0; + }; + my %return; + if ( $@ eq "timeout\n" ) { + return { error => 'request timed out' }; + } elsif ( $@ ) { + return { error => $@ }; + } else { + #+++ HLR9820 <date> <time>\n + my $header = shift(@result); + $header =~ /(\+\+\+.*)/ + or return { error => 'malformed response: '.$header }; + $return{header} = $1; + #SMU #<serial number>\n + $return{smu} = shift(@result); + #%%<command string>%%\n + $return{echo} = shift(@result); # should match the input + #<message code>: <message description>\n + my $message = shift(@result); + if ($message =~ /^SUCCESS/) { + $return{success} = $message; + } else { #/^ERR/ + $return{error} = $message; + } + $return{trailer} = pop(@result); + $return{details} = join("\n",@result,''); + } + \%return; +} + +sub process_import_sim { + my $job = shift; + my $param = thaw(decode_base64(shift)); + $param->{'job'} = $job; + my $exportnum = delete $param->{'exportnum'}; + my $export = __PACKAGE__->by_key($exportnum); + my $file = delete $param->{'uploaded_files'}; + $file =~ s/^file://; + my $dir = $FS::UID::cache_dir .'/cache.'. $FS::UID::datasrc; + open( $param->{'filehandle'}, '<', "$dir/$file" ) + or die "unable to open '$file'.\n"; + my $error = $export->import_sim($param); +} + +sub import_sim { + # import a SIM list + local $FS::UID::AutoCommit = 1; # yes, 1 + my $self = shift; + my $param = shift; + my $job = $param->{'job'}; + my $fh = $param->{'filehandle'}; + my @lines = $fh->getlines; + + my @command = 'ADD KI'; + push @command, ('HLRSN', $self->option('hlrsn')) if $self->option('hlrsn'); + + my @args = ('OPERTYPE', 'ADD'); + push @args, ('K4SNO', $self->option('k4sno')) if $self->option('k4sno'); + push @args, ('CARDTYPE', $self->option('cardtype'), + 'ALG', $self->option('alg')); + push @args, ('OPCVALUE', $self->option('opcvalue'), + 'OPSNO', $self->option('opsno')) + if $self->option('alg') eq 'MILENAGE'; + + my $agentnum = $param->{'agentnum'}; + my $classnum = $param->{'classnum'}; + my $class = FS::inventory_class->by_key($classnum) + or die "bad inventory class $classnum\n"; + my %existing = map { $_->item, 1 } + qsearch('inventory_item', { 'classnum' => $classnum }); + + my $socket = $self->login; + my $num=0; + my $total = scalar(@lines); + foreach my $line (@lines) { + $num++; + $job->update_statustext(int(100*$num/$total).',Provisioning IMSIs...') + if $job; + + chomp $line; + my ($imsi, $iccid, $pin1, $puk1, $pin2, $puk2, $acc, $ki) = + split(' ', $line); + # the only fields we really care about are the IMSI and KI. + if ($imsi !~ /^\d{15}$/ or $ki !~ /^[0-9A-Z]{32}$/) { + warn "misspelled line in SIM file: $line\n"; + next; + } + if ($existing{$imsi}) { + warn "IMSI $imsi already in inventory, skipped\n"; + next; + } + + # push IMSI/KI to the HLR + my $return = $self->command($socket, + @command, + 'IMSI', qq{"$imsi"}, + 'KIVALUE', qq{"$ki"}, + @args + ); + if ( $return->{success} ) { + # add to inventory + my $item = FS::inventory_item->new({ + 'classnum' => $classnum, + 'agentnum' => $agentnum, + 'item' => $imsi, + }); + my $error = $item->insert; + if ( $error ) { + die "IMSI $imsi added to HLR, but not to inventory:\n$error\n"; + } + } else { + die "IMSI $imsi could not be added to HLR:\n".$return->{error}."\n"; + } + } #foreach $line + $self->logout($socket); + return; +} + +1; diff --git a/FS/FS/part_export/netsapiens.pm b/FS/FS/part_export/netsapiens.pm index 2e37d04b6..c72093d00 100644 --- a/FS/FS/part_export/netsapiens.pm +++ b/FS/FS/part_export/netsapiens.pm @@ -72,7 +72,7 @@ tie my %options, 'Tie::IxHash', ; %info = ( - 'svc' => [ 'svc_phone', ], # 'part_device', + 'svc' => [qw( svc_phone part_device )], 'desc' => 'Provision phone numbers to NetSapiens', 'options' => \%options, 'no_machine' => 1, diff --git a/FS/FS/part_export/phone_shellcommands.pm b/FS/FS/part_export/phone_shellcommands.pm index 5c1ae0153..411c263d2 100644 --- a/FS/FS/part_export/phone_shellcommands.pm +++ b/FS/FS/part_export/phone_shellcommands.pm @@ -13,16 +13,18 @@ use FS::part_export; #- suspension/unsuspension tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root', }, - 'useradd' => { label=>'Insert command', }, - 'userdel' => { label=>'Delete command', }, - 'usermod' => { label=>'Modify command', }, - 'suspend' => { label=>'Suspension command', }, - 'unsuspend' => { label=>'Unsuspension command', }, + 'user' => { label=>'Remote username', default=>'root', }, + 'useradd' => { label=>'Insert command', }, + 'userdel' => { label=>'Delete command', }, + 'usermod' => { label=>'Modify command', }, + 'suspend' => { label=>'Suspension command', }, + 'unsuspend' => { label=>'Unsuspension command', }, + 'mac_insert' => { label=>'Device MAC address insert command', }, + 'mac_delete' => { label=>'Device MAC address delete command', }, ; %info = ( - 'svc' => 'svc_phone', + 'svc' => [qw( svc_phone part_device )], 'desc' => 'Run remote commands via SSH, for phone numbers', 'options' => \%options, 'notes' => <<'END' @@ -49,6 +51,9 @@ old_ for replace operations): <LI><code>$sip_password</code> - SIP secret (quoted for the shell) <LI><code>$pin</code> - Personal identification number <LI><code>$cust_name</code> - Customer name (quoted for the shell) + <LI><code>$pkgnum</code> - Internal package number + <LI><code>$custnum</code> - Internal customer number + <LI><code>$mac_addr</code> - MAC address (Device MAC address insert and delete commands only) </UL> END ); @@ -56,27 +61,41 @@ END sub rebless { shift; } sub _export_insert { - my($self) = shift; + my $self = shift; $self->_export_command('useradd', @_); } sub _export_delete { - my($self) = shift; + my $self = shift; $self->_export_command('userdel', @_); } sub _export_suspend { - my($self) = shift; + my $self = shift; $self->_export_command('suspend', @_); } sub _export_unsuspend { - my($self) = shift; + my $self = shift; $self->_export_command('unsuspend', @_); } +sub export_device_insert { + my( $self, $svc_phone, $phone_device ) = @_; + $self->_export_command('mac_insert', $svc_phone, + 'mac_addr'=>$phone_device->mac_addr + ); +} + +sub export_device_delete { + my( $self, $svc_phone, $phone_device ) = @_; + $self->_export_command('mac_delete', $svc_phone, + 'mac_addr'=>$phone_device->mac_addr + ); +} + sub _export_command { - my ( $self, $action, $svc_phone) = (shift, shift, shift); + my ( $self, $action, $svc_phone, %addl_vars) = @_; my $command = $self->option($action); return '' if $command =~ /^\s*$/; @@ -85,8 +104,11 @@ sub _export_command { { no strict 'refs'; ${$_} = $svc_phone->getfield($_) foreach $svc_phone->fields; + ${$_} = $addl_vars{$_} foreach keys %addl_vars; } my $cust_pkg = $svc_phone->cust_svc->cust_pkg; + my $pkgnum = $cust_pkg ? $cust_pkg->pkgnum : ''; + my $custnum = $cust_pkg ? $cust_pkg->custnum : ''; my $cust_name = $cust_pkg ? $cust_pkg->cust_main->name : ''; $cust_name = shell_quote $cust_name; my $sip_password = shell_quote $svc_phone->sip_password; @@ -111,7 +133,12 @@ sub _export_replace { ${"new_$_"} = $new->getfield($_) foreach $new->fields; } + my $old_cust_pkg = $old->cust_svc->cust_pkg; + my $old_pkgnum = $old_cust_pkg ? $old_cust_pkg->pkgnum : ''; + my $old_custnum = $old_cust_pkg ? $old_cust_pkg->custnum : ''; my $cust_pkg = $new->cust_svc->cust_pkg; + my $new_pkgnum = $cust_pkg ? $cust_pkg->pkgnum : ''; + my $new_custnum = $new_cust_pkg ? $new_cust_pkg->custnum : ''; my $new_cust_name = $cust_pkg ? $cust_pkg->cust_main->name : ''; $new_cust_name = shell_quote $new_cust_name; #done setting variables for the command diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index f964af31c..ce1369510 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -2,6 +2,7 @@ package FS::part_export::shellcommands; use vars qw(@ISA %info); use Tie::IxHash; +use Date::Format; use String::ShellQuote; use FS::part_export; use FS::Record qw( qsearch qsearchs ); @@ -9,7 +10,9 @@ use FS::Record qw( qsearch qsearchs ); @ISA = qw(FS::part_export); tie my %options, 'Tie::IxHash', + 'user' => { label=>'Remote username', default=>'root' }, + 'useradd' => { label=>'Insert command', 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' @@ -21,6 +24,7 @@ tie my %options, 'Tie::IxHash', type =>'textarea', default=>'', }, + 'userdel' => { label=>'Delete command', default=>'userdel -r $username', #default=>'rm -rf $dir', @@ -32,6 +36,7 @@ tie my %options, 'Tie::IxHash', type =>'textarea', default=>'', }, + 'usermod' => { label=>'Modify command', default=>'usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -p $new_crypt_password $old_username', #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '. @@ -54,6 +59,7 @@ tie my %options, 'Tie::IxHash', 'usermod_nousername' => { label=>'Disallow just username changes', type =>'checkbox', }, + 'suspend' => { label=>'Suspension command', default=>'usermod -L $username', }, @@ -63,6 +69,7 @@ tie my %options, 'Tie::IxHash', 'suspend_stdin' => { label=>'Suspension command STDIN', default=>'', }, + 'unsuspend' => { label=>'Unsuspension command', default=>'usermod -U $username', }, @@ -72,6 +79,22 @@ tie my %options, 'Tie::IxHash', 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', default=>'', }, + + 'pkg_change' => { label=>'Package changed command', + default=>'', + }, + + # run commands on package change for multiple services and roll back the + # package change transaciton if one fails? yuck. no. + # if this was really needed, would need to restrict to a single service with + # this kind of export configured. + #'pkg_change_no_queue' => { label=>'Run immediately', + # type =>'checkbox', + # }, + 'pkg_change_stdin' => { label=>'Package changed command STDIN', + default=>'', + }, + 'crypt' => { label => 'Default password encryption', type=>'select', options=>[qw(crypt md5)], default => 'crypt', @@ -189,6 +212,24 @@ old_ for replace operations): <LI>All other fields in <b>svc_acct</b> are also available. <LI>The following fields from <b>cust_main</b> are also available (except during replace): company, address1, address2, city, state, zip, county, daytime, night, fax, otaker, agent_custid, locale. When used on the command line (rather than STDIN), they will be quoted for the shell already (do not add additional quotes). </UL> +For the package changed command only, the following fields are also available: +<UL> + <LI>$old_pkgnum and $new_pkgnum + <LI>$old_pkgpart and $new_pkgpart + <LI>$old_agent_pkgid and $new_agent_pkgid + <LI>$old_order_date and $new_order_date + <LI>$old_start_date and $new_start_date + <LI>$old_setup and $new_setup + <LI>$old_bill and $new_bill + <LI>$old_last_bill and $new_last_bill + <LI>$old_susp and $new_susp + <LI>$old_adjourn and $new_adjourn + <LI>$old_resume and $new_resume + <LI>$old_cancel and $new_cancel + <LI>$old_unancel and $new_unancel + <LI>$old_expire and $new_expire + <LI>$old_contract_end and $new_contract_end +</UL> END ); @@ -202,25 +243,48 @@ sub _map { sub rebless { shift; } sub _export_insert { - my($self) = shift; + my $self = shift; $self->_export_command('useradd', @_); } sub _export_delete { - my($self) = shift; + my $self = shift; $self->_export_command('userdel', @_); } sub _export_suspend { - my($self) = shift; + my $self = shift; $self->_export_command_or_super('suspend', @_); } sub _export_unsuspend { - my($self) = shift; + my $self = shift; $self->_export_command_or_super('unsuspend', @_); } +sub export_pkg_change { + my( $self, $svc_acct, $new_cust_pkg, $old_cust_pkg ) = @_; + + my @fields = qw( pkgnum pkgpart agent_pkgid ); #others? + my @date_fields = qw( order_date start_date setup bill last_bill susp adjourn + resume cancel uncancel expore contract_end ); + + no strict 'vars'; + { + no strict 'refs'; + foreach (@fields) { + ${"old_$_"} = $old_cust_pkg->getfield($_); + ${"new_$_"} = $new_cust_pkg->getfield($_); + } + foreach (@date_fields) { + ${"old_$_"} = time2str('%Y-%m-%d', $old_cust_pkg->getfield($_)); + ${"new_$_"} = time2str('%Y-%m-%d', $new_cust_pkg->getfield($_)); + } + } + + $self->_export_command('pkg_change', $svc_acct); +} + sub _export_command_or_super { my($self, $action) = (shift, shift); if ( $self->option($action) =~ /^\s*$/ ) { @@ -234,6 +298,7 @@ sub _export_command_or_super { sub _export_command { my ( $self, $action, $svc_acct) = (shift, shift, shift); my $command = $self->option($action); + return '' if $command =~ /^\s*$/; my $stdin = $self->option($action."_stdin"); @@ -243,12 +308,12 @@ sub _export_command { ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; # snarfs are unused at this point? - my $count = 1; - foreach my $acct_snarf ( $svc_acct->acct_snarf ) { - ${"snarf_$_$count"} = shell_quote( $acct_snarf->get($_) ) - foreach qw( machine username _password ); - $count++; - } + # my $count = 1; + # foreach my $acct_snarf ( $svc_acct->acct_snarf ) { + # ${"snarf_$_$count"} = shell_quote( $acct_snarf->get($_) ) + # foreach qw( machine username _password ); + # $count++; + # } } my $cust_pkg = $svc_acct->cust_svc->cust_pkg; @@ -318,6 +383,7 @@ sub _export_command { $custnum = $cust_pkg ? $cust_pkg->custnum : ''; my $stdin_string = eval(qq("$stdin")); + return "error filling in STDIN: $@" if $@; $first = shell_quote $first; $last = shell_quote $last; @@ -340,6 +406,7 @@ sub _export_command { $locale = shell_quote $locale; my $command_string = eval(qq("$command")); + return "error filling in command: $@" if $@; my @ssh_cmd_args = ( user => $self->option('user') || 'root', @@ -351,15 +418,15 @@ sub _export_command { fail_on_output => $self->option('fail_on_output'), ); - if($self->option($action . '_no_queue')) { + if ( $self->option($action. '_no_queue') ) { # discard return value just like freeside-queued. eval { ssh_cmd(@ssh_cmd_args) }; $error = $@; $error = $error->full_message if ref $error; # Exception::Class::Base - return $error. ' ('. $self->exporttype. ' to '. $self->svc_machine($svc_acct). ')' + return $error. + ' ('. $self->exporttype. ' to '. $self->svc_machine($svc_acct). ')' if $error; - } - else { + } else { $self->shellcommands_queue( $svc_acct->svcnum, @ssh_cmd_args ); } } diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 6760d09b7..833dd9a1d 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -213,6 +213,7 @@ sub _export_replace { return $error; } } + $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } my @del = grep { !exists $new{$_} } keys %old; @@ -230,6 +231,7 @@ sub _export_replace { return $error; } } + $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } } @@ -348,7 +350,7 @@ sub _export_delete { sub sqlradius_queue { my( $self, $svcnum, $method ) = (shift, shift, shift); - my %args = @_; + #my %args = @_; my $queue = new FS::queue { 'svcnum' => $svcnum, 'job' => "FS::part_export::sqlradius::sqlradius_$method", @@ -561,6 +563,7 @@ sub sqlreplace_usergroups { my $error = $err_or_queue->depend_insert( $jobnum ); return $error if $error; } + $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } if ( @newgroups ) { @@ -594,7 +597,8 @@ New-style: pass a hashref with the following keys: =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp -=item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead) +=item session_status - 'closed' to only show records with AcctStopTime, +'open' to only show records I<without> AcctStopTime, empty to show both. =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp @@ -724,17 +728,27 @@ sub usage_sessions { push @where, " CalledStationID LIKE 'sip:$prefix\%'"; } - if ( $start ) { - push @where, "$str2time AcctStopTime ) >= ?"; - push @param, $start; - } - if ( $end ) { - push @where, "$str2time AcctStopTime ) <= ?"; - push @param, $end; + my $acctstoptime = ''; + if ( $opt->{session_status} ne 'open' ) { + if ( $start ) { + $acctstoptime .= "$str2time AcctStopTime ) >= ?"; + push @param, $start; + $acctstoptime .= ' AND ' if $end; + } + if ( $end ) { + $acctstoptime .= "$str2time AcctStopTime ) <= ?"; + push @param, $end; + } } - if ( $opt->{open_sessions} ) { - push @where, 'AcctStopTime IS NULL'; + if ( $opt->{session_status} ne 'closed' ) { + if ( $acctstoptime ) { + $acctstoptime = "( ( $acctstoptime ) OR AcctStopTime IS NULL )"; + } else { + $acctstoptime = 'AcctStopTime IS NULL'; + } } + push @where, $acctstoptime; + if ( $opt->{starttime_start} ) { push @where, "$str2time AcctStartTime ) >= ?"; push @param, $opt->{starttime_start}; @@ -753,10 +767,14 @@ sub usage_sessions { my $orderby = 'ORDER BY AcctStartTime DESC'; $orderby = '' if $summarize; - my $sth = $dbh->prepare('SELECT '. join(', ', @fields). - " FROM radacct $where $groupby $orderby - ") or die $dbh->errstr; - $sth->execute(@param) or die $sth->errstr; + my $sql = 'SELECT '. join(', ', @fields). + " FROM radacct $where $groupby $orderby"; + if ( $DEBUG ) { + warn $sql; + warn join(',', @param); + } + my $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute(@param) or die $sth->errstr; [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ]; diff --git a/FS/FS/part_export/status_shellcommands.pm b/FS/FS/part_export/status_shellcommands.pm index 53d2b3754..c5200ec50 100644 --- a/FS/FS/part_export/status_shellcommands.pm +++ b/FS/FS/part_export/status_shellcommands.pm @@ -43,6 +43,10 @@ sub _export_unsuspend {} sub export_setstatus { my($self, $svc_acct, $hashref) = @_; + for (qw( spam_tag2_level spam_kill_level )) { + $hashref->{$_} =~ /^\d+(\.\d+)?$/ or return "illegal $_"; + } + my @shellargs = ( $svc_acct->svcnum, user => $self->option('user') || 'root', diff --git a/FS/FS/part_export/test.pm b/FS/FS/part_export/test.pm new file mode 100644 index 000000000..126897c0b --- /dev/null +++ b/FS/FS/part_export/test.pm @@ -0,0 +1,75 @@ +package FS::part_export::test; + +use strict; +use vars qw(%options %info); +use Tie::IxHash; +use base qw(FS::part_export); + +tie %options, 'Tie::IxHash', + 'result' => { label => 'Result', + type => 'select', + options => [ 'success', 'failure', 'exception' ], + default => 'success', + }, + 'errormsg'=> { label => 'Error message', + default => 'Test export' }, + 'insert' => { label => 'Insert', type => 'checkbox', default => 1, }, + 'delete' => { label => 'Delete', type => 'checkbox', default => 1, }, + 'replace' => { label => 'Replace',type => 'checkbox', default => 1, }, + 'suspend' => { label => 'Suspend',type => 'checkbox', default => 1, }, + 'unsuspend'=>{ label => 'Unsuspend', type => 'checkbox', default => 1, }, +; + +%info = ( + 'svc' => [ qw(svc_acct svc_broadband svc_phone svc_domain) ], + 'desc' => 'Test export for development', + 'options' => \%options, + 'notes' => <<END, +<P>Test export. Do not use this in production systems.</P> +<P>This export either always succeeds, always fails (returning an error), +or always dies, according to the "Result" option. It does nothing else; the +purpose is purely to simulate success or failure within an export module.</P> +<P>The checkbox options can be used to turn the export off for certain +actions, if this is needed.</P> +END +); + +sub export_insert { + my $self = shift; + $self->run(@_) if $self->option('insert'); +} + +sub export_delete { + my $self = shift; + $self->run(@_) if $self->option('delete'); +} + +sub export_replace { + my $self = shift; + $self->run(@_) if $self->option('replace'); +} + +sub export_suspend { + my $self = shift; + $self->run(@_) if $self->option('suspend'); +} + +sub export_unsuspend { + my $self = shift; + $self->run(@_) if $self->option('unsuspend'); +} + +sub run { + my $self = shift; + my $svc_x = shift; + my $result = $self->option('result'); + if ( $result eq 'failure' ) { + return $self->option('errormsg'); + } elsif ( $result eq 'exception' ) { + die $self->option('errormsg'); + } else { + return ''; + } +} + +1; diff --git a/FS/FS/part_export/vitelity.pm b/FS/FS/part_export/vitelity.pm index 350a5ad48..3c0534fc1 100644 --- a/FS/FS/part_export/vitelity.pm +++ b/FS/FS/part_export/vitelity.pm @@ -39,6 +39,8 @@ END sub rebless { shift; } +sub get_dids_can_tollfree { 1; }; + sub get_dids { my $self = shift; my %opt = ref($_[0]) ? %{$_[0]} : @_; diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 6e7f8f87e..22e8828d6 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -1,7 +1,8 @@ package FS::part_pkg; +use base qw( FS::m2m_Common FS::o2m_Common FS::option_Common ); use strict; -use vars qw( @ISA %plans $DEBUG $setup_hack $skip_pkg_svc_hack ); +use vars qw( %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 ); @@ -16,14 +17,16 @@ use FS::type_pkgs; use FS::part_pkg_option; use FS::pkg_class; use FS::agent; +use FS::part_pkg_msgcat; use FS::part_pkg_taxrate; use FS::part_pkg_taxoverride; use FS::part_pkg_taxproduct; use FS::part_pkg_link; use FS::part_pkg_discount; +use FS::part_pkg_usage; use FS::part_pkg_vendor; +use FS::part_pkg_currency; -@ISA = qw( FS::m2m_Common FS::option_Common ); $DEBUG = 0; $setup_hack = 0; $skip_pkg_svc_hack = 0; @@ -175,6 +178,9 @@ records will be inserted. If I<options> is set to a hashref of options, appropriate FS::part_pkg_option records will be inserted. +If I<part_pkg_currency> is set to a hashref of options (with the keys as +option_CURRENCY), appropriate FS::part_pkg::currency records will be inserted. + =cut sub insert { @@ -249,6 +255,23 @@ sub insert { } } + warn " inserting part_pkg_currency records" if $DEBUG; + my %part_pkg_currency = %{ $options{'part_pkg_currency'} || {} }; + foreach my $key ( keys %part_pkg_currency ) { + $key =~ /^(.+)_([A-Z]{3})$/ or next; + my $part_pkg_currency = new FS::part_pkg_currency { + 'pkgpart' => $self->pkgpart, + 'optionname' => $1, + 'currency' => $2, + 'optionvalue' => $part_pkg_currency{$key}, + }; + my $error = $part_pkg_currency->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + unless ( $skip_pkg_svc_hack ) { warn " inserting pkg_svc records" if $DEBUG; @@ -350,6 +373,9 @@ FS::pkg_svc record will be updated. If I<options> is set to a hashref, the appropriate FS::part_pkg_option records will be replaced. +If I<part_pkg_currency> is set to a hashref of options (with the keys as +option_CURRENCY), appropriate FS::part_pkg::currency records will be replaced. + =cut sub replace { @@ -364,7 +390,7 @@ sub replace { ? shift : { @_ }; - $options->{options} = {} unless defined($options->{options}); + $options->{options} = { $old->options } unless defined($options->{options}); warn "FS::part_pkg::replace called on $new to replace $old with options". join(', ', map "$_ => ". $options->{$_}, keys %$options) @@ -445,54 +471,84 @@ sub replace { } } - warn " replacing pkg_svc records" if $DEBUG; - my $pkg_svc = $options->{'pkg_svc'} || {}; - my $hidden_svc = $options->{'hidden_svc'} || {}; - foreach my $part_svc ( qsearch('part_svc', {} ) ) { - my $quantity = $pkg_svc->{$part_svc->svcpart} || 0; - my $hidden = $hidden_svc->{$part_svc->svcpart} || ''; - my $primary_svc = - ( defined($options->{'primary_svc'}) && $options->{'primary_svc'} - && $options->{'primary_svc'} == $part_svc->svcpart - ) - ? 'Y' - : ''; - - my $old_pkg_svc = qsearchs('pkg_svc', { - 'pkgpart' => $old->pkgpart, - 'svcpart' => $part_svc->svcpart, - } - ); - my $old_quantity = 0; - my $old_primary_svc = ''; - my $old_hidden = ''; - if ( $old_pkg_svc ) { - $old_quantity = $old_pkg_svc->quantity; - $old_primary_svc = $old_pkg_svc->primary_svc - if $old_pkg_svc->dbdef_table->column('primary_svc'); # is this needed? - $old_hidden = $old_pkg_svc->hidden; + #trivial nit: not the most efficient to delete and reinsert + warn " deleting old part_pkg_currency records" if $DEBUG; + foreach my $part_pkg_currency ( $old->part_pkg_currency ) { + my $error = $part_pkg_currency->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error deleting part_pkg_currency record: $error"; } - - next unless $old_quantity != $quantity || - $old_primary_svc ne $primary_svc || - $old_hidden ne $hidden; - - my $new_pkg_svc = new FS::pkg_svc( { - 'pkgsvcnum' => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ), + } + + warn " inserting new part_pkg_currency records" if $DEBUG; + my %part_pkg_currency = %{ $options->{'part_pkg_currency'} || {} }; + foreach my $key ( keys %part_pkg_currency ) { + $key =~ /^(.+)_([A-Z]{3})$/ or next; + my $part_pkg_currency = new FS::part_pkg_currency { 'pkgpart' => $new->pkgpart, - 'svcpart' => $part_svc->svcpart, - 'quantity' => $quantity, - 'primary_svc' => $primary_svc, - 'hidden' => $hidden, - } ); - my $error = $old_pkg_svc - ? $new_pkg_svc->replace($old_pkg_svc) - : $new_pkg_svc->insert; + 'optionname' => $1, + 'currency' => $2, + 'optionvalue' => $part_pkg_currency{$key}, + }; + my $error = $part_pkg_currency->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "error inserting part_pkg_currency record: $error"; } } + + + warn " replacing pkg_svc records" if $DEBUG; + my $pkg_svc = $options->{'pkg_svc'}; + my $hidden_svc = $options->{'hidden_svc'} || {}; + if ( $pkg_svc ) { # if it wasn't passed, don't change existing pkg_svcs + foreach my $part_svc ( qsearch('part_svc', {} ) ) { + my $quantity = $pkg_svc->{$part_svc->svcpart} || 0; + my $hidden = $hidden_svc->{$part_svc->svcpart} || ''; + my $primary_svc = + ( defined($options->{'primary_svc'}) && $options->{'primary_svc'} + && $options->{'primary_svc'} == $part_svc->svcpart + ) + ? 'Y' + : ''; + + my $old_pkg_svc = qsearchs('pkg_svc', { + 'pkgpart' => $old->pkgpart, + 'svcpart' => $part_svc->svcpart, + } + ); + my $old_quantity = 0; + my $old_primary_svc = ''; + my $old_hidden = ''; + if ( $old_pkg_svc ) { + $old_quantity = $old_pkg_svc->quantity; + $old_primary_svc = $old_pkg_svc->primary_svc + if $old_pkg_svc->dbdef_table->column('primary_svc'); # is this needed? + $old_hidden = $old_pkg_svc->hidden; + } + + next unless $old_quantity != $quantity || + $old_primary_svc ne $primary_svc || + $old_hidden ne $hidden; + + my $new_pkg_svc = new FS::pkg_svc( { + 'pkgsvcnum' => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ), + 'pkgpart' => $new->pkgpart, + 'svcpart' => $part_svc->svcpart, + 'quantity' => $quantity, + 'primary_svc' => $primary_svc, + 'hidden' => $hidden, + } ); + my $error = $old_pkg_svc + ? $new_pkg_svc->replace($old_pkg_svc) + : $new_pkg_svc->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } #foreach $part_svc + } #if $options->{pkg_svc} my @part_pkg_vendor = $old->part_pkg_vendor; my @current_exportnum = (); @@ -712,6 +768,35 @@ sub propagate { join("\n", @error); } +=item pkg_locale LOCALE + +Returns a customer-viewable string representing this package for the given +locale, from the part_pkg_msgcat table. If the given locale is empty or no +localized string is found, returns the base pkg field. + +=cut + +sub pkg_locale { + my( $self, $locale ) = @_; + return $self->pkg unless $locale; + my $part_pkg_msgcat = $self->part_pkg_msgcat($locale) or return $self->pkg; + $part_pkg_msgcat->pkg; +} + +=item part_pkg_msgcat LOCALE + +Like pkg_locale, but returns the FS::part_pkg_msgcat object itself. + +=cut + +sub part_pkg_msgcat { + my( $self, $locale ) = @_; + qsearchs( 'part_pkg_msgcat', { + pkgpart => $self->pkgpart, + locale => $locale, + }); +} + =item pkg_comment [ OPTION => VALUE... ] Returns an (internal) string representing this package. Currently, @@ -991,6 +1076,8 @@ sub can_discount { 0; } sub can_start_date { 1; } +sub can_currency_exchange { 0; } + sub freqs_href { # moved to FS::Misc to make this accessible to other packages # at initialization @@ -1048,6 +1135,9 @@ sub add_freq { if ( $freq =~ /^\d+$/ ) { $mon += $freq; until ( $mon < 12 ) { $mon -= 12; $year++; } + + $mday = 28 if $mday > 28 && FS::Conf->new->exists('anniversary-rollback'); + } elsif ( $freq =~ /^(\d+)w$/ ) { my $weeks = $1; $mday += $weeks * 7; @@ -1155,6 +1245,55 @@ sub option { ''; } +=item part_pkg_currency [ CURRENCY ] + +Returns all currency options as FS::part_pkg_currency objects (see +L<FS::part_pkg_currency>), or, if a currency is specified, only return the +objects for that currency. + +=cut + +sub part_pkg_currency { + my $self = shift; + my %hash = ( 'pkgpart' => $self->pkgpart ); + $hash{'currency'} = shift if @_; + qsearch('part_pkg_currency', \%hash ); +} + +=item part_pkg_currency_options CURRENCY + +Returns a list of option names and values from FS::part_pkg_currency for the +specified currency. + +=cut + +sub part_pkg_currency_options { + my $self = shift; + map { $_->optionname => $_->optionvalue } $self->part_pkg_currency(shift); +} + +=item part_pkg_currency_option CURRENCY OPTIONNAME + +Returns the option value for the given name and currency. + +=cut + +sub part_pkg_currency_option { + my( $self, $currency, $optionname ) = @_; + my $part_pkg_currency = + qsearchs('part_pkg_currency', { 'pkgpart' => $self->pkgpart, + 'currency' => $currency, + 'optionname' => $optionname, + } + )#; + #fatal if not found? that works for our use cases from + #part_pkg/currency_fixed, but isn't how we would typically/expect the method + #to behave. have to catch it there if we change it here... + or die "Unknown price for ". $self->pkg_comment. " in $currency\n"; + + $part_pkg_currency->optionvalue; +} + =item bill_part_pkg_link Returns the associated part_pkg_link records (see L<FS::part_pkg_link>). @@ -1175,6 +1314,17 @@ sub svc_part_pkg_link { shift->_part_pkg_link('svc', @_); } +=item supp_part_pkg_link + +Returns the associated part_pkg_link records of type 'supp' (supplemental +packages). + +=cut + +sub supp_part_pkg_link { + shift->_part_pkg_link('supp', @_); +} + sub _part_pkg_link { my( $self, $type ) = @_; qsearch({ table => 'part_pkg_link', @@ -1384,6 +1534,18 @@ sub part_pkg_discount { qsearch('part_pkg_discount', { 'pkgpart' => $self->pkgpart }); } +=item part_pkg_usage + +Returns the voice usage pools (see L<FS::part_pkg_usage>) defined for +this package. + +=cut + +sub part_pkg_usage { + my $self = shift; + qsearch('part_pkg_usage', { 'pkgpart' => $self->pkgpart }); +} + =item _rebless Reblesses the object into the FS::part_pkg::PLAN class (if available), where @@ -1439,6 +1601,29 @@ sub recur_cost_permonth { sprintf('%.2f', $self->recur_cost / $self->freq ); } +=item cust_bill_pkg_recur CUST_PKG + +Actual recurring charge for the specified customer package from customer's most +recent invoice + +=cut + +sub cust_bill_pkg_recur { + my($self, $cust_pkg) = @_; + my $cust_bill_pkg = qsearchs({ + 'table' => 'cust_bill_pkg', + 'addl_from' => 'LEFT JOIN cust_bill USING ( invnum )', + 'hashref' => { 'pkgnum' => $cust_pkg->pkgnum, + 'recur' => { op=>'>', value=>'0' }, + }, + 'order_by' => 'ORDER BY cust_bill._date DESC, + cust_bill_pkg.sdate DESC + LIMIT 1 + ', + }) or return 0; #die "use cust_bill_pkg_recur credits with once_perinv condition"; + $cust_bill_pkg->recur; +} + =item format OPTION DATA Returns data formatted according to the function 'format' described diff --git a/FS/FS/part_pkg/base_delayed.pm b/FS/FS/part_pkg/base_delayed.pm deleted file mode 100644 index c6864a692..000000000 --- a/FS/FS/part_pkg/base_delayed.pm +++ /dev/null @@ -1,42 +0,0 @@ -package FS::part_pkg::base_delayed; - -use strict; -use vars qw(@ISA %info); -#use FS::Record qw(qsearch qsearchs); -use FS::part_pkg::base_rate; - -@ISA = qw(FS::part_pkg::base_rate); - -%info = ( - 'name' => 'Free (or setup fee) for X days, then base rate'. - ' (anniversary billing)', - 'shortname' => 'Bulk (manual from "units" option), w/intro period', - 'inherit_fields' => [ 'global_Mixin' ], - 'fields' => { - 'free_days' => { 'name' => 'Initial free days', - 'default' => 0, - }, - 'recur_notify' => { 'name' => 'Number of days before recurring billing'. - ' commences to notify customer. (0 means'. - ' no warning)', - 'default' => 0, - }, - }, - 'fieldorder' => [ 'free_days', 'recur_notify', - ], - #'setup' => '\'my $d = $cust_pkg->bill || $time; $d += 86400 * \' + what.free_days.value + \'; $cust_pkg->bill($d); $cust_pkg_mod_flag=1; \' + what.setup_fee.value', - #'recur' => 'what.recur_fee.value', - 'weight' => 54, #&g! -); - -sub calc_setup { - my($self, $cust_pkg, $time ) = @_; - - my $d = $cust_pkg->bill || $time; - $d += 86400 * $self->option('free_days'); - $cust_pkg->bill($d); - - $self->option('setup_fee'); -} - -1; diff --git a/FS/FS/part_pkg/base_rate.pm b/FS/FS/part_pkg/base_rate.pm deleted file mode 100644 index 43a050610..000000000 --- a/FS/FS/part_pkg/base_rate.pm +++ /dev/null @@ -1,97 +0,0 @@ -package FS::part_pkg::base_rate; - -use strict; -use vars qw(@ISA %info); -#use FS::Record qw(qsearch); -use FS::part_pkg; - -@ISA = qw(FS::part_pkg); - -%info = ( - 'name' => 'Base rate (anniversary billing, Times units ordered)', - # XXX it multiplies recurring fee by cust_pkg option "units", how to - # express that - 'shortname' => 'Bulk (manual from "units" option)', - 'inherit_fields' => [ 'global_Mixin' ], - 'fields' => { - 'externalid' => { 'name' => 'Optional External ID', - 'default' => '', - }, - }, - 'fieldorder' => [ qw( externalid ) ], - 'weight' => 52, -); - -sub price_info { - my $self = shift; - my $conf = new FS::Conf; - my $money_char = $conf->config('money_char') || '$'; - my $setup = $self->option('setup_fee') || 0; - my $recur = $self->option('recur_fee', 1) || 0; - my $str = ''; - $str = $money_char . $setup . ' one-time' if $setup; - $str .= ', ' if ($setup && $recur); - $str .= $money_char . $recur . ' recurring per unit ' if $recur; - $str; -} - - -sub calc_setup { - my($self, $cust_pkg, $sdate, $details ) = @_; - - my $i = 0; - my $count = $self->option( 'additional_count', 'quiet' ) || 0; - while ($i < $count) { - push @$details, $self->option( 'additional_info' . $i++ ); - } - - $self->option('setup_fee'); -} - -sub calc_recur { - my($self, $cust_pkg) = @_; - $self->base_recur($cust_pkg); -} - -sub base_recur { - my($self, $cust_pkg) = @_; - my $units = $cust_pkg->option('units') ? $cust_pkg->option('units') : 1 ; - # default to 1 if not found - sprintf("%.2f", - ($self->option('recur_fee') * $units ) - ); -} - -sub calc_remain { - my ($self, $cust_pkg, %options) = @_; - my $time = $options{'time'} || time; - my $next_bill = $cust_pkg->getfield('bill') || 0; - return 0 if ! $self->base_recur($cust_pkg) - || ! $next_bill - || $next_bill < $time; - - my %sec = ( - 'h' => 3600, # 60 * 60 - 'd' => 86400, # 60 * 60 * 24 - 'w' => 604800, # 60 * 60 * 24 * 7 - 'm' => 2629744, # 60 * 60 * 24 * 365.2422 / 12 - ); - - $self->freq =~ /^(\d+)([hdwm]?)$/ - or die 'unparsable frequency: '. $self->freq; - my $freq_sec = $1 * $sec{$2||'m'}; - return 0 unless $freq_sec; - - sprintf("%.2f", $self->base_recur($cust_pkg) * ( $next_bill - $time ) / $freq_sec ); - -} - -sub is_free_options { - qw( setup_fee recur_fee ); -} - -sub is_prepaid { - 0; #no, we're postpaid -} - -1; diff --git a/FS/FS/part_pkg/bulk.pm b/FS/FS/part_pkg/bulk.pm index fd96f8bc2..4a55858de 100644 --- a/FS/FS/part_pkg/bulk.pm +++ b/FS/FS/part_pkg/bulk.pm @@ -44,6 +44,9 @@ sub _bulk_recur { if $self->option('no_prorate',1); my $last_bill = $cust_pkg->last_bill; + + return (0, '') if $$sdate == $last_bill; + my $svc_start = max( $h_cust_svc->date_inserted, $last_bill); my $svc_end = $h_cust_svc->date_deleted; $svc_end = ( !$svc_end || $svc_end > $$sdate ) ? $$sdate : $svc_end; diff --git a/FS/FS/part_pkg/cdr_termination.pm b/FS/FS/part_pkg/cdr_termination.pm index 37fa47e98..54bce2c1d 100644 --- a/FS/FS/part_pkg/cdr_termination.pm +++ b/FS/FS/part_pkg/cdr_termination.pm @@ -182,7 +182,7 @@ sub calc_recur { # eotermiation calculation - $charges += $self->calc_recur_Common(@_); + $charges += ($cust_pkg->quantity || 1) * $self->calc_recur_Common(@_); $charges; } diff --git a/FS/FS/part_pkg/currency_fixed.pm b/FS/FS/part_pkg/currency_fixed.pm new file mode 100644 index 000000000..c64fb7872 --- /dev/null +++ b/FS/FS/part_pkg/currency_fixed.pm @@ -0,0 +1,96 @@ +package FS::part_pkg::currency_fixed; +#can't discount yet +#use base qw( FS::part_pkg::discount_Mixin FS::part_pkg::recur_Common ); +use base qw( FS::part_pkg::recur_Common ); + +use strict; +use vars qw( %info ); +use FS::Record qw(qsearchs); # qsearch qsearchs); +use FS::currency_exchange; + +%info = ( + 'name' => 'Per-currency pricing from package definitions', + 'shortname' => 'Per-currency pricing', + 'inherit_fields' => [ 'prorate_Mixin', 'global_Mixin' ], + 'fields' => { + '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, + }, + }, + 'fieldorder' => [qw( recur_method cutoff_day ), + FS::part_pkg::prorate_Mixin::fieldorder, + ], + 'weight' => '59', +); + +sub price_info { + my $self = shift; + my $str = $self->SUPER::price_info; + $str .= " (or local currency pricing)" if $str; + $str; +} + +sub base_setup { + my($self, $cust_pkg, $sdate, $details, $param ) = @_; + + $self->calc_currency_option('setup_fee', $cust_pkg, $sdate, $details, $param); +} + +sub calc_setup { + my($self, $cust_pkg, $sdate, $details, $param) = @_; + + return 0 if $self->prorate_setup($cust_pkg, $sdate); + + $self->base_setup($cust_pkg, $sdate, $details, $param); +} + +use FS::Conf; +sub calc_currency_option { + my($self, $optionname, $cust_pkg, $sdate, $details, $param) = @_; + + my($currency, $amount) = $cust_pkg->part_pkg_currency_option($optionname); + return sprintf('%.2f', $amount ) unless $currency; + + $param->{'billed_currency'} = $currency; + $param->{'billed_amount'} = $amount; + + my $currency_exchange = qsearchs('currency_exchange', { + 'from_currency' => $currency, + 'to_currency' => ( FS::Conf->new->config('currency') || 'USD' ), + }) or die "No exchange rate from $currency\n"; + + #XXX do we want the rounding here to work differently? + #my $recognized_amount = + sprintf('%.2f', $amount * $currency_exchange->rate); +} + +sub base_recur { + my( $self, $cust_pkg, $sdate, $details, $param ) = @_; + $param ||= {}; + $self->calc_currency_option('recur_fee', $cust_pkg, $sdate, $details, $param); +} + +sub can_discount { 0; } #can't discount yet (percentage would work, but amount?) +sub calc_recur { + my $self = shift; + + #my($cust_pkg, $sdate, $details, $param ) = @_; + my $cust_pkg = $_[0]; + + ($cust_pkg->quantity || 1) * $self->calc_recur_Common(@_); #($cust_pkg,$sdate,$details,$param); + +} + +sub is_free { 0; } + +sub can_currency_exchange { 1; } + +1; diff --git a/FS/FS/part_pkg/delayed_Mixin.pm b/FS/FS/part_pkg/delayed_Mixin.pm index 83e543a4f..ab53bda06 100644 --- a/FS/FS/part_pkg/delayed_Mixin.pm +++ b/FS/FS/part_pkg/delayed_Mixin.pm @@ -23,7 +23,8 @@ use NEXT; ); sub calc_setup { - my($self, $cust_pkg, $time ) = @_; + my $self = shift; + my( $cust_pkg, $time ) = @_; unless ( $self->option('delay_setup', 1) ) { my $d = $cust_pkg->bill || $time; @@ -31,7 +32,7 @@ sub calc_setup { $cust_pkg->bill($d); } - $self->option('setup_fee'); + $self->NEXT::calc_setup(@_); } sub calc_remain { diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm index 22eb69815..6118fd2ed 100644 --- a/FS/FS/part_pkg/flat.pm +++ b/FS/FS/part_pkg/flat.pm @@ -120,9 +120,7 @@ sub calc_setup { push @$details, $self->option( 'additional_info' . $i++ ); } - my $quantity = $cust_pkg->quantity || 1; - - my $charge = $quantity * $self->unit_setup($cust_pkg, $sdate, $details); + my $charge = $self->base_setup($cust_pkg, $sdate, $details); my $discount = 0; if ( $charge > 0 ) { @@ -131,10 +129,10 @@ sub calc_setup { delete $param->{'setup_charge'}; } - sprintf('%.2f', $charge - $discount); + sprintf( '%.2f', ($cust_pkg->quantity || 1) * ($charge - $discount) ); } -sub unit_setup { +sub base_setup { my($self, $cust_pkg, $sdate, $details ) = @_; $self->option('setup_fee') || 0; @@ -162,11 +160,9 @@ sub calc_recur { $charge *= $param->{freq_override} if $param->{freq_override}; } - my $quantity = $cust_pkg->quantity || 1; - $charge *= $quantity; - my $discount = $self->calc_discount($cust_pkg, $sdate, $details, $param); - return sprintf('%.2f', $charge - $discount); + + sprintf( '%.2f', ($cust_pkg->quantity || 1) * ($charge - $discount) ); } sub cutoff_day { diff --git a/FS/FS/part_pkg/flat_introrate.pm b/FS/FS/part_pkg/flat_introrate.pm index 10c205609..733760276 100644 --- a/FS/FS/part_pkg/flat_introrate.pm +++ b/FS/FS/part_pkg/flat_introrate.pm @@ -1,12 +1,8 @@ package FS::part_pkg::flat_introrate; +use base qw( FS::part_pkg::flat ); use strict; -use vars qw(@ISA %info $DEBUG $me); -use FS::part_pkg::flat; - -@ISA = qw(FS::part_pkg::flat); -$me = '[' . __PACKAGE__ . ']'; -$DEBUG = 0; +use vars qw( %info ); %info = ( 'name' => 'Introductory price for X months, then flat rate,'. diff --git a/FS/FS/part_pkg/rt_time.pm b/FS/FS/part_pkg/incomplete/rt_time.pm index 11b7ee85c..f96eba628 100644 --- a/FS/FS/part_pkg/rt_time.pm +++ b/FS/FS/part_pkg/incomplete/rt_time.pm @@ -44,7 +44,7 @@ sub calc_recur { my $charges = 0; $charges += $self->calc_usage(@_); - $charges += $self->calc_recur_Common(@_); + $charges += ($cust_pkg->quantity || 1) * $self->calc_recur_Common(@_); $charges; diff --git a/FS/FS/part_pkg/prorate.pm b/FS/FS/part_pkg/prorate.pm index ac86f3918..a5f9ef6b6 100644 --- a/FS/FS/part_pkg/prorate.pm +++ b/FS/FS/part_pkg/prorate.pm @@ -45,8 +45,12 @@ use FS::part_pkg::flat; sub calc_recur { my $self = shift; my $cust_pkg = $_[0]; - $self->calc_prorate(@_, $self->cutoff_day($cust_pkg)) - - $self->calc_discount(@_); + + my $charge = $self->calc_prorate(@_, $self->cutoff_day($cust_pkg)); + my $discount = $self->calc_discount(@_); + + sprintf( '%.2f', ($cust_pkg->quantity || 1) * ($charge - $discount) ); + } sub cutoff_day { diff --git a/FS/FS/part_pkg/prorate_Mixin.pm b/FS/FS/part_pkg/prorate_Mixin.pm index d148c963d..e8d42b9ca 100644 --- a/FS/FS/part_pkg/prorate_Mixin.pm +++ b/FS/FS/part_pkg/prorate_Mixin.pm @@ -67,11 +67,11 @@ the base price per billing cycle. Options: - add_full_period: Bill for the time up to the prorate day plus one full -billing period after that. + billing period after that. - prorate_round_day: Round the current time to the nearest full day, -instead of using the exact time. + instead of using the exact time. - prorate_defer_bill: Don't bill the prorate interval until the prorate -day arrives. + day arrives. - prorate_verbose: Generate details to explain the prorate calculations. =cut @@ -104,7 +104,7 @@ sub calc_prorate { $add_period = 1; } - # if the customer alreqady has a billing day-of-month established, + # if the customer already has a billing day-of-month established, # and it's a valid cutoff day, try to respect it my $next_bill_day; if ( my $next_bill = $cust_pkg->cust_main->next_bill_date ) { @@ -123,38 +123,53 @@ sub calc_prorate { my $permonth = $charge / $self->freq; my $months = ( ( $self->freq - 1 ) + ($mend-$mnow) / ($mend-$mstart) ); - - if ( $self->option('prorate_verbose',1) - and $months > 0 and $months < $self->freq ) { - push @$details, - 'Prorated (' . time2str('%b %d', $mnow) . - ' - ' . time2str('%b %d', $mend) . '): ' . $money_char . - sprintf('%.2f', $permonth * $months + 0.00000001 ); - } + # after this, $self->freq - 1 < $months <= $self->freq # add a full period if currently billing for a partial period # or periods up to freq_override if billing for an override interval if ( ($param->{'freq_override'} || 0) > 1 ) { $months += $param->{'freq_override'} - 1; - } - elsif ( $add_period && $months < $self->freq) { + # freq_override - 1 correct here? + # (probably only if freq == 1, yes?) + } elsif ( $add_period && $months < $self->freq ) { + + # 'add_period' is a misnomer. + # we add enough to make the total at least a full period + $months++; + $$sdate = $self->add_freq($mstart, 1); + # now $self->freq <= $months <= $self->freq + 1 + # (note that this only happens if $months < $self->freq to begin with) - if ( $self->option('prorate_verbose',1) ) { - # calculate the prorated and add'l period charges + } + + if ( $self->option('prorate_verbose',1) and $months > 0 ) { + if ( $months < $self->freq ) { + # we are billing a fractional period only + # # (though maybe not a fractional month) + my $period_end = $self->add_freq($mstart); + push @$details, + 'Prorated (' . time2str('%b %d', $mnow) . + ' - ' . time2str('%b %d', $period_end) . '): ' . $money_char . + sprintf('%.2f', $permonth * $months + 0.00000001 ); + + } elsif ( $months > $self->freq ) { + # we are billing MORE than a full period push @$details, - 'First full month: ' . $money_char . - sprintf('%.2f', $permonth); - } - $months += $self->freq; - $$sdate = $self->add_freq($mstart); + 'Prorated (' . time2str('%b %d', $mnow) . + ' - ' . time2str('%b %d', $mend) . '): ' . $money_char . + sprintf('%.2f', $permonth * ($months - $self->freq + 0.0000001)), + + 'First full period: ' . $money_char . + sprintf('%.2f', $permonth * $self->freq); + } # else $months == $self->freq, and no prorating has happened } $param->{'months'} = $months; #so 1.005 rounds to 1.01 $charge = sprintf('%.2f', $permonth * $months + 0.00000001 ); - return $charge; + return sprintf('%.2f', $charge); } =item prorate_setup CUST_PKG SDATE diff --git a/FS/FS/part_pkg/recur_Common.pm b/FS/FS/part_pkg/recur_Common.pm index 03d5c2cb2..ebf8869f6 100644 --- a/FS/FS/part_pkg/recur_Common.pm +++ b/FS/FS/part_pkg/recur_Common.pm @@ -61,7 +61,7 @@ sub calc_recur_Common { my $recur_method = $self->option('recur_method', 1) || 'anniversary'; my @cutoff_day = $self->cutoff_day($cust_pkg); - $charges = $self->base_recur($cust_pkg); + $charges = $self->base_recur($cust_pkg, $sdate, $details, $param); $charges += $param->{'override_charges'} if $param->{'override_charges'}; if ( $recur_method eq 'prorate' ) { diff --git a/FS/FS/part_pkg/sql_external.pm b/FS/FS/part_pkg/sql_external.pm index 4bf9ecbe7..813e8085c 100644 --- a/FS/FS/part_pkg/sql_external.pm +++ b/FS/FS/part_pkg/sql_external.pm @@ -71,7 +71,7 @@ sub calc_recur { } $param->{'override_charges'} = $price; - $self->calc_recur_Common($cust_pkg,$sdate,$details,$param); + ($cust_pkg->quantity || 1) * $self->calc_recur_Common($cust_pkg,$sdate,$details,$param); } sub can_discount { 1; } diff --git a/FS/FS/part_pkg/sqlradacct_daily.pm b/FS/FS/part_pkg/sqlradacct_daily.pm new file mode 100644 index 000000000..27fc1df3e --- /dev/null +++ b/FS/FS/part_pkg/sqlradacct_daily.pm @@ -0,0 +1,206 @@ +package FS::part_pkg::sqlradacct_daily; +use base qw( FS::part_pkg::flat ); + +use strict; +use vars qw(%info); +use Time::Local qw( timelocal timelocal_nocheck ); +use Date::Format; +#use FS::Record qw(qsearch qsearchs); + +%info = ( + 'name' => 'Time and data charges from an SQL RADIUS radacct table, with per-day limits', + 'shortname' => 'Daily usage charges from RADIUS', + 'inherit_fields' => [ 'global_Mixin' ], + 'fields' => { + 'recur_included_hours' => { 'name' => 'Hours included per day', + 'default' => 0, + }, + 'recur_hourly_charge' => { 'name' => 'Additional charge per hour', + 'default' => 0, + }, + 'recur_hourly_cap' => { 'name' => 'Maximum daily charge for hours'. + ' (0 means no cap)', + + 'default' => 0, + }, + + 'recur_included_input' => { 'name' => 'Upload megabytes included per day', + 'default' => 0, + }, + 'recur_input_charge' => { 'name' => + 'Additional charge per megabyte upload', + 'default' => 0, + }, + 'recur_input_cap' => { 'name' => 'Maximum daily charge for upload'. + ' (0 means no cap)', + 'default' => 0, + }, + + 'recur_included_output' => { 'name' => 'Download megabytes included per day', + 'default' => 0, + }, + 'recur_output_charge' => { 'name' => + 'Additional charge per megabyte download', + 'default' => 0, + }, + 'recur_output_cap' => { 'name' => 'Maximum daily charge for download'. + ' (0 means no cap)', + 'default' => 0, + }, + + 'recur_included_total' => { 'name' => + 'Total megabytes included per day', + 'default' => 0, + }, + 'recur_total_charge' => { 'name' => + 'Additional charge per megabyte total', + 'default' => 0, + }, + 'recur_total_cap' => { 'name' => 'Maximum daily charge for total'. + ' megabytes (0 means no cap)', + 'default' => 0, + }, + + 'global_cap' => { 'name' => 'Daily cap on all overage charges'. + ' (0 means no cap)', + 'default' => 0, + }, + + 'monthly_cap' => { 'name' => 'Monthly (billing frequency) cap on all overage charges'. + ' (0 means no cap)', + 'default' => 0, + }, + + }, + 'fieldorder' => [qw( recur_included_hours recur_hourly_charge recur_hourly_cap recur_included_input recur_input_charge recur_input_cap recur_included_output recur_output_charge recur_output_cap recur_included_total recur_total_charge recur_total_cap global_cap monthly_cap )], + 'weight' => 41, +); + +sub price_info { + my $self = shift; + my $str = $self->SUPER::price_info; + $str .= " plus usage" if $str; + $str; +} + +#hacked-up false laziness w/sqlradacct_hour, +# but keeping it separate to start with is safer for existing folks +sub calc_recur { + my($self, $cust_pkg, $sdate, $details ) = @_; + + my $last_bill = $cust_pkg->last_bill; + + my $charges = 0; + + #loop over each day starting with last_bill inclusive (since we generated a + # bill that day, we didn't have a full picture of the day's usage) + # and ending with sdate exclusive (same reason) + + my($l_day, $l_mon, $l_year) = (localtime($last_bill))[3..5]; + my $day_start = timelocal(0,0,0, $l_day, $l_mon, $l_year); + + my($s_day, $s_mon, $s_year) = (localtime($$sdate))[3..5]; + my $billday_start = timelocal(0,0,0, $s_day, $s_mon, $s_year); + + while ( $day_start < $billday_start ) { + + my($day, $mon, $year) = (localtime($day_start))[3..5]; + my $tomorrow = timelocal_nocheck(0,0,0, $day+1, $mon, $year); + + #afact the usage methods already use the lower bound inclusive and the upper + # exclusive, so no need for $tomorrow-1 + my @range = ( $day_start, $tomorrow ); + + my $hours = $cust_pkg->seconds_since_sqlradacct(@range) / 3600; + $hours -= $self->option('recur_included_hours'); + $hours = 0 if $hours < 0; + + my $input = $cust_pkg->attribute_since_sqlradacct( @range, + 'AcctInputOctets') + / 1048576; + + my $output = $cust_pkg->attribute_since_sqlradacct( @range, + 'AcctOutputOctets' ) + / 1048576; + + my $total = $input + $output - $self->option('recur_included_total'); + $total = 0 if $total < 0; + $input = $input - $self->option('recur_included_input'); + $input = 0 if $input < 0; + $output = $output - $self->option('recur_included_output'); + $output = 0 if $output < 0; + + my $totalcharge = + sprintf('%.2f', $total * $self->option('recur_total_charge')); + $totalcharge = $self->option('recur_total_cap') + if $self->option('recur_total_cap') + && $totalcharge > $self->option('recur_total_cap'); + + my $inputcharge = + sprintf('%.2f', $input * $self->option('recur_input_charge')); + $inputcharge = $self->option('recur_input_cap') + if $self->option('recur_input_cap') + && $inputcharge > $self->option('recur_input_cap'); + + my $outputcharge = + sprintf('%.2f', $output * $self->option('recur_output_charge')); + $outputcharge = $self->option('recur_output_cap') + if $self->option('recur_output_cap') + && $outputcharge > $self->option('recur_output_cap'); + + my $hourscharge = + sprintf('%.2f', $hours * $self->option('recur_hourly_charge')); + $hourscharge = $self->option('recur_hourly_cap') + if $self->option('recur_hourly_cap') + && $hourscharge > $self->option('recur_hourly_cap'); + + my $fordate = time2str('for %a %b %o, %Y', $day_start); + + if ( $self->option('recur_total_charge') > 0 ) { + push @$details, "Data $fordate ". + sprintf('%.1f', $total). " megs: $totalcharge"; + } + if ( $self->option('recur_input_charge') > 0 ) { + push @$details, "Download $fordate ". + sprintf('%.1f', $input). " megs: $inputcharge"; + } + if ( $self->option('recur_output_charge') > 0 ) { + push @$details, "Upload $fordate". + sprintf('%.1f', $output). " megs: $outputcharge"; + } + if ( $self->option('recur_hourly_charge') > 0 ) { + push @$details, "Time $fordate ". + sprintf('%.1f', $hours). " hours: $hourscharge"; + } + + my $daily_charges = $hourscharge + $inputcharge + $outputcharge + $totalcharge; + if ( $self->option('global_cap') && $charges > $self->option('global_cap') ) { + $charges = $self->option('global_cap'); + push @$details, "Usage charges $fordate capped at: $charges"; + } + + $charges += $daily_charges; + + $day_start = $tomorrow; + } + + $charges = $self->option('monthly_cap') + if $self->option('monthly_cap') + && $charges > $self->option('monthly_cap'); + + $self->option('recur_fee') + $charges; +} + +sub can_discount { 0; } + +sub is_free_options { + qw( setup_fee recur_fee recur_hourly_charge + recur_input_charge recur_output_charge recur_total_charge ); +} + +sub base_recur { + my($self, $cust_pkg) = @_; + $self->option('recur_fee'); +} + +1; diff --git a/FS/FS/part_pkg/sqlradacct_hour.pm b/FS/FS/part_pkg/sqlradacct_hour.pm index 7b821310f..c9fdb36f4 100644 --- a/FS/FS/part_pkg/sqlradacct_hour.pm +++ b/FS/FS/part_pkg/sqlradacct_hour.pm @@ -8,7 +8,7 @@ use FS::part_pkg::flat; @ISA = qw(FS::part_pkg::flat); %info = ( - 'name' => 'Base charge plus per-hour (and for data) from an SQL RADIUS radacct table', + 'name' => 'Time and data charges from an SQL RADIUS radacct table', 'shortname' => 'Usage charges from RADIUS', 'inherit_fields' => [ 'global_Mixin' ], 'fields' => { diff --git a/FS/FS/part_pkg/subscription.pm b/FS/FS/part_pkg/subscription.pm index bf88f516f..0dfe049fe 100644 --- a/FS/FS/part_pkg/subscription.pm +++ b/FS/FS/part_pkg/subscription.pm @@ -102,7 +102,7 @@ sub calc_recur { my $discount = $self->calc_discount($cust_pkg, $sdate, $details, $param); - sprintf('%.2f', $br - $discount); + sprintf('%.2f', ($cust_pkg->quantity || 1) * ($br - $discount) ); } 1; diff --git a/FS/FS/part_pkg/voip_cdr.pm b/FS/FS/part_pkg/voip_cdr.pm index 8c3d80d49..1a9718641 100644 --- a/FS/FS/part_pkg/voip_cdr.pm +++ b/FS/FS/part_pkg/voip_cdr.pm @@ -31,6 +31,11 @@ tie my %rating_method, 'Tie::IxHash', 'single_price' => 'A single price per minute for all calls.', ; +tie my %rounding, 'Tie::IxHash', + '2' => 'Two decimal places (cent)', + '4' => 'Four decimal places (100th of a cent)', +; + #tie my %cdr_location, 'Tie::IxHash', # 'internal' => 'Internal: CDR records imported into the internal CDR table', # 'external' => 'External: CDR records queried directly from an external '. @@ -51,6 +56,11 @@ tie my %unrateable_opts, 'Tie::IxHash', 2 => 'Flag for later review', ; +tie my %detail_formats, 'Tie::IxHash', + '' => '', + FS::cdr::invoice_formats() +; + %info = ( 'name' => 'VoIP rating by plan of CDR records in an internal (or external) SQL table', 'shortname' => 'VoIP/telco CDR rating (standard)', @@ -87,6 +97,11 @@ tie my %unrateable_opts, 'Tie::IxHash', 'options' => \%rating_method, }, + 'rounding' => { 'name' => 'Rounding for destination prefix rating', + 'type' => 'select', + 'select_options' => \%rounding, + }, + 'ratenum' => { 'name' => 'Rate plan', 'type' => 'select', 'select_table' => 'rate', @@ -149,13 +164,19 @@ tie my %unrateable_opts, 'Tie::IxHash', 'type' => 'checkbox', }, - 'use_carrierid' => { 'name' => 'Only charge for CDRs where the Carrier ID is set to: ', + 'use_carrierid' => { 'name' => 'Only charge for CDRs where the Carrier ID is set to any of these (comma-separated) values: ', + }, + + 'use_cdrtypenum' => { 'name' => 'Only charge for CDRs where the CDR Type is set to this cdrtypenum: ', + }, + + 'ignore_cdrtypenum' => { 'name' => 'Do not charge for CDRs where the CDR Type is set to this cdrtypenum: ', }, - 'use_cdrtypenum' => { 'name' => 'Only charge for CDRs where the CDR Type is set to: ', + 'use_calltypenum' => { 'name' => 'Only charge for CDRs where the CDR Call Type is set to this calltypenum: ', }, - 'ignore_cdrtypenum' => { 'name' => 'Do not charge for CDRs where the CDR Type is set to: ', + 'ignore_calltypenum' => { 'name' => 'Do not charge for CDRs where the CDR Call Type is set to this calltypenum: ', }, 'ignore_disposition' => { 'name' => 'Do not charge for CDRs where the Disposition is set to any of these (comma-separated) values: ', @@ -203,6 +224,11 @@ tie my %unrateable_opts, 'Tie::IxHash', 'skip_max_callers' => { 'name' => 'Do not charge for CDRs where max_callers is less than or equal to this value: ', }, + 'skip_same_customer' => { + 'name' => 'Do not charge for calls between numbers belonging to the same customer', + 'type' => 'checkbox', + }, + 'use_duration' => { 'name' => 'Calculate usage based on the duration field instead of the billsec field', 'type' => 'checkbox', }, @@ -211,12 +237,25 @@ tie my %unrateable_opts, 'Tie::IxHash', }, #false laziness w/cdr_termination.pm - 'output_format' => { 'name' => 'CDR invoice display format', + 'output_format' => { 'name' => 'CDR display format for invoices', 'type' => 'select', - 'select_options' => { FS::cdr::invoice_formats() }, + 'select_options' => \%detail_formats, 'default' => 'default', #XXX test }, + 'selfservice_format' => + { 'name' => 'CDR display format for selfservice', + 'type' => 'select', + 'select_options' => \%detail_formats, + 'default' => 'default' + }, + 'selfservice_inbound_format' => + { 'name' => 'Inbound CDR display format for selfservice', + 'type' => 'select', + 'select_options' => \%detail_formats, + 'default' => '' + }, + 'usage_section' => { 'name' => 'Section in which to place usage charges (whether separated or not): ', }, @@ -229,6 +268,10 @@ tie my %unrateable_opts, 'Tie::IxHash', }, #eofalse + 'usage_nozero' => { 'name' => 'Omit details for included / no-charge calls.', + 'type' => 'checkbox', + }, + 'bill_every_call' => { 'name' => 'Generate an invoice immediately for every call (as well any setup fee, upon first payment). Useful for prepaid.', 'type' => 'checkbox', }, @@ -271,7 +314,7 @@ tie my %unrateable_opts, 'Tie::IxHash', FS::part_pkg::prorate_Mixin::fieldorder, qw( cdr_svc_method - rating_method ratenum intrastate_ratenum + rating_method rounding ratenum intrastate_ratenum calls_included min_charge min_included sec_granularity ignore_unrateable @@ -282,6 +325,7 @@ tie my %unrateable_opts, 'Tie::IxHash', use_amaflags use_carrierid use_cdrtypenum ignore_cdrtypenum + use_calltypenum ignore_calltypenum ignore_disposition disposition_in skip_dcontext skip_dst_prefix skip_dstchannel_prefix skip_src_length_more @@ -291,9 +335,12 @@ tie my %unrateable_opts, 'Tie::IxHash', noskip_dst_length_accountcode_tollfree skip_lastapp skip_max_callers + skip_same_customer use_duration 411_rewrite - output_format usage_mandate summarize_usage usage_section + output_format + selfservice_format selfservice_inbound_format + usage_mandate summarize_usage usage_section bill_every_call bill_inactive_svcs count_available_phones suspend_bill ) @@ -315,7 +362,7 @@ sub calc_recur { my $charges = 0; $charges += $self->calc_usage(@_); - $charges += $self->calc_recur_Common(@_); + $charges += ($cust_pkg->quantity || 1) * $self->calc_recur_Common(@_); $charges; @@ -358,6 +405,8 @@ sub calc_usage { : 'default' ); + my $usage_nozero = $self->option('usage_nozero', 1); + my $formatter = FS::detail_format->new($output_format, buffer => $details); my $use_duration = $self->option('use_duration'); @@ -384,10 +433,16 @@ sub calc_usage { $svc_x = $cust_svc->svc_x; } + unless ( $svc_x ) { + my $h = $self->option('bill_inactive_svcs',1) ? 'h_' : ''; + warn "WARNING: no $h$svc_table for svcnum ". $cust_svc->svcnum. "\n"; + } + my %options = ( 'disable_src' => $self->option('disable_src'), 'default_prefix' => $self->option('default_prefix'), 'cdrtypenum' => $self->option('use_cdrtypenum'), + 'calltypenum' => $self->option('use_calltypenum'), 'status' => '', 'for_update' => 1, ); # $last_bill, $$sdate ) @@ -408,6 +463,7 @@ sub calc_usage { my $error = $cdr->rate( 'part_pkg' => $self, + 'cust_pkg' => $cust_pkg, 'svcnum' => $svc_x->svcnum, 'single_price_included_min' => \$included_min, 'region_group_included_min' => \$region_group_included_min, @@ -441,7 +497,7 @@ sub calc_usage { $error = $cdr->set_status('done'); } die $error if $error; - $formatter->append($cdr); + $formatter->append($cdr) unless $usage_nozero && $cdr->rated_price == 0; $cdr_search->adjust(1) if $cdr->freesidestatus eq 'rated'; } #$cdr @@ -454,17 +510,18 @@ sub calc_usage { } #returns a reason why not to rate this CDR, or false if the CDR is chargeable +# lots of false laziness w/voip_inbound sub check_chargable { my( $self, $cdr, %flags ) = @_; return 'amaflags != 2' if $self->option_cacheable('use_amaflags') && $cdr->amaflags != 2; - return "disposition NOT IN ( $self->option_cacheable('disposition_in') )" + return "disposition NOT IN ( ". $self->option_cacheable('disposition_in')." )" if $self->option_cacheable('disposition_in') =~ /\S/ && !grep { $cdr->disposition eq $_ } split(/\s*,\s*/, $self->option_cacheable('disposition_in')); - return "disposition IN ( $self->option_cacheable('ignore_disposition') )" + return "disposition IN ( ". $self->option_cacheable('ignore_disposition')." )" if $self->option_cacheable('ignore_disposition') =~ /\S/ && grep { $cdr->disposition eq $_ } split(/\s*,\s*/, $self->option_cacheable('ignore_disposition')); @@ -473,26 +530,35 @@ sub check_chargable { if length($_) && substr($cdr->dst,0,length($_)) eq $_; } - return "carrierid != $self->option_cacheable('use_carrierid')" - if length($self->option_cacheable('use_carrierid')) - && $cdr->carrierid ne $self->option_cacheable('use_carrierid') #ne otherwise 0 matches '' - && ! $flags{'da_rewrote'}; + return "carrierid NOT IN ( ". $self->option_cacheable('use_carrierid'). " )" + if $self->option_cacheable('use_carrierid') =~ /\S/ + && ! $flags{'da_rewrote'} #why? + && !grep { $cdr->carrierid eq $_ } split(/\s*,\s*/, $self->option_cacheable('use_carrierid')); #eq otherwise 0 matches '' # unlike everything else, use_cdrtypenum is applied in FS::svc_x::get_cdrs. - return "cdrtypenum != $self->option_cacheable('use_cdrtypenum')" + return "cdrtypenum != ". $self->option_cacheable('use_cdrtypenum') if length($self->option_cacheable('use_cdrtypenum')) && $cdr->cdrtypenum ne $self->option_cacheable('use_cdrtypenum'); #ne otherwise 0 matches '' - return "cdrtypenum == $self->option_cacheable('ignore_cdrtypenum')" + return "cdrtypenum == ". $self->option_cacheable('ignore_cdrtypenum') if length($self->option_cacheable('ignore_cdrtypenum')) && $cdr->cdrtypenum eq $self->option_cacheable('ignore_cdrtypenum'); #eq otherwise 0 matches '' - return "dcontext IN ( $self->option_cacheable('skip_dcontext') )" + # unlike everything else, use_calltypenum is applied in FS::svc_x::get_cdrs. + return "calltypenum != ". $self->option_cacheable('use_calltypenum') + if length($self->option_cacheable('use_calltypenum')) + && $cdr->calltypenum ne $self->option_cacheable('use_calltypenum'); #ne otherwise 0 matches '' + + return "calltypenum == ". $self->option_cacheable('ignore_calltypenum') + if length($self->option_cacheable('ignore_calltypenum')) + && $cdr->calltypenum eq $self->option_cacheable('ignore_calltypenum'); #eq otherwise 0 matches '' + + return "dcontext IN ( ". $self->option_cacheable('skip_dcontext'). " )" if $self->option_cacheable('skip_dcontext') =~ /\S/ && grep { $cdr->dcontext eq $_ } split(/\s*,\s*/, $self->option_cacheable('skip_dcontext')); my $len_prefix = length($self->option_cacheable('skip_dstchannel_prefix')); - return "dstchannel starts with $self->option_cacheable('skip_dstchannel_prefix')" + return "dstchannel starts with ". $self->option_cacheable('skip_dstchannel_prefix') if $len_prefix && substr($cdr->dstchannel,0,$len_prefix) eq $self->option_cacheable('skip_dstchannel_prefix'); @@ -503,7 +569,7 @@ sub check_chargable { && $cdr->is_tollfree('accountcode') ); - return "lastapp is $self->option_cacheable('skip_lastapp')" + return "lastapp is ". $self->option_cacheable('skip_lastapp') if length($self->option_cacheable('skip_lastapp')) && $cdr->lastapp eq $self->option_cacheable('skip_lastapp'); my $src_length = $self->option_cacheable('skip_src_length_more'); @@ -555,6 +621,41 @@ sub calc_units { $count; } +sub reset_usage { + my ($self, $cust_pkg, %opt) = @_; + my @part_pkg_usage = $self->part_pkg_usage or return ''; + warn " resetting usage minutes\n" if $opt{debug}; + my %cust_pkg_usage = map { $_->pkgusagepart, $_ } $cust_pkg->cust_pkg_usage; + foreach my $part_pkg_usage (@part_pkg_usage) { + my $part = $part_pkg_usage->pkgusagepart; + my $usage = $cust_pkg_usage{$part} || + FS::cust_pkg_usage->new({ + 'pkgnum' => $cust_pkg->pkgnum, + 'pkgusagepart' => $part, + 'minutes' => $part_pkg_usage->minutes, + }); + foreach my $cdr_usage ( + qsearch('cdr_cust_pkg_usage', {'cdrusagenum' => $usage->cdrusagenum}) + ) { + my $error = $cdr_usage->delete; + warn " error resetting CDR usage: $error\n"; + } + + if ( $usage->pkgusagenum ) { + if ( $part_pkg_usage->rollover ) { + $usage->set('minutes', $part_pkg_usage->minutes + $usage->minutes); + } else { + $usage->set('minutes', $part_pkg_usage->minutes); + } + my $error = $usage->replace; + warn " error resetting usage minutes: $error\n" if $error; + } else { + my $error = $usage->insert; + warn " error resetting usage minutes: $error\n" if $error; + } + } #foreach $part_pkg_usage +} + # tells whether cust_bill_pkg_detail should return a single line for # each phonenum sub sum_usage { diff --git a/FS/FS/part_pkg/voip_inbound.pm b/FS/FS/part_pkg/voip_inbound.pm index 9054f7b99..811329d9f 100644 --- a/FS/FS/part_pkg/voip_inbound.pm +++ b/FS/FS/part_pkg/voip_inbound.pm @@ -60,15 +60,21 @@ tie my %granularity, 'Tie::IxHash', FS::rate_detail::granularities(); 'type' => 'checkbox', }, - 'use_carrierid' => { 'name' => 'Only charge for CDRs where the Carrier ID is set to: ', + 'use_carrierid' => { 'name' => 'Only charge for CDRs where the Carrier ID is set to any of these (comma-separated) values: ', }, - 'use_cdrtypenum' => { 'name' => 'Only charge for CDRs where the CDR Type is set to: ', + 'use_cdrtypenum' => { 'name' => 'Only charge for CDRs where the CDR Type is set to this cdrtypenum: ', }, - 'ignore_cdrtypenum' => { 'name' => 'Do not charge for CDRs where the CDR Type is set to: ', + 'ignore_cdrtypenum' => { 'name' => 'Do not charge for CDRs where the CDR Type is set to this cdrtypenum: ', }, + 'use_calltypenum' => { 'name' => 'Only charge for CDRs where the CDR Call Type is set to this cdrtypenum: ', + }, + + 'ignore_calltypenum' => { 'name' => 'Do not charge for CDRs where the CDR Call Type is set to this cdrtypenum: ', + }, + 'ignore_disposition' => { 'name' => 'Do not charge for CDRs where the Disposition is set to any of these (comma-separated) values: ', }, @@ -147,6 +153,7 @@ tie my %granularity, 'Tie::IxHash', FS::rate_detail::granularities(); use_amaflags use_carrierid use_cdrtypenum ignore_cdrtypenum + use_calltypenum ignore_calltypenum ignore_disposition disposition_in skip_dcontext skip_dstchannel_prefix skip_dst_length_less skip_lastapp @@ -172,7 +179,7 @@ sub calc_recur { my $charges = 0; $charges += $self->calc_usage(@_); - $charges += $self->calc_recur_Common(@_); + $charges += ($cust_pkg->quantity || 1) * $self->calc_recur_Common(@_); $charges; @@ -329,67 +336,58 @@ sub calc_usage { } #returns a reason why not to rate this CDR, or false if the CDR is chargeable +# lots of false laziness w/voip_cdr... sub check_chargable { my( $self, $cdr, %flags ) = @_; - #should have some better way of checking these options from a hash - #or something - - my @opt = qw( - use_amaflags - use_carrierid - use_cdrtypenum - ignore_cdrtypenum - disposition_in - ignore_disposition - skip_dcontext - 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, 1); - } - my %opt = %{ $flags{option_cache} }; - return 'amaflags != 2' - if $opt{'use_amaflags'} && $cdr->amaflags != 2; - - return "disposition NOT IN ( $opt{'disposition_in'} )" - if $opt{'disposition_in'} =~ /\S/ - && !grep { $cdr->disposition eq $_ } split(/\s*,\s*/, $opt{'disposition_in'}); - - return "disposition IN ( $opt{'ignore_disposition'} )" - if $opt{'ignore_disposition'} =~ /\S/ - && grep { $cdr->disposition eq $_ } split(/\s*,\s*/, $opt{'ignore_disposition'}); - - return "carrierid != $opt{'use_carrierid'}" - if length($opt{'use_carrierid'}) - && $cdr->carrierid ne $opt{'use_carrierid'}; #ne otherwise 0 matches '' + if $self->option_cacheable('use_amaflags') && $cdr->amaflags != 2; - return "cdrtypenum != $opt{'use_cdrtypenum'}" - if length($opt{'use_cdrtypenum'}) - && $cdr->cdrtypenum ne $opt{'use_cdrtypenum'}; #ne otherwise 0 matches '' - - return "cdrtypenum == $opt{'ignore_cdrtypenum'}" - if length($opt{'ignore_cdrtypenum'}) - && $cdr->cdrtypenum eq $opt{'ignore_cdrtypenum'}; #eq otherwise 0 matches '' + return "disposition NOT IN ( ". $self->option_cacheable('disposition_in')." )" + if $self->option_cacheable('disposition_in') =~ /\S/ + && !grep { $cdr->disposition eq $_ } split(/\s*,\s*/, $self->option_cacheable('disposition_in')); + + return "disposition IN ( ". $self->option_cacheable('ignore_disposition')." )" + if $self->option_cacheable('ignore_disposition') =~ /\S/ + && grep { $cdr->disposition eq $_ } split(/\s*,\s*/, $self->option_cacheable('ignore_disposition')); + + return "carrierid NOT IN ( ". $self->option_cacheable('use_carrierid'). " )" + if $self->option_cacheable('use_carrierid') =~ /\S/ + && !grep { $cdr->carrierid eq $_ } split(/\s*,\s*/, $self->option_cacheable('use_carrierid')); #eq otherwise 0 matches '' + + # unlike everything else, use_cdrtypenum is applied in FS::svc_x::get_cdrs. + return "cdrtypenum != ". $self->option_cacheable('use_cdrtypenum') + if length($self->option_cacheable('use_cdrtypenum')) + && $cdr->cdrtypenum ne $self->option_cacheable('use_cdrtypenum'); #ne otherwise 0 matches '' + + return "cdrtypenum == ". $self->option_cacheable('ignore_cdrtypenum') + if length($self->option_cacheable('ignore_cdrtypenum')) + && $cdr->cdrtypenum eq $self->option_cacheable('ignore_cdrtypenum'); #eq otherwise 0 matches '' + + # unlike everything else, use_calltypenum is applied in FS::svc_x::get_cdrs. + return "calltypenum != ". $self->option_cacheable('use_calltypenum') + if length($self->option_cacheable('use_calltypenum')) + && $cdr->calltypenum ne $self->option_cacheable('use_calltypenum'); #ne otherwise 0 matches '' + + return "calltypenum == ". $self->option_cacheable('ignore_calltypenum') + if length($self->option_cacheable('ignore_calltypenum')) + && $cdr->calltypenum eq $self->option_cacheable('ignore_calltypenum'); #eq otherwise 0 matches '' - return "dcontext IN ( $opt{'skip_dcontext'} )" - if $opt{'skip_dcontext'} =~ /\S/ - && grep { $cdr->dcontext eq $_ } split(/\s*,\s*/, $opt{'skip_dcontext'}); + return "dcontext IN ( ". $self->option_cacheable('skip_dcontext'). " )" + if $self->option_cacheable('skip_dcontext') =~ /\S/ + && grep { $cdr->dcontext eq $_ } split(/\s*,\s*/, $self->option_cacheable('skip_dcontext')); - my $len_prefix = length($opt{'skip_dstchannel_prefix'}); - return "dstchannel starts with $opt{'skip_dstchannel_prefix'}" + my $len_prefix = length($self->option_cacheable('skip_dstchannel_prefix')); + return "dstchannel starts with ". $self->option_cacheable('skip_dstchannel_prefix') if $len_prefix - && substr($cdr->dstchannel,0,$len_prefix) eq $opt{'skip_dstchannel_prefix'}; + && substr($cdr->dstchannel,0,$len_prefix) eq $self->option_cacheable('skip_dstchannel_prefix'); - my $dst_length = $opt{'skip_dst_length_less'}; + my $dst_length = $self->option_cacheable('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'}; + return "lastapp is ". $self->option_cacheable('skip_lastapp') + if length($self->option_cacheable('skip_lastapp')) && $cdr->lastapp eq $self->option_cacheable('skip_lastapp'); #all right then, rate it ''; diff --git a/FS/FS/part_pkg_currency.pm b/FS/FS/part_pkg_currency.pm new file mode 100644 index 000000000..246abee8b --- /dev/null +++ b/FS/FS/part_pkg_currency.pm @@ -0,0 +1,139 @@ +package FS::part_pkg_currency; +use base qw( FS::Record ); + +use strict; +#use FS::Record qw( qsearch qsearchs ); +use FS::part_pkg; + +=head1 NAME + +FS::part_pkg_currency - Object methods for part_pkg_currency records + +=head1 SYNOPSIS + + use FS::part_pkg_currency; + + $record = new FS::part_pkg_currency \%hash; + $record = new FS::part_pkg_currency { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_pkg_currency object represents an example. FS::part_pkg_currency inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item pkgcurrencynum + +primary key + +=item pkgpart + +Package definition (see L<FS::part_pkg>). + +=item currency + +3-letter currency code + +=item optionname + +optionname + +=item optionvalue + +optionvalue + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new example. To add the example to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'part_pkg_currency'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('pkgcurrencynum') + || $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart') + || $self->ut_currency('currency') + || $self->ut_text('optionname') + || $self->ut_textn('optionvalue') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +The author forgot to customize this manpage. + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_pkg_link.pm b/FS/FS/part_pkg_link.pm index fb7a8d387..9ce8e6a76 100644 --- a/FS/FS/part_pkg_link.pm +++ b/FS/FS/part_pkg_link.pm @@ -49,12 +49,13 @@ Destination package (see L<FS::part_pkg>) =item link_type Link type - currently, "bill" (source package bills a line item from target -package), or "svc" (source package includes services from target package). +package), or "svc" (source package includes services from target package), +or "supp" (ordering source package creates a target package). =item hidden Flag indicating that this subpackage should be felt, but not seen as an invoice -line item when set to 'Y' +line item when set to 'Y'. Not allowed for "supp" links. =back @@ -119,11 +120,26 @@ 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_enum('link_type', [ 'bill', 'svc' ] ) + || $self->ut_enum('link_type', [ 'bill', 'svc', 'supp' ] ) || $self->ut_enum('hidden', [ '', 'Y' ] ) ; return $error if $error; + if ( $self->link_type eq 'supp' ) { + # some sanity checking + my $src_pkg = $self->src_pkg; + my $dst_pkg = $self->dst_pkg; + if ( $src_pkg->freq eq '0' and $dst_pkg->freq ne '0' ) { + return "One-time charges can't have supplemental packages." + } elsif ( $dst_pkg->freq ne '0' ) { + my $ratio = $dst_pkg->freq / $src_pkg->freq; + if ($ratio != int($ratio)) { + return "Supplemental package period (pkgpart ".$dst_pkg->pkgpart. + ") must be an integer multiple of main package period."; + } + } + } + $self->SUPER::check; } diff --git a/FS/FS/part_pkg_msgcat.pm b/FS/FS/part_pkg_msgcat.pm new file mode 100644 index 000000000..7c00c26ac --- /dev/null +++ b/FS/FS/part_pkg_msgcat.pm @@ -0,0 +1,138 @@ +package FS::part_pkg_msgcat; + +use strict; +use base qw( FS::Record ); +use FS::Locales; +#use FS::Record qw( qsearch qsearchs ); +use FS::part_pkg; + +=head1 NAME + +FS::part_pkg_msgcat - Object methods for part_pkg_msgcat records + +=head1 SYNOPSIS + + use FS::part_pkg_msgcat; + + $record = new FS::part_pkg_msgcat \%hash; + $record = new FS::part_pkg_msgcat { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_pkg_msgcat object represents localized labels of a package +definition. FS::part_pkg_msgcat inherits from FS::Record. The following +fields are currently supported: + +=over 4 + +=item pkgpartmsgnum + +primary key + +=item pkgpart + +Package definition + +=item locale + +locale + +=item pkg + +Localized package name (customer-viewable) + +=item comment + +Localized package comment (non-customer-viewable), optional + +=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_pkg_msgcat'; } + +=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('pkgpartmsgnum') + || $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart') + || $self->ut_enum('locale', [ FS::Locales->locales ] ) + || $self->ut_text('pkg') + || $self->ut_textn('comment') + ; + 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/part_pkg_taxrate.pm b/FS/FS/part_pkg_taxrate.pm index c83f700d9..a73272040 100644 --- a/FS/FS/part_pkg_taxrate.pm +++ b/FS/FS/part_pkg_taxrate.pm @@ -5,8 +5,7 @@ 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::Record qw( qsearch qsearchs dbh ); use FS::part_pkg_taxproduct; use FS::Misc qw(csv_from_fixed); @@ -310,8 +309,8 @@ sub batch_import { } } - my $part_pkg_taxrate = qsearchs('part_pkg_taxrate', $hash); - unless ( $part_pkg_taxrate ) { + my @part_pkg_taxrate = qsearch('part_pkg_taxrate', $hash); + unless ( scalar(@part_pkg_taxrate) || $param->{'delete_only'} ) { if ( $hash->{taxproductnum} ) { my $taxproduct = qsearchs( 'part_pkg_taxproduct', @@ -324,8 +323,10 @@ sub batch_import { join(" ", map { "$_ => *". $hash->{$_}. '*' } keys(%$hash) ); } - my $error = $part_pkg_taxrate->delete; - return $error if $error; + foreach my $part_pkg_taxrate (@part_pkg_taxrate) { + my $error = $part_pkg_taxrate->delete; + return $error if $error; + } delete($hash->{$_}) foreach (keys %$hash); } diff --git a/FS/FS/part_pkg_usage.pm b/FS/FS/part_pkg_usage.pm new file mode 100644 index 000000000..99014d398 --- /dev/null +++ b/FS/FS/part_pkg_usage.pm @@ -0,0 +1,159 @@ +package FS::part_pkg_usage; + +use strict; +use base qw( FS::m2m_Common FS::Record ); +use FS::Record qw( qsearch qsearchs ); +use Scalar::Util qw(blessed); + +=head1 NAME + +FS::part_pkg_usage - Object methods for part_pkg_usage records + +=head1 SYNOPSIS + + use FS::part_pkg_usage; + + $record = new FS::part_pkg_usage \%hash; + $record = new FS::part_pkg_usage { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_pkg_usage object represents a stock of usage minutes (generally +for voice services) included in a package definition. FS::part_pkg_usage +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item pkgusagepart - primary key + +=item pkgpart - the package definition (L<FS::part_pkg>) + +=item minutes - the number of minutes included per billing cycle + +=item priority - the relative order in which to use this stock of minutes. + +=item shared - 'Y' to allow these minutes to be shared with other packages +belonging to the same customer. Otherwise, only usage allocated to this +package will use this stock of minutes. + +=item rollover - 'Y' to allow unused minutes to carry over between billing +cycles. Otherwise, the available minutes will reset to the value of the +"minutes" field upon billing. + +=item description - a text description of this stock of minutes + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +=item insert CLASSES + +=item replace CLASSES + +CLASSES can be an array or hash of usage classnums (see L<FS::usage_class>) +to link to this record. + +=item delete + +=cut + +sub table { 'part_pkg_usage'; } + +sub insert { + my $self = shift; + my $opt = ref($_[0]) eq 'HASH' ? shift : { @_ }; + + $self->SUPER::insert + || $self->process_m2m( 'link_table' => 'part_pkg_usage_class', + 'target_table' => 'usage_class', + 'params' => $opt, + ); +} + +sub replace { + my $self = shift; + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $self->replace_old; + my $opt = ref($_[0]) eq 'HASH' ? $_[0] : { @_ }; + $self->SUPER::replace($old) + || $self->process_m2m( 'link_table' => 'part_pkg_usage_class', + 'target_table' => 'usage_class', + 'params' => $opt, + ); +} + +sub delete { + my $self = shift; + $self->process_m2m( 'link_table' => 'part_pkg_usage_class', + 'target_table' => 'usage_class', + 'params' => {}, + ) || $self->SUPER::delete; +} + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('pkgusagepart') + || $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart') + || $self->ut_number('minutes') + || $self->ut_numbern('priority') + || $self->ut_flag('shared') + || $self->ut_flag('rollover') + || $self->ut_textn('description') + ; + return $error if $error; + + $self->SUPER::check; +} + +=item classnums + +Returns the usage class numbers that are allowed to use minutes from this +pool. + +=cut + +sub classnums { + my $self = shift; + if (!$self->get('classnums')) { + my $classnums = [ + map { $_->classnum } + qsearch('part_pkg_usage_class', { 'pkgusagepart' => $self->pkgusagepart }) + ]; + $self->set('classnums', $classnums); + } + @{ $self->get('classnums') }; +} + +=back + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_pkg_usage_class.pm b/FS/FS/part_pkg_usage_class.pm new file mode 100644 index 000000000..9a99783af --- /dev/null +++ b/FS/FS/part_pkg_usage_class.pm @@ -0,0 +1,125 @@ +package FS::part_pkg_usage_class; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::part_pkg_usage_class - Object methods for part_pkg_usage_class records + +=head1 SYNOPSIS + + use FS::part_pkg_usage_class; + + $record = new FS::part_pkg_usage_class \%hash; + $record = new FS::part_pkg_usage_class { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_pkg_usage_class object is a link between a package usage stock +(L<FS::part_pkg_usage>) and a voice usage class (L<FS::usage_class)>. +FS::part_pkg_usage_class inherits from FS::Record. The following fields +are currently supported: + +=over 4 + +=item num - primary key + +=item pkgusagepart - L<FS::part_pkg_usage> key + +=item classnum - L<FS::usage_class> key. Set to null to allow this stock +to be used for calls that have no usage class. To avoid confusion, you +should only do this if you don't use usage classes on your system. + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new example. To add the example to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'part_pkg_usage_class'; } + +=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('num') + || $self->ut_foreign_key('pkgusagepart', 'part_pkg_usage', 'pkgusagepart') + || $self->ut_foreign_keyn('classnum', 'usage_class', 'classnum') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +The author forgot to customize this manpage. + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 7f22411e0..da794dd4c 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -58,6 +58,13 @@ L<FS::svc_domain>, and L<FS::svc_forward>, among others. =item preserve - Preserve after cancellation, empty or 'Y' +=item selfservice_access - Access allowed to the service via self-service: +empty for full access, "readonly" for read-only, "hidden" to hide it entirely + +=item restrict_edit_password - Require the "Provision customer service" access +right to change the password field, rather than just "Edit password". Only +relevant to svc_acct for now. + =back =head1 METHODS @@ -391,7 +398,8 @@ sub check { || $self->ut_enum('preserve', [ '', 'Y' ] ) || $self->ut_enum('selfservice_access', [ '', 'hidden', 'readonly' ] ) || $self->ut_foreign_keyn('classnum', 'part_svc_class', 'classnum' ) - ; + || $self->ut_enum('restrict_edit_password', [ '', 'Y' ] ) +; return $error if $error; my @fields = eval { fields( $self->svcdb ) }; #might die @@ -441,9 +449,10 @@ sub part_export { my $self = shift; my %search; $search{'exporttype'} = shift if @_; - sort { $a->weight <=> $b->weight } - map { qsearchs('part_export', { 'exportnum' => $_->exportnum, %search } ) } - qsearch('export_svc', { 'svcpart' => $self->svcpart } ); + map { $_ } #behavior of sort undefined in scalar context + sort { $a->weight <=> $b->weight } + map { qsearchs('part_export', { 'exportnum'=>$_->exportnum, %search } ) } + qsearch('export_svc', { 'svcpart'=>$self->svcpart } ); } =item part_export_usage @@ -748,11 +757,9 @@ sub process { if ( $flag =~ /^[MAH]$/ ) { $param->{ $f } = delete( $param->{ $f.'_classnum' } ); } - if ( $flag =~ /^S$/ - or $_ eq 'usergroup' ) { - $param->{ $f } = ref($param->{ $f }) - ? join(',', @{$param->{ $f }} ) - : $param->{ $f }; + if ( ( $flag =~ /^[MAHS]$/ or $_ eq 'usergroup' ) + and ref($param->{ $f }) ) { + $param->{ $f } = join(',', @{ $param->{ $f } }); } ( $f, $f.'_flag', $f.'_label' ); } diff --git a/FS/FS/part_svc_column.pm b/FS/FS/part_svc_column.pm index d467516ed..38ce1fa80 100644 --- a/FS/FS/part_svc_column.pm +++ b/FS/FS/part_svc_column.pm @@ -99,8 +99,14 @@ sub check { $self->columnflag(uc($1)); if ( $self->columnflag =~ /^[MA]$/ ) { - $error = - $self->ut_foreign_key( 'columnvalue', 'inventory_class', 'classnum' ); + # split, check all values independently, and normalize + my @classnums = split(/\s*,\s*/, $self->columnvalue); + foreach (@classnums) { + $self->set('columnvalue', $_); + $error = $self->ut_foreign_key( 'columnvalue', 'inventory_class', 'classnum' ); + return $error if $error; + } + $self->set('columnvalue', join(',', @classnums)); } if ( $self->columnflag eq 'H' ) { $error = diff --git a/FS/FS/pay_batch.pm b/FS/FS/pay_batch.pm index b8da9b49b..2a048a115 100644 --- a/FS/FS/pay_batch.pm +++ b/FS/FS/pay_batch.pm @@ -201,7 +201,7 @@ foreach my $INC (@INC) { \\%FS::pay_batch::$mod\::export_info, \$FS::pay_batch::$mod\::name)"; $name ||= $mod; # in case it's not defined - if( $@) { + 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; @@ -401,12 +401,12 @@ sub import_results { foreach ('paid', '_date', 'payinfo') { $new_cust_pay_batch->$_($hash{$_}) if $hash{$_}; } - $error = $new_cust_pay_batch->approve($hash{'paybatch'} || $self->batchnum); + $error = $new_cust_pay_batch->approve(%hash); $total += $hash{'paid'}; } elsif ( &{$declined_condition}(\%hash) ) { - $error = $new_cust_pay_batch->decline; + $error = $new_cust_pay_batch->decline($hash{'error_message'});; } @@ -572,8 +572,6 @@ sub import_from_gateway { my $payby; # CARD or CHEK my $error; - # follow realtime gateway practice here - # though eventually this stuff should go into separate fields... my $paybatch = $gateway->gatewaynum . '-' . $gateway->gateway_module . ':' . $item->authorization . ':' . $item->order_number; @@ -644,8 +642,11 @@ sub import_from_gateway { payby => $payby, invnum => $item->invoice_number, batchnum => $pay_batch->batchnum, - paybatch => $paybatch, payinfo => $payinfo, + gatewaynum => $gateway->gatewaynum, + processor => $gateway->gateway_module, + auth => $item->authorization, + order_number => $item->order_number, } ); $error ||= $cust_pay->insert; @@ -725,7 +726,12 @@ sub import_from_gateway { # approval status if ( $item->approved ) { # follow Billing_Realtime format for paybatch - $error = $cust_pay_batch->approve($paybatch); + $error = $cust_pay_batch->approve( + 'gatewaynum' => $gateway->gatewaynum, + 'processor' => $gateway->gateway_module, + 'auth' => $item->authorization, + 'order_number' => $item->order_number, + ); $total += $cust_pay_batch->paid; } else { @@ -829,6 +835,9 @@ sub try_to_resolve { } return $error if $error; } + } elsif ( @unresolved ) { + # auto resolve is not enabled, and we're not ready to resolve + return; } $self->set_status('R'); @@ -1028,7 +1037,6 @@ sub manual_approve { my $self = shift; my $date = time; my %opt = @_; - my $paybatch = $opt{'paybatch'} || $self->batchnum; my $usernum = $opt{'usernum'} || die "manual approval requires a usernum"; my $conf = FS::Conf->new; return 'manual batch approval disabled' @@ -1058,7 +1066,9 @@ sub manual_approve { '_date' => $date, 'usernum' => $usernum, }; - my $error = $new_cust_pay_batch->approve($paybatch); + my $error = $new_cust_pay_batch->approve(); + # there are no approval options here (authorization, order_number, etc.) + # because the transaction wasn't really approved if ( $error ) { $dbh->rollback; return 'paybatchnum '.$cust_pay_batch->paybatchnum.": $error"; diff --git a/FS/FS/pay_batch/BoM.pm b/FS/FS/pay_batch/BoM.pm index 719b504e5..b609df351 100644 --- a/FS/FS/pay_batch/BoM.pm +++ b/FS/FS/pay_batch/BoM.pm @@ -31,13 +31,13 @@ $name = 'BoM'; }, header => sub { my $pay_batch = shift; - sprintf( "A%10s%04u%06u%05u%54s\n", #80 + sprintf( "A%10s%04u%06u%05u%53s\n", #80 $origid, $pay_batch->batchnum, jdate($pay_batch->download), $datacenter, "") . - sprintf( "XD%03u%06u%-15s%-30s%09u%-12s \n", #80 + sprintf( "XD%03u%06u%-15s%-30s%09u%-12s ", #80 $typecode, jdate($pay_batch->download), $shortname, @@ -48,7 +48,7 @@ $name = 'BoM'; 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", #80 + sprintf( "D%010.0f%09u%-12s%-29s%-18s ", #80 $cust_pay_batch->amount * 100, $aba, $account, @@ -58,8 +58,8 @@ $name = 'BoM'; }, footer => sub { my ($pay_batch, $batchcount, $batchtotal) = @_; - sprintf( "YD%08u%014.0f%56s\n", $batchcount, $batchtotal*100, ""). #80 - sprintf( "Z%014u%04u%014u%05u%42s\n", #80 now + sprintf( "YD%08u%014.0f%55s\n", $batchcount, $batchtotal*100, ""). #80 + sprintf( "Z%014.0f%05u%014u%05u%40s", #80 now $batchtotal*100, $batchcount, "0", "0", ""); }, ); diff --git a/FS/FS/pay_batch/eft_canada.pm b/FS/FS/pay_batch/eft_canada.pm index ea9d58402..b24c9c3a4 100644 --- a/FS/FS/pay_batch/eft_canada.pm +++ b/FS/FS/pay_batch/eft_canada.pm @@ -25,12 +25,6 @@ my %holiday_yearly = ( 12 => { map {$_=>1} 26 }, #boxing day ); my %holiday = ( - 2012 => { - 7 => { map {$_=>1} 2 }, #canada day - 8 => { map {$_=>1} 6 }, #First Monday of August Civic Holiday - 9 => { map {$_=>1} 3 }, #labour day - 10 => { map {$_=>1} 8 }, #thanksgiving - }, 2013 => { 2 => { map {$_=>1} 18 }, #family day 3 => { map {$_=>1} 29 }, #good friday 4 => { map {$_=>1} 1 }, #easter monday @@ -112,7 +106,7 @@ my %holiday = ( } push @fields, sprintf('%05s', $branch), sprintf('%03s', $bankno), - sprintf('%012s', $account), + $account, sprintf('%.02f', $cust_pay_batch->amount); # DB = debit push @fields, 'DB', $trans_code, $process_date; diff --git a/FS/FS/pay_batch/nacha.pm b/FS/FS/pay_batch/nacha.pm new file mode 100644 index 000000000..c069082c7 --- /dev/null +++ b/FS/FS/pay_batch/nacha.pm @@ -0,0 +1,208 @@ +package FS::pay_batch::nacha; + +use strict; +use vars qw( %import_info %export_info $name $conf $entry_hash $DEBUG ); +use Date::Format; +#use Time::Local 'timelocal'; +#use FS::Conf; + +$name = 'NACHA'; + +$DEBUG = 0; + +%import_info = ( + #XXX stub finish me + 'filetype' => 'CSV', + 'fields' => [ + ], + 'hook' => sub { + my $hash = shift; + }, + 'approved' => sub { 1 }, + 'declined' => sub { 0 }, +); + +%export_info = ( + + #optional + init => sub { + $conf = shift; + }, + + delimiter => '', + + + header => sub { + my( $pay_batch, $cust_pay_batch_arrayref ) = @_; + + $conf->config('batchconfig-nacha-destination') =~ /^\s*(\d{9})\s*$/ + or die 'illegal NACHA Destination'; + my $dest = $1; + + my $dest_name = $conf->config('batchconfig-nacha-destination_name'); + $dest_name = substr( $dest_name. (' 'x23), 0, 23); + + $conf->config('batchconfig-nacha-origin') =~ /^\s*(\d{10})\s*$/ + or die 'illegal NACHA Origin'; + my $origin = $1; + + my $company = $conf->config('company_name', $pay_batch->agentnum); + $company = substr(uc($company). (' 'x23), 0, 23); + + my $now = time; + + #haha don't want to break after a quarter million years of a batch a day + #or 54 years for 5000 agent-virtualized hosted companies batching daily + my $refcode = substr( (' 'x8). $pay_batch->batchnum, -8); + + #or only 25,000 years or 5.4 for 5000 companies :) + #though they would probably want them numbered per company + my $batchnum = substr( ('0'x7). $pay_batch->batchnum, -7); + + $entry_hash = 0; + + warn "building File & Batch Header Records\n" if $DEBUG; + + ## + # File Header Record + ## + + '1'. #Record Type Code + '01'. #Priority Code + ' '. $dest. #Immediate Destination / 9-digit transit routing # + $origin. #Immediate Origin / 10 digit company number + time2str('%y%m%d', $now). #File Creation Date + time2str('%H%M', $now). #File Creation Time + 'A'. #XXX file ID modifier, mult. files in transit? [A-Z0-9] + '094'. #94 character records + '10'. #Blocking Factor + '1'. #Format code + $dest_name. #Immediate Destination Name / 23 char bank name + $company. #Immediate Origin Name / 23 char company name + $refcode. #Reference Code (internal/optional) + + ### + # Batch Header Record + ### + + '5'. #Record Type Code + '225'. #Service Class Code (220 credits only, + # 200 mixed debits & credits) + substr($company, 0, 16). #on cust. statements + (' 'x20 ). #20 char "company internal use if desired" + $origin. #Company Identification (Immediate Origin) + 'PPD'. #others? + #PPD "Prearranged Payments and Deposit entries" for consumer items + #CCD (Cash Concentration and Disbursement) + #CTX (Corporate Trade Exchange) + #TEL (Telephone initiated entires) + #WEB (Authorization received via the Internet) + 'InterntSvc'. #XXX from conf 10 char txn desc, printed on cust. statements + + #6 char "Descriptive date" printed on customer statements + #XXX now? or use a separate post date? + time2str('%y%m%d', $now). + + #6 char date transactions are to be posted + #XXX now? or do we need a future banking day date like eft_canada trainwreck + time2str('%y%m%d', $now). + + (' 'x3). #Settlement Date / Reserved + '1'. #Originator Status Code + substr($dest, 0, 8). #Originating Financial Institution + $batchnum #Batch Number ("number batches sequentially") + + }, + + 'row' => sub { + my( $cust_pay_batch, $pay_batch, $batchcount, $batchtotal ) = @_; + + my ($account, $aba) = split('@', $cust_pay_batch->payinfo); + + # "Total of all positions 4-11 on each 6 record" + $entry_hash += substr($aba,0,8); + + my $cust_main = $cust_pay_batch->cust_main; + my $cust_identifier = substr($cust_main->display_custnum. (' 'x15), 0, 15); + + #XXX paytype should actually be in the batch, but this will do for now + #27 checking debit, 37 savings debit + my $transaction_code = ( $cust_main->paytype =~ /savings/i ? '37' : '27' ); + + my $cust_name = substr($cust_main->name. (' 'x22), 0, 22); + + #non-PPD transactions? future + + warn "building PPD Record\n" if $DEBUG; + + ### + # PPD Entry Detail Record + ### + + '6'. #Record Type Code + $transaction_code. #Transaction Code + $aba. #Receiving DFI Identification, check digit + substr($account.(' 'x17), 0, 17). #DFI Account number (Left justify) + sprintf('%010d', $cust_pay_batch->amount * 100). #Amount + $cust_identifier. #Individual Identification Number, 15 char + $cust_name. #Individual name (22-char) + ' '. #2 char "company internal use if desired" + '0'. #Addenda Record Indicator + (' 'x15) #15 digit "bank will assign trace number" + # (00000?) + }, + + 'footer' => sub { + my( $pay_batch, $batchcount, $batchtotal ) = @_; + + #Only use the final 10 positions in the entry + $entry_hash = substr( '00'.$entry_hash, -10); + + $conf->config('batchconfig-nacha-destination') =~ /^\s*(\d{9})\s*$/ + or die 'illegal NACHA Destination'; + my $dest = $1; + + $conf->config('batchconfig-nacha-origin') =~ /^\s*(\d{10})\s*$/ + or die 'illegal NACHA Origin'; + my $origin = $1; + + my $batchnum = substr( ('0'x7). $pay_batch->batchnum, -7); + + warn "building Batch & File Control Records\n" if $DEBUG; + + ### + # Batch Control Record + ### + + '8'. #Record Type Code + '225'. #Service Class Code (220 credits only, + # 200 mixed debits&credits) + sprintf('%06d', $batchcount). #Entry / Addenda Count + $entry_hash. + sprintf('%012d', $batchtotal * 100). #Debit total + '000000000000'. #Credit total + $origin. #Company Identification (Immediate Origin) + (' 'x19). #Message Authentication Code (19 char blank) + (' 'x6). #Federal Reserve Use (6 char blank) + substr($dest, 0, 8). #Originating Financial Institution + $batchnum. #Batch Number ("number batches sequentially") + + ### + # File Control Record + ### + + '9'. #Record Type Code + '000001'. #Batch Counter (# of batch header recs) + sprintf('%06d', $batchcount + 4). #num of physical blocks on the file..? + sprintf('%08d', $batchcount). #total # of entry detail and addenda + $entry_hash. + sprintf('%012d', $batchtotal * 100). #Debit total + '000000000000'. #Credit total + ( ' 'x39 ) #Reserved / blank + + }, + +); + +1; + diff --git a/FS/FS/pay_batch/paymentech.pm b/FS/FS/pay_batch/paymentech.pm index 2ac5a6624..1ecf35afd 100644 --- a/FS/FS/pay_batch/paymentech.pm +++ b/FS/FS/pay_batch/paymentech.pm @@ -10,7 +10,7 @@ use Tie::IxHash; use FS::Conf; my $conf; -my ($bin, $merchantID, $terminalID, $username); +my ($bin, $merchantID, $terminalID, $username, $password, $with_recurringInd); $name = 'paymentech'; my $gateway; @@ -23,7 +23,10 @@ my $gateway; '_date', 'approvalStatus', 'order_number', - 'authorization', + 'auth', + 'procStatus', + 'procStatusMessage', + 'respCodeMessage', ], xmlkeys => [ 'orderID', @@ -31,6 +34,9 @@ my $gateway; 'approvalStatus', 'txRefNum', 'authorizationCode', + 'procStatus', + 'procStatusMessage', + 'respCodeMessage', ], 'hook' => sub { if ( !$gateway ) { @@ -38,7 +44,7 @@ my $gateway; # as the batch config, if there is one. If not, leave # gateway out entirely. my $merchant = (FS::Conf->new->config('batchconfig-paymentech'))[2]; - my $g = qsearchs({ + $gateway = qsearchs({ 'table' => 'payment_gateway', 'addl_from' => ' JOIN payment_gateway_option USING (gatewaynum) ', 'hashref' => { disabled => '', @@ -46,18 +52,19 @@ my $gateway; optionvalue => $merchant, }, }); - $gateway = ($g ? $g->gatewaynum . '-' : '') . 'PaymenTech'; } my ($hash, $oldhash) = @_; + $hash->{'gatewaynum'} = $gateway->gatewaynum if $gateway; + $hash->{'processor'} = 'PaymenTech'; my ($mon, $day, $year, $hour, $min, $sec) = $hash->{'_date'} =~ /^(..)(..)(....)(..)(..)(..)$/; $hash->{'_date'} = timelocal($sec, $min, $hour, $day, $mon-1, $year); $hash->{'paid'} = $oldhash->{'amount'}; - $hash->{'paybatch'} = join(':', - $gateway, - $hash->{'authorization'}, - $hash->{'order_number'}, - ); + if ( $hash->{'procStatus'} == 0 ) { + $hash->{'error_message'} = $hash->{'respCodeMessage'}; + } else { + $hash->{'error_message'} = $hash->{'procStatusMessage'}; + } }, 'approved' => sub { my $hash = shift; $hash->{'approvalStatus'} @@ -72,7 +79,9 @@ my %paytype = ( 'personal savings' => 'S', 'business checking' => 'X', 'business savings' => 'X', - ); +); + +my %paymentech_countries = map { $_ => 1 } qw( US CA GB UK ); %export_info = ( init => sub { @@ -80,7 +89,7 @@ my %paytype = ( eval "use XML::Writer"; die $@ if $@; my $conf = shift; - ($bin, $terminalID, $merchantID, $username) = + ($bin, $terminalID, $merchantID, $username, $password, $with_recurringInd) = $conf->config('batchconfig-paymentech'); }, # Here we do all the work in the header function. @@ -99,31 +108,42 @@ my %paytype = ( foreach (@cust_pay_batch) { $xml->startTag('newOrder', BatchRequestNo => $count++); + my $status = $_->cust_main->status; tie my %order, 'Tie::IxHash', ( - industryType => 'EC', - transType => 'AC', - bin => $bin, - merchantID => $merchantID, - terminalID => $terminalID, + industryType => 'EC', + transType => 'AC', + bin => $bin, + merchantID => $merchantID, + terminalID => $terminalID, ($_->payby eq 'CARD') ? ( - ccAccountNum => $_->payinfo, - ccExp => $_->expmmyy, + ccAccountNum => $_->payinfo, + ccExp => $_->expmmyy, ) : ( ecpCheckRT => ($_->payinfo =~ /@(\d+)/), ecpCheckDDA => ($_->payinfo =~ /(\d+)@/), ecpBankAcctType => $paytype{lc($_->cust_main->paytype)}, ecpDelvMethod => 'A', ), - avsZip => substr($_->zip, 0, 10), + avsZip => substr($_->zip, 0, 10), avsAddress1 => substr($_->address1, 0, 30), avsAddress2 => substr($_->address2, 0, 30), - avsCity => substr($_->city, 0, 20), - avsState => $_->state, - avsName => substr($_->first . ' ' . $_->last, 0, 30), - avsCountryCode => $_->country, - orderID => $_->paybatchnum, - amount => $_->amount * 100, + avsCity => substr($_->city, 0, 20), + avsState => substr($_->state, 0, 2), + avsName => substr($_->first. ' '. $_->last, 0, 30), + ( $paymentech_countries{ $_->country } + ? ( avsCountryCode => $_->country ) + : () + ), + orderID => $_->paybatchnum, + amount => $_->amount * 100, ); + # only do this if recurringInd is enabled in config, + # and the customer has at least one non-canceled recurring package + if ( $with_recurringInd and $status =~ /^active|suspended|ordered$/ ) { + # then send RF if this is the first payment on this payinfo, + # RS otherwise. + $order{'recurringInd'} = $_->payinfo_used ? 'RS' : 'RF'; + } foreach my $key (keys %order) { $xml->dataElement($key, $order{$key}) } diff --git a/FS/FS/payby.pm b/FS/FS/payby.pm index d1961a58d..e223a050f 100644 --- a/FS/FS/payby.pm +++ b/FS/FS/payby.pm @@ -208,6 +208,7 @@ sub longname { 'CARD' => 'CC', 'CHEK' => 'ECHECK', 'MCRD' => 'CC', + 'PPAL' => 'PAYPAL', ); sub payby2bop { diff --git a/FS/FS/payinfo_Mixin.pm b/FS/FS/payinfo_Mixin.pm index d03391f68..82632526d 100644 --- a/FS/FS/payinfo_Mixin.pm +++ b/FS/FS/payinfo_Mixin.pm @@ -3,6 +3,9 @@ package FS::payinfo_Mixin; use strict; use Business::CreditCard; use FS::payby; +use FS::Record qw(qsearch); + +use vars qw($ignore_masked_payinfo); =head1 NAME @@ -41,26 +44,18 @@ For Refunds (cust_refund): For Payments (cust_pay): 'CARD' (credit cards), 'CHEK' (electronic check/ACH), 'LECB' (phone bill billing), 'BILL' (billing), 'PREP' (prepaid card), -'CASH' (cash), 'WEST' (Western Union), or 'MCRD' (Manual credit card) +'CASH' (cash), 'WEST' (Western Union), 'MCRD' (Manual credit card), +'PPAL' (PayPal) 'COMP' (free) is depricated as a payment type in cust_pay =cut -# was this supposed to do something? - -#sub payby { -# my($self,$payby) = @_; -# if ( defined($payby) ) { -# $self->setfield('payby', $payby); -# } -# return $self->getfield('payby') -#} - =item payinfo Payment information (payinfo) can be one of the following types: -Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>) +Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) +prepayment identifier (see L<FS::prepay_credit>), PayPal transaction ID =cut @@ -206,17 +201,21 @@ sub payinfo_check { if ( $self->payby eq 'CARD' && ! $self->is_encrypted($self->payinfo) ) { my $payinfo = $self->payinfo; - $payinfo =~ s/\D//g; - $self->payinfo($payinfo); - if ( $self->payinfo ) { - $self->payinfo =~ /^(\d{13,16}|\d{8,9})$/ - or return "Illegal (mistyped?) credit card number (payinfo)"; - $self->payinfo($1); - validate($self->payinfo) or return "Illegal credit card number"; - return "Unknown card type" if $self->payinfo !~ /^99\d{14}$/ #token - && cardtype($self->payinfo) eq "Unknown"; + if ( $ignore_masked_payinfo and $self->mask_payinfo eq $self->payinfo ) { + # allow it } else { - $self->payinfo('N/A'); #??? + $payinfo =~ s/\D//g; + $self->payinfo($payinfo); + if ( $self->payinfo ) { + $self->payinfo =~ /^(\d{13,16}|\d{8,9})$/ + or return "Illegal (mistyped?) credit card number (payinfo)"; + $self->payinfo($1); + validate($self->payinfo) or return "Illegal credit card number"; + return "Unknown card type" if $self->payinfo !~ /^99\d{14}$/ #token + && cardtype($self->payinfo) eq "Unknown"; + } else { + $self->payinfo('N/A'); #??? + } } } else { if ( $self->is_encrypted($self->payinfo) ) { @@ -229,8 +228,6 @@ sub payinfo_check { } } - ''; - } =item payby_payinfo_pretty @@ -262,11 +259,37 @@ sub payby_payinfo_pretty { 'Western Union'; #. $self->payinfo; } elsif ( $self->payby eq 'MCRD' ) { 'Manual credit card'; #. $self->payinfo; + } elsif ( $self->payby eq 'PPAL' ) { + 'PayPal transaction#' . $self->order_number; } else { $self->payby. ' '. $self->payinfo; } } +=item payinfo_used [ PAYINFO ] + +Returns 1 if there's an existing payment using this payinfo. This can be +used to set the 'recurring payment' flag required by some processors. + +=cut + +sub payinfo_used { + my $self = shift; + my $payinfo = shift || $self->payinfo; + my %hash = ( + 'custnum' => $self->custnum, + 'payby' => 'CARD', + ); + + return 1 + if qsearch('cust_pay', { %hash, 'payinfo' => $payinfo } ) + || qsearch('cust_pay', + { %hash, 'paymask' => $self->mask_payinfo('CARD', $payinfo) } ) + ; + + return 0; +} + =back =head1 BUGS diff --git a/FS/FS/payinfo_transaction_Mixin.pm b/FS/FS/payinfo_transaction_Mixin.pm index 19419de1c..50659ac1e 100644 --- a/FS/FS/payinfo_transaction_Mixin.pm +++ b/FS/FS/payinfo_transaction_Mixin.pm @@ -23,7 +23,8 @@ use vars qw(@ISA); =head1 DESCRIPTION This is a mixin class for records that represent transactions: that contain -payinfo and paybatch. Currently FS::cust_pay and FS::cust_refund +payinfo and realtime result fields (gatewaynum, processor, authorization, +order_number). Currently FS::cust_pay, FS::cust_refund, and FS::cust_pay_void. =head1 METHODS @@ -55,32 +56,8 @@ sub payby_name { } } -=item gatewaynum +# We keep _parse_paybatch just because the upgrade needs it. -Returns a gatewaynum for the processing gateway. - -=item processor - -Returns a name for the processing gateway. - -=item authorization - -Returns a name for the processing gateway. - -=item order_number - -Returns a name for the processing gateway. - -=cut - -sub gatewaynum { shift->_parse_paybatch->{'gatewaynum'}; } -sub processor { shift->_parse_paybatch->{'processor'}; } -sub authorization { shift->_parse_paybatch->{'authorization'}; } -sub order_number { shift->_parse_paybatch->{'order_number'}; } - -#sucks that this stuff is in paybatch like this in the first place, -#but at least other code can start to use new field names -#(code nicked from FS::cust_main::realtime_refund_bop) sub _parse_paybatch { my $self = shift; @@ -96,10 +73,7 @@ sub _parse_paybatch { my $payment_gateway = qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } ); - die "payment gateway $gatewaynum not found" #? - unless $payment_gateway; - - $processor = $payment_gateway->gateway_module; + $processor = $payment_gateway->gateway_module if $payment_gateway; } @@ -112,6 +86,33 @@ sub _parse_paybatch { } +# because we can't actually name the field 'authorization' (reserved word) +sub authorization { + my $self = shift; + $self->auth(@_); +} + +=item payinfo_check + +Checks the validity of the realtime payment fields (gatewaynum, processor, +auth, and order_number) as well as payby and payinfo + +=cut + +sub payinfo_check { + my $self = shift; + + # All of these can be null, so in principle this could go in payinfo_Mixin. + + $self->SUPER::payinfo_check() + || $self->ut_numbern('gatewaynum') + # not ut_foreign_keyn, it causes upgrades to fail + || $self->ut_alphan('processor') + || $self->ut_textn('auth') + || $self->ut_textn('order_number') + || ''; +} + =back =head1 SEE ALSO diff --git a/FS/FS/payment_gateway.pm b/FS/FS/payment_gateway.pm index 4a7585e24..68d841855 100644 --- a/FS/FS/payment_gateway.pm +++ b/FS/FS/payment_gateway.pm @@ -41,7 +41,7 @@ currently supported: =item gateway_namespace - Business::OnlinePayment, Business::OnlineThirdPartyPayment, or Business::BatchPayment -=item gateway_module - Business::OnlinePayment:: module name +=item gateway_module - Business::OnlinePayment:: (or other) module name =item gateway_username - payment gateway username @@ -51,6 +51,14 @@ currently supported: =item disabled - Disabled flag, empty or 'Y' +=item gateway_callback_url - For ThirdPartyPayment only, set to the URL that +the user should be redirected to on a successful payment. This will be sent +as a transaction parameter named "return_url". + +=item gateway_cancel_url - For ThirdPartyPayment only, set to the URL that +the user should be redirected to if they cancel the transaction. This will +be sent as a transaction parameter named "cancel_url". + =item auto_resolve_status - For BatchPayment only, set to 'approve' to auto-approve unresolved payments after some number of days, 'reject' to auto-decline them, or null to do nothing. @@ -128,6 +136,7 @@ sub check { || $self->ut_textn('gateway_username') || $self->ut_anything('gateway_password') || $self->ut_textn('gateway_callback_url') # a bit too permissive + || $self->ut_textn('gateway_cancel_url') || $self->ut_enum('disabled', [ '', 'Y' ] ) || $self->ut_enum('auto_resolve_status', [ '', 'approve', 'reject' ]) || $self->ut_numbern('auto_resolve_days') @@ -152,8 +161,8 @@ sub check { } # 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->gateway_callback_url($self->gateway_callback_url. '/') + # if ( $self->gateway_callback_url && $self->gateway_callback_url !~ /\/$/ ); $self->SUPER::check; } @@ -268,10 +277,6 @@ sub batch_processor { eval "use Business::BatchPayment;"; die "couldn't load Business::BatchPayment: $@" if $@; - my $conf = new FS::Conf; - my $test_mode = $conf->exists('business-batchpayment-test_transaction'); - $opt{'test_mode'} = 1 if $test_mode; - my $module = $self->gateway_module; my $processor = eval { Business::BatchPayment->create($module, $self->options, %opt) @@ -280,11 +285,46 @@ sub batch_processor { if $@; die "$module does not support test mode" - if $test_mode and not $processor->does('Business::BatchPayment::TestMode'); + if $opt{'test_mode'} + and not $processor->does('Business::BatchPayment::TestMode'); return $processor; } +=item processor OPTIONS + +Loads the module for the processor and returns an instance of it. + +=cut + +sub processor { + local $@; + my $self = shift; + my %opt = @_; + foreach (qw(action username password)) { + if (length($self->get("gateway_$_"))) { + $opt{$_} = $self->get("gateway_$_"); + } + } + $opt{'return_url'} = $self->gateway_callback_url; + $opt{'cancel_url'} = $self->gateway_cancel_url; + + my $conf = new FS::Conf; + my $test_mode = $conf->exists('business-batchpayment-test_transaction'); + $opt{'test_mode'} = 1 if $test_mode; + + my $namespace = $self->gateway_namespace; + eval "use $namespace"; + die "couldn't load $namespace: $@" if $@; + + if ( $namespace eq 'Business::BatchPayment' ) { + # at some point we can merge these, but there's enough special behavior... + return $self->batch_processor(%opt); + } else { + return $namespace->new( $self->gateway_module, $self->options, %opt ); + } +} + # _upgrade_data # # Used by FS::Upgrade to migrate to a new database. diff --git a/FS/FS/prospect_main.pm b/FS/FS/prospect_main.pm index b5d51d333..a18c8ff67 100644 --- a/FS/FS/prospect_main.pm +++ b/FS/FS/prospect_main.pm @@ -2,7 +2,7 @@ package FS::prospect_main; use strict; use base qw( FS::Quotable_Mixin FS::o2m_Common FS::Record ); -use vars qw( $DEBUG ); +use vars qw( $DEBUG @location_fields ); use Scalar::Util qw( blessed ); use FS::Record qw( dbh qsearch qsearchs ); use FS::agent; @@ -12,6 +12,43 @@ use FS::qual; $DEBUG = 0; +#started as false laziness w/cust_main/Location.pm + +use Carp qw(carp); + +my $init = 0; +BEGIN { + # set up accessors for location fields + if (!$init) { + no strict 'refs'; + @location_fields = + qw( address1 address2 city county state zip country district + latitude longitude coord_auto censustract censusyear geocode + addr_clean ); + + foreach my $f (@location_fields) { + *{"FS::prospect_main::$f"} = sub { + carp "WARNING: tried to set cust_main.$f with accessor" if (@_ > 1); + my @cust_location = shift->cust_location or return ''; + #arbitrarily picking the first because the UI only lets you add one + $cust_location[0]->$f + }; + } + $init++; + } +} + +#debugging shim--probably a performance hit, so remove this at some point +sub get { + my $self = shift; + my $field = shift; + if ( $DEBUG and grep { $_ eq $field } @location_fields ) { + carp "WARNING: tried to get() location field $field"; + $self->$field; + } + $self->FS::Record::get($field); +} + =head1 NAME FS::prospect_main - Object methods for prospect_main records @@ -208,6 +245,12 @@ sub check { ; return $error if $error; + my $company = $self->company; + $company =~ s/^\s+//; + $company =~ s/\s+$//; + $company =~ s/\s+/ /g; + $self->company($company); + $self->SUPER::check; } diff --git a/FS/FS/quotation.pm b/FS/FS/quotation.pm index bf2711b0a..47f13e6dc 100644 --- a/FS/FS/quotation.pm +++ b/FS/FS/quotation.pm @@ -176,6 +176,36 @@ sub _total { } +#prevent things from falsely showing up as taxes, at least until we support +# quoting tax amounts.. +sub _items_tax { + return (); +} +sub _items_nontax { + shift->cust_bill_pkg; +} + +sub _items_total { + my( $self, $total_items ) = @_; + + if ( $self->total_setup > 0 ) { + push @$total_items, { + 'total_item' => $self->mt( $self->total_recur > 0 ? 'Total Setup' : 'Total' ), + 'total_amount' => $self->total_setup, + }; + } + + #could/should add up the different recurring frequencies on lines of their own + # but this will cover the 95% cases for now + if ( $self->total_recur > 0 ) { + push @$total_items, { + 'total_item' => $self->mt('Total Recurring'), + 'total_amount' => $self->total_recur, + }; + } + +} + =item enable_previous =cut diff --git a/FS/FS/quotation_pkg.pm b/FS/FS/quotation_pkg.pm index 3d40bb03a..efff9683f 100644 --- a/FS/FS/quotation_pkg.pm +++ b/FS/FS/quotation_pkg.pm @@ -1,10 +1,12 @@ package FS::quotation_pkg; use strict; -use base qw( FS::Record ); +use base qw( FS::TemplateItem_Mixin FS::Record ); use FS::Record qw( qsearchs ); #qsearch use FS::part_pkg; use FS::cust_location; +use FS::quotation; +use FS::quotation_pkg_discount; #so its loaded when TemplateItem_Mixin needs it =head1 NAME @@ -80,6 +82,14 @@ points to. You can ask the object for a copy with the I<hash> method. sub table { 'quotation_pkg'; } +sub display_table { 'quotation_pkg'; } + +#forget it, just overriding cust_bill_pkg_display entirely +#sub display_table_orderby { 'quotationpkgnum'; } # something else? +# # (for invoice display order) + +sub discount_table { 'quotation_pkg_discount'; } + =item insert Adds this record to the database. If there is an error, returns the error, @@ -107,8 +117,9 @@ sub check { my $error = $self->ut_numbern('quotationpkgnum') - || $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' ) - || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum' ) + || $self->ut_foreign_key( 'quotationnum', 'quotation', 'quotationnum' ) + || $self->ut_foreign_key( 'pkgpart', 'part_pkg', 'pkgpart' ) + || $self->ut_foreign_keyn( 'locationnum', 'cust_location', 'locationnum' ) || $self->ut_numbern('start_date') || $self->ut_numbern('contract_end') || $self->ut_numbern('quantity') @@ -131,7 +142,7 @@ sub desc { sub setup { my $self = shift; - return '0.00' if $self->waive_setup eq 'Y'; + return '0.00' if $self->waive_setup eq 'Y' || $self->{'_NO_SETUP_KLUDGE'}; my $part_pkg = $self->part_pkg; #my $setup = $part_pkg->can('base_setup') ? $part_pkg->base_setup # : $part_pkg->option('setup_fee'); @@ -144,6 +155,7 @@ sub setup { sub recur { my $self = shift; + return '0.00' if $self->{'_NO_RECUR_KLUDGE'}; my $part_pkg = $self->part_pkg; my $recur = $part_pkg->can('base_recur') ? $part_pkg->base_recur : $part_pkg->option('recur_fee'); @@ -152,6 +164,43 @@ sub recur { sprintf('%.2f', $recur); } +=item cust_bill_pkg_display [ type => TYPE ] + +=cut + +sub cust_bill_pkg_display { + my ( $self, %opt ) = @_; + + my $type = $opt{type} if exists $opt{type}; + return () if $type eq 'U'; #quotations don't have usage + + if ( $self->get('display') ) { + return ( grep { defined($type) ? ($type eq $_->type) : 1 } + @{ $self->get('display') } + ); + } else { + + #?? + my $setup = $self->new($self->hashref); + $setup->{'_NO_RECUR_KLUDGE'} = 1; + $setup->{'type'} = 'S'; + my $recur = $self->new($self->hashref); + $recur->{'_NO_SETUP_KLUDGE'} = 1; + $recur->{'type'} = 'R'; + + if ( $type eq 'S' ) { + return ($setup); + } elsif ( $type eq 'R' ) { + return ($recur); + } else { + #return ($setup, $recur); + return ($self); + } + + } + +} + =back =head1 BUGS diff --git a/FS/FS/rate.pm b/FS/FS/rate.pm index a2511cf99..49ac938fd 100644 --- a/FS/FS/rate.pm +++ b/FS/FS/rate.pm @@ -308,17 +308,28 @@ sub dest_detail { #find a rate prefix, first look at most specific, then fewer digits, # finally trying the country code only my $rate_prefix = ''; - for my $len ( reverse(1..10) ) { - $rate_prefix = qsearchs('rate_prefix', { + $rate_prefix = qsearchs({ + 'table' => 'rate_prefix', + 'addl_from' => ' JOIN rate_region USING (regionnum)', + 'hashref' => { + 'countrycode' => $countrycode, + 'npa' => $phonenum, + }, + 'extra_sql' => ' AND exact_match = \'Y\'' + }); + if (!$rate_prefix) { + for my $len ( reverse(1..10) ) { + $rate_prefix = qsearchs('rate_prefix', { + 'countrycode' => $countrycode, + #'npa' => { op=> 'LIKE', value=> substr($number, 0, $len) } + 'npa' => substr($phonenum, 0, $len), + } ) and last; + } + $rate_prefix ||= qsearchs('rate_prefix', { 'countrycode' => $countrycode, - #'npa' => { op=> 'LIKE', value=> substr($number, 0, $len) } - 'npa' => substr($phonenum, 0, $len), - } ) and last; + 'npa' => '', + }); } - $rate_prefix ||= qsearchs('rate_prefix', { - 'countrycode' => $countrycode, - 'npa' => '', - }); return '' unless $rate_prefix; diff --git a/FS/FS/rate_region.pm b/FS/FS/rate_region.pm index f4a0ab196..d42fdb41e 100644 --- a/FS/FS/rate_region.pm +++ b/FS/FS/rate_region.pm @@ -36,7 +36,10 @@ inherits from FS::Record. The following fields are currently supported: =item regionnum - primary key -=item regionname +=item regionname - name of the region + +=item exact_match - 'Y' if "prefixes" in this region really represent +complete phone numbers. Null if they represent prefixes (the usual case). =back @@ -233,6 +236,7 @@ sub check { my $error = $self->ut_numbern('regionnum') || $self->ut_text('regionname') + || $self->ut_flag('exact_match') ; return $error if $error; diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm index a9a7d745d..e6b20db8f 100644 --- a/FS/FS/reason.pm +++ b/FS/FS/reason.pm @@ -139,6 +139,43 @@ sub reasontype { =back +=head1 CLASS METHODS + +=over 4 + +=item new_or_existing reason => REASON, type => TYPE, class => CLASS + +Fetches the reason matching these parameters if there is one. If not, +inserts one. Will also insert the reason type if necessary. CLASS must +be one of 'C' (cancel reasons), 'R' (credit reasons), or 'S' (suspend reasons). + +This will die if anything fails. + +=cut + +sub new_or_existing { + my $class = shift; + my %opt = @_; + + my $error = ''; + my %hash = ('class' => $opt{'class'}, 'type' => $opt{'type'}); + my $reason_type = qsearchs('reason_type', \%hash) + || FS::reason_type->new(\%hash); + + $error = $reason_type->insert unless $reason_type->typenum; + die "error inserting reason type: $error\n" if $error; + + %hash = ('reason_type' => $reason_type->typenum, 'reason' => $opt{'reason'}); + my $reason = qsearchs('reason', \%hash) + || FS::reason->new(\%hash); + + $error = $reason->insert unless $reason->reasonnum; + die "error inserting reason: $error\n" if $error; + + $reason; +} + + =head1 BUGS Here by termintes. Don't use on wooden computers. diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index 7aede54a6..0aea4559b 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -43,27 +43,6 @@ inherit from, i.e. FS::svc_acct. FS::svc_Common inherits from FS::Record. =over 4 -=item search_sql_field FIELD STRING - -Class method which returns an SQL fragment to search for STRING in FIELD. - -It is now case-insensitive by default. - -=cut - -sub search_sql_field { - my( $class, $field, $string ) = @_; - my $table = $class->table; - my $q_string = dbh->quote($string); - "LOWER($table.$field) = LOWER($q_string)"; -} - -#fallback for services that don't provide a search... -sub search_sql { - #my( $class, $string ) = @_; - '1 = 0'; #false -} - =item new =cut @@ -863,13 +842,20 @@ sub set_auto_inventory { next if $columnflag eq 'A' && $self->$field() ne ''; my $classnum = $part_svc_column->columnvalue; - my %hash = ( 'classnum' => $classnum ); + my %hash; if ( $columnflag eq 'A' && $self->$field() eq '' ) { $hash{'svcnum'} = ''; } elsif ( $columnflag eq 'M' ) { return "Select inventory item for $field" unless $self->getfield($field); $hash{'item'} = $self->getfield($field); + my $chosen_classnum = $self->getfield($field.'_classnum'); + if ( grep {$_ == $chosen_classnum} split(',', $classnum) ) { + $classnum = $chosen_classnum; + } + # otherwise the chosen classnum is either (all), or somehow not on + # the list, so ignore it and choose the first item that's in any + # class on the list } my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql( @@ -880,18 +866,30 @@ sub set_auto_inventory { my $inventory_item = qsearchs({ 'table' => 'inventory_item', 'hashref' => \%hash, - 'extra_sql' => "AND $agentnums_sql", + 'extra_sql' => "AND classnum IN ($classnum) AND $agentnums_sql", 'order_by' => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first ' LIMIT 1 FOR UPDATE', }); unless ( $inventory_item ) { + # should really only be shown if columnflag eq 'A'... $dbh->rollback if $oldAutoCommit; - my $inventory_class = - qsearchs('inventory_class', { 'classnum' => $classnum } ); - return "Can't find inventory_class.classnum $classnum" - unless $inventory_class; - return "Out of ". PL_N($inventory_class->classname); + my $message = 'Out of '; + my @classnums = split(',', $classnum); + foreach ( @classnums ) { + my $class = FS::inventory_class->by_key($_) + or return "Can't find inventory_class.classnum $_"; + $message .= PL_N($class->classname); + if ( scalar(@classnums) > 2 ) { # english is hard + if ( $_ != $classnums[-1] ) { + $message .= ', '; + } + } + if ( scalar(@classnums) > 1 and $_ == $classnums[-2] ) { + $message .= 'and '; + } + } + return $message; } next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum; @@ -899,13 +897,14 @@ sub set_auto_inventory { $self->setfield( $field, $inventory_item->item ); #if $columnflag eq 'A' && $self->$field() eq ''; + # release the old inventory item, if there was one if ( $old && $old->$field() && $old->$field() ne $self->$field() ) { my $old_inv = qsearchs({ 'table' => 'inventory_item', - 'hashref' => { 'classnum' => $classnum, + 'hashref' => { 'svcnum' => $old->svcnum, }, - 'extra_sql' => ' AND '. + 'extra_sql' => "AND classnum IN ($classnum) AND ". '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'. ' OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'. ')', @@ -941,6 +940,9 @@ sub set_auto_inventory { =item return_inventory +Release all inventory items attached to this service's fields. Call +when unprovisioning the service. + =cut sub return_inventory { @@ -1082,17 +1084,22 @@ otherwise returns false. =cut -sub export_setstatus { - my( $self, @args ) = @_; - my $error = $self->export('setstatus', @args); +sub export_setstatus { shift->_export_setstatus_X('setstatus', @_) } +sub export_setstatus_listadd { shift->_export_setstatus_X('setstatus_listadd', @_) } +sub export_setstatus_listdel { shift->_export_setstatus_X('setstatus_listdel', @_) } +sub export_setstatus_vacationadd { shift->_export_setstatus_X('setstatus_vacationadd', @_) } +sub export_setstatus_vacationdel { shift->_export_setstatus_X('setstatus_vacationdel', @_) } + +sub _export_setstatus_X { + my( $self, $method, @args ) = @_; + my $error = $self->export($method, @args); if ( $error ) { - warn "error running export_setstatus: $error"; + warn "error running export_$method: $error"; return $error; } ''; } - =item export HOOK [ EXPORT_ARGS ] Runs the provided export hook (i.e. "suspend", "unsuspend") for this service. @@ -1277,6 +1284,221 @@ sub nms_ip_delete { #XXX not yet implemented } +=item search_sql_field FIELD STRING + +Class method which returns an SQL fragment to search for STRING in FIELD. + +It is now case-insensitive by default. + +=cut + +sub search_sql_field { + my( $class, $field, $string ) = @_; + my $table = $class->table; + my $q_string = dbh->quote($string); + "LOWER($table.$field) = LOWER($q_string)"; +} + +#fallback for services that don't provide a search... +sub search_sql { + #my( $class, $string ) = @_; + '1 = 0'; #false +} + +=item search HASHREF + +Class method which returns a qsearch hash expression to search for parameters +specified in HASHREF. + +Parameters: + +=over 4 + +=item unlinked - set to search for all unlinked services. Overrides all other options. + +=item agentnum + +=item custnum + +=item svcpart + +=item ip_addr + +=item pkgpart - arrayref + +=item routernum - arrayref + +=item sectornum - arrayref + +=item towernum - arrayref + +=item order_by + +=back + +=cut + +# svc_broadband::search should eventually use this instead +sub search { + my ($class, $params) = @_; + + my @from = ( + 'LEFT JOIN cust_svc USING ( svcnum )', + 'LEFT JOIN part_svc USING ( svcpart )', + 'LEFT JOIN cust_pkg USING ( pkgnum )', + FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'), + ); + + my @where = (); + + $class->_search_svc($params, \@from, \@where) if $class->can('_search_svc'); + +# # domain +# if ( $params->{'domain'} ) { +# my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } ); +# #preserve previous behavior & bubble up an error if $svc_domain not found? +# push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain; +# } +# +# # domsvc +# if ( $params->{'domsvc'} =~ /^(\d+)$/ ) { +# push @where, "domsvc = $1"; +# } + + #unlinked + push @where, 'pkgnum IS NULL' if $params->{'unlinked'}; + + #agentnum + if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) { + push @where, "cust_main.agentnum = $1"; + } + + #custnum + if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) { + push @where, "custnum = $1"; + } + + #customer status + if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) { + push @where, FS::cust_main->cust_status_sql . " = '$1'"; + } + + #customer balance + if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) { + my $balance = $1; + + my $age = ''; + if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) { + $age = time - 86400 * $1; + } + push @where, FS::cust_main->balance_date_sql($age) . " > $balance"; + } + + #payby + if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) { + my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} }; + push @where, 'payby IN ('. join(',', @payby ). ')'; + } + + #pkgpart + ##pkgpart, now properly untainted, can be arrayref + #for my $pkgpart ( $params->{'pkgpart'} ) { + # if ( ref $pkgpart ) { + # my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart ); + # push @where, "cust_pkg.pkgpart IN ($where)" if $where; + # } + # elsif ( $pkgpart =~ /^(\d+)$/ ) { + # push @where, "cust_pkg.pkgpart = $1"; + # } + #} + if ( $params->{'pkgpart'} ) { + my @pkgpart = ref( $params->{'pkgpart'} ) + ? @{ $params->{'pkgpart'} } + : $params->{'pkgpart'} + ? ( $params->{'pkgpart'} ) + : (); + @pkgpart = grep /^(\d+)$/, @pkgpart; + push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')' if @pkgpart; + } + + #svcnum + if ( $params->{'svcnum'} =~ /^(\d+)$/ ) { + push @where, "svcnum = $1"; + } + + # svcpart + if ( $params->{'svcpart'} ) { + my @svcpart = ref( $params->{'svcpart'} ) + ? @{ $params->{'svcpart'} } + : $params->{'svcpart'} + ? ( $params->{'svcpart'} ) + : (); + @svcpart = grep /^(\d+)$/, @svcpart; + push @where, 'svcpart IN ('. join(',', @svcpart ). ')' if @svcpart; + } + + if ( $params->{'exportnum'} =~ /^(\d+)$/ ) { + push @from, ' LEFT JOIN export_svc USING ( svcpart )'; + push @where, "exportnum = $1"; + } + +# # sector and tower +# my @where_sector = $class->tower_sector_sql($params); +# if ( @where_sector ) { +# push @where, @where_sector; +# push @from, ' LEFT JOIN tower_sector USING ( sectornum )'; +# } + + # here is the agent virtualization + #if ($params->{CurrentUser}) { + # my $access_user = + # qsearchs('access_user', { username => $params->{CurrentUser} }); + # + # if ($access_user) { + # push @where, $access_user->agentnums_sql('table'=>'cust_main'); + # }else{ + # push @where, "1=0"; + # } + #} else { + push @where, $FS::CurrentUser::CurrentUser->agentnums_sql( + 'table' => 'cust_main', + 'null_right' => 'View/link unlinked services', + ); + #} + + push @where, @{ $params->{'where'} } if $params->{'where'}; + + my $addl_from = join(' ', @from); + my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : ''; + + my $table = $class->table; + + my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql"; + #if ( keys %svc_X ) { + # $count_query .= ' WHERE '. + # join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}), + # keys %svc_X + # ); + #} + + { + 'table' => $table, + 'hashref' => {}, + 'select' => join(', ', + "$table.*", + 'part_svc.svc', + 'cust_main.custnum', + @{ $params->{'addl_select'} || [] }, + FS::UI::Web::cust_sql_fields($params->{'cust_fields'}), + ), + 'addl_from' => $addl_from, + 'extra_sql' => $extra_sql, + 'order_by' => $params->{'order_by'}, + 'count_query' => $count_query, + }; + +} + =back =head1 BUGS diff --git a/FS/FS/svc_IP_Mixin.pm b/FS/FS/svc_IP_Mixin.pm new file mode 100644 index 000000000..7eda7e02c --- /dev/null +++ b/FS/FS/svc_IP_Mixin.pm @@ -0,0 +1,123 @@ +package FS::svc_IP_Mixin; + +use strict; +use base 'FS::IP_Mixin'; +use FS::Record qw(qsearchs qsearch); + +=item addr_block + +Returns the address block assigned to this service. + +=item router + +Returns the router assigned to this service, if there is one. + +=cut + +#addr_block and router methods provided by FS::IP_Mixin + +=item NetAddr + +Returns the address as a L<NetAddr::IP> object. Use C<$svc->NetAddr->addr> +to put it into canonical string form. + +=cut + +sub NetAddr { + my $self = shift; + NetAddr::IP->new($self->ip_addr); +} + +=item ip_addr + +Wrapper for set/get on the IP address field. + +=cut + +sub ip_addr { + my $self = shift; + my $ip_field = $self->table_info->{'ip_field'} + or return ''; + if ( @_ ) { + $self->set($ip_field, @_); + } else { + $self->get($ip_field); + } +} + +=item allowed_routers + +Returns a list of L<FS::router> objects allowed on this service. + +=cut + +sub allowed_routers { + my $self = shift; + my $svcpart = $self->svcnum ? $self->cust_svc->svcpart : $self->svcpart; + my @r = map { $_->router } + qsearch('part_svc_router', { svcpart => $svcpart }); + + if ( $self->cust_main ) { + my $agentnum = $self->cust_main->agentnum; + return grep { !$_->agentnum or $_->agentnum == $agentnum } @r; + } else { + return @r; + } +} + +=item svc_ip_check + +Wrapper for C<ip_check> which also checks the validity of the router. + +=cut + +sub svc_ip_check { + my $self = shift; + my $error = $self->ip_check; + return $error if $error; + if ( my $router = $self->router ) { + if ( grep { $_->routernum eq $router->routernum } $self->allowed_routers ) { + return ''; + } else { + return 'Router '.$router->routername.' not available for this service'; + } + } + ''; +} + +sub _used_addresses { + my ($class, $block, $exclude) = @_; + my $ip_field = $class->table_info->{'ip_field'} + or return (); + # if the service doesn't have an ip_field, then it has no IP addresses + # in use, yes? + + my %hash = ( $ip_field => { op => '!=', value => '' } ); + #$hash{'blocknum'} = $block->blocknum if $block; + $hash{'svcnum'} = { op => '!=', value => $exclude->svcnum } if ref $exclude; + map { $_->NetAddr->addr } qsearch($class->table, \%hash); +} + +sub _is_used { + my ($class, $addr, $exclude) = @_; + my $ip_field = $class->table_info->{'ip_field'} + or return ''; + + my $svc = qsearchs($class->table, { $ip_field => $addr }) + or return ''; + + return '' if ( ref $exclude and $exclude->svcnum == $svc->svcnum ); + + my $cust_svc = $svc->cust_svc; + if ( $cust_svc ) { + my @label = $cust_svc->label; + # "svc_foo 1234 (Service Desc)" + # this should be enough to identify it without leaking customer + # names across agents + "$label[2] $label[3] ($label[0])"; + } else { + join(' ', $class->table, $svc->svcnum, '(unlinked service)'); + } +} + +1; diff --git a/FS/FS/svc_Radius_Mixin.pm b/FS/FS/svc_Radius_Mixin.pm index ac97eab58..544c7e958 100644 --- a/FS/FS/svc_Radius_Mixin.pm +++ b/FS/FS/svc_Radius_Mixin.pm @@ -68,7 +68,8 @@ sub replace { $old->usergroup; # make sure this is cached for exports - my $error = $new->process_m2m( + my $error = $new->check # make sure fixed fields are set before process_m2m + || $new->process_m2m( 'link_table' => 'radius_usergroup', 'target_table' => 'radius_group', 'params' => $new->usergroup, diff --git a/FS/FS/svc_Tower_Mixin.pm b/FS/FS/svc_Tower_Mixin.pm index 6adbc6f5e..3da07c1cd 100644 --- a/FS/FS/svc_Tower_Mixin.pm +++ b/FS/FS/svc_Tower_Mixin.pm @@ -27,12 +27,10 @@ towernum or sectornum can also contain 'none' to allow null values. =cut sub tower_sector_sql { - my $class = shift; - my $params = shift; - return '' unless keys %$params; - my $where = ''; + my( $class, $params ) = @_; + return () unless keys %$params; - my @where; + my @where = (); for my $field (qw(towernum sectornum)) { my $value = $params->{$field} or next; if ( ref $value and grep { $_ } @$value ) { diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 7ce79ae01..26d6e5b72 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -6,6 +6,7 @@ use base qw( FS::svc_Domain_Mixin FS::svc_CGPRule_Mixin FS::svc_Radius_Mixin FS::svc_Tower_Mixin + FS::svc_IP_Mixin FS::svc_Common ); use vars qw( $DEBUG $me $conf $skip_fuzzyfiles $dir_prefix @shells $usernamemin @@ -14,6 +15,7 @@ use vars qw( $DEBUG $me $conf $skip_fuzzyfiles $username_noperiod $username_nounderscore $username_nodash $username_uppercase $username_percent $username_colon $username_slash $username_equals $username_pound + $username_exclamation $password_noampersand $password_noexclamation $warning_template $warning_from $warning_subject $warning_mimetype $warning_cc @@ -84,6 +86,7 @@ FS::UID->install_callback( sub { $username_slash = $conf->exists('username-slash'); $username_equals = $conf->exists('username-equals'); $username_pound = $conf->exists('username-pound'); + $username_exclamation = $conf->exists('username-exclamation'); $password_noampersand = $conf->exists('password-noexclamation'); $password_noexclamation = $conf->exists('password-noexclamation'); $dirhash = $conf->config('dirhash') || 0; @@ -1126,6 +1129,8 @@ sub check { || $self->ut_foreign_key( 'domsvc', 'svc_domain', 'svcnum' ) || $self->ut_foreign_keyn('pbxsvc', 'svc_pbx', 'svcnum' ) || $self->ut_foreign_keyn('sectornum','tower_sector','sectornum') + || $self->ut_foreign_keyn('routernum','router','routernum') + || $self->ut_foreign_keyn('blocknum','addr_block','blocknum') || $self->ut_textn('sec_phrase') || $self->ut_snumbern('seconds') || $self->ut_snumbern('upbytes') @@ -1161,6 +1166,15 @@ sub check { ; return $error if $error; + # assign IP address, etc. + if ( $conf->exists('svc_acct-ip_addr') ) { + my $error = $self->svc_ip_check; + return $error if $error; + } else { # I think this is correct + $self->routernum(''); + $self->blocknum(''); + } + my $cust_pkg; local $username_letter = $username_letter; local $username_uppercase = $username_uppercase; @@ -1181,7 +1195,7 @@ sub check { my $ulen = $usernamemax || $self->dbdef_table->column('username')->length; - $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; @@ -1222,6 +1236,9 @@ sub check { unless ( $username_pound ) { $recref->{username} =~ /\#/ and return $uerror; } + unless ( $username_exclamation ) { + $recref->{username} =~ /\!/ and return $uerror; + } $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum}; @@ -1314,7 +1331,7 @@ sub check { unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) { if ( $recref->{slipip} eq '' ) { - $recref->{slipip} = ''; + $recref->{slipip} = ''; # eh? } elsif ( $recref->{slipip} eq '0e0' ) { $recref->{slipip} = '0e0'; } else { @@ -1322,7 +1339,6 @@ sub check { or return "Illegal slipip: ". $self->slipip; $recref->{slipip} = $1; } - } #arbitrary RADIUS stuff; allow ut_textn for now @@ -1384,6 +1400,7 @@ sub check { else { return "invalid password encoding ('".$recref->{_password_encoding}."'"; } + $self->SUPER::check; } @@ -1878,12 +1895,14 @@ sub email { $self->username. '@'. $self->domain(@_); } + =item acct_snarf Returns an array of FS::acct_snarf records associated with the account. =cut +# unused as originally intended, but now by Communigate Pro "RPOP" sub acct_snarf { my $self = shift; qsearch({ @@ -2805,116 +2824,39 @@ Arrayref of additional WHERE clauses, will be ANDed together. =cut -sub search { - my ($class, $params) = @_; +sub _search_svc { + my( $class, $params, $from, $where ) = @_; - my @from = ( - ' LEFT JOIN cust_svc USING ( svcnum ) ', - ' LEFT JOIN part_svc USING ( svcpart ) ', - ' LEFT JOIN cust_pkg USING ( pkgnum ) ', - ' LEFT JOIN cust_main USING ( custnum ) ', - ); - - my @where = (); + #these two should probably move to svc_Domain_Mixin ? # domain if ( $params->{'domain'} ) { my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } ); #preserve previous behavior & bubble up an error if $svc_domain not found? - push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain; + push @$where, 'domsvc = '. $svc_domain->svcnum if $svc_domain; } # domsvc if ( $params->{'domsvc'} =~ /^(\d+)$/ ) { - push @where, "domsvc = $1"; - } - - #unlinked - push @where, 'pkgnum IS NULL' if $params->{'unlinked'}; - - #agentnum - if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) { - push @where, "cust_main.agentnum = $1"; + push @$where, "domsvc = $1"; } - #custnum - if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) { - push @where, "custnum = $1"; - } - - #pkgpart - if ( $params->{'pkgpart'} && scalar(@{ $params->{'pkgpart'} }) ) { - #XXX untaint or sql quote - push @where, - 'cust_pkg.pkgpart IN ('. join(',', @{ $params->{'pkgpart'} } ). ')'; - } # popnum if ( $params->{'popnum'} =~ /^(\d+)$/ ) { - push @where, "popnum = $1"; + push @$where, "popnum = $1"; } - # svcpart - if ( $params->{'svcpart'} =~ /^(\d+)$/ ) { - push @where, "svcpart = $1"; - } - if ( $params->{'exportnum'} =~ /^(\d+)$/ ) { - push @from, ' LEFT JOIN export_svc USING ( svcpart )'; - push @where, "exportnum = $1"; - } + #and these in svc_Tower_Mixin, or maybe we never should have done svc_acct + # towers (or, as mark thought, never should have done svc_broadband) # sector and tower my @where_sector = $class->tower_sector_sql($params); if ( @where_sector ) { - push @where, @where_sector; - push @from, ' LEFT JOIN tower_sector USING ( sectornum )'; - } - - # here is the agent virtualization - #if ($params->{CurrentUser}) { - # my $access_user = - # qsearchs('access_user', { username => $params->{CurrentUser} }); - # - # if ($access_user) { - # push @where, $access_user->agentnums_sql('table'=>'cust_main'); - # }else{ - # push @where, "1=0"; - # } - #} else { - push @where, $FS::CurrentUser::CurrentUser->agentnums_sql( - 'table' => 'cust_main', - 'null_right' => 'View/link unlinked services', - ); - #} - - push @where, @{ $params->{'where'} } if $params->{'where'}; - - my $addl_from = join(' ', @from); - my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : ''; - - my $count_query = "SELECT COUNT(*) FROM svc_acct $addl_from $extra_sql"; - #if ( keys %svc_acct ) { - # $count_query .= ' WHERE '. - # join(' AND ', map "$_ = ". dbh->quote($svc_acct{$_}), - # keys %svc_acct - # ); - #} - - my $sql_query = { - 'table' => 'svc_acct', - 'hashref' => {}, # \%svc_acct, - 'select' => join(', ', - 'svc_acct.*', - 'part_svc.svc', - 'cust_main.custnum', - FS::UI::Web::cust_sql_fields($params->{'cust_fields'}), - ), - 'addl_from' => $addl_from, - 'extra_sql' => $extra_sql, - 'order_by' => $params->{'order_by'}, - 'count_query' => $count_query, - }; + push @$where, @where_sector; + push @$from, ' LEFT JOIN tower_sector USING ( sectornum )'; + } } diff --git a/FS/FS/svc_broadband.pm b/FS/FS/svc_broadband.pm index 26659d52a..b5012caa3 100755 --- a/FS/FS/svc_broadband.pm +++ b/FS/FS/svc_broadband.pm @@ -1,5 +1,10 @@ package FS::svc_broadband; -use base qw(FS::svc_Radius_Mixin FS::svc_Tower_Mixin FS::svc_Common); +use base qw( + FS::svc_Radius_Mixin + FS::svc_Tower_Mixin + FS::svc_IP_Mixin + FS::svc_Common + ); use strict; use vars qw($conf); @@ -98,10 +103,10 @@ sub table_info { 'ip_field' => 'ip_addr', 'fields' => { 'svcnum' => 'Service', - 'description' => 'Descriptive label for this particular device', - 'speed_down' => 'Maximum download speed for this service in Kbps. 0 denotes unlimited.', - 'speed_up' => 'Maximum upload speed for this service in Kbps. 0 denotes unlimited.', - 'ip_addr' => 'IP address. Leave blank for automatic assignment.', + 'description' => 'Descriptive label', + 'speed_down' => 'Download speed (Kbps)', + 'speed_up' => 'Upload speed (Kbps)', + 'ip_addr' => 'IP address', 'blocknum' => { 'label' => 'Address block', 'type' => 'select', @@ -129,6 +134,15 @@ sub table_info { disable_inventory => 1, multiple => 1, }, + 'radio_serialnum' => 'Radio Serial Number', + 'radio_location' => 'Radio Location', + 'poe_location' => 'POE Location', + 'rssi' => 'RSSI', + 'suid' => 'SUID', + 'shared_svcnum' => { label => 'Shared Service', + type => 'search-svc_broadband', + disable_inventory => 1, + }, }, }; } @@ -170,115 +184,44 @@ Parameters: =cut -sub search { - my ($class, $params) = @_; - my @where = (); - my @from = ( - 'LEFT JOIN cust_svc USING ( svcnum )', - 'LEFT JOIN part_svc USING ( svcpart )', - 'LEFT JOIN cust_pkg USING ( pkgnum )', - 'LEFT JOIN cust_main USING ( custnum )', - ); - - # based on FS::svc_acct::search, probably the most mature of the bunch - #unlinked - push @where, 'pkgnum IS NULL' if $params->{'unlinked'}; - - #agentnum - if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) { - push @where, "cust_main.agentnum = $1"; - } - push @where, $FS::CurrentUser::CurrentUser->agentnums_sql( - 'null_right' => 'View/link unlinked services', - 'table' => 'cust_main' - ); - - #custnum - if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) { - push @where, "custnum = $1"; - } - - #pkgpart, now properly untainted, can be arrayref - for my $pkgpart ( $params->{'pkgpart'} ) { - if ( ref $pkgpart ) { - my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart ); - push @where, "cust_pkg.pkgpart IN ($where)" if $where; - } - elsif ( $pkgpart =~ /^(\d+)$/ ) { - push @where, "cust_pkg.pkgpart = $1"; - } - } +sub _search_svc { + my( $class, $params, $from, $where ) = @_; #routernum, can be arrayref for my $routernum ( $params->{'routernum'} ) { # this no longer uses addr_block if ( ref $routernum and grep { $_ } @$routernum ) { my $in = join(',', map { /^(\d+)$/ ? $1 : () } @$routernum ); - my @orwhere; + my @orwhere = (); push @orwhere, "svc_broadband.routernum IN ($in)" if $in; push @orwhere, "svc_broadband.routernum IS NULL" if grep /^none$/, @$routernum; - push @where, '( '.join(' OR ', @orwhere).' )'; + push @$where, '( '.join(' OR ', @orwhere).' )'; } elsif ( $routernum =~ /^(\d+)$/ ) { - push @where, "svc_broadband.routernum = $1"; + push @$where, "svc_broadband.routernum = $1"; } elsif ( $routernum eq 'none' ) { - push @where, "svc_broadband.routernum IS NULL"; + push @$where, "svc_broadband.routernum IS NULL"; } } + #this should probably move to svc_Tower_Mixin, or maybe we never should have + # done svc_acct # towers (or, as mark thought, never should have done + # svc_broadband) + #sector and tower, as above my @where_sector = $class->tower_sector_sql($params); if ( @where_sector ) { - push @where, @where_sector; - push @from, 'LEFT JOIN tower_sector USING ( sectornum )'; + push @$where, @where_sector; + push @$from, 'LEFT JOIN tower_sector USING ( sectornum )'; } - #svcnum - if ( $params->{'svcnum'} =~ /^(\d+)$/ ) { - push @where, "svcnum = $1"; - } - - #svcpart - if ( $params->{'svcpart'} =~ /^(\d+)$/ ) { - push @where, "svcpart = $1"; - } - - #exportnum - if ( $params->{'exportnum'} =~ /^(\d+)$/ ) { - push @from, 'LEFT JOIN export_svc USING ( svcpart )'; - push @where, "exportnum = $1"; - } - #ip_addr if ( $params->{'ip_addr'} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ ) { - push @where, "ip_addr = '$1'"; + push @$where, "ip_addr = '$1'"; } - #custnum - if ( $params->{'custnum'} =~ /^(\d+)$/ and $1) { - push @where, "custnum = $1"; - } - - my $addl_from = join(' ', @from); - my $extra_sql = ''; - $extra_sql = 'WHERE '.join(' AND ', @where) if @where; - my $count_query = "SELECT COUNT(*) FROM svc_broadband $addl_from $extra_sql"; - return( { - 'table' => 'svc_broadband', - 'hashref' => {}, - 'select' => join(', ', - 'svc_broadband.*', - 'part_svc.svc', - 'cust_main.custnum', - FS::UI::Web::cust_sql_fields($params->{'cust_fields'}), - ), - 'extra_sql' => $extra_sql, - 'addl_from' => $addl_from, - 'order_by' => "ORDER BY ".($params->{'order_by'} || 'svcnum'), - 'count_query' => $count_query, - } ); } =item search_sql STRING @@ -291,15 +234,31 @@ sub search_sql { my( $class, $string ) = @_; if ( $string =~ /^(\d{1,3}\.){3}\d{1,3}$/ ) { $class->search_sql_field('ip_addr', $string ); - }elsif ( $string =~ /^([a-fA-F0-9]{12})$/ ) { + } elsif ( $string =~ /^([a-fA-F0-9]{12})$/ ) { $class->search_sql_field('mac_addr', uc($string)); - }elsif ( $string =~ /^(([a-fA-F0-9]{1,2}:){5}([a-fA-F0-9]{1,2}))$/ ) { + } elsif ( $string =~ /^(([a-fA-F0-9]{1,2}:){5}([a-fA-F0-9]{1,2}))$/ ) { $class->search_sql_field('mac_addr', uc("$2$3$4$5$6$7") ); + } elsif ( $string =~ /^(\d+)$/ ) { + my $table = $class->table; + "$table.svcnum = $1"; } else { '1 = 0'; #false } } +=item smart_search STRING + +=cut + +sub smart_search { + my( $class, $string ) = @_; + qsearch({ + 'table' => $class->table, #'svc_broadband', + 'hashref' => {}, + 'extra_sql' => 'WHERE '. $class->search_sql($string), + }); +} + =item label Returns the IP address. @@ -308,7 +267,12 @@ Returns the IP address. sub label { my $self = shift; - $self->ip_addr; + my $label = 'IP:'. ($self->ip_addr || 'Unknown'); + $label .= ', MAC:'. $self->mac_addr + if $self->mac_addr; + $label .= ' ('. $self->description. ')' + if $self->description; + return $label; } =item insert [ , OPTION => VALUE ... ] @@ -372,7 +336,7 @@ sub check { # remove delimiters my $mac_addr = uc($self->get('mac_addr')); - $mac_addr =~ s/[-: ]//g; + $mac_addr =~ s/[\W_]//g; $self->set('mac_addr', $mac_addr); my $error = @@ -391,6 +355,12 @@ sub check { || $self->ut_sfloatn('altitude') || $self->ut_textn('vlan_profile') || $self->ut_textn('plan_id') + || $self->ut_alphan('radio_serialnum') + || $self->ut_textn('radio_location') + || $self->ut_textn('poe_location') + || $self->ut_snumbern('rssi') + || $self->ut_numbern('suid') + || $self->ut_foreign_keyn('shared_svcnum', 'svc_broadband', 'svcnum') ; return $error if $error; @@ -412,38 +382,13 @@ sub check { } my $agentnum = $cust_pkg->cust_main->agentnum if $cust_pkg; - if ( $conf->exists('auto_router') and $self->ip_addr and !$self->routernum ) { - # assign_router is guaranteed to provide a router that's legal - # for this agent and svcpart - my $error = $self->_check_ip_addr || $self->assign_router; - return $error if $error; + # assign IP address / router / block + $error = $self->svc_ip_check; + return $error if $error; + if ( !$self->ip_addr + and !$conf->exists('svc_broadband-allow_null_ip_addr') ) { + return 'IP address is required'; } - elsif ($self->routernum) { - return "Router ".$self->routernum." does not provide this service" - unless qsearchs('part_svc_router', { - svcpart => $svcpart, - routernum => $self->routernum - }); - - my $router = $self->router; - return "Router ".$self->routernum." does not serve this customer" - if $router->agentnum and $agentnum and $router->agentnum != $agentnum; - - if ( $router->manual_addr ) { - $self->blocknum(''); - } - else { - my $addr_block = $self->addr_block; - if ( $self->ip_addr eq '' - and not ( $addr_block and $addr_block->manual_flag ) ) { - my $error = $self->assign_ip_addr; - return $error if $error; - } - } - - my $error = $self->_check_ip_addr; - return $error if $error; - } # if $self->routernum if ( $cust_pkg && ! $self->latitude && ! $self->longitude ) { my $l = $cust_pkg->cust_location_or_main; @@ -459,104 +404,12 @@ sub check { $self->SUPER::check; } -=item assign_ip_addr - -Assign an IP address matching the selected router, and the selected block -if there is one. - -=cut - -sub assign_ip_addr { - my $self = shift; - my @blocks; - my $ip_addr; - - if ( $self->addr_block and $self->addr_block->routernum == $self->routernum ) { - # simple case: user chose a block, find an address in that block - # (this overrides an existing IP address if it's not in the block) - @blocks = ($self->addr_block); - } - elsif ( $self->routernum ) { - @blocks = $self->router->auto_addr_block; - } - else { - return ''; - } -#warn "assigning ip address in blocks\n".join("\n",map{$_->cidr} @blocks)."\n"; - - foreach my $block ( @blocks ) { - if ( $self->ip_addr and $block->NetAddr->contains($self->NetAddr) ) { - # don't change anything - return ''; - } - $ip_addr = $block->next_free_addr; - if ( $ip_addr ) { - $self->set(ip_addr => $ip_addr->addr); - $self->set(blocknum => $block->blocknum); - return ''; - } - } - return 'No IP address available on this router'; -} - -=item assign_router - -Assign an address block and router matching the selected IP address. -Does nothing if IP address is null. - -=cut - -sub assign_router { - my $self = shift; - return '' if !$self->ip_addr; - #warn "assigning router/block for ".$self->ip_addr."\n"; - foreach my $router ($self->allowed_routers) { - foreach my $block ($router->addr_block) { - if ( $block->NetAddr->contains($self->NetAddr) ) { - $self->blocknum($block->blocknum); - $self->routernum($block->routernum); - return ''; - } - } - } - return $self->ip_addr.' is not in an allowed block.'; -} - -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'); - return 'IP address required'; - } - else { - return 'Cannot parse address: '.$self->ip_addr unless $self->NetAddr; - } - - if ( $self->addr_block - and not $self->addr_block->NetAddr->contains($self->NetAddr) ) { - return 'Address '.$self->ip_addr.' not in block '.$self->addr_block->cidr; - } - -# if (my $dup = qsearchs('svc_broadband', { -# ip_addr => $self->ip_addr, -# svcnum => {op=>'!=', value => $self->svcnum} -# }) ) { -# return 'IP address conflicts with svcnum '.$dup->svcnum; -# } - ''; -} - sub _check_duplicate { my $self = shift; # Not a reliable check because the table isn't locked, but # that's why we have a unique index. This is just to give a # friendlier error message. my @dup; - @dup = $self->find_duplicates('global', 'ip_addr'); - if ( @dup ) { - return "IP address in use (svcnum ".$dup[0]->svcnum.")"; - } @dup = $self->find_duplicates('global', 'mac_addr'); if ( @dup ) { return "MAC address in use (svcnum ".$dup[0]->svcnum.")"; @@ -565,64 +418,6 @@ sub _check_duplicate { ''; } - -=item NetAddr - -Returns a NetAddr::IP object containing the IP address of this service. The netmask -is /32. - -=cut - -sub NetAddr { - my $self = shift; - new NetAddr::IP ($self->ip_addr); -} - -=item addr_block - -Returns the FS::addr_block record (i.e. the address block) for this broadband service. - -=cut - -sub addr_block { - my $self = shift; - qsearchs('addr_block', { blocknum => $self->blocknum }); -} - -=item router - -Returns the FS::router record for this service. - -=cut - -sub router { - my $self = shift; - qsearchs('router', { routernum => $self->routernum }); -} - -=item allowed_routers - -Returns a list of allowed FS::router objects. - -=cut - -sub allowed_routers { - my $self = shift; - my $svcpart = $self->svcnum ? $self->cust_svc->svcpart : $self->svcpart; - my @r = map { $_->router } qsearch('part_svc_router', - { svcpart => $svcpart }); - if ( $self->cust_main ) { - my $agentnum = $self->cust_main->agentnum; - return grep { !$_->agentnum or $_->agentnum == $agentnum } @r; - } - else { - return @r; - } -} - -=back - - =item mac_addr_formatted CASE DELIMITER Format the MAC address (for use by exports). If CASE starts with "l" @@ -645,6 +440,11 @@ sub _upgrade_data { local($FS::svc_Common::noexport_hack) = 1; + # fix wrong-case MAC addresses + my $dbh = dbh; + $dbh->do('UPDATE svc_broadband SET mac_addr = UPPER(mac_addr);') + or die $dbh->errstr; + # set routernum to addr_block.routernum foreach my $self (qsearch('svc_broadband', { blocknum => {op => '!=', value => ''}, diff --git a/FS/FS/svc_cable.pm b/FS/FS/svc_cable.pm new file mode 100644 index 000000000..f588f43c3 --- /dev/null +++ b/FS/FS/svc_cable.pm @@ -0,0 +1,114 @@ +package FS::svc_cable; +use base qw( FS::device_Common FS::svc_Common ); + +use strict; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); + +=head1 NAME + +FS::svc_cable - Object methods for svc_cable records + +=head1 SYNOPSIS + + use FS::svc_cable; + + $record = new FS::svc_cable \%hash; + $record = new FS::svc_cable { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::svc_cable object represents a cable subscriber. FS::svc_cable inherits +from FS::Record. The following fields are currently supported: + +=over 4 + +=item svcnum + +primary key + +=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 { 'svc_cable'; } + +sub table_info { + { + 'name' => 'Cable Subscriber', + #'name_plural' => '', #optional, + #'longname_plural' => '', #optional + 'sorts' => [ 'svcnum', ], #, 'serviceid' ], # optional sort field (or arrayref of sort fields, main first) + 'display_weight' => 54, + 'cancel_weight' => 70, #? no deps, so + 'fields' => { + 'svcnum' => 'Service', + 'identifier' => 'Identifier', + }, + }; +} + +=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 + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('svcnum') + ; + 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/svc_export_machine.pm b/FS/FS/svc_export_machine.pm index 10f7b6821..7ca20ccb6 100644 --- a/FS/FS/svc_export_machine.pm +++ b/FS/FS/svc_export_machine.pm @@ -40,6 +40,10 @@ fields are currently supported: primary key +=item exportnum + +Export definition, see L<FS::part_export> + =item svcnum Customer service, see L<FS::cust_svc> diff --git a/FS/FS/svc_hardware.pm b/FS/FS/svc_hardware.pm index af6865f12..b28cc9ef5 100644 --- a/FS/FS/svc_hardware.pm +++ b/FS/FS/svc_hardware.pm @@ -105,9 +105,13 @@ sub search_sql { my ($class, $string) = @_; my @where = (); - my $ip = NetAddr::IP->new($string); - if ( $ip ) { - push @where, $class->search_sql_field('ip_addr', $ip->addr); + if ( $string =~ /^[\d\.:]+$/ ) { + # if the string isn't an IP address, this will waste several seconds + # attempting a DNS lookup. so try to filter those out. + my $ip = NetAddr::IP->new($string); + if ( $ip ) { + push @where, $class->search_sql_field('ip_addr', $ip->addr); + } } if ( $string =~ /^(\w+)$/ ) { @@ -164,7 +168,7 @@ sub check { return $x unless ref $x; my $hw_addr = $self->getfield('hw_addr'); - $hw_addr = join('', split(/\W/, $hw_addr)); + $hw_addr = join('', split(/[_\W]/, $hw_addr)); if ( $conf->exists('svc_hardware-check_mac_addr') ) { $hw_addr = uc($hw_addr); $hw_addr =~ /^[0-9A-F]{12}$/ diff --git a/FS/FS/svc_pbx.pm b/FS/FS/svc_pbx.pm index 4182a1315..66e51da71 100644 --- a/FS/FS/svc_pbx.pm +++ b/FS/FS/svc_pbx.pm @@ -292,7 +292,9 @@ to allow title to indicate a range of IP addresses. =item begin, end: Start and end of date range, as unix timestamp. -=item cdrtypenum: Only return CDRs with this type number. +=item cdrtypenum: Only return CDRs with this type. + +=item calltypenum: Only return CDRs with this call type. =back @@ -310,6 +312,9 @@ sub psearch_cdrs { if ($options{'cdrtypenum'}) { $hash{'cdrtypenum'} = $options{'cdrtypenum'}; } + if ($options{'calltypenum'}) { + $hash{'calltypenum'} = $options{'calltypenum'}; + } my $for_update = $options{'for_update'} ? 'FOR UPDATE' : ''; diff --git a/FS/FS/svc_phone.pm b/FS/FS/svc_phone.pm index 1296c1e85..65a98d25a 100644 --- a/FS/FS/svc_phone.pm +++ b/FS/FS/svc_phone.pm @@ -23,10 +23,11 @@ $DEBUG = 0; @pw_set = ( 'a'..'k', 'm','n', 'p-z', 'A'..'N', 'P'..'Z' , '2'..'9' ); #ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::svc_acct'} = sub { +FS::UID->install_callback( sub { $conf = new FS::Conf; $phone_name_max = $conf->config('svc_phone-phone_name-max_length'); -}; +} +); =head1 NAME @@ -68,6 +69,10 @@ primary key =item phonenum +=item sim_imsi + +SIM IMSI (http://en.wikipedia.org/wiki/International_mobile_subscriber_identity) + =item sip_password =item pin @@ -147,6 +152,7 @@ sub table_info { disable_select => 1, }, 'phonenum' => 'Phone number', + 'sim_imsi' => 'IMSI', #http://en.wikipedia.org/wiki/International_mobile_subscriber_identity 'pin' => { label => 'Voicemail PIN', #'Personal Identification Number', type => 'text', disable_inventory => 1, @@ -167,6 +173,15 @@ sub table_info { select_label => 'domain', disable_inventory => 1, }, + 'sms_carrierid' => { label => 'SMS Carrier', + type => 'select', + select_table => 'cdr_carrier', + select_key => 'carrierid', + select_label => 'carriername', + disable_inventory => 1, + }, + 'sms_account' => { label => 'SMS Carrier Account', }, + 'max_simultaneous' => { label=>'Maximum number of simultaneous users' }, 'locationnum' => { label => 'E911 location', disable_inventory => 1, @@ -282,9 +297,8 @@ sub insert { #false laziness w/cust_pkg.pm... move this to location_Mixin? that would #make it more of a base class than a mixin... :) - if ( $options{'cust_location'} - && ( ! $self->locationnum || $self->locationnum == -1 ) ) { - my $error = $options{'cust_location'}->insert; + if ( $options{'cust_location'} ) { + my $error = $options{'cust_location'}->find_or_insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "inserting cust_location (transaction rolled back): $error"; @@ -353,8 +367,6 @@ sub delete { } -# 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, @@ -466,11 +478,15 @@ sub check { $self->ut_numbern('svcnum') || $self->ut_numbern('countrycode') || $self->$phonenum_check_method('phonenum') + || $self->ut_numbern('sim_imsi') || $self->ut_anything('sip_password') || $self->ut_numbern('pin') || $self->ut_textn('phone_name') || $self->ut_foreign_keyn('pbxsvc', 'svc_pbx', 'svcnum' ) || $self->ut_foreign_keyn('domsvc', 'svc_domain', 'svcnum' ) + || $self->ut_foreign_keyn('sms_carrierid', 'cdr_carrier', 'carrierid' ) + || $self->ut_alphan('sms_account') + || $self->ut_numbern('max_simultaneous') || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum') || $self->ut_numbern('forwarddst') || $self->ut_textn('email') @@ -486,6 +502,10 @@ sub check { ; return $error if $error; + return 'Illegal IMSI (not 14-15 digits)' #shorter? + if length($self->sim_imsi) + && ( length($self->sim_imsi) < 14 || length($self->sim_imsi) > 15 ); + # LNP data validation return 'Cannot set LNP fields: no LNP in progress' if ( ($self->lnp_desired_due_date || $self->lnp_due_date @@ -627,6 +647,26 @@ sub radius_groups { (); } +=item sms_cdr_carrier + +=cut + +sub sms_cdr_carrier { + my $self = shift; + return '' unless $self->sms_carrierid; + qsearchs('cdr_carrier', { 'carrierid' => $self->sms_carrierid } ); +} + +=item sms_carriername + +=cut + +sub sms_carriername { + my $self = shift; + my $cdr_carrier = $self->sms_cdr_carrier or return ''; + $cdr_carrier->carriername; +} + =item phone_device Returns any FS::phone_device records associated with this service. @@ -673,10 +713,14 @@ with the chosen prefix. =item begin, end: Start and end of a date range, as unix timestamp. -=item cdrtypenum: Only return CDRs with this type number. +=item cdrtypenum: Only return CDRs with this type. + +=item calltypenum: Only return CDRs with this call type. =item disable_src => 1: Only match on "charged_party", not "src". +=item nonzero: Only return CDRs where duration > 0. + =item by_svcnum: not supported for svc_phone =item billsec_sum: Instead of returning all of the CDRs, return a single @@ -722,6 +766,9 @@ sub psearch_cdrs { if ($options{'cdrtypenum'}) { $hash{'cdrtypenum'} = $options{'cdrtypenum'}; } + if ($options{'calltypenum'}) { + $hash{'calltypenum'} = $options{'calltypenum'}; + } my $for_update = $options{'for_update'} ? 'FOR UPDATE' : ''; @@ -744,6 +791,9 @@ sub psearch_cdrs { if ( $options{'end'} ) { push @where, 'startdate < '. $options{'end'}; } + if ( $options{'nonzero'} ) { + push @where, 'duration > 0'; + } my $extra_sql = ( keys(%hash) ? ' AND ' : ' WHERE ' ). join(' AND ', @where ); @@ -770,6 +820,30 @@ sub get_cdrs { qsearch ( $psearch->{query} ) } +=item sum_cdrs + +Takes the same options as psearch_cdrs, but returns a single row containing +"count" (the number of CDRs) and the sums of the following fields: duration, +billsec, rated_price, rated_seconds, rated_minutes. + +Note that if any calls are not rated, their rated_* fields will be null. +If you want to use those fields, pass the 'status' option to limit to +calls that have been rated. This is intentional; please don't "fix" it. + +=cut + +sub sum_cdrs { + my $self = shift; + my $psearch = $self->psearch_cdrs(@_); + $psearch->{query}->{'select'} = join(',', + 'COUNT(*) AS count', + map { "SUM($_) AS $_" } + qw(duration billsec rated_price rated_seconds rated_minutes) + ); + # hack + $psearch->{query}->{'extra_sql'} =~ s/ ORDER BY.*$//; + qsearchs ( $psearch->{query} ); +} =back diff --git a/FS/FS/tax_class.pm b/FS/FS/tax_class.pm index bfec2c06c..d68e7e30c 100644 --- a/FS/FS/tax_class.pm +++ b/FS/FS/tax_class.pm @@ -5,6 +5,8 @@ use vars qw( @ISA ); use FS::UID qw(dbh); use FS::Record qw( qsearch qsearchs ); use FS::Misc qw( csv_from_fixed ); +use FS::part_pkg_taxrate; +use FS::part_pkg_taxoverride; @ISA = qw(FS::Record); @@ -83,20 +85,53 @@ Delete this record from the database. sub delete { my $self = shift; - return "Can't delete a tax class which has tax rates!" - if qsearch( 'tax_rate', { 'taxclassnum' => $self->taxclassnum } ); - - return "Can't delete a tax class which has package tax rates!" - if qsearch( 'part_pkg_taxrate', { 'taxclassnum' => $self->taxclassnum } ); - return "Can't delete a tax class which has package tax rates!" if qsearch( 'part_pkg_taxrate', { 'taxclassnumtaxed' => $self->taxclassnum } ); return "Can't delete a tax class which has package tax overrides!" if qsearch( 'part_pkg_taxoverride', { 'taxclassnum' => $self->taxclassnum } ); - $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 $tax_rate ( + qsearch( 'tax_rate', { taxclassnum=>$self->taxclassnum } ) + ) { + my $error = $tax_rate->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + foreach my $part_pkg_taxrate ( + qsearch( 'part_pkg_taxrate', { taxclassnum=>$self->taxclassnum } ) + ) { + my $error = $part_pkg_taxrate->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 @@ -253,14 +288,23 @@ sub batch_import { } } - my $tax_class = - new FS::tax_class( { 'data_vendor' => 'cch', - 'taxclass' => $type->[0].':'.$cat->[0], - 'description' => $type->[1].':'.$cat->[1], - } ); - my $error = $tax_class->insert; - return $error if $error; + my %hash = ( 'data_vendor' => 'cch', + 'taxclass' => $type->[0].':'.$cat->[0], + 'description' => $type->[1].':'.$cat->[1], + ); + unless ( qsearchs('tax_class', \%hash) ) { + my $tax_class = new FS::tax_class \%hash; + my $error = $tax_class->insert; + + return "can't insert tax_class for ". + " old TAXTYPE ". $type->[0].':'.$type->[1]. + " and new TAXCAT ". $cat->[0].':'. $cat->[1]. + " : $error" + if $error; + } + $imported++; + } } @@ -283,7 +327,7 @@ sub batch_import { 'description' => $type->[1].':'.$cat->[1], } ); my $error = $tax_class->insert; - return $error if $error; + return "can't insert tax_class for new TAXTYPE $type and TAXCAT $cat: $error" if $error; $imported++; } } @@ -363,7 +407,7 @@ sub batch_import { my $error = &{$endhook}(); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "can't insert tax_class for $line: $error"; + return "can't run end hook: $error"; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -378,9 +422,6 @@ sub batch_import { =head1 BUGS - batch_import does not handle mixed I and D records in the same file for - format cch-update - =head1 SEE ALSO L<FS::Record>, schema.html from the base documentation. diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index a5a623d94..342c7cb0b 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -413,7 +413,7 @@ sub taxline { } my $maxtype = $self->maxtype || 0; - if ($maxtype != 0 && $maxtype != 9) { + if ($maxtype != 0 && $maxtype != 1 && $maxtype != 9) { return $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' ); @@ -476,12 +476,12 @@ sub taxline { } - # - # XXX insert exemption handling here + # XXX handle excessrate (use_excessrate) / excessfee / + # taxbase/feebase / taxmax/feemax + # and eventually exemptions # # the tax or fee is applied to taxbase or feebase and then # the excessrate or excess fee is applied to taxmax or feemax - # $amount += $taxable_charged * $self->tax; $amount += $taxable_units * $self->fee; @@ -785,7 +785,8 @@ sub batch_import { } - for (grep { !exists($delete{$_}) } keys %insert) { + my @replace = grep { exists($delete{$_}) } keys %insert; + for (@replace) { if ( $job ) { # progress bar if ( time - $min_sec > $last ) { my $error = $job->update_statustext( @@ -799,20 +800,35 @@ sub batch_import { } } - my $tax_rate = new FS::tax_rate( $insert{$_} ); - my $error = $tax_rate->insert; + my $old = qsearchs( 'tax_rate', $delete{$_} ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - my $hashref = $insert{$_}; - $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) ); - return "can't insert tax_rate for $line: $error"; + if ( $old ) { + + my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' }); + $new->taxnum($old->taxnum); + my $error = $new->replace($old); + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + my $hashref = $insert{$_}; + $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) ); + return "can't replace tax_rate for $line: $error"; + } + + $imported++; + + } else { + + $old = delete $delete{$_}; + warn "WARNING: can't find tax_rate to replace (inserting instead and continuing) for: ". + #join(" ", map { "$_ => ". $old->{$_} } @fields); + join(" ", map { "$_ => ". $old->{$_} } keys(%$old) ); } $imported++; } - for (grep { exists($delete{$_}) } keys %insert) { + for (grep { !exists($delete{$_}) } keys %insert) { if ( $job ) { # progress bar if ( time - $min_sec > $last ) { my $error = $job->update_statustext( @@ -826,27 +842,17 @@ sub batch_import { } } - my $old = qsearchs( 'tax_rate', $delete{$_} ); - unless ($old) { - $dbh->rollback if $oldAutoCommit; - $old = $delete{$_}; - return "can't find tax_rate to replace for: ". - #join(" ", map { "$_ => ". $old->{$_} } @fields); - join(" ", map { "$_ => ". $old->{$_} } keys(%$old) ); - } - my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' }); - $new->taxnum($old->taxnum); - my $error = $new->replace($old); + my $tax_rate = new FS::tax_rate( $insert{$_} ); + my $error = $tax_rate->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; my $hashref = $insert{$_}; $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) ); - return "can't replace tax_rate for $line: $error"; + return "can't insert tax_rate for $line: $error"; } $imported++; - $imported++; } for (grep { !exists($insert{$_}) } keys %delete) { @@ -961,7 +967,7 @@ sub _perform_batch_import { my $file = lc($name). 'file'; unless ($files{$file}) { - $error = "No $name supplied"; + #$error = "No $name supplied"; next; } next if $name eq 'DETAIL' && $format =~ /update/; @@ -978,7 +984,7 @@ sub _perform_batch_import { unlink $filename or warn "Can't delete $filename: $!" unless $keep_cch_files; push @insert_list, $name, $insertname, $import_sub, $format; - if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better + if ( $name eq 'GEOCODE' || $name eq 'CODE' ) { #handle this whole ordering issue better unshift @predelete_list, $name, $deletename, $import_sub, $format; } else { unshift @delete_list, $name, $deletename, $import_sub, $format; @@ -996,10 +1002,17 @@ sub _perform_batch_import { 'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format if $format =~ /update/; + my %addl_param = (); + if ( $param->{'delete_only'} ) { + $addl_param{'delete_only'} = $param->{'delete_only'}; + @insert_list = () + } + $error ||= _perform_cch_tax_import( $job, [ @predelete_list ], [ @insert_list ], [ @delete_list ], + \%addl_param, ); @@ -1024,7 +1037,8 @@ sub _perform_batch_import { sub _perform_cch_tax_import { - my ( $job, $predelete_list, $insert_list, $delete_list ) = @_; + my ( $job, $predelete_list, $insert_list, $delete_list, $addl_param ) = @_; + $addl_param ||= {}; my $error = ''; foreach my $list ($predelete_list, $insert_list, $delete_list) { @@ -1033,7 +1047,11 @@ sub _perform_cch_tax_import { my $fmt = "$format-update"; $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' ); open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!"; - $error ||= &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job); + my $param = { 'filehandle' => $fh, + 'format' => $fmt, + %$addl_param, + }; + $error ||= &{$method}($param, $job); close $fh; } } diff --git a/FS/FS/upload_target.pm b/FS/FS/upload_target.pm new file mode 100644 index 000000000..f3486d393 --- /dev/null +++ b/FS/FS/upload_target.pm @@ -0,0 +1,275 @@ +package FS::upload_target; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); +use FS::Misc qw(send_email); +use FS::Conf; +use File::Spec; +use vars qw($me $DEBUG); + +$DEBUG = 0; + +=head1 NAME + +FS::upload_target - Object methods for upload_target records + +=head1 SYNOPSIS + + use FS::upload_target; + + $record = new FS::upload_target \%hash; + $record = new FS::upload_target { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::upload_target object represents a destination to deliver files (such +as invoice batches) by FTP, SFTP, or email. FS::upload_target inherits from +FS::Record. + +=over 4 + +=item targetnum - primary key + +=item agentnum - L<FS::agent> foreign key; can be null + +=item protocol - 'ftp', 'sftp', or 'email'. + +=item hostname - the DNS name of the FTP site, or the domain name of the +email address. + +=item port - the TCP port number, if it's not standard. + +=item username - username + +=item password - password + +=item path - for FTP/SFTP, the working directory to change to upon connecting. + +=item subject - for email, the Subject: header + +=item handling - a string naming an additional process to apply to +the file before sending it. + +=back + +=head1 METHODS + +=over 4 + +=cut + +sub table { 'upload_target'; } + +=item new HASHREF + +Creates a new FTP target. To add it to the database, see L<"insert">. + +=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 example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $protocol = lc($self->protocol); + if ( $protocol eq 'email' ) { + $self->set(password => ''); + $self->set(port => ''); + $self->set(path => ''); + } elsif ( $protocol eq 'sftp' ) { + $self->set(port => 22) unless $self->get('port'); + $self->set(subject => ''); + } elsif ( $protocol eq 'ftp' ) { + $self->set('port' => 21) unless $self->get('port'); + $self->set(subject => ''); + } else { + return "protocol '$protocol' not supported"; + } + $self->set(protocol => $protocol); # lowercase it + + my $error = + $self->ut_numbern('targetnum') + || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum') + || $self->ut_text('hostname') + || $self->ut_text('username') + || $self->ut_textn('password') + || $self->ut_numbern('port') + || $self->ut_textn('path') + || $self->ut_textn('subject') + || $self->ut_enum('handling', [ $self->handling_types ]) + ; + return $error if $error; + + $self->SUPER::check; +} + +=item put LOCALNAME [ REMOTENAME ] + +Uploads the file named LOCALNAME, optionally changing its name to REMOTENAME +on the target. For FTP/SFTP, this opens a connection, changes to the working +directory (C<path>), and PUTs the file. For email, it composes an empty +message and attaches the file. + +Returns an error message if anything goes wrong. + +=cut + +sub put { + my $self = shift; + my $localname = shift; + my @s = File::Spec->splitpath($localname); + my $remotename = shift || $s[-1]; + + my $conf = FS::Conf->new; + if ( $self->protocol eq 'ftp' or $self->protocol eq 'sftp' ) { + # could cache this if we ever want to reuse it + local $@; + my $connection = eval { $self->connect }; + return $@ if $@; + $connection->put($localname, $remotename) or return $connection->error; + } elsif ( $self->protocol eq 'email' ) { + + my $to = join('@', $self->username, $self->hostname); + # XXX if we were smarter, this could use a message template for the + # message subject, body, and source address + # (maybe use only the raw content, so that we don't have to supply a + # customer for substitutions? ewww.) + my %message = ( + 'from' => $conf->config('invoice_from'), + 'to' => $to, + 'subject' => $self->subject, + 'nobody' => 1, + 'mimeparts' => [ + { Path => $localname, + Type => 'application/octet-stream', + Encoding => 'base64', + Filename => $remotename, + Disposition => 'attachment', + } + ], + ); + return send_email(%message); + + } else { + return "unknown protocol '".$self->protocol."'"; + } +} + +=item connect + +Creates a Net::FTP or Net::SFTP::Foreign object (according to the setting +of the 'secure' flag), connects to 'hostname', attempts to log in with +'username' and 'password', and changes the working directory to 'path'. +On success, returns the object. On failure, dies with an error message. + +Always returns an error for email targets. + +=cut + +sub connect { + my $self = shift; + if ( $self->protocol eq 'sftp' ) { + eval "use Net::SFTP::Foreign;"; + die $@ if $@; + my %args = ( + port => $self->port, + user => $self->username, + password => $self->password, + more => ($DEBUG ? '-v' : ''), + timeout => 30, + autodie => 1, #we're doing this anyway + ); + my $sftp = Net::SFTP::Foreign->new($self->hostname, %args); + $sftp->setcwd($self->path); + return $sftp; + } + elsif ( $self->protocol eq 'ftp') { + eval "use Net::FTP;"; + die $@ if $@; + my %args = ( + Debug => $DEBUG, + Port => $self->port, + Passive => 1,# optional? + ); + my $ftp = Net::FTP->new($self->hostname, %args) + or die "connect to ".$self->hostname." failed: $@"; + $ftp->login($self->username, $self->password) + or die "login to ".$self->username.'@'.$self->hostname." failed: $@"; + $ftp->binary; #optional? + $ftp->cwd($self->path) + or ($self->path eq '/') + or die "cwd to ".$self->hostname.'/'.$self->path." failed: $@"; + + return $ftp; + } else { + return "can't connect() to a target of type '".$self->protocol."'"; + } +} + +=item label + +Returns a descriptive label for this target. + +=cut + +sub label { + my $self = shift; + $self->targetnum . ': ' . $self->username . '@' . $self->hostname; +} + +=item handling_types + +Returns a list of values for the "handling" field, corresponding to the +known ways to preprocess a file before uploading. Currently those are +implemented somewhat crudely in L<FS::Cron::upload>. + +=cut + +sub handling_types { + '', + #'billco', #not implemented this way yet + 'bridgestone', + 'ics', +} + +=back + +=head1 BUGS + +Handling methods should be here, but instead are in FS::Cron. + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/MANIFEST b/FS/MANIFEST index b5ee87e93..a86683d6b 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -11,8 +11,8 @@ bin/freeside-count-active-customers bin/freeside-daily bin/freeside-deloutsource bin/freeside-deloutsourceuser -bin/freeside-deluser bin/freeside-email +bin/freeside-phonenum_list bin/freeside-queued bin/freeside-radgroup bin/freeside-reexport @@ -26,14 +26,16 @@ bin/freeside-sqlradius-seconds bin/freeside-torrus-srvderive FS.pm FS/AccessRight.pm +FS/AuthCookieHandler.pm +FS/Auth/external.pm +FS/Auth/internal.pm +FS/Auth/legacy.pm FS/CGI.pm -FS/InitHandler.pm FS/ClientAPI.pm FS/ClientAPI_SessionCache.pm FS/ClientAPI_XMLRPC.pm FS/ClientAPI/passwd.pm FS/ClientAPI/Agent.pm -FS/ClientAPI/Bulk.pm FS/ClientAPI/MasonComponent.pm FS/ClientAPI/MyAccount.pm FS/ClientAPI/PrepaidPhone.pm @@ -44,7 +46,6 @@ FS/Cron/backup.pm FS/Cron/bill.pm FS/Cron/vacuum.pm FS/Daemon.pm -FS/Maestro.pm FS/Misc.pm FS/Record.pm FS/Report.pm @@ -74,7 +75,6 @@ FS/cust_main/Billing_Realtime.pm FS/cust_main/Import.pm FS/cust_main/Packages.pm FS/cust_main/Search.pm -FS/cust_main/_Marketgear.pm FS/cust_main_Mixin.pm FS/cust_main_county.pm FS/cust_main_invoice.pm @@ -149,8 +149,6 @@ FS/part_pkg/sqlradacct_hour.pm FS/part_pkg/subscription.pm FS/part_pkg/voip_sqlradacct.pm FS/part_pkg/voip_cdr.pm -FS/part_pkg/base_rate.pm -FS/part_pkg/base_delayed.pm FS/part_pop_local.pm FS/part_referral.pm FS/part_svc.pm @@ -493,6 +491,8 @@ FS/phone_type.pm t/phone_type.t FS/contact_email.pm t/contact_email.t +FS/contact_Mixin.pm +t/contact_Mixin.t FS/prospect_main.pm t/prospect_main.t FS/o2m_Common.pm @@ -640,8 +640,8 @@ FS/access_groupsales.pm t/access_groupsales.t FS/part_svc_class.pm t/part_svc_class.t -FS/ftp_target.pm -t/ftp_target.t +FS/upload_target.pm +t/upload_target.t FS/quotation.pm t/quotation.t FS/quotation_pkg.pm @@ -673,3 +673,35 @@ FS/part_export_machine.pm t/part_export_machine.t FS/svc_export_machine.pm t/svc_export_machine.t +FS/GeocodeCache.pm +t/GeocodeCache.t +FS/log.pm +t/log.t +FS/log_context.pm +t/log_context.t +FS/part_pkg_usage_class.pm +t/part_pkg_usage_class.t +FS/cust_pkg_usage.pm +t/cust_pkg_usage.t +FS/part_pkg_usage_class.pm +t/part_pkg_usage_class.t +FS/part_pkg_usage.pm +t/part_pkg_usage.t +FS/cdr_cust_pkg_usage.pm +t/cdr_cust_pkg_usage.t +FS/part_pkg_msgcat.pm +t/part_pkg_msgcat.t +FS/access_user_session.pm +t/access_user_session.t +FS/svc_cable.pm +t/svc_cable.t +FS/cable_device.pm +t/cable_device.t +FS/h_svc_cable.pm +t/h_svc_cable.t +FS/agent_currency.pm +t/agent_currency.t +FS/currency_exchange.pm +t/currency_exchange.t +FS/part_pkg_currency.pm +t/part_pkg_currency.t diff --git a/FS/bin/freeside-adduser b/FS/bin/freeside-adduser index 530481377..6bfb759f8 100644 --- a/FS/bin/freeside-adduser +++ b/FS/bin/freeside-adduser @@ -7,46 +7,9 @@ use Getopt::Std; my $FREESIDE_CONF = "%%%FREESIDE_CONF%%%"; -getopts("s:g:n"); +getopts("g:"); my $user = shift or die &usage; -if ( $opt_s ) { - - #if ( -e "$FREESIDE_CONF/mapsecrets" ) { - # open(MAPSECRETS,"<$FREESIDE_CONF/mapsecrets") - # or die "can't open $FREESIDE_CONF/mapsecrets: $!"; - # while (<MAPSECRETS>) { - # /^(\S+) / or die "unparsable line in mapsecrets: $_"; - # die "user $user already exists\n" if $user eq $1; - # } - # close MAPSECRETS; - #} - - #insert new entry before a wildcard... - open(MAPSECRETS,"<$FREESIDE_CONF/mapsecrets") - and flock(MAPSECRETS,LOCK_EX) - or die "can't open $FREESIDE_CONF/mapsecrets: $!"; - open(NEW,">$FREESIDE_CONF/mapsecrets.new") - or die "can't open $FREESIDE_CONF/mapsecrets.new: $!"; - while(<MAPSECRETS>) { - if ( /^\*\s/ ) { - print NEW "$user $opt_s\n"; - } - print NEW $_; - } - close MAPSECRETS or die "can't close $FREESIDE_CONF/mapsecrets: $!"; - close NEW or die "can't close $FREESIDE_CONF/mapsecrets.new: $!"; - rename("$FREESIDE_CONF/mapsecrets.new", "$FREESIDE_CONF/mapsecrets") - or die "can't move mapsecrets.new into place: $!"; - -} - -### - -exit if $opt_n; - -### - use FS::UID qw(adminsuidsetup); use FS::CurrentUser; use FS::access_user; @@ -58,7 +21,7 @@ adminsuidsetup $user; my $access_user = new FS::access_user { 'username' => $user, - '_password' => 'notyet', + '_password' => '', 'first' => 'Firstname', # $opt_f || 'last' => 'Lastname', # $opt_l || }; @@ -79,7 +42,7 @@ if ( $opt_g ) { ### sub usage { - die "Usage:\n\n freeside-adduser [ -n ] [ -s ] [ -g groupnum ] username [ password ]" + die "Usage:\n\n freeside-adduser [ -g groupnum ] username [ password ]" } =head1 NAME @@ -88,7 +51,7 @@ freeside-adduser - Command line interface to add (freeside) users. =head1 SYNOPSIS - freeside-adduser [ -n ] [ -s ] [ -g groupnum ] username [ password ] + freeside-adduser [ -g groupnum ] username [ password ] =head1 DESCRIPTION @@ -100,17 +63,6 @@ B<Configuration | Employees | View/Edit employees>. -g: initial groupnum - Development/multi-DB options: - - -s: alternate secrets file - - -n: no ACL added, for bootstrapping - -=head1 NOTE - -No explicit htpasswd options are available in 1.7 - passwords are now -maintained automatically. - =head1 SEE ALSO Base Freeside documentation diff --git a/FS/bin/freeside-cdr-sftp_and_import b/FS/bin/freeside-cdr-sftp_and_import index 7f2693fcb..aa1b3942c 100755 --- a/FS/bin/freeside-cdr-sftp_and_import +++ b/FS/bin/freeside-cdr-sftp_and_import @@ -12,8 +12,8 @@ use FS::cdr; # parse command line ### -use vars qw( $opt_m $opt_p $opt_r $opt_e $opt_d $opt_v $opt_P $opt_a $opt_c $opt_g ); -getopts('c:m:p:r:e:d:v:P:ag'); +use vars qw( $opt_m $opt_p $opt_r $opt_e $opt_d $opt_v $opt_P $opt_a $opt_c $opt_g $opt_s $opt_b ); +getopts('c:m:p:r:e:d:v:P:agsb'); $opt_e ||= 'csv'; #$opt_e = ".$opt_e" unless $opt_e =~ /^\./; @@ -116,31 +116,39 @@ foreach my $filename ( @$ls ) { $import_options->{'cdrtypenum'} = $opt_c if $opt_c; my $error = FS::cdr::batch_import($import_options); + if ( $error ) { - unlink "$cachedir/$filename"; - unlink "$cachedir/$ungziped" if $opt_g; - die $error; - } - if ( $opt_d ) { - if($opt_m eq 'ftp') { - my $ftp = ftp(); - $ftp->rename($filename, "$opt_d/$file_timestamp") - or do { - unlink "$cachedir/$filename"; - unlink "$cachedir/$ungziped" if $opt_g; - die "Can't move $filename to $opt_d: ".$ftp->message . "\n"; - }; + if ( $opt_s ) { + warn "$ungziped: $error\n"; + } else { + unlink "$cachedir/$filename"; + unlink "$cachedir/$ungziped" if $opt_g; + die $error; } - else { - my $sftp = sftp(); - $sftp->rename($filename, "$opt_d/$file_timestamp") - or do { - unlink "$cachedir/$filename"; - unlink "$cachedir/$ungziped" if $opt_g; - die "can't move $filename to $opt_d: ". $sftp->error . "\n"; - }; + + } else { + + if ( $opt_d ) { + if ( $opt_m eq 'ftp') { + my $ftp = ftp(); + $ftp->rename($filename, "$opt_d/$file_timestamp") + or do { + unlink "$cachedir/$filename"; + unlink "$cachedir/$ungziped" if $opt_g; + die "Can't move $filename to $opt_d: ".$ftp->message . "\n"; + }; + } else { + my $sftp = sftp(); + $sftp->rename($filename, "$opt_d/$file_timestamp") + or do { + unlink "$cachedir/$filename"; + unlink "$cachedir/$ungziped" if $opt_g; + die "can't move $filename to $opt_d: ". $sftp->error . "\n"; + }; + } } + } unlink "$cachedir/$filename"; @@ -168,6 +176,7 @@ sub ftp { or die "FTP connection to '$hostname' failed."; $ftp->login($ftp_user, $ftp_pass) or die "FTP login failed: ".$ftp->message; $ftp->cwd($opt_r) or die "can't chdir to $opt_r\n" if $opt_r; + $ftp->binary or die "can't set BINARY mode: ". $ftp->message if $opt_b; return $ftp; } @@ -192,7 +201,7 @@ freeside-cdr-sftp_and_import - Download CDR files from a remote server via SFTP cdr.sftp_and_import [ -m method ] [ -p prefix ] [ -e extension ] [ -r remotefolder ] [ -d donefolder ] [ -v level ] [ -P port ] - [ -a ] [ -c cdrtypenum ] user format [sftpuser@]servername + [ -a ] [ -g ] [ -s ] [ -c cdrtypenum ] user format [sftpuser@]servername =head1 DESCRIPTION @@ -213,11 +222,17 @@ or FTP and then import them into the database. -a: use ftp passive mode +-b: use ftp binary mode + -v: set verbosity level; this script only has one level, but it will be passed as the 'debug' argument to the transport method -c: cdrtypenum to set, defaults to none +-g: File is gzipped + +-s: Warn and skip files which could not be imported rather than abort + user: freeside username format: CDR format name diff --git a/FS/bin/freeside-cdrrated b/FS/bin/freeside-cdrrated index 131b56a7e..99ea67594 100644 --- a/FS/bin/freeside-cdrrated +++ b/FS/bin/freeside-cdrrated @@ -33,9 +33,11 @@ if ( @cdrtypenums ) { $extra_sql .= ' AND cdrtypenum IN ('. join(',', @cdrtypenums ). ')'; } -our %svcnum = (); -our %pkgpart = (); -our %part_pkg = (); +our %svcnum = (); # phonenum => svcnum +our %pkgnum = (); # phonenum => pkgnum +our %cust_pkg = (); # pkgnum => cust_pkg (NOT phonenum => cust_pkg!) +our %pkgpart = (); # phonenum => pkgpart +our %part_pkg = (); # phonenum => part_pkg #some false laziness w/freeside-cdrrewrited @@ -91,6 +93,9 @@ while (1) { next; } + $pkgnum{$number} = $cust_pkg->pkgnum; + $cust_pkg{$cust_pkg->pkgnum} ||= $cust_pkg; + #get the package, search through the part_pkg and linked for a voip_cdr def w/matching cdrtypenum (or no use_cdrtypenum) my @part_pkg = grep { $_->plan eq 'voip_cdr' @@ -126,10 +131,11 @@ while (1) { #} #XXX if $part_pkg->option('min_included') then we can't prerate this CDR - + my $error = $cdr->rate( 'part_pkg' => $part_pkg{ $pkgpart{$number} }, - 'svcnum' => $svcnum{ $number }, + 'cust_pkg' => $cust_pkg{ $pkgnum{$number} }, + 'svcnum' => $svcnum{$number}, ); if ( $error ) { #XXX ??? diff --git a/FS/bin/freeside-cdrrewrited b/FS/bin/freeside-cdrrewrited index f2c3926fb..16f931fbf 100644 --- a/FS/bin/freeside-cdrrewrited +++ b/FS/bin/freeside-cdrrewrited @@ -30,9 +30,9 @@ die "not running; cdr-asterisk_forward_rewrite, cdr-charged_party_rewrite ". #-- -my %accountcode_unmatch = (); -my $accountcode_retry = 4 * 60 * 60; # 4 hours -my $accountcode_giveup = 4 * 24 * 60 * 60; # 4 days +my %sessionnum_unmatch = (); +my $sessionnum_retry = 4 * 60 * 60; # 4 hours +my $sessionnum_giveup = 4 * 24 * 60 * 60; # 4 days my %cdr_type = map { lc($_->cdrtypename) => $_->cdrtypenum } qsearch('cdr_type',{}); @@ -45,8 +45,8 @@ while (1) { # instead of just doing this search like normal CDRs #hmm :/ - my @recent = grep { ($accountcode_unmatch{$_} + $accountcode_retry) > time } - keys %accountcode_unmatch; + my @recent = grep { ($sessionnum_unmatch{$_} + $sessionnum_retry) > time } + keys %sessionnum_unmatch; my $extra_sql = scalar(@recent) ? ' AND acctid NOT IN ('. join(',', @recent). ') ' : ''; @@ -136,45 +136,62 @@ while (1) { } - if ( $conf->exists('cdr-taqua-accountcode_rewrite') - && $cdr->lastapp eq 'acctcode' && $cdr->cdrtypenum == 1 + if ( $cdr->cdrtypenum == 1 + and $cdr->lastapp + and ( + $conf->exists('cdr-taqua-accountcode_rewrite') or + $conf->exists('cdr-taqua-callerid_rewrite') ) ) { #find the matching CDR - my $primary = qsearchs('cdr', { - 'sessionnum' => $cdr->sessionnum, - 'src' => $cdr->subscriber, - #'accountcode' => '', - }); + my %search = ( 'sessionnum' => $cdr->sessionnum ); + if ( $cdr->lastapp eq 'acctcode' ) { + $search{'src'} = $cdr->subscriber; + } elsif ( $cdr->lastapp eq 'CallerId' ) { + $search{'dst'} = $cdr->subscriber; + } + my $primary = qsearchs('cdr', \%search); unless ( $primary ) { my $cantfind = "can't find primary CDR with session ". $cdr->sessionnum. ", src ". $cdr->subscriber; - if ( $cdr->calldate_unix + $accountcode_giveup < time ) { + if ( $cdr->calldate_unix + $sessionnum_giveup < time ) { warn "ERROR: $cantfind; giving up\n"; - push @status, 'taqua-accountcode-NOTFOUND'; + push @status, 'taqua-sessionnum-NOTFOUND'; $cdr->status('done'); #so it doesn't try to rate - delete $accountcode_unmatch{$cdr->acctid}; #so it doesn't suck mem + delete $sessionnum_unmatch{$cdr->acctid}; #so it doesn't suck mem } else { warn "WARNING: $cantfind; will keep trying\n"; - $accountcode_unmatch{$cdr->acctid} = time; + $sessionnum_unmatch{$cdr->acctid} = time; next; } } else { - $primary->accountcode( $cdr->lastdata ); + if ( $cdr->lastapp eq 'acctcode' ) { + # lastdata contains the dialed account code + $primary->accountcode( $cdr->lastdata ); + push @status, 'taqua-accountcode'; + } elsif ( $cdr->lastapp eq 'CallerId' ) { + # lastdata contains "allowed" or "restricted" + # or case variants thereof + if ( lc($cdr->lastdata) eq 'restricted' ) { + $primary->clid( 'PRIVATE' ); + } + push @status, 'taqua-callerid'; + } else { + warn "unknown Taqua service name: ".$cdr->lastapp."\n"; + } #$primary->freesiderewritestatus( 'taqua-accountcode-primary' ); - my $error = $primary->replace; + my $error = $primary->replace if $primary->modified; if ( $error ) { warn "WARNING: error rewriting primary CDR (will retry): $error\n"; next; } $skip{$primary->acctid} = 1; - push @status, 'taqua-accountcode'; $cdr->status('done'); #so it doesn't try to rate } @@ -214,7 +231,10 @@ sub _shouldrun { $conf->exists('cdr-asterisk_forward_rewrite') || $conf->exists('cdr-asterisk_australia_rewrite') || $conf->exists('cdr-charged_party_rewrite') - || $conf->exists('cdr-taqua-accountcode_rewrite'); + || $conf->exists('cdr-taqua-accountcode_rewrite') + || $conf->exists('cdr-taqua-callerid_rewrite') + || 0 + ; } sub usage { diff --git a/FS/bin/freeside-censustract-update b/FS/bin/freeside-censustract-update index 8c6721b3e..af9ad749b 100644 --- a/FS/bin/freeside-censustract-update +++ b/FS/bin/freeside-censustract-update @@ -6,8 +6,8 @@ use Date::Parse 'str2time'; use FS::UID qw(adminsuidsetup); use FS::Record qw(qsearch dbh); use FS::Conf; -use FS::cust_main; -use FS::h_cust_main; +use FS::cust_location; +use FS::h_cust_location; my %opt; getopts('d:', \%opt); @@ -22,40 +22,48 @@ my $current_year = $conf->config('census_year') or die "No current census year configured.\n"; my $date = str2time($opt{d}) if $opt{d}; $date ||= time; -my %h_cust_main = map { $_->custnum => $_ } +# This now operates on cust_location, not cust_main. +# Find all locations that, as of $date, did not have +# censusyear = the current year. This includes those +# that have no censusyear. +my %h_cust_location = map { $_->locationnum => $_ } qsearch( - 'h_cust_main', + 'h_cust_location', { censusyear => { op => '!=', value => $current_year } }, - FS::h_cust_main->sql_h_search($date), - ) ; #the state of these customers as of $date + FS::h_cust_location->sql_h_search($date), + ) ; -my @cust_main = qsearch( 'cust_main', +# Find all locations that don't have censusyear = the current +# year as of now. +my @cust_location = qsearch( 'cust_location', { censusyear => { op => '!=', value => $current_year } }, -); # all possibly interesting customers +); -warn scalar(@cust_main)." records found.\n"; +warn scalar(@cust_location)." records found.\n"; my $queued = 0; my $updated = 0; -foreach my $cust_main (@cust_main) { +foreach my $cust_location (@cust_location) { my $error; - my $h = $h_cust_main{$cust_main->custnum}; - if ( defined($h) and $h->censustract eq $cust_main->censustract ) { - # the tract code hasn't been changed since $date - # so update it now + my $h = $h_cust_location{$cust_location->locationnum}; + if ( defined($h) and $h->censustract eq $cust_location->censustract ) { + # Then the location's censustract hasn't been changed since $date + # (or it didn't exist on $date, or $date is now). Queue a censustract + # update for it. my $job = FS::queue->new({ - job => 'FS::cust_main::process_censustract_update' + job => 'FS::cust_location::process_censustract_update' }); - $error = $job->insert($cust_main->custnum); + $error = $job->insert($cust_location->locationnum); $queued++; } - elsif ($cust_main->censusyear eq '') { - # the tract number is assumed current, so just set the year - $cust_main->set('censusyear', $current_year); - $error = $cust_main->replace; + elsif ($cust_location->censusyear eq '') { + # Then it's been updated since $date, but somehow has a null censusyear. + # (Is this still relevant?) + $cust_location->set('censusyear', $current_year); + $error = $cust_location->replace; $updated++; - } + } # Else it's been updated since $date, so leave it alone. if ( $error ) { $dbh->rollback; - die "error updating ".$cust_main->custnum.": $error\n"; + die "error updating ".$cust_location->locationnum.": $error\n"; } } warn "Queued $queued census code lookups, updated year in $updated records.\n"; diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 8e8ae4ff9..b6ee5188e 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -4,6 +4,7 @@ use strict; use Getopt::Std; use FS::UID qw(adminsuidsetup); use FS::Conf; +use FS::Log; &untaint_argv; #what it sounds like (eww) use vars qw(%opt); @@ -11,6 +12,8 @@ getopts("p:a:d:vl:sy:nmrkg:o", \%opt); my $user = shift or die &usage; adminsuidsetup $user; +my $log = FS::Log->new('daily'); +$log->info('start'); #you can skip this by not having a NetworkMonitoringSystem configured use FS::Cron::nms_report qw(nms_report); @@ -74,6 +77,12 @@ unlink <${deldir}.CGItemp*>; use FS::Cron::backup qw(backup); backup(); +#except we'd rather not start cleanup jobs until the backup is done +use FS::Cron::cleanup qw(cleanup); +cleanup(); + +$log->info('finish'); + ### # subroutines ### @@ -138,13 +147,13 @@ the bill and collect methods of a cust_main object. See L<FS::cust_main>. -l: debugging level - -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing. + -m: Multi-process mode uses the job queue for multi-process and/or multi-machine billing. -r: Multi-process mode dry run option -k: skip notify_flat_delay -user: From the mapsecrets file - see config.html from the base documentation +user: Typically "fs_daily" custnum: if one or more customer numbers are specified, only bills those customers. Otherwise, bills all customers. diff --git a/FS/bin/freeside-deluser b/FS/bin/freeside-deluser deleted file mode 100644 index a2a361a83..000000000 --- a/FS/bin/freeside-deluser +++ /dev/null @@ -1,64 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use vars qw($opt_h); -use Fcntl qw(:flock); -use Getopt::Std; - -my $FREESIDE_CONF = "%%%FREESIDE_CONF%%%"; - -getopts("h:"); -my $user = shift or die &usage; - -if ( $opt_h ) { - open(HTPASSWD,"<$opt_h") - and flock(HTPASSWD,LOCK_EX) - or die "can't open $opt_h: $!"; - open(HTPASSWD_TMP,">$opt_h.tmp") or die "can't open $opt_h.tmp: $!"; - while (<HTPASSWD>) { - print HTPASSWD_TMP $_ unless /^$user:/; - } - close HTPASSWD_TMP; - rename "$opt_h.tmp", "$opt_h" or die $!; - flock(HTPASSWD,LOCK_UN); - close HTPASSWD; -} - -open(MAPSECRETS,"<$FREESIDE_CONF/mapsecrets") - and flock(MAPSECRETS,LOCK_EX) - or die "can't open $FREESIDE_CONF/mapsecrets: $!"; -open(MAPSECRETS_TMP,">>$FREESIDE_CONF/mapsecrets.tmp") - or die "can't open $FREESIDE_CONF/mapsecrets.tmp: $!"; -while (<MAPSECRETS>) { - print MAPSECRETS_TMP $_ unless /^$user\s/; -} -close MAPSECRETS_TMP; -rename "$FREESIDE_CONF/mapsecrets.tmp", "$FREESIDE_CONF/mapsecrets" or die $!; -flock(MAPSECRETS,LOCK_UN); -close MAPSECRETS; - -sub usage { - die "Usage:\n\n freeside-deluser [ -h htpasswd_file ] username" -} - -=head1 NAME - -freeside-deluser - Command line interface to add (freeside) users. - -=head1 SYNOPSIS - - freeside-deluser [ -h htpasswd_file ] username - -=head1 DESCRIPTION - -Adds a user to the Freeside billing system. This is for adding users (internal -sales/tech folks) to the web interface, not for adding customer accounts. - - -h: Also delete from the given htpasswd filename - -=head1 SEE ALSO - -L<freeside-adduser>, L<htpasswd>(1), base Freeside documentation - -=cut - diff --git a/FS/bin/freeside-eftca-download b/FS/bin/freeside-eftca-download index 702a80ca1..1b7653cb3 100755 --- a/FS/bin/freeside-eftca-download +++ b/FS/bin/freeside-eftca-download @@ -52,7 +52,7 @@ my $conf = new FS::Conf; my @agents; if ( $conf->exists('batch-spoolagent') ) { - @agents = qsearchs('agent', { 'disabled' => '' }); + @agents = qsearch('agent', { 'disabled' => '' }); } else { @agents = (1); } @@ -62,11 +62,14 @@ foreach my $agent (@agents) { my @batchconf; if ( $conf->exists('batch-spoolagent') ) { @batchconf = $conf->config('batchconfig-eft_canada', $agent->agentnum, 1); - next unless $batchconf[0]; + if ( !length($batchconf[0]) ) { + warn "agent '".$agent->agent."' has no batchconfig-eft_canada setting; skipped.\n"; + next; + } } else { @batchconf = $conf->config('batchconfig-eft_canada'); } - # BIN, terminalID, merchantID, username, password + # user, password, transaction code, delay days my $user = $batchconf[0] or die "no EFT Canada batch username configured\n"; my $pass = $batchconf[1] or die "no EFT Canada batch password configured\n"; @@ -82,7 +85,7 @@ foreach my $agent (@agents) { $sftp->setcwd('/Returns'); - my $files = $sftp->ls('.', wanted => qr/^ReturnFile/, names_only => 1); + my $files = $sftp->ls('.', wanted => qr/\.txt$/, names_only => 1); die "no response files found\n" if !@$files; FILE: foreach my $filename (@$files) { diff --git a/FS/bin/freeside-email b/FS/bin/freeside-email index 7a93f78ee..6e4e0fe6c 100755 --- a/FS/bin/freeside-email +++ b/FS/bin/freeside-email @@ -45,7 +45,7 @@ freeside-email - Prints email addresses of all users on STDOUT Prints the email addresses of all customers on STDOUT, separated by newlines. -user: From the mapsecrets file - see config.html from the base documentation +user: Freeside user =head1 BUGS diff --git a/FS/bin/freeside-fetch b/FS/bin/freeside-fetch index f689bfd93..c1ab78373 100755 --- a/FS/bin/freeside-fetch +++ b/FS/bin/freeside-fetch @@ -79,7 +79,7 @@ freeside-fetch - Send a freeside page to a list of employees. Fetches a web page specified by url as if employee and emails it to employee. Useful when run out of cron to send freeside web pages. - user: From the mapsecrets file - a user with access to the freeside database + user: Freeside user employee: the username of an employee to receive the emailed page. May be a comma separated list diff --git a/FS/bin/freeside-ipifony-download b/FS/bin/freeside-ipifony-download new file mode 100644 index 000000000..9df4db08a --- /dev/null +++ b/FS/bin/freeside-ipifony-download @@ -0,0 +1,320 @@ +#!/usr/bin/perl + +use strict; +use Getopt::Std; +use Date::Format qw(time2str); +use File::Temp qw(tempdir); +use Net::SFTP::Foreign; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::cust_main; +use FS::Conf; +use File::Copy qw(copy); +use Text::CSV; + +my %opt; +getopts('va:P:C:e:', \%opt); + +# Product codes that are subject to flat rate E911 charges. For these +# products, the'quantity' field represents the number of lines. +my @E911_CODES = ( 'V-HPBX', 'V-TRUNK' ); + +# Map TAXNONVOICE/TAXVOICE to Freeside taxclass names +my %TAXCLASSES = ( + 'TAXNONVOICE' => 'Other', + 'TAXVOICE' => 'VoIP', +); + + +#$Net::SFTP::Foreign::debug = -1; +sub HELP_MESSAGE { ' + Usage: + freeside-ipifony-download + [ -v ] + [ -a archivedir ] + [ -P port ] + [ -C category ] + [ -e pkgpart ] + freesideuser sftpuser@hostname[:path] +' } + +my @fields = ( + 'custnum', + 'date_desc', + 'quantity', + 'unit_price', + 'classname', + 'taxclass', +); + +my $user = shift or die &HELP_MESSAGE; +my $dbh = adminsuidsetup $user; +$FS::UID::AutoCommit = 0; + +# for statistics +my $num_charges = 0; +my $num_errors = 0; +my $sum_charges = 0; +# cache classnums +my %classnum_of; + +if ( $opt{a} ) { + die "no such directory: $opt{a}\n" + unless -d $opt{a}; + die "archive directory $opt{a} is not writable by the freeside user\n" + unless -w $opt{a}; +} + +my $e911_part_pkg; +if ( $opt{e} ) { + $e911_part_pkg = FS::part_pkg->by_key($opt{e}) + or die "E911 pkgpart $opt{e} not found.\n"; + + if ( $e911_part_pkg->base_recur > 0 or $e911_part_pkg->freq ) { + die "E911 pkgpart $opt{e} must be a one-time charge.\n"; + } +} + +my $categorynum = ''; +if ( $opt{C} ) { + # find this category (don't auto-create it, it should exist already) + my $category = qsearchs('pkg_category', { categoryname => $opt{C} }); + if (!defined($category)) { + die "Package category '$opt{C}' does not exist.\n"; + } + $categorynum = $category->categorynum; +} + +#my $tmpdir = File::Temp->newdir(); +my $tmpdir = tempdir( CLEANUP => 1 ); #DIR=>somewhere? + +my $host = shift + or die &HELP_MESSAGE; +my ($sftpuser, $path); +$host =~ s/^(.+)\@//; +$sftpuser = $1 || $ENV{USER}; +$host =~ s/:(.*)//; +$path = $1; + +my $port = 22; +if ( $opt{P} =~ /^(\d+)$/ ) { + $port = $1; +} + +# for now assume SFTP download as the only method +print STDERR "Connecting to $sftpuser\@$host...\n" if $opt{v}; + +my $sftp = Net::SFTP::Foreign->new( + host => $host, + user => $sftpuser, + port => $port, + # for now we don't support passwords. use authorized_keys. + timeout => 30, + #more => ($opt{v} ? '-v' : ''), +); +die "failed to connect to '$sftpuser\@$host'\n(".$sftp->error.")\n" + if $sftp->error; + +$sftp->setcwd($path) if $path; + +my $files = $sftp->ls('ready', wanted => qr/\.csv$/, names_only => 1); +if (!@$files) { + print STDERR "No charge files found.\n" if $opt{v}; + exit(-1); +} + +my %cust_main; # cache +my %e911_qty; # custnum => sum of E911-subject quantity + +my %is_e911 = map {$_ => 1} @E911_CODES; + +FILE: foreach my $filename (@$files) { + print STDERR "Retrieving $filename\n" if $opt{v}; + $sftp->get("ready/$filename", "$tmpdir/$filename"); + if($sftp->error) { + warn "failed to download $filename\n"; + next FILE; + } + + # make sure server archive dir exists + if ( !$sftp->stat('done') ) { + print STDERR "Creating $path/done\n" if $opt{v}; + $sftp->mkdir('done'); + if($sftp->error) { + # something is seriously wrong + die "failed to create archive directory on server:\n".$sftp->error."\n"; + } + } + #move to server archive dir + $sftp->rename("ready/$filename", "done/$filename"); + if($sftp->error) { + warn "failed to archive $filename on server:\n".$sftp->error."\n"; + } # process it anyway, I guess/ + + #copy to local archive dir + if ( $opt{a} ) { + print STDERR "Copying $tmpdir/$filename to archive dir $opt{a}\n" + if $opt{v}; + copy("$tmpdir/$filename", $opt{a}); + warn "failed to copy $tmpdir/$filename to $opt{a}: $!" if $!; + } + + open my $fh, "<$tmpdir/$filename"; + my $csv = Text::CSV->new; # orthodox CSV + my %hash; + while (my $line = <$fh>) { + $csv->parse($line) or do { + warn "can't parse $filename: ".$csv->error_input."\n"; + next FILE; + }; + @hash{@fields} = $csv->fields(); + if ( $hash{custnum} =~ /^cust/ ) { + # there appears to be a header row + print STDERR "skipping header row\n" if $opt{v}; + next; + } + my $cust_main = + $cust_main{$hash{custnum}} ||= FS::cust_main->by_key($hash{custnum}); + if (!$cust_main) { + warn "customer #$hash{custnum} not found\n"; + next; + } + print STDERR "Found customer #$hash{custnum}: ".$cust_main->name."\n" + if $opt{v}; + + my $amount = sprintf('%.2f',$hash{quantity} * $hash{unit_price}); + # construct arguments for $cust_main->charge + my %charge_opt = ( + amount => $hash{unit_price}, + quantity => $hash{quantity}, + start_date => $cust_main->next_bill_date, + pkg => $hash{date_desc} . + ' (' . $hash{quantity} . ' @ $' . $hash{unit_price} . ' ea)', + taxclass => $TAXCLASSES{ $hash{taxclass} }, + ); + if (my $classname = $hash{classname}) { + if (!exists($classnum_of{$classname}) ) { + # then look it up + my $pkg_class = qsearchs('pkg_class', { + classname => $classname, + categorynum => $categorynum, + }); + if (!defined($pkg_class)) { + # then create it + $pkg_class = FS::pkg_class->new({ + classname => $classname, + categorynum => $categorynum, + }); + my $error = $pkg_class->insert; + die "Error creating package class for product code '$classname':\n". + "$error\n" + if $error; + } + + $classnum_of{$classname} = $pkg_class->classnum; + } + $charge_opt{classnum} = $classnum_of{$classname}; + } + print STDERR " Charging $hash{unit_price} * $hash{quantity}\n" + if $opt{v}; + my $error = $cust_main->charge(\%charge_opt); + if ($error) { + warn "Error creating charge: $error" if $error; + $num_errors++; + } else { + $num_charges++; + $sum_charges += $amount; + } + + if ( $opt{e} and $is_e911{$hash{classname}} ) { + $e911_qty{$hash{custnum}} ||= 0; + $e911_qty{$hash{custnum}} += $hash{quantity}; + } + } #while $line + close $fh; +} #FILE + +# Order E911 packages +my $num_e911 = 0; +my $num_lines = 0; +foreach my $custnum ( keys (%e911_qty) ) { + my $cust_main = $cust_main{$custnum}; + my $quantity = $e911_qty{$custnum}; + next if $quantity == 0; + my $cust_pkg = FS::cust_pkg->new({ + pkgpart => $opt{e}, + custnum => $custnum, + start_date => $cust_main->next_bill_date, + quantity => $quantity, + }); + my $error = $cust_main->order_pkg({ cust_pkg => $cust_pkg }); + if ( $error ) { + warn "Error creating e911 charge for customer $custnum: $error\n"; + $num_errors++; + } else { + $num_e911++; + $num_lines += $quantity; + } +} + +$dbh->commit; + +if ($opt{v}) { + print STDERR " +Finished! + Processed files: @$files + Created charges: $num_charges + Sum of charges: \$".sprintf('%0.2f', $sum_charges)." + E911 charges: $num_e911 + E911 lines: $num_lines + Errors: $num_errors +"; +} + +=head1 NAME + +freeside-ipifony-download - Download and import invoice items from IPifony. + +=head1 SYNOPSIS + + freeside-ipifony-download + [ -v ] + [ -a archivedir ] + [ -P port ] + [ -C category ] + [ -T taxclass ] + [ -e pkgpart ] + freesideuser sftpuser@hostname[:path] + +=head1 REQUIRED PARAMETERS + +I<freesideuser>: the Freeside user to run as. + +I<sftpuser>: the SFTP user to connect as. The 'freeside' system user should +have an authorization key to connect as that user. + +I<hostname>: the SFTP server. + +=head1 OPTIONAL PARAMETERS + +-v: Be verbose. + +-a I<archivedir>: Save a copy of the downloaded file to I<archivedir>. + +-P I<port>: Connect to that TCP port. + +-C I<category>: The name of a package category to use when creating package +classes. + +-e I<pkgpart>: The pkgpart (L<FS::part_pkg>) to use for E911 charges. A +package of this type will be ordered for each invoice that has E911-subject +line items. The 'quantity' field on this package will be set to the total +quantity of those line items. + +The E911 package must be a one-time package (flat rate, no frequency, no +recurring fee) with setup fee equal to the fee per line. + +=cut + +1; + diff --git a/FS/bin/freeside-monthly b/FS/bin/freeside-monthly index 0d6ea14a2..431fbd86f 100755 --- a/FS/bin/freeside-monthly +++ b/FS/bin/freeside-monthly @@ -7,7 +7,7 @@ use FS::UID qw(adminsuidsetup); &untaint_argv; #what it sounds like (eww) #use vars qw($opt_d $opt_v $opt_p $opt_a $opt_s $opt_y); use vars qw(%opt); -getopts("p:a:d:vsy:", \%opt); +getopts("p:a:d:vsy:m", \%opt); my $user = shift or die &usage; adminsuidsetup $user; @@ -72,7 +72,9 @@ the bill and collect methods of a cust_main object. See L<FS::cust_main>. -v: enable debugging -user: From the mapsecrets file - see config.html from the base documentation + -m: Experimental multi-process mode (delay upload jobs until billing jobs complete) + +user: Typically "fs_daily" custnum: if one or more customer numbers are specified, only bills those customers. Otherwise, bills all customers. diff --git a/FS/bin/freeside-phonenum_list b/FS/bin/freeside-phonenum_list new file mode 100755 index 000000000..19b564dee --- /dev/null +++ b/FS/bin/freeside-phonenum_list @@ -0,0 +1,86 @@ +#!/usr/bin/perl + +use strict; +use vars qw( $opt_c $opt_o $opt_l $opt_p $opt_b $opt_d $opt_s $opt_t ); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Conf; +use FS::Record qw(qsearch); +use FS::svc_phone; + +getopts('colp:b:d:s:t:'); + +my $user = shift or &usage; +adminsuidsetup $user; + +my $conf = new FS::Conf; +my $default_locale = $conf->config('locale') || 'en_US'; + +my %search = (); + +$search{payby} = [ split(/\s*,\s*/, $opt_p) ] if $opt_p; +$search{balance} = $opt_b if $opt_b; +$search{balance_days} = $opt_d if $opt_d; +$search{svcpart} = [ split(/\s*,\s*/, $opt_s) ] if $opt_s; +$search{cust_status} = lc($opt_t) if $opt_t; + +my @svc_phone = qsearch( FS::svc_phone->search(\%search) ); + +foreach my $svc_phone (@svc_phone) { + print $svc_phone->countrycode if $opt_c; + print $svc_phone->phonenum; + print '@'. $svc_phone->domain if $opt_o; + if ( $opt_l ) { + my $cust_pkg = $svc_phone->cust_svc->cust_pkg; + print ','. ($cust_pkg && $cust_pkg->cust_main->locale || $default_locale); + } + print "\n"; +} + +sub usage { + die "usage: freeside-phonenum_list [ -c ] [ -o ] [ -l ] [ -p payby,payby... ] [ -b balance [ -d balance_days ] ] [ -s svcpart,svcpart... ] username \n"; +} + +=head1 NAME + +freeside-phonenum_list + +=head1 SYNOPSIS + freeside-phonenum_list [ -c ] [ -o ] [ -l ] [ -p payby,payby... ] [ -b balance [ -d balance_days ] ] [ -s svcpart,svcpart... ] username + +=head1 DESCRIPTION + +Command-line tool to list phone numbers. + +Display options: + +-c: Include country code + +-o: Include domain + +-l: Include customer locale + +Selection options: + +-p: Customer payby (CARD, BILL, etc.). Separate multiple values with commas. + +-b: Customer balance over (or equal to) this amount + +-d: Customer balance age over this many days + +-s: Service definition (svcpart). Separate multiple values with commas. + +-t: Customer status: prospect, active, ordered, inactive, suspended or cancelled + +username: Employee username + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::svc_phone>, L<FS::cust_main> + +=cut + +1; + diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 756b699d4..5eac06b24 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -11,6 +11,7 @@ use FS::Conf; use FS::Record qw(qsearch); use FS::queue; use FS::queue_depend; +use FS::Log; # no autoloading for non-FS classes... use Net::SSH 0.07; @@ -45,6 +46,7 @@ while ( $@ ) { } } +my $log = FS::Log->new('queue'); logfile( "%%%FREESIDE_LOG%%%/queuelog.". $FS::UID::datasrc ); warn "completing daemonization (detaching))\n" if $DEBUG; @@ -135,6 +137,8 @@ while (1) { foreach my $job ( @jobs ) { + $log->debug('locking queue job', object => $job); + my %hash = $job->hash; $hash{'status'} = 'locked'; my $ljob = new FS::queue ( \%hash ); @@ -186,7 +190,7 @@ while (1) { dbh->{'private_profile'} = {} if UNIVERSAL::can(dbh, 'sprintProfile'); #auto-use classes... - if ( $ljob->job =~ /(FS::(part_export|cust_main|cust_pkg)::\w+)::/ + if ( $ljob->job =~ /(FS::(part_export|cust_main|cust_pkg|Cron)::\w+)::/ || $ljob->job =~ /(FS::\w+)::/ ) { @@ -205,9 +209,13 @@ while (1) { } my $eval = "&". $ljob->job. '(@args);'; + # don't put @args in the log, may expose passwords + $log->info('starting job ('.$ljob->job.')'); warn 'running "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG; + local $FS::UID::AutoCommit = 0; # so that we can clean up failures eval $eval; #throw away return value? suppose so if ( $@ ) { + dbh->rollback; my %hash = $ljob->hash; $hash{'statustext'} = $@; if ( $hash{'statustext'} =~ /\/misc\/queued_report/ ) { #use return? @@ -219,8 +227,10 @@ while (1) { my $fjob = new FS::queue( \%hash ); my $error = $fjob->replace($ljob); die $error if $error; + dbh->commit; # for the status change only } else { $ljob->delete; + dbh->commit; # for the job itself } if ( UNIVERSAL::can(dbh, 'sprintProfile') ) { @@ -286,7 +296,7 @@ Job queue daemon. Should be running at all times. -n: non-"secure" jobs only (other jobs) -user: from the mapsecrets file - see config.html from the base documentation +user: Typically "fs_queue" =head1 VERSION diff --git a/FS/bin/freeside-selfservice-server b/FS/bin/freeside-selfservice-server index c10623c96..8ce74d5c8 100644 --- a/FS/bin/freeside-selfservice-server +++ b/FS/bin/freeside-selfservice-server @@ -16,6 +16,7 @@ use FS::UID qw(adminsuidsetup forksuidsetup); use FS::ClientAPI qw( load_clientapi_modules ); use FS::ClientAPI_SessionCache; use FS::Record qw( qsearch qsearchs ); +use FS::TicketSystem; use FS::Conf; use FS::cust_svc; @@ -108,31 +109,7 @@ while (1) { if ( $keepalives && $keepalive_count++ > 10 ) { $keepalive_count = 0; lock_write; - nstore_fd( { _token => '_keepalive' }, $writer ); - -#commenting izoom stuff out until we can move it to a branch (or just remove) -# 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; @@ -181,12 +158,10 @@ while (1) { warn "child $pid spawned\n" if $Debug; } else { #kid time - ##get new db handle $FS::UID::dbh->{InactiveDestroy} = 1; forksuidsetup($user); - #get db handle - #adminsuidsetup($user); + FS::TicketSystem->init(); my $type = $packet->{_packet}; warn "calling $type handler\n" if $Debug; diff --git a/FS/bin/freeside-selfservice-xmlrpcd b/FS/bin/freeside-selfservice-xmlrpcd index acf516abe..423d2c30b 100755 --- a/FS/bin/freeside-selfservice-xmlrpcd +++ b/FS/bin/freeside-selfservice-xmlrpcd @@ -28,6 +28,7 @@ use FS::UID qw( adminsuidsetup forksuidsetup dbh ); use FS::Conf; use FS::ClientAPI qw( load_clientapi_modules ); use FS::ClientAPI_XMLRPC; #FS::SelfService::XMLRPC; +use FS::TicketSystem; #freeside my $FREESIDE_LOG = "%%%FREESIDE_LOG%%%"; @@ -195,6 +196,9 @@ sub server_do_fork { #freeside db connection, etc. forksuidsetup($user); + #why isn't this needed ala freeside-selfservice-server?? + #FS::TicketSystem->init(); + return; } } diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 155c74aa0..07da88dea 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -32,7 +32,7 @@ $config_dir =~ /^([\w.:=\/]+)$/ or die "unacceptable configuration directory name"; $config_dir = $1; -getsecrets($opt_u); +getsecrets(); #needs to match FS::Record my($dbdef_file) = "%%%FREESIDE_CONF%%%/dbdef.". datasrc; diff --git a/FS/bin/freeside-upgrade b/FS/bin/freeside-upgrade index b08a8401f..5bd141538 100755 --- a/FS/bin/freeside-upgrade +++ b/FS/bin/freeside-upgrade @@ -5,7 +5,7 @@ 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; #0.39 -use FS::UID qw(adminsuidsetup checkeuid datasrc driver_name); #getsecrets); +use FS::UID qw(adminsuidsetup checkeuid datasrc driver_name); use FS::CurrentUser; use FS::Schema qw( dbdef dbdef_dist reload_dbdef ); use FS::Misc::prune qw(prune_applications); @@ -123,6 +123,8 @@ my $cf; while ( $cf = $cfsth->fetchrow_hashref ) { my $tbl = $cf->{'dbtable'}; my $name = $cf->{'name'}; + $name = lc($name) unless driver_name =~ /^mysql/i; + @statements = grep { $_ !~ /^\s*ALTER\s+TABLE\s+(h_|)$tbl\s+DROP\s+COLUMN\s+cf_$name\s*$/i } @statements; push @statements, diff --git a/FS/bin/freeside-username_list b/FS/bin/freeside-username_list new file mode 100755 index 000000000..5352f02eb --- /dev/null +++ b/FS/bin/freeside-username_list @@ -0,0 +1,84 @@ +#!/usr/bin/perl + +use strict; +use vars qw( $opt_o $opt_l $opt_p $opt_b $opt_d $opt_s $opt_t ); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Conf; +use FS::Record qw(qsearch); +use FS::svc_acct; + +getopts('olp:b:d:s:t:'); + +my $user = shift or &usage; +adminsuidsetup $user; + +my $conf = new FS::Conf; +my $default_locale = $conf->config('locale') || 'en_US'; + +my %search = (); + +$search{payby} = [ split(/\s*,\s*/, $opt_p) ] if $opt_p; +$search{balance} = $opt_b if $opt_b; +$search{balance_days} = $opt_d if $opt_d; +$search{svcpart} = [ split(/\s*,\s*/, $opt_s) ] if $opt_s; +$search{cust_status} = lc($opt_t) if $opt_t; + +my @svc_acct = qsearch( FS::svc_acct->search(\%search) ); + +foreach my $svc_acct (@svc_acct) { + print $svc_acct->username; + print '@'. $svc_acct->domain if $opt_o; + if ( $opt_l ) { + my $cust_pkg = $svc_acct->cust_svc->cust_pkg; + print ','. ($cust_pkg && $cust_pkg->cust_main->locale || $default_locale); + } + print "\n"; +} + +sub usage { + die "usage: freeside-username_list [ -c ] [ -l ] [ -p payby,payby... ] [ -b balance [ -d balance_days ] ] [ -s svcpart,svcpart... ] username \n"; +} + +=head1 NAME + +freeside-username_list + +=head1 SYNOPSIS + + freeside-username_list [ -c ] [ -l ] [ -p payby,payby... ] [ -b balance [ -d balance_days ] ] [ -s svcpart,svcpart... ] username + +=head1 DESCRIPTION + +Command-line tool to list usernames. + +Display options: + +-o: Include domain + +-l: Include customer locale + +Selection options: + +-p: Customer payby (CARD, BILL, etc.). Separate multiple values with commas. + +-b: Customer balance over (or equal to) this amount + +-d: Customer balance age over this many days + +-s: Service definition (svcpart). Separate multiple values with commas. + +-t: Customer status: prospect, active, ordered, inactive, suspended or cancelled + +username: Employee username + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::svc_acct>, L<FS::cust_main> + +=cut + +1; + diff --git a/FS/bin/freeside-void-payments b/FS/bin/freeside-void-payments index 8c1f3dbdf..49b74d388 100755 --- a/FS/bin/freeside-void-payments +++ b/FS/bin/freeside-void-payments @@ -90,8 +90,11 @@ 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 $cust_pay = qsearchs('cust_pay', { + gatewaynum => $gatewaynum, + processor => $processor, + authorization => $authnum, + }); my $error; my $cancel_error; if($cust_pay) { @@ -103,7 +106,11 @@ foreach my $authnum (@auths) { } } else { - my $cpv = qsearchs('cust_pay_void', { paybatch => $paybatch }); + my $cpv = qsearchs('cust_pay_void', { + gatewaynum => $gatewaynum, + processor => $processor, + authorization => $authnum, + }); if($cpv) { $error = 'already voided '.time2str('%Y-%m-%d', $cpv->void_date) . ' by ' . $cpv->otaker; diff --git a/FS/bin/freeside-wkhtmltopdf b/FS/bin/freeside-wkhtmltopdf index c6c5531a5..f0c53e6da 100755 --- a/FS/bin/freeside-wkhtmltopdf +++ b/FS/bin/freeside-wkhtmltopdf @@ -1,7 +1,7 @@ #!/bin/sh -if [ $DISPLAY ] ; then - wkhtmltopdf $@ -else +#if [ $DISPLAY ] ; then +# wkhtmltopdf $@ +#else xvfb-run -- wkhtmltopdf $@ -fi +#fi diff --git a/FS/t/GeocodeCache.t b/FS/t/GeocodeCache.t new file mode 100644 index 000000000..eae6f0d01 --- /dev/null +++ b/FS/t/GeocodeCache.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::GeocodeCache; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/access_user_session.t b/FS/t/access_user_session.t new file mode 100644 index 000000000..ab3a59acc --- /dev/null +++ b/FS/t/access_user_session.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::access_user_session; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/agent_currency.t b/FS/t/agent_currency.t new file mode 100644 index 000000000..152e066b5 --- /dev/null +++ b/FS/t/agent_currency.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::agent_currency; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cable_device.t b/FS/t/cable_device.t new file mode 100644 index 000000000..016d2c5c1 --- /dev/null +++ b/FS/t/cable_device.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cable_device; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cdr_cust_pkg_usage.t b/FS/t/cdr_cust_pkg_usage.t new file mode 100644 index 000000000..1e2060e96 --- /dev/null +++ b/FS/t/cdr_cust_pkg_usage.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cdr_cust_pkg_usage; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/contact_Mixin.t b/FS/t/contact_Mixin.t new file mode 100644 index 000000000..89dcc37c5 --- /dev/null +++ b/FS/t/contact_Mixin.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::contact_Mixin; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/currency_exchange.t b/FS/t/currency_exchange.t new file mode 100644 index 000000000..6f8ac1de0 --- /dev/null +++ b/FS/t/currency_exchange.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::currency_exchange; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_pkg_usage.t b/FS/t/cust_pkg_usage.t new file mode 100644 index 000000000..23a7b299e --- /dev/null +++ b/FS/t/cust_pkg_usage.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_pkg_usage; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/h_svc_cable.t b/FS/t/h_svc_cable.t new file mode 100644 index 000000000..7f9fad585 --- /dev/null +++ b/FS/t/h_svc_cable.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_svc_cable; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/ftp_target.t b/FS/t/log.t index 1a5928118..42c604b88 100644 --- a/FS/t/ftp_target.t +++ b/FS/t/log.t @@ -1,5 +1,5 @@ BEGIN { $| = 1; print "1..1\n" } END {print "not ok 1\n" unless $loaded;} -use FS::ftp_target; +use FS::log; $loaded=1; print "ok 1\n"; diff --git a/FS/t/log_context.t b/FS/t/log_context.t new file mode 100644 index 000000000..57c3b340b --- /dev/null +++ b/FS/t/log_context.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::log_context; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg_currency.t b/FS/t/part_pkg_currency.t new file mode 100644 index 000000000..b8654c7e3 --- /dev/null +++ b/FS/t/part_pkg_currency.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg_currency; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg_msgcat.t b/FS/t/part_pkg_msgcat.t new file mode 100644 index 000000000..541c16799 --- /dev/null +++ b/FS/t/part_pkg_msgcat.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg_msgcat; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg_usage.t b/FS/t/part_pkg_usage.t new file mode 100644 index 000000000..ba5ccb6c8 --- /dev/null +++ b/FS/t/part_pkg_usage.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg_usage; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg_usage_class.t b/FS/t/part_pkg_usage_class.t new file mode 100644 index 000000000..e46ff0648 --- /dev/null +++ b/FS/t/part_pkg_usage_class.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg_usage_class; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_cable.t b/FS/t/svc_cable.t new file mode 100644 index 000000000..505765990 --- /dev/null +++ b/FS/t/svc_cable.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_cable; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/upload_target.t b/FS/t/upload_target.t new file mode 100644 index 000000000..6d55de0f2 --- /dev/null +++ b/FS/t/upload_target.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::upload_target; +$loaded=1; +print "ok 1\n"; |