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 $dbh->rollback if $oldAutoCommit;
134 #kinda false laziness with process_m2name
135 my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ }
138 $self->part_export_machine_textarea;
140 foreach my $machine ( @machines ) {
142 my $part_export_machine = new FS::part_export_machine {
143 'exportnum' => $self->exportnum,
144 'machine' => $machine,
146 $error = $part_export_machine->insert;
148 $dbh->rollback if $oldAutoCommit;
153 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
159 Delete this record from the database.
163 #foreign keys would make this much less tedious... grr dumb mysql
167 local $SIG{HUP} = 'IGNORE';
168 local $SIG{INT} = 'IGNORE';
169 local $SIG{QUIT} = 'IGNORE';
170 local $SIG{TERM} = 'IGNORE';
171 local $SIG{TSTP} = 'IGNORE';
172 local $SIG{PIPE} = 'IGNORE';
173 my $oldAutoCommit = $FS::UID::AutoCommit;
174 local $FS::UID::AutoCommit = 0;
177 # clean up export_nas records
178 my $error = $self->process_m2m(
179 'link_table' => 'export_nas',
180 'target_table' => 'nas',
182 ) || $self->SUPER::delete;
184 $dbh->rollback if $oldAutoCommit;
188 foreach my $export_svc ( $self->export_svc ) {
189 my $error = $export_svc->delete;
191 $dbh->rollback if $oldAutoCommit;
196 foreach my $part_export_machine ( $self->part_export_machine ) {
197 my $error = $part_export_machine->delete;
199 $dbh->rollback if $oldAutoCommit;
204 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
208 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
210 Replaces the OLD_RECORD with this one in the database. If there is an error,
211 returns the error, otherwise returns false.
213 If a list or hash reference of options is supplied, option records are created
221 local $SIG{HUP} = 'IGNORE';
222 local $SIG{INT} = 'IGNORE';
223 local $SIG{QUIT} = 'IGNORE';
224 local $SIG{TERM} = 'IGNORE';
225 local $SIG{TSTP} = 'IGNORE';
226 local $SIG{PIPE} = 'IGNORE';
228 my $oldAutoCommit = $FS::UID::AutoCommit;
229 local $FS::UID::AutoCommit = 0;
232 my $error = $self->SUPER::replace(@_);
234 $dbh->rollback if $oldAutoCommit;
238 if ( $self->part_export_machine_textarea ) {
240 my %part_export_machine = map { $_->machine => $_ }
241 $self->part_export_machine;
243 my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ }
246 $self->part_export_machine_textarea;
248 foreach my $machine ( @machines ) {
250 if ( $part_export_machine{$machine} ) {
252 if ( $part_export_machine{$machine}->disabled eq 'Y' ) {
253 $part_export_machine{$machine}->disabled('');
254 $error = $part_export_machine{$machine}->replace;
256 $dbh->rollback if $oldAutoCommit;
261 delete $part_export_machine{$machine}; #so we don't disable it below
265 my $part_export_machine = new FS::part_export_machine {
266 'exportnum' => $self->exportnum,
267 'machine' => $machine
269 $error = $part_export_machine->insert;
271 $dbh->rollback if $oldAutoCommit;
280 foreach my $part_export_machine ( values %part_export_machine ) {
281 $part_export_machine->disabled('Y');
282 $error = $part_export_machine->replace;
284 $dbh->rollback if $oldAutoCommit;
291 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
297 Checks all fields to make sure this is a valid export. If there is
298 an error, returns the error, otherwise returns false. Called by the insert
306 $self->ut_numbern('exportnum')
307 || $self->ut_textn('exportname')
308 || $self->ut_domainn('machine')
309 || $self->ut_alpha('exporttype')
311 return $error if $error;
313 $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
316 $self->deprecated(1); #BLAH
325 Returns a label for this export, "exportname||exportype (machine)".
331 ($self->exportname || $self->exporttype ). ' ('. $self->machine. ')';
336 Returns a label for this export, "exportname: exporttype to machine".
343 my $label = $self->exportname
344 ? '<B>'. $self->exportname. '</B>: ' #<BR>'.
347 $label .= $self->exporttype;
349 $label .= ' to '. ( $self->machine eq '_SVC_MACHINE'
350 ? 'per-service hostname'
361 #Returns the service definition (see L<FS::part_svc>) for this export.
367 # qsearchs('part_svc', { svcpart => $self->svcpart } );
372 croak "FS::part_export::part_svc deprecated";
373 #confess "FS::part_export::part_svc deprecated";
378 Returns a list of associated FS::svc_* records.
384 map { $_->svc_x } $self->cust_svc;
389 Returns a list of associated FS::cust_svc records.
395 map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
396 grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
400 =item part_export_machine
402 Returns all machines as FS::part_export_machine objects (see
403 L<FS::part_export_machine>).
407 sub part_export_machine {
409 map { $_ } #behavior of sort undefined in scalar context
410 sort { $a->machine cmp $b->machine }
411 qsearch('part_export_machine', { 'exportnum' => $self->exportnum } );
416 Returns a list of associated FS::export_svc records.
422 qsearch('export_svc', { 'exportnum' => $self->exportnum } );
427 Returns a list of associated FS::export_device records.
433 qsearch('export_device', { 'exportnum' => $self->exportnum } );
436 =item part_export_option
438 Returns all options as FS::part_export_option objects (see
439 L<FS::part_export_option>).
443 sub part_export_option {
445 $self->option_objects;
450 Returns a list of option names and values suitable for assigning to a hash.
452 =item option OPTIONNAME
454 Returns the option value for the given name, or the empty string.
458 Reblesses the object into the FS::part_export::EXPORTTYPE class, where
459 EXPORTTYPE is the object's I<exporttype> field. There should be better docs
460 on how to create new exports, but until then, see L</NEW EXPORT CLASSES>.
466 my $exporttype = $self->exporttype;
467 my $class = ref($self). "::$exporttype";
470 bless($self, $class) unless $@;
479 my( $self, $svc_x ) = @_;
481 return $self->machine unless $self->machine eq '_SVC_MACHINE';
483 my $svc_export_machine = qsearchs('svc_export_machine', {
484 'svcnum' => $svc_x->svcnum,
485 'exportnum' => $self->exportnum,
487 #would only happen if you add this export to existing services without a
488 #machine set then try to run exports without setting it... right?
489 or die "No hostname selected for ".($self->exportname || $self->exporttype);
491 return $svc_export_machine->part_export_machine->machine;
494 #these should probably all go away, just let the subclasses define em
496 =item export_insert SVC_OBJECT
503 $self->_export_insert(@_);
509 # my $method = $AUTOLOAD;
510 # #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
511 # $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
512 # $self->$method(@_);
515 =item export_replace NEW OLD
522 $self->_export_replace(@_);
532 $self->_export_delete(@_);
542 $self->_export_suspend(@_);
545 =item export_unsuspend
549 sub export_unsuspend {
552 $self->_export_unsuspend(@_);
555 #fallbacks providing useful error messages intead of infinite loops
558 return "_export_insert: unknown export type ". $self->exporttype;
561 sub _export_replace {
563 return "_export_replace: unknown export type ". $self->exporttype;
568 return "_export_delete: unknown export type ". $self->exporttype;
571 #call svcdb-specific fallbacks
573 sub _export_suspend {
575 #warn "warning: _export_suspened unimplemented for". ref($self);
577 my $new = $svc_x->clone_suspended;
578 $self->_export_replace( $new, $svc_x );
581 sub _export_unsuspend {
583 #warn "warning: _export_unsuspend unimplemented for ". ref($self);
585 my $old = $svc_x->clone_kludge_unsuspend;
586 $self->_export_replace( $svc_x, $old );
589 =item export_links SVC_OBJECT ARRAYREF
591 Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT.
592 The elements are displayed in the UI to lead the the operator to external
593 configuration, monitoring, and similar tools.
595 =item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF
597 Adds a hashref of settings to SETTINGSREF specific to this export and
598 SVC_OBJECT. The elements can be displayed in the UI on the service view.
600 DEFAULTSREF is a hashref with the same keys where true values indicate the
601 setting is a default (and thus can be displayed in the UI with less emphasis,
602 or hidden by default).
608 Returns the 'weight' element from the export's %info hash, or 0 if there is
615 export_info()->{$self->exporttype}->{'weight'} || 0;
620 Returns a reference to (a copy of) the export's %info hash.
627 %{ export_info()->{$self->exporttype} }
637 =item export_info [ SVCDB ]
639 Returns a hash reference of the exports for the given I<svcdb>, or if no
640 I<svcdb> is specified, for all exports. The keys of the hash are
641 I<exporttype>s and the values are again hash references containing information
644 'desc' => 'Description',
646 'option' => { label=>'Option Label' },
647 'option2' => { label=>'Another label' },
649 'nodomain' => 'Y', #or ''
650 'notes' => 'Additional notes',
656 return $exports{$_[0]} || {} if @_;
657 #{ map { %{$exports{$_}} } keys %exports };
658 my $r = { map { %{$exports{$_}} } keys %exports };
662 sub _upgrade_data { #class method
663 my ($class, %opts) = @_;
665 my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
666 foreach my $opt ( @part_export_option ) {
667 next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
668 my @groupnames = split(' ',$opt->optionvalue);
671 foreach my $groupname ( @groupnames ) {
672 my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
674 $g = new FS::radius_group {
675 'groupname' => $groupname,
676 'description' => $groupname,
679 die $error if $error;
681 push @groupnums, $g->groupnum;
683 $opt->optionvalue(join(' ',@groupnums));
684 $error = $opt->replace;
685 die $error if $error;
689 $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});
690 foreach (keys(%exports_in_use)) {
691 $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype');
695 #=item exporttype2svcdb EXPORTTYPE
697 #Returns the applicable I<svcdb> for an I<exporttype>.
701 #sub exporttype2svcdb {
702 # my $exporttype = $_[0];
703 # foreach my $svcdb ( keys %exports ) {
704 # return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
709 #false laziness w/part_pkg & cdr
710 foreach my $INC ( @INC ) {
711 foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
712 warn "attempting to load export info from $file\n" if $DEBUG;
713 $file =~ /\/(\w+)\.pm$/ or do {
714 warn "unrecognized file in $INC/FS/part_export/: $file\n";
718 my $info = eval "use FS::part_export::$mod; ".
719 "\\%FS::part_export::$mod\::info;";
721 die "error using FS::part_export::$mod (skipping): $@\n" if $@;
724 unless ( keys %$info ) {
725 warn "no %info hash found in FS::part_export::$mod, skipping\n"
726 unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck
729 warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
732 ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
735 warn "blank svc for FS::part_export::$mod (skipping)\n";
738 $exports{$svc}->{$mod} = $info;
745 =head1 NEW EXPORT CLASSES
747 A module should be added in FS/FS/part_export/ (an example may be found in
748 eg/export_template.pm)
752 Hmm... cust_export class (not necessarily a database table...) ... ?
758 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
760 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.