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
69 Creates a new export. To add the export to the database, see L<"insert">.
71 Note that this stores the hash reference, not a distinct copy of the hash it
72 points to. You can ask the object for a copy with the I<hash> method.
76 # the new method can be inherited from FS::Record, if a table method is defined
78 sub table { 'part_export'; }
84 #An alternate constructor. Creates a new export by duplicating an existing
85 #export. The given svcpart is assigned to the new export.
87 #Returns a list consisting of the new export object and a hashref of options.
93 # my $class = ref($self);
94 # my %hash = $self->hash;
95 # $hash{'exportnum'} = '';
96 # $hash{'svcpart'} = shift;
97 # ( $class->new( \%hash ),
98 # { map { $_->optionname => $_->optionvalue }
99 # qsearch('part_export_option', { 'exportnum' => $self->exportnum } )
106 Adds this record to the database. If there is an error, returns the error,
107 otherwise returns false.
109 If a hash reference of options is supplied, part_export_option records are
110 created (see L<FS::part_export_option>).
117 local $SIG{HUP} = 'IGNORE';
118 local $SIG{INT} = 'IGNORE';
119 local $SIG{QUIT} = 'IGNORE';
120 local $SIG{TERM} = 'IGNORE';
121 local $SIG{TSTP} = 'IGNORE';
122 local $SIG{PIPE} = 'IGNORE';
123 my $oldAutoCommit = $FS::UID::AutoCommit;
124 local $FS::UID::AutoCommit = 0;
127 my $error = $self->SUPER::insert(@_)
129 # use replace to do all the part_export_machine and default_machine stuff
131 $dbh->rollback if $oldAutoCommit;
135 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
141 Delete this record from the database.
145 #foreign keys would make this much less tedious... grr dumb mysql
149 local $SIG{HUP} = 'IGNORE';
150 local $SIG{INT} = 'IGNORE';
151 local $SIG{QUIT} = 'IGNORE';
152 local $SIG{TERM} = 'IGNORE';
153 local $SIG{TSTP} = 'IGNORE';
154 local $SIG{PIPE} = 'IGNORE';
155 my $oldAutoCommit = $FS::UID::AutoCommit;
156 local $FS::UID::AutoCommit = 0;
159 # clean up export_nas records
160 my $error = $self->process_m2m(
161 'link_table' => 'export_nas',
162 'target_table' => 'nas',
164 ) || $self->process_m2m(
165 'link_table' => 'export_svc',
166 'target_table' => 'part_svc',
168 ) || $self->SUPER::delete;
170 $dbh->rollback if $oldAutoCommit;
174 foreach my $export_svc ( $self->export_svc ) {
175 my $error = $export_svc->delete;
177 $dbh->rollback if $oldAutoCommit;
182 foreach my $part_export_machine ( $self->part_export_machine ) {
183 my $error = $part_export_machine->delete;
185 $dbh->rollback if $oldAutoCommit;
190 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
194 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
196 Replaces the OLD_RECORD with this one in the database. If there is an error,
197 returns the error, otherwise returns false.
199 If a list or hash reference of options is supplied, option records are created
206 my $old = $self->replace_old;
208 local $SIG{HUP} = 'IGNORE';
209 local $SIG{INT} = 'IGNORE';
210 local $SIG{QUIT} = 'IGNORE';
211 local $SIG{TERM} = 'IGNORE';
212 local $SIG{TSTP} = 'IGNORE';
213 local $SIG{PIPE} = 'IGNORE';
215 my $oldAutoCommit = $FS::UID::AutoCommit;
216 local $FS::UID::AutoCommit = 0;
220 if ( $self->part_export_machine_textarea ) {
222 my %part_export_machine = map { $_->machine => $_ }
223 $self->part_export_machine;
225 my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ }
228 $self->part_export_machine_textarea;
230 foreach my $machine ( @machines ) {
232 if ( $part_export_machine{$machine} ) {
234 if ( $part_export_machine{$machine}->disabled eq 'Y' ) {
235 $part_export_machine{$machine}->disabled('');
236 $error = $part_export_machine{$machine}->replace;
238 $dbh->rollback if $oldAutoCommit;
243 if ( $self->default_machine_name eq $machine ) {
244 $self->default_machine( $part_export_machine{$machine}->machinenum );
247 delete $part_export_machine{$machine}; #so we don't disable it below
251 my $part_export_machine = new FS::part_export_machine {
252 'exportnum' => $self->exportnum,
253 'machine' => $machine
255 $error = $part_export_machine->insert;
257 $dbh->rollback if $oldAutoCommit;
261 if ( $self->default_machine_name eq $machine ) {
262 $self->default_machine( $part_export_machine->machinenum );
268 foreach my $part_export_machine ( values %part_export_machine ) {
269 $part_export_machine->disabled('Y');
270 $error = $part_export_machine->replace;
272 $dbh->rollback if $oldAutoCommit;
277 if ( $old->machine ne '_SVC_MACHINE' ) {
278 # then set up the default for any already-attached export_svcs
279 foreach my $export_svc ( $self->export_svc ) {
280 my @svcs = qsearch('cust_svc', { 'svcpart' => $export_svc->svcpart });
281 foreach my $cust_svc ( @svcs ) {
282 my $svc_export_machine = FS::svc_export_machine->new({
283 'exportnum' => $self->exportnum,
284 'svcnum' => $cust_svc->svcnum,
285 'machinenum' => $self->default_machine,
287 $error ||= $svc_export_machine->insert;
291 $dbh->rollback if $oldAutoCommit;
294 } # if switching to selectable hosts
296 } elsif ( $old->machine eq '_SVC_MACHINE' ) {
297 # then we're switching from selectable to non-selectable
298 foreach my $svc_export_machine (
299 qsearch('svc_export_machine', { 'exportnum' => $self->exportnum })
301 $error ||= $svc_export_machine->delete;
304 $dbh->rollback if $oldAutoCommit;
310 $error = $self->SUPER::replace(@_);
312 $dbh->rollback if $oldAutoCommit;
316 if ( $self->machine eq '_SVC_MACHINE' and ! $self->default_machine ) {
317 $dbh->rollback if $oldAutoCommit;
318 return "no default export host selected";
321 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
327 Checks all fields to make sure this is a valid export. If there is
328 an error, returns the error, otherwise returns false. Called by the insert
336 $self->ut_numbern('exportnum')
337 || $self->ut_textn('exportname')
338 || $self->ut_domainn('machine')
339 || $self->ut_alpha('exporttype')
342 if ( $self->machine eq '_SVC_MACHINE' ) {
343 $error ||= $self->ut_numbern('default_machine')
345 $self->set('default_machine', '');
348 return $error if $error;
350 $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
353 $self->deprecated(1); #BLAH
362 Returns a label for this export, "exportname||exportype (machine)".
368 ($self->exportname || $self->exporttype ). ' ('. $self->machine. ')';
373 Returns a label for this export, "exportname: exporttype to machine".
380 my $label = $self->exportname
381 ? '<B>'. $self->exportname. '</B>: ' #<BR>'.
384 $label .= $self->exporttype;
386 $label .= ' to '. ( $self->machine eq '_SVC_MACHINE'
387 ? 'per-service hostname'
398 #Returns the service definition (see L<FS::part_svc>) for this export.
404 # qsearchs('part_svc', { svcpart => $self->svcpart } );
409 croak "FS::part_export::part_svc deprecated";
410 #confess "FS::part_export::part_svc deprecated";
415 Returns a list of associated FS::svc_* records.
421 map { $_->svc_x } $self->cust_svc;
426 Returns a list of associated FS::cust_svc records.
432 map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
433 grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
437 =item part_export_machine
439 Returns all machines as FS::part_export_machine objects (see
440 L<FS::part_export_machine>).
444 sub part_export_machine {
446 map { $_ } #behavior of sort undefined in scalar context
447 sort { $a->machine cmp $b->machine }
448 qsearch('part_export_machine', { 'exportnum' => $self->exportnum } );
453 Returns a list of associated FS::export_svc records.
457 Returns a list of associated FS::export_device records.
459 =item part_export_option
461 Returns all options as FS::part_export_option objects (see
462 L<FS::part_export_option>).
466 sub part_export_option {
468 $self->option_objects;
473 Returns a list of option names and values suitable for assigning to a hash.
475 =item option OPTIONNAME
477 Returns the option value for the given name, or the empty string.
481 Reblesses the object into the FS::part_export::EXPORTTYPE class, where
482 EXPORTTYPE is the object's I<exporttype> field. There should be better docs
483 on how to create new exports, but until then, see L</NEW EXPORT CLASSES>.
489 my $exporttype = $self->exporttype;
490 my $class = ref($self). "::$exporttype";
493 bless($self, $class) unless $@;
497 =item svc_machine SVC_X
499 Return the export hostname for SVC_X.
504 my( $self, $svc_x ) = @_;
506 return $self->machine unless $self->machine eq '_SVC_MACHINE';
508 my $svc_export_machine = qsearchs('svc_export_machine', {
509 'svcnum' => $svc_x->svcnum,
510 'exportnum' => $self->exportnum,
513 if (!$svc_export_machine) {
514 warn "No hostname selected for ".($self->exportname || $self->exporttype);
515 return $self->default_export_machine->machine;
518 return $svc_export_machine->part_export_machine->machine;
521 =item default_export_machine
523 Return the default export hostname for this export.
527 sub default_export_machine {
529 my $machinenum = $self->default_machine;
531 my $default_machine = FS::part_export_machine->by_key($machinenum);
532 return $default_machine->machine if $default_machine;
534 # this should not happen
535 die "no default export hostname for export ".$self->exportnum;
540 Returns the role that SVC_X occupies with respect to this export, if any.
541 This is part of the part_svc's export configuration.
548 my $cust_svc = $svc_x->cust_svc or return '';
549 my $export_svc = qsearchs('export_svc', { exportnum => $self->exportnum,
550 svcpart => $cust_svc->svcpart })
555 #these should probably all go away, just let the subclasses define em
557 =item export_insert SVC_OBJECT
564 $self->_export_insert(@_);
570 # my $method = $AUTOLOAD;
571 # #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
572 # $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
573 # $self->$method(@_);
576 =item export_replace NEW OLD
583 $self->_export_replace(@_);
593 $self->_export_delete(@_);
603 $self->_export_suspend(@_);
606 =item export_unsuspend
610 sub export_unsuspend {
613 $self->_export_unsuspend(@_);
616 #fallbacks providing useful error messages intead of infinite loops
619 return "_export_insert: unknown export type ". $self->exporttype;
622 sub _export_replace {
624 return "_export_replace: unknown export type ". $self->exporttype;
629 return "_export_delete: unknown export type ". $self->exporttype;
632 #call svcdb-specific fallbacks
634 sub _export_suspend {
636 #warn "warning: _export_suspened unimplemented for". ref($self);
638 my $new = $svc_x->clone_suspended;
639 $self->_export_replace( $new, $svc_x );
642 sub _export_unsuspend {
644 #warn "warning: _export_unsuspend unimplemented for ". ref($self);
646 my $old = $svc_x->clone_kludge_unsuspend;
647 $self->_export_replace( $svc_x, $old );
650 =item export_links SVC_OBJECT ARRAYREF
652 Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT.
653 The elements are displayed in the UI to lead the the operator to external
654 configuration, monitoring, and similar tools.
656 =item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF
658 Adds a hashref of settings to SETTINGSREF specific to this export and
659 SVC_OBJECT. The elements can be displayed in the UI on the service view.
661 DEFAULTSREF is a hashref with the same keys where true values indicate the
662 setting is a default (and thus can be displayed in the UI with less emphasis,
663 or hidden by default).
667 Adds one or more "action" links to the export's display in
668 browse/part_export.cgi. Should return pairs of values. The first is
669 the link label; the second is the Mason path to a document to load.
670 The document will show in a popup.
680 Returns the 'weight' element from the export's %info hash, or 0 if there is
687 export_info()->{$self->exporttype}->{'weight'} || 0;
692 Returns a reference to (a copy of) the export's %info hash.
699 %{ export_info()->{$self->exporttype} }
703 =item get_dids SELECTION
705 Does several things, which is unfortunate. DID phone numbers are organized
706 in a sort-of hierarchy: state, areacode, exchange, number. Or, for some
707 vendors: state, region, number. But not always that, either.
709 SELECTION is one or more field/value pairs specifying parts of the hierarchy
710 that have already been selected. C<get_dids> will then return an arrayref of
711 the possible values for the next selection level. Note that these are not
712 actual DIDs except at the lowest level.
714 Generally, 'state' alone will return an array of area codes or region names
717 'state' and 'areacode' together will return an array of exchanges (NXX
718 prefixes), or for some exports, an array of ratecenter names.
720 'areacode' and 'exchange', or 'state' and 'ratecenter', or 'region' by itself
721 will return an array of actual DID numbers.
723 Passing 'tollfree' with a true value will override the whole hierarchy and
724 return an array of tollfree numbers.
728 # no stub; can('get_dids') should return false by default
730 #default fallbacks... FS::part_export::DID_Common ?
731 sub can_get_dids { 0; }
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).
763 =item export_info [ SVCDB ]
765 Returns a hash reference of the exports for the given I<svcdb>, or if no
766 I<svcdb> is specified, for all exports. The keys of the hash are
767 I<exporttype>s and the values are again hash references containing information
770 'desc' => 'Description',
772 'option' => { label=>'Option Label' },
773 'option2' => { label=>'Another label' },
775 'nodomain' => 'Y', #or ''
776 'notes' => 'Additional notes',
782 return $exports{$_[0]} || {} if @_;
783 #{ map { %{$exports{$_}} } keys %exports };
784 my $r = { map { %{$exports{$_}} } keys %exports };
788 sub _upgrade_data { #class method
789 my ($class, %opts) = @_;
791 my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
792 foreach my $opt ( @part_export_option ) {
793 next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
794 my @groupnames = split(' ',$opt->optionvalue);
797 foreach my $groupname ( @groupnames ) {
798 my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
800 $g = new FS::radius_group {
801 'groupname' => $groupname,
802 'description' => $groupname,
805 die $error if $error;
807 push @groupnums, $g->groupnum;
809 $opt->optionvalue(join(' ',@groupnums));
810 $error = $opt->replace;
811 die $error if $error;
813 # for exports that have selectable hostnames, make sure all services
814 # have a hostname selected
815 foreach my $part_export (
816 qsearch('part_export', { 'machine' => '_SVC_MACHINE' })
819 my $exportnum = $part_export->exportnum;
820 my $machinenum = $part_export->default_machine;
822 my ($first) = $part_export->part_export_machine;
824 # user intervention really is required.
825 die "Export $exportnum has no hostname options defined.\n".
826 "You must correct this before upgrading.\n";
828 # warn about this, because we might not choose the right one
829 warn "Export $exportnum (". $part_export->exporttype.
830 ") has no default hostname. Setting to ".$first->machine."\n";
831 $machinenum = $first->machinenum;
832 $part_export->set('default_machine', $machinenum);
833 my $error = $part_export->replace;
834 die $error if $error;
837 # the service belongs to a service def that uses this export
838 # and there is not a hostname selected for this export for that service
839 my $join = ' JOIN export_svc USING ( svcpart )'.
840 ' LEFT JOIN svc_export_machine'.
841 ' ON ( cust_svc.svcnum = svc_export_machine.svcnum'.
842 ' AND export_svc.exportnum = svc_export_machine.exportnum )';
844 my @svcs = qsearch( {
845 'select' => 'cust_svc.*',
846 'table' => 'cust_svc',
847 'addl_from' => $join,
848 'extra_sql' => ' WHERE svcexportmachinenum IS NULL'.
849 ' AND export_svc.exportnum = '.$part_export->exportnum,
851 foreach my $cust_svc (@svcs) {
852 my $svc_export_machine = FS::svc_export_machine->new({
853 'exportnum' => $exportnum,
854 'machinenum' => $machinenum,
855 'svcnum' => $cust_svc->svcnum,
857 my $error = $svc_export_machine->insert;
858 die $error if $error;
864 $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});
865 foreach (keys(%exports_in_use)) {
866 $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype');
870 #=item exporttype2svcdb EXPORTTYPE
872 #Returns the applicable I<svcdb> for an I<exporttype>.
876 #sub exporttype2svcdb {
877 # my $exporttype = $_[0];
878 # foreach my $svcdb ( keys %exports ) {
879 # return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
884 #false laziness w/part_pkg & cdr
885 foreach my $INC ( @INC ) {
886 foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
887 warn "attempting to load export info from $file\n" if $DEBUG;
888 $file =~ /\/(\w+)\.pm$/ or do {
889 warn "unrecognized file in $INC/FS/part_export/: $file\n";
893 my $info = eval "use FS::part_export::$mod; ".
894 "\\%FS::part_export::$mod\::info;";
896 die "error using FS::part_export::$mod (skipping): $@\n" if $@;
899 unless ( keys %$info ) {
900 warn "no %info hash found in FS::part_export::$mod, skipping\n"
901 unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck
904 warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
907 ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
910 warn "blank svc for FS::part_export::$mod (skipping)\n";
913 $exports{$svc}->{$mod} = $info;
920 =head1 NEW EXPORT CLASSES
922 A module should be added in FS/FS/part_export/ (an example may be found in
923 eg/export_template.pm)
927 Hmm... cust_export class (not necessarily a database table...) ... ?
933 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
935 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.