X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_export.pm;h=5d650626ef8282a6cd257df02beeb3efcd1856aa;hb=a72a10f754f7465121d6137bb3dcee0a21ea6443;hp=588606dc12c68bbc58626fe5ee9f443cd4f5b6fe;hpb=624b2d44625f69d71175c3348cae635d580c890b;p=freeside.git diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 588606dc1..5d650626e 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -4,16 +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::option_Common; use FS::part_svc; use FS::part_export_option; +use FS::part_export_machine; +use FS::svc_export_machine; use FS::export_svc; #for export modules, though they should probably just use it themselves use FS::queue; -@ISA = qw( FS::option_Common ); @EXPORT_OK = qw(export_info); $DEBUG = 0; @@ -50,6 +51,8 @@ fields are currently supported: =item exportnum - primary key +=item exportname - Descriptive name + =item machine - Machine name =item exporttype - Export type @@ -107,6 +110,50 @@ otherwise returns false. If a hash reference of options is supplied, part_export_option records are created (see L). +=cut + +sub insert { + 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::insert(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + #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; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + =item delete Delete this record from the database. @@ -116,18 +163,23 @@ 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; @@ -141,10 +193,103 @@ sub delete { } } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; + foreach my $part_export_machine ( $self->part_export_machine ) { + my $error = $part_export_machine->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; +} + +=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 list or hash reference of options is supplied, option records are created +or modified. + +=cut + +sub replace { + 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::replace(@_); + 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; + } + + } + + } + + + 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 @@ -159,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; @@ -174,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. @@ -215,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. @@ -275,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 @@ -387,6 +603,35 @@ 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 @@ -417,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. @@ -448,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;