FS/FS/part_export.pm

   1 package FS::part_export;
   2 use base qw( FS::option_Common FS::m2m_Common );
   3
   4 use strict;
   5 use vars qw( @ISA @EXPORT_OK $DEBUG %exports );
   6 use Exporter;
   7 use Tie::IxHash;
   8 use FS::Record qw( qsearch qsearchs dbh );
   9 use FS::part_svc;
  10 use FS::part_export_option;
  11 use FS::part_export_machine;
  12 use FS::svc_export_machine;
  13
  14 #for export modules, though they should probably just use it themselves
  15 use FS::queue;
  16
  17 @EXPORT_OK = qw(export_info);
  18
  19 $DEBUG = 0;
  20
  21 =head1 NAME
  22
  23 FS::part_export - Object methods for part_export records
  24
  25 =head1 SYNOPSIS
  26
  27   use FS::part_export;
  28
  29   $record = new FS::part_export \%hash;
  30   $record = new FS::part_export { 'column' => 'value' };
  31
  32   #($new_record, $options) = $template_recored->clone( $svcpart );
  33
  34   $error = $record->insert( { 'option' => 'value' } );
  35   $error = $record->insert( \%options );
  36
  37   $error = $new_record->replace($old_record);
  38
  39   $error = $record->delete;
  40
  41   $error = $record->check;
  42
  43 =head1 DESCRIPTION
  44
  45 An FS::part_export object represents an export of Freeside data to an external
  46 provisioning system.  FS::part_export inherits from FS::Record.  The following
  47 fields are currently supported:
  48
  49 =over 4
  50
  51 =item exportnum - primary key
  52
  53 =item exportname - Descriptive name
  54
  55 =item machine - Machine name
  56
  57 =item exporttype - Export type
  58
  59 =item nodomain - blank or "Y" : usernames are exported to this service with no domain
  60
  61 =back
  62
  63 =head1 METHODS
  64
  65 =over 4
  66
  67 =item new HASHREF
  68
  69 Creates a new export.  To add the export to the database, see L<"insert">.
  70
  71 Note that this stores the hash reference, not a distinct copy of the hash it
  72 points to.  You can ask the object for a copy with the I<hash> method.
  73
  74 =cut
  75
  76 # the new method can be inherited from FS::Record, if a table method is defined
  77
  78 sub table { 'part_export'; }
  79
  80 =cut
  81
  82 #=item clone SVCPART
  83 #
  84 #An alternate constructor.  Creates a new export by duplicating an existing
  85 #export.  The given svcpart is assigned to the new export.
  86 #
  87 #Returns a list consisting of the new export object and a hashref of options.
  88 #
  89 #=cut
  90 #
  91 #sub clone {
  92 #  my $self = shift;
  93 #  my $class = ref($self);
  94 #  my %hash = $self->hash;
  95 #  $hash{'exportnum'} = '';
  96 #  $hash{'svcpart'} = shift;
  97 #  ( $class->new( \%hash ),
  98 #    { map { $_->optionname => $_->optionvalue }
  99 #        qsearch('part_export_option', { 'exportnum' => $self->exportnum } )
 100 #    }
 101 #  );
 102 #}
 103
 104 =item insert HASHREF
 105
 106 Adds this record to the database.  If there is an error, returns the error,
 107 otherwise returns false.
 108
 109 If a hash reference of options is supplied, part_export_option records are
 110 created (see L<FS::part_export_option>).
 111
 112 =cut
 113
 114 sub insert {
 115   my $self = shift;
 116
 117   local $SIG{HUP} = 'IGNORE';
 118   local $SIG{INT} = 'IGNORE';
 119   local $SIG{QUIT} = 'IGNORE';
 120   local $SIG{TERM} = 'IGNORE';
 121   local $SIG{TSTP} = 'IGNORE';
 122   local $SIG{PIPE} = 'IGNORE';
 123   my $oldAutoCommit = $FS::UID::AutoCommit;
 124   local $FS::UID::AutoCommit = 0;
 125   my $dbh = dbh;
 126
 127   my $error = $self->SUPER::insert(@_)
 128            || $self->replace;
 129   # use replace to do all the part_export_machine and default_machine stuff
 130   if ( $error ) {
 131     $dbh->rollback if $oldAutoCommit;
 132     return $error;
 133   }
 134
 135   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 136   '';
 137 }
 138
 139 =item delete
 140
 141 Delete this record from the database.
 142
 143 =cut
 144
 145 #foreign keys would make this much less tedious... grr dumb mysql
 146 sub delete {
 147   my $self = shift;
 148
 149   local $SIG{HUP} = 'IGNORE';
 150   local $SIG{INT} = 'IGNORE';
 151   local $SIG{QUIT} = 'IGNORE';
 152   local $SIG{TERM} = 'IGNORE';
 153   local $SIG{TSTP} = 'IGNORE';
 154   local $SIG{PIPE} = 'IGNORE';
 155   my $oldAutoCommit = $FS::UID::AutoCommit;
 156   local $FS::UID::AutoCommit = 0;
 157   my $dbh = dbh;
 158
 159   # clean up export_nas records
 160   my $error = $self->process_m2m(
 161     'link_table'    => 'export_nas',
 162     'target_table'  => 'nas',
 163     'params'        => [],
 164   ) || $self->process_m2m(
 165     'link_table'    => 'export_svc',
 166     'target_table'  => 'part_svc',
 167     'params'        => [],
 168   ) || $self->SUPER::delete;
 169   if ( $error ) {
 170     $dbh->rollback if $oldAutoCommit;
 171     return $error;
 172   }
 173
 174   foreach my $export_svc ( $self->export_svc ) {
 175     my $error = $export_svc->delete;
 176     if ( $error ) {
 177       $dbh->rollback if $oldAutoCommit;
 178       return $error;
 179     }
 180   }
 181
 182   foreach my $part_export_machine ( $self->part_export_machine ) {
 183     my $error = $part_export_machine->delete;
 184     if ( $error ) {
 185       $dbh->rollback if $oldAutoCommit;
 186       return $error;
 187     }
 188   }
 189
 190   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 191   '';
 192 }
 193
 194 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
 195
 196 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 197 returns the error, otherwise returns false.
 198
 199 If a list or hash reference of options is supplied, option records are created
 200 or modified.
 201
 202 =cut
 203
 204 sub replace {
 205   my $self = shift;
 206   my $old = $self->replace_old;
 207
 208   local $SIG{HUP} = 'IGNORE';
 209   local $SIG{INT} = 'IGNORE';
 210   local $SIG{QUIT} = 'IGNORE';
 211   local $SIG{TERM} = 'IGNORE';
 212   local $SIG{TSTP} = 'IGNORE';
 213   local $SIG{PIPE} = 'IGNORE';
 214
 215   my $oldAutoCommit = $FS::UID::AutoCommit;
 216   local $FS::UID::AutoCommit = 0;
 217   my $dbh = dbh;
 218   my $error;
 219
 220   if ( $self->part_export_machine_textarea ) {
 221
 222     my %part_export_machine = map { $_->machine => $_ }
 223                                 $self->part_export_machine;
 224
 225     my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ }
 226                      grep /\S/,
 227                        split /[\n\r]{1,2}/,
 228                          $self->part_export_machine_textarea;
 229
 230     foreach my $machine ( @machines ) {
 231
 232       if ( $part_export_machine{$machine} ) {
 233
 234         if ( $part_export_machine{$machine}->disabled eq 'Y' ) {
 235           $part_export_machine{$machine}->disabled('');
 236           $error = $part_export_machine{$machine}->replace;
 237           if ( $error ) {
 238             $dbh->rollback if $oldAutoCommit;
 239             return $error;
 240           }
 241         }
 242
 243         if ( $self->default_machine_name eq $machine ) {
 244           $self->default_machine( $part_export_machine{$machine}->machinenum );
 245         }
 246
 247         delete $part_export_machine{$machine}; #so we don't disable it below
 248
 249       } else {
 250
 251         my $part_export_machine = new FS::part_export_machine {
 252                                         'exportnum' => $self->exportnum,
 253                                         'machine'   => $machine
 254                                       };
 255         $error = $part_export_machine->insert;
 256         if ( $error ) {
 257           $dbh->rollback if $oldAutoCommit;
 258           return $error;
 259         }
 260
 261         if ( $self->default_machine_name eq $machine ) {
 262           $self->default_machine( $part_export_machine->machinenum );
 263         }
 264       }
 265
 266     }
 267
 268     foreach my $part_export_machine ( values %part_export_machine ) {
 269       $part_export_machine->disabled('Y');
 270       $error = $part_export_machine->replace;
 271       if ( $error ) {
 272         $dbh->rollback if $oldAutoCommit;
 273         return $error;
 274       }
 275     }
 276
 277     if ( $old->machine ne '_SVC_MACHINE' ) {
 278       # then set up the default for any already-attached export_svcs
 279       foreach my $export_svc ( $self->export_svc ) {
 280         my @svcs = qsearch('cust_svc', { 'svcpart' => $export_svc->svcpart });
 281         foreach my $cust_svc ( @svcs ) {
 282           my $svc_export_machine = FS::svc_export_machine->new({
 283               'exportnum'   => $self->exportnum,
 284               'svcnum'      => $cust_svc->svcnum,
 285               'machinenum'  => $self->default_machine,
 286           });
 287           $error ||= $svc_export_machine->insert;
 288         }
 289       }
 290       if ( $error ) {
 291         $dbh->rollback if $oldAutoCommit;
 292         return $error;
 293       }
 294     } # if switching to selectable hosts
 295
 296   } elsif ( $old->machine eq '_SVC_MACHINE' ) {
 297     # then we're switching from selectable to non-selectable
 298     foreach my $svc_export_machine (
 299       qsearch('svc_export_machine', { 'exportnum' => $self->exportnum })
 300     ) {
 301       $error ||= $svc_export_machine->delete;
 302     }
 303     if ( $error ) {
 304       $dbh->rollback if $oldAutoCommit;
 305       return $error;
 306     }
 307
 308   }
 309
 310   $error = $self->SUPER::replace(@_);
 311   if ( $error ) {
 312     $dbh->rollback if $oldAutoCommit;
 313     return $error;
 314   }
 315
 316   if ( $self->machine eq '_SVC_MACHINE' and ! $self->default_machine ) {
 317     $dbh->rollback if $oldAutoCommit;
 318     return "no default export host selected";
 319   }
 320
 321   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 322   '';
 323 }
 324
 325 =item check
 326
 327 Checks all fields to make sure this is a valid export.  If there is
 328 an error, returns the error, otherwise returns false.  Called by the insert
 329 and replace methods.
 330
 331 =cut
 332
 333 sub check {
 334   my $self = shift;
 335   my $error =
 336     $self->ut_numbern('exportnum')
 337     || $self->ut_textn('exportname')
 338     || $self->ut_domainn('machine')
 339     || $self->ut_alpha('exporttype')
 340   ;
 341
 342   if ( $self->machine eq '_SVC_MACHINE' ) {
 343     $error ||= $self->ut_numbern('default_machine')
 344   } else {
 345     $self->set('default_machine', '');
 346   }
 347
 348   return $error if $error;
 349
 350   $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
 351   $self->nodomain($1);
 352
 353   $self->deprecated(1); #BLAH
 354
 355   #check exporttype?
 356
 357   $self->SUPER::check;
 358 }
 359
 360 =item label
 361
 362 Returns a label for this export, "exportname||exportype (machine)".
 363
 364 =cut
 365
 366 sub label {
 367   my $self = shift;
 368   ($self->exportname || $self->exporttype ). ' ('. $self->machine. ')';
 369 }
 370
 371 =item label_html
 372
 373 Returns a label for this export, "exportname: exporttype to machine".
 374
 375 =cut
 376
 377 sub label_html {
 378   my $self = shift;
 379
 380   my $label = $self->exportname
 381                 ? '<B>'. $self->exportname. '</B>: ' #<BR>'.
 382                 : '';
 383
 384   $label .= $self->exporttype;
 385
 386   $label .= ' to '. ( $self->machine eq '_SVC_MACHINE'
 387                         ? 'per-service hostname'
 388                         : $self->machine
 389                     )
 390     if $self->machine;
 391
 392   $label;
 393
 394 }
 395
 396 #=item part_svc
 397 #
 398 #Returns the service definition (see L<FS::part_svc>) for this export.
 399 #
 400 #=cut
 401 #
 402 #sub part_svc {
 403 #  my $self = shift;
 404 #  qsearchs('part_svc', { svcpart => $self->svcpart } );
 405 #}
 406
 407 sub part_svc {
 408   use Carp;
 409   croak "FS::part_export::part_svc deprecated";
 410   #confess "FS::part_export::part_svc deprecated";
 411 }
 412
 413 =item svc_x
 414
 415 Returns a list of associated FS::svc_* records.
 416
 417 =cut
 418
 419 sub svc_x {
 420   my $self = shift;
 421   map { $_->svc_x } $self->cust_svc;
 422 }
 423
 424 =item cust_svc
 425
 426 Returns a list of associated FS::cust_svc records.
 427
 428 =cut
 429
 430 sub cust_svc {
 431   my $self = shift;
 432   map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
 433     grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
 434       $self->export_svc;
 435 }
 436
 437 =item part_export_machine
 438
 439 Returns all machines as FS::part_export_machine objects (see
 440 L<FS::part_export_machine>).
 441
 442 =cut
 443
 444 sub part_export_machine {
 445   my $self = shift;
 446   map { $_ } #behavior of sort undefined in scalar context
 447     sort { $a->machine cmp $b->machine }
 448       qsearch('part_export_machine', { 'exportnum' => $self->exportnum } );
 449 }
 450
 451 =item export_svc
 452
 453 Returns a list of associated FS::export_svc records.
 454
 455 =item export_device
 456
 457 Returns a list of associated FS::export_device records.
 458
 459 =item part_export_option
 460
 461 Returns all options as FS::part_export_option objects (see
 462 L<FS::part_export_option>).
 463
 464 =cut
 465
 466 sub part_export_option {
 467   my $self = shift;
 468   $self->option_objects;
 469 }
 470
 471 =item options
 472
 473 Returns a list of option names and values suitable for assigning to a hash.
 474
 475 =item option OPTIONNAME
 476
 477 Returns the option value for the given name, or the empty string.
 478
 479 =item _rebless
 480
 481 Reblesses the object into the FS::part_export::EXPORTTYPE class, where
 482 EXPORTTYPE is the object's I<exporttype> field.  There should be better docs
 483 on how to create new exports, but until then, see L</NEW EXPORT CLASSES>.
 484
 485 =cut
 486
 487 sub _rebless {
 488   my $self = shift;
 489   my $exporttype = $self->exporttype;
 490   my $class = ref($self). "::$exporttype";
 491   eval "use $class;";
 492   #die $@ if $@;
 493   bless($self, $class) unless $@;
 494   $self;
 495 }
 496
 497 =item svc_machine SVC_X
 498
 499 Return the export hostname for SVC_X.
 500
 501 =cut
 502
 503 sub svc_machine {
 504   my( $self, $svc_x ) = @_;
 505
 506   return $self->machine unless $self->machine eq '_SVC_MACHINE';
 507
 508   my $svc_export_machine = qsearchs('svc_export_machine', {
 509     'svcnum'    => $svc_x->svcnum,
 510     'exportnum' => $self->exportnum,
 511   });
 512
 513   if (!$svc_export_machine) {
 514     warn "No hostname selected for ".($self->exportname || $self->exporttype);
 515     return $self->default_export_machine->machine;
 516   }
 517
 518   return $svc_export_machine->part_export_machine->machine;
 519 }
 520
 521 =item default_export_machine
 522
 523 Return the default export hostname for this export.
 524
 525 =cut
 526
 527 sub default_export_machine {
 528   my $self = shift;
 529   my $machinenum = $self->default_machine;
 530   if ( $machinenum ) {
 531     my $default_machine = FS::part_export_machine->by_key($machinenum);
 532     return $default_machine->machine if $default_machine;
 533   }
 534   # this should not happen
 535   die "no default export hostname for export ".$self->exportnum;
 536 }
 537
 538 =item svc_role SVC_X
 539
 540 Returns the role that SVC_X occupies with respect to this export, if any.
 541 This is part of the part_svc's export configuration.
 542
 543 =cut
 544
 545 sub svc_role {
 546   my $self = shift;
 547   my $svc_x = shift;
 548   my $cust_svc = $svc_x->cust_svc or return '';
 549   my $export_svc = qsearchs('export_svc', { exportnum => $self->exportnum,
 550                                             svcpart   => $cust_svc->svcpart })
 551                    or return '';
 552   $export_svc->role;
 553 }
 554
 555 #these should probably all go away, just let the subclasses define em
 556
 557 =item export_insert SVC_OBJECT
 558
 559 =cut
 560
 561 sub export_insert {
 562   my $self = shift;
 563   #$self->rebless;
 564   $self->_export_insert(@_);
 565 }
 566
 567 #sub AUTOLOAD {
 568 #  my $self = shift;
 569 #  $self->rebless;
 570 #  my $method = $AUTOLOAD;
 571 #  #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
 572 #  $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
 573 #  $self->$method(@_);
 574 #}
 575
 576 =item export_replace NEW OLD
 577
 578 =cut
 579
 580 sub export_replace {
 581   my $self = shift;
 582   #$self->rebless;
 583   $self->_export_replace(@_);
 584 }
 585
 586 =item export_delete
 587
 588 =cut
 589
 590 sub export_delete {
 591   my $self = shift;
 592   #$self->rebless;
 593   $self->_export_delete(@_);
 594 }
 595
 596 =item export_suspend
 597
 598 =cut
 599
 600 sub export_suspend {
 601   my $self = shift;
 602   #$self->rebless;
 603   $self->_export_suspend(@_);
 604 }
 605
 606 =item export_unsuspend
 607
 608 =cut
 609
 610 sub export_unsuspend {
 611   my $self = shift;
 612   #$self->rebless;
 613   $self->_export_unsuspend(@_);
 614 }
 615
 616 #fallbacks providing useful error messages intead of infinite loops
 617 sub _export_insert {
 618   my $self = shift;
 619   return "_export_insert: unknown export type ". $self->exporttype;
 620 }
 621
 622 sub _export_replace {
 623   my $self = shift;
 624   return "_export_replace: unknown export type ". $self->exporttype;
 625 }
 626
 627 sub _export_delete {
 628   my $self = shift;
 629   return "_export_delete: unknown export type ". $self->exporttype;
 630 }
 631
 632 #call svcdb-specific fallbacks
 633
 634 sub _export_suspend {
 635   my $self = shift;
 636   #warn "warning: _export_suspened unimplemented for". ref($self);
 637   my $svc_x = shift;
 638   my $new = $svc_x->clone_suspended;
 639   $self->_export_replace( $new, $svc_x );
 640 }
 641
 642 sub _export_unsuspend {
 643   my $self = shift;
 644   #warn "warning: _export_unsuspend unimplemented for ". ref($self);
 645   my $svc_x = shift;
 646   my $old = $svc_x->clone_kludge_unsuspend;
 647   $self->_export_replace( $svc_x, $old );
 648 }
 649
 650 =item export_links SVC_OBJECT ARRAYREF
 651
 652 Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT.
 653 The elements are displayed in the UI to lead the the operator to external
 654 configuration, monitoring, and similar tools.
 655
 656 =item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF
 657
 658 Adds a hashref of settings to SETTINGSREF specific to this export and
 659 SVC_OBJECT.  The elements can be displayed in the UI on the service view.
 660
 661 DEFAULTSREF is a hashref with the same keys where true values indicate the
 662 setting is a default (and thus can be displayed in the UI with less emphasis,
 663 or hidden by default).
 664
 665 =item actions
 666
 667 Adds one or more "action" links to the export's display in
 668 browse/part_export.cgi.  Should return pairs of values.  The first is
 669 the link label; the second is the Mason path to a document to load.
 670 The document will show in a popup.
 671
 672 =cut
 673
 674 sub actions { }
 675
 676 =cut
 677
 678 =item weight
 679
 680 Returns the 'weight' element from the export's %info hash, or 0 if there is
 681 no weight defined.
 682
 683 =cut
 684
 685 sub weight {
 686   my $self = shift;
 687   export_info()->{$self->exporttype}->{'weight'} || 0;
 688 }
 689
 690 =item info
 691
 692 Returns a reference to (a copy of) the export's %info hash.
 693
 694 =cut
 695
 696 sub info {
 697   my $self = shift;
 698   $self->{_info} ||= {
 699     %{ export_info()->{$self->exporttype} }
 700   };
 701 }
 702
 703 =item get_dids SELECTION
 704
 705 Does several things, which is unfortunate. DID phone numbers are organized
 706 in a sort-of hierarchy: state, areacode, exchange, number. Or, for some
 707 vendors: state, region, number. But not always that, either.
 708
 709 SELECTION is one or more field/value pairs specifying parts of the hierarchy
 710 that have already been selected.  C<get_dids> will then return an arrayref of
 711 the possible values for the next selection level. Note that these are not
 712 actual DIDs except at the lowest level.
 713
 714 Generally, 'state' alone will return an array of area codes or region names
 715 in the state.
 716
 717 'state' and 'areacode' together will return an array of exchanges (NXX
 718 prefixes), or for some exports, an array of ratecenter names.
 719
 720 'areacode' and 'exchange', or 'state' and 'ratecenter', or 'region' by itself
 721 will return an array of actual DID numbers.
 722
 723 Passing 'tollfree' with a true value will override the whole hierarchy and
 724 return an array of tollfree numbers.
 725
 726 =cut
 727
 728 # no stub; can('get_dids') should return false by default
 729
 730 #default fallbacks... FS::part_export::DID_Common ?
 731 sub can_get_dids { 0; }
 732 sub get_dids_can_tollfree { 0; }
 733 sub get_dids_can_manual   { 0; }
 734 sub get_dids_can_edit     { 0; } #don't use without can_manual, otherwise the
 735                                  # DID selector provisions a new number from
 736                                  # inventory each edit
 737 sub get_dids_npa_select   { 1; }
 738
 739 # get_dids_npa_select: if true, then prompt to select state, then area code,
 740 # then city/exchange, then phone number.
 741 # if false, then prompt to select state (actually province), then "region",
 742 # then phone number.
 743 #
 744 # get_dids_can_manual: if true, then there will be a radio button to enter
 745 # a phone number manually.
 746 #
 747 # get_dids_can_tollfree: if true, then the user will be prompted to choose
 748 # both a regular and a toll-free number. The export can have a
 749 # 'restrict_selection' option to enable only one or the other of those. See
 750 # part_export/vitelity.pm for an example.
 751 #
 752 # get_dids_can_edit: if true, then the user can use the selector again to
 753 # change the phone number for a service. if false, then they can't (have to
 754 # reprovision completely).
 755
 756
 757 =back
 758
 759 =head1 SUBROUTINES
 760
 761 =over 4
 762
 763 =item export_info [ SVCDB ]
 764
 765 Returns a hash reference of the exports for the given I<svcdb>, or if no
 766 I<svcdb> is specified, for all exports.  The keys of the hash are
 767 I<exporttype>s and the values are again hash references containing information
 768 on the export:
 769
 770   'desc'     => 'Description',
 771   'options'  => {
 772                   'option'  => { label=>'Option Label' },
 773                   'option2' => { label=>'Another label' },
 774                 },
 775   'nodomain' => 'Y', #or ''
 776   'notes'    => 'Additional notes',
 777
 778 =cut
 779
 780 sub export_info {
 781   #warn $_[0];
 782   return $exports{$_[0]} || {} if @_;
 783   #{ map { %{$exports{$_}} } keys %exports };
 784   my $r = { map { %{$exports{$_}} } keys %exports };
 785 }
 786
 787
 788 sub _upgrade_data {  #class method
 789   my ($class, %opts) = @_;
 790
 791   my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
 792   foreach my $opt ( @part_export_option ) {
 793     next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
 794     my @groupnames = split(' ',$opt->optionvalue);
 795     my @groupnums;
 796     my $error = '';
 797     foreach my $groupname ( @groupnames ) {
 798         my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
 799         unless ( $g ) {
 800             $g = new FS::radius_group {
 801                             'groupname' => $groupname,
 802                             'description' => $groupname,
 803                             };
 804             $error = $g->insert;
 805             die $error if $error;
 806         }
 807         push @groupnums, $g->groupnum;
 808     }
 809     $opt->optionvalue(join(' ',@groupnums));
 810     $error = $opt->replace;
 811     die $error if $error;
 812   }
 813   # for exports that have selectable hostnames, make sure all services
 814   # have a hostname selected
 815   foreach my $part_export (
 816     qsearch('part_export', { 'machine' => '_SVC_MACHINE' })
 817   ) {
 818
 819     my $exportnum = $part_export->exportnum;
 820     my $machinenum = $part_export->default_machine;
 821     if (!$machinenum) {
 822       my ($first) = $part_export->part_export_machine;
 823       if (!$first) {
 824         # user intervention really is required.
 825         die "Export $exportnum has no hostname options defined.\n".
 826             "You must correct this before upgrading.\n";
 827       }
 828       # warn about this, because we might not choose the right one
 829       warn "Export $exportnum (". $part_export->exporttype.
 830            ") has no default hostname.  Setting to ".$first->machine."\n";
 831       $machinenum = $first->machinenum;
 832       $part_export->set('default_machine', $machinenum);
 833       my $error = $part_export->replace;
 834       die $error if $error;
 835     }
 836
 837     # the service belongs to a service def that uses this export
 838     # and there is not a hostname selected for this export for that service
 839     my $join = ' JOIN export_svc USING ( svcpart )'.
 840                ' LEFT JOIN svc_export_machine'.
 841                ' ON ( cust_svc.svcnum = svc_export_machine.svcnum'.
 842                ' AND export_svc.exportnum = svc_export_machine.exportnum )';
 843
 844     my @svcs = qsearch( {
 845           'select'    => 'cust_svc.*',
 846           'table'     => 'cust_svc',
 847           'addl_from' => $join,
 848           'extra_sql' => ' WHERE svcexportmachinenum IS NULL'.
 849                          ' AND export_svc.exportnum = '.$part_export->exportnum,
 850       } );
 851     foreach my $cust_svc (@svcs) {
 852       my $svc_export_machine = FS::svc_export_machine->new({
 853           'exportnum'   => $exportnum,
 854           'machinenum'  => $machinenum,
 855           'svcnum'      => $cust_svc->svcnum,
 856       });
 857       my $error = $svc_export_machine->insert;
 858       die $error if $error;
 859     }
 860   }
 861
 862   # pass downstream
 863   my %exports_in_use;
 864   $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});
 865   foreach (keys(%exports_in_use)) {
 866     $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype');
 867   }
 868 }
 869
 870 #=item exporttype2svcdb EXPORTTYPE
 871 #
 872 #Returns the applicable I<svcdb> for an I<exporttype>.
 873 #
 874 #=cut
 875 #
 876 #sub exporttype2svcdb {
 877 #  my $exporttype = $_[0];
 878 #  foreach my $svcdb ( keys %exports ) {
 879 #    return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
 880 #  }
 881 #  '';
 882 #}
 883
 884 #false laziness w/part_pkg & cdr
 885 foreach my $INC ( @INC ) {
 886   foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
 887     warn "attempting to load export info from $file\n" if $DEBUG;
 888     $file =~ /\/(\w+)\.pm$/ or do {
 889       warn "unrecognized file in $INC/FS/part_export/: $file\n";
 890       next;
 891     };
 892     my $mod = $1;
 893     my $info = eval "use FS::part_export::$mod; ".
 894                     "\\%FS::part_export::$mod\::info;";
 895     if ( $@ ) {
 896       die "error using FS::part_export::$mod (skipping): $@\n" if $@;
 897       next;
 898     }
 899     unless ( keys %$info ) {
 900       warn "no %info hash found in FS::part_export::$mod, skipping\n"
 901         unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck
 902       next;
 903     }
 904     warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
 905     no strict 'refs';
 906     foreach my $svc (
 907       ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
 908     ) {
 909       unless ( $svc ) {
 910         warn "blank svc for FS::part_export::$mod (skipping)\n";
 911         next;
 912       }
 913       $exports{$svc}->{$mod} = $info;
 914     }
 915   }
 916 }
 917
 918 =back
 919
 920 =head1 NEW EXPORT CLASSES
 921
 922 A module should be added in FS/FS/part_export/ (an example may be found in
 923 eg/export_template.pm)
 924
 925 =head1 BUGS
 926
 927 Hmm... cust_export class (not necessarily a database table...) ... ?
 928
 929 deprecated column...
 930
 931 =head1 SEE ALSO
 932
 933 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
 934 L<FS::svc_domain>,
 935 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.
 936
 937 =cut
 938
 939 1;
 940