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->SUPER::delete;
166 $dbh->rollback if $oldAutoCommit;
170 foreach my $export_svc ( $self->export_svc ) {
171 my $error = $export_svc->delete;
173 $dbh->rollback if $oldAutoCommit;
178 foreach my $part_export_machine ( $self->part_export_machine ) {
179 my $error = $part_export_machine->delete;
181 $dbh->rollback if $oldAutoCommit;
186 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
190 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
192 Replaces the OLD_RECORD with this one in the database. If there is an error,
193 returns the error, otherwise returns false.
195 If a list or hash reference of options is supplied, option records are created
202 my $old = $self->replace_old;
204 local $SIG{HUP} = 'IGNORE';
205 local $SIG{INT} = 'IGNORE';
206 local $SIG{QUIT} = 'IGNORE';
207 local $SIG{TERM} = 'IGNORE';
208 local $SIG{TSTP} = 'IGNORE';
209 local $SIG{PIPE} = 'IGNORE';
211 my $oldAutoCommit = $FS::UID::AutoCommit;
212 local $FS::UID::AutoCommit = 0;
216 if ( $self->part_export_machine_textarea ) {
218 my %part_export_machine = map { $_->machine => $_ }
219 $self->part_export_machine;
221 my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ }
224 $self->part_export_machine_textarea;
226 foreach my $machine ( @machines ) {
228 if ( $part_export_machine{$machine} ) {
230 if ( $part_export_machine{$machine}->disabled eq 'Y' ) {
231 $part_export_machine{$machine}->disabled('');
232 $error = $part_export_machine{$machine}->replace;
234 $dbh->rollback if $oldAutoCommit;
239 if ( $self->default_machine_name eq $machine ) {
240 $self->default_machine( $part_export_machine{$machine}->machinenum );
243 delete $part_export_machine{$machine}; #so we don't disable it below
247 my $part_export_machine = new FS::part_export_machine {
248 'exportnum' => $self->exportnum,
249 'machine' => $machine
251 $error = $part_export_machine->insert;
253 $dbh->rollback if $oldAutoCommit;
257 if ( $self->default_machine_name eq $machine ) {
258 $self->default_machine( $part_export_machine->machinenum );
264 foreach my $part_export_machine ( values %part_export_machine ) {
265 $part_export_machine->disabled('Y');
266 $error = $part_export_machine->replace;
268 $dbh->rollback if $oldAutoCommit;
273 if ( $old->machine ne '_SVC_MACHINE' ) {
274 # then set up the default for any already-attached export_svcs
275 foreach my $export_svc ( $self->export_svc ) {
276 my @svcs = qsearch('cust_svc', { 'svcpart' => $export_svc->svcpart });
277 foreach my $cust_svc ( @svcs ) {
278 my $svc_export_machine = FS::svc_export_machine->new({
279 'exportnum' => $self->exportnum,
280 'svcnum' => $cust_svc->svcnum,
281 'machinenum' => $self->default_machine,
283 $error ||= $svc_export_machine->insert;
287 $dbh->rollback if $oldAutoCommit;
290 } # if switching to selectable hosts
292 } elsif ( $old->machine eq '_SVC_MACHINE' ) {
293 # then we're switching from selectable to non-selectable
294 foreach my $svc_export_machine (
295 qsearch('svc_export_machine', { 'exportnum' => $self->exportnum })
297 $error ||= $svc_export_machine->delete;
300 $dbh->rollback if $oldAutoCommit;
306 $error = $self->SUPER::replace(@_);
308 $dbh->rollback if $oldAutoCommit;
312 if ( $self->machine eq '_SVC_MACHINE' and ! $self->default_machine ) {
313 $dbh->rollback if $oldAutoCommit;
314 return "no default export host selected";
317 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
323 Checks all fields to make sure this is a valid export. If there is
324 an error, returns the error, otherwise returns false. Called by the insert
332 $self->ut_numbern('exportnum')
333 || $self->ut_textn('exportname')
334 || $self->ut_domainn('machine')
335 || $self->ut_alpha('exporttype')
338 if ( $self->machine eq '_SVC_MACHINE' ) {
339 $error ||= $self->ut_numbern('default_machine')
341 $self->set('default_machine', '');
344 return $error if $error;
346 $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
349 $self->deprecated(1); #BLAH
358 Returns a label for this export, "exportname||exportype (machine)".
364 ($self->exportname || $self->exporttype ). ' ('. $self->machine. ')';
369 Returns a label for this export, "exportname: exporttype to machine".
376 my $label = $self->exportname
377 ? '<B>'. $self->exportname. '</B>: ' #<BR>'.
380 $label .= $self->exporttype;
382 $label .= ' to '. ( $self->machine eq '_SVC_MACHINE'
383 ? 'per-service hostname'
394 #Returns the service definition (see L<FS::part_svc>) for this export.
400 # qsearchs('part_svc', { svcpart => $self->svcpart } );
405 croak "FS::part_export::part_svc deprecated";
406 #confess "FS::part_export::part_svc deprecated";
411 Returns a list of associated FS::svc_* records.
417 map { $_->svc_x } $self->cust_svc;
422 Returns a list of associated FS::cust_svc records.
428 map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
429 grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
433 =item part_export_machine
435 Returns all machines as FS::part_export_machine objects (see
436 L<FS::part_export_machine>).
440 sub part_export_machine {
442 map { $_ } #behavior of sort undefined in scalar context
443 sort { $a->machine cmp $b->machine }
444 qsearch('part_export_machine', { 'exportnum' => $self->exportnum } );
449 Returns a list of associated FS::export_svc records.
453 Returns a list of associated FS::export_device records.
455 =item part_export_option
457 Returns all options as FS::part_export_option objects (see
458 L<FS::part_export_option>).
462 sub part_export_option {
464 $self->option_objects;
469 Returns a list of option names and values suitable for assigning to a hash.
471 =item option OPTIONNAME
473 Returns the option value for the given name, or the empty string.
477 Reblesses the object into the FS::part_export::EXPORTTYPE class, where
478 EXPORTTYPE is the object's I<exporttype> field. There should be better docs
479 on how to create new exports, but until then, see L</NEW EXPORT CLASSES>.
485 my $exporttype = $self->exporttype;
486 my $class = ref($self). "::$exporttype";
489 bless($self, $class) unless $@;
493 =item svc_machine SVC_X
495 Return the export hostname for SVC_X.
500 my( $self, $svc_x ) = @_;
502 return $self->machine unless $self->machine eq '_SVC_MACHINE';
504 my $svc_export_machine = qsearchs('svc_export_machine', {
505 'svcnum' => $svc_x->svcnum,
506 'exportnum' => $self->exportnum,
509 if (!$svc_export_machine) {
510 warn "No hostname selected for ".($self->exportname || $self->exporttype);
511 return $self->default_export_machine->machine;
514 return $svc_export_machine->part_export_machine->machine;
517 =item default_export_machine
519 Return the default export hostname for this export.
523 sub default_export_machine {
525 my $machinenum = $self->default_machine;
527 my $default_machine = FS::part_export_machine->by_key($machinenum);
528 return $default_machine->machine if $default_machine;
530 # this should not happen
531 die "no default export hostname for export ".$self->exportnum;
534 #these should probably all go away, just let the subclasses define em
536 =item export_insert SVC_OBJECT
543 $self->_export_insert(@_);
549 # my $method = $AUTOLOAD;
550 # #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
551 # $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
552 # $self->$method(@_);
555 =item export_replace NEW OLD
562 $self->_export_replace(@_);
572 $self->_export_delete(@_);
582 $self->_export_suspend(@_);
585 =item export_unsuspend
589 sub export_unsuspend {
592 $self->_export_unsuspend(@_);
595 #fallbacks providing useful error messages intead of infinite loops
598 return "_export_insert: unknown export type ". $self->exporttype;
601 sub _export_replace {
603 return "_export_replace: unknown export type ". $self->exporttype;
608 return "_export_delete: unknown export type ". $self->exporttype;
611 #call svcdb-specific fallbacks
613 sub _export_suspend {
615 #warn "warning: _export_suspened unimplemented for". ref($self);
617 my $new = $svc_x->clone_suspended;
618 $self->_export_replace( $new, $svc_x );
621 sub _export_unsuspend {
623 #warn "warning: _export_unsuspend unimplemented for ". ref($self);
625 my $old = $svc_x->clone_kludge_unsuspend;
626 $self->_export_replace( $svc_x, $old );
629 =item export_links SVC_OBJECT ARRAYREF
631 Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT.
632 The elements are displayed in the UI to lead the the operator to external
633 configuration, monitoring, and similar tools.
635 =item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF
637 Adds a hashref of settings to SETTINGSREF specific to this export and
638 SVC_OBJECT. The elements can be displayed in the UI on the service view.
640 DEFAULTSREF is a hashref with the same keys where true values indicate the
641 setting is a default (and thus can be displayed in the UI with less emphasis,
642 or hidden by default).
646 Adds one or more "action" links to the export's display in
647 browse/part_export.cgi. Should return pairs of values. The first is
648 the link label; the second is the Mason path to a document to load.
649 The document will show in a popup.
659 Returns the 'weight' element from the export's %info hash, or 0 if there is
666 export_info()->{$self->exporttype}->{'weight'} || 0;
671 Returns a reference to (a copy of) the export's %info hash.
678 %{ export_info()->{$self->exporttype} }
682 #default fallbacks... FS::part_export::DID_Common ?
683 sub get_dids_can_tollfree { 0; }
684 sub get_dids_can_manual { 0; }
685 sub get_dids_can_edit { 0; } #don't use without can_manual, otherwise the
686 # DID selector provisions a new number from
687 # inventory each edit
688 sub get_dids_npa_select { 1; }
696 =item export_info [ SVCDB ]
698 Returns a hash reference of the exports for the given I<svcdb>, or if no
699 I<svcdb> is specified, for all exports. The keys of the hash are
700 I<exporttype>s and the values are again hash references containing information
703 'desc' => 'Description',
705 'option' => { label=>'Option Label' },
706 'option2' => { label=>'Another label' },
708 'nodomain' => 'Y', #or ''
709 'notes' => 'Additional notes',
715 return $exports{$_[0]} || {} if @_;
716 #{ map { %{$exports{$_}} } keys %exports };
717 my $r = { map { %{$exports{$_}} } keys %exports };
721 sub _upgrade_data { #class method
722 my ($class, %opts) = @_;
724 my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
725 foreach my $opt ( @part_export_option ) {
726 next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
727 my @groupnames = split(' ',$opt->optionvalue);
730 foreach my $groupname ( @groupnames ) {
731 my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
733 $g = new FS::radius_group {
734 'groupname' => $groupname,
735 'description' => $groupname,
738 die $error if $error;
740 push @groupnums, $g->groupnum;
742 $opt->optionvalue(join(' ',@groupnums));
743 $error = $opt->replace;
744 die $error if $error;
746 # for exports that have selectable hostnames, make sure all services
747 # have a hostname selected
748 foreach my $part_export (
749 qsearch('part_export', { 'machine' => '_SVC_MACHINE' })
752 my $exportnum = $part_export->exportnum;
753 my $machinenum = $part_export->default_machine;
755 my ($first) = $part_export->part_export_machine;
757 # user intervention really is required.
758 die "Export $exportnum has no hostname options defined.\n".
759 "You must correct this before upgrading.\n";
761 # warn about this, because we might not choose the right one
762 warn "Export $exportnum (". $part_export->exporttype.
763 ") has no default hostname. Setting to ".$first->machine."\n";
764 $machinenum = $first->machinenum;
765 $part_export->set('default_machine', $machinenum);
766 my $error = $part_export->replace;
767 die $error if $error;
770 # the service belongs to a service def that uses this export
771 # and there is not a hostname selected for this export for that service
772 my $join = ' JOIN export_svc USING ( svcpart )'.
773 ' LEFT JOIN svc_export_machine'.
774 ' ON ( cust_svc.svcnum = svc_export_machine.svcnum'.
775 ' AND export_svc.exportnum = svc_export_machine.exportnum )';
777 my @svcs = qsearch( {
778 'select' => 'cust_svc.*',
779 'table' => 'cust_svc',
780 'addl_from' => $join,
781 'extra_sql' => ' WHERE svcexportmachinenum IS NULL'.
782 ' AND export_svc.exportnum = '.$part_export->exportnum,
784 foreach my $cust_svc (@svcs) {
785 my $svc_export_machine = FS::svc_export_machine->new({
786 'exportnum' => $exportnum,
787 'machinenum' => $machinenum,
788 'svcnum' => $cust_svc->svcnum,
790 my $error = $svc_export_machine->insert;
791 die $error if $error;
797 $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});
798 foreach (keys(%exports_in_use)) {
799 $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype');
803 #=item exporttype2svcdb EXPORTTYPE
805 #Returns the applicable I<svcdb> for an I<exporttype>.
809 #sub exporttype2svcdb {
810 # my $exporttype = $_[0];
811 # foreach my $svcdb ( keys %exports ) {
812 # return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
817 #false laziness w/part_pkg & cdr
818 foreach my $INC ( @INC ) {
819 foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
820 warn "attempting to load export info from $file\n" if $DEBUG;
821 $file =~ /\/(\w+)\.pm$/ or do {
822 warn "unrecognized file in $INC/FS/part_export/: $file\n";
826 my $info = eval "use FS::part_export::$mod; ".
827 "\\%FS::part_export::$mod\::info;";
829 die "error using FS::part_export::$mod (skipping): $@\n" if $@;
832 unless ( keys %$info ) {
833 warn "no %info hash found in FS::part_export::$mod, skipping\n"
834 unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck
837 warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
840 ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
843 warn "blank svc for FS::part_export::$mod (skipping)\n";
846 $exports{$svc}->{$mod} = $info;
853 =head1 NEW EXPORT CLASSES
855 A module should be added in FS/FS/part_export/ (an example may be found in
856 eg/export_template.pm)
860 Hmm... cust_export class (not necessarily a database table...) ... ?
866 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
868 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.