1 package FS::part_export;
4 use vars qw( @ISA @EXPORT_OK $DEBUG %exports );
7 use base qw( FS::option_Common FS::m2m_Common );
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;
15 #for export modules, though they should probably just use it themselves
18 @EXPORT_OK = qw(export_info);
24 FS::part_export - Object methods for part_export records
30 $record = new FS::part_export \%hash;
31 $record = new FS::part_export { 'column' => 'value' };
33 #($new_record, $options) = $template_recored->clone( $svcpart );
35 $error = $record->insert( { 'option' => 'value' } );
36 $error = $record->insert( \%options );
38 $error = $new_record->replace($old_record);
40 $error = $record->delete;
42 $error = $record->check;
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:
52 =item exportnum - primary key
54 =item exportname - Descriptive name
56 =item machine - Machine name
58 =item exporttype - Export type
60 =item nodomain - blank or "Y" : usernames are exported to this service with no domain
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.
65 =item no_suspend - Don't export service suspensions. In the future there may
66 be "no_*" options for the other service actions.
76 Creates a new export. To add the export to the database, see L<"insert">.
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.
83 # the new method can be inherited from FS::Record, if a table method is defined
85 sub table { 'part_export'; }
91 #An alternate constructor. Creates a new export by duplicating an existing
92 #export. The given svcpart is assigned to the new export.
94 #Returns a list consisting of the new export object and a hashref of options.
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 } )
113 Adds this record to the database. If there is an error, returns the error,
114 otherwise returns false.
116 If a hash reference of options is supplied, part_export_option records are
117 created (see L<FS::part_export_option>).
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;
134 my $error = $self->SUPER::insert(@_)
136 # use replace to do all the part_export_machine and default_machine stuff
138 $dbh->rollback if $oldAutoCommit;
142 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
148 Delete this record from the database.
152 #foreign keys would make this much less tedious... grr dumb mysql
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;
166 # clean up export_nas records
167 my $error = $self->process_m2m(
168 'link_table' => 'export_nas',
169 'target_table' => 'nas',
171 ) || $self->SUPER::delete;
173 $dbh->rollback if $oldAutoCommit;
177 foreach my $export_svc ( $self->export_svc ) {
178 my $error = $export_svc->delete;
180 $dbh->rollback if $oldAutoCommit;
185 foreach my $part_export_machine ( $self->part_export_machine ) {
186 my $error = $part_export_machine->delete;
188 $dbh->rollback if $oldAutoCommit;
193 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
197 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
199 Replaces the OLD_RECORD with this one in the database. If there is an error,
200 returns the error, otherwise returns false.
202 If a list or hash reference of options is supplied, option records are created
209 my $old = $self->replace_old;
211 local $SIG{HUP} = 'IGNORE';
212 local $SIG{INT} = 'IGNORE';
213 local $SIG{QUIT} = 'IGNORE';
214 local $SIG{TERM} = 'IGNORE';
215 local $SIG{TSTP} = 'IGNORE';
216 local $SIG{PIPE} = 'IGNORE';
218 my $oldAutoCommit = $FS::UID::AutoCommit;
219 local $FS::UID::AutoCommit = 0;
223 if ( $self->part_export_machine_textarea ) {
225 my %part_export_machine = map { $_->machine => $_ }
226 $self->part_export_machine;
228 my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ }
231 $self->part_export_machine_textarea;
233 foreach my $machine ( @machines ) {
235 if ( $part_export_machine{$machine} ) {
237 if ( $part_export_machine{$machine}->disabled eq 'Y' ) {
238 $part_export_machine{$machine}->disabled('');
239 $error = $part_export_machine{$machine}->replace;
241 $dbh->rollback if $oldAutoCommit;
246 if ( $self->default_machine_name eq $machine ) {
247 $self->default_machine( $part_export_machine{$machine}->machinenum );
250 delete $part_export_machine{$machine}; #so we don't disable it below
254 my $part_export_machine = new FS::part_export_machine {
255 'exportnum' => $self->exportnum,
256 'machine' => $machine
258 $error = $part_export_machine->insert;
260 $dbh->rollback if $oldAutoCommit;
264 if ( $self->default_machine_name eq $machine ) {
265 $self->default_machine( $part_export_machine->machinenum );
271 foreach my $part_export_machine ( values %part_export_machine ) {
272 $part_export_machine->disabled('Y');
273 $error = $part_export_machine->replace;
275 $dbh->rollback if $oldAutoCommit;
280 if ( $old->machine ne '_SVC_MACHINE' ) {
281 # then set up the default for any already-attached export_svcs
282 foreach my $export_svc ( $self->export_svc ) {
283 my @svcs = qsearch('cust_svc', { 'svcpart' => $export_svc->svcpart });
284 foreach my $cust_svc ( @svcs ) {
285 my $svc_export_machine = FS::svc_export_machine->new({
286 'exportnum' => $self->exportnum,
287 'svcnum' => $cust_svc->svcnum,
288 'machinenum' => $self->default_machine,
290 $error ||= $svc_export_machine->insert;
294 $dbh->rollback if $oldAutoCommit;
297 } # if switching to selectable hosts
299 } elsif ( $old->machine eq '_SVC_MACHINE' ) {
300 # then we're switching from selectable to non-selectable
301 foreach my $svc_export_machine (
302 qsearch('svc_export_machine', { 'exportnum' => $self->exportnum })
304 $error ||= $svc_export_machine->delete;
307 $dbh->rollback if $oldAutoCommit;
313 $error = $self->SUPER::replace(@_);
315 $dbh->rollback if $oldAutoCommit;
319 if ( $self->machine eq '_SVC_MACHINE' and ! $self->default_machine ) {
320 $dbh->rollback if $oldAutoCommit;
321 return "no default export host selected";
324 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
330 Checks all fields to make sure this is a valid export. If there is
331 an error, returns the error, otherwise returns false. Called by the insert
339 $self->ut_numbern('exportnum')
340 || $self->ut_textn('exportname')
341 || $self->ut_domainn('machine')
342 || $self->ut_alpha('exporttype')
343 || $self->ut_flag('no_suspend')
346 if ( $self->machine eq '_SVC_MACHINE' ) {
347 $error ||= $self->ut_numbern('default_machine')
349 $self->set('default_machine', '');
352 return $error if $error;
354 $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
357 $self->deprecated(1); #BLAH
366 Returns a label for this export, "exportname||exportype (machine)".
372 ($self->exportname || $self->exporttype ). ' ('. $self->machine. ')';
377 Returns a label for this export, "exportname: exporttype to machine".
384 my $label = $self->exportname
385 ? '<B>'. $self->exportname. '</B>: ' #<BR>'.
388 $label .= $self->exporttype;
390 $label .= ' to '. ( $self->machine eq '_SVC_MACHINE'
391 ? 'per-service hostname'
402 #Returns the service definition (see L<FS::part_svc>) for this export.
408 # qsearchs('part_svc', { svcpart => $self->svcpart } );
413 croak "FS::part_export::part_svc deprecated";
414 #confess "FS::part_export::part_svc deprecated";
419 Returns a list of associated FS::svc_* records.
425 map { $_->svc_x } $self->cust_svc;
430 Returns a list of associated FS::cust_svc records.
436 map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
437 grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
441 =item part_export_machine
443 Returns all machines as FS::part_export_machine objects (see
444 L<FS::part_export_machine>).
448 sub part_export_machine {
450 map { $_ } #behavior of sort undefined in scalar context
451 sort { $a->machine cmp $b->machine }
452 qsearch('part_export_machine', { 'exportnum' => $self->exportnum } );
457 Returns a list of associated FS::export_svc records.
463 qsearch('export_svc', { 'exportnum' => $self->exportnum } );
468 Returns a list of associated FS::export_device records.
474 qsearch('export_device', { 'exportnum' => $self->exportnum } );
477 =item part_export_option
479 Returns all options as FS::part_export_option objects (see
480 L<FS::part_export_option>).
484 sub part_export_option {
486 $self->option_objects;
491 Returns a list of option names and values suitable for assigning to a hash.
493 =item option OPTIONNAME
495 Returns the option value for the given name, or the empty string.
499 Reblesses the object into the FS::part_export::EXPORTTYPE class, where
500 EXPORTTYPE is the object's I<exporttype> field. There should be better docs
501 on how to create new exports, but until then, see L</NEW EXPORT CLASSES>.
507 my $exporttype = $self->exporttype;
508 my $class = ref($self). "::$exporttype";
511 bless($self, $class) unless $@;
515 =item svc_machine SVC_X
517 Return the export hostname for SVC_X.
522 my( $self, $svc_x ) = @_;
524 return $self->machine unless $self->machine eq '_SVC_MACHINE';
526 my $svc_export_machine = qsearchs('svc_export_machine', {
527 'svcnum' => $svc_x->svcnum,
528 'exportnum' => $self->exportnum,
531 if (!$svc_export_machine) {
532 warn "No hostname selected for ".($self->exportname || $self->exporttype);
533 return $self->default_export_machine->machine;
536 return $svc_export_machine->part_export_machine->machine;
539 =item default_export_machine
541 Return the default export hostname for this export.
545 sub default_export_machine {
547 my $machinenum = $self->default_machine;
549 my $default_machine = FS::part_export_machine->by_key($machinenum);
550 return $default_machine->machine if $default_machine;
552 # this should not happen
553 die "no default export hostname for export ".$self->exportnum;
556 #these should probably all go away, just let the subclasses define em
558 =item export_insert SVC_OBJECT
565 $self->_export_insert(@_);
571 # my $method = $AUTOLOAD;
572 # #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
573 # $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
574 # $self->$method(@_);
577 =item export_replace NEW OLD
584 $self->_export_replace(@_);
594 $self->_export_delete(@_);
604 $self->_export_suspend(@_);
607 =item export_unsuspend
611 sub export_unsuspend {
614 $self->_export_unsuspend(@_);
617 #fallbacks providing useful error messages intead of infinite loops
620 return "_export_insert: unknown export type ". $self->exporttype;
623 sub _export_replace {
625 return "_export_replace: unknown export type ". $self->exporttype;
630 return "_export_delete: unknown export type ". $self->exporttype;
633 #call svcdb-specific fallbacks
635 sub _export_suspend {
637 #warn "warning: _export_suspened unimplemented for". ref($self);
639 my $new = $svc_x->clone_suspended;
640 $self->_export_replace( $new, $svc_x );
643 sub _export_unsuspend {
645 #warn "warning: _export_unsuspend unimplemented for ". ref($self);
647 my $old = $svc_x->clone_kludge_unsuspend;
648 $self->_export_replace( $svc_x, $old );
651 =item export_links SVC_OBJECT ARRAYREF
653 Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT.
654 The elements are displayed in the UI to lead the the operator to external
655 configuration, monitoring, and similar tools.
657 =item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF
659 Adds a hashref of settings to SETTINGSREF specific to this export and
660 SVC_OBJECT. The elements can be displayed in the UI on the service view.
662 DEFAULTSREF is a hashref with the same keys where true values indicate the
663 setting is a default (and thus can be displayed in the UI with less emphasis,
664 or hidden by default).
668 Adds one or more "action" links to the export's display in
669 browse/part_export.cgi. Should return pairs of values. The first is
670 the link label; the second is the Mason path to a document to load.
671 The document will show in a popup.
681 Returns the 'weight' element from the export's %info hash, or 0 if there is
688 export_info()->{$self->exporttype}->{'weight'} || 0;
693 Returns a reference to (a copy of) the export's %info hash.
700 %{ export_info()->{$self->exporttype} }
704 =item get_dids SELECTION
706 Does several things, which is unfortunate. DID phone numbers are organized
707 in a sort-of hierarchy: state, areacode, exchange, number. Or, for some
708 vendors: state, region, number. But not always that, either.
710 SELECTION is one or more field/value pairs specifying parts of the hierarchy
711 that have already been selected. C<get_dids> will then return an arrayref of
712 the possible values for the next selection level. Note that these are not
713 actual DIDs except at the lowest level.
715 Generally, 'state' alone will return an array of area codes or region names
718 'state' and 'areacode' together will return an array of exchanges (NXX
719 prefixes), or for some exports, an array of ratecenter names.
721 'areacode' and 'exchange', or 'state' and 'ratecenter', or 'region' by itself
722 will return an array of actual DID numbers.
724 Passing 'tollfree' with a true value will override the whole hierarchy and
725 return an array of tollfree numbers.
729 # no stub; can('get_dids') should return false by default
731 #default fallbacks... FS::part_export::DID_Common ?
732 sub get_dids_can_tollfree { 0; }
733 sub get_dids_can_manual { 0; }
734 sub get_dids_can_edit { 0; } #don't use without can_manual, otherwise the
735 # DID selector provisions a new number from
736 # inventory each edit
737 sub get_dids_npa_select { 1; }
739 # get_dids_npa_select: if true, then prompt to select state, then area code,
740 # then city/exchange, then phone number.
741 # if false, then prompt to select state (actually province), then "region",
744 # get_dids_can_manual: if true, then there will be a radio button to enter
745 # a phone number manually.
747 # get_dids_can_tollfree: if true, then the user will be prompted to choose
748 # both a regular and a toll-free number. The export can have a
749 # 'restrict_selection' option to enable only one or the other of those. See
750 # part_export/vitelity.pm for an example.
752 # get_dids_can_edit: if true, then the user can use the selector again to
753 # change the phone number for a service. if false, then they can't (have to
754 # reprovision completely).
758 Returns the role that SVC occupies with respect to this export, if any.
759 This is part of the part_svc's export configuration.
766 my $cust_svc = $svc_x->cust_svc or return '';
767 my $export_svc = qsearchs('export_svc', { exportnum => $self->exportnum,
768 svcpart => $cust_svc->svcpart })
773 =item svc_with_role { SVC | PKGNUM }, ROLE
775 Given a svc_* object SVC or pkgnum PKG, and a role name ROLE, finds the
776 service(s) in the same package that are linked to this export with ROLE.
782 my $svc_or_pkgnum = shift;
785 if ( ref $svc_or_pkgnum ) {
786 $pkgnum = $svc_or_pkgnum->cust_svc->pkgnum or return '';
788 $pkgnum = $svc_or_pkgnum;
790 my $role_info = $self->info->{roles}->{$role}
791 or die "role '$role' does not exist for export '".$self->exporttype."'\n";
792 my $svcdb = $role_info->{svcdb};
796 'addl_from' => ' JOIN cust_svc USING (svcnum)' .
797 ' JOIN export_svc USING (svcpart)',
798 'extra_sql' => " WHERE cust_svc.pkgnum = $pkgnum" .
799 " AND export_svc.exportnum = ".$self->exportnum .
800 " AND export_svc.role = '$role'",
802 if ( $role_info->{multiple} ) {
806 warn "multiple $role services in pkgnum $pkgnum; returning the first one.\n";
818 =item export_info [ SVCDB ]
820 Returns a hash reference of the exports for the given I<svcdb>, or if no
821 I<svcdb> is specified, for all exports. The keys of the hash are
822 I<exporttype>s and the values are again hash references containing information
825 'desc' => 'Description',
827 'option' => { label=>'Option Label' },
828 'option2' => { label=>'Another label' },
830 'nodomain' => 'Y', #or ''
831 'notes' => 'Additional notes',
837 return $exports{$_[0]} || {} if @_;
838 #{ map { %{$exports{$_}} } keys %exports };
839 my $r = { map { %{$exports{$_}} } keys %exports };
843 sub _upgrade_data { #class method
844 my ($class, %opts) = @_;
846 my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
847 foreach my $opt ( @part_export_option ) {
848 next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
849 my @groupnames = split(' ',$opt->optionvalue);
852 foreach my $groupname ( @groupnames ) {
853 my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
855 $g = new FS::radius_group {
856 'groupname' => $groupname,
857 'description' => $groupname,
860 die $error if $error;
862 push @groupnums, $g->groupnum;
864 $opt->optionvalue(join(' ',@groupnums));
865 $error = $opt->replace;
866 die $error if $error;
868 # for exports that have selectable hostnames, make sure all services
869 # have a hostname selected
870 foreach my $part_export (
871 qsearch('part_export', { 'machine' => '_SVC_MACHINE' })
874 my $exportnum = $part_export->exportnum;
875 my $machinenum = $part_export->default_machine;
877 my ($first) = $part_export->part_export_machine;
879 # user intervention really is required.
880 die "Export $exportnum has no hostname options defined.\n".
881 "You must correct this before upgrading.\n";
883 # warn about this, because we might not choose the right one
884 warn "Export $exportnum (". $part_export->exporttype.
885 ") has no default hostname. Setting to ".$first->machine."\n";
886 $machinenum = $first->machinenum;
887 $part_export->set('default_machine', $machinenum);
888 my $error = $part_export->replace;
889 die $error if $error;
892 # the service belongs to a service def that uses this export
893 # and there is not a hostname selected for this export for that service
894 my $join = ' JOIN export_svc USING ( svcpart )'.
895 ' LEFT JOIN svc_export_machine'.
896 ' ON ( cust_svc.svcnum = svc_export_machine.svcnum'.
897 ' AND export_svc.exportnum = svc_export_machine.exportnum )';
899 my @svcs = qsearch( {
900 'select' => 'cust_svc.*',
901 'table' => 'cust_svc',
902 'addl_from' => $join,
903 'extra_sql' => ' WHERE svcexportmachinenum IS NULL'.
904 ' AND export_svc.exportnum = '.$part_export->exportnum,
906 foreach my $cust_svc (@svcs) {
907 my $svc_export_machine = FS::svc_export_machine->new({
908 'exportnum' => $exportnum,
909 'machinenum' => $machinenum,
910 'svcnum' => $cust_svc->svcnum,
912 my $error = $svc_export_machine->insert;
913 die $error if $error;
919 $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});
920 foreach (keys(%exports_in_use)) {
921 $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype');
925 #=item exporttype2svcdb EXPORTTYPE
927 #Returns the applicable I<svcdb> for an I<exporttype>.
931 #sub exporttype2svcdb {
932 # my $exporttype = $_[0];
933 # foreach my $svcdb ( keys %exports ) {
934 # return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
939 #false laziness w/part_pkg & cdr
940 foreach my $INC ( @INC ) {
941 foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
942 warn "attempting to load export info from $file\n" if $DEBUG;
943 $file =~ /\/(\w+)\.pm$/ or do {
944 warn "unrecognized file in $INC/FS/part_export/: $file\n";
948 my $info = eval "use FS::part_export::$mod; ".
949 "\\%FS::part_export::$mod\::info;";
951 die "error using FS::part_export::$mod (skipping): $@\n" if $@;
954 unless ( keys %$info ) {
955 warn "no %info hash found in FS::part_export::$mod, skipping\n"
956 unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck
959 warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
962 ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
965 warn "blank svc for FS::part_export::$mod (skipping)\n";
968 $exports{$svc}->{$mod} = $info;
975 =head1 NEW EXPORT CLASSES
977 A module should be added in FS/FS/part_export/ (an example may be found in
978 eg/export_template.pm)
982 Hmm... cust_export class (not necessarily a database table...) ... ?
988 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
990 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.