[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.844 and 1.845

version 1.844, 2007/03/03 02:16:10 version 1.845, 2007/03/08 01:54:50
Line 36  use HTTP::Date; Line 36  use HTTP::Date;
 # use Date::Parse;  # use Date::Parse;
 use vars   use vars 
 qw(%perlvar %badServerCache %iphost %spareid   qw(%perlvar %badServerCache %iphost %spareid 
    %libserv %pr %prp $memcache %packagetab      %pr %prp $memcache %packagetab 
    %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount      %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf     %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf
    %domaindescription %domain_auth_def %domain_auth_arg_def      %domaindescription %domain_auth_def %domain_auth_arg_def 
Line 2133  sub courseiddump { Line 2133  sub courseiddump {
     my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;      my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;
     my %returnhash=();      my %returnhash=();
     unless ($domfilter) { $domfilter=''; }      unless ($domfilter) { $domfilter=''; }
     foreach my $tryserver (keys %libserv) {      my %libserv = &all_library();
         if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) {      foreach my $tryserver (keys(%libserv)) {
     if ((!$domfilter) || (&host_domain($tryserver) eq $domfilter)) {          if ( (  $hostidflag == 1 
           && grep(/^\Q$tryserver\E$/,@{$hostidref}) ) 
        || (!defined($hostidflag)) ) {
   
       if ($domfilter eq ''
    || (&host_domain($tryserver) eq $domfilter)) {
         foreach my $line (          foreach my $line (
                  split(/\&/,&reply('courseiddump:'.&host_domain($tryserver).':'.                   split(/\&/,&reply('courseiddump:'.&host_domain($tryserver).':'.
        $sincefilter.':'.&escape($descfilter).':'.         $sincefilter.':'.&escape($descfilter).':'.
Line 4170  sub definerole { Line 4175  sub definerole {
 sub metadata_query {  sub metadata_query {
     my ($query,$custom,$customshow,$server_array)=@_;      my ($query,$custom,$customshow,$server_array)=@_;
     my %rhash;      my %rhash;
       my %libserv = &all_library();
     my @server_list = (defined($server_array) ? @$server_array      my @server_list = (defined($server_array) ? @$server_array
                                               : keys(%libserv) );                                                : keys(%libserv) );
     for my $server (@server_list) {      for my $server (@server_list) {
Line 5038  sub createcourse { Line 5044  sub createcourse {
    }     }
 # ------------------------------------------------ Check supplied server name  # ------------------------------------------------ Check supplied server name
     $course_server = $env{'user.homeserver'} if (! defined($course_server));      $course_server = $env{'user.homeserver'} if (! defined($course_server));
     if (! exists($libserv{$course_server})) {      if (! &is_library($course_server)) {
         return 'error:bad server name '.$course_server;          return 'error:bad server name '.$course_server;
     }      }
 # ------------------------------------------------------------- Make the course  # ------------------------------------------------------------- Make the course
Line 7593  BEGIN { Line 7599  BEGIN {
 {  {
     my %hostname;      my %hostname;
     my %hostdom;      my %hostdom;
       my %libserv;
     open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");      open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
Line 7614  BEGIN { Line 7621  BEGIN {
  my ($lonid) = @_;   my ($lonid) = @_;
  return $hostname{$lonid};   return $hostname{$lonid};
     }      }
   
     sub all_hostnames {      sub all_hostnames {
  return %hostname;   return %hostname;
     }      }
   
       sub is_library {
    return exists($libserv{$_[0]});
       }
   
       sub all_library {
    return %libserv;
       }
   
     sub get_servers {      sub get_servers {
  my ($domain,$type) = @_;   my ($domain,$type) = @_;
  my %possible_hosts = ($type eq 'library') ? %libserv   my %possible_hosts = ($type eq 'library') ? %libserv
Line 7637  BEGIN { Line 7654  BEGIN {
  }   }
  return %result;   return %result;
     }      }
   
     sub host_domain {      sub host_domain {
  my ($lonid) = @_;   my ($lonid) = @_;
  return $hostdom{$lonid};   return $hostdom{$lonid};
Removed from v.1.844  
changed lines
  Added in v.1.845

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>