X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_export.pm;h=5d650626ef8282a6cd257df02beeb3efcd1856aa;hb=a72a10f754f7465121d6137bb3dcee0a21ea6443;hp=3f677b2670386f4790ee0e05113f686aec18cbd3;hpb=b8cfd0780aa40bb07f3215bf9cb58011f5e32a35;p=freeside.git diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 3f677b267..5d650626e 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -4,12 +4,17 @@ use strict; use vars qw( @ISA @EXPORT_OK $DEBUG %exports ); use Exporter; use Tie::IxHash; +use base qw( FS::option_Common FS::m2m_Common ); use FS::Record qw( qsearch qsearchs dbh ); use FS::part_svc; use FS::part_export_option; +use FS::part_export_machine; +use FS::svc_export_machine; use FS::export_svc; -@ISA = qw(FS::Record); +#for export modules, though they should probably just use it themselves +use FS::queue; + @EXPORT_OK = qw(export_info); $DEBUG = 0; @@ -46,6 +51,8 @@ fields are currently supported: =item exportnum - primary key +=item exportname - Descriptive name + =item machine - Machine name =item exporttype - Export type @@ -105,34 +112,38 @@ created (see L). =cut -#false laziness w/queue.pm sub insert { my $self = shift; - my $options = shift; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; - my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->SUPER::insert; + my $error = $self->SUPER::insert(@_); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - foreach my $optionname ( keys %{$options} ) { - my $part_export_option = new FS::part_export_option ( { - 'exportnum' => $self->exportnum, - 'optionname' => $optionname, - 'optionvalue' => $options->{$optionname}, - } ); - $error = $part_export_option->insert; + #kinda false laziness with process_m2name + my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ } + grep /\S/, + split /[\n\r]{1,2}/, + $self->part_export_machine_textarea; + + foreach my $machine ( @machines ) { + + my $part_export_machine = new FS::part_export_machine { + 'exportnum' => $self->exportnum, + 'machine' => $machine, + }; + $error = $part_export_machine->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -140,9 +151,7 @@ sub insert { } $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - } =item delete @@ -154,33 +163,38 @@ Delete this record from the database. #foreign keys would make this much less tedious... grr dumb mysql sub delete { my $self = shift; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; - my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->SUPER::delete; + # clean up export_nas records + my $error = $self->process_m2m( + 'link_table' => 'export_nas', + 'target_table' => 'nas', + 'params' => [], + ) || $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - foreach my $part_export_option ( $self->part_export_option ) { - my $error = $part_export_option->delete; + foreach my $export_svc ( $self->export_svc ) { + my $error = $export_svc->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } } - foreach my $export_svc ( $self->export_svc ) { - my $error = $export_svc->delete; + foreach my $part_export_machine ( $self->part_export_machine ) { + my $error = $part_export_machine->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -188,25 +202,22 @@ sub delete { } $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - } -=item replace OLD_RECORD HASHREF +=item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ] Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -If a hash reference of options is supplied, part_export_option records are -created or modified (see L). +If a list or hash reference of options is supplied, option records are created +or modified. =cut sub replace { my $self = shift; - my $old = shift; - my $options = shift; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -218,46 +229,68 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->SUPER::replace($old); + my $error = $self->SUPER::replace(@_); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - foreach my $optionname ( keys %{$options} ) { - my $old = qsearchs( 'part_export_option', { - 'exportnum' => $self->exportnum, - 'optionname' => $optionname, - } ); - my $new = new FS::part_export_option ( { - 'exportnum' => $self->exportnum, - 'optionname' => $optionname, - 'optionvalue' => $options->{$optionname}, - } ); - $new->optionnum($old->optionnum) if $old; - my $error = $old ? $new->replace($old) : $new->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + if ( $self->part_export_machine_textarea ) { + + my %part_export_machine = map { $_->machine => $_ } + $self->part_export_machine; + + my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ } + grep /\S/, + split /[\n\r]{1,2}/, + $self->part_export_machine_textarea; + + foreach my $machine ( @machines ) { + + if ( $part_export_machine{$machine} ) { + + if ( $part_export_machine{$machine}->disabled eq 'Y' ) { + $part_export_machine{$machine}->disabled(''); + $error = $part_export_machine{$machine}->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + delete $part_export_machine{$machine}; #so we don't disable it below + + } else { + + my $part_export_machine = new FS::part_export_machine { + 'exportnum' => $self->exportnum, + 'machine' => $machine + }; + $error = $part_export_machine->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } + } - } - #remove extraneous old options - foreach my $opt ( - grep { !exists $options->{$_->optionname} } $old->part_export_option - ) { - my $error = $opt->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + + foreach my $part_export_machine ( values %part_export_machine ) { + $part_export_machine->disabled('Y'); + $error = $part_export_machine->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -}; +} =item check @@ -271,7 +304,8 @@ sub check { my $self = shift; my $error = $self->ut_numbern('exportnum') - || $self->ut_domain('machine') + || $self->ut_textn('exportname') + || $self->ut_domainn('machine') || $self->ut_alpha('exporttype') ; return $error if $error; @@ -286,6 +320,42 @@ sub check { $self->SUPER::check; } +=item label + +Returns a label for this export, "exportname||exportype (machine)". + +=cut + +sub label { + my $self = shift; + ($self->exportname || $self->exporttype ). ' ('. $self->machine. ')'; +} + +=item label_html + +Returns a label for this export, "exportname: exporttype to machine". + +=cut + +sub label_html { + my $self = shift; + + my $label = $self->exportname + ? ''. $self->exportname. ': ' #
'. + : ''; + + $label .= $self->exporttype; + + $label .= ' to '. ( $self->machine eq '_SVC_MACHINE' + ? 'per-service hostname' + : $self->machine + ) + if $self->machine; + + $label; + +} + #=item part_svc # #Returns the service definition (see L) for this export. @@ -327,6 +397,20 @@ sub cust_svc { $self->export_svc; } +=item part_export_machine + +Returns all machines as FS::part_export_machine objects (see +L). + +=cut + +sub part_export_machine { + my $self = shift; + map { $_ } #behavior of sort undefined in scalar context + sort { $a->machine cmp $b->machine } + qsearch('part_export_machine', { 'exportnum' => $self->exportnum } ); +} + =item export_svc Returns a list of associated FS::export_svc records. @@ -338,6 +422,17 @@ sub export_svc { qsearch('export_svc', { 'exportnum' => $self->exportnum } ); } +=item export_device + +Returns a list of associated FS::export_device records. + +=cut + +sub export_device { + my $self = shift; + qsearch('export_device', { 'exportnum' => $self->exportnum } ); +} + =item part_export_option Returns all options as FS::part_export_option objects (see @@ -347,36 +442,17 @@ L). sub part_export_option { my $self = shift; - qsearch('part_export_option', { 'exportnum' => $self->exportnum } ); + $self->option_objects; } =item options Returns a list of option names and values suitable for assigning to a hash. -=cut - -sub options { - my $self = shift; - map { $_->optionname => $_->optionvalue } $self->part_export_option; -} - =item option OPTIONNAME Returns the option value for the given name, or the empty string. -=cut - -sub option { - my $self = shift; - my $part_export_option = - qsearchs('part_export_option', { - exportnum => $self->exportnum, - optionname => shift, - } ); - $part_export_option ? $part_export_option->optionvalue : ''; -} - =item _rebless Reblesses the object into the FS::part_export::EXPORTTYPE class, where @@ -395,6 +471,26 @@ sub _rebless { $self; } +=item svc_machine + +=cut + +sub svc_machine { + my( $self, $svc_x ) = @_; + + return $self->machine unless $self->machine eq '_SVC_MACHINE'; + + my $svc_export_machine = qsearchs('svc_export_machine', { + 'svcnum' => $svc_x->svcnum, + 'exportnum' => $self->exportnum, + }) + #would only happen if you add this export to existing services without a + #machine set then try to run exports without setting it... right? + or die "No hostname selected for ".($self->exportname || $self->exporttype); + + return $svc_export_machine->part_export_machine->machine; +} + #these should probably all go away, just let the subclasses define em =item export_insert SVC_OBJECT @@ -490,6 +586,52 @@ sub _export_unsuspend { $self->_export_replace( $svc_x, $old ); } +=item export_links SVC_OBJECT ARRAYREF + +Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT. +The elements are displayed in the UI to lead the the operator to external +configuration, monitoring, and similar tools. + +=item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF + +Adds a hashref of settings to SETTINGSREF specific to this export and +SVC_OBJECT. The elements can be displayed in the UI on the service view. + +DEFAULTSREF is a hashref with the same keys where true values indicate the +setting is a default (and thus can be displayed in the UI with less emphasis, +or hidden by default). + +=cut + +=item weight + +Returns the 'weight' element from the export's %info hash, or 0 if there is +no weight defined. + +=cut + +sub weight { + my $self = shift; + export_info()->{$self->exporttype}->{'weight'} || 0; +} + +=item info + +Returns a reference to (a copy of) the export's %info hash. + +=cut + +sub info { + my $self = shift; + $self->{_info} ||= { + %{ export_info()->{$self->exporttype} } + }; +} + +#default fallbacks... FS::part_export::DID_Common ? +sub get_dids_can_tollfree { 0; } +sub get_dids_npa_select { 1; } + =back =head1 SUBROUTINES @@ -520,6 +662,40 @@ sub export_info { my $r = { map { %{$exports{$_}} } keys %exports }; } + +sub _upgrade_data { #class method + my ($class, %opts) = @_; + + my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' }); + foreach my $opt ( @part_export_option ) { + next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue; + my @groupnames = split(' ',$opt->optionvalue); + my @groupnums; + my $error = ''; + foreach my $groupname ( @groupnames ) { + my $g = qsearchs('radius_group', { 'groupname' => $groupname } ); + unless ( $g ) { + $g = new FS::radius_group { + 'groupname' => $groupname, + 'description' => $groupname, + }; + $error = $g->insert; + die $error if $error; + } + push @groupnums, $g->groupnum; + } + $opt->optionvalue(join(' ',@groupnums)); + $error = $opt->replace; + die $error if $error; + } + # pass downstream + my %exports_in_use; + $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {}); + foreach (keys(%exports_in_use)) { + $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype'); + } +} + #=item exporttype2svcdb EXPORTTYPE # #Returns the applicable I for an I. @@ -534,6 +710,7 @@ sub export_info { # ''; #} +#false laziness w/part_pkg & cdr foreach my $INC ( @INC ) { foreach my $file ( glob("$INC/FS/part_export/*.pm") ) { warn "attempting to load export info from $file\n" if $DEBUG; @@ -550,7 +727,7 @@ foreach my $INC ( @INC ) { } unless ( keys %$info ) { warn "no %info hash found in FS::part_export::$mod, skipping\n" - unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck + unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck next; } warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;