version 1.1172.2.28, 2013/06/27 18:34:21
|
version 1.1172.2.34, 2013/09/02 14:41:53
|
Line 1576 sub idput {
|
Line 1576 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 1983 sub get_domain_defaults {
|
Line 2013 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 2009 sub get_domain_defaults {
|
Line 2042 sub get_domain_defaults {
|
$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 2808 sub can_edit_resource {
|
Line 2846 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 4339 sub set_first_access {
|
Line 4384 sub set_first_access {
|
return 'already_set'; |
return 'already_set'; |
} |
} |
} |
} |
|
|
|
sub checkout { |
|
my ($symb,$tuname,$tudom,$tcrsid)=@_; |
|
my $now=time; |
|
my $lonhost=$perlvar{'lonHostID'}; |
|
my $infostr=&escape( |
|
'CHECKOUTTOKEN&'. |
|
$tuname.'&'. |
|
$tudom.'&'. |
|
$tcrsid.'&'. |
|
$symb.'&'. |
|
$now.'&'.$ENV{'REMOTE_ADDR'}); |
|
my $token=&reply('tmpput:'.$infostr,$lonhost); |
|
if ($token=~/^error\:/) { |
|
&logthis("<font color=\"blue\">WARNING: ". |
|
"Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb. |
|
"</font>"); |
|
return ''; |
|
} |
|
|
|
$token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/; |
|
$token=~tr/a-z/A-Z/; |
|
|
|
my %infohash=('resource.0.outtoken' => $token, |
|
'resource.0.checkouttime' => $now, |
|
'resource.0.outremote' => $ENV{'REMOTE_ADDR'}); |
|
|
|
unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { |
|
return ''; |
|
} else { |
|
&logthis("<font color=\"blue\">WARNING: ". |
|
"Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb. |
|
"</font>"); |
|
} |
|
|
|
if (&log($tudom,$tuname,&homeserver($tuname,$tudom), |
|
&escape('Checkout '.$infostr.' - '. |
|
$token)) ne 'ok') { |
|
return ''; |
|
} else { |
|
&logthis("<font color=\"blue\">WARNING: ". |
|
"Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb. |
|
"</font>"); |
|
} |
|
return $token; |
|
} |
|
|
|
# ------------------------------------------------------------ Check in an item |
|
|
|
sub checkin { |
|
my $token=shift; |
|
my $now=time; |
|
my ($ta,$tb,$lonhost)=split(/\*/,$token); |
|
$lonhost=~tr/A-Z/a-z/; |
|
my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb; |
|
$dtoken=~s/\W/\_/g; |
|
my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)= |
|
split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost))); |
|
|
|
unless (($tuname) && ($tudom)) { |
|
&logthis('Check in '.$token.' ('.$dtoken.') failed'); |
|
return ''; |
|
} |
|
|
|
unless (&allowed('mgr',$tcrsid)) { |
|
&logthis('Check in '.$token.' ('.$dtoken.') unauthorized: '. |
|
$env{'user.name'}.' - '.$env{'user.domain'}); |
|
return ''; |
|
} |
|
|
|
my %infohash=('resource.0.intoken' => $token, |
|
'resource.0.checkintime' => $now, |
|
'resource.0.inremote' => $ENV{'REMOTE_ADDR'}); |
|
|
|
unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { |
|
return ''; |
|
} |
|
|
|
if (&log($tudom,$tuname,&homeserver($tuname,$tudom), |
|
&escape('Checkin - '.$token)) ne 'ok') { |
|
return ''; |
|
} |
|
|
|
return ($symb,$tuname,$tudom,$tcrsid); |
|
} |
|
|
# --------------------------------------------- Set Expire Date for Spreadsheet |
# --------------------------------------------- Set Expire Date for Spreadsheet |
|
|
sub expirespread { |
sub expirespread { |
Line 7229 sub definerole {
|
Line 7360 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 8440 sub modifystudent {
|
Line 8575 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 9576 sub resdata {
|
Line 9711 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 9719 sub EXT {
|
Line 9874 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 ($symbparm) { |
|
return &clutter((&decode_symb($symbparm))[2]); |
|
} |
} |
return &hreflocation('',$env{'request.filename'}); |
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'}); |
|
} |
|
|
|
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); |
Line 11600 sub parse_dns_checksums_tab {
|
Line 11777 sub parse_dns_checksums_tab {
|
my (%chksum,%revnum); |
my (%chksum,%revnum); |
if (ref($lines) eq 'ARRAY') { |
if (ref($lines) eq 'ARRAY') { |
chomp(@{$lines}); |
chomp(@{$lines}); |
my $versions = shift(@{$lines}); |
my $version = shift(@{$lines}); |
my %supported; |
if ($version eq $release) { |
if ($versions =~ /^VERSIONS\:([\w\.\,]+)$/) { |
|
my $releaseslist = $1; |
|
if ($releaseslist =~ /,/) { |
|
map { $supported{$_} = 1; } split(/,/,$releaseslist); |
|
} elsif ($releaseslist) { |
|
$supported{$releaseslist} = 1; |
|
} |
|
} |
|
if ($supported{$release}) { |
|
my $matchthis = 0; |
|
foreach my $line (@{$lines}) { |
foreach my $line (@{$lines}) { |
if ($line =~ /^(\d[\w\.]+)$/) { |
my ($file,$version,$shasum) = split(/,/,$line); |
if ($matchthis) { |
$chksum{$file} = $shasum; |
last; |
$revnum{$file} = $version; |
} elsif ($1 eq $release) { |
|
$matchthis = 1; |
|
} |
|
} elsif ($matchthis) { |
|
my ($file,$version,$shasum) = split(/,/,$line); |
|
$chksum{$file} = $shasum; |
|
$revnum{$file} = $version; |
|
} |
|
} |
} |
if (ref($hashref) eq 'HASH') { |
if (ref($hashref) eq 'HASH') { |
%{$hashref} = ( |
%{$hashref} = ( |
Line 11638 sub parse_dns_checksums_tab {
|
Line 11797 sub parse_dns_checksums_tab {
|
|
|
sub fetch_dns_checksums { |
sub fetch_dns_checksums { |
my %checksums; |
my %checksums; |
&get_dns('/adm/dns/checksums',\&parse_dns_checksums_tab,1,1, |
my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'}); |
|
my $loncaparev = &get_server_loncaparev($machine_dom); |
|
my ($release,$timestamp) = split(/\-/,$loncaparev); |
|
&get_dns("/adm/dns/checksums/$release",\&parse_dns_checksums_tab,1,1, |
\%checksums); |
\%checksums); |
return \%checksums; |
return \%checksums; |
} |
} |
Line 12613 or when Autoupdate.pl is run by cron in
|
Line 12775 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 12674 Inputs:
|
Line 12836 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 12769 If defined, the supplied username is use
|
Line 12931 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 12778 data base, returning a hash that is keye
|
Line 12940 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 |