X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_export.pm;h=251184371017636cfba1e0d9780e2f509e4f0913;hb=a72a10f754f7465121d6137bb3dcee0a21ea6443;hp=835f5318f1b067e5e9d60ed77dc151d949937fdb;hpb=e6ea57971831f25d682d97a0ba508c39b66ecd8b;p=freeside.git diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 835f5318f..5d650626e 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -1,16 +1,24 @@ package FS::part_export; use strict; -use vars qw( @ISA @EXPORT_OK %exports ); +use vars qw( @ISA @EXPORT_OK $DEBUG %exports ); use Exporter; +use Tie::IxHash; +use base qw( FS::option_Common FS::m2m_Common ); use FS::Record qw( qsearch qsearchs dbh ); use FS::part_svc; use FS::part_export_option; +use FS::part_export_machine; +use FS::svc_export_machine; use FS::export_svc; -@ISA = qw(FS::Record); +#for export modules, though they should probably just use it themselves +use FS::queue; + @EXPORT_OK = qw(export_info); +$DEBUG = 0; + =head1 NAME FS::part_export - Object methods for part_export records @@ -43,6 +51,8 @@ fields are currently supported: =item exportnum - primary key +=item exportname - Descriptive name + =item machine - Machine name =item exporttype - Export type @@ -102,34 +112,38 @@ created (see L). =cut -#false laziness w/queue.pm sub insert { my $self = shift; - my $options = shift; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; - my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->SUPER::insert; + my $error = $self->SUPER::insert(@_); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - foreach my $optionname ( keys %{$options} ) { - my $part_export_option = new FS::part_export_option ( { - 'exportnum' => $self->exportnum, - 'optionname' => $optionname, - 'optionvalue' => $options->{$optionname}, - } ); - $error = $part_export_option->insert; + #kinda false laziness with process_m2name + my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ } + grep /\S/, + split /[\n\r]{1,2}/, + $self->part_export_machine_textarea; + + foreach my $machine ( @machines ) { + + my $part_export_machine = new FS::part_export_machine { + 'exportnum' => $self->exportnum, + 'machine' => $machine, + }; + $error = $part_export_machine->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -137,10 +151,8 @@ sub insert { } $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -}; +} =item delete @@ -151,33 +163,38 @@ Delete this record from the database. #foreign keys would make this much less tedious... grr dumb mysql sub delete { my $self = shift; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; - my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->SUPER::delete; + # clean up export_nas records + my $error = $self->process_m2m( + 'link_table' => 'export_nas', + 'target_table' => 'nas', + 'params' => [], + ) || $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - foreach my $part_export_option ( $self->part_export_option ) { - my $error = $part_export_option->delete; + foreach my $export_svc ( $self->export_svc ) { + my $error = $export_svc->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } } - foreach my $export_svc ( $self->export_svc ) { - my $error = $export_svc->delete; + foreach my $part_export_machine ( $self->part_export_machine ) { + my $error = $part_export_machine->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -185,25 +202,22 @@ sub delete { } $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - } -=item replace OLD_RECORD HASHREF +=item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ] Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -If a hash reference of options is supplied, part_export_option records are -created or modified (see L). +If a list or hash reference of options is supplied, option records are created +or modified. =cut sub replace { my $self = shift; - my $old = shift; - my $options = shift; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -215,46 +229,68 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->SUPER::replace($old); + my $error = $self->SUPER::replace(@_); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - foreach my $optionname ( keys %{$options} ) { - my $old = qsearchs( 'part_export_option', { - 'exportnum' => $self->exportnum, - 'optionname' => $optionname, - } ); - my $new = new FS::part_export_option ( { - 'exportnum' => $self->exportnum, - 'optionname' => $optionname, - 'optionvalue' => $options->{$optionname}, - } ); - $new->optionnum($old->optionnum) if $old; - my $error = $old ? $new->replace($old) : $new->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + if ( $self->part_export_machine_textarea ) { + + my %part_export_machine = map { $_->machine => $_ } + $self->part_export_machine; + + my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ } + grep /\S/, + split /[\n\r]{1,2}/, + $self->part_export_machine_textarea; + + foreach my $machine ( @machines ) { + + if ( $part_export_machine{$machine} ) { + + if ( $part_export_machine{$machine}->disabled eq 'Y' ) { + $part_export_machine{$machine}->disabled(''); + $error = $part_export_machine{$machine}->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + delete $part_export_machine{$machine}; #so we don't disable it below + + } else { + + my $part_export_machine = new FS::part_export_machine { + 'exportnum' => $self->exportnum, + 'machine' => $machine + }; + $error = $part_export_machine->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } + } - } - #remove extraneous old options - foreach my $opt ( - grep { !exists $options->{$_->optionname} } $old->part_export_option - ) { - my $error = $opt->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + + foreach my $part_export_machine ( values %part_export_machine ) { + $part_export_machine->disabled('Y'); + $error = $part_export_machine->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -}; +} =item check @@ -268,17 +304,12 @@ sub check { my $self = shift; my $error = $self->ut_numbern('exportnum') - || $self->ut_domain('machine') + || $self->ut_textn('exportname') + || $self->ut_domainn('machine') || $self->ut_alpha('exporttype') ; return $error if $error; - warn $self->machine. "!!!\n"; - - $self->machine =~ /^([\w\-\.]*)$/ - or return "Illegal machine: ". $self->machine; - $self->machine($1); - $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain; $self->nodomain($1); @@ -286,7 +317,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,6 +373,44 @@ sub part_svc { #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; + 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. @@ -317,6 +422,17 @@ sub export_svc { qsearch('export_svc', { 'exportnum' => $self->exportnum } ); } +=item export_device + +Returns a list of associated FS::export_device records. + +=cut + +sub export_device { + my $self = shift; + qsearch('export_device', { 'exportnum' => $self->exportnum } ); +} + =item part_export_option Returns all options as FS::part_export_option objects (see @@ -326,60 +442,64 @@ L). sub part_export_option { my $self = shift; - qsearch('part_export_option', { 'exportnum' => $self->exportnum } ); + $self->option_objects; } =item options Returns a list of option names and values suitable for assigning to a hash. -=cut - -sub options { - my $self = shift; - map { $_->optionname => $_->optionvalue } $self->part_export_option; -} - =item option OPTIONNAME Returns the option value for the given name, or the empty string. -=cut - -sub option { - my $self = shift; - my $part_export_option = - qsearchs('part_export_option', { - exportnum => $self->exportnum, - optionname => shift, - } ); - $part_export_option ? $part_export_option->optionvalue : ''; -} - -=item rebless +=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 + +=cut + +sub svc_machine { + my( $self, $svc_x ) = @_; + + return $self->machine unless $self->machine eq '_SVC_MACHINE'; + + my $svc_export_machine = qsearchs('svc_export_machine', { + 'svcnum' => $svc_x->svcnum, + 'exportnum' => $self->exportnum, + }) + #would only happen if you add this export to existing services without a + #machine set then try to run exports without setting it... right? + or die "No hostname selected for ".($self->exportname || $self->exporttype); + + return $svc_export_machine->part_export_machine->machine; } +#these should probably all go away, just let the subclasses define em + =item export_insert SVC_OBJECT =cut sub export_insert { my $self = shift; - $self->rebless; + #$self->rebless; $self->_export_insert(@_); } @@ -398,7 +518,7 @@ sub export_insert { sub export_replace { my $self = shift; - $self->rebless; + #$self->rebless; $self->_export_replace(@_); } @@ -408,10 +528,30 @@ sub export_replace { sub export_delete { my $self = shift; - $self->rebless; + #$self->rebless; $self->_export_delete(@_); } +=item export_suspend + +=cut + +sub export_suspend { + my $self = shift; + #$self->rebless; + $self->_export_suspend(@_); +} + +=item export_unsuspend + +=cut + +sub export_unsuspend { + my $self = shift; + #$self->rebless; + $self->_export_unsuspend(@_); +} + #fallbacks providing useful error messages intead of infinite loops sub _export_insert { my $self = shift; @@ -428,6 +568,70 @@ 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 export_links SVC_OBJECT ARRAYREF + +Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT. +The elements are displayed in the UI to lead the the operator to external +configuration, monitoring, and similar tools. + +=item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF + +Adds a hashref of settings to SETTINGSREF specific to this export and +SVC_OBJECT. The elements can be displayed in the UI on the service view. + +DEFAULTSREF is a hashref with the same keys where true values indicate the +setting is a default (and thus can be displayed in the UI with less emphasis, +or hidden by default). + +=cut + +=item weight + +Returns the 'weight' element from the export's %info hash, or 0 if there is +no weight defined. + +=cut + +sub weight { + my $self = shift; + export_info()->{$self->exporttype}->{'weight'} || 0; +} + +=item info + +Returns a reference to (a copy of) the export's %info hash. + +=cut + +sub info { + my $self = shift; + $self->{_info} ||= { + %{ export_info()->{$self->exporttype} } + }; +} + +#default fallbacks... FS::part_export::DID_Common ? +sub get_dids_can_tollfree { 0; } +sub get_dids_npa_select { 1; } + =back =head1 SUBROUTINES @@ -453,100 +657,102 @@ 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. -=cut - -sub exporttype2svcdb { - my $exporttype = $_[0]; - foreach my $svcdb ( keys %exports ) { - return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}}; +sub _upgrade_data { #class method + my ($class, %opts) = @_; + + my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' }); + foreach my $opt ( @part_export_option ) { + next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue; + my @groupnames = split(' ',$opt->optionvalue); + my @groupnums; + my $error = ''; + foreach my $groupname ( @groupnames ) { + my $g = qsearchs('radius_group', { 'groupname' => $groupname } ); + unless ( $g ) { + $g = new FS::radius_group { + 'groupname' => $groupname, + 'description' => $groupname, + }; + $error = $g->insert; + die $error if $error; + } + push @groupnums, $g->groupnum; + } + $opt->optionvalue(join(' ',@groupnums)); + $error = $opt->replace; + die $error if $error; + } + # pass downstream + my %exports_in_use; + $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {}); + foreach (keys(%exports_in_use)) { + $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype'); } - ''; } -%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' => {}, -# }, - 'bsdshell' => { - 'desc' => - 'Batch export of /etc/passwd and /etc/master.passwd files (BSD)', - 'options' => {}, - }, - 'textradius' => { - 'desc' => 'Batch export of a text /etc/raddb/users file (Livingston, Cistron)', - }, - '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' => 'Not specifying datasrc will export to the freeside database? (no... notes on MySQL replication, DBI::Proxy, etc., from Conf.pm && export.html etc., reset with bin/sqlradius_reset', - }, - 'cyrus' => { - 'desc' => 'Real-time export to Cyrus IMAP server', - }, - 'cp' => { - 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol', - }, - '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.', - } - }, - - 'svc_domain' => {}, - - '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...