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 either:
 708 - exchange strings of the form "New York (212-555-XXXX)"
 709 - ratecenter names of the form "New York, NY"
 710
 711 These strings are sent back to the UI and offered as options so that the user
 712 can choose the local calling area they like.
 713
 714 'areacode' and 'exchange', or 'state' and 'ratecenter', or 'region' by itself
 715 will return an array of actual DID numbers.
 716
 717 Passing 'tollfree' with a true value will override the whole hierarchy and
 718 return an array of tollfree numbers.
 719
 720 =cut
 721
 722 # no stub; can('get_dids') should return false by default
 723
 724 #default fallbacks... FS::part_export::DID_Common ?
 725 sub can_get_dids { 0; }
 726 sub get_dids_can_tollfree { 0; }
 727 sub get_dids_can_manual   { 0; }
 728 sub get_dids_can_edit     { 0; } #don't use without can_manual, otherwise the
 729                                  # DID selector provisions a new number from
 730                                  # inventory each edit
 731 sub get_dids_npa_select   { 1; }
 732
 733 # get_dids_npa_select: if true, then prompt to select state, then area code,
 734 # then city/exchange, then phone number.
 735 # if false, then prompt to select state (actually province), then "region",
 736 # then phone number.
 737 #
 738 # get_dids_can_manual: if true, then there will be a radio button to enter
 739 # a phone number manually.
 740 #
 741 # get_dids_can_tollfree: if true, then the user will be prompted to choose
 742 # both a regular and a toll-free number. The export can have a
 743 # 'restrict_selection' option to enable only one or the other of those. See
 744 # part_export/vitelity.pm for an example.
 745 #
 746 # get_dids_can_edit: if true, then the user can use the selector again to
 747 # change the phone number for a service. if false, then they can't (have to
 748 # reprovision completely).
 749
 750 =item svc_role SVC
 751
 752 Returns the role that SVC occupies with respect to this export, if any.
 753 This is part of the part_svc's export configuration.
 754
 755 =cut
 756
 757 sub svc_role {
 758   my $self = shift;
 759   my $svc_x = shift;
 760   my $cust_svc = $svc_x->cust_svc or return '';
 761   my $export_svc = qsearchs('export_svc', { exportnum => $self->exportnum,
 762                                             svcpart   => $cust_svc->svcpart })
 763                    or return '';
 764   $export_svc->role;
 765 }
 766
 767 =item svc_with_role { SVC | PKGNUM }, ROLE
 768
 769 Given a svc_* object SVC or pkgnum PKG, and a role name ROLE, finds the
 770 service(s) in the same package that are linked to this export with ROLE.
 771
 772 =cut
 773
 774 sub svc_with_role {
 775   my $self = shift;
 776   my $svc_or_pkgnum = shift;
 777   my $role = shift;
 778   my $pkgnum;
 779   if ( ref $svc_or_pkgnum ) {
 780     $pkgnum = $svc_or_pkgnum->cust_svc->pkgnum or return '';
 781   } else {
 782     $pkgnum = $svc_or_pkgnum;
 783   }
 784   my $role_info = $self->info->{roles}->{$role}
 785     or die "role '$role' does not exist for export '".$self->exporttype."'\n";
 786   my $svcdb = $role_info->{svcdb};
 787
 788   my @svcs = qsearch({
 789     'table'     =>  $svcdb,
 790     'addl_from' =>  ' JOIN cust_svc USING (svcnum)' .
 791                     ' JOIN export_svc USING (svcpart)',
 792     'extra_sql' =>  " WHERE cust_svc.pkgnum = $pkgnum" .
 793                     " AND export_svc.exportnum = ".$self->exportnum .
 794                     " AND export_svc.role = '$role'",
 795   });
 796   if ( $role_info->{multiple} ) {
 797     return @svcs;
 798   } else {
 799     if ( @svcs > 1 ) {
 800       warn "multiple $role services in pkgnum $pkgnum; returning the first one.\n";
 801     }
 802     return $svcs[0];
 803   }
 804 }
 805
 806 =back
 807
 808 =head1 SUBROUTINES
 809
 810 =over 4
 811
 812 =item export_info [ SVCDB ]
 813
 814 Returns a hash reference of the exports for the given I<svcdb>, or if no
 815 I<svcdb> is specified, for all exports.  The keys of the hash are
 816 I<exporttype>s and the values are again hash references containing information
 817 on the export:
 818
 819   'desc'     => 'Description',
 820   'options'  => {
 821                   'option'  => { label=>'Option Label' },
 822                   'option2' => { label=>'Another label' },
 823                 },
 824   'nodomain' => 'Y', #or ''
 825   'notes'    => 'Additional notes',
 826
 827 =cut
 828
 829 sub export_info {
 830   #warn $_[0];
 831   return $exports{$_[0]} || {} if @_;
 832   #{ map { %{$exports{$_}} } keys %exports };
 833   my $r = { map { %{$exports{$_}} } keys %exports };
 834 }
 835
 836
 837 sub _upgrade_data {  #class method
 838   my ($class, %opts) = @_;
 839
 840   my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
 841   foreach my $opt ( @part_export_option ) {
 842     next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
 843     my @groupnames = split(' ',$opt->optionvalue);
 844     my @groupnums;
 845     my $error = '';
 846     foreach my $groupname ( @groupnames ) {
 847         my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
 848         unless ( $g ) {
 849             $g = new FS::radius_group {
 850                             'groupname' => $groupname,
 851                             'description' => $groupname,
 852                             };
 853             $error = $g->insert;
 854             die $error if $error;
 855         }
 856         push @groupnums, $g->groupnum;
 857     }
 858     $opt->optionvalue(join(' ',@groupnums));
 859     $error = $opt->replace;
 860     die $error if $error;
 861   }
 862   # for exports that have selectable hostnames, make sure all services
 863   # have a hostname selected
 864   foreach my $part_export (
 865     qsearch('part_export', { 'machine' => '_SVC_MACHINE' })
 866   ) {
 867
 868     my $exportnum = $part_export->exportnum;
 869     my $machinenum = $part_export->default_machine;
 870     if (!$machinenum) {
 871       my ($first) = $part_export->part_export_machine;
 872       if (!$first) {
 873         # user intervention really is required.
 874         die "Export $exportnum has no hostname options defined.\n".
 875             "You must correct this before upgrading.\n";
 876       }
 877       # warn about this, because we might not choose the right one
 878       warn "Export $exportnum (". $part_export->exporttype.
 879            ") has no default hostname.  Setting to ".$first->machine."\n";
 880       $machinenum = $first->machinenum;
 881       $part_export->set('default_machine', $machinenum);
 882       my $error = $part_export->replace;
 883       die $error if $error;
 884     }
 885
 886     # the service belongs to a service def that uses this export
 887     # and there is not a hostname selected for this export for that service
 888     my $join = ' JOIN export_svc USING ( svcpart )'.
 889                ' LEFT JOIN svc_export_machine'.
 890                ' ON ( cust_svc.svcnum = svc_export_machine.svcnum'.
 891                ' AND export_svc.exportnum = svc_export_machine.exportnum )';
 892
 893     my @svcs = qsearch( {
 894           'select'    => 'cust_svc.*',
 895           'table'     => 'cust_svc',
 896           'addl_from' => $join,
 897           'extra_sql' => ' WHERE svcexportmachinenum IS NULL'.
 898                          ' AND export_svc.exportnum = '.$part_export->exportnum,
 899       } );
 900     foreach my $cust_svc (@svcs) {
 901       my $svc_export_machine = FS::svc_export_machine->new({
 902           'exportnum'   => $exportnum,
 903           'machinenum'  => $machinenum,
 904           'svcnum'      => $cust_svc->svcnum,
 905       });
 906       my $error = $svc_export_machine->insert;
 907       die $error if $error;
 908     }
 909   }
 910
 911   # pass downstream
 912   my %exports_in_use;
 913   $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});
 914   foreach (keys(%exports_in_use)) {
 915     $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype');
 916   }
 917 }
 918
 919 #=item exporttype2svcdb EXPORTTYPE
 920 #
 921 #Returns the applicable I<svcdb> for an I<exporttype>.
 922 #
 923 #=cut
 924 #
 925 #sub exporttype2svcdb {
 926 #  my $exporttype = $_[0];
 927 #  foreach my $svcdb ( keys %exports ) {
 928 #    return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
 929 #  }
 930 #  '';
 931 #}
 932
 933 #false laziness w/part_pkg & cdr
 934 foreach my $INC ( @INC ) {
 935   foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
 936     warn "attempting to load export info from $file\n" if $DEBUG;
 937     $file =~ /\/(\w+)\.pm$/ or do {
 938       warn "unrecognized file in $INC/FS/part_export/: $file\n";
 939       next;
 940     };
 941     my $mod = $1;
 942     my $info = eval "use FS::part_export::$mod; ".
 943                     "\\%FS::part_export::$mod\::info;";
 944     if ( $@ ) {
 945       die "error using FS::part_export::$mod (skipping): $@\n" if $@;
 946       next;
 947     }
 948     unless ( keys %$info ) {
 949       warn "no %info hash found in FS::part_export::$mod, skipping\n"
 950         unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck
 951       next;
 952     }
 953     warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
 954     no strict 'refs';
 955     foreach my $svc (
 956       ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
 957     ) {
 958       unless ( $svc ) {
 959         warn "blank svc for FS::part_export::$mod (skipping)\n";
 960         next;
 961       }
 962       $exports{$svc}->{$mod} = $info;
 963     }
 964   }
 965 }
 966
 967 =back
 968
 969 =head1 NEW EXPORT CLASSES
 970
 971 A module should be added in FS/FS/part_export/ (an example may be found in
 972 eg/export_template.pm)
 973
 974 =head1 BUGS
 975
 976 Hmm... cust_export class (not necessarily a database table...) ... ?
 977
 978 deprecated column...
 979
 980 =head1 SEE ALSO
 981
 982 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
 983 L<FS::svc_domain>,
 984 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.
 985
 986 =cut
 987
 988 1;
 989