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;
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 $dbh->rollback if $oldAutoCommit;
133 #kinda false laziness with process_m2name
134 my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ }
137 $self->part_export_machine_textarea;
139 foreach my $machine ( @machines ) {
141 my $part_export_machine = new FS::part_export_machine {
142 'exportnum' => $self->exportnum,
143 'machine' => $machine,
145 $error = $part_export_machine->insert;
147 $dbh->rollback if $oldAutoCommit;
152 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
158 Delete this record from the database.
162 #foreign keys would make this much less tedious... grr dumb mysql
166 local $SIG{HUP} = 'IGNORE';
167 local $SIG{INT} = 'IGNORE';
168 local $SIG{QUIT} = 'IGNORE';
169 local $SIG{TERM} = 'IGNORE';
170 local $SIG{TSTP} = 'IGNORE';
171 local $SIG{PIPE} = 'IGNORE';
172 my $oldAutoCommit = $FS::UID::AutoCommit;
173 local $FS::UID::AutoCommit = 0;
176 # clean up export_nas records
177 my $error = $self->process_m2m(
178 'link_table' => 'export_nas',
179 'target_table' => 'nas',
181 ) || $self->SUPER::delete;
183 $dbh->rollback if $oldAutoCommit;
187 foreach my $export_svc ( $self->export_svc ) {
188 my $error = $export_svc->delete;
190 $dbh->rollback if $oldAutoCommit;
195 foreach my $part_export_machine ( $self->part_export_machine ) {
196 my $error = $part_export_machine->delete;
198 $dbh->rollback if $oldAutoCommit;
203 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
207 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
209 Replaces the OLD_RECORD with this one in the database. If there is an error,
210 returns the error, otherwise returns false.
212 If a list or hash reference of options is supplied, option records are created
220 local $SIG{HUP} = 'IGNORE';
221 local $SIG{INT} = 'IGNORE';
222 local $SIG{QUIT} = 'IGNORE';
223 local $SIG{TERM} = 'IGNORE';
224 local $SIG{TSTP} = 'IGNORE';
225 local $SIG{PIPE} = 'IGNORE';
227 my $oldAutoCommit = $FS::UID::AutoCommit;
228 local $FS::UID::AutoCommit = 0;
231 my $error = $self->SUPER::replace(@_);
233 $dbh->rollback if $oldAutoCommit;
237 if ( $self->part_export_machine_textarea ) {
239 my %part_export_machine = map { $_->machine => $_ }
240 $self->part_export_machine;
242 my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ }
245 $self->part_export_machine_textarea;
247 foreach my $machine ( @machines ) {
249 if ( $part_export_machine{$machine} ) {
251 if ( $part_export_machine{$machine}->disabled eq 'Y' ) {
252 $part_export_machine{$machine}->disabled('');
253 $error = $part_export_machine{$machine}->replace;
255 $dbh->rollback if $oldAutoCommit;
260 delete $part_export_machine{$machine}; #so we don't disable it below
264 my $part_export_machine = new FS::part_export_machine {
265 'exportnum' => $self->exportnum,
266 'machine' => $machine
268 $error = $part_export_machine->insert;
270 $dbh->rollback if $oldAutoCommit;
279 foreach my $part_export_machine ( values %part_export_machine ) {
280 $part_export_machine->disabled('Y');
281 $error = $part_export_machine->replace;
283 $dbh->rollback if $oldAutoCommit;
290 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
296 Checks all fields to make sure this is a valid export. If there is
297 an error, returns the error, otherwise returns false. Called by the insert
305 $self->ut_numbern('exportnum')
306 || $self->ut_textn('exportname')
307 || $self->ut_domainn('machine')
308 || $self->ut_alpha('exporttype')
310 return $error if $error;
312 $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
315 $self->deprecated(1); #BLAH
324 Returns a label for this export, "exportname||exportype (machine)".
330 ($self->exportname || $self->exporttype ). ' ('. $self->machine. ')';
335 Returns a label for this export, "exportname: exporttype to machine".
342 my $label = $self->exportname
343 ? '<B>'. $self->exportname. '</B>: ' #<BR>'.
346 $label .= $self->exporttype;
348 $label .= ' to '. ( $self->machine eq '_SVC_MACHINE'
349 ? 'per-service hostname'
360 #Returns the service definition (see L<FS::part_svc>) for this export.
366 # qsearchs('part_svc', { svcpart => $self->svcpart } );
371 croak "FS::part_export::part_svc deprecated";
372 #confess "FS::part_export::part_svc deprecated";
377 Returns a list of associated FS::svc_* records.
383 map { $_->svc_x } $self->cust_svc;
388 Returns a list of associated FS::cust_svc records.
394 map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
395 grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
399 =item part_export_machine
401 Returns all machines as FS::part_export_machine objects (see
402 L<FS::part_export_machine>).
406 sub part_export_machine {
408 map { $_ } #behavior of sort undefined in scalar context
409 sort { $a->machine cmp $b->machine }
410 qsearch('part_export_machine', { 'exportnum' => $self->exportnum } );
415 Returns a list of associated FS::export_svc records.
421 qsearch('export_svc', { 'exportnum' => $self->exportnum } );
426 Returns a list of associated FS::export_device records.
432 qsearch('export_device', { 'exportnum' => $self->exportnum } );
435 =item part_export_option
437 Returns all options as FS::part_export_option objects (see
438 L<FS::part_export_option>).
442 sub part_export_option {
444 $self->option_objects;
449 Returns a list of option names and values suitable for assigning to a hash.
451 =item option OPTIONNAME
453 Returns the option value for the given name, or the empty string.
457 Reblesses the object into the FS::part_export::EXPORTTYPE class, where
458 EXPORTTYPE is the object's I<exporttype> field. There should be better docs
459 on how to create new exports, but until then, see L</NEW EXPORT CLASSES>.
465 my $exporttype = $self->exporttype;
466 my $class = ref($self). "::$exporttype";
469 bless($self, $class) unless $@;
473 #these should probably all go away, just let the subclasses define em
475 =item export_insert SVC_OBJECT
482 $self->_export_insert(@_);
488 # my $method = $AUTOLOAD;
489 # #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
490 # $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
491 # $self->$method(@_);
494 =item export_replace NEW OLD
501 $self->_export_replace(@_);
511 $self->_export_delete(@_);
521 $self->_export_suspend(@_);
524 =item export_unsuspend
528 sub export_unsuspend {
531 $self->_export_unsuspend(@_);
534 #fallbacks providing useful error messages intead of infinite loops
537 return "_export_insert: unknown export type ". $self->exporttype;
540 sub _export_replace {
542 return "_export_replace: unknown export type ". $self->exporttype;
547 return "_export_delete: unknown export type ". $self->exporttype;
550 #call svcdb-specific fallbacks
552 sub _export_suspend {
554 #warn "warning: _export_suspened unimplemented for". ref($self);
556 my $new = $svc_x->clone_suspended;
557 $self->_export_replace( $new, $svc_x );
560 sub _export_unsuspend {
562 #warn "warning: _export_unsuspend unimplemented for ". ref($self);
564 my $old = $svc_x->clone_kludge_unsuspend;
565 $self->_export_replace( $svc_x, $old );
568 =item export_links SVC_OBJECT ARRAYREF
570 Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT.
571 The elements are displayed in the UI to lead the the operator to external
572 configuration, monitoring, and similar tools.
574 =item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF
576 Adds a hashref of settings to SETTINGSREF specific to this export and
577 SVC_OBJECT. The elements can be displayed in the UI on the service view.
579 DEFAULTSREF is a hashref with the same keys where true values indicate the
580 setting is a default (and thus can be displayed in the UI with less emphasis,
581 or hidden by default).
587 Returns the 'weight' element from the export's %info hash, or 0 if there is
594 export_info()->{$self->exporttype}->{'weight'} || 0;
603 =item export_info [ SVCDB ]
605 Returns a hash reference of the exports for the given I<svcdb>, or if no
606 I<svcdb> is specified, for all exports. The keys of the hash are
607 I<exporttype>s and the values are again hash references containing information
610 'desc' => 'Description',
612 'option' => { label=>'Option Label' },
613 'option2' => { label=>'Another label' },
615 'nodomain' => 'Y', #or ''
616 'notes' => 'Additional notes',
622 return $exports{$_[0]} || {} if @_;
623 #{ map { %{$exports{$_}} } keys %exports };
624 my $r = { map { %{$exports{$_}} } keys %exports };
628 sub _upgrade_data { #class method
629 my ($class, %opts) = @_;
631 my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
632 foreach my $opt ( @part_export_option ) {
633 next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
634 my @groupnames = split(' ',$opt->optionvalue);
637 foreach my $groupname ( @groupnames ) {
638 my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
640 $g = new FS::radius_group {
641 'groupname' => $groupname,
642 'description' => $groupname,
645 die $error if $error;
647 push @groupnums, $g->groupnum;
649 $opt->optionvalue(join(' ',@groupnums));
650 $error = $opt->replace;
651 die $error if $error;
655 $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});
656 foreach (keys(%exports_in_use)) {
657 $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype');
661 #=item exporttype2svcdb EXPORTTYPE
663 #Returns the applicable I<svcdb> for an I<exporttype>.
667 #sub exporttype2svcdb {
668 # my $exporttype = $_[0];
669 # foreach my $svcdb ( keys %exports ) {
670 # return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
675 #false laziness w/part_pkg & cdr
676 foreach my $INC ( @INC ) {
677 foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
678 warn "attempting to load export info from $file\n" if $DEBUG;
679 $file =~ /\/(\w+)\.pm$/ or do {
680 warn "unrecognized file in $INC/FS/part_export/: $file\n";
684 my $info = eval "use FS::part_export::$mod; ".
685 "\\%FS::part_export::$mod\::info;";
687 die "error using FS::part_export::$mod (skipping): $@\n" if $@;
690 unless ( keys %$info ) {
691 warn "no %info hash found in FS::part_export::$mod, skipping\n"
692 unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck
695 warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
698 ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
701 warn "blank svc for FS::part_export::$mod (skipping)\n";
704 $exports{$svc}->{$mod} = $info;
711 =head1 NEW EXPORT CLASSES
713 A module should be added in FS/FS/part_export/ (an example may be found in
714 eg/export_template.pm)
718 Hmm... cust_export class (not necessarily a database table...) ... ?
724 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
726 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.