diff options
Diffstat (limited to 'FS')
| -rw-r--r-- | FS/FS/part_export/nas_wrapper.pm | 310 |
1 files changed, 310 insertions, 0 deletions
diff --git a/FS/FS/part_export/nas_wrapper.pm b/FS/FS/part_export/nas_wrapper.pm new file mode 100644 index 000000000..fee9f48fe --- /dev/null +++ b/FS/FS/part_export/nas_wrapper.pm @@ -0,0 +1,310 @@ +package FS::part_export::nas_wrapper; + +=head1 FS::part_export::nas_wrapper + +This is a meta-export that triggers other exports for FS::svc_broadband objects +based on a set of configurable conditions. These conditions are defined by the +following FS::router virtual fields: + +=over 4 + +=item nas_conf - Per-router meta-export configuration. See L</"nas_conf Syntax">. + +=back + +=head2 nas_conf Syntax + +export_name|routernum[,routernum]|[field,condition[,field,condition]][||...] + +=over 4 + +=item export_name - Name or exportnum of the export to be executed. In order to specify export options you must use the exportnum form. (ex. 'router' for FS::part_export::router). + +=item routernum - FS::router routernum corresponding to the desired FS::router for which this export will be run. + +=item field - FS::svc_broadband field (real or virtual). The following condition (regex) will be matched against the value of this field. + +=item condition - A regular expression to be match against the value of the previously listed FS::svc_broadband field. + +=back + +If multiple routernum's are specified, then the export will be triggered for each router listed. If multiple field/condition pairs are present, then the results of the matches will be and'd. Note that if a false match is found, the rest of the matches may not be checked. + +You can specify multiple export/router/condition sets by concatenating them with '||'. + +=cut + +use strict; +use vars qw(@ISA %info $me $DEBUG); + +use FS::Record qw(qsearchs); +use FS::part_export; + +use Tie::IxHash; +use Data::Dumper qw(Dumper); + +@ISA = qw(FS::part_export); +$me = '[' . __PACKAGE__ . ']'; +$DEBUG = 1; + +%info = ( + 'svc' => 'svc_broadband', + 'desc' => 'A meta-export that triggers other svc_broadband exports.', + 'options' => {}, + 'notes' => '', +); + + +sub rebless { shift; } + +sub _export_insert { + my($self) = shift; + $self->_export_command('insert', @_); +} + +sub _export_delete { + my($self) = shift; + $self->_export_command('delete', @_); +} + +sub _export_suspend { + my($self) = shift; + $self->_export_command('suspend', @_); +} + +sub _export_unsuspend { + my($self) = shift; + $self->_export_command('unsuspend', @_); +} + +sub _export_replace { + my($self) = shift; + $self->_export_command('replace', @_); +} + +sub _export_command { + my ( $self, $action, $svc_broadband) = (shift, shift, shift); + + my ($new, $old); + if ($action eq 'replace') { + $new = $svc_broadband; + $old = shift; + } + + my $router = $svc_broadband->addr_block->router; + + return '' unless grep(/^nas_conf$/, $router->fields); + my $nas_conf = $router->nas_conf; + + my $child_exports = &_parse_nas_conf($nas_conf); + + my $error = ''; + + my $queue_child_exports = {}; + + # Similar to FS::svc_Common::replace, calling insert, delete, and replace + # exports where necessary depending on which conditions match. + if ($action eq 'replace') { + + my @new_child_exports = (); + my @old_child_exports = (); + + # Find all the matching "new" child exports. + foreach my $child_export (@$child_exports) { + my $match = &_test_child_export_conditions( + $child_export->{'conditions'}, + $new, + ); + + if ($match) { + push @new_child_exports, $child_export; + } + } + + # Find all the matching "old" child exports. + foreach my $child_export (@$child_exports) { + my $match = &_test_child_export_conditions( + $child_export->{'conditions'}, + $old, + ); + + if ($match) { + push @old_child_exports, $child_export; + } + } + + # Insert exports for new. + push @{$queue_child_exports->{'insert'}}, ( + map { + my $new_child_export = $_; + if (! grep { $new_child_export eq $_ } @old_child_exports) { + $new_child_export->{'args'} = [ $new ]; + $new_child_export; + } else { + (); + } + } @new_child_exports + ); + + # Replace exports for new and old. + push @{$queue_child_exports->{'replace'}}, ( + map { + my $new_child_export = $_; + if (grep { $new_child_export eq $_ } @old_child_exports) { + $new_child_export->{'args'} = [ $new, $old ]; + $new_child_export; + } else { + (); + } + } @new_child_exports + ); + + # Delete exports for old. + push @{$queue_child_exports->{'delete'}}, ( + grep { + my $old_child_export = $_; + if (! grep { $old_child_export eq $_ } @new_child_exports) { + $old_child_export->{'args'} = [ $old ]; + $old_child_export; + } else { + (); + } + } @old_child_exports + ); + + } else { + + foreach my $child_export (@$child_exports) { + my $match = &_test_child_export_conditions( + $child_export->{'conditions'}, + $svc_broadband, + ); + + if ($match) { + $child_export->{'args'} = [ $svc_broadband ]; + push @{$queue_child_exports->{$action}}, $child_export; + } + } + + } + + warn "[debug]$me Dispatching child exports... " + . &Dumper($queue_child_exports); + + # Actually call the child exports now, with their preset action and arguments. + foreach my $_action (keys(%$queue_child_exports)) { + + foreach my $_child_export (@{$queue_child_exports->{$_action}}) { + $error = &_dispatch_child_export( + $_child_export, + $_action, + @{$_child_export->{'args'}}, + ); + + # Bail if there's an error queueing one of the exports. + # This will all get rolled-back. + return $error if $error; + } + + } + + return ''; + +} + + +sub _parse_nas_conf { + + my $nas_conf = shift; + my @child_exports = (); + + foreach my $cond_set ($nas_conf =~ m/(.*?[^\\])(?:\|\||$)/g) { + + warn "[debug]$me cond_set is '$cond_set'" if $DEBUG; + + my @args = $cond_set =~ m/(.*?[^\\])(?:\||$)/g; + + my %child_export = ( + 'export' => $args[0], + 'routernum' => [ split(/,\s*/, $args[1]) ], + 'conditions' => { @args[2..$#args] }, + ); + + warn "[debug]$me " . Dumper(\%child_export) if $DEBUG; + + push @child_exports, { %child_export }; + + } + + return \@child_exports; + +} + +sub _dispatch_child_export { + + my ($child_export, $action, @args) = (shift, shift, @_); + + my $child_export_name = $child_export->{'export'}; + my @routernums = @{$child_export->{'routernum'}}; + + my $error = ''; + + # And the real hack begins... + + my $child_part_export; + if ($child_export_name =~ /^(\d+)$/) { + my $exportnum = $1; + $child_part_export = qsearchs('part_export', { exportnum => $exportnum }); + unless ($child_part_export) { + return "No such FS::part_export with exportnum '$exportnum'"; + } + + $child_export_name = $child_part_export->exporttype; + } else { + $child_part_export = new FS::part_export { + 'exporttype' => $child_export_name, + 'machine' => 'bogus', + }; + } + + warn "[debug]$me running export '$child_export_name' for routernum(s) '" + . join(',', @routernums) . "'" if $DEBUG; + + my $cmd_method = "_export_$action"; + + foreach my $routernum (@routernums) { + $error ||= $child_part_export->$cmd_method( + @args, + 'routernum' => $routernum, + ); + last if $error; + } + + warn "[debug]$me export '$child_export_name' returned '$error'" + if $DEBUG; + + return $error; + +} + +sub _test_child_export_conditions { + + my ($conditions, $svc_broadband) = (shift, shift); + + my $match = 1; + foreach my $cond_field (keys %$conditions) { + my $cond_regex = $conditions->{$cond_field}; + warn "[debug]$me Condition: $cond_field =~ /$cond_regex/" if $DEBUG; + unless ($svc_broadband->get($cond_field) =~ /$cond_regex/) { + $match = 0; + last; + } + } + + return $match; + +} + + +1; + |