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