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