X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_export.pm;h=1a8f43de10097174ba511ece6f4ad7bdc0b0e488;hb=bb7e827141c9ed68f30765c9ca2ddcd1d760ad2d;hp=3f184be070c4cb65f926e8c2f7d5c9082d3f8221;hpb=b159f42fa3f48cc2ca3b43773e7661e17d2fb072;p=freeside.git diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 3f184be07..1a8f43de1 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -1,12 +1,23 @@ package FS::part_export; +use base qw( FS::option_Common FS::m2m_Common ); use strict; -use vars qw( @ISA ); +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::part_export_machine; +use FS::svc_export_machine; +use FS::export_cust_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; =head1 NAME @@ -19,7 +30,7 @@ FS::part_export - Object methods for part_export records $record = new FS::part_export \%hash; $record = new FS::part_export { 'column' => 'value' }; - ($new_record, $options) = $template_recored->clone( $svcpart ); + #($new_record, $options) = $template_recored->clone( $svcpart ); $error = $record->insert( { 'option' => 'value' } ); $error = $record->insert( \%options ); @@ -40,7 +51,7 @@ fields are currently supported: =item exportnum - primary key -=item svcpart - Service definition (see L) to which this export applies +=item exportname - Descriptive name =item machine - Machine name @@ -48,6 +59,12 @@ fields are currently supported: =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 @@ -67,27 +84,29 @@ points to. You can ask the object for a copy with the I method. sub table { 'part_export'; } -=item clone SVCPART - -An alternate constructor. Creates a new export by duplicating an existing -export. The given svcpart is assigned to the new export. - -Returns a list consisting of the new export object and a hashref of options. - =cut -sub clone { - my $self = shift; - my $class = ref($self); - my %hash = $self->hash; - $hash{'exportnum'} = ''; - $hash{'svcpart'} = shift; - ( $class->new( \%hash ), - { map { $_->optionname => $_->optionvalue } - qsearch('part_export_option', { 'exportnum' => $self->exportnum } ) - } - ); -} +#=item clone SVCPART +# +#An alternate constructor. Creates a new export by duplicating an existing +#export. The given svcpart is assigned to the new export. +# +#Returns a list consisting of the new export object and a hashref of options. +# +#=cut +# +#sub clone { +# my $self = shift; +# my $class = ref($self); +# my %hash = $self->hash; +# $hash{'exportnum'} = ''; +# $hash{'svcpart'} = shift; +# ( $class->new( \%hash ), +# { map { $_->optionname => $_->optionvalue } +# qsearch('part_export_option', { 'exportnum' => $self->exportnum } ) +# } +# ); +#} =item insert HASHREF @@ -99,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 @@ -148,51 +152,77 @@ 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; } } - $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 +=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'; @@ -203,47 +233,112 @@ sub replace { my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; + my $error; - my $error = $self->SUPER::replace($old); - 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; + } + } + + 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 ); + } + } - 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; } - } - #remove extraneous old options - foreach my $opt ( - grep { !exists $options->{$_->optionname} } $old->part_export_option - ) { - my $error = $opt->delete; + 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; + } + } + + 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 @@ -257,38 +352,129 @@ sub check { my $self = shift; my $error = $self->ut_numbern('exportnum') - || $self->ut_domain('machine') - || $self->ut_number('svcpart') + || $self->ut_textn('exportname') + || $self->ut_domainn('machine') || $self->ut_alpha('exporttype') + || $self->ut_flag('no_suspend') ; - return $error if $error; - return "Unknown svcpart: ". $self->svcpart - unless qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); + 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); + $self->deprecated(1); #BLAH + #check exporttype? - ''; #no error + $self->SUPER::check; } -=item part_svc +=item label -Returns the service definition (see L) for this export. +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. +# +#=cut +# +#sub part_svc { +# my $self = shift; +# qsearchs('part_svc', { svcpart => $self->svcpart } ); +#} + sub part_svc { + use Carp; + croak "FS::part_export::part_svc deprecated"; + #confess "FS::part_export::part_svc deprecated"; +} + +=item svc_x + +Returns a list of associated FS::svc_* records. + +=cut + +sub svc_x { my $self = shift; - qsearchs('part_svc', { svcpart => $self->svcpart } ); + map { $_->svc_x } $self->cust_svc; } +=item cust_svc + +Returns a list of associated FS::cust_svc records. + +=cut + +sub cust_svc { + my $self = shift; + map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + $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. + +=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 @@ -298,59 +484,89 @@ 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. +=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, but until then, see L. + =cut -sub options { +sub _rebless { my $self = shift; - map { $_->optionname => $_->optionvalue } $self->part_export_option; + my $exporttype = $self->exporttype; + my $class = ref($self). "::$exporttype"; + eval "use $class;"; + #die $@ if $@; + bless($self, $class) unless $@; + $self; } -=item option OPTIONNAME +=item svc_machine SVC_X -Returns the option value for the given name, or the empty string. +Return the export hostname for SVC_X. =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 : ''; +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 rebless +=item default_export_machine -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. +Return the default export hostname for this export. =cut -sub rebless { +sub default_export_machine { my $self = shift; - my $exporttype = $self->exporttype; - my $class = ref($self); - bless($self, $class."::$exporttype"); + 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(@_); } @@ -367,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(@_); } @@ -377,281 +599,505 @@ 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(@_); } -=back +=item export_suspend =cut -#infostreet +# Do not overload! Overload _export_suspend instead -package FS::part_export::infostreet; -use vars qw(@ISA); -@ISA = qw(FS::part_export); +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, $svc_acct ) = (shift, shift); - $self->infostreet_queue( $svc_acct->svcnum, - 'createUser', $svc_acct->username, $svc_acct->password ); + my $self = shift; + return "_export_insert: unknown export type ". $self->exporttype; } sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't change username with InfoStreet" - if $old->username ne $new->username; - return '' unless $old->_password ne $new->_password; - $self->infostreet_queue( $new->svcnum, - 'passwd', $new->username, $new->password ); + my $self = shift; + return "_export_replace: unknown export type ". $self->exporttype; } sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->infostreet_queue( $svc_acct->svcnum, - 'purgeAccount,releaseUsername', $svc_acct->username ); + my $self = shift; + return "_export_delete: unknown export type ". $self->exporttype; } -sub infostreet_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => 'FS::part_export::infostreet::infostreet_command', - }; - $queue->insert( - $self->option('url'), - $self->option('login'), - $self->option('password'), - $self->option('groupID'), - $method, - @_, - ); -} - -sub infostreet_command { #subroutine, not method - my($url, $username, $password, $groupID, $method, @args) = @_; - - #quelle hack - if ( $method =~ /,/ ) { - foreach my $part ( split(/,\s*/, $method) ) { - infostreet_command($url, $username, $password, $groupID, $part, @args); - } - return; - } +#call svcdb-specific fallbacks - eval "use Frontier::Client;"; +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 ); +} - my $conn = Frontier::Client->new( url => $url ); - my $key_result = $conn->call( 'authenticate', $username, $password, $groupID); - my %key_result = _infostreet_parse($key_result); - die $key_result{error} unless $key_result{success}; - my $key = $key_result{data}; +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 ); +} - my $result = $conn->call($method, $key, @args); - my %result = _infostreet_parse($result); - die $result{error} unless $result{success}; +=item get_remoteid SVC -} +Returns the remote id for this export for the given service. -sub _infostreet_parse { #subroutine, not method - my $arg = shift; - map { - my $value = $arg->{$_}; - #warn ref($value); - $value = $value->value() - if ref($value) && $value->isa('Frontier::RPC2::DataType'); - $_=>$value; - } keys %$arg; -} +=cut -#sqlradius +sub get_remoteid { + my ($self, $svc_x) = @_; -package FS::part_export::sqlradius; -use vars qw(@ISA); -@ISA = qw(FS::part_export); + my $export_cust_svc = qsearchs('export_cust_svc',{ + 'exportnum' => $self->exportnum, + 'svcnum' => $svc_x->svcnum + }); -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - $self->sqlradius_queue( $svc_acct->svcnum, 'insert', - 'reply', $svc_acct->username, $svc_acct->radius_reply ); - $self->sqlradius_queue( $svc_acct->svcnum, 'insert', - 'check', $svc_acct->username, $svc_acct->radius_check ); + return $export_cust_svc ? $export_cust_svc->remoteid : ''; } -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - #return "can't (yet) change username with sqlradius" - # if $old->username ne $new->username; - if ( $old->username ne $new->username ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'rename', - $new->username, $old->username ); - return $error if $error; - } +=item set_remoteid SVC VALUE - foreach my $table (qw(reply check)) { - my $method = "radius_$table"; - my %new = $new->$method; - my %old = $old->$method; - if ( grep { !exists $old{$_} #new attributes - || $new{$_} ne $old{$_} #changed - } keys %new - ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'insert', - $table, $new->username, %new ); - return $error if $error; +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 + } - my @del = grep { !exists $new{$_} } keys %old; - my $error = $self->sqlradius_queue( $new->svcnum, 'sqlradius_attrib_delete', - $table, $new->username, @del ); - return $error if $error; + if ($oldAutoCommit) { + $dbh->rollback if $error; + $dbh->commit unless $error; } - ''; + return $error; } -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->sqlradius_queue( $svc_acct->svcnum, 'delete', - $svc_acct->username ); +=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; } -sub sqlradius_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::sqlradius::sqlradius_$method", +=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} } }; - $queue->insert( - $self->option('datasrc'), - $self->option('username'), - $self->option('password'), - @_, - ); -} - -sub sqlradius_insert { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $replycheck, $username, %attributes ) = @_; - - foreach my $attribute ( keys %attributes ) { - my $u_sth = $dbh->prepare( - "UPDATE rad$replycheck SET Value = ? WHERE UserName = ? AND Attribute = ?" ) or die $dbh->errstr; - my $i_sth = $dbh->prepare( - "INSERT INTO rad$replycheck ( id, UserName, Attribute, Value ) ". - "VALUES ( ?, ?, ?, ? )" ) - or die $dbh->errstr; - $u_sth->execute($attributes{$attribute}, $username, $attribute) > 0 - or $i_sth->execute( '', $username, $attribute, $attributes{$attribute} ) - or die "can't insert into rad$replycheck table: ". $i_sth->errstr; - } - $dbh->disconnect; } -sub sqlradius_rename { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my($new_username, $old_username) = @_; - foreach my $table (qw(radreply radcheck)) { - my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?") - or die $dbh->errstr; - $sth->execute($new_username, $old_username) - or die "can't update $table: ". $sth->errstr; - } - $dbh->disconnect; -} +=item get_dids SELECTION -sub sqlradius_attrib_delete { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $replycheck, $username, @attrib ) = @_; +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. - foreach my $attribute ( @attrib ) { - my $sth = $dbh->prepare( - "DELETE FROM rad$replycheck WHERE UserName = ? AND Attribute = ?" ) - or die $dbh->errstr; - $sth->execute($username,$attribute) - or die "can't delete from rad$replycheck table: ". $sth->errstr; - } - $dbh->disconnect; -} +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" -sub sqlradius_delete { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my $username = shift; +These strings are sent back to the UI and offered as options so that the user +can choose the local calling area they like. - foreach my $table (qw( radcheck radreply )) { - my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" ); - $sth->execute($username) - or die "can't delete from $table table: ". $sth->errstr; +'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]; } - $dbh->disconnect; } -sub sqlradius_connect { - #my($datasrc, $username, $password) = @_; - #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; - DBI->connect(@_) or die $DBI::errstr; +=back + +=head1 SUBROUTINES + +=over 4 + +=item export_info [ SVCDB ] + +Returns a hash reference of the exports for the given I, or if no +I is specified, for all exports. The keys of the hash are +Is and the values are again hash references containing information +on the export: + + 'desc' => 'Description', + 'options' => { + 'option' => { label=>'Option Label' }, + 'option2' => { label=>'Another label' }, + }, + 'nodomain' => 'Y', #or '' + 'notes' => 'Additional notes', + +=cut + +sub export_info { + #warn $_[0]; + return $exports{$_[0]} || {} if @_; + #{ map { %{$exports{$_}} } keys %exports }; + my $r = { map { %{$exports{$_}} } keys %exports }; } -=head1 NEW EXPORT CLASSES - #myexport - - package FS::part_export::myexport; - use vars qw(@ISA); - @ISA = qw(FS::part_export); - - sub _export_insert { - my($self, $svc_something) = (shift, shift); - $self->myexport_queue( $svc_acct->svcnum, 'insert', - $svc_something->username, $svc_something->password ); +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; } - - sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - #return "can't change username with myexport" - # if $old->username ne $new->username; - #return '' unless $old->_password ne $new->_password; - $self->myexport_queue( $new->svcnum, - 'replace', $new->username, $new->password ); + # for exports that have selectable hostnames, make sure all services + # have a hostname selected + foreach my $part_export ( + qsearch('part_export', { 'machine' => '_SVC_MACHINE' }) + ) { + + 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; + } + + # 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; + } } - - sub _export_delete { - my( $self, $svc_something ) = (shift, shift); - $self->myexport_queue( $svc_acct->svcnum, - 'delete', $svc_something->username ); + + # 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'); } - - #a good idea to queue anything that could fail or take any time - sub myexport_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::myexport::myexport_$method", +} + +#=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; }; - $queue->insert( @_ ); - } - - sub myexport_insert { #subroutine, not method - } - sub myexport_replace { #subroutine, not method - } - sub myexport_delete { #subroutine, not method + 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 + +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...) ... ? -Hmm, export code has wound up in here. Move those sub-classes out into their -own files, at least. Also hmm... cust_export class (not necessarily a -database table...) ... ? +deprecated column... =head1 SEE ALSO -L, L, L, L, +L, L, L, +L, L, L, schema.html from the base documentation. =cut