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 #default fallbacks... FS::part_export::DID_Common ?
 698 sub get_dids_can_tollfree { 0; }
 699 sub get_dids_can_manual   { 0; }
 700 sub get_dids_can_edit     { 0; } #don't use without can_manual, otherwise the
 701                                  # DID selector provisions a new number from
 702                                  # inventory each edit
 703 sub get_dids_npa_select   { 1; }
 704
 705 =back
 706
 707 =head1 SUBROUTINES
 708
 709 =over 4
 710
 711 =item export_info [ SVCDB ]
 712
 713 Returns a hash reference of the exports for the given I<svcdb>, or if no
 714 I<svcdb> is specified, for all exports.  The keys of the hash are
 715 I<exporttype>s and the values are again hash references containing information
 716 on the export:
 717
 718   'desc'     => 'Description',
 719   'options'  => {
 720                   'option'  => { label=>'Option Label' },
 721                   'option2' => { label=>'Another label' },
 722                 },
 723   'nodomain' => 'Y', #or ''
 724   'notes'    => 'Additional notes',
 725
 726 =cut
 727
 728 sub export_info {
 729   #warn $_[0];
 730   return $exports{$_[0]} || {} if @_;
 731   #{ map { %{$exports{$_}} } keys %exports };
 732   my $r = { map { %{$exports{$_}} } keys %exports };
 733 }
 734
 735
 736 sub _upgrade_data {  #class method
 737   my ($class, %opts) = @_;
 738
 739   my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
 740   foreach my $opt ( @part_export_option ) {
 741     next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
 742     my @groupnames = split(' ',$opt->optionvalue);
 743     my @groupnums;
 744     my $error = '';
 745     foreach my $groupname ( @groupnames ) {
 746         my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
 747         unless ( $g ) {
 748             $g = new FS::radius_group {
 749                             'groupname' => $groupname,
 750                             'description' => $groupname,
 751                             };
 752             $error = $g->insert;
 753             die $error if $error;
 754         }
 755         push @groupnums, $g->groupnum;
 756     }
 757     $opt->optionvalue(join(' ',@groupnums));
 758     $error = $opt->replace;
 759     die $error if $error;
 760   }
 761   # for exports that have selectable hostnames, make sure all services
 762   # have a hostname selected
 763   foreach my $part_export (
 764     qsearch('part_export', { 'machine' => '_SVC_MACHINE' })
 765   ) {
 766
 767     my $exportnum = $part_export->exportnum;
 768     my $machinenum = $part_export->default_machine;
 769     if (!$machinenum) {
 770       my ($first) = $part_export->part_export_machine;
 771       if (!$first) {
 772         # user intervention really is required.
 773         die "Export $exportnum has no hostname options defined.\n".
 774             "You must correct this before upgrading.\n";
 775       }
 776       # warn about this, because we might not choose the right one
 777       warn "Export $exportnum (". $part_export->exporttype.
 778            ") has no default hostname.  Setting to ".$first->machine."\n";
 779       $machinenum = $first->machinenum;
 780       $part_export->set('default_machine', $machinenum);
 781       my $error = $part_export->replace;
 782       die $error if $error;
 783     }
 784
 785     # the service belongs to a service def that uses this export
 786     # and there is not a hostname selected for this export for that service
 787     my $join = ' JOIN export_svc USING ( svcpart )'.
 788                ' LEFT JOIN svc_export_machine'.
 789                ' ON ( cust_svc.svcnum = svc_export_machine.svcnum'.
 790                ' AND export_svc.exportnum = svc_export_machine.exportnum )';
 791
 792     my @svcs = qsearch( {
 793           'select'    => 'cust_svc.*',
 794           'table'     => 'cust_svc',
 795           'addl_from' => $join,
 796           'extra_sql' => ' WHERE svcexportmachinenum IS NULL'.
 797                          ' AND export_svc.exportnum = '.$part_export->exportnum,
 798       } );
 799     foreach my $cust_svc (@svcs) {
 800       my $svc_export_machine = FS::svc_export_machine->new({
 801           'exportnum'   => $exportnum,
 802           'machinenum'  => $machinenum,
 803           'svcnum'      => $cust_svc->svcnum,
 804       });
 805       my $error = $svc_export_machine->insert;
 806       die $error if $error;
 807     }
 808   }
 809
 810   # pass downstream
 811   my %exports_in_use;
 812   $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});
 813   foreach (keys(%exports_in_use)) {
 814     $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype');
 815   }
 816 }
 817
 818 #=item exporttype2svcdb EXPORTTYPE
 819 #
 820 #Returns the applicable I<svcdb> for an I<exporttype>.
 821 #
 822 #=cut
 823 #
 824 #sub exporttype2svcdb {
 825 #  my $exporttype = $_[0];
 826 #  foreach my $svcdb ( keys %exports ) {
 827 #    return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
 828 #  }
 829 #  '';
 830 #}
 831
 832 #false laziness w/part_pkg & cdr
 833 foreach my $INC ( @INC ) {
 834   foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
 835     warn "attempting to load export info from $file\n" if $DEBUG;
 836     $file =~ /\/(\w+)\.pm$/ or do {
 837       warn "unrecognized file in $INC/FS/part_export/: $file\n";
 838       next;
 839     };
 840     my $mod = $1;
 841     my $info = eval "use FS::part_export::$mod; ".
 842                     "\\%FS::part_export::$mod\::info;";
 843     if ( $@ ) {
 844       die "error using FS::part_export::$mod (skipping): $@\n" if $@;
 845       next;
 846     }
 847     unless ( keys %$info ) {
 848       warn "no %info hash found in FS::part_export::$mod, skipping\n"
 849         unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck
 850       next;
 851     }
 852     warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
 853     no strict 'refs';
 854     foreach my $svc (
 855       ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
 856     ) {
 857       unless ( $svc ) {
 858         warn "blank svc for FS::part_export::$mod (skipping)\n";
 859         next;
 860       }
 861       $exports{$svc}->{$mod} = $info;
 862     }
 863   }
 864 }
 865
 866 =back
 867
 868 =head1 NEW EXPORT CLASSES
 869
 870 A module should be added in FS/FS/part_export/ (an example may be found in
 871 eg/export_template.pm)
 872
 873 =head1 BUGS
 874
 875 Hmm... cust_export class (not necessarily a database table...) ... ?
 876
 877 deprecated column...
 878
 879 =head1 SEE ALSO
 880
 881 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
 882 L<FS::svc_domain>,
 883 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.
 884
 885 =cut
 886
 887 1;
 888