4 use vars qw( @ISA @EXPORT_OK $DEBUG );
8 use FS::UID qw( dbh driver_name );
10 use FS::Record qw(qsearchs qsearch str2time_sql);
12 use FS::upgrade_journal;
15 $FS::svc_domain::whois_hack = 1;
17 @ISA = qw( Exporter );
18 @EXPORT_OK = qw( upgrade_schema upgrade_config upgrade upgrade_sqlradius );
24 FS::Upgrade - Database upgrade routines
32 Currently this module simply provides a place to store common subroutines for
47 my $conf = new FS::Conf;
49 if ($conf->config('invoice_from') =~ /\<(.*)\>/) {
51 $realemail =~ s/^\s*//; # remove leading spaces
52 $realemail =~ s/\s*$//; # remove trailing spaces
53 my $realname = $conf->config('invoice_from');
54 $realname =~ s/\<.*\>//; # remove email address
55 $realname =~ s/^\s*//; # remove leading spaces
56 $realname =~ s/\s*$//; # remove trailing spaces
57 # properly quote names that contain punctuation
58 if (($realname =~ /[^[:alnum:][:space:]]/) && ($realname !~ /^\".*\"$/)) {
59 $realname = '"' . $realname . '"';
61 $conf->set('invoice_from_name', $realname);
62 $conf->set('invoice_from', $realemail);
65 $conf->touch('payment_receipt')
66 if $conf->exists('payment_receipt_email')
67 || $conf->config('payment_receipt_msgnum');
69 $conf->touch('geocode-require_nw_coordinates')
70 if $conf->exists('svc_broadband-require-nw-coordinates');
72 unless ( $conf->config('echeck-country') ) {
73 if ( $conf->exists('cust_main-require-bank-branch') ) {
74 $conf->set('echeck-country', 'CA');
75 } elsif ( $conf->exists('echeck-nonus') ) {
76 $conf->set('echeck-country', 'XX');
78 $conf->set('echeck-country', 'US');
82 upgrade_overlimit_groups($conf);
83 map { upgrade_overlimit_groups($conf,$_->agentnum) } qsearch('agent', {});
85 my $DIST_CONF = '/usr/local/etc/freeside/default_conf/';#DIST_CONF in Makefile
86 $conf->set($_, scalar(read_file( "$DIST_CONF/$_" )) )
87 foreach grep { ! $conf->exists($_) && -s "$DIST_CONF/$_" }
88 qw( quotation_html quotation_latex quotation_latexnotes );
90 # change 'fslongtable' to 'longtable'
91 # in invoice and quotation main templates, and also in all secondary
94 qsearch('conf', { 'name' => {op=>'LIKE', value=>'%latex%'} });
96 foreach my $c (@latex_confs) {
97 my $value = $c->value;
98 if (length($value) and $value =~ /fslongtable/) {
99 $value =~ s/fslongtable/longtable/g;
100 $conf->set($c->name, $value, $c->agentnum);
104 # if there's a USPS tools login, assume that's the standardization method
106 $conf->set('address_standardize_method', 'usps')
107 if $conf->exists('usps_webtools-userid')
108 && length($conf->config('usps_webtools-userid')) > 0
109 && ! $conf->exists('address_standardize_method');
111 # this option has been renamed/expanded
112 if ( $conf->exists('cust_main-enable_spouse_birthdate') ) {
113 $conf->touch('cust_main-enable_spouse');
114 $conf->delete('cust_main-enable_spouse_birthdate');
118 if ( $conf->exists('cust_pkg-show_fcc_voice_grade_equivalent') ) {
119 $conf->touch('part_pkg-show_fcc_options');
120 $conf->delete('cust_pkg-show_fcc_voice_grade_equivalent');
122 You have FCC Form 477 package options enabled.
124 Starting with the October 2014 filing date, the FCC has redesigned
125 Form 477 and introduced new service categories. See bin/convert-477-options
126 to update your package configuration for the new report.
128 If you need to continue using the old Form 477 report, turn on the
129 'old_fcc_report' configuration option.
133 # boolean invoice_sections_by_location option is now
134 # invoice_sections_method = 'location'
135 my @invoice_sections_confs =
136 qsearch('conf', { 'name' => { op=>'LIKE', value=>'%sections_by_location' } });
137 foreach my $c (@invoice_sections_confs) {
138 $c->name =~ /^(\w+)sections_by_location$/;
139 $conf->delete($c->name);
140 my $newname = $1.'sections_method';
141 $conf->set($newname, 'location');
144 # boolean enable_taxproducts is now enable_taxproducts = 'cch'
145 if ( $conf->exists('enable_taxproducts') and
146 $conf->config('enable_taxproducts') eq '' ) {
148 $conf->set('enable_taxproducts', 'cch');
152 # boolean tax-cust_exempt-groups-require_individual_nums is now -num_req all
153 if ( $conf->exists('tax-cust_exempt-groups-require_individual_nums') ) {
154 $conf->set('tax-cust_exempt-groups-num_req', 'all');
155 $conf->delete('tax-cust_exempt-groups-require_individual_nums');
160 sub upgrade_overlimit_groups {
162 my $agentnum = shift;
163 my @groups = $conf->config('overlimit_groups',$agentnum);
164 if(scalar(@groups)) {
165 my $groups = join(',',@groups);
168 if ( $groups !~ /^[\d,]+$/ ) {
169 foreach my $groupname ( @groups ) {
170 my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
172 $g = new FS::radius_group {
173 'groupname' => $groupname,
174 'description' => $groupname,
177 die $error if $error;
179 push @groupnums, $g->groupnum;
181 $conf->set('overlimit_groups',join("\n",@groupnums),$agentnum);
193 my $data = upgrade_data(%opt);
195 my $oldAutoCommit = $FS::UID::AutoCommit;
196 local $FS::UID::AutoCommit = 0;
197 local $FS::UID::AutoCommit = 0;
199 local $FS::cust_pkg::upgrade = 1; #go away after setup+start dates cleaned up for old customers
202 foreach my $table ( keys %$data ) {
204 my $class = "FS::$table";
208 if ( $class->can('_upgrade_data') ) {
209 warn "Upgrading $table...\n";
213 $class->_upgrade_data(%opt);
215 # New interface for async upgrades: a class can declare a
216 # "queueable_upgrade" method, which will run as part of the normal
217 # upgrade, but if the -j option is passed, will instead be run from
219 if ( $class->can('queueable_upgrade') ) {
220 my $jobname = $class . '::queueable_upgrade';
221 my $num_jobs = FS::queue->count("job = '$jobname' and status != 'failed'");
223 warn "$class upgrade already scheduled.\n";
225 if ( $opt{'queue'} ) {
226 warn "Scheduling $class upgrade.\n";
227 my $job = FS::queue->new({ job => $jobname });
228 $job->insert($class, %opt);
230 $class->queueable_upgrade(%opt);
235 if ( $oldAutoCommit ) {
236 warn " committing\n";
237 dbh->commit or die dbh->errstr;
240 #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
241 warn " done in ". (time-$start). " seconds\n";
244 warn "WARNING: asked for upgrade of $table,".
245 " but FS::$table has no _upgrade_data method\n";
248 # my @records = @{ $data->{$table} };
250 # foreach my $record ( @records ) {
251 # my $args = delete($record->{'_upgrade_args'}) || [];
252 # my $object = $class->new( $record );
253 # my $error = $object->insert( @$args );
254 # die "error inserting record into $table: $error\n"
260 local($FS::cust_main::ignore_expired_card) = 1;
261 #this is long-gone... would need to set an equivalent in cust_location #local($FS::cust_main::ignore_illegal_zip) = 1;
262 local($FS::cust_main::ignore_banned_card) = 1;
263 local($FS::cust_main::skip_fuzzyfiles) = 1;
265 local($FS::cust_payby::ignore_expired_card) = 1;
266 local($FS::cust_payby::ignore_banned_card) = 1;
268 # decrypt inadvertantly-encrypted payinfo where payby != CARD,DCRD,CHEK,DCHK
269 # kind of a weird spot for this, but it's better than duplicating
270 # all this code in each class...
271 my @decrypt_tables = qw( cust_main cust_pay_void cust_pay cust_refund cust_pay_pending );
272 foreach my $table ( @decrypt_tables ) {
273 my @objects = qsearch({
276 'extra_sql' => "WHERE payby NOT IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
277 " AND LENGTH(payinfo) > 100",
279 foreach my $object ( @objects ) {
280 my $payinfo = $object->decrypt($object->payinfo);
281 die "error decrypting payinfo" if $payinfo eq $object->payinfo;
282 $object->payinfo($payinfo);
283 my $error = $object->replace;
284 die $error if $error;
297 tie my %hash, 'Tie::IxHash',
299 #cust_main (remove paycvv from history)
305 #reason type and reasons
307 'cust_pkg_reason' => [],
309 #need part_pkg before cust_credit...
315 #duplicate history records
318 #populate cust_pay.otaker
321 #populate part_pkg_taxclass for starters
322 'part_pkg_taxclass' => [],
324 #remove bad pending records
325 'cust_pay_pending' => [],
327 #replace invnum and pkgnum with billpkgnum
328 'cust_bill_pkg_detail' => [],
330 #usage_classes if we have none
333 #phone_type if we have none
337 'access_right' => [],
339 #change recur_flat and enable_prorate
340 'part_pkg_option' => [],
342 #add weights to pkg_category
343 'pkg_category' => [],
349 'cust_attachment' => [],
350 #'cust_credit' => [],
352 'cust_main_note' => [],
354 'cust_pay_void' => [],
356 #'cust_pkg_reason' => [],
357 'cust_pkg_discount' => [],
362 'payment_gateway' => [],
364 #migrate to templates
365 'msg_template' => [],
367 #return unprovisioned numbers to availability
370 #insert scripcondition
371 'TicketSystem' => [],
373 #insert LATA data if not already present
376 #insert MSA data if not already present
379 # migrate to radius_group and groupnum instead of groupname
380 'radius_usergroup' => [],
384 #insert default tower_sector if not present
387 #repair improperly deleted services
391 'svc_broadband' => [],
393 #set up payment gateways if needed
396 #flag monthly tax exemptions
397 'cust_tax_exempt_pkg' => [],
399 #kick off tax location history upgrade
400 'cust_bill_pkg' => [],
402 #fix taxable line item links
403 'cust_bill_pkg_tax_location' => [],
405 #populate state FIPS codes if not already done
408 #populate tax statuses
423 my $data = upgrade_schema_data(%opt);
425 my $oldAutoCommit = $FS::UID::AutoCommit;
426 local $FS::UID::AutoCommit = 0;
427 local $FS::UID::AutoCommit = 0;
429 foreach my $table ( keys %$data ) {
431 my $class = "FS::$table";
435 if ( $class->can('_upgrade_schema') ) {
436 warn "Upgrading $table schema...\n";
440 $class->_upgrade_schema(%opt);
442 if ( $oldAutoCommit ) {
443 warn " committing\n";
444 dbh->commit or die dbh->errstr;
447 #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
448 warn " done in ". (time-$start). " seconds\n";
451 warn "WARNING: asked for schema upgrade of $table,".
452 " but FS::$table has no _upgrade_schema method\n";
459 =item upgrade_schema_data
463 sub upgrade_schema_data {
466 tie my %hash, 'Tie::IxHash',
468 #fix classnum character(1)
469 'cust_bill_pkg_detail' => [],
470 #add necessary columns to RT schema
471 'TicketSystem' => [],
479 sub upgrade_sqlradius {
482 my $conf = new FS::Conf;
484 my @part_export = FS::part_export::sqlradius->all_sqlradius_withaccounting();
486 foreach my $part_export ( @part_export ) {
488 my $errmsg = 'Error adding FreesideStatus to '.
489 $part_export->option('datasrc'). ': ';
491 my $dbh = DBI->connect(
492 ( map $part_export->option($_), qw ( datasrc username password ) ),
493 { PrintError => 0, PrintWarn => 0 }
495 warn $errmsg.$DBI::errstr;
499 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
500 my $group = "UserName";
502 if ref($part_export) =~ /withdomain/
503 || $dbh->{Driver}->{Name} =~ /^Pg/; #hmm
505 my $sth_alter = $dbh->prepare(
506 "ALTER TABLE radacct ADD COLUMN FreesideStatus varchar(32) NULL"
509 if ( $sth_alter->execute ) {
510 my $sth_update = $dbh->prepare(
511 "UPDATE radacct SET FreesideStatus = 'done' WHERE FreesideStatus IS NULL"
512 ) or die $errmsg.$dbh->errstr;
513 $sth_update->execute or die $errmsg.$sth_update->errstr;
515 my $error = $sth_alter->errstr;
517 unless $error =~ /Duplicate column name/i #mysql
518 || $error =~ /already exists/i; #Pg
522 my $error = $dbh->errstr;
523 warn $errmsg.$error; #unless $error =~ /exists/i;
526 my $sth_index = $dbh->prepare(
527 "CREATE INDEX FreesideStatus ON radacct ( FreesideStatus )"
530 unless ( $sth_index->execute ) {
531 my $error = $sth_index->errstr;
533 unless $error =~ /Duplicate key name/i #mysql
534 || $error =~ /already exists/i; #Pg
537 my $error = $dbh->errstr;
538 warn $errmsg.$error. ' (preparing statement)';#unless $error =~ /exists/i;
541 my $times = ($dbh->{Driver}->{Name} =~ /^mysql/)
542 ? ' AcctStartTime != 0 AND AcctStopTime != 0 '
543 : ' AcctStartTime IS NOT NULL AND AcctStopTime IS NOT NULL ';
545 my $sth = $dbh->prepare("SELECT UserName,
547 $str2time max(AcctStartTime)),
548 $str2time max(AcctStopTime))
550 WHERE FreesideStatus = 'done'
554 or die $errmsg.$dbh->errstr;
555 $sth->execute() or die $errmsg.$sth->errstr;
557 while (my $row = $sth->fetchrow_arrayref ) {
558 my ($username, $realm, $start, $stop) = @$row;
560 $username = lc($username) unless $conf->exists('username-uppercase');
562 my $exportnum = $part_export->exportnum;
563 my $extra_sql = " AND exportnum = $exportnum ".
564 " AND exportsvcnum IS NOT NULL ";
566 if ( ref($part_export) =~ /withdomain/ ) {
567 $extra_sql = " AND '$realm' = ( SELECT domain FROM svc_domain
568 WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
571 my $svc_acct = qsearchs({
572 'select' => 'svc_acct.*',
573 'table' => 'svc_acct',
574 'addl_from' => 'LEFT JOIN cust_svc USING ( svcnum )'.
575 'LEFT JOIN export_svc USING ( svcpart )',
576 'hashref' => { 'username' => $username },
577 'extra_sql' => $extra_sql,
581 $svc_acct->last_login($start)
582 if $start && (!$svc_acct->last_login || $start > $svc_acct->last_login);
583 $svc_acct->last_logout($stop)
584 if $stop && (!$svc_acct->last_logout || $stop > $svc_acct->last_logout);