use FS::nas;
use FS::export_nas;
use FS::legacy_cust_bill;
+ use FS::radius_attr;
# Sammath Naur
if ( $FS::Mason::addl_handler_use ) {
'groupnum', 'serial', '', '', '', '',
'groupname', 'varchar', '', $char_d, '', '',
'description', 'varchar', 'NULL', $char_d, '', '',
+ 'priority', 'int', '', '', '1', '',
],
'primary_key' => 'groupnum',
'unique' => [ ['groupname'] ],
'index' => [],
},
+ 'radius_attr' => {
+ 'columns' => [
+ 'attrnum', 'serial', '', '', '', '',
+ 'groupnum', 'int', '', '', '', '',
+ 'attrname', 'varchar', '', $char_d, '', '',
+ 'value', 'varchar', '', $char_d, '', '',
+ 'attrtype', 'char', '', 1, '', '',
+ 'op', 'char', '', 2, '', '',
+ ],
+ 'primary_key' => 'attrnum',
+ 'unique' => [ ['groupnum','attrname'] ], #?
+ 'index' => [],
+ },
+
'msgcat' => {
'columns' => [
'msgnum', 'serial', '', '', '', '',
'radius_password' => { label=>'Fixed password' },
'ip_addr_as' => { label => 'Send IP address as',
default => 'Framed-IP-Address' },
-;
+ 'export_attrs' => {
+ type => 'checkbox',
+ label => 'Export RADIUS group attributes to this database',
+ },
+ ;
%info = (
'svc' => 'svc_broadband',
package FS::part_export::sqlradius;
+use strict;
use vars qw(@ISA @EXPORT_OK $DEBUG %info %options $notes1 $notes2);
use Exporter;
use Tie::IxHash;
@ISA = qw(FS::part_export);
@EXPORT_OK = qw( sqlradius_connect );
-$DEBUG = 1;
+$DEBUG = 0;
my %groups;
tie %options, 'Tie::IxHash',
'Radius group mapping to reason (via template user) (svcnum|username|username@domain reasonnum|reason)',
type => 'textarea',
},
-
+ 'export_attrs' => {
+ type => 'checkbox',
+ label => 'Export RADIUS group attributes to this database',
+ },
;
$notes1 = <<'END';
$table, $self->export_username($svc_x), %attrib );
return $err_or_queue unless ref($err_or_queue);
}
- my @groups = $svc_x->radius_groups;
+ my @groups = $svc_x->radius_groups('hashref');
if ( @groups ) {
cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum.
" (". $self->export_username($svc_x). " with ". join(", ", @groups)
}
my $error;
- my (@oldgroups) = $old->radius_groups;
- my (@newgroups) = $new->radius_groups;
+ my (@oldgroups) = $old->radius_groups('hashref');
+ my (@newgroups) = $new->radius_groups('hashref');
$error = $self->sqlreplace_usergroups( $new->svcnum,
$self->export_username($new),
$jobnum ? $jobnum : '',
}
my $error =
- $self->sqlreplace_usergroups( $new->svcnum,
- $self->export_username($new),
- '',
- [ $svc_acct->radius_groups ],
- \@newgroups,
- );
+ $self->sqlreplace_usergroups(
+ $new->svcnum,
+ $self->export_username($new),
+ '',
+ [ $svc_acct->radius_groups('hashref') ],
+ \@newgroups,
+ );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
my $error;
my (@oldgroups) = $self->suspended_usergroups($svc_acct);
- $error = $self->sqlreplace_usergroups( $svc_acct->svcnum,
- $self->export_username($svc_acct),
- '',
- \@oldgroups,
- [ $svc_acct->radius_groups ],
- );
+ $error = $self->sqlreplace_usergroups(
+ $svc_acct->svcnum,
+ $self->export_username($svc_acct),
+ '',
+ \@oldgroups,
+ [ $svc_acct->radius_groups('hashref') ],
+ );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
$suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } );
}
#esalf
- return $suspend_user->radius_groups if $suspend_user;
+ return $suspend_user->radius_groups('hashref') if $suspend_user;
();
}
) or die $dbh->errstr;
my $sth = $dbh->prepare(
- "INSERT INTO $usergroup ( UserName, GroupName ) VALUES ( ?, ? )"
+ "INSERT INTO $usergroup ( UserName, GroupName, Priority ) VALUES ( ?, ?, ? )"
) or die $dbh->errstr;
- foreach my $group ( @groups ) {
+ foreach ( @groups ) {
+ my $group = $_->{'groupname'};
+ my $priority = $_->{'priority'};
$s_sth->execute( $username, $group ) or die $s_sth->errstr;
if ($s_sth->fetchrow_arrayref->[0]) {
warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
if $DEBUG;
next;
}
- $sth->execute( $username, $group )
+ $sth->execute( $username, $group, $priority )
or die "can't insert into groupname table: ". $sth->errstr;
}
if ( $s_sth->{Active} ) {
my $sth = $dbh->prepare(
"DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?"
) or die $dbh->errstr;
- foreach my $group ( @groups ) {
+ foreach ( @groups ) {
+ my $group = $_->{'groupname'};
$sth->execute( $username, $group )
or die "can't delete from groupname table: ". $sth->errstr;
}
$sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr;
}
+=item export_attr_insert RADIUS_ATTR
+
+=item export_attr_delete RADIUS_ATTR
+
+=item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR
+
+Update the group attribute tables (radgroupcheck and radgroupreply) on
+the RADIUS server. In delete and replace actions, the existing records
+are identified by the combination of group name and attribute name.
+
+In the special case where attributes are being replaced because a group
+name (L<FS::radius_group>->groupname) is changing, the pseudo-field
+'groupname' must be set in OLD_RADIUS_ATTR. It's probably best to do this
+
+
+=cut
+
+# some false laziness with NAS export stuff...
+
+sub export_attr_insert { shift->export_attr_action('insert', @_); }
+
+sub export_attr_delete { shift->export_attr_action('delete', @_); }
+
+sub export_attr_replace { shift->export_attr_action('replace', @_); }
+
+sub export_attr_action {
+ my $self = shift;
+ my ($action, $new, $old) = @_;
+ my ($attrname, $attrtype, $groupname) =
+ ($new->attrname, $new->attrtype, $new->radius_group->groupname);
+ if ( $action eq 'replace' ) {
+
+ if ( $new->attrtype ne $old->attrtype ) {
+ # they're in separate tables in the target
+ return $self->export_attr_action('delete', $old)
+ || $self->export_attr_action('insert', $new)
+ ;
+ }
+
+ # otherwise, just make sure we know the old attribute/group names
+ # so we can find the existing record
+ $attrname = $old->attrname;
+ $groupname = $old->groupname || $old->radius_group->groupname;
+ # maybe this should be enforced more strictly
+ warn "WARNING: attribute replace without 'groupname' set; assuming '$groupname'\n"
+ if !defined($old->groupname);
+ }
+
+ my $err_or_queue = $self->sqlradius_queue('', "attr_$action",
+ attrnum => $new->attrnum,
+ attrname => $attrname,
+ attrtype => $attrtype,
+ groupname => $groupname,
+ );
+ return $err_or_queue unless ref $err_or_queue;
+ '';
+}
+
+sub sqlradius_attr_insert {
+ my $dbh = sqlradius_connect(shift, shift, shift);
+ my %opt = @_;
+ my $radius_attr = qsearchs('radius_attr', { attrnum => $opt{'attrnum'} })
+ or die 'attrnum '.$opt{'attrnum'}.' not found';
+
+ my $table;
+ # make sure $table is completely safe
+ if ( $opt{'attrtype'} eq 'C' ) {
+ $table = 'radgroupcheck';
+ }
+ elsif ( $opt{'attrtype'} eq 'R' ) {
+ $table = 'radgroupreply';
+ }
+ else {
+ die "unknown attribute type '".$radius_attr->attrtype."'";
+ }
+
+ my @values = (
+ $opt{'groupname'}, map { $radius_attr->$_ } qw(attrname op value)
+ );
+ my $sth = $dbh->prepare(
+ 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)'
+ );
+ $sth->execute(@values) or die $dbh->errstr;
+}
+
+sub sqlradius_attr_delete {
+ my $dbh = sqlradius_connect(shift, shift, shift);
+ my %opt = @_;
+
+ my $table;
+ if ( $opt{'attrtype'} eq 'C' ) {
+ $table = 'radgroupcheck';
+ }
+ elsif ( $opt{'attrtype'} eq 'R' ) {
+ $table = 'radgroupreply';
+ }
+ else {
+ die "unknown attribute type '".$opt{'attrtype'}."'";
+ }
+
+ my $sth = $dbh->prepare(
+ 'DELETE FROM '.$table.' WHERE groupname = ? AND attribute = ?'
+ );
+ $sth->execute( @opt{'groupname', 'attrname'} ) or die $dbh->errstr;
+}
+
+sub sqlradius_attr_replace {
+ my $dbh = sqlradius_connect(shift, shift, shift);
+ my %opt = @_;
+ my $radius_attr = qsearchs('radius_attr', { attrnum => $opt{'attrnum'} })
+ or die 'attrnum '.$opt{'attrnum'}.' not found';
+
+ my $table;
+ if ( $opt{'attrtype'} eq 'C' ) {
+ $table = 'radgroupcheck';
+ }
+ elsif ( $opt{'attrtype'} eq 'R' ) {
+ $table = 'radgroupreply';
+ }
+ else {
+ die "unknown attribute type '".$opt{'attrtype'}."'";
+ }
+
+ my $sth = $dbh->prepare(
+ 'UPDATE '.$table.' SET groupname = ?, attribute = ?, op = ?, value = ?
+ WHERE groupname = ? AND attribute = ?'
+ );
+
+ my $new_groupname = $radius_attr->radius_group->groupname;
+ my @new_values = (
+ $new_groupname, map { $radius_attr->$_ } qw(attrname op value)
+ );
+ $sth->execute( @new_values, @opt{'groupname', 'attrname'} )
+ or die $dbh->errstr;
+}
+
+=item export_group_replace NEW OLD
+
+Replace the L<FS::radius_group> object OLD with NEW. This will change
+the group name and priority in all radusergroup records, and the group
+name in radgroupcheck and radgroupreply.
+
+=cut
+
+sub export_group_replace {
+ my $self = shift;
+ my ($new, $old) = @_;
+ return '' if $new->groupname eq $old->groupname
+ and $new->priority == $old->priority;
+
+ my $err_or_queue = $self->sqlradius_queue(
+ '',
+ 'group_replace',
+ ($self->option('usergroup') || 'usergroup'),
+ $new->hashref,
+ $old->hashref,
+ );
+ return $err_or_queue unless ref $err_or_queue;
+ '';
+}
+
+sub sqlradius_group_replace {
+ my $dbh = sqlradius_connect(shift, shift, shift);
+ my $usergroup = shift;
+ $usergroup =~ /^(rad)?usergroup$/
+ or die "bad usergroup table name: $usergroup";
+ my ($new, $old) = (shift, shift);
+ # apply renames to check/reply attribute tables
+ if ( $new->{'groupname'} ne $old->{'groupname'} ) {
+ foreach my $table (qw(radgroupcheck radgroupreply)) {
+ my $sth = $dbh->prepare(
+ 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?'
+ );
+ $sth->execute($new->{'groupname'}, $old->{'groupname'})
+ or die $dbh->errstr;
+ }
+ }
+ # apply renames and priority changes to usergroup table
+ my $sth = $dbh->prepare(
+ 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?'
+ );
+ $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'})
+ or die $dbh->errstr;
+}
+
###
#class methods
###
my @part_export = ();
push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
- foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius );
+ foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius
+ broadband_sqlradius );
@part_export;
}
--- /dev/null
+package FS::radius_attr;
+
+use strict;
+use base qw( FS::Record );
+use FS::Record qw( qsearch qsearchs );
+use vars qw( $noexport_hack );
+
+=head1 NAME
+
+FS::radius_attr - Object methods for radius_attr records
+
+=head1 SYNOPSIS
+
+ use FS::radius_attr;
+
+ $record = new FS::radius_attr \%hash;
+ $record = new FS::radius_attr { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::radius_attr object represents a RADIUS group attribute.
+FS::radius_attr inherits from FS::Record. The following fields are
+currently supported:
+
+=over 4
+
+=item attrnum - primary key
+
+=item groupnum - L<FS::radius_group> to assign this attribute
+
+=item attrname - Attribute name, as defined in the RADIUS server's dictionary
+
+=item value - Attribute value
+
+=item attrtype - 'C' (check) or 'R' (reply)
+
+=item op - Operator (see L<http://wiki.freeradius.org/Operators>)
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new example. To add the example to the database, see L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to. You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'radius_attr'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false. If any sqlradius-type exports exist and have the
+C<export_attrs> option enabled, the new attribute will be exported to them.
+
+=cut
+
+sub insert {
+ my $self = shift;
+ my $error = $self->SUPER::insert;
+ return $error if $error;
+ return if $noexport_hack;
+
+ foreach ( qsearch('part_export', {}) ) {
+ next if !$_->option('export_attrs',1);
+ $error = $_->export_attr_insert($self);
+ return $error if $error;
+ }
+
+ '';
+}
+
+
+=item delete
+
+Delete this record from the database. Like C<insert>, this will delete
+the attribute from any attached RADIUS databases.
+
+=cut
+
+sub delete {
+ my $self = shift;
+ my $error;
+ if ( !$noexport_hack ) {
+ foreach ( qsearch('part_export', {}) ) {
+ next if !$_->option('export_attrs',1);
+ $error = $_->export_attr_delete($self);
+ return $error if $error;
+ }
+ }
+
+ $self->SUPER::delete;
+}
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+sub replace {
+ my ($self, $old) = @_;
+ $old ||= $self->replace_old;
+ return 'can\'t change radius_attr.groupnum'
+ if $self->groupnum != $old->groupnum;
+ return ''
+ unless grep { $self->$_ ne $old->$_ } qw(attrname value op attrtype);
+
+ # don't attempt export on an invalid record
+ my $error = $self->check;
+ return $error if $error;
+
+ # exportage
+ $old->set('groupname', $old->radius_group->groupname);
+ if ( !$noexport_hack ) {
+ foreach ( qsearch('part_export', {}) ) {
+ next if !$_->option('export_attrs',1);
+ $error = $_->export_attr_replace($self, $old);
+ return $error if $error;
+ }
+ }
+
+ $self->SUPER::replace($old);
+}
+
+
+=item check
+
+Checks all fields to make sure this is a valid example. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('attrnum')
+ || $self->ut_foreign_key('groupnum', 'radius_group', 'groupnum')
+ || $self->ut_text('attrname')
+ || $self->ut_text('value')
+ || $self->ut_enum('attrtype', [ 'C', 'R' ])
+ ;
+ return $error if $error;
+
+ my @ops = $self->ops($self->get('attrtype'));
+ $self->set('op' => $ops[0]) if !$self->get('op');
+ $error ||= $self->ut_enum('op', \@ops);
+
+ return $error if $error;
+
+ $self->SUPER::check;
+}
+
+=item radius_group
+
+Returns the L<FS::radius_group> object to which this attribute applies.
+
+=cut
+
+sub radius_group {
+ my $self = shift;
+ qsearchs('radius_group', { 'groupnum' => $self->groupnum });
+}
+
+=back
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item ops ATTRTYPE
+
+Returns a list of all legal values of the "op" field. ATTRTYPE must be C for
+check or R for reply.
+
+=cut
+
+my %ops = (
+ C => [ '==', ':=', '+=', '!=', '>', '>=', '<', '<=', '=~', '!~', '=*', '!*' ],
+ R => [ '=', ':=', '+=' ],
+);
+
+sub ops {
+ my $self = shift;
+ my $attrtype = shift;
+ return @{ $ops{$attrtype} };
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
package FS::radius_group;
use strict;
-use base qw( FS::Record );
+use base qw( FS::o2m_Common FS::Record );
use FS::Record qw( qsearch qsearchs );
+use FS::radius_attr;
=head1 NAME
description
+=item priority
+
+priority - for export
+
=back
=cut
-# the delete method can be inherited from FS::Record
+# I'd delete any linked attributes here but we don't really support group
+# deletion. We would also have to delete linked records from
+# radius_usergroup and part_svc_column...
=item replace OLD_RECORD
=cut
-# the replace method can be inherited from FS::Record
+# To keep these things from proliferating, we will follow the same
+# export/noexport switches that radius_attr uses. If you _don't_ use
+# Freeside to maintain your RADIUS group attributes, then it probably
+# shouldn't try to rename groups either.
+
+sub replace {
+ my ($self, $old) = @_;
+ $old ||= $self->replace_old;
+
+ my $error = $self->check;
+ return $error if $error;
+
+ if ( !$FS::radius_attr::noexport_hack ) {
+ foreach ( qsearch('part_export', {}) ) {
+ next if !$_->option('export_attrs',1);
+ $error = $_->export_group_replace($self, $old);
+ return $error if $error;
+ }
+ }
+
+ $self->SUPER::replace($old);
+}
=item check
$self->ut_numbern('groupnum')
|| $self->ut_text('groupname')
|| $self->ut_textn('description')
+ || $self->ut_numbern('priority')
;
return $error if $error;
: $self->groupname;
}
+=item radius_attr
+
+Returns all L<FS::radius_attr> objects (check and reply attributes) for
+this group.
+
+=cut
+
+sub radius_attr {
+ my $self = shift;
+ qsearch({
+ table => 'radius_attr',
+ hashref => {'groupnum' => $self->groupnum },
+ order_by => 'ORDER BY attrtype, attrname',
+ })
+}
+
=back
=head1 BUGS
t/rate_tier.t
FS/rate_tier_detail.pm
t/rate_tier_detail.t
+FS/radius_attr.pm
+t/radius_attr.t
map { $export->option($_) } qw( datasrc username password )
) or die $DBI::errstr;
my $usergroup = $export->option('usergroup') || 'usergroup';
- for my $table (qw( radcheck radreply ), $usergroup) {
+ my @attr_tables;
+ @attr_tables = qw( radgroupcheck radgroupreply )
+ if $export->option('export_attrs');
+ for my $table (qw( radcheck radreply ), $usergroup, @attr_tables) {
my $sth = $icradius_dbh->prepare("DELETE FROM $table");
$sth->execute or die "Can't reset $table table: ". $sth->errstr;
}
$FS::svc_Common::overlimit_missing_cust_svc_nonfatal_kludge = 1;
$FS::svc_Common::overlimit_missing_cust_svc_nonfatal_kludge = 1;
+# this is the same across all exports, for now
+my @radius_attrs = qsearch('radius_attr', {});
+
foreach my $export ( @exports ) {
#my @svcparts = map { $_->svcpart } $export->export_svc;
die $error if $error;
}
+
+ if ( $export->option('export_attrs') ) {
+ foreach my $attr (@radius_attrs) {
+ my $error = $export->export_attr_insert($attr);
+ die $error if $error;
+ }
+ }
}
sub usage {
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::radius_attr;
+$loaded=1;
+print "ok 1\n";
<& elements/browse.html,
- 'title' => 'RADIUS Groups',
- 'name' => 'RADIUS Groups',
- 'menubar' => [ 'Add a RADIUS Group' => $p.'edit/radius_group.html', ],
- 'query' => { 'table' => 'radius_group' },
- 'count_query' => 'SELECT COUNT(*) FROM radius_group',
- 'header' => [ '#', 'RADIUS Group', 'Description' ],
- 'fields' => [ 'groupnum',
- 'groupname',
- 'description',
- ],
- 'links' => [ [ $p.'edit/radius_group.html?', 'groupnum' ],
- '',
- '',
- ],
+ 'title' => 'RADIUS Groups',
+ 'name' => 'RADIUS Groups',
+ 'menubar' => [ 'Add a RADIUS Group' => $p.'edit/radius_group.html', ],
+ 'query' => { 'table' => 'radius_group' },
+ 'count_query' => 'SELECT COUNT(*) FROM radius_group',
+ 'header' => [ '#', 'RADIUS Group', 'Description', 'Priority',
+ 'Check', 'Reply' ],
+ 'fields' => [ 'groupnum',
+ 'groupname',
+ 'description',
+ 'priority',
+ $check_attr, $reply_attr
+ ],
+ 'align' => 'lllcll',
+ 'links' => [ $link, $link, '', '', '', '',
+ ],
&>
<%init>
die "access denied"
unless $curuser->access_right('Configuration');
+my $attr_sub = sub {
+ my $type = shift;
+ my $radius_group = shift;
+ [ map { [ { data => join(' ', $_->attrname, $_->op, $_->value) } ] }
+ grep {$_->attrtype eq $type}
+ $radius_group->radius_attr
+ ];
+};
+
+my $check_attr = sub { &$attr_sub('C', @_) };
+my $reply_attr = sub { &$attr_sub('R', @_) };
+
+my $link = [ $p.'edit/radius_group.html?', 'groupnum' ];
+
</%init>
<& elements/process.html,
- 'table' => 'radius_group',
- 'viewall_dir' => 'browse',
+ 'table' => 'radius_group',
+ 'viewall_dir' => 'browse',
+ 'process_o2m' => {
+ 'table' => 'radius_attr',
+ 'fields' => [ qw( attrtype attrname op value )],
+ },
+ 'precheck_callback' => $precheck_callback,
&>
<%init>
-
die "access denied"
unless $FS::CurrentUser::CurrentUser->access_right('Configuration');
+my $precheck_callback = sub {
+ my $cgi = shift;
+ my $param = $cgi->Vars;
+ # remove rows with a blank attrname and attrnum
+ foreach my $k (grep /^attrnum\d+$/, keys %$param) {
+ if ( !length($param->{$k}) and !length($param->{$k.'_attrname'}) ) {
+ delete $param->{$k.'_'.$_} foreach qw(attrtype attrname op value);
+ delete $param->{$k};
+ }
+ }
+ '';
+};
+
</%init>
<& elements/edit.html,
- 'name' => 'RADIUS Group',
- 'table' => 'radius_group',
- 'labels' => {
- 'groupnum' => 'Group',
- 'groupname' => 'RADIUS Group',
- 'description' => 'Description',
- },
- 'viewall_dir' => 'browse',
+ 'name' => 'RADIUS Group',
+ 'table' => 'radius_group',
+ 'labels' => {
+ 'groupnum' => 'Group',
+ 'groupname' => 'RADIUS Group',
+ 'description' => 'Description',
+ 'attrnum' => 'Attribute',
+ 'priority' => 'Priority',
+ },
+ 'viewall_dir' => 'browse',
+ 'fields' => [
+ { 'field' => 'groupname',
+ 'type' => 'text',
+ 'size' => 20,
+ 'colspan' => 6, # just to not interfere with radius_attr columns
+ },
+ { 'field' => 'description',
+ 'type' => 'text',
+ 'size' => 40,
+ 'colspan' => 6,
+ },
+ { 'field' => 'priority',
+ 'type' => 'text',
+ 'size' => 2,
+ 'colspan' => 6, # just to not interfere with radius_attr columns
+ },
+ {
+ 'field' => 'attrnum',
+ 'type' => 'radius_attr',
+ 'o2m_table' => 'radius_attr',
+ 'm2_label' => 'Attribute',
+ 'm2_error_callback' => $m2_error_callback,
+ },
+ ],
+ #debug => 1
&>
<%init>
die "access denied"
unless $FS::CurrentUser::CurrentUser->access_right('Configuration');
+my $m2_error_callback = sub { # reconstruct the list
+ my ($cgi, $object) = @_;
+
+ warn Dumper({$cgi->Vars});
+ my @fields = qw(attrname attrtype op value);
+ map {
+ my $k = $_;
+ next if !length($cgi->param($k.'_attrname'));
+ new FS::radius_attr {
+ 'groupnum' => $object->groupnum,
+ 'attrnum' => scalar( $cgi->param($k) ),
+ map { $_ => scalar( $cgi->param($k.'_'.$_) ) } @fields,
+ };
+ } grep /^attrnum\d+$/, ($cgi->param);
+};
</%init>
--- /dev/null
+% if ( $first_row ) {
+% $first_row = '';
+<SCRIPT TYPE="text/javascript">
+var ops_for_type = {
+% foreach my $type ('C','R') {
+'<%$type%>': [<% join(',', map {"'$_'"} FS::radius_attr->ops($type)) %>],
+% }
+};
+function change_attrtype(what) {
+ var new_type = what.value;
+ var select_op = document.getElementById(
+ what.id.replace(/_attrtype$/, '_op')
+ );
+ if ( select_op ) {
+ var options = select_op.options;
+ var new_ops = ops_for_type[new_type];
+ while ( options.length > 0 )
+ options.remove(0);
+ for ( var x in new_ops ) {
+ // Option(text, value, defaultSelected)
+ options.add(new Option(new_ops[x], new_ops[x], (options.length == 0)));
+ }
+ }
+ <% $onchange %>(what);
+}
+</SCRIPT>
+% } #if $first_row
+<INPUT TYPE="hidden" NAME="<%$name%>" ID="<%$id%>" VALUE="<% $curr_value %>">
+<& select.html,
+ field => $name.'_attrtype',
+ id => $name.'_attrtype',
+ options => ['C','R'],
+ labels => { 'C' => 'Check', 'R' => 'Reply' },
+ curr_value => $radius_attr->attrtype,
+ onchange => 'change_attrtype(this)',
+&>
+<& input-text.html,
+ field => $name.'_attrname',
+ curr_value => $radius_attr->attrname,
+ onchange => $onchange,
+ size => 40, #longest attribute name in freeradius dict = 46
+&>
+<& select.html,
+ field => $name.'_op',
+ id => $name.'_op',
+ options => [ FS::radius_attr->ops($radius_attr->attrtype) ],
+ curr_value => $radius_attr->op,
+ onchange => $onchange,
+&>
+<& input-text.html,
+ field => $name.'_value',
+ curr_value => $radius_attr->value,
+ onchange => $onchange,
+ size => 20, #tend to be shorter than attribute names
+&>
+<%shared>
+my $first_row = 1;
+</%shared>
+<%init>
+
+my( %opt ) = @_;
+
+# for an 'onchange' option that will work in both select.html and
+# input-text.html:
+# - don't start with "onchange="
+# - don't end with (what) or (this)
+# - don't end with a semicolon
+# - don't have quotes
+my $onchange = $opt{'onchange'} || '';
+$onchange =~ s/\((what|this)\);?$//;
+
+my $name = $opt{'element_name'} || $opt{'field'} || 'attrnum';
+my $id = $opt{'id'} || 'attrnum';
+
+my $curr_value = $opt{'curr_value'} || $opt{'value'};
+my $radius_attr;
+
+if ( $curr_value ) {
+ $radius_attr = qsearchs('radius_attr', { 'attrnum' => $curr_value })
+ or die "attrnum $curr_value not found";
+}
+else {
+ $radius_attr = new FS::radius_attr {
+ 'attrtype' => 'C',
+ 'op' => '==',
+ };
+}
+
+</%init>
my( %opt ) = @_;
-warn "elements/select-table.html: \n". Dumper(%opt)
+warn "elements/select-table.html: \n". Dumper(\%opt)
if exists $opt{debug} && $opt{debug};
$opt{'extra_option_attributes'} ||= [];
my %opt = @_;
-my $onchange = $opt{'onchange'}
- ? 'onChange="'. $opt{'onchange'}. '(this)"'
- : '';
+#no-op code...
+#my $onchange = $opt{'onchange'}
+# ? 'onChange="'. $opt{'onchange'}. '(this)"'
+# : '';
my $labels = $opt{'option_labels'} || $opt{'labels'};
projects / freeside.git / commitdiff