--- loncom/lonnet/perl/lonnet.pm 2013/05/15 19:49:25 1.1172.2.24 +++ loncom/lonnet/perl/lonnet.pm 2013/08/04 03:00:12 1.1172.2.30 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.24 2013/05/15 19:49:25 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.30 2013/08/04 03:00:12 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1576,6 +1576,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) = @_; @@ -1983,13 +2013,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') { @@ -2009,6 +2042,11 @@ sub get_domain_defaults { $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') { @@ -4788,9 +4826,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'}) { @@ -5486,7 +5527,7 @@ sub dump { if (grep { $_ eq $uhome } ¤t_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) { @@ -8748,6 +8789,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); } @@ -9598,7 +9642,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; @@ -9713,26 +9757,51 @@ sub EXT { if (!$symbparm) { $symbparm=&symbread(); } } - if ($space eq 'title') { - if (!$symbparm) { $symbparm = $env{'request.filename'}; } - return &gettitle($symbparm); - } + if ($qualifier eq '') { + if ($space eq 'title') { + if (!$symbparm) { $symbparm = $env{'request.filename'}; } + return &gettitle($symbparm); + } - if ($space eq 'map') { - my ($map) = &decode_symb($symbparm); - return &symbread($map); - } - if ($space eq 'filename') { - if ($symbparm) { - return &clutter((&decode_symb($symbparm))[2]); + if ($space eq 'map') { + my ($map) = &decode_symb($symbparm); + return &symbread($map); + } + if ($space eq 'maptitle') { + my ($map) = &decode_symb($symbparm); + return &gettitle($map); + } + if ($space eq 'filename') { + if ($symbparm) { + return &clutter((&decode_symb($symbparm))[2]); + } + return &hreflocation('',$env{'request.filename'}); } - return &hreflocation('',$env{'request.filename'}); - } + + if ((defined($courseid)) && ($courseid eq $env{'request.course.id'}) && $symbparm) { + if ($space eq 'visibleparts') { + my $navmap = Apache::lonnavmaps::navmap->new(); + my $item; + if (ref($navmap)) { + my $res = $navmap->getBySymb($symbparm); + my $parts = $res->parts(); + if (ref($parts) eq 'ARRAY') { + $item = join(',',@{$parts}); + } + undef($navmap); + } + return $item; + } + } + } 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 '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest; @@ -10357,78 +10426,6 @@ sub gettitle { return $title; } -sub getdocspath { - my ($symb) = @_; - my $path; - if ($symb) { - my ($mapurl,$id,$resurl) = &decode_symb($symb); - if ($resurl=~/\.(sequence|page)$/) { - $mapurl=$resurl; - } elsif ($resurl eq 'adm/navmaps') { - $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'}; - } - my $mapresobj; - my $navmap = Apache::lonnavmaps::navmap->new(); - if (ref($navmap)) { - $mapresobj = $navmap->getResourceByUrl($mapurl); - } - $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1}; - my $type=$2; - if (ref($mapresobj)) { - my $pcslist = $mapresobj->map_hierarchy(); - if ($pcslist ne '') { - foreach my $pc (split(/,/,$pcslist)) { - next if ($pc <= 1); - my $res = $navmap->getByMapPc($pc); - if (ref($res)) { - my $thisurl = $res->src(); - $thisurl=~s{^.*/([^/]+)\.\w+$}{$1}; - my $thistitle = $res->title(); - $path .= '&'. - &Apache::lonhtmlcommon::entity_encode($thisurl).'&'. - &Apache::lonhtmlcommon::entity_encode($thistitle). - ':'.$res->randompick(). - ':'.$res->randomout(). - ':'.$res->encrypted(). - ':'.$res->randomorder(). - ':'.$res->is_page(); - } - } - } - $path =~ s/^\&//; - my $maptitle = $mapresobj->title(); - if ($mapurl eq 'default') { - $maptitle = 'Main Course Documents'; - } - $path .= ($path ne '')? '&' : ''. - &Apache::lonhtmlcommon::entity_encode($mapurl).'&'. - &Apache::lonhtmlcommon::entity_encode($maptitle). - ':'.$mapresobj->randompick(). - ':'.$mapresobj->randomout(). - ':'.$mapresobj->encrypted(). - ':'.$mapresobj->randomorder(). - ':'.$mapresobj->is_page(); - } else { - my $maptitle = &gettitle($mapurl); - my $ispage; - if ($mapurl =~ /\.page$/) { - $ispage = 1; - } - if ($mapurl eq 'default') { - $maptitle = 'Main Course Documents'; - } - $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'. - &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage; - } - unless ($mapurl eq 'default') { - $path = 'default&'. - &Apache::lonhtmlcommon::entity_encode('Main Course Documents'). - ':::::&'.$path; - } - } - return $path; -} - sub get_slot { my ($which,$cnum,$cdom)=@_; if (!$cnum || !$cdom) { @@ -12082,6 +12079,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 @@ -12157,34 +12187,15 @@ BEGIN { close($config); } -# ---------------------------------------------------------- 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); - } - } -} +# --------------------------------------------------------- Read loncaparev table -# ---------------------------------------------------------- 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_loncaparevs(); + +# ------------------------------------------------------- Read serverhostID table + +&load_serverhomeIDs(); +# ---------------------------------------------------------- Read releaseslist XML { my $file = $Apache::lonnet::perlvar{'lonTabDir'}.'/releaseslist.xml'; if (-e $file) { @@ -12394,8 +12405,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. @@ -12886,10 +12897,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