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 #these should probably all go away, just let the subclasses define em
 558
 559 =item export_insert SVC_OBJECT
 560
 561 =cut
 562
 563 sub export_insert {
 564   my $self = shift;
 565   #$self->rebless;
 566   $self->_export_insert(@_);
 567 }
 568
 569 #sub AUTOLOAD {
 570 #  my $self = shift;
 571 #  $self->rebless;
 572 #  my $method = $AUTOLOAD;
 573 #  #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
 574 #  $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
 575 #  $self->$method(@_);
 576 #}
 577
 578 =item export_replace NEW OLD
 579
 580 =cut
 581
 582 sub export_replace {
 583   my $self = shift;
 584   #$self->rebless;
 585   $self->_export_replace(@_);
 586 }
 587
 588 =item export_delete
 589
 590 =cut
 591
 592 sub export_delete {
 593   my $self = shift;
 594   #$self->rebless;
 595   $self->_export_delete(@_);
 596 }
 597
 598 =item export_suspend
 599
 600 =cut
 601
 602 sub export_suspend {
 603   my $self = shift;
 604   #$self->rebless;
 605   $self->_export_suspend(@_);
 606 }
 607
 608 =item export_unsuspend
 609
 610 =cut
 611
 612 sub export_unsuspend {
 613   my $self = shift;
 614   #$self->rebless;
 615   $self->_export_unsuspend(@_);
 616 }
 617
 618 #fallbacks providing useful error messages intead of infinite loops
 619 sub _export_insert {
 620   my $self = shift;
 621   return "_export_insert: unknown export type ". $self->exporttype;
 622 }
 623
 624 sub _export_replace {
 625   my $self = shift;
 626   return "_export_replace: unknown export type ". $self->exporttype;
 627 }
 628
 629 sub _export_delete {
 630   my $self = shift;
 631   return "_export_delete: unknown export type ". $self->exporttype;
 632 }
 633
 634 #call svcdb-specific fallbacks
 635
 636 sub _export_suspend {
 637   my $self = shift;
 638   #warn "warning: _export_suspened unimplemented for". ref($self);
 639   my $svc_x = shift;
 640   my $new = $svc_x->clone_suspended;
 641   $self->_export_replace( $new, $svc_x );
 642 }
 643
 644 sub _export_unsuspend {
 645   my $self = shift;
 646   #warn "warning: _export_unsuspend unimplemented for ". ref($self);
 647   my $svc_x = shift;
 648   my $old = $svc_x->clone_kludge_unsuspend;
 649   $self->_export_replace( $svc_x, $old );
 650 }
 651
 652 =item get_remoteid SVC
 653
 654 Returns the remote id for this export for the given service.
 655
 656 =cut
 657
 658 sub get_remoteid {
 659   my ($self, $svc_x) = @_;
 660
 661   my $export_cust_svc = qsearchs('export_cust_svc',{
 662     'exportnum' => $self->exportnum,
 663     'svcnum' => $svc_x->svcnum
 664   });
 665
 666   return $export_cust_svc ? $export_cust_svc->remoteid : '';
 667 }
 668
 669 =item set_remoteid SVC VALUE
 670
 671 Sets the remote id for this export for the given service.
 672 See L<FS::export_cust_svc>.
 673
 674 If value is true, inserts or updates export_cust_svc record.
 675 If value is false, deletes any existing record.
 676
 677 Returns error message, blank on success.
 678
 679 =cut
 680
 681 sub set_remoteid {
 682   my ($self, $svc_x, $value) = @_;
 683
 684   my $export_cust_svc = qsearchs('export_cust_svc',{
 685     'exportnum' => $self->exportnum,
 686     'svcnum' => $svc_x->svcnum
 687   });
 688
 689   local $SIG{HUP} = 'IGNORE';
 690   local $SIG{INT} = 'IGNORE';
 691   local $SIG{QUIT} = 'IGNORE';
 692   local $SIG{TERM} = 'IGNORE';
 693   local $SIG{TSTP} = 'IGNORE';
 694   local $SIG{PIPE} = 'IGNORE';
 695
 696   my $oldAutoCommit = $FS::UID::AutoCommit;
 697   local $FS::UID::AutoCommit = 0;
 698   my $dbh = dbh;
 699
 700   my $error = '';
 701   if ($value) {
 702     if ($export_cust_svc) {
 703       $export_cust_svc->set('remoteid',$value);
 704       $error = $export_cust_svc->replace;
 705     } else {
 706       $export_cust_svc = new FS::export_cust_svc {
 707         'exportnum' => $self->exportnum,
 708         'svcnum' => $svc_x->svcnum,
 709         'remoteid' => $value
 710       };
 711       $error = $export_cust_svc->insert;
 712     }
 713   } else {
 714     if ($export_cust_svc) {
 715       $error = $export_cust_svc->delete;
 716     } #otherwise, it already doesn't exist
 717   }
 718
 719   if ($oldAutoCommit) {
 720     $dbh->rollback if $error;
 721     $dbh->commit unless $error;
 722   }
 723
 724   return $error;
 725 }
 726
 727 =item export_links SVC_OBJECT ARRAYREF
 728
 729 Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT.
 730 The elements are displayed in the UI to lead the the operator to external
 731 configuration, monitoring, and similar tools.
 732
 733 =item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF
 734
 735 Adds a hashref of settings to SETTINGSREF specific to this export and
 736 SVC_OBJECT.  The elements can be displayed in the UI on the service view.
 737
 738 DEFAULTSREF is a hashref with the same keys where true values indicate the
 739 setting is a default (and thus can be displayed in the UI with less emphasis,
 740 or hidden by default).
 741
 742 =item actions
 743
 744 Adds one or more "action" links to the export's display in
 745 browse/part_export.cgi.  Should return pairs of values.  The first is
 746 the link label; the second is the Mason path to a document to load.
 747 The document will show in a popup.
 748
 749 =cut
 750
 751 sub actions { }
 752
 753 =cut
 754
 755 =item weight
 756
 757 Returns the 'weight' element from the export's %info hash, or 0 if there is
 758 no weight defined.
 759
 760 =cut
 761
 762 sub weight {
 763   my $self = shift;
 764   export_info()->{$self->exporttype}->{'weight'} || 0;
 765 }
 766
 767 =item info
 768
 769 Returns a reference to (a copy of) the export's %info hash.
 770
 771 =cut
 772
 773 sub info {
 774   my $self = shift;
 775   $self->{_info} ||= {
 776     %{ export_info()->{$self->exporttype} }
 777   };
 778 }
 779
 780 =item get_dids SELECTION
 781
 782 Does several things, which is unfortunate. DID phone numbers are organized
 783 in a sort-of hierarchy: state, areacode, exchange, number. Or, for some
 784 vendors: state, region, number. But not always that, either.
 785
 786 SELECTION is one or more field/value pairs specifying parts of the hierarchy
 787 that have already been selected.  C<get_dids> will then return an arrayref of
 788 the possible values for the next selection level. Note that these are not
 789 actual DIDs except at the lowest level.
 790
 791 Generally, 'state' alone will return an array of area codes or region names
 792 in the state.
 793
 794 'state' and 'areacode' together will return an array of either:
 795 - exchange strings of the form "New York (212-555-XXXX)"
 796 - ratecenter names of the form "New York, NY"
 797
 798 These strings are sent back to the UI and offered as options so that the user
 799 can choose the local calling area they like.
 800
 801 'areacode' and 'exchange', or 'state' and 'ratecenter', or 'region' by itself
 802 will return an array of actual DID numbers.
 803
 804 Passing 'tollfree' with a true value will override the whole hierarchy and
 805 return an array of tollfree numbers.
 806
 807 C<get_dids> methods should report errors via die().
 808
 809 =cut
 810
 811 # no stub; can('get_dids') should return false by default
 812
 813 #default fallbacks... FS::part_export::DID_Common ?
 814 sub can_get_dids { 0; }
 815 sub get_dids_can_tollfree { 0; }
 816 sub get_dids_can_manual   { 0; }
 817 sub get_dids_can_edit     { 0; } #don't use without can_manual, otherwise the
 818                                  # DID selector provisions a new number from
 819                                  # inventory each edit
 820 sub get_dids_npa_select   { 1; }
 821
 822 # get_dids_npa_select: if true, then prompt to select state, then area code,
 823 # then city/exchange, then phone number.
 824 # if false, then prompt to select state (actually province), then "region",
 825 # then phone number.
 826 #
 827 # get_dids_can_manual: if true, then there will be a radio button to enter
 828 # a phone number manually.
 829 #
 830 # get_dids_can_tollfree: if true, then the user will be prompted to choose
 831 # both a regular and a toll-free number. The export can have a
 832 # 'restrict_selection' option to enable only one or the other of those. See
 833 # part_export/vitelity.pm for an example.
 834 #
 835 # get_dids_can_edit: if true, then the user can use the selector again to
 836 # change the phone number for a service. if false, then they can't (have to
 837 # reprovision completely).
 838
 839 =item svc_role SVC
 840
 841 Returns the role that SVC occupies with respect to this export, if any.
 842 This is part of the part_svc's export configuration.
 843
 844 =cut
 845
 846 sub svc_role {
 847   my $self = shift;
 848   my $svc_x = shift;
 849   my $cust_svc = $svc_x->cust_svc or return '';
 850   my $export_svc = qsearchs('export_svc', { exportnum => $self->exportnum,
 851                                             svcpart   => $cust_svc->svcpart })
 852                    or return '';
 853   $export_svc->role;
 854 }
 855
 856 =item svc_with_role { SVC | PKGNUM }, ROLE
 857
 858 Given a svc_* object SVC or pkgnum PKG, and a role name ROLE, finds the
 859 service(s) in the same package that are linked to this export with ROLE.
 860
 861 =cut
 862
 863 sub svc_with_role {
 864   my $self = shift;
 865   my $svc_or_pkgnum = shift;
 866   my $role = shift;
 867   my $pkgnum;
 868   if ( ref $svc_or_pkgnum ) {
 869     $pkgnum = $svc_or_pkgnum->cust_svc->pkgnum or return '';
 870   } else {
 871     $pkgnum = $svc_or_pkgnum;
 872   }
 873   my $role_info = $self->info->{roles}->{$role}
 874     or die "role '$role' does not exist for export '".$self->exporttype."'\n";
 875   my $svcdb = $role_info->{svcdb};
 876
 877   my @svcs = qsearch({
 878     'table'     =>  $svcdb,
 879     'addl_from' =>  ' JOIN cust_svc USING (svcnum)' .
 880                     ' JOIN export_svc USING (svcpart)',
 881     'extra_sql' =>  " WHERE cust_svc.pkgnum = $pkgnum" .
 882                     " AND export_svc.exportnum = ".$self->exportnum .
 883                     " AND export_svc.role = '$role'",
 884   });
 885   if ( $role_info->{multiple} ) {
 886     return @svcs;
 887   } else {
 888     if ( @svcs > 1 ) {
 889       warn "multiple $role services in pkgnum $pkgnum; returning the first one.\n";
 890     }
 891     return $svcs[0];
 892   }
 893 }
 894
 895 =back
 896
 897 =head1 SUBROUTINES
 898
 899 =over 4
 900
 901 =item export_info [ SVCDB ]
 902
 903 Returns a hash reference of the exports for the given I<svcdb>, or if no
 904 I<svcdb> is specified, for all exports.  The keys of the hash are
 905 I<exporttype>s and the values are again hash references containing information
 906 on the export:
 907
 908   'desc'     => 'Description',
 909   'options'  => {
 910                   'option'  => { label=>'Option Label' },
 911                   'option2' => { label=>'Another label' },
 912                 },
 913   'nodomain' => 'Y', #or ''
 914   'notes'    => 'Additional notes',
 915
 916 =cut
 917
 918 sub export_info {
 919   #warn $_[0];
 920   return $exports{$_[0]} || {} if @_;
 921   #{ map { %{$exports{$_}} } keys %exports };
 922   my $r = { map { %{$exports{$_}} } keys %exports };
 923 }
 924
 925
 926 sub _upgrade_data {  #class method
 927   my ($class, %opts) = @_;
 928
 929   my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
 930   foreach my $opt ( @part_export_option ) {
 931     next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
 932     my @groupnames = split(' ',$opt->optionvalue);
 933     my @groupnums;
 934     my $error = '';
 935     foreach my $groupname ( @groupnames ) {
 936         my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
 937         unless ( $g ) {
 938             $g = new FS::radius_group {
 939                             'groupname' => $groupname,
 940                             'description' => $groupname,
 941                             };
 942             $error = $g->insert;
 943             die $error if $error;
 944         }
 945         push @groupnums, $g->groupnum;
 946     }
 947     $opt->optionvalue(join(' ',@groupnums));
 948     $error = $opt->replace;
 949     die $error if $error;
 950   }
 951   # for exports that have selectable hostnames, make sure all services
 952   # have a hostname selected
 953   foreach my $part_export (
 954     qsearch('part_export', { 'machine' => '_SVC_MACHINE' })
 955   ) {
 956
 957     my $exportnum = $part_export->exportnum;
 958     my $machinenum = $part_export->default_machine;
 959     if (!$machinenum) {
 960       my ($first) = $part_export->part_export_machine;
 961       if (!$first) {
 962         # user intervention really is required.
 963         die "Export $exportnum has no hostname options defined.\n".
 964             "You must correct this before upgrading.\n";
 965       }
 966       # warn about this, because we might not choose the right one
 967       warn "Export $exportnum (". $part_export->exporttype.
 968            ") has no default hostname.  Setting to ".$first->machine."\n";
 969       $machinenum = $first->machinenum;
 970       $part_export->set('default_machine', $machinenum);
 971       my $error = $part_export->replace;
 972       die $error if $error;
 973     }
 974
 975     # the service belongs to a service def that uses this export
 976     # and there is not a hostname selected for this export for that service
 977     my $join = ' JOIN export_svc USING ( svcpart )'.
 978                ' LEFT JOIN svc_export_machine'.
 979                ' ON ( cust_svc.svcnum = svc_export_machine.svcnum'.
 980                ' AND export_svc.exportnum = svc_export_machine.exportnum )';
 981
 982     my @svcs = qsearch( {
 983           'select'    => 'cust_svc.*',
 984           'table'     => 'cust_svc',
 985           'addl_from' => $join,
 986           'extra_sql' => ' WHERE svcexportmachinenum IS NULL'.
 987                          ' AND export_svc.exportnum = '.$part_export->exportnum,
 988       } );
 989     foreach my $cust_svc (@svcs) {
 990       my $svc_export_machine = FS::svc_export_machine->new({
 991           'exportnum'   => $exportnum,
 992           'machinenum'  => $machinenum,
 993           'svcnum'      => $cust_svc->svcnum,
 994       });
 995       my $error = $svc_export_machine->insert;
 996       die $error if $error;
 997     }
 998   }
 999
1000   # pass downstream
1001   my %exports_in_use;
1002   $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});
1003   foreach (keys(%exports_in_use)) {
1004     $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype');
1005   }
1006 }
1007
1008 #=item exporttype2svcdb EXPORTTYPE
1009 #
1010 #Returns the applicable I<svcdb> for an I<exporttype>.
1011 #
1012 #=cut
1013 #
1014 #sub exporttype2svcdb {
1015 #  my $exporttype = $_[0];
1016 #  foreach my $svcdb ( keys %exports ) {
1017 #    return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
1018 #  }
1019 #  '';
1020 #}
1021
1022 #false laziness w/part_pkg & cdr
1023 foreach my $INC ( @INC ) {
1024   foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
1025     warn "attempting to load export info from $file\n" if $DEBUG;
1026     $file =~ /\/(\w+)\.pm$/ or do {
1027       warn "unrecognized file in $INC/FS/part_export/: $file\n";
1028       next;
1029     };
1030     my $mod = $1;
1031     my $info = eval "use FS::part_export::$mod; ".
1032                     "\\%FS::part_export::$mod\::info;";
1033     if ( $@ ) {
1034       die "error using FS::part_export::$mod (skipping): $@\n" if $@;
1035       next;
1036     }
1037     unless ( keys %$info ) {
1038       warn "no %info hash found in FS::part_export::$mod, skipping\n"
1039         unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck
1040       next;
1041     }
1042     warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
1043     no strict 'refs';
1044     foreach my $svc (
1045       ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
1046     ) {
1047       unless ( $svc ) {
1048         warn "blank svc for FS::part_export::$mod (skipping)\n";
1049         next;
1050       }
1051       $exports{$svc}->{$mod} = $info;
1052     }
1053   }
1054 }
1055
1056 =back
1057
1058 =head1 NEW EXPORT CLASSES
1059
1060 A module should be added in FS/FS/part_export/ (an example may be found in
1061 eg/export_template.pm)
1062
1063 =head1 BUGS
1064
1065 Hmm... cust_export class (not necessarily a database table...) ... ?
1066
1067 deprecated column...
1068
1069 =head1 SEE ALSO
1070
1071 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
1072 L<FS::svc_domain>,
1073 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.
1074
1075 =cut
1076
1077 1;
1078