use strict;
use vars qw($VERSION);
-$VERSION = '3.0';
+$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
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
L<FS::part_pkg> - Package definition class
+L<FS::part_pkg_msgcat> - Package definition localization class
+
L<FS::part_pkg_link> - Package definition link class
L<FS::part_pkg_taxclass> - Tax class class
'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',
],
},
'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) ],
},
{
{
'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).',
'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) ],
},
{
'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) ],
},
{
'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.',
},
{
+ '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.',
},
{
+ '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?
'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" },
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 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
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;
use FS::part_pkg_usage_class;
use FS::part_pkg_usage;
use FS::cdr_cust_pkg_usage;
+ use FS::part_pkg_msgcat;
# Sammath Naur
if ( $FS::Mason::addl_handler_use ) {
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 FS::UID qw(dbh datasrc driver_name);
use FS::CurrentUser;
use FS::Schema qw(dbdef);
use FS::SearchCache;
# 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 = '';
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 );
}
"INSERT INTO h_". $self->table. " ( ".
join(', ', qw(history_date history_user history_action), @fields ).
") VALUES (".
- join(', ', $time, dbh->quote(getotaker()), dbh->quote($action), @values).
+ join(', ', $time,
+ dbh->quote( $FS::CurrentUser::CurrentUser->username ),
+ dbh->quote($action),
+ @values
+ ).
")"
;
}
#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 } );
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->{$_}
'custnum', 'int', '', '', '', '',
'pkgpart', 'int', '', '', '', '',
'pkgbatch', 'varchar', 'NULL', $char_d, '', '',
+ 'contactnum', 'int', 'NULL', '', '', '',
'locationnum', 'int', 'NULL', '', '', '',
'otaker', 'varchar', 'NULL', 32, '', '',
'usernum', 'int', 'NULL', '', '', '',
'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, '', '',
],
},
+ '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_link' => {
'columns' => [
'pkglinknum', 'serial', '', '', '', '',
'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' => [],
'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' ] ],
'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',
'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' ] ],
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;
}
use Carp;
use Storable qw(nfreeze);
use MIME::Base64;
-use JSON;
+use JSON::XS;
- use FS::UID qw(getotaker);
+ use FS::CurrentUser;
use FS::Record qw(qsearchs);
use FS::queue;
use FS::CGI qw(rooturl);
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 {
@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;
}
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);
$payby = 'PREP' if $amount;
- } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
+ } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|PPAL)$/ ) {
$payby = $1;
$self->payby('BILL');
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 ) {
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 );
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;
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
}
} #$object
} #$table
- FS::upgrade_journal->set_done('cust_pay__parse_paybatch');
+ FS::upgrade_journal->set_done('cust_pay__parse_paybatch_1');
}
}
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 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;
=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.
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
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;
$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')
=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 }
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 ) {
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;
$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
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>).
$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";
$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
# (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;
}
}
+ # 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";
+ }
+ }
+ }
+
# Order any supplemental packages.
my $part_pkg = $cust_pkg->part_pkg;
my @old_supp_pkgs = $self->supplemental_pkgs;
my $new = FS::cust_pkg->new({
pkgpart => $link->dst_pkgpart,
pkglinknum => $link->pkglinknum,
- custnum => $self->custnum,
+ custnum => $custnum,
main_pkgnum => $cust_pkg->pkgnum,
locationnum => $cust_pkg->locationnum,
start_date => $cust_pkg->start_date,
contract_end => $cust_pkg->contract_end,
refnum => $cust_pkg->refnum,
discountnum => $cust_pkg->discountnum,
- waive_setup => $cust_pkg->waive_setup
+ 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;
+ $error = $new->insert( allow_pkgpart => $same_pkgpart );
# transfer services
if ( $old ) {
$error ||= $old->transfer($new);
#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;
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
=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
$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.
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
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
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
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);
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,
projects / freeside.git / commitdiff