summaryrefslogtreecommitdiff
path: root/FS/FS/part_export/nas_wrapper.pm
diff options
context:
space:
mode:
Diffstat (limited to 'FS/FS/part_export/nas_wrapper.pm')
-rw-r--r--FS/FS/part_export/nas_wrapper.pm311
1 files changed, 0 insertions, 311 deletions
diff --git a/FS/FS/part_export/nas_wrapper.pm b/FS/FS/part_export/nas_wrapper.pm
deleted file mode 100644
index 2499ba3ee..000000000
--- a/FS/FS/part_export/nas_wrapper.pm
+++ /dev/null
@@ -1,311 +0,0 @@
-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 = 0;
-
-%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) if $DEBUG;
-
- # 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;
-
generated by cgit v1.2.1 (git 2.18.0) at 2024-09-25 08:00:48 +0000