[LON-CAPA-cvs] cvs: loncom /interface loncommon.pm loncreateuser.pm londropadd.pm portfolio.pm /lonnet/perl lonnet.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Sat, 03 Mar 2007 01:33:21 -0000
This is a MIME encoded message
--albertel1172885601
Content-Type: text/plain
albertel Fri Mar 2 20:33:21 2007 EDT
Modified files:
/loncom/lonnet/perl lonnet.pm
/loncom/interface loncommon.pm loncreateuser.pm londropadd.pm
portfolio.pm
Log:
- reduce usage of libserv and host dom,
- mode the domain fetching routines to lonnet
--albertel1172885601
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20070302203321.txt"
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.840 loncom/lonnet/perl/lonnet.pm:1.841
--- loncom/lonnet/perl/lonnet.pm:1.840 Fri Mar 2 18:53:19 2007
+++ loncom/lonnet/perl/lonnet.pm Fri Mar 2 20:33:10 2007
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.840 2007/03/02 23:53:19 albertel Exp $
+# $Id: lonnet.pm,v 1.841 2007/03/03 01:33:10 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -640,19 +640,19 @@
my $index="$uname:$udom";
if (exists($homecache{$index})) { return $homecache{$index}; }
- my $tryserver;
- foreach $tryserver (keys %libserv) {
+
+ my %servers = &get_servers($udom,'library');
+ foreach my $tryserver (keys(%servers)) {
next if ($ignoreBadCache ne 'true' &&
exists($badServerCache{$tryserver}));
- if ($hostdom{$tryserver} eq $udom) {
- my $answer=reply("home:$udom:$uname",$tryserver);
- if ($answer eq 'found') {
- delete($badServerCache{$tryserver});
- return $homecache{$index}=$tryserver;
- } elsif ($answer eq 'no_host') {
- $badServerCache{$tryserver}=1;
- }
- }
+
+ my $answer=reply("home:$udom:$uname",$tryserver);
+ if ($answer eq 'found') {
+ delete($badServerCache{$tryserver});
+ return $homecache{$index}=$tryserver;
+ } elsif ($answer eq 'no_host') {
+ $badServerCache{$tryserver}=1;
+ }
}
return 'no_host';
}
@@ -663,24 +663,22 @@
my ($udom,@ids)=@_;
my %returnhash=();
- my $tryserver;
- foreach $tryserver (keys %libserv) {
- if ($hostdom{$tryserver} eq $udom) {
- my $idlist=join('&',@ids);
- $idlist=~tr/A-Z/a-z/;
- my $reply=&reply("idget:$udom:".$idlist,$tryserver);
- my @answer=();
- if (($reply ne 'con_lost') && ($reply!~/^error\:/)) {
- @answer=split(/\&/,$reply);
- } ;
- my $i;
- for ($i=0;$i<=$#ids;$i++) {
- if ($answer[$i]) {
- $returnhash{$ids[$i]}=$answer[$i];
- }
- }
- }
- }
+ my %servers = &get_servers($udom,'library');
+ foreach my $tryserver (keys(%servers)) {
+ my $idlist=join('&',@ids);
+ $idlist=~tr/A-Z/a-z/;
+ my $reply=&reply("idget:$udom:".$idlist,$tryserver);
+ my @answer=();
+ if (($reply ne 'con_lost') && ($reply!~/^error\:/)) {
+ @answer=split(/\&/,$reply);
+ } ;
+ my $i;
+ for ($i=0;$i<=$#ids;$i++) {
+ if ($answer[$i]) {
+ $returnhash{$ids[$i]}=$answer[$i];
+ }
+ }
+ }
return %returnhash;
}
@@ -1912,13 +1910,12 @@
delete $domainrolehash{$entry};
}
foreach my $dom (keys(%domrolebuffer)) {
- foreach my $tryserver (keys %libserv) {
- if ($hostdom{$tryserver} eq $dom) {
- unless (&reply('domroleput:'.$dom.':'.
- $domrolebuffer{$dom},$tryserver) eq 'ok') {
- &logthis('Put of domain roles failed for '.$dom.' and '.$tryserver);
- }
- }
+ my %servers = &get_servers($dom,'library');
+ foreach my $tryserver (keys(%servers)) {
+ unless (&reply('domroleput:'.$dom.':'.
+ $domrolebuffer{$dom},$tryserver) eq 'ok') {
+ &logthis('Put of domain roles failed for '.$dom.' and '.$tryserver);
+ }
}
}
$dumpcount++;
@@ -2194,19 +2191,19 @@
}
my $rolelist = join(':',@{$roles});
my %personnel = ();
- foreach my $tryserver (keys(%libserv)) {
- if ($hostdom{$tryserver} eq $dom) {
- %{$personnel{$tryserver}}=();
- foreach my $line (
- split(/\&/,&reply('domrolesdump:'.$dom.':'.
- &escape($startdate).':'.&escape($enddate).':'.
- &escape($rolelist), $tryserver))) {
- my ($key,$value) = split(/\=/,$line,2);
- if (($key) && ($value)) {
- $personnel{$tryserver}{&unescape($key)} = &unescape($value);
- }
- }
- }
+
+ my %servers = &get_servers($dom,'library');
+ foreach my $tryserver (keys(%servers)) {
+ %{$personnel{$tryserver}}=();
+ foreach my $line (split(/\&/,&reply('domrolesdump:'.$dom.':'.
+ &escape($startdate).':'.
+ &escape($enddate).':'.
+ &escape($rolelist), $tryserver))) {
+ my ($key,$value) = split(/\=/,$line,2);
+ if (($key) && ($value)) {
+ $personnel{$tryserver}{&unescape($key)} = &unescape($value);
+ }
+ }
}
return %personnel;
}
@@ -4459,12 +4456,11 @@
my $courses = '';
my @homeservers;
if ($caller eq 'global') {
- foreach my $tryserver (keys(%libserv)) {
- if ($hostdom{$tryserver} eq $codedom) {
- if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
- push(@homeservers,$tryserver);
- }
- }
+ my %servers = &get_servers($codedom,'library');
+ foreach my $tryserver (keys(%servers)) {
+ if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
+ push(@homeservers,$tryserver);
+ }
}
} else {
push(@homeservers,&homeserver($caller,$codedom));
@@ -4498,35 +4494,31 @@
sub auto_instcode_defaults {
my ($domain,$returnhash,$code_order) = @_;
my @homeservers;
- foreach my $tryserver (keys(%libserv)) {
- if ($hostdom{$tryserver} eq $domain) {
- if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
- push(@homeservers,$tryserver);
- }
- }
+
+ my %servers = &get_servers($domain,'library');
+ foreach my $tryserver (keys(%servers)) {
+ if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
+ push(@homeservers,$tryserver);
+ }
}
- my $ok_response = 0;
+
my $response;
- while (@homeservers > 0 && $ok_response == 0) {
- my $server = shift(@homeservers);
+ foreach my $server (@homeservers) {
$response=&reply('autoinstcodedefaults:'.$domain,$server);
- if ($response !~ /(con_lost|error|no_such_host|refused)/) {
- foreach my $pair (split(/\&/,$response)) {
- my ($name,$value)=split(/\=/,$pair);
- if ($name eq 'code_order') {
- @{$code_order} = split(/\&/,&unescape($value));
- } else {
- $returnhash->{&unescape($name)}=&unescape($value);
- }
- }
- $ok_response = 1;
- }
- }
- if ($ok_response) {
- return 'ok';
- } else {
- return $response;
+ next if ($response =~ /(con_lost|error|no_such_host|refused)/);
+
+ foreach my $pair (split(/\&/,$response)) {
+ my ($name,$value)=split(/\=/,$pair);
+ if ($name eq 'code_order') {
+ @{$code_order} = split(/\&/,&unescape($value));
+ } else {
+ $returnhash->{&unescape($name)}=&unescape($value);
+ }
+ }
+ return 'ok';
}
+
+ return $response;
}
sub auto_validate_class_sec {
@@ -4824,16 +4816,14 @@
} elsif($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom) {
$unhome=$env{'course.'.$env{'request.course.id'}.'.home'};
} else { # load balancing routine for determining $unhome
- my $tryserver;
my $loadm=10000000;
- foreach $tryserver (keys %libserv) {
- if ($hostdom{$tryserver} eq $udom) {
- my $answer=reply('load',$tryserver);
- if (($answer=~/\d+/) && ($answer<$loadm)) {
- $loadm=$answer;
- $unhome=$tryserver;
- }
- }
+ my %servers = &get_servers($udom,'library');
+ foreach my $tryserver (keys(%servers)) {
+ my $answer=reply('load',$tryserver);
+ if (($answer=~/\d+/) && ($answer<$loadm)) {
+ $loadm=$answer;
+ $unhome=$tryserver;
+ }
}
}
if (($unhome eq '') || ($unhome eq 'no_host')) {
@@ -5581,28 +5571,27 @@
return @listing_results;
} elsif(!defined($alternateDirectoryRoot)) {
my %allusers;
- foreach my $tryserver (keys(%libserv)) {
- if($hostdom{$tryserver} eq $udom) {
- my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
- $udom, $tryserver);
- my @listing_results;
- if ($listing eq 'unknown_cmd') {
- $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
- $udom, $tryserver);
- @listing_results = split(/:/,$listing);
- } else {
- @listing_results =
- map { &unescape($_); } split(/:/,$listing);
- }
- if ($listing_results[0] ne 'no_such_dir' &&
- $listing_results[0] ne 'empty' &&
- $listing_results[0] ne 'con_lost') {
- foreach my $line (@listing_results) {
- my ($entry) = split(/&/,$line,2);
- $allusers{$entry} = 1;
- }
- }
- }
+ my %servers = &get_servers($udom,'library');
+ foreach my $tryserver (keys(%servers)) {
+ my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
+ $udom, $tryserver);
+ my @listing_results;
+ if ($listing eq 'unknown_cmd') {
+ $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
+ $udom, $tryserver);
+ @listing_results = split(/:/,$listing);
+ } else {
+ @listing_results =
+ map { &unescape($_); } split(/:/,$listing);
+ }
+ if ($listing_results[0] ne 'no_such_dir' &&
+ $listing_results[0] ne 'empty' &&
+ $listing_results[0] ne 'con_lost') {
+ foreach my $line (@listing_results) {
+ my ($entry) = split(/&/,$line,2);
+ $allusers{$entry} = 1;
+ }
+ }
}
my $alluserstr='';
foreach my $user (sort(keys(%allusers))) {
@@ -5614,18 +5603,12 @@
return ('missing user name');
}
} elsif(!defined($alternateDirectoryRoot)) {
- my $tryserver;
- my %alldom=();
- foreach $tryserver (keys(%libserv)) {
- $alldom{$hostdom{$tryserver}}=1;
- }
- my $alldomstr='';
- foreach my $domain (sort(keys(%alldom))) {
- $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain:';
- }
- $alldomstr=~s/:$//;
- return split(/:/,$alldomstr);
- } else {
+ my @all_domains = sort(&all_domains());
+ foreach my $domain (@all_domains) {
+ $domain = $perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain';
+ }
+ return @all_domains;
+ } else {
return ('missing domain');
}
}
@@ -7633,6 +7616,23 @@
sub all_hostnames {
return %hostname;
}
+ sub get_servers {
+ my ($domain,$type) = @_;
+ my %possible_hosts = ($type eq 'library') ? %libserv
+ : %hostname;
+ my %result;
+ while ( my ($host,$hostname) = each(%possible_hosts)) {
+ if ($hostdom{$host} eq $domain) {
+ $result{$host} = $hostname;
+ }
+ }
+ return %result;
+ }
+ sub all_domains {
+ my %seen;
+ my @uniq = grep(!$seen{$_}++, values(%hostdom));
+ return @uniq;
+ }
}
sub get_hosts_from_ip {
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.511 loncom/interface/loncommon.pm:1.512
--- loncom/interface/loncommon.pm:1.511 Fri Mar 2 18:17:58 2007
+++ loncom/interface/loncommon.pm Fri Mar 2 20:33:20 2007
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.511 2007/03/02 23:17:58 albertel Exp $
+# $Id: loncommon.pm,v 1.512 2007/03/03 01:33:20 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1265,37 +1265,13 @@
## Home server <option> list generating code ##
###############################################################
-=pod
-
-=head1 Home Server option list generating code
-
-=over 4
-
-=item * get_domains()
-
-Returns an array containing each of the domains listed in the hosts.tab
-file.
-
-=cut
-
-#-------------------------------------------
-sub get_domains {
- # The code below was stolen from "The Perl Cookbook", p 102, 1st ed.
- my @domains;
- my %seen;
- foreach my $dom (sort(values(%Apache::lonnet::hostdom))) {
- push(@domains,$dom) unless $seen{$dom}++;
- }
- return @domains;
-}
-
# ------------------------------------------
sub domain_select {
my ($name,$value,$multiple)=@_;
my %domains=map {
$_ => $_.' '.$Apache::lonnet::domaindescription{$_}
- } &get_domains;
+ } &Apache::lonnet::all_domains();
if ($multiple) {
$domains{''}=&mt('Any domain');
return &multiple_select_form($name,$value,4,\%domains);
@@ -1459,7 +1435,7 @@
#-------------------------------------------
sub select_dom_form {
my ($defdom,$name,$includeempty) = @_;
- my @domains = get_domains();
+ my @domains = &Apache::lonnet::all_domains();
if ($includeempty) { @domains=('',@domains); }
my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
foreach my $dom (@domains) {
@@ -1485,14 +1461,7 @@
#-------------------------------------------
sub get_library_servers {
- my $domain = shift;
- my %library_servers;
- foreach my $hostid (keys(%Apache::lonnet::libserv)) {
- if ($Apache::lonnet::hostdom{$hostid} eq $domain) {
- $library_servers{$hostid} = &Apache::lonnet::hostname($hostid);
- }
- }
- return %library_servers;
+ return &Apache::lonnet::get_servers($_[0],'library');
}
#-------------------------------------------
Index: loncom/interface/loncreateuser.pm
diff -u loncom/interface/loncreateuser.pm:1.145 loncom/interface/loncreateuser.pm:1.146
--- loncom/interface/loncreateuser.pm:1.145 Tue Jan 16 15:09:49 2007
+++ loncom/interface/loncreateuser.pm Fri Mar 2 20:33:21 2007
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Create a user
#
-# $Id: loncreateuser.pm,v 1.145 2007/01/16 20:09:49 raeburn Exp $
+# $Id: loncreateuser.pm,v 1.146 2007/03/03 01:33:21 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -135,7 +135,6 @@
sub print_username_entry_form {
my ($r) = @_;
my $defdom=$env{'request.role.domain'};
- my @domains = &Apache::loncommon::get_domains();
my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');
my $selscript=&Apache::loncommon::studentbrowser_javascript();
my $start_page =
@@ -454,11 +453,7 @@
<input type="hidden" name="pres_marker" value="" >
ENDFORMINFO
my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
- my %incdomains;
my %inccourses;
- foreach my $item (values(%Apache::lonnet::hostdom)) {
- $incdomains{$item}=1;
- }
foreach my $key (keys(%env)) {
if ($key=~/^user\.priv\.cm\.\/($match_domain)\/($match_username)/) {
$inccourses{$1.'_'.$2}=1;
@@ -932,7 +927,7 @@
&mt('Extent').'</th>'.
'<th>'.&mt('Start').'</th><th>'.&mt('End').'</th>'.
&Apache::loncommon::end_data_table_header_row();
- foreach my $thisdomain ( sort( keys(%incdomains))) {
+ foreach my $thisdomain (sort(&Apache::lonnet::all_domains())) {
foreach my $role ('dc','li','dg','au','sc') {
if (&Apache::lonnet::allowed('c'.$role,$thisdomain)) {
my $plrole=&Apache::lonnet::plaintext($role);
Index: loncom/interface/londropadd.pm
diff -u loncom/interface/londropadd.pm:1.155 loncom/interface/londropadd.pm:1.156
--- loncom/interface/londropadd.pm:1.155 Wed Jan 10 16:37:50 2007
+++ loncom/interface/londropadd.pm Fri Mar 2 20:33:21 2007
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to drop and add students in courses
#
-# $Id: londropadd.pm,v 1.155 2007/01/10 21:37:50 www Exp $
+# $Id: londropadd.pm,v 1.156 2007/03/03 01:33:21 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -106,7 +106,7 @@
# Set up domain and server selection forms
#
# Get the domains
- my @domains = &Apache::loncommon::get_domains();
+ my @domains = &Apache::lonnet::all_domains();
# build up the menu information to be passed to
# &Apache::loncommon::linked_select_forms
my %select_menus;
Index: loncom/interface/portfolio.pm
diff -u loncom/interface/portfolio.pm:1.176 loncom/interface/portfolio.pm:1.177
--- loncom/interface/portfolio.pm:1.176 Mon Jan 29 16:18:53 2007
+++ loncom/interface/portfolio.pm Fri Mar 2 20:33:21 2007
@@ -1,7 +1,7 @@
# The LearningOnline Network
# portfolio browser
#
-# $Id: portfolio.pm,v 1.176 2007/01/29 21:18:53 albertel Exp $
+# $Id: portfolio.pm,v 1.177 2007/03/03 01:33:21 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1347,7 +1347,7 @@
'</th>');
$colspan ++;
} elsif ($type eq 'domains') {
- @all_doms = &Apache::loncommon::get_domains();
+ @all_doms = &Apache::lonnet::all_domains();
}
$r->print(&Apache::loncommon::end_data_table_header_row());
foreach my $key (@{$items}) {
--albertel1172885601--