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).
606 Adds one or more "action" links to the export's display in
607 browse/part_export.cgi. Should return pairs of values. The first is
608 the link label; the second is the Mason path to a document to load.
609 The document will show in a popup.
619 Returns the 'weight' element from the export's %info hash, or 0 if there is
626 export_info()->{$self->exporttype}->{'weight'} || 0;
631 Returns a reference to (a copy of) the export's %info hash.
638 %{ export_info()->{$self->exporttype} }
642 #default fallbacks... FS::part_export::DID_Common ?
643 sub get_dids_can_tollfree { 0; }
644 sub get_dids_can_manual { 0; }
645 sub get_dids_can_edit { 0; } #don't use without can_manual, otherwise the
646 # DID selector provisions a new number from
647 # inventory each edit
648 sub get_dids_npa_select { 1; }
656 =item export_info [ SVCDB ]
658 Returns a hash reference of the exports for the given I<svcdb>, or if no
659 I<svcdb> is specified, for all exports. The keys of the hash are
660 I<exporttype>s and the values are again hash references containing information
663 'desc' => 'Description',
665 'option' => { label=>'Option Label' },
666 'option2' => { label=>'Another label' },
668 'nodomain' => 'Y', #or ''
669 'notes' => 'Additional notes',
675 return $exports{$_[0]} || {} if @_;
676 #{ map { %{$exports{$_}} } keys %exports };
677 my $r = { map { %{$exports{$_}} } keys %exports };
681 sub _upgrade_data { #class method
682 my ($class, %opts) = @_;
684 my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
685 foreach my $opt ( @part_export_option ) {
686 next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
687 my @groupnames = split(' ',$opt->optionvalue);
690 foreach my $groupname ( @groupnames ) {
691 my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
693 $g = new FS::radius_group {
694 'groupname' => $groupname,
695 'description' => $groupname,
698 die $error if $error;
700 push @groupnums, $g->groupnum;
702 $opt->optionvalue(join(' ',@groupnums));
703 $error = $opt->replace;
704 die $error if $error;
708 $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});
709 foreach (keys(%exports_in_use)) {
710 $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype');
714 #=item exporttype2svcdb EXPORTTYPE
716 #Returns the applicable I<svcdb> for an I<exporttype>.
720 #sub exporttype2svcdb {
721 # my $exporttype = $_[0];
722 # foreach my $svcdb ( keys %exports ) {
723 # return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
728 #false laziness w/part_pkg & cdr
729 foreach my $INC ( @INC ) {
730 foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
731 warn "attempting to load export info from $file\n" if $DEBUG;
732 $file =~ /\/(\w+)\.pm$/ or do {
733 warn "unrecognized file in $INC/FS/part_export/: $file\n";
737 my $info = eval "use FS::part_export::$mod; ".
738 "\\%FS::part_export::$mod\::info;";
740 die "error using FS::part_export::$mod (skipping): $@\n" if $@;
743 unless ( keys %$info ) {
744 warn "no %info hash found in FS::part_export::$mod, skipping\n"
745 unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck
748 warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
751 ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
754 warn "blank svc for FS::part_export::$mod (skipping)\n";
757 $exports{$svc}->{$mod} = $info;
764 =head1 NEW EXPORT CLASSES
766 A module should be added in FS/FS/part_export/ (an example may be found in
767 eg/export_template.pm)
771 Hmm... cust_export class (not necessarily a database table...) ... ?
777 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
779 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.