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