version 1.1223, 2013/05/21 18:57:45
|
version 1.1237, 2013/09/01 22:39:48
|
Line 1578 sub idput {
|
Line 1578 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 |
# ------------------------------dump from db file owned by domainconfig user |
sub dump_dom { |
sub dump_dom { |
my ($namespace, $udom, $regexp) = @_; |
my ($namespace, $udom, $regexp) = @_; |
Line 1985 sub get_domain_defaults {
|
Line 2015 sub get_domain_defaults {
|
$domdefaults{'defaultquota'} = $domconfig{'quotas'}{'defaultquota'}; |
$domdefaults{'defaultquota'} = $domconfig{'quotas'}{'defaultquota'}; |
} else { |
} else { |
$domdefaults{'defaultquota'} = $domconfig{'quotas'}; |
$domdefaults{'defaultquota'} = $domconfig{'quotas'}; |
} |
} |
my @usertools = ('aboutme','blog','webdav','portfolio'); |
my @usertools = ('aboutme','blog','webdav','portfolio'); |
foreach my $item (@usertools) { |
foreach my $item (@usertools) { |
if (ref($domconfig{'quotas'}{$item}) eq 'HASH') { |
if (ref($domconfig{'quotas'}{$item}) eq 'HASH') { |
$domdefaults{$item} = $domconfig{'quotas'}{$item}; |
$domdefaults{$item} = $domconfig{'quotas'}{$item}; |
} |
} |
} |
} |
|
if (ref($domconfig{'quotas'}{'authorquota'}) eq 'HASH') { |
|
$domdefaults{'authorquota'} = $domconfig{'quotas'}{'authorquota'}; |
|
} |
} |
} |
if (ref($domconfig{'requestcourses'}) eq 'HASH') { |
if (ref($domconfig{'requestcourses'}) eq 'HASH') { |
foreach my $item ('official','unofficial','community') { |
foreach my $item ('official','unofficial','community') { |
Line 2007 sub get_domain_defaults {
|
Line 2040 sub get_domain_defaults {
|
} |
} |
} |
} |
if (ref($domconfig{'coursedefaults'}) eq 'HASH') { |
if (ref($domconfig{'coursedefaults'}) eq 'HASH') { |
foreach my $item ('canuse_pdfforms') { |
$domdefaults{'canuse_pdfforms'} = $domconfig{'coursedefaults'}{'canuse_pdfforms'}; |
$domdefaults{$item} = $domconfig{'coursedefaults'}{$item}; |
|
} |
|
if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') { |
if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') { |
$domdefaults{'officialcredits'} = $domconfig{'coursedefaults'}{'coursecredits'}{'official'}; |
$domdefaults{'officialcredits'} = $domconfig{'coursedefaults'}{'coursecredits'}{'official'}; |
$domdefaults{'unofficialcredits'} = $domconfig{'coursedefaults'}{'coursecredits'}{'unofficial'}; |
$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'}) eq 'HASH') { |
if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') { |
if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') { |
Line 2816 sub can_edit_resource {
|
Line 2852 sub can_edit_resource {
|
$cfile =~ s{^http://}{}; |
$cfile =~ s{^http://}{}; |
$cfile = '/adm/wrapper/ext/'.$cfile; |
$cfile = '/adm/wrapper/ext/'.$cfile; |
} |
} |
|
} elsif ($resurl =~ m{^/?adm/viewclasslist$}) { |
|
if ($env{'form.forceedit'}) { |
|
$forceview = 1; |
|
} else { |
|
$forceedit = 1; |
|
} |
|
$cfile = ($resurl =~ m{^/} ? $resurl : "/$resurl"); |
} |
} |
} |
} |
if ($uploaded || $incourse) { |
if ($uploaded || $incourse) { |
Line 4796 sub restore {
|
Line 4839 sub restore {
|
if ($stuname) { $home=&homeserver($stuname,$domain); } |
if ($stuname) { $home=&homeserver($stuname,$domain); } |
|
|
if (!$symb) { |
if (!$symb) { |
unless ($symb=escape(&symbread())) { return ''; } |
return if ($namespace eq 'courserequests'); |
|
unless ($symb=escape(&symbread())) { return ''; } |
} else { |
} else { |
$symb=&escape(&symbclean($symb)); |
unless ($namespace eq 'courserequests') { |
|
$symb=&escape(&symbclean($symb)); |
|
} |
} |
} |
if (!$namespace) { |
if (!$namespace) { |
unless ($namespace=$env{'request.course.id'}) { |
unless ($namespace=$env{'request.course.id'}) { |
Line 5495 sub dump {
|
Line 5541 sub dump {
|
if (grep { $_ eq $uhome } current_machine_ids()) { |
if (grep { $_ eq $uhome } current_machine_ids()) { |
# user is hosted on this machine |
# user is hosted on this machine |
$reply = LONCAPA::Lond::dump_with_regexp(join(":", ($udomain, |
$reply = LONCAPA::Lond::dump_with_regexp(join(":", ($udomain, |
$uname, $namespace, $regexp, $range)), $loncaparevs{$uhome}); |
$uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'}); |
return %{unserialize($reply, $escapedkeys)}; |
return %{unserialize($reply, $escapedkeys)}; |
} |
} |
if ($regexp) { |
if ($regexp) { |
Line 7244 sub definerole {
|
Line 7290 sub definerole {
|
# ---------------- Make a metadata query against the network of library servers |
# ---------------- Make a metadata query against the network of library servers |
|
|
sub metadata_query { |
sub metadata_query { |
my ($query,$custom,$customshow,$server_array)=@_; |
my ($query,$custom,$customshow,$server_array,$domains_hash)=@_; |
my %rhash; |
my %rhash; |
my %libserv = &all_library(); |
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) { |
|
my $domains = ''; |
|
if (ref($domains_hash) eq 'HASH') { |
|
$domains = $domains_hash->{$server}; |
|
} |
unless ($custom or $customshow) { |
unless ($custom or $customshow) { |
my $reply=&reply("querysend:".&escape($query),$server); |
my $reply=&reply("querysend:".&escape($query).':::'.&escape($domains),$server); |
$rhash{$server}=$reply; |
$rhash{$server}=$reply; |
} |
} |
else { |
else { |
my $reply=&reply("querysend:".&escape($query).':'. |
my $reply=&reply("querysend:".&escape($query).':'. |
&escape($custom).':'.&escape($customshow), |
&escape($custom).':'.&escape($customshow).':'.&escape($domains), |
$server); |
$server); |
$rhash{$server}=$reply; |
$rhash{$server}=$reply; |
} |
} |
Line 8455 sub modifystudent {
|
Line 8505 sub modifystudent {
|
$desiredhome,$email,$inststatus); |
$desiredhome,$email,$inststatus); |
unless ($reply eq 'ok') { return $reply; } |
unless ($reply eq 'ok') { return $reply; } |
# This will cause &modify_student_enrollment to get the uid from the |
# This will cause &modify_student_enrollment to get the uid from the |
# students environment |
# student's environment |
$uid = undef if (!$forceid); |
$uid = undef if (!$forceid); |
$reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last, |
$reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last, |
$gene,$usec,$end,$start,$type,$locktype, |
$gene,$usec,$end,$start,$type,$locktype, |
Line 8766 sub store_userdata {
|
Line 8816 sub store_userdata {
|
$namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&'; |
$namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&'; |
} |
} |
$namevalue=~s/\&$//; |
$namevalue=~s/\&$//; |
|
unless ($namespace eq 'courserequests') { |
|
$datakey = &escape($datakey); |
|
} |
$result = &reply("store:$udom:$uname:$namespace:$datakey:". |
$result = &reply("store:$udom:$uname:$namespace:$datakey:". |
$namevalue,$uhome); |
$namevalue,$uhome); |
} |
} |
Line 9588 sub resdata {
|
Line 9641 sub resdata {
|
return undef; |
return undef; |
} |
} |
|
|
|
sub get_numsuppfiles { |
|
my ($cnum,$cdom,$ignorecache)=@_; |
|
my $hashid=$cnum.':'.$cdom; |
|
my ($suppcount,$cached); |
|
unless ($ignorecache) { |
|
($suppcount,$cached) = &is_cached_new('suppcount',$hashid); |
|
} |
|
unless (defined($cached)) { |
|
my $chome=&homeserver($cnum,$cdom); |
|
unless ($chome eq 'no_host') { |
|
($suppcount,my $errors) = (0,0); |
|
my $suppmap = 'supplemental.sequence'; |
|
($suppcount,$errors) = |
|
&Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,$errors); |
|
} |
|
&do_cache_new('suppcount',$hashid,$suppcount,600); |
|
} |
|
return $suppcount; |
|
} |
|
|
# |
# |
# EXT resource caching routines |
# EXT resource caching routines |
# |
# |
Line 9616 sub EXT_cache_set {
|
Line 9689 sub EXT_cache_set {
|
# --------------------------------------------------------- Value of a Variable |
# --------------------------------------------------------- Value of a Variable |
sub EXT { |
sub EXT { |
|
|
my ($varname,$symbparm,$udom,$uname,$usection,$recurse)=@_; |
my ($varname,$symbparm,$udom,$uname,$usection,$recurse,$cid)=@_; |
unless ($varname) { return ''; } |
unless ($varname) { return ''; } |
#get real user name/domain, courseid and symb |
#get real user name/domain, courseid and symb |
my $courseid; |
my $courseid; |
Line 9731 sub EXT {
|
Line 9804 sub EXT {
|
if (!$symbparm) { $symbparm=&symbread(); } |
if (!$symbparm) { $symbparm=&symbread(); } |
} |
} |
|
|
if ($space eq 'title') { |
if ($qualifier eq '') { |
if (!$symbparm) { $symbparm = $env{'request.filename'}; } |
if ($space eq 'title') { |
return &gettitle($symbparm); |
if (!$symbparm) { $symbparm = $env{'request.filename'}; } |
} |
return &gettitle($symbparm); |
|
} |
|
|
if ($space eq 'map') { |
if ($space eq 'map') { |
my ($map) = &decode_symb($symbparm); |
my ($map) = &decode_symb($symbparm); |
return &symbread($map); |
return &symbread($map); |
} |
} |
if ($space eq 'filename') { |
if ($space eq 'maptitle') { |
if ($symbparm) { |
my ($map) = &decode_symb($symbparm); |
return &clutter((&decode_symb($symbparm))[2]); |
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 ($section, $group, @groups); |
my ($courselevelm,$courselevel); |
my ($courselevelm,$courselevel); |
if ($symbparm && defined($courseid) && |
if (($courseid eq '') && ($cid)) { |
$courseid eq $env{'request.course.id'}) { |
$courseid = $cid; |
|
} |
|
if (($symbparm && $courseid) && |
|
(($courseid eq $env{'request.course.id'}) || ($courseid eq $cid))) { |
|
|
#print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest; |
#print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest; |
|
|
Line 12029 sub all_loncaparevs {
|
Line 12127 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); |
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 { |
BEGIN { |
|
|
# ----------------------------------- Read loncapa.conf and loncapa_apache.conf |
# ----------------------------------- Read loncapa.conf and loncapa_apache.conf |
Line 12105 BEGIN {
|
Line 12236 BEGIN {
|
} |
} |
|
|
# ---------------------------------------------------------- Read loncaparev table |
# ---------------------------------------------------------- Read loncaparev table |
{ |
|
if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") { |
&load_loncaparevs(); |
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 |
# ---------------------------------------------------------- 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'; |
my $file = $Apache::lonnet::perlvar{'lonTabDir'}.'/releaseslist.xml'; |
if (-e $file) { |
if (-e $file) { |
Line 12341 were new keys. I.E. 1:foo will become 1:
|
Line 12453 were new keys. I.E. 1:foo will become 1:
|
|
|
Calling convention: |
Calling convention: |
|
|
my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname,$home); |
my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname); |
&Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname,$home); |
&Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname); |
|
|
For more detailed information, see lonnet specific documentation. |
For more detailed information, see lonnet specific documentation. |
|
|
Line 12609 or when Autoupdate.pl is run by cron in
|
Line 12721 or when Autoupdate.pl is run by cron in
|
modifystudent |
modifystudent |
|
|
modify a student's enrollment and identification information. |
modify a student's enrollment and identification information. |
The course id is resolved based on the current users environment. |
The course id is resolved based on the current user's environment. |
This means the envoking user must be a course coordinator or otherwise |
This means the invoking user must be a course coordinator or otherwise |
associated with a course. |
associated with a course. |
|
|
This call is essentially a wrapper for lonnet::modifyuser and |
This call is essentially a wrapper for lonnet::modifyuser and |
Line 12670 Inputs:
|
Line 12782 Inputs:
|
|
|
modify_student_enrollment |
modify_student_enrollment |
|
|
Change a students enrollment status in a class. The environment variable |
Change a student's enrollment status in a class. The environment variable |
'role.request.course' must be defined for this function to proceed. |
'role.request.course' must be defined for this function to proceed. |
|
|
Inputs: |
Inputs: |
|
|
=over 4 |
=over 4 |
|
|
=item $udom, students domain |
=item $udom, student's domain |
|
|
=item $uname, students name |
=item $uname, student's name |
|
|
=item $uid, students user id |
=item $uid, student's user id |
|
|
=item $first, students first name |
=item $first, student's first name |
|
|
=item $middle |
=item $middle |
|
|
Line 12765 If defined, the supplied username is use
|
Line 12877 If defined, the supplied username is use
|
resdata($name,$domain,$type,@which) : request for current parameter |
resdata($name,$domain,$type,@which) : request for current parameter |
setting for a specific $type, where $type is either 'course' or 'user', |
setting for a specific $type, where $type is either 'course' or 'user', |
@what should be a list of parameters to ask about. This routine caches |
@what should be a list of parameters to ask about. This routine caches |
answers for 5 minutes. |
answers for 10 minutes. |
|
|
=item * |
=item * |
|
|
Line 12774 data base, returning a hash that is keye
|
Line 12886 data base, returning a hash that is keye
|
values that are the resource value. I believe that the timestamps and |
values that are the resource value. I believe that the timestamps and |
versions are also returned. |
versions are also returned. |
|
|
|
get_numsuppfiles($cnum,$cdom) : retrieve number of files in a course's |
|
supplemental content area. This routine caches the number of files for |
|
10 minutes. |
|
|
=back |
=back |
|
|
=head2 Course Modification |
=head2 Course Modification |
Line 12833 resource. Expects the local filesystem p
|
Line 12949 resource. Expects the local filesystem p
|
|
|
=item * |
=item * |
|
|
EXT($varname,$symb,$udom,$uname) : evaluates and returns the value of |
EXT($varname,$symb,$udom,$uname,$usection,$recurse,$cid) : evaluates |
a vairety of different possible values, $varname should be a request |
and returns the value of a variety of different possible values, |
string, and the other parameters can be used to specify who and what |
$varname should be a request string, and the other parameters can be |
one is asking about. |
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 |
Possible values for $varname are environment.lastname (or other item |
from the envirnment hash), user.name (or someother aspect about the |
from the envirnment hash), user.name (or someother aspect about the |