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