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