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