X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_export.pm;h=96fb85fc38883de1fa834b003d001958ba6bb3a4;hb=8d0e8149e7b19ad8543ac6c8c663be63dbc34762;hp=d1148fa0ac9c3f5bc23d65fd7c4b7e8e7475f44f;hpb=ffe9f4473c5c9c7cb7caeaa5b39160d7b3e8d137;p=freeside.git diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index d1148fa0a..96fb85fc3 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -1,16 +1,24 @@ package FS::part_export; +use base qw( FS::option_Common FS::m2m_Common ); use strict; -use vars qw( @ISA @EXPORT_OK %exports ); +use vars qw( @ISA @EXPORT_OK $DEBUG %exports ); use Exporter; +use Tie::IxHash; use FS::Record qw( qsearch qsearchs dbh ); use FS::part_svc; use FS::part_export_option; -use FS::export_svc; +use FS::part_export_machine; +use FS::svc_export_machine; +use FS::export_cust_svc; + +#for export modules, though they should probably just use it themselves +use FS::queue; -@ISA = qw(FS::Record); @EXPORT_OK = qw(export_info); +$DEBUG = 0; + =head1 NAME FS::part_export - Object methods for part_export records @@ -43,12 +51,20 @@ fields are currently supported: =item exportnum - primary key +=item exportname - Descriptive name + =item machine - Machine name =item exporttype - Export type =item nodomain - blank or "Y" : usernames are exported to this service with no domain +=item default_machine - For exports that require a machine to be selected for +each service (see L), the one to use as the default. + +=item no_suspend - Don't export service suspensions. In the future there may +be "no_*" options for the other service actions. + =back =head1 METHODS @@ -102,45 +118,30 @@ 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(@_) + || $self->replace; + # use replace to do all the part_export_machine and default_machine stuff 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; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -}; +} =item delete @@ -151,33 +152,53 @@ 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; + # delete associated export_cust_svc + foreach my $export_cust_svc ( + qsearch('export_cust_svc',{ 'exportnum' => $self->exportnum }) + ) { + my $error = $export_cust_svc->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + # clean up export_nas records + my $error = $self->process_m2m( + 'link_table' => 'export_nas', + 'target_table' => 'nas', + 'params' => [], + ) || $self->process_m2m( + 'link_table' => 'export_svc', + 'target_table' => 'part_svc', + '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; @@ -185,25 +206,23 @@ 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; + my $old = $self->replace_old; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -214,47 +233,112 @@ sub replace { my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; + my $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; + } + } + + if ( $self->default_machine_name eq $machine ) { + $self->default_machine( $part_export_machine{$machine}->machinenum ); + } + + 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; + } + + if ( $self->default_machine_name eq $machine ) { + $self->default_machine( $part_export_machine->machinenum ); + } + } - my $error = $self->SUPER::replace($old); - 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; + 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; + } } - } - #remove extraneous old options - foreach my $opt ( - grep { !exists $options->{$_->optionname} } $old->part_export_option - ) { - my $error = $opt->delete; + if ( $old->machine ne '_SVC_MACHINE' ) { + # then set up the default for any already-attached export_svcs + foreach my $export_svc ( $self->export_svc ) { + my @svcs = qsearch('cust_svc', { 'svcpart' => $export_svc->svcpart }); + foreach my $cust_svc ( @svcs ) { + my $svc_export_machine = FS::svc_export_machine->new({ + 'exportnum' => $self->exportnum, + 'svcnum' => $cust_svc->svcnum, + 'machinenum' => $self->default_machine, + }); + $error ||= $svc_export_machine->insert; + } + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } # if switching to selectable hosts + + } elsif ( $old->machine eq '_SVC_MACHINE' ) { + # then we're switching from selectable to non-selectable + foreach my $svc_export_machine ( + qsearch('svc_export_machine', { 'exportnum' => $self->exportnum }) + ) { + $error ||= $svc_export_machine->delete; + } if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } + } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; + $error = $self->SUPER::replace(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } - ''; + if ( $self->machine eq '_SVC_MACHINE' and ! $self->default_machine ) { + $dbh->rollback if $oldAutoCommit; + return "no default export host selected"; + } -}; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} =item check @@ -268,16 +352,19 @@ 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') + || $self->ut_flag('no_suspend') ; - return $error if $error; - warn $self->machine. "!!!\n"; + if ( $self->machine eq '_SVC_MACHINE' ) { + $error ||= $self->ut_numbern('default_machine') + } else { + $self->set('default_machine', ''); + } - $self->machine =~ /^([\w\-\.]*)$/ - or return "Illegal machine: ". $self->machine; - $self->machine($1); + return $error if $error; $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain; $self->nodomain($1); @@ -286,7 +373,43 @@ sub check { #check exporttype? - ''; #no error + $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 @@ -306,80 +429,144 @@ sub part_svc { #confess "FS::part_export::part_svc deprecated"; } -=item export_svc +=item svc_x -Returns a list of associated FS::export_svc records. +Returns a list of associated FS::svc_* records. =cut -sub export_svc { +sub svc_x { my $self = shift; - qsearch('export_svc', { 'exportnum' => $self->exportnum } ); + map { $_->svc_x } $self->cust_svc; } -=item part_export_option +=item cust_svc -Returns all options as FS::part_export_option objects (see -L). +Returns a list of associated FS::cust_svc records. =cut -sub part_export_option { +sub cust_svc { my $self = shift; - qsearch('part_export_option', { 'exportnum' => $self->exportnum } ); + map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + $self->export_svc; } -=item options +=item part_export_machine -Returns a list of option names and values suitable for assigning to a hash. +Returns all machines as FS::part_export_machine objects (see +L). =cut -sub options { +sub part_export_machine { my $self = shift; - map { $_->optionname => $_->optionvalue } $self->part_export_option; + map { $_ } #behavior of sort undefined in scalar context + sort { $a->machine cmp $b->machine } + qsearch('part_export_machine', { 'exportnum' => $self->exportnum } ); } -=item option OPTIONNAME +=item export_svc -Returns the option value for the given name, or the empty string. +Returns a list of associated FS::export_svc records. + +=item export_device + +Returns a list of associated FS::export_device records. + +=item part_export_option + +Returns all options as FS::part_export_option objects (see +L). =cut -sub option { +sub part_export_option { my $self = shift; - my $part_export_option = - qsearchs('part_export_option', { - exportnum => $self->exportnum, - optionname => shift, - } ); - $part_export_option ? $part_export_option->optionvalue : ''; + $self->option_objects; } -=item rebless +=item options + +Returns a list of option names and values suitable for assigning to a hash. + +=item option OPTIONNAME + +Returns the option value for the given name, or the empty string. + +=item _rebless Reblesses the object into the FS::part_export::EXPORTTYPE class, where EXPORTTYPE is the object's I field. There should be better docs -on how to create new exports (and they should live in their own files and be -autoloaded-on-demand), but until then, see L. +on how to create new exports, but until then, see L. =cut -sub rebless { +sub _rebless { my $self = shift; my $exporttype = $self->exporttype; my $class = ref($self). "::$exporttype"; eval "use $class;"; - bless($self, $class); + #die $@ if $@; + bless($self, $class) unless $@; + $self; +} + +=item svc_machine SVC_X + +Return the export hostname for SVC_X. + +=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, + }); + + if (!$svc_export_machine) { + warn "No hostname selected for ".($self->exportname || $self->exporttype); + return $self->default_export_machine->machine; + } + + return $svc_export_machine->part_export_machine->machine; +} + +=item default_export_machine + +Return the default export hostname for this export. + +=cut + +sub default_export_machine { + my $self = shift; + my $machinenum = $self->default_machine; + if ( $machinenum ) { + my $default_machine = FS::part_export_machine->by_key($machinenum); + return $default_machine->machine if $default_machine; + } + # this should not happen + die "no default export hostname for export ".$self->exportnum; } =item export_insert SVC_OBJECT =cut +# Do not overload! Overload _export_insert instead + sub export_insert { my $self = shift; - $self->rebless; + #$self->rebless; + if ( $FS::svc_Common::noexport_hack ) { + carp "export_insert() suppressed by noexport_hack" if $DEBUG; + return; + } $self->_export_insert(@_); } @@ -396,9 +583,15 @@ sub export_insert { =cut +# Do not overload! Overload _export_replace instead + sub export_replace { my $self = shift; - $self->rebless; + #$self->rebless; + if ( $FS::svc_Common::noexport_hack ) { + carp "export_replace() suppressed by noexport_hack" if $DEBUG; + return; + } $self->_export_replace(@_); } @@ -406,12 +599,50 @@ sub export_replace { =cut +# Do not overload! Overload _export_delete instead + sub export_delete { my $self = shift; - $self->rebless; + #$self->rebless; + if ( $FS::svc_Common::noexport_hack ) { + carp "export_delete() suppressed by noexport_hack" if $DEBUG; + return; + } $self->_export_delete(@_); } +=item export_suspend + +=cut + +# Do not overload! Overload _export_suspend instead + +sub export_suspend { + my $self = shift; + #$self->rebless; + if ( $FS::svc_Common::noexport_hack ) { + carp "export_suspend() suppressed by noexport_hack" if $DEBUG; + return; + } + $self->_export_suspend(@_); +} + +=item export_unsuspend + +=cut + +# Do not overload! Overload _export_unsuspend instead + +sub export_unsuspend { + my $self = shift; + #$self->rebless; + if ( $FS::svc_Common::noexport_hack ) { + carp "export_unsuspend() suppressed by noexport_hack" if $DEBUG; + return; + } + $self->_export_unsuspend(@_); +} + #fallbacks providing useful error messages intead of infinite loops sub _export_insert { my $self = shift; @@ -428,6 +659,267 @@ sub _export_delete { return "_export_delete: unknown export type ". $self->exporttype; } +#call svcdb-specific fallbacks + +sub _export_suspend { + my $self = shift; + #warn "warning: _export_suspened unimplemented for". ref($self); + my $svc_x = shift; + my $new = $svc_x->clone_suspended; + $self->export_replace( $new, $svc_x ); +} + +sub _export_unsuspend { + my $self = shift; + #warn "warning: _export_unsuspend unimplemented for ". ref($self); + my $svc_x = shift; + my $old = $svc_x->clone_kludge_unsuspend; + $self->export_replace( $svc_x, $old ); +} + +=item get_remoteid SVC + +Returns the remote id for this export for the given service. + +=cut + +sub get_remoteid { + my ($self, $svc_x) = @_; + + my $export_cust_svc = qsearchs('export_cust_svc',{ + 'exportnum' => $self->exportnum, + 'svcnum' => $svc_x->svcnum + }); + + return $export_cust_svc ? $export_cust_svc->remoteid : ''; +} + +=item set_remoteid SVC VALUE + +Sets the remote id for this export for the given service. +See L. + +If value is true, inserts or updates export_cust_svc record. +If value is false, deletes any existing record. + +Returns error message, blank on success. + +=cut + +sub set_remoteid { + my ($self, $svc_x, $value) = @_; + + my $export_cust_svc = qsearchs('export_cust_svc',{ + 'exportnum' => $self->exportnum, + 'svcnum' => $svc_x->svcnum + }); + + 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 = ''; + if ($value) { + if ($export_cust_svc) { + $export_cust_svc->set('remoteid',$value); + $error = $export_cust_svc->replace; + } else { + $export_cust_svc = new FS::export_cust_svc { + 'exportnum' => $self->exportnum, + 'svcnum' => $svc_x->svcnum, + 'remoteid' => $value + }; + $error = $export_cust_svc->insert; + } + } else { + if ($export_cust_svc) { + $error = $export_cust_svc->delete; + } #otherwise, it already doesn't exist + } + + if ($oldAutoCommit) { + $dbh->rollback if $error; + $dbh->commit unless $error; + } + + return $error; +} + +=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). + +=item actions + +Adds one or more "action" links to the export's display in +browse/part_export.cgi. Should return pairs of values. The first is +the link label; the second is the Mason path to a document to load. +The document will show in a popup. + +=cut + +sub actions { } + +=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} } + }; +} + +=item get_dids SELECTION + +Does several things, which is unfortunate. DID phone numbers are organized +in a sort-of hierarchy: state, areacode, exchange, number. Or, for some +vendors: state, region, number. But not always that, either. + +SELECTION is one or more field/value pairs specifying parts of the hierarchy +that have already been selected. C will then return an arrayref of +the possible values for the next selection level. Note that these are not +actual DIDs except at the lowest level. + +Generally, 'state' alone will return an array of area codes or region names +in the state. + +'state' and 'areacode' together will return an array of either: +- exchange strings of the form "New York (212-555-XXXX)" +- ratecenter names of the form "New York, NY" + +These strings are sent back to the UI and offered as options so that the user +can choose the local calling area they like. + +'areacode' and 'exchange', or 'state' and 'ratecenter', or 'region' by itself +will return an array of actual DID numbers. + +Passing 'tollfree' with a true value will override the whole hierarchy and +return an array of tollfree numbers. + +C methods should report errors via die(). + +=cut + +# no stub; can('get_dids') should return false by default + +#default fallbacks... FS::part_export::DID_Common ? +sub can_get_dids { 0; } +sub get_dids_can_tollfree { 0; } +sub get_dids_can_manual { 0; } +sub get_dids_can_edit { 0; } #don't use without can_manual, otherwise the + # DID selector provisions a new number from + # inventory each edit +sub get_dids_npa_select { 1; } + +# get_dids_npa_select: if true, then prompt to select state, then area code, +# then city/exchange, then phone number. +# if false, then prompt to select state (actually province), then "region", +# then phone number. +# +# get_dids_can_manual: if true, then there will be a radio button to enter +# a phone number manually. +# +# get_dids_can_tollfree: if true, then the user will be prompted to choose +# both a regular and a toll-free number. The export can have a +# 'restrict_selection' option to enable only one or the other of those. See +# part_export/vitelity.pm for an example. +# +# get_dids_can_edit: if true, then the user can use the selector again to +# change the phone number for a service. if false, then they can't (have to +# reprovision completely). + +=item svc_role SVC + +Returns the role that SVC occupies with respect to this export, if any. +This is part of the part_svc's export configuration. + +=cut + +sub svc_role { + my $self = shift; + my $svc_x = shift; + my $cust_svc = $svc_x->cust_svc or return ''; + my $export_svc = qsearchs('export_svc', { exportnum => $self->exportnum, + svcpart => $cust_svc->svcpart }) + or return ''; + $export_svc->role; +} + +=item svc_with_role { SVC | PKGNUM }, ROLE + +Given a svc_* object SVC or pkgnum PKG, and a role name ROLE, finds the +service(s) in the same package that are linked to this export with ROLE. + +=cut + +sub svc_with_role { + my $self = shift; + my $svc_or_pkgnum = shift; + my $role = shift; + my $pkgnum; + if ( ref $svc_or_pkgnum ) { + $pkgnum = $svc_or_pkgnum->cust_svc->pkgnum or return ''; + } else { + $pkgnum = $svc_or_pkgnum; + } + my $role_info = $self->info->{roles}->{$role} + or die "role '$role' does not exist for export '".$self->exporttype."'\n"; + my $svcdb = $role_info->{svcdb}; + + my @svcs = qsearch({ + 'table' => $svcdb, + 'addl_from' => ' JOIN cust_svc USING (svcnum)' . + ' JOIN export_svc USING (svcpart)', + 'extra_sql' => " WHERE cust_svc.pkgnum = $pkgnum" . + " AND export_svc.exportnum = ".$self->exportnum . + " AND export_svc.role = '$role'", + }); + if ( $role_info->{multiple} ) { + return @svcs; + } else { + if ( @svcs > 1 ) { + warn "multiple $role services in pkgnum $pkgnum; returning the first one.\n"; + } + return $svcs[0]; + } +} + =back =head1 SUBROUTINES @@ -453,181 +945,151 @@ on the export: sub export_info { #warn $_[0]; - return $exports{$_[0]} if @_; + return $exports{$_[0]} || {} if @_; #{ map { %{$exports{$_}} } keys %exports }; my $r = { map { %{$exports{$_}} } keys %exports }; } -=item exporttype2svcdb EXPORTTYPE -Returns the applicable I for an I. +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; + } + # for exports that have selectable hostnames, make sure all services + # have a hostname selected + foreach my $part_export ( + qsearch('part_export', { 'machine' => '_SVC_MACHINE' }) + ) { -=cut + my $exportnum = $part_export->exportnum; + my $machinenum = $part_export->default_machine; + if (!$machinenum) { + my ($first) = $part_export->part_export_machine; + if (!$first) { + # user intervention really is required. + die "Export $exportnum has no hostname options defined.\n". + "You must correct this before upgrading.\n"; + } + # warn about this, because we might not choose the right one + warn "Export $exportnum (". $part_export->exporttype. + ") has no default hostname. Setting to ".$first->machine."\n"; + $machinenum = $first->machinenum; + $part_export->set('default_machine', $machinenum); + my $error = $part_export->replace; + die $error if $error; + } -sub exporttype2svcdb { - my $exporttype = $_[0]; - foreach my $svcdb ( keys %exports ) { - return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}}; + # the service belongs to a service def that uses this export + # and there is not a hostname selected for this export for that service + my $join = ' JOIN export_svc USING ( svcpart )'. + ' LEFT JOIN svc_export_machine'. + ' ON ( cust_svc.svcnum = svc_export_machine.svcnum'. + ' AND export_svc.exportnum = svc_export_machine.exportnum )'; + + my @svcs = qsearch( { + 'select' => 'cust_svc.*', + 'table' => 'cust_svc', + 'addl_from' => $join, + 'extra_sql' => ' WHERE svcexportmachinenum IS NULL'. + ' AND export_svc.exportnum = '.$part_export->exportnum, + } ); + foreach my $cust_svc (@svcs) { + my $svc_export_machine = FS::svc_export_machine->new({ + 'exportnum' => $exportnum, + 'machinenum' => $machinenum, + 'svcnum' => $cust_svc->svcnum, + }); + my $error = $svc_export_machine->insert; + 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'); } - ''; } -#export names cannot have dashes... -%exports = ( - 'svc_acct' => { - 'sysvshell' => { - 'desc' => - 'Batch export of /etc/passwd and /etc/shadow files (Linux/SysV)', - 'options' => {}, - }, - 'bsdshell' => { - 'desc' => - 'Batch export of /etc/passwd and /etc/master.passwd files (BSD)', - 'options' => {}, - }, -# 'nis' => { -# 'desc' => -# 'Batch export of /etc/global/passwd and /etc/global/shadow for NIS ', -# 'options' => {}, -# }, - 'textradius' => { - 'desc' => 'Batch export of a text /etc/raddb/users file (Livingston, Cistron)', - }, - - 'shellcommands' => { - 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', - 'options' => { - #'machine' => { label=>'Remote machine' }, - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'useradd -d $dir -m -s $shell -u $uid $username' - #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir' - }, - 'userdel' => { label=>'Delete command', - default=>'userdel $username', - #default=>'rm -rf $dir', - }, - 'usermod' => { label=>'Modify command', - default=>'usermod -d $new_dir -l $new_username -s $new_shell -u $new_uid $old_username', - #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '. - # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. - # 'find . -depth -print | cpio -pdm $new_dir; '. - # 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '. - # 'rm -rf $old_dir'. - #')' - }, - }, - 'nodomain' => 'Y', - 'notes' => 'shellcommandsnotes... (this one is the nodomain one)', - }, - - 'sqlradius' => { - 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)', - 'options' => { - 'datasrc' => { label=>'DBI data source' }, - 'username' => { label=>'Database username' }, - 'password' => { label=>'Database password' }, - }, - 'nodomain' => 'Y', - 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. Use freeside-sqlradius-reset to delete and repopulate the tables from the Freeside database.', - }, - - 'cyrus' => { - 'desc' => 'Real-time export to Cyrus IMAP server', - 'options' => { - 'server' => { label=>'IMAP server' }, - 'username' => { label=>'Admin username' }, - 'password' => { label=>'Admin password' }, - }, - 'nodomain' => 'Y', - 'notes' => 'Integration with Cyrus IMAP Server. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured. svc_acct.quota, if available, is used to set the Cyrus quota. ' - }, - - 'cp' => { - 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol', - 'options' => { - 'host' => { label=>'Hostname' }, - 'port' => { label=>'Port number' }, - 'username' => { label=>'Username' }, - 'password' => { label=>'Password' }, - 'domain' => { label=>'Domain' }, - 'workgroup' => { label=>'Default Workgroup' }, - }, - 'notes' => 'Real-time export to Critial Path Account Provisioning Protocol. Requires installation of Net::APP from CPAN.', - }, - - 'infostreet' => { - 'desc' => 'Real-time export to InfoStreet streetSmartAPI', - 'options' => { - 'url' => { label=>'XML-RPC Access URL', }, - 'login' => { label=>'InfoStreet login', }, - 'password' => { label=>'InfoStreet password', }, - 'groupID' => { label=>'InfoStreet groupID', }, - }, - 'nodomain' => 'Y', - 'notes' => 'Real-time export to InfoStreet streetSmartAPI. Requires installation of Frontier::Client from CPAN.', - }, - - 'vpopmail' => { - 'desc' => 'Real-time export to vpopmail text files', - 'options' => { - 'machine' => { label=>'vpopmail machine', }, - 'dir' => { label=>'directory', }, # ?more info? default? - 'uid' => { label=>'vpopmail uid' }, - 'gid' => { label=>'vpopmail gid' }, - }, - 'notes' => 'Real time export to vpopmail text files (...extended description from jeff?...)', - }, - - }, - - 'svc_domain' => { - - 'bind' => { - 'desc' =>'Batch export to BIND named', - 'options' => { - #'machine' => { label=>'named machine' }, - 'named_conf' => { label => 'named.conf location', - default=> '/etc/bind/named.conf' }, - 'zonepath' => { label => 'path to zone files', - default=> '/etc/bind/', }, - }, - 'notes' => 'bind export notes', - }, - - 'bind_slave' => { - 'desc' =>'Batch export to slave BIND named', - 'options' => { - #'machine' => { label=> 'Slave machine' }, - 'master' => { label=> 'Master IP address' }, - 'named_conf' => { label => 'named.conf location', - default=> '/etc/bind/named.conf' }, - }, - 'notes' => 'bind export notes (secondary munge)', - }, - - - }, - - 'svc_acct_sm' => {}, - - 'svc_forward' => {}, - - 'svc_www' => {}, - -); +#=item exporttype2svcdb EXPORTTYPE +# +#Returns the applicable I for an I. +# +#=cut +# +#sub exporttype2svcdb { +# my $exporttype = $_[0]; +# foreach my $svcdb ( keys %exports ) { +# return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}}; +# } +# ''; +#} + +#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; + $file =~ /\/(\w+)\.pm$/ or do { + warn "unrecognized file in $INC/FS/part_export/: $file\n"; + next; + }; + my $mod = $1; + my $info = eval "use FS::part_export::$mod; ". + "\\%FS::part_export::$mod\::info;"; + if ( $@ ) { + die "error using FS::part_export::$mod (skipping): $@\n" if $@; + next; + } + unless ( keys %$info ) { + warn "no %info hash found in FS::part_export::$mod, skipping\n" + unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck + next; + } + warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG; + no strict 'refs'; + foreach my $svc ( + ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'} + ) { + unless ( $svc ) { + warn "blank svc for FS::part_export::$mod (skipping)\n"; + next; + } + $exports{$svc}->{$mod} = $info; + } + } +} =back =head1 NEW EXPORT CLASSES -Should be added to the %export hash here, and a module should be added in -FS/FS/part_export/ (an example may be found in eg/export_template.pm) +A module should be added in FS/FS/part_export/ (an example may be found in +eg/export_template.pm) =head1 BUGS -Probably. - Hmm... cust_export class (not necessarily a database table...) ... ? deprecated column...