backoffice API: add new_customer, RT#22830
[freeside.git] / FS / FS / Upgrade.pm
1 package FS::Upgrade;
2
3 use strict;
4 use vars qw( @ISA @EXPORT_OK $DEBUG );
5 use Exporter;
6 use Tie::IxHash;
7 use FS::UID qw( dbh driver_name );
8 use FS::Conf;
9 use FS::Record qw(qsearchs qsearch str2time_sql);
10 use FS::upgrade_journal;
11
12 use FS::svc_domain;
13 $FS::svc_domain::whois_hack = 1;
14
15 @ISA = qw( Exporter );
16 @EXPORT_OK = qw( upgrade_schema upgrade_config upgrade upgrade_sqlradius );
17
18 $DEBUG = 1;
19
20 =head1 NAME
21
22 FS::Upgrade - Database upgrade routines
23
24 =head1 SYNOPSIS
25
26   use FS::Upgrade;
27
28 =head1 DESCRIPTION
29
30 Currently this module simply provides a place to store common subroutines for
31 database upgrades.
32
33 =head1 SUBROUTINES
34
35 =over 4
36
37 =item upgrade_config
38
39 =cut
40
41 #config upgrades
42 sub upgrade_config {
43   my %opt = @_;
44
45   my $conf = new FS::Conf;
46
47   $conf->touch('payment_receipt')
48     if $conf->exists('payment_receipt_email')
49     || $conf->config('payment_receipt_msgnum');
50
51   $conf->touch('geocode-require_nw_coordinates')
52     if $conf->exists('svc_broadband-require-nw-coordinates');
53
54   unless ( $conf->config('echeck-country') ) {
55     if ( $conf->exists('cust_main-require-bank-branch') ) {
56       $conf->set('echeck-country', 'CA');
57     } elsif ( $conf->exists('echeck-nonus') ) {
58       $conf->set('echeck-country', 'XX');
59     } else {
60       $conf->set('echeck-country', 'US');
61     }
62   }
63
64   upgrade_overlimit_groups($conf);
65   map { upgrade_overlimit_groups($conf,$_->agentnum) } qsearch('agent', {});
66   
67   # change 'fslongtable' to 'longtable'
68   # in invoice main template, and also in all secondary invoice templates
69   my @latex_confs =
70   qsearch('conf', { 'name' => {op=>'LIKE', value=>'%latex%'} });
71
72   foreach my $c (@latex_confs) {
73     my $value = $c->value;
74     if (length($value) and $value =~ /fslongtable/) {
75       $value =~ s/fslongtable/longtable/g;
76       $conf->set($c->name, $value, $c->agentnum);
77     }
78   }
79
80 }
81
82 sub upgrade_overlimit_groups {
83     my $conf = shift;
84     my $agentnum = shift;
85     my @groups = $conf->config('overlimit_groups',$agentnum); 
86     if(scalar(@groups)) {
87         my $groups = join(',',@groups);
88         my @groupnums;
89         my $error = '';
90         if ( $groups !~ /^[\d,]+$/ ) {
91             foreach my $groupname ( @groups ) {
92                 my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
93                 unless ( $g ) {
94                     $g = new FS::radius_group {
95                                     'groupname' => $groupname,
96                                     'description' => $groupname,
97                                     };
98                     $error = $g->insert;
99                     die $error if $error;
100                 }
101                 push @groupnums, $g->groupnum;
102             }
103             $conf->set('overlimit_groups',join("\n",@groupnums),$agentnum);
104         }
105     }
106 }
107
108 =item upgrade
109
110 =cut
111
112 sub upgrade {
113   my %opt = @_;
114
115   my $data = upgrade_data(%opt);
116
117   my $oldAutoCommit = $FS::UID::AutoCommit;
118   local $FS::UID::AutoCommit = 0;
119   local $FS::UID::AutoCommit = 0;
120
121   foreach my $table ( keys %$data ) {
122
123     my $class = "FS::$table";
124     eval "use $class;";
125     die $@ if $@;
126
127     if ( $class->can('_upgrade_data') ) {
128       warn "Upgrading $table...\n";
129
130       my $start = time;
131
132       $class->_upgrade_data(%opt);
133
134       if ( $oldAutoCommit ) {
135         warn "  committing\n";
136         dbh->commit or die dbh->errstr;
137       }
138       
139       #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
140       warn "  done in ". (time-$start). " seconds\n";
141
142     } else {
143       warn "WARNING: asked for upgrade of $table,".
144            " but FS::$table has no _upgrade_data method\n";
145     }
146
147 #    my @records = @{ $data->{$table} };
148 #
149 #    foreach my $record ( @records ) {
150 #      my $args = delete($record->{'_upgrade_args'}) || [];
151 #      my $object = $class->new( $record );
152 #      my $error = $object->insert( @$args );
153 #      die "error inserting record into $table: $error\n"
154 #        if $error;
155 #    }
156
157   }
158
159   local($FS::cust_main::ignore_expired_card) = 1;
160   local($FS::cust_main::ignore_illegal_zip) = 1;
161   local($FS::cust_main::ignore_banned_card) = 1;
162   local($FS::cust_main::skip_fuzzyfiles) = 1;
163
164   # decrypt inadvertantly-encrypted payinfo where payby != CARD,DCRD,CHEK,DCHK
165   # kind of a weird spot for this, but it's better than duplicating
166   # all this code in each class...
167   my @decrypt_tables = qw( cust_main cust_pay_void cust_pay cust_refund cust_pay_pending );
168   foreach my $table ( @decrypt_tables ) {
169       my @objects = qsearch({
170         'table'     => $table,
171         'hashref'   => {},
172         'extra_sql' => "WHERE payby NOT IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
173                        " AND LENGTH(payinfo) > 100",
174       });
175       foreach my $object ( @objects ) {
176           my $payinfo = $object->decrypt($object->payinfo);
177           die "error decrypting payinfo" if $payinfo eq $object->payinfo;
178           $object->payinfo($payinfo);
179           my $error = $object->replace;
180           die $error if $error;
181       }
182   }
183
184 }
185
186 =item upgrade_data
187
188 =cut
189
190 sub upgrade_data {
191   my %opt = @_;
192
193   tie my %hash, 'Tie::IxHash', 
194
195     #cust_main (remove paycvv from history)
196     'cust_main' => [],
197
198     #msgcat
199     'msgcat' => [],
200
201     #reason type and reasons
202     'reason_type'     => [],
203     'cust_pkg_reason' => [],
204
205     #need part_pkg before cust_credit...
206     'part_pkg' => [],
207
208     #customer credits
209     'cust_credit' => [],
210
211     #duplicate history records
212     'h_cust_svc'  => [],
213
214     #populate cust_pay.otaker
215     'cust_pay'    => [],
216
217     #populate part_pkg_taxclass for starters
218     'part_pkg_taxclass' => [],
219
220     #remove bad pending records
221     'cust_pay_pending' => [],
222
223     #replace invnum and pkgnum with billpkgnum
224     'cust_bill_pkg_detail' => [],
225
226     #usage_classes if we have none
227     'usage_class' => [],
228
229     #phone_type if we have none
230     'phone_type' => [],
231
232     #fixup access rights
233     'access_right' => [],
234
235     #change recur_flat and enable_prorate
236     'part_pkg_option' => [],
237
238     #add weights to pkg_category
239     'pkg_category' => [],
240
241     #cdrbatch fixes
242     'cdr' => [],
243
244     #otaker->usernum
245     'cust_attachment' => [],
246     #'cust_credit' => [],
247     #'cust_main' => [],
248     'cust_main_note' => [],
249     #'cust_pay' => [],
250     'cust_pay_void' => [],
251     'cust_pkg' => [],
252     #'cust_pkg_reason' => [],
253     'cust_pkg_discount' => [],
254     'cust_refund' => [],
255     'banned_pay' => [],
256
257     #default namespace
258     'payment_gateway' => [],
259
260     #migrate to templates
261     'msg_template' => [],
262
263     #return unprovisioned numbers to availability
264     'phone_avail' => [],
265
266     #insert scripcondition
267     'TicketSystem' => [],
268     
269     #insert LATA data if not already present
270     'lata' => [],
271     
272     #insert MSA data if not already present
273     'msa' => [],
274
275     # migrate to radius_group and groupnum instead of groupname
276     'radius_usergroup' => [],
277     'part_svc'         => [],
278     'part_export'      => [],
279
280     #insert default tower_sector if not present
281     'tower' => [],
282
283     #routernum/blocknum
284     'svc_broadband' => [],
285   ;
286
287   \%hash;
288
289 }
290
291 =item upgrade_schema
292
293 =cut
294
295 sub upgrade_schema {
296   my %opt = @_;
297
298   my $data = upgrade_schema_data(%opt);
299
300   my $oldAutoCommit = $FS::UID::AutoCommit;
301   local $FS::UID::AutoCommit = 0;
302   local $FS::UID::AutoCommit = 0;
303
304   foreach my $table ( keys %$data ) {
305
306     my $class = "FS::$table";
307     eval "use $class;";
308     die $@ if $@;
309
310     if ( $class->can('_upgrade_schema') ) {
311       warn "Upgrading $table schema...\n";
312
313       my $start = time;
314
315       $class->_upgrade_schema(%opt);
316
317       if ( $oldAutoCommit ) {
318         warn "  committing\n";
319         dbh->commit or die dbh->errstr;
320       }
321       
322       #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
323       warn "  done in ". (time-$start). " seconds\n";
324
325     } else {
326       warn "WARNING: asked for schema upgrade of $table,".
327            " but FS::$table has no _upgrade_schema method\n";
328     }
329
330   }
331
332 }
333
334 =item upgrade_schema_data
335
336 =cut
337
338 sub upgrade_schema_data {
339   my %opt = @_;
340
341   tie my %hash, 'Tie::IxHash', 
342
343     #fix classnum character(1)
344     'cust_bill_pkg_detail' => [],
345     #add necessary columns to RT schema
346     'TicketSystem' => [],
347
348   ;
349
350   \%hash;
351
352 }
353
354 sub upgrade_sqlradius {
355   #my %opt = @_;
356
357   my $conf = new FS::Conf;
358
359   my @part_export = FS::part_export::sqlradius->all_sqlradius_withaccounting();
360
361   foreach my $part_export ( @part_export ) {
362
363     my $errmsg = 'Error adding FreesideStatus to '.
364                  $part_export->option('datasrc'). ': ';
365
366     my $dbh = DBI->connect(
367       ( map $part_export->option($_), qw ( datasrc username password ) ),
368       { PrintError => 0, PrintWarn => 0 }
369     ) or do {
370       warn $errmsg.$DBI::errstr;
371       next;
372     };
373
374     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
375     my $group = "UserName";
376     $group .= ",Realm"
377       if ref($part_export) =~ /withdomain/
378       || $dbh->{Driver}->{Name} =~ /^Pg/; #hmm
379
380     my $sth_alter = $dbh->prepare(
381       "ALTER TABLE radacct ADD COLUMN FreesideStatus varchar(32) NULL"
382     );
383     if ( $sth_alter ) {
384       if ( $sth_alter->execute ) {
385         my $sth_update = $dbh->prepare(
386          "UPDATE radacct SET FreesideStatus = 'done' WHERE FreesideStatus IS NULL"
387         ) or die $errmsg.$dbh->errstr;
388         $sth_update->execute or die $errmsg.$sth_update->errstr;
389       } else {
390         my $error = $sth_alter->errstr;
391         warn $errmsg.$error
392           unless $error =~ /Duplicate column name/i  #mysql
393               || $error =~ /already exists/i;        #Pg
394 ;
395       }
396     } else {
397       my $error = $dbh->errstr;
398       warn $errmsg.$error; #unless $error =~ /exists/i;
399     }
400
401     my $sth_index = $dbh->prepare(
402       "CREATE INDEX FreesideStatus ON radacct ( FreesideStatus )"
403     );
404     if ( $sth_index ) {
405       unless ( $sth_index->execute ) {
406         my $error = $sth_index->errstr;
407         warn $errmsg.$error
408           unless $error =~ /Duplicate key name/i #mysql
409               || $error =~ /already exists/i;    #Pg
410       }
411     } else {
412       my $error = $dbh->errstr;
413       warn $errmsg.$error. ' (preparing statement)';#unless $error =~ /exists/i;
414     }
415
416     my $times = ($dbh->{Driver}->{Name} =~ /^mysql/)
417       ? ' AcctStartTime != 0 AND AcctStopTime != 0 '
418       : ' AcctStartTime IS NOT NULL AND AcctStopTime IS NOT NULL ';
419
420     my $sth = $dbh->prepare("SELECT UserName,
421                                     Realm,
422                                     $str2time max(AcctStartTime)),
423                                     $str2time max(AcctStopTime))
424                               FROM radacct
425                               WHERE FreesideStatus = 'done'
426                                 AND $times
427                               GROUP BY $group
428                             ")
429       or die $errmsg.$dbh->errstr;
430     $sth->execute() or die $errmsg.$sth->errstr;
431   
432     while (my $row = $sth->fetchrow_arrayref ) {
433       my ($username, $realm, $start, $stop) = @$row;
434   
435       $username = lc($username) unless $conf->exists('username-uppercase');
436
437       my $exportnum = $part_export->exportnum;
438       my $extra_sql = " AND exportnum = $exportnum ".
439                       " AND exportsvcnum IS NOT NULL ";
440
441       if ( ref($part_export) =~ /withdomain/ ) {
442         $extra_sql = " AND '$realm' = ( SELECT domain FROM svc_domain
443                          WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
444       }
445   
446       my $svc_acct = qsearchs({
447         'select'    => 'svc_acct.*',
448         'table'     => 'svc_acct',
449         'addl_from' => 'LEFT JOIN cust_svc   USING ( svcnum )'.
450                        'LEFT JOIN export_svc USING ( svcpart )',
451         'hashref'   => { 'username' => $username },
452         'extra_sql' => $extra_sql,
453       });
454
455       if ($svc_acct) {
456         $svc_acct->last_login($start)
457           if $start && (!$svc_acct->last_login || $start > $svc_acct->last_login);
458         $svc_acct->last_logout($stop)
459           if $stop && (!$svc_acct->last_logout || $stop > $svc_acct->last_logout);
460       }
461     }
462   }
463
464 }
465
466 =back
467
468 =head1 BUGS
469
470 Sure.
471
472 =head1 SEE ALSO
473
474 =cut
475
476 1;
477