X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fpart_export.pm;h=572a1b684aa6d407b503f2949162c08e2d2424cc;hp=f1a0b1a2eea4e50200dd721fbb1b88499cfb3dc1;hb=ff27c3f36240aee48ed50153dd5d8fe3ac3f2443;hpb=927ed7458ff7536ec321e8d214ed8adfbd12193f diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index f1a0b1a2e..572a1b684 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -1,17 +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 @@ -44,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 @@ -103,44 +118,29 @@ 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 @@ -152,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; @@ -186,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'; @@ -215,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 @@ -269,14 +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; - $self->machine =~ /^([\w\-\.]*)$/ - or return "Illegal machine: ". $self->machine; - $self->machine($1); + if ( $self->machine eq '_SVC_MACHINE' ) { + $error ||= $self->ut_numbern('default_machine') + } else { + $self->set('default_machine', ''); + } + + return $error if $error; $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain; $self->nodomain($1); @@ -285,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 @@ -329,17 +453,28 @@ sub cust_svc { $self->export_svc; } -=item export_svc +=item part_export_machine -Returns a list of associated FS::export_svc records. +Returns all machines as FS::part_export_machine objects (see +L). =cut -sub export_svc { +sub part_export_machine { my $self = shift; - qsearch('export_svc', { 'exportnum' => $self->exportnum } ); + 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 @@ -349,61 +484,85 @@ 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). "::$exporttype"; - eval "use $class;"; - die $@ if $@; - bless($self, $class); + 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; } +#these should probably all go away, just let the subclasses define em + =item export_insert SVC_OBJECT =cut sub export_insert { my $self = shift; - $self->rebless; + #$self->rebless; $self->_export_insert(@_); } @@ -422,7 +581,7 @@ sub export_insert { sub export_replace { my $self = shift; - $self->rebless; + #$self->rebless; $self->_export_replace(@_); } @@ -432,7 +591,7 @@ sub export_replace { sub export_delete { my $self = shift; - $self->rebless; + #$self->rebless; $self->_export_delete(@_); } @@ -442,7 +601,7 @@ sub export_delete { sub export_suspend { my $self = shift; - $self->rebless; + #$self->rebless; $self->_export_suspend(@_); } @@ -452,7 +611,7 @@ sub export_suspend { sub export_unsuspend { my $self = shift; - $self->rebless; + #$self->rebless; $self->_export_unsuspend(@_); } @@ -472,18 +631,265 @@ sub _export_delete { return "_export_delete: unknown export type ". $self->exporttype; } -#fallbacks providing null operations +#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 @@ -511,11 +917,94 @@ 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 }; } + +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' }) + ) { + + 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; + } + } + + # 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. @@ -530,492 +1019,49 @@ sub export_info { # ''; #} -tie my %sysvshell_options, 'Tie::IxHash', - 'crypt' => { label=>'Password encryption', - type=>'select', options=>[qw(crypt md5)], - default=>'crypt', - }, -; - -tie my %bsdshell_options, 'Tie::IxHash', - 'crypt' => { label=>'Password encryption', - type=>'select', options=>[qw(crypt md5)], - default=>'crypt', - }, -; - -tie my %shellcommands_options, 'Tie::IxHash', - #'machine' => { label=>'Remote machine' }, - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username' - #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir' - }, - 'useradd_stdin' => { label=>'Insert command STDIN', - type =>'textarea', - default=>'', - }, - 'userdel' => { label=>'Delete command', - default=>'userdel -r $username', - #default=>'rm -rf $dir', - }, - 'userdel_stdin' => { label=>'Delete command STDIN', - type =>'textarea', - default=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $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'. - #')' - }, - 'usermod_stdin' => { label=>'Modify command STDIN', - type =>'textarea', - default=>'', - }, - 'usermod_pwonly' => { label=>'Disallow username changes', - type =>'checkbox', - }, - 'suspend' => { label=>'Suspension command', - default=>'', - }, - 'suspend_stdin' => { label=>'Suspension command STDIN', - default=>'', - }, - 'unsuspend' => { label=>'Unsuspension command', - default=>'', - }, - 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', - default=>'', - }, -; - -tie my %shellcommands_withdomain_options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - #default=>'' - }, - 'useradd_stdin' => { label=>'Insert command STDIN', - type =>'textarea', - #default=>"$_password\n$_password\n", - }, - 'userdel' => { label=>'Delete command', - #default=>'', - }, - 'userdel_stdin' => { label=>'Delete command STDIN', - type =>'textarea', - #default=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'', - }, - 'usermod_stdin' => { label=>'Modify command STDIN', - type =>'textarea', - #default=>"$_password\n$_password\n", - }, - 'usermod_pwonly' => { label=>'Disallow username changes', - type =>'checkbox', - }, - 'suspend' => { label=>'Suspension command', - default=>'', - }, - 'suspend_stdin' => { label=>'Suspension command STDIN', - default=>'', - }, - 'unsuspend' => { label=>'Unsuspension command', - default=>'', - }, - 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', - default=>'', - }, -; - -tie my %www_shellcommands_options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'mkdir /var/www/$zone; chown $username /var/www/$zone; ln -s /var/www/$zone $homedir/$zone', - }, - 'userdel' => { label=>'Delete command', - default=>'[ -n "$zone" ] && rm -rf /var/www/$zone; rm $homedir/$zone', - }, - 'usermod' => { label=>'Modify command', - default=>'[ -n "$old_zone" ] && rm $old_homedir/$old_zone; [ "$old_zone" != "$new_zone" -a -n "$new_zone" ] && mv /var/www/$old_zone /var/www/$new_zone; [ "$old_username" != "$new_username" ] && chown -R $new_username /var/www/$new_zone; ln -s /var/www/$new_zone $new_homedir/$new_zone', - }, -; - -tie my %apache_options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'httpd_conf' => { label=>'httpd.conf snippet location', - default=>'/etc/apache/httpd-freeside.conf', }, - 'template' => { - label => 'Template', - type => 'textarea', - default => <<'END', - #generic -# #preferred, http://httpd.apache.org/docs/dns-caveats.html -DocumentRoot /var/www/$zone -ServerName $zone -ServerAlias *.$zone -#BandWidthModule On -#LargeFileLimit 4096 12288 - - -END - }, -; - -tie my %domain_shellcommands_options, 'Tie::IxHash', - 'user' => { lable=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'', - }, - 'userdel' => { label=>'Delete command', - default=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'', - }, -; - -tie my %textradius_options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'users' => { label=>'users file location', default=>'/etc/raddb/users' }, -; - -tie my %sqlradius_options, 'Tie::IxHash', - 'datasrc' => { label=>'DBI data source ' }, - 'username' => { label=>'Database username' }, - 'password' => { label=>'Database password' }, -; - -tie my %cyrus_options, 'Tie::IxHash', - 'server' => { label=>'IMAP server' }, - 'username' => { label=>'Admin username' }, - 'password' => { label=>'Admin password' }, -; - -tie my %cp_options, 'Tie::IxHash', - 'port' => { label=>'Port number' }, - 'username' => { label=>'Username' }, - 'password' => { label=>'Password' }, - 'domain' => { label=>'Domain' }, - 'workgroup' => { label=>'Default Workgroup' }, -; - -tie my %infostreet_options, 'Tie::IxHash', - 'url' => { label=>'XML-RPC Access URL', }, - 'login' => { label=>'InfoStreet login', }, - 'password' => { label=>'InfoStreet password', }, - 'groupID' => { label=>'InfoStreet groupID', }, -; - -tie my %vpopmail_options, 'Tie::IxHash', - #'machine' => { label=>'vpopmail machine', }, - 'dir' => { label=>'directory', }, # ?more info? default? - 'uid' => { label=>'vpopmail uid' }, - 'gid' => { label=>'vpopmail gid' }, - 'restart' => { label=> 'vpopmail restart command', - default=> 'cd /home/vpopmail/domains; for domain in *; do /home/vpopmail/bin/vmkpasswd $domain; done; /var/qmail/bin/qmail-newu; killall -HUP qmail-send', - }, -; - -tie my %bind_options, 'Tie::IxHash', - #'machine' => { label=>'named machine' }, - 'named_conf' => { label => 'named.conf location', - default=> '/etc/bind/named.conf' }, - 'zonepath' => { label => 'path to zone files', - default=> '/etc/bind/', }, - 'bind_release' => { label => 'ISC BIND Release', - type => 'select', - options => [qw(BIND8 BIND9)], - default => 'BIND8' }, - 'bind9_minttl' => { label => 'The minttl required by bind9 and RFC1035.', - default => '1D' }, -; - -tie my %bind_slave_options, 'Tie::IxHash', - #'machine' => { label=> 'Slave machine' }, - 'master' => { label=> 'Master IP address(s) (semicolon-separated)' }, - 'named_conf' => { label => 'named.conf location', - default => '/etc/bind/named.conf' }, - 'bind_release' => { label => 'ISC BIND Release', - type => 'select', - options => [qw(BIND8 BIND9)], - default => 'BIND8' }, - 'bind9_minttl' => { label => 'The minttl required by bind9 and RFC1035.', - default => '1D' }, -; - -tie my %http_options, 'Tie::IxHash', - 'method' => { label =>'Method', - type =>'select', - #options =>[qw(POST GET)], - options =>[qw(POST)], - default =>'POST' }, - 'url' => { label => 'URL', default => 'http://', }, - 'insert_data' => { - label => 'Insert data', - type => 'textarea', - default => join("\n", - 'DomainName $svc_x->domain', - 'Email ( grep { $_ ne "POST" } $svc_x->cust_svc->cust_pkg->cust_main->invoicing_list)[0]', - 'test 1', - 'reseller $svc_x->cust_svc->cust_pkg->part_pkg->pkg =~ /reseller/i', - ), - }, - 'delete_data' => { - label => 'Delete data', - type => 'textarea', - default => join("\n", - ), - }, - 'replace_data' => { - label => 'Replace data', - type => 'textarea', - default => join("\n", - ), - }, -; - -tie my %sqlmail_options, 'Tie::IxHash', - 'datasrc' => { label => 'DBI data source' }, - 'username' => { label => 'Database username' }, - 'password' => { label => 'Database password' }, - 'server_type' => { - label => 'Server type', - type => 'select', - options => [qw(dovecot_plain dovecot_crypt dovecot_digest_md5 courier_plain - courier_crypt)], - default => ['dovecot_plain'], }, - 'svc_acct_table' => { label => 'User Table', default => 'user_acct' }, - 'svc_forward_table' => { label => 'Forward Table', default => 'forward' }, - 'svc_domain_table' => { label => 'Domain Table', default => 'domain' }, - 'svc_acct_fields' => { label => 'svc_acct Export Fields', - default => 'username _password domsvc svcnum' }, - 'svc_forward_fields' => { label => 'svc_forward Export Fields', - default => 'domain svcnum catchall' }, - 'svc_domain_fields' => { label => 'svc_domain Export Fields', - default => 'srcsvc dstsvc dst' }, - 'resolve_dstsvc' => { label => q{Resolve svc_forward.dstsvc to an email address and store it in dst. (Doesn't require that you also export dstsvc.)}, - type => 'checkbox' }, - -; - -tie my %ldap_options, 'Tie::IxHash', - 'dn' => { label=>'Root DN' }, - 'password' => { label=>'Root DN password' }, - 'userdn' => { label=>'User DN' }, - 'attributes' => { label=>'Attributes', - type=>'textarea', - default=>join("\n", - 'uid $username', - 'mail $username\@$domain', - 'uidno $uid', - 'gidno $gid', - 'cn $first', - 'sn $last', - 'mailquota $quota', - 'vmail', - 'location', - 'mailtag', - 'mailhost', - 'mailmessagestore $dir', - 'userpassword $crypt_password', - 'hint', - 'answer $sec_phrase', - 'objectclass top,person,inetOrgPerson', - ), - }, - 'radius' => { label=>'Export RADIUS attributes', type=>'checkbox', }, -; - -tie my %forward_shellcommands_options, 'Tie::IxHash', - 'user' => { lable=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'', - }, - 'userdel' => { label=>'Delete command', - default=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'', - }, -; - -#export names cannot have dashes... -%exports = ( - 'svc_acct' => { - 'sysvshell' => { - 'desc' => - 'Batch export of /etc/passwd and /etc/shadow files (Linux/SysV).', - 'options' => \%sysvshell_options, - 'nodomain' => 'Y', - 'notes' => 'MD5 crypt requires installation of Crypt::PasswdMD5 from CPAN. Run bin/sysvshell.export to export the files.', - }, - 'bsdshell' => { - 'desc' => - 'Batch export of /etc/passwd and /etc/master.passwd files (BSD).', - 'options' => \%bsdshell_options, - 'nodomain' => 'Y', - 'notes' => 'MD5 crypt requires installation of Crypt::PasswdMD5 from CPAN. Run bin/bsdshell.export to export the files.', - }, -# 'nis' => { -# 'desc' => -# 'Batch export of /etc/global/passwd and /etc/global/shadow for NIS ', -# 'options' => {}, -# }, - 'textradius' => { - 'desc' => 'Real-time export to a text /etc/raddb/users file (Livingston, Cistron)', - 'options' => \%textradius_options, - 'notes' => 'This will edit a text RADIUS users file in place on a remote server. Requires installation of RADIUS::UserFile from CPAN. If using RADIUS::UserFile 1.01, make sure to apply this patch. Also make sure rsync is installed on the remote machine, and SSH is setup for unattended operation.', - }, - - 'shellcommands' => { - 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', - 'options' => \%shellcommands_options, - 'nodomain' => 'Y', - 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $username
  • $_password
  • $quoted_password - unencrypted password quoted for the shell
  • $crypt_password - encrypted password
  • $uid
  • $gid
  • $finger - GECOS, already quoted for the shell (do not add additional quotes)
  • $dir - home directory
  • $shell
  • $quota
  • All other fields in svc_acct are also available.
', - }, - - 'shellcommands_withdomain' => { - 'desc' => 'Real-time export via remote SSH (vpopmail, etc.).', - 'options' => \%shellcommands_withdomain_options, - 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $username
  • $domain
  • $_password
  • $quoted_password - unencrypted password quoted for the shell
  • $crypt_password - encrypted password
  • $uid
  • $gid
  • $finger - GECOS, already quoted for the shell (do not add additional quotes)
  • $dir - home directory
  • $shell
  • $quota
  • All other fields in svc_acct are also available.
', - }, - - 'ldap' => { - 'desc' => 'Real-time export to LDAP', - 'options' => \%ldap_options, - 'notes' => 'Real-time export to arbitrary LDAP attributes. Requires installation of Net::LDAP from CPAN.', - }, - - 'sqlradius' => { - 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)', - 'options' => \%sqlradius_options, - 'nodomain' => 'Y', - 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for FreeRADIUS or ICRADIUS. An existing RADIUS database will be updated in realtime, but you can use freeside-sqlradius-reset to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source.', - }, - - 'sqlmail' => { - 'desc' => 'Real-time export to SQL-backed mail server', - 'options' => \%sqlmail_options, - 'nodomain' => '', - 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', - }, - - 'cyrus' => { - 'desc' => 'Real-time export to Cyrus IMAP server', - 'options' => \%cyrus_options, - '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' => \%cp_options, - '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' => \%infostreet_options, - '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' => \%vpopmail_options, - 'notes' => 'Real time export to vpopmail text files. File::Rsync must be installed, and you will need to setup SSH for unattended operation to vpopmail@export.host.', - }, - - }, - - 'svc_domain' => { - - 'bind' => { - 'desc' =>'Batch export to BIND named', - 'options' => \%bind_options, - 'notes' => 'Batch export of BIND zone and configuration files to primary nameserver. File::Rsync must be installed. Run bin/bind.export to export the files.', - }, - - 'bind_slave' => { - 'desc' =>'Batch export to slave BIND named', - 'options' => \%bind_slave_options, - 'notes' => 'Batch export of BIND configuration file to a secondary nameserver. Zones are slaved from the listed masters. File::Rsync must be installed. Run bin/bind.export to export the files.', - }, - - 'http' => { - 'desc' => 'Send an HTTP or HTTPS GET or POST request', - 'options' => \%http_options, - 'notes' => 'Send an HTTP or HTTPS GET or POST to the specified URL. libwww-perl must be installed. For HTTPS support, Crypt::SSLeay or IO::Socket::SSL is required.', - }, - - 'sqlmail' => { - 'desc' => 'Real-time export to SQL-backed mail server', - 'options' => \%sqlmail_options, - #'nodomain' => 'Y', - 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', - }, - - 'domain_shellcommands' => { - 'desc' => 'Run remote commands via SSH, for domains.', - 'options' => \%domain_shellcommands_options, - 'notes' => 'Run remote commands via SSH, for domains. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $domain
  • $qdomain - domain with periods replaced by colons
  • $uid - of catchall account
  • $gid - of catchall account
  • $dir - home directory of catchall account
  • All other fields in svc_domain are also available.
', - }, - - - }, - - 'svc_forward' => { - 'sqlmail' => { - 'desc' => 'Real-time export to SQL-backed mail server', - 'options' => \%sqlmail_options, - #'nodomain' => 'Y', - 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', - }, - - 'forward_shellcommands' => { - 'desc' => 'Run remote commands via SSH, for forwards', - 'options' => \%forward_shellcommands_options, - 'notes' => 'Run remote commands via SSH, for forwards. You will need to setup SSH for unattended operation.

Use these buttons for some useful presets:
  • /home/vpopmail/domains/$domain/$username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$domain/$username/.qmail; }"; this.form.userdel.value = "rm /home/vpopmail/domains/$domain/$username/.qmail"; this.form.usermod.value = "mv /home/vpopmail/domains/$old_domain/$old_username/.qmail /home/vpopmail/domains/$new_domain/$new_username; [ \"$old_destination\" != \"$new_destination\" ] && { echo \"$new_destination\" > /home/vpopmail/domains/$new_domain/$new_username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$new_domain/$new_username/.qmail; }";\'>
The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $username
  • $domain
  • $destination - forward destination
  • All other fields in svc_forward are also available.
', - }, - }, - - 'svc_www' => { - 'www_shellcommands' => { - 'desc' => 'Run remote commands via SSH, for virtual web sites.', - 'options' => \%www_shellcommands_options, - 'notes' => 'Run remote commands via SSH, for virtual web sites. You will need to setup SSH for unattended operation.

The following variables are available for interpolation (prefixed with new_ or old_ for replace operations):
  • $zone
  • $username
  • $homedir
  • All other fields in svc_www are also available.
', - }, - - 'apache' => { - 'desc' => 'Export an Apache httpd.conf file snippet.', - 'options' => \%apache_options, - 'notes' => 'Batch export of an httpd.conf snippet from a template. Typically used with something like Include /etc/apache/httpd-freeside.conf in httpd.conf. File::Rsync must be installed. Run bin/apache.export to export the files.', - }, - }, - - 'svc_broadband' => { - }, - -); +#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 -All the stuff in the %exports hash should be generated from the specific -export modules. - Hmm... cust_export class (not necessarily a database table...) ... ? deprecated column...