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 #these should probably all go away, just let the subclasses define em
 539
 540 =item export_insert SVC_OBJECT
 541
 542 =cut
 543
 544 sub export_insert {
 545   my $self = shift;
 546   #$self->rebless;
 547   $self->_export_insert(@_);
 548 }
 549
 550 #sub AUTOLOAD {
 551 #  my $self = shift;
 552 #  $self->rebless;
 553 #  my $method = $AUTOLOAD;
 554 #  #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
 555 #  $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
 556 #  $self->$method(@_);
 557 #}
 558
 559 =item export_replace NEW OLD
 560
 561 =cut
 562
 563 sub export_replace {
 564   my $self = shift;
 565   #$self->rebless;
 566   $self->_export_replace(@_);
 567 }
 568
 569 =item export_delete
 570
 571 =cut
 572
 573 sub export_delete {
 574   my $self = shift;
 575   #$self->rebless;
 576   $self->_export_delete(@_);
 577 }
 578
 579 =item export_suspend
 580
 581 =cut
 582
 583 sub export_suspend {
 584   my $self = shift;
 585   #$self->rebless;
 586   $self->_export_suspend(@_);
 587 }
 588
 589 =item export_unsuspend
 590
 591 =cut
 592
 593 sub export_unsuspend {
 594   my $self = shift;
 595   #$self->rebless;
 596   $self->_export_unsuspend(@_);
 597 }
 598
 599 #fallbacks providing useful error messages intead of infinite loops
 600 sub _export_insert {
 601   my $self = shift;
 602   return "_export_insert: unknown export type ". $self->exporttype;
 603 }
 604
 605 sub _export_replace {
 606   my $self = shift;
 607   return "_export_replace: unknown export type ". $self->exporttype;
 608 }
 609
 610 sub _export_delete {
 611   my $self = shift;
 612   return "_export_delete: unknown export type ". $self->exporttype;
 613 }
 614
 615 #call svcdb-specific fallbacks
 616
 617 sub _export_suspend {
 618   my $self = shift;
 619   #warn "warning: _export_suspened unimplemented for". ref($self);
 620   my $svc_x = shift;
 621   my $new = $svc_x->clone_suspended;
 622   $self->_export_replace( $new, $svc_x );
 623 }
 624
 625 sub _export_unsuspend {
 626   my $self = shift;
 627   #warn "warning: _export_unsuspend unimplemented for ". ref($self);
 628   my $svc_x = shift;
 629   my $old = $svc_x->clone_kludge_unsuspend;
 630   $self->_export_replace( $svc_x, $old );
 631 }
 632
 633 =item export_links SVC_OBJECT ARRAYREF
 634
 635 Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT.
 636 The elements are displayed in the UI to lead the the operator to external
 637 configuration, monitoring, and similar tools.
 638
 639 =item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF
 640
 641 Adds a hashref of settings to SETTINGSREF specific to this export and
 642 SVC_OBJECT.  The elements can be displayed in the UI on the service view.
 643
 644 DEFAULTSREF is a hashref with the same keys where true values indicate the
 645 setting is a default (and thus can be displayed in the UI with less emphasis,
 646 or hidden by default).
 647
 648 =item actions
 649
 650 Adds one or more "action" links to the export's display in
 651 browse/part_export.cgi.  Should return pairs of values.  The first is
 652 the link label; the second is the Mason path to a document to load.
 653 The document will show in a popup.
 654
 655 =cut
 656
 657 sub actions { }
 658
 659 =cut
 660
 661 =item weight
 662
 663 Returns the 'weight' element from the export's %info hash, or 0 if there is
 664 no weight defined.
 665
 666 =cut
 667
 668 sub weight {
 669   my $self = shift;
 670   export_info()->{$self->exporttype}->{'weight'} || 0;
 671 }
 672
 673 =item info
 674
 675 Returns a reference to (a copy of) the export's %info hash.
 676
 677 =cut
 678
 679 sub info {
 680   my $self = shift;
 681   $self->{_info} ||= {
 682     %{ export_info()->{$self->exporttype} }
 683   };
 684 }
 685
 686 =item get_dids SELECTION
 687
 688 Does several things, which is unfortunate. DID phone numbers are organized
 689 in a sort-of hierarchy: state, areacode, exchange, number. Or, for some
 690 vendors: state, region, number. But not always that, either.
 691
 692 SELECTION is one or more field/value pairs specifying parts of the hierarchy
 693 that have already been selected.  C<get_dids> will then return an arrayref of
 694 the possible values for the next selection level. Note that these are not
 695 actual DIDs except at the lowest level.
 696
 697 Generally, 'state' alone will return an array of area codes or region names
 698 in the state.
 699
 700 'state' and 'areacode' together will return an array of exchanges (NXX
 701 prefixes), or for some exports, an array of ratecenter names.
 702
 703 'areacode' and 'exchange', or 'state' and 'ratecenter', or 'region' by itself
 704 will return an array of actual DID numbers.
 705
 706 Passing 'tollfree' with a true value will override the whole hierarchy and
 707 return an array of tollfree numbers.
 708
 709 =cut
 710
 711 # no stub; can('get_dids') should return false by default
 712
 713 #default fallbacks... FS::part_export::DID_Common ?
 714 sub can_get_dids { 0; }
 715 sub get_dids_can_tollfree { 0; }
 716 sub get_dids_can_manual   { 0; }
 717 sub get_dids_can_edit     { 0; } #don't use without can_manual, otherwise the
 718                                  # DID selector provisions a new number from
 719                                  # inventory each edit
 720 sub get_dids_npa_select   { 1; }
 721
 722 # get_dids_npa_select: if true, then prompt to select state, then area code,
 723 # then city/exchange, then phone number.
 724 # if false, then prompt to select state (actually province), then "region",
 725 # then phone number.
 726 #
 727 # get_dids_can_manual: if true, then there will be a radio button to enter
 728 # a phone number manually.
 729 #
 730 # get_dids_can_tollfree: if true, then the user will be prompted to choose
 731 # both a regular and a toll-free number. The export can have a
 732 # 'restrict_selection' option to enable only one or the other of those. See
 733 # part_export/vitelity.pm for an example.
 734 #
 735 # get_dids_can_edit: if true, then the user can use the selector again to
 736 # change the phone number for a service. if false, then they can't (have to
 737 # reprovision completely).
 738
 739 =item svc_role SVC
 740
 741 Returns the role that SVC occupies with respect to this export, if any.
 742 This is part of the part_svc's export configuration.
 743
 744 =cut
 745
 746 sub svc_role {
 747   my $self = shift;
 748   my $svc_x = shift;
 749   my $cust_svc = $svc_x->cust_svc or return '';
 750   my $export_svc = qsearchs('export_svc', { exportnum => $self->exportnum,
 751                                             svcpart   => $cust_svc->svcpart })
 752                    or return '';
 753   $export_svc->role;
 754 }
 755
 756 =item svc_with_role { SVC | PKGNUM }, ROLE
 757
 758 Given a svc_* object SVC or pkgnum PKG, and a role name ROLE, finds the
 759 service(s) in the same package that are linked to this export with ROLE.
 760
 761 =cut
 762
 763 sub svc_with_role {
 764   my $self = shift;
 765   my $svc_or_pkgnum = shift;
 766   my $role = shift;
 767   my $pkgnum;
 768   if ( ref $svc_or_pkgnum ) {
 769     $pkgnum = $svc_or_pkgnum->cust_svc->pkgnum or return '';
 770   } else {
 771     $pkgnum = $svc_or_pkgnum;
 772   }
 773   my $role_info = $self->info->{roles}->{$role}
 774     or die "role '$role' does not exist for export '".$self->exporttype."'\n";
 775   my $svcdb = $role_info->{svcdb};
 776
 777   my @svcs = qsearch({
 778     'table'     =>  $svcdb,
 779     'addl_from' =>  ' JOIN cust_svc USING (svcnum)' .
 780                     ' JOIN export_svc USING (svcpart)',
 781     'extra_sql' =>  " WHERE cust_svc.pkgnum = $pkgnum" .
 782                     " AND export_svc.exportnum = ".$self->exportnum .
 783                     " AND export_svc.role = '$role'",
 784   });
 785   if ( $role_info->{multiple} ) {
 786     return @svcs;
 787   } else {
 788     if ( @svcs > 1 ) {
 789       warn "multiple $role services in pkgnum $pkgnum; returning the first one.\n";
 790     }
 791     return $svcs[0];
 792   }
 793 }
 794
 795 =back
 796
 797 =head1 SUBROUTINES
 798
 799 =over 4
 800
 801 =item export_info [ SVCDB ]
 802
 803 Returns a hash reference of the exports for the given I<svcdb>, or if no
 804 I<svcdb> is specified, for all exports.  The keys of the hash are
 805 I<exporttype>s and the values are again hash references containing information
 806 on the export:
 807
 808   'desc'     => 'Description',
 809   'options'  => {
 810                   'option'  => { label=>'Option Label' },
 811                   'option2' => { label=>'Another label' },
 812                 },
 813   'nodomain' => 'Y', #or ''
 814   'notes'    => 'Additional notes',
 815
 816 =cut
 817
 818 sub export_info {
 819   #warn $_[0];
 820   return $exports{$_[0]} || {} if @_;
 821   #{ map { %{$exports{$_}} } keys %exports };
 822   my $r = { map { %{$exports{$_}} } keys %exports };
 823 }
 824
 825
 826 sub _upgrade_data {  #class method
 827   my ($class, %opts) = @_;
 828
 829   my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
 830   foreach my $opt ( @part_export_option ) {
 831     next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
 832     my @groupnames = split(' ',$opt->optionvalue);
 833     my @groupnums;
 834     my $error = '';
 835     foreach my $groupname ( @groupnames ) {
 836         my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
 837         unless ( $g ) {
 838             $g = new FS::radius_group {
 839                             'groupname' => $groupname,
 840                             'description' => $groupname,
 841                             };
 842             $error = $g->insert;
 843             die $error if $error;
 844         }
 845         push @groupnums, $g->groupnum;
 846     }
 847     $opt->optionvalue(join(' ',@groupnums));
 848     $error = $opt->replace;
 849     die $error if $error;
 850   }
 851   # for exports that have selectable hostnames, make sure all services
 852   # have a hostname selected
 853   foreach my $part_export (
 854     qsearch('part_export', { 'machine' => '_SVC_MACHINE' })
 855   ) {
 856
 857     my $exportnum = $part_export->exportnum;
 858     my $machinenum = $part_export->default_machine;
 859     if (!$machinenum) {
 860       my ($first) = $part_export->part_export_machine;
 861       if (!$first) {
 862         # user intervention really is required.
 863         die "Export $exportnum has no hostname options defined.\n".
 864             "You must correct this before upgrading.\n";
 865       }
 866       # warn about this, because we might not choose the right one
 867       warn "Export $exportnum (". $part_export->exporttype.
 868            ") has no default hostname.  Setting to ".$first->machine."\n";
 869       $machinenum = $first->machinenum;
 870       $part_export->set('default_machine', $machinenum);
 871       my $error = $part_export->replace;
 872       die $error if $error;
 873     }
 874
 875     # the service belongs to a service def that uses this export
 876     # and there is not a hostname selected for this export for that service
 877     my $join = ' JOIN export_svc USING ( svcpart )'.
 878                ' LEFT JOIN svc_export_machine'.
 879                ' ON ( cust_svc.svcnum = svc_export_machine.svcnum'.
 880                ' AND export_svc.exportnum = svc_export_machine.exportnum )';
 881
 882     my @svcs = qsearch( {
 883           'select'    => 'cust_svc.*',
 884           'table'     => 'cust_svc',
 885           'addl_from' => $join,
 886           'extra_sql' => ' WHERE svcexportmachinenum IS NULL'.
 887                          ' AND export_svc.exportnum = '.$part_export->exportnum,
 888       } );
 889     foreach my $cust_svc (@svcs) {
 890       my $svc_export_machine = FS::svc_export_machine->new({
 891           'exportnum'   => $exportnum,
 892           'machinenum'  => $machinenum,
 893           'svcnum'      => $cust_svc->svcnum,
 894       });
 895       my $error = $svc_export_machine->insert;
 896       die $error if $error;
 897     }
 898   }
 899
 900   # pass downstream
 901   my %exports_in_use;
 902   $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});
 903   foreach (keys(%exports_in_use)) {
 904     $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype');
 905   }
 906 }
 907
 908 #=item exporttype2svcdb EXPORTTYPE
 909 #
 910 #Returns the applicable I<svcdb> for an I<exporttype>.
 911 #
 912 #=cut
 913 #
 914 #sub exporttype2svcdb {
 915 #  my $exporttype = $_[0];
 916 #  foreach my $svcdb ( keys %exports ) {
 917 #    return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
 918 #  }
 919 #  '';
 920 #}
 921
 922 #false laziness w/part_pkg & cdr
 923 foreach my $INC ( @INC ) {
 924   foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
 925     warn "attempting to load export info from $file\n" if $DEBUG;
 926     $file =~ /\/(\w+)\.pm$/ or do {
 927       warn "unrecognized file in $INC/FS/part_export/: $file\n";
 928       next;
 929     };
 930     my $mod = $1;
 931     my $info = eval "use FS::part_export::$mod; ".
 932                     "\\%FS::part_export::$mod\::info;";
 933     if ( $@ ) {
 934       die "error using FS::part_export::$mod (skipping): $@\n" if $@;
 935       next;
 936     }
 937     unless ( keys %$info ) {
 938       warn "no %info hash found in FS::part_export::$mod, skipping\n"
 939         unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck
 940       next;
 941     }
 942     warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
 943     no strict 'refs';
 944     foreach my $svc (
 945       ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
 946     ) {
 947       unless ( $svc ) {
 948         warn "blank svc for FS::part_export::$mod (skipping)\n";
 949         next;
 950       }
 951       $exports{$svc}->{$mod} = $info;
 952     }
 953   }
 954 }
 955
 956 =back
 957
 958 =head1 NEW EXPORT CLASSES
 959
 960 A module should be added in FS/FS/part_export/ (an example may be found in
 961 eg/export_template.pm)
 962
 963 =head1 BUGS
 964
 965 Hmm... cust_export class (not necessarily a database table...) ... ?
 966
 967 deprecated column...
 968
 969 =head1 SEE ALSO
 970
 971 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
 972 L<FS::svc_domain>,
 973 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.
 974
 975 =cut
 976
 977 1;
 978