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
70 Creates a new export. To add the export to the database, see L<"insert">.
72 Note that this stores the hash reference, not a distinct copy of the hash it
73 points to. You can ask the object for a copy with the I<hash> method.
77 # the new method can be inherited from FS::Record, if a table method is defined
79 sub table { 'part_export'; }
85 #An alternate constructor. Creates a new export by duplicating an existing
86 #export. The given svcpart is assigned to the new export.
88 #Returns a list consisting of the new export object and a hashref of options.
94 # my $class = ref($self);
95 # my %hash = $self->hash;
96 # $hash{'exportnum'} = '';
97 # $hash{'svcpart'} = shift;
98 # ( $class->new( \%hash ),
99 # { map { $_->optionname => $_->optionvalue }
100 # qsearch('part_export_option', { 'exportnum' => $self->exportnum } )
107 Adds this record to the database. If there is an error, returns the error,
108 otherwise returns false.
110 If a hash reference of options is supplied, part_export_option records are
111 created (see L<FS::part_export_option>).
118 local $SIG{HUP} = 'IGNORE';
119 local $SIG{INT} = 'IGNORE';
120 local $SIG{QUIT} = 'IGNORE';
121 local $SIG{TERM} = 'IGNORE';
122 local $SIG{TSTP} = 'IGNORE';
123 local $SIG{PIPE} = 'IGNORE';
124 my $oldAutoCommit = $FS::UID::AutoCommit;
125 local $FS::UID::AutoCommit = 0;
128 my $error = $self->SUPER::insert(@_)
130 # use replace to do all the part_export_machine and default_machine stuff
132 $dbh->rollback if $oldAutoCommit;
136 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
142 Delete this record from the database.
146 #foreign keys would make this much less tedious... grr dumb mysql
150 local $SIG{HUP} = 'IGNORE';
151 local $SIG{INT} = 'IGNORE';
152 local $SIG{QUIT} = 'IGNORE';
153 local $SIG{TERM} = 'IGNORE';
154 local $SIG{TSTP} = 'IGNORE';
155 local $SIG{PIPE} = 'IGNORE';
156 my $oldAutoCommit = $FS::UID::AutoCommit;
157 local $FS::UID::AutoCommit = 0;
160 # clean up export_nas records
161 my $error = $self->process_m2m(
162 'link_table' => 'export_nas',
163 'target_table' => 'nas',
165 ) || $self->SUPER::delete;
167 $dbh->rollback if $oldAutoCommit;
171 foreach my $export_svc ( $self->export_svc ) {
172 my $error = $export_svc->delete;
174 $dbh->rollback if $oldAutoCommit;
179 foreach my $part_export_machine ( $self->part_export_machine ) {
180 my $error = $part_export_machine->delete;
182 $dbh->rollback if $oldAutoCommit;
187 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
191 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
193 Replaces the OLD_RECORD with this one in the database. If there is an error,
194 returns the error, otherwise returns false.
196 If a list or hash reference of options is supplied, option records are created
203 my $old = $self->replace_old;
205 local $SIG{HUP} = 'IGNORE';
206 local $SIG{INT} = 'IGNORE';
207 local $SIG{QUIT} = 'IGNORE';
208 local $SIG{TERM} = 'IGNORE';
209 local $SIG{TSTP} = 'IGNORE';
210 local $SIG{PIPE} = 'IGNORE';
212 my $oldAutoCommit = $FS::UID::AutoCommit;
213 local $FS::UID::AutoCommit = 0;
217 if ( $self->part_export_machine_textarea ) {
219 my %part_export_machine = map { $_->machine => $_ }
220 $self->part_export_machine;
222 my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ }
225 $self->part_export_machine_textarea;
227 foreach my $machine ( @machines ) {
229 if ( $part_export_machine{$machine} ) {
231 if ( $part_export_machine{$machine}->disabled eq 'Y' ) {
232 $part_export_machine{$machine}->disabled('');
233 $error = $part_export_machine{$machine}->replace;
235 $dbh->rollback if $oldAutoCommit;
240 if ( $self->default_machine_name eq $machine ) {
241 $self->default_machine( $part_export_machine{$machine}->machinenum );
244 delete $part_export_machine{$machine}; #so we don't disable it below
248 my $part_export_machine = new FS::part_export_machine {
249 'exportnum' => $self->exportnum,
250 'machine' => $machine
252 $error = $part_export_machine->insert;
254 $dbh->rollback if $oldAutoCommit;
258 if ( $self->default_machine_name eq $machine ) {
259 $self->default_machine( $part_export_machine->machinenum );
265 foreach my $part_export_machine ( values %part_export_machine ) {
266 $part_export_machine->disabled('Y');
267 $error = $part_export_machine->replace;
269 $dbh->rollback if $oldAutoCommit;
274 if ( $old->machine ne '_SVC_MACHINE' ) {
275 # then set up the default for any already-attached export_svcs
276 foreach my $export_svc ( $self->export_svc ) {
277 my @svcs = qsearch('cust_svc', { 'svcpart' => $export_svc->svcpart });
278 foreach my $cust_svc ( @svcs ) {
279 my $svc_export_machine = FS::svc_export_machine->new({
280 'exportnum' => $self->exportnum,
281 'svcnum' => $cust_svc->svcnum,
282 'machinenum' => $self->default_machine,
284 $error ||= $svc_export_machine->insert;
288 $dbh->rollback if $oldAutoCommit;
291 } # if switching to selectable hosts
293 } elsif ( $old->machine eq '_SVC_MACHINE' ) {
294 # then we're switching from selectable to non-selectable
295 foreach my $svc_export_machine (
296 qsearch('svc_export_machine', { 'exportnum' => $self->exportnum })
298 $error ||= $svc_export_machine->delete;
301 $dbh->rollback if $oldAutoCommit;
307 $error = $self->SUPER::replace(@_);
309 $dbh->rollback if $oldAutoCommit;
313 if ( $self->machine eq '_SVC_MACHINE' and ! $self->default_machine ) {
314 $dbh->rollback if $oldAutoCommit;
315 return "no default export host selected";
318 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
324 Checks all fields to make sure this is a valid export. If there is
325 an error, returns the error, otherwise returns false. Called by the insert
333 $self->ut_numbern('exportnum')
334 || $self->ut_textn('exportname')
335 || $self->ut_domainn('machine')
336 || $self->ut_alpha('exporttype')
339 if ( $self->machine eq '_SVC_MACHINE' ) {
340 $error ||= $self->ut_numbern('default_machine')
342 $self->set('default_machine', '');
345 return $error if $error;
347 $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
350 $self->deprecated(1); #BLAH
359 Returns a label for this export, "exportname||exportype (machine)".
365 ($self->exportname || $self->exporttype ). ' ('. $self->machine. ')';
370 Returns a label for this export, "exportname: exporttype to machine".
377 my $label = $self->exportname
378 ? '<B>'. $self->exportname. '</B>: ' #<BR>'.
381 $label .= $self->exporttype;
383 $label .= ' to '. ( $self->machine eq '_SVC_MACHINE'
384 ? 'per-service hostname'
395 #Returns the service definition (see L<FS::part_svc>) for this export.
401 # qsearchs('part_svc', { svcpart => $self->svcpart } );
406 croak "FS::part_export::part_svc deprecated";
407 #confess "FS::part_export::part_svc deprecated";
412 Returns a list of associated FS::svc_* records.
418 map { $_->svc_x } $self->cust_svc;
423 Returns a list of associated FS::cust_svc records.
429 map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
430 grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
434 =item part_export_machine
436 Returns all machines as FS::part_export_machine objects (see
437 L<FS::part_export_machine>).
441 sub part_export_machine {
443 map { $_ } #behavior of sort undefined in scalar context
444 sort { $a->machine cmp $b->machine }
445 qsearch('part_export_machine', { 'exportnum' => $self->exportnum } );
450 Returns a list of associated FS::export_svc records.
456 qsearch('export_svc', { 'exportnum' => $self->exportnum } );
461 Returns a list of associated FS::export_device records.
467 qsearch('export_device', { 'exportnum' => $self->exportnum } );
470 =item part_export_option
472 Returns all options as FS::part_export_option objects (see
473 L<FS::part_export_option>).
477 sub part_export_option {
479 $self->option_objects;
484 Returns a list of option names and values suitable for assigning to a hash.
486 =item option OPTIONNAME
488 Returns the option value for the given name, or the empty string.
492 Reblesses the object into the FS::part_export::EXPORTTYPE class, where
493 EXPORTTYPE is the object's I<exporttype> field. There should be better docs
494 on how to create new exports, but until then, see L</NEW EXPORT CLASSES>.
500 my $exporttype = $self->exporttype;
501 my $class = ref($self). "::$exporttype";
504 bless($self, $class) unless $@;
508 =item svc_machine SVC_X
510 Return the export hostname for SVC_X.
515 my( $self, $svc_x ) = @_;
517 return $self->machine unless $self->machine eq '_SVC_MACHINE';
519 my $svc_export_machine = qsearchs('svc_export_machine', {
520 'svcnum' => $svc_x->svcnum,
521 'exportnum' => $self->exportnum,
524 if (!$svc_export_machine) {
525 warn "No hostname selected for ".($self->exportname || $self->exporttype);
526 return $self->default_export_machine->machine;
529 return $svc_export_machine->part_export_machine->machine;
532 =item default_export_machine
534 Return the default export hostname for this export.
538 sub default_export_machine {
540 my $machinenum = $self->default_machine;
542 my $default_machine = FS::part_export_machine->by_key($machinenum);
543 return $default_machine->machine if $default_machine;
545 # this should not happen
546 die "no default export hostname for export ".$self->exportnum;
549 #these should probably all go away, just let the subclasses define em
551 =item export_insert SVC_OBJECT
558 $self->_export_insert(@_);
564 # my $method = $AUTOLOAD;
565 # #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
566 # $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
567 # $self->$method(@_);
570 =item export_replace NEW OLD
577 $self->_export_replace(@_);
587 $self->_export_delete(@_);
597 $self->_export_suspend(@_);
600 =item export_unsuspend
604 sub export_unsuspend {
607 $self->_export_unsuspend(@_);
610 #fallbacks providing useful error messages intead of infinite loops
613 return "_export_insert: unknown export type ". $self->exporttype;
616 sub _export_replace {
618 return "_export_replace: unknown export type ". $self->exporttype;
623 return "_export_delete: unknown export type ". $self->exporttype;
626 #call svcdb-specific fallbacks
628 sub _export_suspend {
630 #warn "warning: _export_suspened unimplemented for". ref($self);
632 my $new = $svc_x->clone_suspended;
633 $self->_export_replace( $new, $svc_x );
636 sub _export_unsuspend {
638 #warn "warning: _export_unsuspend unimplemented for ". ref($self);
640 my $old = $svc_x->clone_kludge_unsuspend;
641 $self->_export_replace( $svc_x, $old );
644 =item export_links SVC_OBJECT ARRAYREF
646 Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT.
647 The elements are displayed in the UI to lead the the operator to external
648 configuration, monitoring, and similar tools.
650 =item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF
652 Adds a hashref of settings to SETTINGSREF specific to this export and
653 SVC_OBJECT. The elements can be displayed in the UI on the service view.
655 DEFAULTSREF is a hashref with the same keys where true values indicate the
656 setting is a default (and thus can be displayed in the UI with less emphasis,
657 or hidden by default).
661 Adds one or more "action" links to the export's display in
662 browse/part_export.cgi. Should return pairs of values. The first is
663 the link label; the second is the Mason path to a document to load.
664 The document will show in a popup.
674 Returns the 'weight' element from the export's %info hash, or 0 if there is
681 export_info()->{$self->exporttype}->{'weight'} || 0;
686 Returns a reference to (a copy of) the export's %info hash.
693 %{ export_info()->{$self->exporttype} }
697 =item get_dids SELECTION
699 Does several things, which is unfortunate. DID phone numbers are organized
700 in a sort-of hierarchy: state, areacode, exchange, number. Or, for some
701 vendors: state, region, number. But not always that, either.
703 SELECTION is one or more field/value pairs specifying parts of the hierarchy
704 that have already been selected. C<get_dids> will then return an arrayref of
705 the possible values for the next selection level. Note that these are not
706 actual DIDs except at the lowest level.
708 Generally, 'state' alone will return an array of area codes or region names
711 'state' and 'areacode' together will return an array of exchanges (NXX
712 prefixes), or for some exports, an array of ratecenter names.
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 get_dids_can_tollfree { 0; }
726 sub get_dids_can_manual { 0; }
727 sub get_dids_can_edit { 0; } #don't use without can_manual, otherwise the
728 # DID selector provisions a new number from
729 # inventory each edit
730 sub get_dids_npa_select { 1; }
732 # get_dids_npa_select: if true, then prompt to select state, then area code,
733 # then city/exchange, then phone number.
734 # if false, then prompt to select state (actually province), then "region",
737 # get_dids_can_manual: if true, then there will be a radio button to enter
738 # a phone number manually.
740 # get_dids_can_tollfree: if true, then the user will be prompted to choose
741 # both a regular and a toll-free number. The export can have a
742 # 'restrict_selection' option to enable only one or the other of those. See
743 # part_export/vitelity.pm for an example.
745 # get_dids_can_edit: if true, then the user can use the selector again to
746 # change the phone number for a service. if false, then they can't (have to
747 # reprovision completely).
751 Returns the role that SVC occupies with respect to this export, if any.
752 This is part of the part_svc's export configuration.
759 my $cust_svc = $svc_x->cust_svc or return '';
760 my $export_svc = qsearchs('export_svc', { exportnum => $self->exportnum,
761 svcpart => $cust_svc->svcpart })
766 =item svc_with_role { SVC | PKGNUM }, ROLE
768 Given a svc_* object SVC or pkgnum PKG, and a role name ROLE, finds the
769 service(s) in the same package that are linked to this export with ROLE.
775 my $svc_or_pkgnum = shift;
778 if ( ref $svc_or_pkgnum ) {
779 $pkgnum = $svc_or_pkgnum->cust_svc->pkgnum or return '';
781 $pkgnum = $svc_or_pkgnum;
783 my $role_info = $self->info->{roles}->{$role}
784 or die "role '$role' does not exist for export '".$self->exporttype."'\n";
785 my $svcdb = $role_info->{svcdb};
789 'addl_from' => ' JOIN cust_svc USING (svcnum)' .
790 ' JOIN export_svc USING (svcpart)',
791 'extra_sql' => " WHERE cust_svc.pkgnum = $pkgnum" .
792 " AND export_svc.exportnum = ".$self->exportnum .
793 " AND export_svc.role = '$role'",
795 if ( $role_info->{multiple} ) {
799 warn "multiple $role services in pkgnum $pkgnum; returning the first one.\n";
811 =item export_info [ SVCDB ]
813 Returns a hash reference of the exports for the given I<svcdb>, or if no
814 I<svcdb> is specified, for all exports. The keys of the hash are
815 I<exporttype>s and the values are again hash references containing information
818 'desc' => 'Description',
820 'option' => { label=>'Option Label' },
821 'option2' => { label=>'Another label' },
823 'nodomain' => 'Y', #or ''
824 'notes' => 'Additional notes',
830 return $exports{$_[0]} || {} if @_;
831 #{ map { %{$exports{$_}} } keys %exports };
832 my $r = { map { %{$exports{$_}} } keys %exports };
836 sub _upgrade_data { #class method
837 my ($class, %opts) = @_;
839 my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
840 foreach my $opt ( @part_export_option ) {
841 next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
842 my @groupnames = split(' ',$opt->optionvalue);
845 foreach my $groupname ( @groupnames ) {
846 my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
848 $g = new FS::radius_group {
849 'groupname' => $groupname,
850 'description' => $groupname,
853 die $error if $error;
855 push @groupnums, $g->groupnum;
857 $opt->optionvalue(join(' ',@groupnums));
858 $error = $opt->replace;
859 die $error if $error;
861 # for exports that have selectable hostnames, make sure all services
862 # have a hostname selected
863 foreach my $part_export (
864 qsearch('part_export', { 'machine' => '_SVC_MACHINE' })
867 my $exportnum = $part_export->exportnum;
868 my $machinenum = $part_export->default_machine;
870 my ($first) = $part_export->part_export_machine;
872 # user intervention really is required.
873 die "Export $exportnum has no hostname options defined.\n".
874 "You must correct this before upgrading.\n";
876 # warn about this, because we might not choose the right one
877 warn "Export $exportnum (". $part_export->exporttype.
878 ") has no default hostname. Setting to ".$first->machine."\n";
879 $machinenum = $first->machinenum;
880 $part_export->set('default_machine', $machinenum);
881 my $error = $part_export->replace;
882 die $error if $error;
885 # the service belongs to a service def that uses this export
886 # and there is not a hostname selected for this export for that service
887 my $join = ' JOIN export_svc USING ( svcpart )'.
888 ' LEFT JOIN svc_export_machine'.
889 ' ON ( cust_svc.svcnum = svc_export_machine.svcnum'.
890 ' AND export_svc.exportnum = svc_export_machine.exportnum )';
892 my @svcs = qsearch( {
893 'select' => 'cust_svc.*',
894 'table' => 'cust_svc',
895 'addl_from' => $join,
896 'extra_sql' => ' WHERE svcexportmachinenum IS NULL'.
897 ' AND export_svc.exportnum = '.$part_export->exportnum,
899 foreach my $cust_svc (@svcs) {
900 my $svc_export_machine = FS::svc_export_machine->new({
901 'exportnum' => $exportnum,
902 'machinenum' => $machinenum,
903 'svcnum' => $cust_svc->svcnum,
905 my $error = $svc_export_machine->insert;
906 die $error if $error;
912 $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});
913 foreach (keys(%exports_in_use)) {
914 $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype');
918 #=item exporttype2svcdb EXPORTTYPE
920 #Returns the applicable I<svcdb> for an I<exporttype>.
924 #sub exporttype2svcdb {
925 # my $exporttype = $_[0];
926 # foreach my $svcdb ( keys %exports ) {
927 # return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
932 #false laziness w/part_pkg & cdr
933 foreach my $INC ( @INC ) {
934 foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
935 warn "attempting to load export info from $file\n" if $DEBUG;
936 $file =~ /\/(\w+)\.pm$/ or do {
937 warn "unrecognized file in $INC/FS/part_export/: $file\n";
941 my $info = eval "use FS::part_export::$mod; ".
942 "\\%FS::part_export::$mod\::info;";
944 die "error using FS::part_export::$mod (skipping): $@\n" if $@;
947 unless ( keys %$info ) {
948 warn "no %info hash found in FS::part_export::$mod, skipping\n"
949 unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck
952 warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
955 ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
958 warn "blank svc for FS::part_export::$mod (skipping)\n";
961 $exports{$svc}->{$mod} = $info;
968 =head1 NEW EXPORT CLASSES
970 A module should be added in FS/FS/part_export/ (an example may be found in
971 eg/export_template.pm)
975 Hmm... cust_export class (not necessarily a database table...) ... ?
981 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
983 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.