FS/FS/part_export.pm

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