--- loncom/lonnet/perl/lonnet.pm 2013/05/21 18:57:45 1.1223 +++ loncom/lonnet/perl/lonnet.pm 2013/07/25 19:11:12 1.1231 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1223 2013/05/21 18:57:45 raeburn Exp $ +# $Id: lonnet.pm,v 1.1231 2013/07/25 19:11:12 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1578,6 +1578,36 @@ sub idput { } } +# ---------------------------------------- Delete unwanted IDs from ids.db file + +sub iddel { + my ($udom,$idshashref,$uhome)=@_; + my %result=(); + unless (ref($idshashref) eq 'HASH') { + return %result; + } + my %servers=(); + while (my ($id,$uname) = each(%{$idshashref})) { + my $uhom; + if ($uhome) { + $uhom = $uhome; + } else { + $uhom=&homeserver($uname,$udom); + } + if ($uhom ne 'no_host') { + if ($servers{$uhom}) { + $servers{$uhom}.='&'.&escape($id); + } else { + $servers{$uhom}=&escape($id); + } + } + } + foreach my $server (keys(%servers)) { + $result{$server} = &critical('iddel:'.$udom.':'.$servers{$server},$uhome); + } + return %result; +} + # ------------------------------dump from db file owned by domainconfig user sub dump_dom { my ($namespace, $udom, $regexp) = @_; @@ -1985,13 +2015,16 @@ sub get_domain_defaults { $domdefaults{'defaultquota'} = $domconfig{'quotas'}{'defaultquota'}; } else { $domdefaults{'defaultquota'} = $domconfig{'quotas'}; - } + } my @usertools = ('aboutme','blog','webdav','portfolio'); foreach my $item (@usertools) { if (ref($domconfig{'quotas'}{$item}) eq 'HASH') { $domdefaults{$item} = $domconfig{'quotas'}{$item}; } } + if (ref($domconfig{'quotas'}{'authorquota'}) eq 'HASH') { + $domdefaults{'authorquota'} = $domconfig{'quotas'}{'authorquota'}; + } } if (ref($domconfig{'requestcourses'}) eq 'HASH') { foreach my $item ('official','unofficial','community') { @@ -2007,13 +2040,16 @@ sub get_domain_defaults { } } if (ref($domconfig{'coursedefaults'}) eq 'HASH') { - foreach my $item ('canuse_pdfforms') { - $domdefaults{$item} = $domconfig{'coursedefaults'}{$item}; - } + $domdefaults{'canuse_pdfforms'} = $domconfig{'coursedefaults'}{'canuse_pdfforms'}; if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') { $domdefaults{'officialcredits'} = $domconfig{'coursedefaults'}{'coursecredits'}{'official'}; $domdefaults{'unofficialcredits'} = $domconfig{'coursedefaults'}{'coursecredits'}{'unofficial'}; } + if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') { + $domdefaults{'officialquota'} = $domconfig{'coursedefaults'}{'uploadquota'}{'official'}; + $domdefaults{'unofficialquota'} = $domconfig{'coursedefaults'}{'uploadquota'}{'unofficial'}; + $domdefaults{'communityquota'} = $domconfig{'coursedefaults'}{'uploadquota'}{'community'}; + } } if (ref($domconfig{'usersessions'}) eq 'HASH') { if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') { @@ -4796,9 +4832,12 @@ sub restore { if ($stuname) { $home=&homeserver($stuname,$domain); } if (!$symb) { - unless ($symb=escape(&symbread())) { return ''; } + return if ($namespace eq 'courserequests'); + unless ($symb=escape(&symbread())) { return ''; } } else { - $symb=&escape(&symbclean($symb)); + unless ($namespace eq 'courserequests') { + $symb=&escape(&symbclean($symb)); + } } if (!$namespace) { unless ($namespace=$env{'request.course.id'}) { @@ -5495,7 +5534,7 @@ sub dump { if (grep { $_ eq $uhome } current_machine_ids()) { # user is hosted on this machine $reply = LONCAPA::Lond::dump_with_regexp(join(":", ($udomain, - $uname, $namespace, $regexp, $range)), $loncaparevs{$uhome}); + $uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'}); return %{unserialize($reply, $escapedkeys)}; } if ($regexp) { @@ -8766,6 +8805,9 @@ sub store_userdata { $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&'; } $namevalue=~s/\&$//; + unless ($namespace eq 'courserequests') { + $datakey = &escape($datakey); + } $result = &reply("store:$udom:$uname:$namespace:$datakey:". $namevalue,$uhome); } @@ -9616,7 +9658,7 @@ sub EXT_cache_set { # --------------------------------------------------------- Value of a Variable sub EXT { - my ($varname,$symbparm,$udom,$uname,$usection,$recurse)=@_; + my ($varname,$symbparm,$udom,$uname,$usection,$recurse,$cid)=@_; unless ($varname) { return ''; } #get real user name/domain, courseid and symb my $courseid; @@ -9749,8 +9791,11 @@ sub EXT { my ($section, $group, @groups); my ($courselevelm,$courselevel); - if ($symbparm && defined($courseid) && - $courseid eq $env{'request.course.id'}) { + if (($courseid eq '') && ($cid)) { + $courseid = $cid; + } + if (($symbparm && $courseid) && + (($courseid eq $env{'request.course.id'}) || ($courseid eq $cid))) { #print '
'.$space.' - '.$qualifier.' - '.$spacequalifierrest; @@ -12029,6 +12074,39 @@ sub all_loncaparevs { return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10); } +# ---------------------------------------------------------- Read loncaparev table +{ + sub load_loncaparevs { + if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") { + if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) { + while (my $configline=<$config>) { + chomp($configline); + my ($hostid,$loncaparev)=split(/:/,$configline); + $loncaparevs{$hostid}=$loncaparev; + } + close($config); + } + } + } +} + +# ---------------------------------------------------------- Read serverhostID table +{ + sub load_serverhomeIDs { + if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") { + if (open(my $config,"<$perlvar{'lonTabDir'}/serverhomeIDs.tab")) { + while (my $configline=<$config>) { + chomp($configline); + my ($name,$id)=split(/:/,$configline); + $serverhomeIDs{$name}=$id; + } + close($config); + } + } + } +} + + BEGIN { # ----------------------------------- Read loncapa.conf and loncapa_apache.conf @@ -12105,33 +12183,14 @@ BEGIN { } # ---------------------------------------------------------- Read loncaparev table -{ - if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") { - if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) { - while (my $configline=<$config>) { - chomp($configline); - my ($hostid,$loncaparev)=split(/:/,$configline); - $loncaparevs{$hostid}=$loncaparev; - } - close($config); - } - } -} + +&load_loncaparevs(); # ---------------------------------------------------------- Read serverhostID table -{ - if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") { - if (open(my $config,"<$perlvar{'lonTabDir'}/serverhomeIDs.tab")) { - while (my $configline=<$config>) { - chomp($configline); - my ($name,$id)=split(/:/,$configline); - $serverhomeIDs{$name}=$id; - } - close($config); - } - } -} +&load_serverhomeIDs(); + +# ---------------------------------------------------------- Read releaseslist XML { my $file = $Apache::lonnet::perlvar{'lonTabDir'}.'/releaseslist.xml'; if (-e $file) { @@ -12341,8 +12400,8 @@ were new keys. I.E. 1:foo will become 1: Calling convention: - my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname,$home); - &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname,$home); + my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname); + &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname); For more detailed information, see lonnet specific documentation. @@ -12833,10 +12892,15 @@ resource. Expects the local filesystem p =item * -EXT($varname,$symb,$udom,$uname) : evaluates and returns the value of -a vairety of different possible values, $varname should be a request -string, and the other parameters can be used to specify who and what -one is asking about. +EXT($varname,$symb,$udom,$uname,$usection,$recurse,$cid) : evaluates +and returns the value of a variety of different possible values, +$varname should be a request string, and the other parameters can be +used to specify who and what one is asking about. Ordinarily, $cid +does not need to be specified, as it is retrived from +$env{'request.course.id'}, but &Apache::lonnet::EXT() is called +within lonuserstate::loadmap() when initializing a course, before +$env{'request.course.id'} has been set, so it needs to be provided +in that one case. Possible values for $varname are environment.lastname (or other item from the envirnment hash), user.name (or someother aspect about the