1 package FS::part_export;
2 use base qw( FS::option_Common FS::m2m_Common );
5 use vars qw( @ISA @EXPORT_OK $DEBUG %exports );
8 use FS::Record qw( qsearch qsearchs dbh );
10 use FS::part_export_option;
11 use FS::part_export_machine;
12 use FS::svc_export_machine;
14 #for export modules, though they should probably just use it themselves
17 @EXPORT_OK = qw(export_info);
23 FS::part_export - Object methods for part_export records
29 $record = new FS::part_export \%hash;
30 $record = new FS::part_export { 'column' => 'value' };
32 #($new_record, $options) = $template_recored->clone( $svcpart );
34 $error = $record->insert( { 'option' => 'value' } );
35 $error = $record->insert( \%options );
37 $error = $new_record->replace($old_record);
39 $error = $record->delete;
41 $error = $record->check;
45 An FS::part_export object represents an export of Freeside data to an external
46 provisioning system. FS::part_export inherits from FS::Record. The following
47 fields are currently supported:
51 =item exportnum - primary key
53 =item exportname - Descriptive name
55 =item machine - Machine name
57 =item exporttype - Export type
59 =item nodomain - blank or "Y" : usernames are exported to this service with no domain
61 =item default_machine - For exports that require a machine to be selected for
62 each service (see L<FS::svc_export_machine>), the one to use as the default.
64 =item no_suspend - Don't export service suspensions. In the future there may
65 be "no_*" options for the other service actions.
75 Creates a new export. To add the export to the database, see L<"insert">.
77 Note that this stores the hash reference, not a distinct copy of the hash it
78 points to. You can ask the object for a copy with the I<hash> method.
82 # the new method can be inherited from FS::Record, if a table method is defined
84 sub table { 'part_export'; }
90 #An alternate constructor. Creates a new export by duplicating an existing
91 #export. The given svcpart is assigned to the new export.
93 #Returns a list consisting of the new export object and a hashref of options.
99 # my $class = ref($self);
100 # my %hash = $self->hash;
101 # $hash{'exportnum'} = '';
102 # $hash{'svcpart'} = shift;
103 # ( $class->new( \%hash ),
104 # { map { $_->optionname => $_->optionvalue }
105 # qsearch('part_export_option', { 'exportnum' => $self->exportnum } )
112 Adds this record to the database. If there is an error, returns the error,
113 otherwise returns false.
115 If a hash reference of options is supplied, part_export_option records are
116 created (see L<FS::part_export_option>).
123 local $SIG{HUP} = 'IGNORE';
124 local $SIG{INT} = 'IGNORE';
125 local $SIG{QUIT} = 'IGNORE';
126 local $SIG{TERM} = 'IGNORE';
127 local $SIG{TSTP} = 'IGNORE';
128 local $SIG{PIPE} = 'IGNORE';
129 my $oldAutoCommit = $FS::UID::AutoCommit;
130 local $FS::UID::AutoCommit = 0;
133 my $error = $self->SUPER::insert(@_)
135 # use replace to do all the part_export_machine and default_machine stuff
137 $dbh->rollback if $oldAutoCommit;
141 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
147 Delete this record from the database.
151 #foreign keys would make this much less tedious... grr dumb mysql
155 local $SIG{HUP} = 'IGNORE';
156 local $SIG{INT} = 'IGNORE';
157 local $SIG{QUIT} = 'IGNORE';
158 local $SIG{TERM} = 'IGNORE';
159 local $SIG{TSTP} = 'IGNORE';
160 local $SIG{PIPE} = 'IGNORE';
161 my $oldAutoCommit = $FS::UID::AutoCommit;
162 local $FS::UID::AutoCommit = 0;
165 # clean up export_nas records
166 my $error = $self->process_m2m(
167 'link_table' => 'export_nas',
168 'target_table' => 'nas',
170 ) || $self->process_m2m(
171 'link_table' => 'export_svc',
172 'target_table' => 'part_svc',
174 ) || $self->SUPER::delete;
176 $dbh->rollback if $oldAutoCommit;
180 foreach my $export_svc ( $self->export_svc ) {
181 my $error = $export_svc->delete;
183 $dbh->rollback if $oldAutoCommit;
188 foreach my $part_export_machine ( $self->part_export_machine ) {
189 my $error = $part_export_machine->delete;
191 $dbh->rollback if $oldAutoCommit;
196 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
200 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
202 Replaces the OLD_RECORD with this one in the database. If there is an error,
203 returns the error, otherwise returns false.
205 If a list or hash reference of options is supplied, option records are created
212 my $old = $self->replace_old;
214 local $SIG{HUP} = 'IGNORE';
215 local $SIG{INT} = 'IGNORE';
216 local $SIG{QUIT} = 'IGNORE';
217 local $SIG{TERM} = 'IGNORE';
218 local $SIG{TSTP} = 'IGNORE';
219 local $SIG{PIPE} = 'IGNORE';
221 my $oldAutoCommit = $FS::UID::AutoCommit;
222 local $FS::UID::AutoCommit = 0;
226 if ( $self->part_export_machine_textarea ) {
228 my %part_export_machine = map { $_->machine => $_ }
229 $self->part_export_machine;
231 my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ }
234 $self->part_export_machine_textarea;
236 foreach my $machine ( @machines ) {
238 if ( $part_export_machine{$machine} ) {
240 if ( $part_export_machine{$machine}->disabled eq 'Y' ) {
241 $part_export_machine{$machine}->disabled('');
242 $error = $part_export_machine{$machine}->replace;
244 $dbh->rollback if $oldAutoCommit;
249 if ( $self->default_machine_name eq $machine ) {
250 $self->default_machine( $part_export_machine{$machine}->machinenum );
253 delete $part_export_machine{$machine}; #so we don't disable it below
257 my $part_export_machine = new FS::part_export_machine {
258 'exportnum' => $self->exportnum,
259 'machine' => $machine
261 $error = $part_export_machine->insert;
263 $dbh->rollback if $oldAutoCommit;
267 if ( $self->default_machine_name eq $machine ) {
268 $self->default_machine( $part_export_machine->machinenum );
274 foreach my $part_export_machine ( values %part_export_machine ) {
275 $part_export_machine->disabled('Y');
276 $error = $part_export_machine->replace;
278 $dbh->rollback if $oldAutoCommit;
283 if ( $old->machine ne '_SVC_MACHINE' ) {
284 # then set up the default for any already-attached export_svcs
285 foreach my $export_svc ( $self->export_svc ) {
286 my @svcs = qsearch('cust_svc', { 'svcpart' => $export_svc->svcpart });
287 foreach my $cust_svc ( @svcs ) {
288 my $svc_export_machine = FS::svc_export_machine->new({
289 'exportnum' => $self->exportnum,
290 'svcnum' => $cust_svc->svcnum,
291 'machinenum' => $self->default_machine,
293 $error ||= $svc_export_machine->insert;
297 $dbh->rollback if $oldAutoCommit;
300 } # if switching to selectable hosts
302 } elsif ( $old->machine eq '_SVC_MACHINE' ) {
303 # then we're switching from selectable to non-selectable
304 foreach my $svc_export_machine (
305 qsearch('svc_export_machine', { 'exportnum' => $self->exportnum })
307 $error ||= $svc_export_machine->delete;
310 $dbh->rollback if $oldAutoCommit;
316 $error = $self->SUPER::replace(@_);
318 $dbh->rollback if $oldAutoCommit;
322 if ( $self->machine eq '_SVC_MACHINE' and ! $self->default_machine ) {
323 $dbh->rollback if $oldAutoCommit;
324 return "no default export host selected";
327 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
333 Checks all fields to make sure this is a valid export. If there is
334 an error, returns the error, otherwise returns false. Called by the insert
342 $self->ut_numbern('exportnum')
343 || $self->ut_textn('exportname')
344 || $self->ut_domainn('machine')
345 || $self->ut_alpha('exporttype')
346 || $self->ut_flag('no_suspend')
349 if ( $self->machine eq '_SVC_MACHINE' ) {
350 $error ||= $self->ut_numbern('default_machine')
352 $self->set('default_machine', '');
355 return $error if $error;
357 $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
360 $self->deprecated(1); #BLAH
369 Returns a label for this export, "exportname||exportype (machine)".
375 ($self->exportname || $self->exporttype ). ' ('. $self->machine. ')';
380 Returns a label for this export, "exportname: exporttype to machine".
387 my $label = $self->exportname
388 ? '<B>'. $self->exportname. '</B>: ' #<BR>'.
391 $label .= $self->exporttype;
393 $label .= ' to '. ( $self->machine eq '_SVC_MACHINE'
394 ? 'per-service hostname'
405 #Returns the service definition (see L<FS::part_svc>) for this export.
411 # qsearchs('part_svc', { svcpart => $self->svcpart } );
416 croak "FS::part_export::part_svc deprecated";
417 #confess "FS::part_export::part_svc deprecated";
422 Returns a list of associated FS::svc_* records.
428 map { $_->svc_x } $self->cust_svc;
433 Returns a list of associated FS::cust_svc records.
439 map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
440 grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
444 =item part_export_machine
446 Returns all machines as FS::part_export_machine objects (see
447 L<FS::part_export_machine>).
451 sub part_export_machine {
453 map { $_ } #behavior of sort undefined in scalar context
454 sort { $a->machine cmp $b->machine }
455 qsearch('part_export_machine', { 'exportnum' => $self->exportnum } );
460 Returns a list of associated FS::export_svc records.
464 Returns a list of associated FS::export_device records.
466 =item part_export_option
468 Returns all options as FS::part_export_option objects (see
469 L<FS::part_export_option>).
473 sub part_export_option {
475 $self->option_objects;
480 Returns a list of option names and values suitable for assigning to a hash.
482 =item option OPTIONNAME
484 Returns the option value for the given name, or the empty string.
488 Reblesses the object into the FS::part_export::EXPORTTYPE class, where
489 EXPORTTYPE is the object's I<exporttype> field. There should be better docs
490 on how to create new exports, but until then, see L</NEW EXPORT CLASSES>.
496 my $exporttype = $self->exporttype;
497 my $class = ref($self). "::$exporttype";
500 bless($self, $class) unless $@;
504 =item svc_machine SVC_X
506 Return the export hostname for SVC_X.
511 my( $self, $svc_x ) = @_;
513 return $self->machine unless $self->machine eq '_SVC_MACHINE';
515 my $svc_export_machine = qsearchs('svc_export_machine', {
516 'svcnum' => $svc_x->svcnum,
517 'exportnum' => $self->exportnum,
520 if (!$svc_export_machine) {
521 warn "No hostname selected for ".($self->exportname || $self->exporttype);
522 return $self->default_export_machine->machine;
525 return $svc_export_machine->part_export_machine->machine;
528 =item default_export_machine
530 Return the default export hostname for this export.
534 sub default_export_machine {
536 my $machinenum = $self->default_machine;
538 my $default_machine = FS::part_export_machine->by_key($machinenum);
539 return $default_machine->machine if $default_machine;
541 # this should not happen
542 die "no default export hostname for export ".$self->exportnum;
545 #these should probably all go away, just let the subclasses define em
547 =item export_insert SVC_OBJECT
554 $self->_export_insert(@_);
560 # my $method = $AUTOLOAD;
561 # #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
562 # $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
563 # $self->$method(@_);
566 =item export_replace NEW OLD
573 $self->_export_replace(@_);
583 $self->_export_delete(@_);
593 $self->_export_suspend(@_);
596 =item export_unsuspend
600 sub export_unsuspend {
603 $self->_export_unsuspend(@_);
606 #fallbacks providing useful error messages intead of infinite loops
609 return "_export_insert: unknown export type ". $self->exporttype;
612 sub _export_replace {
614 return "_export_replace: unknown export type ". $self->exporttype;
619 return "_export_delete: unknown export type ". $self->exporttype;
622 #call svcdb-specific fallbacks
624 sub _export_suspend {
626 #warn "warning: _export_suspened unimplemented for". ref($self);
628 my $new = $svc_x->clone_suspended;
629 $self->_export_replace( $new, $svc_x );
632 sub _export_unsuspend {
634 #warn "warning: _export_unsuspend unimplemented for ". ref($self);
636 my $old = $svc_x->clone_kludge_unsuspend;
637 $self->_export_replace( $svc_x, $old );
640 =item export_links SVC_OBJECT ARRAYREF
642 Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT.
643 The elements are displayed in the UI to lead the the operator to external
644 configuration, monitoring, and similar tools.
646 =item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF
648 Adds a hashref of settings to SETTINGSREF specific to this export and
649 SVC_OBJECT. The elements can be displayed in the UI on the service view.
651 DEFAULTSREF is a hashref with the same keys where true values indicate the
652 setting is a default (and thus can be displayed in the UI with less emphasis,
653 or hidden by default).
657 Adds one or more "action" links to the export's display in
658 browse/part_export.cgi. Should return pairs of values. The first is
659 the link label; the second is the Mason path to a document to load.
660 The document will show in a popup.
670 Returns the 'weight' element from the export's %info hash, or 0 if there is
677 export_info()->{$self->exporttype}->{'weight'} || 0;
682 Returns a reference to (a copy of) the export's %info hash.
689 %{ export_info()->{$self->exporttype} }
693 =item get_dids SELECTION
695 Does several things, which is unfortunate. DID phone numbers are organized
696 in a sort-of hierarchy: state, areacode, exchange, number. Or, for some
697 vendors: state, region, number. But not always that, either.
699 SELECTION is one or more field/value pairs specifying parts of the hierarchy
700 that have already been selected. C<get_dids> will then return an arrayref of
701 the possible values for the next selection level. Note that these are not
702 actual DIDs except at the lowest level.
704 Generally, 'state' alone will return an array of area codes or region names
707 'state' and 'areacode' together will return an array of either:
708 - exchange strings of the form "New York (212-555-XXXX)"
709 - ratecenter names of the form "New York, NY"
711 These strings are sent back to the UI and offered as options so that the user
712 can choose the local calling area they like.
714 'areacode' and 'exchange', or 'state' and 'ratecenter', or 'region' by itself
715 will return an array of actual DID numbers.
717 Passing 'tollfree' with a true value will override the whole hierarchy and
718 return an array of tollfree numbers.
722 # no stub; can('get_dids') should return false by default
724 #default fallbacks... FS::part_export::DID_Common ?
725 sub can_get_dids { 0; }
726 sub get_dids_can_tollfree { 0; }
727 sub get_dids_can_manual { 0; }
728 sub get_dids_can_edit { 0; } #don't use without can_manual, otherwise the
729 # DID selector provisions a new number from
730 # inventory each edit
731 sub get_dids_npa_select { 1; }
733 # get_dids_npa_select: if true, then prompt to select state, then area code,
734 # then city/exchange, then phone number.
735 # if false, then prompt to select state (actually province), then "region",
738 # get_dids_can_manual: if true, then there will be a radio button to enter
739 # a phone number manually.
741 # get_dids_can_tollfree: if true, then the user will be prompted to choose
742 # both a regular and a toll-free number. The export can have a
743 # 'restrict_selection' option to enable only one or the other of those. See
744 # part_export/vitelity.pm for an example.
746 # get_dids_can_edit: if true, then the user can use the selector again to
747 # change the phone number for a service. if false, then they can't (have to
748 # reprovision completely).
752 Returns the role that SVC occupies with respect to this export, if any.
753 This is part of the part_svc's export configuration.
760 my $cust_svc = $svc_x->cust_svc or return '';
761 my $export_svc = qsearchs('export_svc', { exportnum => $self->exportnum,
762 svcpart => $cust_svc->svcpart })
767 =item svc_with_role { SVC | PKGNUM }, ROLE
769 Given a svc_* object SVC or pkgnum PKG, and a role name ROLE, finds the
770 service(s) in the same package that are linked to this export with ROLE.
776 my $svc_or_pkgnum = shift;
779 if ( ref $svc_or_pkgnum ) {
780 $pkgnum = $svc_or_pkgnum->cust_svc->pkgnum or return '';
782 $pkgnum = $svc_or_pkgnum;
784 my $role_info = $self->info->{roles}->{$role}
785 or die "role '$role' does not exist for export '".$self->exporttype."'\n";
786 my $svcdb = $role_info->{svcdb};
790 'addl_from' => ' JOIN cust_svc USING (svcnum)' .
791 ' JOIN export_svc USING (svcpart)',
792 'extra_sql' => " WHERE cust_svc.pkgnum = $pkgnum" .
793 " AND export_svc.exportnum = ".$self->exportnum .
794 " AND export_svc.role = '$role'",
796 if ( $role_info->{multiple} ) {
800 warn "multiple $role services in pkgnum $pkgnum; returning the first one.\n";
812 =item export_info [ SVCDB ]
814 Returns a hash reference of the exports for the given I<svcdb>, or if no
815 I<svcdb> is specified, for all exports. The keys of the hash are
816 I<exporttype>s and the values are again hash references containing information
819 'desc' => 'Description',
821 'option' => { label=>'Option Label' },
822 'option2' => { label=>'Another label' },
824 'nodomain' => 'Y', #or ''
825 'notes' => 'Additional notes',
831 return $exports{$_[0]} || {} if @_;
832 #{ map { %{$exports{$_}} } keys %exports };
833 my $r = { map { %{$exports{$_}} } keys %exports };
837 sub _upgrade_data { #class method
838 my ($class, %opts) = @_;
840 my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
841 foreach my $opt ( @part_export_option ) {
842 next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
843 my @groupnames = split(' ',$opt->optionvalue);
846 foreach my $groupname ( @groupnames ) {
847 my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
849 $g = new FS::radius_group {
850 'groupname' => $groupname,
851 'description' => $groupname,
854 die $error if $error;
856 push @groupnums, $g->groupnum;
858 $opt->optionvalue(join(' ',@groupnums));
859 $error = $opt->replace;
860 die $error if $error;
862 # for exports that have selectable hostnames, make sure all services
863 # have a hostname selected
864 foreach my $part_export (
865 qsearch('part_export', { 'machine' => '_SVC_MACHINE' })
868 my $exportnum = $part_export->exportnum;
869 my $machinenum = $part_export->default_machine;
871 my ($first) = $part_export->part_export_machine;
873 # user intervention really is required.
874 die "Export $exportnum has no hostname options defined.\n".
875 "You must correct this before upgrading.\n";
877 # warn about this, because we might not choose the right one
878 warn "Export $exportnum (". $part_export->exporttype.
879 ") has no default hostname. Setting to ".$first->machine."\n";
880 $machinenum = $first->machinenum;
881 $part_export->set('default_machine', $machinenum);
882 my $error = $part_export->replace;
883 die $error if $error;
886 # the service belongs to a service def that uses this export
887 # and there is not a hostname selected for this export for that service
888 my $join = ' JOIN export_svc USING ( svcpart )'.
889 ' LEFT JOIN svc_export_machine'.
890 ' ON ( cust_svc.svcnum = svc_export_machine.svcnum'.
891 ' AND export_svc.exportnum = svc_export_machine.exportnum )';
893 my @svcs = qsearch( {
894 'select' => 'cust_svc.*',
895 'table' => 'cust_svc',
896 'addl_from' => $join,
897 'extra_sql' => ' WHERE svcexportmachinenum IS NULL'.
898 ' AND export_svc.exportnum = '.$part_export->exportnum,
900 foreach my $cust_svc (@svcs) {
901 my $svc_export_machine = FS::svc_export_machine->new({
902 'exportnum' => $exportnum,
903 'machinenum' => $machinenum,
904 'svcnum' => $cust_svc->svcnum,
906 my $error = $svc_export_machine->insert;
907 die $error if $error;
913 $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});
914 foreach (keys(%exports_in_use)) {
915 $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype');
919 #=item exporttype2svcdb EXPORTTYPE
921 #Returns the applicable I<svcdb> for an I<exporttype>.
925 #sub exporttype2svcdb {
926 # my $exporttype = $_[0];
927 # foreach my $svcdb ( keys %exports ) {
928 # return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
933 #false laziness w/part_pkg & cdr
934 foreach my $INC ( @INC ) {
935 foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
936 warn "attempting to load export info from $file\n" if $DEBUG;
937 $file =~ /\/(\w+)\.pm$/ or do {
938 warn "unrecognized file in $INC/FS/part_export/: $file\n";
942 my $info = eval "use FS::part_export::$mod; ".
943 "\\%FS::part_export::$mod\::info;";
945 die "error using FS::part_export::$mod (skipping): $@\n" if $@;
948 unless ( keys %$info ) {
949 warn "no %info hash found in FS::part_export::$mod, skipping\n"
950 unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck
953 warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
956 ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
959 warn "blank svc for FS::part_export::$mod (skipping)\n";
962 $exports{$svc}->{$mod} = $info;
969 =head1 NEW EXPORT CLASSES
971 A module should be added in FS/FS/part_export/ (an example may be found in
972 eg/export_template.pm)
976 Hmm... cust_export class (not necessarily a database table...) ... ?
982 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
984 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.