From 315ab10fe12d129ccfe34b321c7e13038080fb5f Mon Sep 17 00:00:00 2001 From: cvs2git Date: Fri, 16 Feb 2007 22:06:36 +0000 Subject: [PATCH] This commit was manufactured by cvs2svn to create tag 'freeside_1_7_2'. --- FS/FS/part_export/nas_wrapper.pm | 310 ----------------------- FS/FS/part_export/snmp.pm | 256 ------------------- FS/FS/part_export/trango.pm | 434 --------------------------------- httemplate/misc/delete-cust_refund.cgi | 17 -- 4 files changed, 1017 deletions(-) delete mode 100644 FS/FS/part_export/nas_wrapper.pm delete mode 100644 FS/FS/part_export/snmp.pm delete mode 100644 FS/FS/part_export/trango.pm delete mode 100755 httemplate/misc/delete-cust_refund.cgi diff --git a/FS/FS/part_export/nas_wrapper.pm b/FS/FS/part_export/nas_wrapper.pm deleted file mode 100644 index fee9f48fe..000000000 --- a/FS/FS/part_export/nas_wrapper.pm +++ /dev/null @@ -1,310 +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. - -=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; - diff --git a/FS/FS/part_export/snmp.pm b/FS/FS/part_export/snmp.pm deleted file mode 100644 index 81b3c7eb2..000000000 --- a/FS/FS/part_export/snmp.pm +++ /dev/null @@ -1,256 +0,0 @@ -package FS::part_export::snmp; - -=head1 FS::part_export::snmp - -This export sends SNMP SETs to a router using the Net::SNMP package. It requires the following custom fields to be defined on a router. If any of the required custom fields are not present, then the export will exit quietly. - -=head1 Required custom fields - -=over 4 - -=item snmp_address - IP address (or hostname) of the router/agent - -=item snmp_comm - R/W SNMP community of the router/agent - -=item snmp_version - SNMP version of the router/agent - -=back - -=head1 Optional custom fields - -=over 4 - -=item snmp_cmd_insert - SNMP SETs to perform on insert. See L - -=item snmp_cmd_replace - SNMP SETs to perform on replace. See L - -=item snmp_cmd_delete - SNMP SETs to perform on delete. See L - -=item snmp_cmd_suspend - SNMP SETs to perform on suspend. See L - -=item snmp_cmd_unsuspend - SNMP SETs to perform on unsuspend. See L - -=back - -=head1 Formatting - -The values for the snmp_cmd_* fields should be formatted as follows: - -||[||||[...]] - -=over 4 - -=item OID - SNMP object ID (ex. 1.3.6.1.4.1.1.20). If the OID string starts with a '.', then the Private Enterprise OID (1.3.6.1.4.1) is prepended. - -=item Data Type - SNMP data types understood by L, as well as HEX_STRING for convenience. ex. INTEGER, OCTET_STRING, IPADDRESS, ... - -=item expr - Expression to be eval'd by freeside. By default, the expression is double quoted and eval'd with all FS::svc_broadband fields available as scalars (ex. $svcnum, $ip_addr, $speed_up). However, if the expression contains a non-escaped double quote, the expression is eval'd without being double quoted. In this case, the expression must be a block of valid perl code that returns the desired value. - -You must escape non-delimiter pipes ("|") with a backslash. - -=back - -=head1 Examples - -This is an example for exporting to a Trango Access5830 AP. Newlines inserted for clarity. - -=over 4 - -=item snmp_cmd_delete - - -1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50|| -1.3.6.1.4.1.5454.1.20.3.5.8|INTEGER|1| - -=item snmp_cmd_insert - - -1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50|| -1.3.6.1.4.1.5454.1.20.3.5.2|HEX_STRING|join("",$radio_addr =~ /[0-9a-fA-F]{2}/g)|| -1.3.6.1.4.1.5454.1.20.3.5.7|INTEGER|1| - -=item snmp_cmd_replace - - -1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50|| -1.3.6.1.4.1.5454.1.20.3.5.8|INTEGER|1||1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50|| -1.3.6.1.4.1.5454.1.20.3.5.2|HEX_STRING|join("",$new_radio_addr =~ /[0-9a-fA-F]{2}/g)|| -1.3.6.1.4.1.5454.1.20.3.5.7|INTEGER|1| - -=back - -=cut - - -use strict; -use vars qw(@ISA %info $me $DEBUG); -use Tie::IxHash; -use FS::Record qw(qsearch qsearchs); -use FS::part_export; -use FS::part_export::router; - -@ISA = qw(FS::part_export::router); - -tie my %options, 'Tie::IxHash', (); - -%info = ( - 'svc' => 'svc_broadband', - 'desc' => 'Sends SNMP SETs to an SNMP agent.', - 'options' => \%options, - 'notes' => 'Requires Net::SNMP. See the documentation for FS::part_export::snmp for required virtual fields and usage information.', -); - -$me= '[' . __PACKAGE__ . ']'; -$DEBUG = 1; - - -sub _field_prefix { 'snmp'; } - -sub _req_router_fields { - map { - $_[0]->_field_prefix . '_' . $_ - } (qw(address comm version)); -} - -sub _get_cmd_sub { - - my ($self, $svc_broadband, $router) = (shift, shift, shift); - - return(ref($self) . '::snmp_cmd'); - -} - -sub _prepare_args { - - my ($self, $action, $router) = (shift, shift, shift); - my ($svc_broadband) = shift; - my $old; - my $field_prefix = $self->_field_prefix; - - if ($action eq 'replace') { $old = shift; } - - my $raw_cmd = $router->getfield("${field_prefix}_cmd_${action}"); - unless ($raw_cmd) { - warn "[debug]$me router custom field '${field_prefix}_cmd_$action' " - . "is not defined." if $DEBUG; - return ''; - } - - my $args = [ - '-hostname' => $router->getfield($field_prefix.'_address'), - '-version' => $router->getfield($field_prefix.'_version'), - '-community' => $router->getfield($field_prefix.'_comm'), - ]; - - my @varbindlist = (); - - foreach my $snmp_cmd ($raw_cmd =~ m/(.*?[^\\])(?:\|\||$)/g) { - - warn "[debug]$me snmp_cmd is '$snmp_cmd'" if $DEBUG; - - my ($oid, $type, $expr) = $snmp_cmd =~ m/(.*?[^\\])(?:\||$)/g; - - if ($oid =~ /^([\d\.]+)$/) { - $oid = $1; - $oid = ($oid =~ /^\./) ? '1.3.6.1.4.1' . $oid : $oid; - } else { - return "Invalid SNMP OID '$oid'"; - } - - if ($type =~ /^([A-Z_\d]+)$/) { - $type = $1; - } else { - return "Invalid SNMP ASN.1 type '$type'"; - } - - if ($expr =~ /^(.*)$/) { - $expr = $1; - } else { - return "Invalid expression '$expr'"; - } - - { - no strict 'vars'; - no strict 'refs'; - - if ($action eq 'replace') { - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $svc_broadband->getfield($_) foreach $svc_broadband->fields; - $expr = ($expr =~/[^\\]"/) ? eval($expr) : eval(qq("$expr")); - } else { - ${$_} = $svc_broadband->getfield($_) foreach $svc_broadband->fields; - $expr = ($expr =~/[^\\]"/) ? eval($expr) : eval(qq("$expr")); - } - return $@ if $@; - } - - push @varbindlist, ($oid, $type, $expr); - - } - - push @$args, ('-varbindlist', @varbindlist); - - return('', $args); - -} - -sub snmp_cmd { - eval "use Net::SNMP;"; - die $@ if $@; - - my %args = (); - my @varbindlist = (); - while (scalar(@_)) { - my $key = shift; - if ($key eq '-varbindlist') { - push @varbindlist, @_; - last; - } else { - $args{$key} = shift; - } - } - - my $i = 0; - while ($i*3 < scalar(@varbindlist)) { - my $type_index = ($i*3)+1; - my $type_name = $varbindlist[$type_index]; - - # Implementing HEX_STRING outselves since Net::SNMP doesn't. Ewwww! - if ($type_name eq 'HEX_STRING') { - my $value_index = $type_index + 1; - $type_name = 'OCTET_STRING'; - $varbindlist[$value_index] = pack('H*', $varbindlist[$value_index]); - } - - my $type = eval "Net::SNMP::$type_name"; - if ($@ or not defined $type) { - warn $@ if $DEBUG; - die "snmp_cmd error: Unable to lookup type '$type_name'"; - } - - $varbindlist[$type_index] = $type; - } continue { - $i++; - } - - my ($snmp, $error) = Net::SNMP->session(%args); - die "snmp_cmd error: $error" unless($snmp); - - my $res = $snmp->set_request('-varbindlist' => \@varbindlist); - unless($res) { - $error = $snmp->error; - $snmp->close; - die "snmp_cmd error: " . $error; - } - - $snmp->close; - - return ''; - -} - - -=head1 BUGS - -Plenty, I'm sure. - -=cut - -1; diff --git a/FS/FS/part_export/trango.pm b/FS/FS/part_export/trango.pm deleted file mode 100644 index e7f1126dd..000000000 --- a/FS/FS/part_export/trango.pm +++ /dev/null @@ -1,434 +0,0 @@ -package FS::part_export::trango; - -=head1 FS::part_export::trango - -This export sends SNMP SETs to a router using the Net::SNMP package. It requires the following custom fields to be defined on a router. If any of the required custom fields are not present, then the export will exit quietly. - -=head1 Required custom fields - -=over 4 - -=item trango_address - IP address (or hostname) of the Trango AP. - -=item trango_comm - R/W SNMP community of the Trango AP. - -=item trango_ap_type - Trango AP Model. Currently 'access5830' is the only supported option. - -=back - -=head1 Optional custom fields - -=over 4 - -=item trango_baseid - Base ID of the Trango AP. See L. - -=item trango_apid - AP ID of the Trango AP. See L. - -=back - -=head1 Generating SU IDs - -This export will/must generate a unique SU ID for each service exported to a Trango AP. It can be done such that SU IDs are globally unique, unique per Base ID, or unique per Base ID/AP ID pair. This is accomplished by setting neither trango_baseid and trango_apid, only trango_baseid, or both trango_baseid and trango_apid, respectively. An SU ID will be generated if the FS::svc_broadband virtual field specified by suid_field export option is unset, otherwise the existing value will be used. - -=head1 Device Support - -This export has been tested with the Trango Access5830 AP. - - -=cut - - -use strict; -use vars qw(@ISA %info $me $DEBUG $trango_mib $counter_dir); - -use FS::UID qw(dbh datasrc); -use FS::Record qw(qsearch qsearchs); -use FS::part_export::snmp; - -use Tie::IxHash; -use File::CounterFile; -use Data::Dumper qw(Dumper); - -@ISA = qw(FS::part_export::snmp); - -tie my %options, 'Tie::IxHash', ( - 'suid_field' => { - 'label' => 'Trango SU ID field', - 'default' => 'trango_suid', - 'notes' => 'Name of the FS::svc_broadband virtual field that will contain the SU ID.', - }, - 'mac_field' => { - 'label' => 'Trango MAC address field', - 'default' => '', - 'notes' => 'Name of the FS::svc_broadband virtual field that will contain the SU\'s MAC address.', - }, -); - -%info = ( - 'svc' => 'svc_broadband', - 'desc' => 'Sends SNMP SETs to a Trango AP.', - 'options' => \%options, - 'notes' => 'Requires Net::SNMP. See the documentation for FS::part_export::trango for required virtual fields and usage information.', -); - -$me= '[' . __PACKAGE__ . ']'; -$DEBUG = 1; - -$trango_mib = { - 'access5830' => { - 'snmpversion' => 'snmpv1', - 'varbinds' => { - 'insert' => [ - { # sudbDeleteOrAddID - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1', - 'type' => 'INTEGER', - 'value' => \&_trango_access5830_sudbDeleteOrAddId, - }, - { # sudbAddMac - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.2', - 'type' => 'HEX_STRING', - 'value' => \&_trango_access5830_sudbAddMac, - }, - { # sudbAddSU - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.7', - 'type' => 'INTEGER', - 'value' => 1, - }, - ], - 'delete' => [ - { # sudbDeleteOrAddID - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1', - 'type' => 'INTEGER', - 'value' => \&_trango_access5830_sudbDeleteOrAddId, - }, - { # sudbDeleteSU - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.8', - 'type' => 'INTEGER', - 'value' => 1, - }, - ], - 'replace' => [ - { # sudbDeleteOrAddID - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1', - 'type' => 'INTEGER', - 'value' => \&_trango_access5830_sudbDeleteOrAddId, - }, - { # sudbDeleteSU - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.8', - 'type' => 'INTEGER', - 'value' => 1, - }, - { # sudbDeleteOrAddID - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1', - 'type' => 'INTEGER', - 'value' => \&_trango_access5830_sudbDeleteOrAddId, - }, - { # sudbAddMac - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.2', - 'type' => 'HEX_STRING', - 'value' => \&_trango_access5830_sudbAddMac, - }, - { # sudbAddSU - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.7', - 'type' => 'INTEGER', - 'value' => 1, - }, - ], - 'suspend' => [ - { # sudbDeleteOrAddID - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1', - 'type' => 'INTEGER', - 'value' => \&_trango_access5830_sudbDeleteOrAddId, - }, - { # sudbDeleteSU - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.8', - 'type' => 'INTEGER', - 'value' => 1, - }, - ], - 'unsuspend' => [ - { # sudbDeleteOrAddID - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1', - 'type' => 'INTEGER', - 'value' => \&_trango_access5830_sudbDeleteOrAddId, - }, - { # sudbAddMac - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.2', - 'type' => 'HEX_STRING', - 'value' => \&_trango_access5830_sudbAddMac, - }, - { # sudbAddSU - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.7', - 'type' => 'INTEGER', - 'value' => 1, - }, - ], - }, - }, -}; - - -sub _field_prefix { 'trango'; } - -sub _req_router_fields { - map { - $_[0]->_field_prefix . '_' . $_ - } (qw(address comm ap_type suid_field)); -} - -sub _get_cmd_sub { - - return('FS::part_export::snmp::snmp_cmd'); - -} - -sub _prepare_args { - - my ($self, $action, $router) = (shift, shift, shift); - my ($svc_broadband) = shift; - my $old = shift if $action eq 'replace'; - my $field_prefix = $self->_field_prefix; - my $error; - - my $ap_type = $router->getfield($field_prefix . '_ap_type'); - - unless (exists $trango_mib->{$ap_type}) { - return "Unsupported Trango AP type '$ap_type'"; - } - - $error = $self->_check_suid( - $action, $router, $svc_broadband, ($old) ? $old : () - ); - return $error if $error; - - $error = $self->_check_mac( - $action, $router, $svc_broadband, ($old) ? $old : () - ); - return $error if $error; - - my $ap_mib = $trango_mib->{$ap_type}; - - my $args = [ - '-hostname' => $router->getfield($field_prefix.'_address'), - '-version' => $ap_mib->{'snmpversion'}, - '-community' => $router->getfield($field_prefix.'_comm'), - ]; - - my @varbindlist = (); - - foreach my $oid (@{$ap_mib->{'varbinds'}->{$action}}) { - warn "[debug]$me Processing OID '" . $oid->{'oid'} . "'" if $DEBUG; - my $value; - if (ref($oid->{'value'}) eq 'CODE') { - eval { - $value = &{$oid->{'value'}}( - $self, $action, $router, $svc_broadband, - (($old) ? $old : ()), - ); - }; - return "While processing OID '" . $oid->{'oid'} . "':" . $@ - if $@; - } else { - $value = $oid->{'value'}; - } - - warn "[debug]$me Value for OID '" . $oid->{'oid'} . "': " if $DEBUG; - - if (defined $value) { # Skip OIDs with undefined values. - push @varbindlist, ($oid->{'oid'}, $oid->{'type'}, $value); - } - } - - - push @$args, ('-varbindlist', @varbindlist); - - return('', $args); - -} - -sub _check_suid { - - my ($self, $action, $router, $svc_broadband) = (shift, shift, shift, shift); - my $old = shift if $action eq 'replace'; - my $error; - - my $suid_field = $self->option('suid_field'); - unless (grep {$_ eq $suid_field} $svc_broadband->fields) { - return "Missing Trango SU ID field. " - . "See the trango export options for more info."; - } - - my $suid = $svc_broadband->getfield($suid_field); - if ($action eq 'replace') { - my $old_suid = $old->getfield($suid_field); - - if ($old_suid ne '' and $old_suid ne $suid) { - return 'Cannot change Trango SU ID'; - } - } - - if (not $suid =~ /^\d+$/ and $action ne 'delete') { - my $new_suid = eval { $self->_get_next_suid($router); }; - return "Error while getting next Trango SU ID: $@" if ($@); - - warn "[debug]$me Got new SU ID: $new_suid" if $DEBUG; - $svc_broadband->set($suid_field, $new_suid); - - #FIXME: Probably a bad hack. - # We need to update the SU ID field in the database. - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::svc_Common::noexport_hack = 1; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $svcnum = $svc_broadband->svcnum; - - my $old_svc = qsearchs('svc_broadband', { svcnum => $svcnum }); - unless ($old_svc) { - return "Unable to retrieve svc_broadband with svcnum '$svcnum"; - } - - my $svcpart = $svc_broadband->svcpart - ? $svc_broadband->svcpart - : $svc_broadband->cust_svc->svcpart; - - my $new_svc = new FS::svc_broadband { - $old_svc->hash, - $suid_field => $new_suid, - svcpart => $svcpart, - }; - - $error = $new_svc->check; - if ($error) { - $dbh->rollback if $oldAutoCommit; - return "Error while updating the Trango SU ID: $error" if $error; - } - - warn "[debug]$me Updating svc_broadband with SU ID '$new_suid'...\n" . - &Dumper($new_svc) if $DEBUG; - - $error = eval { $new_svc->replace($old_svc); }; - - if ($@ or $error) { - $error ||= $@; - $dbh->rollback if $oldAutoCommit; - return "Error while updating the Trango SU ID: $error" if $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - } - - return ''; - -} - -sub _check_mac { - - my ($self, $action, $router, $svc_broadband) = (shift, shift, shift, shift); - my $old = shift if $action eq 'replace'; - - my $mac_field = $self->option('mac_field'); - unless (grep {$_ eq $mac_field} $svc_broadband->fields) { - return "Missing Trango MAC address field. " - . "See the trango export options for more info."; - } - - my $mac_addr = $svc_broadband->getfield($mac_field); - unless (length(join('', $mac_addr =~ /[0-9a-fA-F]/g)) == 12) { - return "Invalid Trango MAC address: $mac_addr"; - } - - return(''); - -} - -sub _get_next_suid { - - my ($self, $router) = (shift, shift); - - my $counter_dir = '/usr/local/etc/freeside/export.'. datasrc . '/trango'; - my $baseid = $router->getfield('trango_baseid'); - my $apid = $router->getfield('trango_apid'); - - my $counter_file_suffix = ''; - if ($baseid ne '') { - $counter_file_suffix .= "_B$baseid"; - if ($apid ne '') { - $counter_file_suffix .= "_A$apid"; - } - } - - my $counter_file = $counter_dir . '/SUID' . $counter_file_suffix; - - warn "[debug]$me Using SUID counter file '$counter_file'"; - - my $suid = eval { - mkdir $counter_dir, 0700 unless -d $counter_dir; - - my $cf = new File::CounterFile($counter_file, 0); - $cf->inc; - }; - - die "Error generating next Trango SU ID: $@" if (not $suid or $@); - - return($suid); - -} - - - -# Trango-specific subroutines for generating varbind values. -# -# All subs should die on error, and return undef to decline. OIDs that -# decline will not be added to varbinds. - -sub _trango_access5830_sudbDeleteOrAddId { - - my ($self, $action, $router) = (shift, shift, shift); - my ($svc_broadband) = shift; - my $old = shift if $action eq 'replace'; - - my $suid = $svc_broadband->getfield($self->option('suid_field')); - - # Sanity check. - unless ($suid =~ /^\d+$/) { - if ($action eq 'delete') { - # Silently ignore. If we don't have a valid SU ID now, we probably - # never did. - return undef; - } else { - die "Invalid Trango SU ID '$suid'"; - } - } - - return ($suid); - -} - -sub _trango_access5830_sudbAddMac { - - my ($self, $action, $router) = (shift, shift, shift); - my ($svc_broadband) = shift; - my $old = shift if $action eq 'replace'; - - my $mac_addr = $svc_broadband->getfield($self->option('mac_field')); - $mac_addr = join('', $mac_addr =~ /[0-9a-fA-F]/g); - - # Sanity check. - die "Invalid Trango MAC address '$mac_addr'" unless (length($mac_addr)==12); - - return($mac_addr); - -} - - -=head1 BUGS - -Plenty, I'm sure. - -=cut - - -1; diff --git a/httemplate/misc/delete-cust_refund.cgi b/httemplate/misc/delete-cust_refund.cgi deleted file mode 100755 index 3e44560d0..000000000 --- a/httemplate/misc/delete-cust_refund.cgi +++ /dev/null @@ -1,17 +0,0 @@ -% -% -%#untaint refundnum -%my($query) = $cgi->keywords; -%$query =~ /^(\d+)$/ || die "Illegal refundnum"; -%my $refundnum = $1; -% -%my $cust_refund = qsearchs('cust_refund',{'refundnum'=>$refundnum}); -%my $custnum = $cust_refund->custnum; -% -%my $error = $cust_refund->delete; -%eidiot($error) if $error; -% -%print $cgi->redirect($p. "view/cust_main.cgi?". $custnum); -% -% - -- 2.11.0