FS/FS/part_export.pm

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