From 92badebcb286260d7861bd09a2450eea18c4259e Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 5 Apr 2002 00:42:21 +0000 Subject: [PATCH] Checkin of disparate changes from working on the road: - generic SQL query - move exports out to their own files - small cleanup of selfadmin server --- FS/FS/part_export.pm | 336 +-------------------------------------- FS/FS/part_export/infostreet.pm | 83 ++++++++++ FS/FS/part_export/sqlradius.pm | 198 +++++++++++++++++++++++ FS/MANIFEST | 6 + fs_selfadmin/fs_mailadmin_server | 2 +- httemplate/docs/install.html | 1 + httemplate/edit/part_export.cgi | 2 +- httemplate/index.html | 2 + 8 files changed, 298 insertions(+), 332 deletions(-) create mode 100644 FS/FS/part_export/infostreet.pm create mode 100644 FS/FS/part_export/sqlradius.pm diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 41dfe77a1..a43c3844e 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -340,8 +340,9 @@ autoloaded-on-demand), but until then, see L. sub rebless { my $self = shift; my $exporttype = $self->exporttype; - my $class = ref($self); - bless($self, $class."::$exporttype"); + my $class = ref($self). "::$exporttype"; + eval "use $class;"; + bless($self, $class); } =item export_insert SVC_OBJECT @@ -401,341 +402,16 @@ sub _export_delete { =back -=cut - -#infostreet - -package FS::part_export::infostreet; -use vars qw(@ISA); -@ISA = qw(FS::part_export); - -sub rebless { shift; } - -sub _export_insert { - my( $self, $svc_acct ) = (shift, shift); - $self->infostreet_queue( $svc_acct->svcnum, - 'createUser', $svc_acct->username, $svc_acct->password ); -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't change username with InfoStreet" - if $old->username ne $new->username; - return '' unless $old->_password ne $new->_password; - $self->infostreet_queue( $new->svcnum, - 'passwd', $new->username, $new->password ); -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->infostreet_queue( $svc_acct->svcnum, - 'purgeAccount,releaseUsername', $svc_acct->username ); -} - -sub infostreet_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => 'FS::part_export::infostreet::infostreet_command', - }; - $queue->insert( - $self->option('url'), - $self->option('login'), - $self->option('password'), - $self->option('groupID'), - $method, - @_, - ); -} - -sub infostreet_command { #subroutine, not method - my($url, $username, $password, $groupID, $method, @args) = @_; - - #quelle hack - if ( $method =~ /,/ ) { - foreach my $part ( split(/,\s*/, $method) ) { - infostreet_command($url, $username, $password, $groupID, $part, @args); - } - return; - } - - eval "use Frontier::Client;"; - - my $conn = Frontier::Client->new( url => $url ); - my $key_result = $conn->call( 'authenticate', $username, $password, $groupID); - my %key_result = _infostreet_parse($key_result); - die $key_result{error} unless $key_result{success}; - my $key = $key_result{data}; - - my $result = $conn->call($method, $key, @args); - my %result = _infostreet_parse($result); - die $result{error} unless $result{success}; - -} - -sub _infostreet_parse { #subroutine, not method - my $arg = shift; - map { - my $value = $arg->{$_}; - #warn ref($value); - $value = $value->value() - if ref($value) && $value->isa('Frontier::RPC2::DataType'); - $_=>$value; - } keys %$arg; -} - -#sqlradius - -package FS::part_export::sqlradius; -use vars qw(@ISA); -@ISA = qw(FS::part_export); - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - - foreach my $table (qw(reply check)) { - my $method = "radius_$table"; - my %attrib = $svc_acct->$method; - next unless keys %attrib; - my $error = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', - $table, $svc_acct->username, %attrib ); - return $error if $error; - } - my @groups = $svc_acct->radius_groups; - if ( @groups ) { - my $error = $self->sqlradius_queue( $svc_acct->svcnum, 'usergroup_insert', - $svc_acct->username, @groups ); - return $error if $error; - } - ''; -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - #return "can't (yet) change username with sqlradius" - # if $old->username ne $new->username; - if ( $old->username ne $new->username ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'rename', - $new->username, $old->username ); - return $error if $error; - } - - foreach my $table (qw(reply check)) { - my $method = "radius_$table"; - my %new = $new->$method; - my %old = $old->$method; - if ( grep { !exists $old{$_} #new attributes - || $new{$_} ne $old{$_} #changed - } keys %new - ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'insert', - $table, $new->username, %new ); - return $error if $error; - } - - my @del = grep { !exists $new{$_} } keys %old; - if ( @del ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'attrib_delete', - $table, $new->username, @del ); - return $error if $error; - } - } - - # (sorta) false laziness with FS::svc_acct::replace - my @oldgroups = @{$old->usergroup}; #uuuh - my @newgroups = $new->radius_groups; - my @delgroups = (); - foreach my $oldgroup ( @oldgroups ) { - if ( grep { $oldgroup eq $_ } @newgroups ) { - @newgroups = grep { $oldgroup ne $_ } @newgroups; - next; - } - push @delgroups, $oldgroup; - } - - if ( @delgroups ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete', - $new->username, @delgroups ); - return $error if $error; - } - - if ( @newgroups ) { - my $error = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert', - $new->username, @newgroups ); - return $error if $error; - } - - ''; -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->sqlradius_queue( $svc_acct->svcnum, 'delete', - $svc_acct->username ); -} - -sub sqlradius_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::sqlradius::sqlradius_$method", - }; - $queue->insert( - $self->option('datasrc'), - $self->option('username'), - $self->option('password'), - @_, - ); -} - -sub sqlradius_insert { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $replycheck, $username, %attributes ) = @_; - - foreach my $attribute ( keys %attributes ) { - my $u_sth = $dbh->prepare( - "UPDATE rad$replycheck SET Value = ? WHERE UserName = ? AND Attribute = ?" ) or die $dbh->errstr; - my $i_sth = $dbh->prepare( - "INSERT INTO rad$replycheck ( id, UserName, Attribute, Value ) ". - "VALUES ( ?, ?, ?, ? )" - ) or die $dbh->errstr; - $u_sth->execute($attributes{$attribute}, $username, $attribute) > 0 - or $i_sth->execute( '', $username, $attribute, $attributes{$attribute} ) - or die "can't insert into rad$replycheck table: ". $i_sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_usergroup_insert { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $username, @groups ) = @_; - - my $sth = $dbh->prepare( - "INSERT INTO usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )" - ) or die $dbh->errstr; - foreach my $group ( @groups ) { - $sth->execute( '', $username, $group ) - or die "can't insert into groupname table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_usergroup_delete { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $username, @groups ) = @_; - - my $sth = $dbh->prepare( - "DELETE FROM usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )" - ) or die $dbh->errstr; - foreach my $group ( @groups ) { - $sth->execute( '', $username, $group ) - or die "can't delete from groupname table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_rename { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my($new_username, $old_username) = @_; - foreach my $table (qw(radreply radcheck usergroup )) { - my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?") - or die $dbh->errstr; - $sth->execute($new_username, $old_username) - or die "can't update $table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_attrib_delete { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $replycheck, $username, @attrib ) = @_; - - foreach my $attribute ( @attrib ) { - my $sth = $dbh->prepare( - "DELETE FROM rad$replycheck WHERE UserName = ? AND Attribute = ?" ) - or die $dbh->errstr; - $sth->execute($username,$attribute) - or die "can't delete from rad$replycheck table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_delete { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my $username = shift; - - foreach my $table (qw( radcheck radreply usergroup )) { - my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" ); - $sth->execute($username) - or die "can't delete from $table table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_connect { - #my($datasrc, $username, $password) = @_; - #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; - DBI->connect(@_) or die $DBI::errstr; -} - =head1 NEW EXPORT CLASSES - #myexport - - package FS::part_export::myexport; - use vars qw(@ISA); - @ISA = qw(FS::part_export); - - sub rebless { shift; } - - sub _export_insert { - my($self, $svc_something) = (shift, shift); - $self->myexport_queue( $svc_acct->svcnum, 'insert', - $svc_something->username, $svc_something->password ); - } - - sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - #return "can't change username with myexport" - # if $old->username ne $new->username; - #return '' unless $old->_password ne $new->_password; - $self->myexport_queue( $new->svcnum, - 'replace', $new->username, $new->password ); - } - - sub _export_delete { - my( $self, $svc_something ) = (shift, shift); - $self->myexport_queue( $svc_acct->svcnum, - 'delete', $svc_something->username ); - } - - #a good idea to queue anything that could fail or take any time - sub myexport_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::myexport::myexport_$method", - }; - $queue->insert( @_ ); - } - - sub myexport_insert { #subroutine, not method - } - sub myexport_replace { #subroutine, not method - } - sub myexport_delete { #subroutine, not method - } +Should be added to httemplate/edit/part_export.cgi and a module should +be FS/FS/part_export/ (an example may be found in eg/export_template.pm) =head1 BUGS Probably. -Hmm, export code has wound up in here. Move those sub-classes out into their -own files, at least. Also hmm... cust_export class (not necessarily a -database table...) ... ? +Hmm... cust_export class (not necessarily a database table...) ... ? =head1 SEE ALSO diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm new file mode 100644 index 000000000..c2386adb7 --- /dev/null +++ b/FS/FS/part_export/infostreet.pm @@ -0,0 +1,83 @@ +package FS::part_export::infostreet; + +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my( $self, $svc_acct ) = (shift, shift); + $self->infostreet_queue( $svc_acct->svcnum, + 'createUser', $svc_acct->username, $svc_acct->password ); +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + return "can't change username with InfoStreet" + if $old->username ne $new->username; + return '' unless $old->_password ne $new->_password; + $self->infostreet_queue( $new->svcnum, + 'passwd', $new->username, $new->password ); +} + +sub _export_delete { + my( $self, $svc_acct ) = (shift, shift); + $self->infostreet_queue( $svc_acct->svcnum, + 'purgeAccount,releaseUsername', $svc_acct->username ); +} + +sub infostreet_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => 'FS::part_export::infostreet::infostreet_command', + }; + $queue->insert( + $self->option('url'), + $self->option('login'), + $self->option('password'), + $self->option('groupID'), + $method, + @_, + ); +} + +sub infostreet_command { #subroutine, not method + my($url, $username, $password, $groupID, $method, @args) = @_; + + #quelle hack + if ( $method =~ /,/ ) { + foreach my $part ( split(/,\s*/, $method) ) { + infostreet_command($url, $username, $password, $groupID, $part, @args); + } + return; + } + + eval "use Frontier::Client;"; + + my $conn = Frontier::Client->new( url => $url ); + my $key_result = $conn->call( 'authenticate', $username, $password, $groupID); + my %key_result = _infostreet_parse($key_result); + die $key_result{error} unless $key_result{success}; + my $key = $key_result{data}; + + my $result = $conn->call($method, $key, @args); + my %result = _infostreet_parse($result); + die $result{error} unless $result{success}; + +} + +sub _infostreet_parse { #subroutine, not method + my $arg = shift; + map { + my $value = $arg->{$_}; + #warn ref($value); + $value = $value->value() + if ref($value) && $value->isa('Frontier::RPC2::DataType'); + $_=>$value; + } keys %$arg; +} + + diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm new file mode 100644 index 000000000..fa2153f31 --- /dev/null +++ b/FS/FS/part_export/sqlradius.pm @@ -0,0 +1,198 @@ +package FS::part_export::sqlradius; + +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_acct) = (shift, shift); + + foreach my $table (qw(reply check)) { + my $method = "radius_$table"; + my %attrib = $svc_acct->$method; + next unless keys %attrib; + my $error = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', + $table, $svc_acct->username, %attrib ); + return $error if $error; + } + my @groups = $svc_acct->radius_groups; + if ( @groups ) { + my $error = $self->sqlradius_queue( $svc_acct->svcnum, 'usergroup_insert', + $svc_acct->username, @groups ); + return $error if $error; + } + ''; +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + + #return "can't (yet) change username with sqlradius" + # if $old->username ne $new->username; + if ( $old->username ne $new->username ) { + my $error = $self->sqlradius_queue( $new->svcnum, 'rename', + $new->username, $old->username ); + return $error if $error; + } + + foreach my $table (qw(reply check)) { + my $method = "radius_$table"; + my %new = $new->$method; + my %old = $old->$method; + if ( grep { !exists $old{$_} #new attributes + || $new{$_} ne $old{$_} #changed + } keys %new + ) { + my $error = $self->sqlradius_queue( $new->svcnum, 'insert', + $table, $new->username, %new ); + return $error if $error; + } + + my @del = grep { !exists $new{$_} } keys %old; + if ( @del ) { + my $error = $self->sqlradius_queue( $new->svcnum, 'attrib_delete', + $table, $new->username, @del ); + return $error if $error; + } + } + + # (sorta) false laziness with FS::svc_acct::replace + my @oldgroups = @{$old->usergroup}; #uuuh + my @newgroups = $new->radius_groups; + my @delgroups = (); + foreach my $oldgroup ( @oldgroups ) { + if ( grep { $oldgroup eq $_ } @newgroups ) { + @newgroups = grep { $oldgroup ne $_ } @newgroups; + next; + } + push @delgroups, $oldgroup; + } + + if ( @delgroups ) { + my $error = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete', + $new->username, @delgroups ); + return $error if $error; + } + + if ( @newgroups ) { + my $error = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert', + $new->username, @newgroups ); + return $error if $error; + } + + ''; +} + +sub _export_delete { + my( $self, $svc_acct ) = (shift, shift); + $self->sqlradius_queue( $svc_acct->svcnum, 'delete', + $svc_acct->username ); +} + +sub sqlradius_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::sqlradius::sqlradius_$method", + }; + $queue->insert( + $self->option('datasrc'), + $self->option('username'), + $self->option('password'), + @_, + ); +} + +sub sqlradius_insert { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my( $replycheck, $username, %attributes ) = @_; + + foreach my $attribute ( keys %attributes ) { + my $u_sth = $dbh->prepare( + "UPDATE rad$replycheck SET Value = ? WHERE UserName = ? AND Attribute = ?" ) or die $dbh->errstr; + my $i_sth = $dbh->prepare( + "INSERT INTO rad$replycheck ( id, UserName, Attribute, Value ) ". + "VALUES ( ?, ?, ?, ? )" + ) or die $dbh->errstr; + $u_sth->execute($attributes{$attribute}, $username, $attribute) > 0 + or $i_sth->execute( '', $username, $attribute, $attributes{$attribute} ) + or die "can't insert into rad$replycheck table: ". $i_sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_usergroup_insert { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my( $username, @groups ) = @_; + + my $sth = $dbh->prepare( + "INSERT INTO usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )" + ) or die $dbh->errstr; + foreach my $group ( @groups ) { + $sth->execute( '', $username, $group ) + or die "can't insert into groupname table: ". $sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_usergroup_delete { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my( $username, @groups ) = @_; + + my $sth = $dbh->prepare( + "DELETE FROM usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )" + ) or die $dbh->errstr; + foreach my $group ( @groups ) { + $sth->execute( '', $username, $group ) + or die "can't delete from groupname table: ". $sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_rename { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my($new_username, $old_username) = @_; + foreach my $table (qw(radreply radcheck usergroup )) { + my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?") + or die $dbh->errstr; + $sth->execute($new_username, $old_username) + or die "can't update $table: ". $sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_attrib_delete { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my( $replycheck, $username, @attrib ) = @_; + + foreach my $attribute ( @attrib ) { + my $sth = $dbh->prepare( + "DELETE FROM rad$replycheck WHERE UserName = ? AND Attribute = ?" ) + or die $dbh->errstr; + $sth->execute($username,$attribute) + or die "can't delete from rad$replycheck table: ". $sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_delete { #subroutine, not method + my $dbh = sqlradius_connect(shift, shift, shift); + my $username = shift; + + foreach my $table (qw( radcheck radreply usergroup )) { + my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" ); + $sth->execute($username) + or die "can't delete from $table table: ". $sth->errstr; + } + $dbh->disconnect; +} + +sub sqlradius_connect { + #my($datasrc, $username, $password) = @_; + #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; + DBI->connect(@_) or die $DBI::errstr; +} + diff --git a/FS/MANIFEST b/FS/MANIFEST index 54aaaa19f..8f7dfe591 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -45,6 +45,10 @@ FS/cust_refund.pm FS/cust_credit_refund.pm FS/cust_svc.pm FS/part_bill_event.pm +FS/part_export.pm +FS/part_export_option.pm +FS/part_export/infostreet.pm +FS/part_export/sqlradius.pm FS/part_pkg.pm FS/part_pop_local.pm FS/part_referral.pm @@ -94,6 +98,8 @@ t/nas.t t/part_bill_event.t t/part_export.t t/part_export_option.t +t/part_export-infostreet.t +t/part_export-sqlradius.t t/part_pkg.t t/part_pop_local.t t/part_referral.t diff --git a/fs_selfadmin/fs_mailadmin_server b/fs_selfadmin/fs_mailadmin_server index 1bcc42e5d..ef4788543 100755 --- a/fs_selfadmin/fs_mailadmin_server +++ b/fs_selfadmin/fs_mailadmin_server @@ -17,7 +17,7 @@ use vars qw( $opt $Debug $conf $default_domain ); $Debug = 1; -my @payby = qw(CARD PREPAY); +#my @payby = qw(CARD PREPAY); my $user = shift or die &usage; &adminsuidsetup( $user ); diff --git a/httemplate/docs/install.html b/httemplate/docs/install.html index 1a4942bc9..4370d9153 100644 --- a/httemplate/docs/install.html +++ b/httemplate/docs/install.html @@ -24,6 +24,7 @@ Before installing, you need:
  • Term-Query (make test broken; install manually)
  • MIME-Base64
  • Digest-MD5 +
  • MD5
  • URI
  • HTML-Tagset
  • HTML-Parser diff --git a/httemplate/edit/part_export.cgi b/httemplate/edit/part_export.cgi index 25e8f5be0..0ca964e02 100644 --- a/httemplate/edit/part_export.cgi +++ b/httemplate/edit/part_export.cgi @@ -87,7 +87,7 @@ my %exports = ( 'groupID' => { label=>'InfoStreet groupID', }, }, 'nodomain' => 'Y', - 'notes' => 'http://www.infostreet.com/ .... install Frontier::Client', + 'notes' => 'Real-time export to InfoStreet streetSmartAPI. Requires installation of Frontier::Client from CPAN.', } }, diff --git a/httemplate/index.html b/httemplate/index.html index c44b8e3db..fecd107cc 100644 --- a/httemplate/index.html +++ b/httemplate/index.html @@ -140,6 +140,8 @@ +
    SQL query: SELECT
    +
    -- 2.11.0