|
version 1.296, 2002/10/10 14:34:05
|
version 1.304, 2002/12/04 15:23:39
|
|
Line 77 use Apache::File;
|
Line 77 use Apache::File;
|
| use LWP::UserAgent(); |
use LWP::UserAgent(); |
| use HTTP::Headers; |
use HTTP::Headers; |
| use vars |
use vars |
| qw(%perlvar %hostname %homecache %badServerCache %hostip %spareid %hostdom |
qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom |
| %libserv %pr %prp %metacache %packagetab |
%libserv %pr %prp %metacache %packagetab %titlecache |
| %courselogs %accesshash $processmarker $dumpcount |
%courselogs %accesshash $processmarker $dumpcount |
| %coursedombuf %coursehombuf %courseresdatacache %domaindescription); |
%coursedombuf %coursehombuf %courseresdatacache %domaindescription); |
| use IO::Socket; |
use IO::Socket; |
|
Line 593 sub idput {
|
Line 593 sub idput {
|
| |
|
| # ------------------------------------- Find the section of student in a course |
# ------------------------------------- Find the section of student in a course |
| |
|
| |
sub getsection { |
| |
my ($udom,$unam,$courseid)=@_; |
| |
$courseid=~s/\_/\//g; |
| |
$courseid=~s/^(\w)/\/$1/; |
| |
my %Pending; |
| |
my %Expired; |
| |
# |
| |
# Each role can either have not started yet (pending), be active, |
| |
# or have expired. |
| |
# |
| |
# If there is an active role, we are done. |
| |
# |
| |
# If there is more than one role which has not started yet, |
| |
# choose the one which will start sooner |
| |
# If there is one role which has not started yet, return it. |
| |
# |
| |
# If there is more than one expired role, choose the one which ended last. |
| |
# If there is a role which has expired, return it. |
| |
# |
| |
foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles', |
| |
&homeserver($unam,$udom)))) { |
| |
my ($key,$value)=split(/\=/,$_); |
| |
$key=&unescape($key); |
| |
next if ($key !~/^$courseid(?:\/)*(\w+)*\_st$/); |
| |
my $section=$1; |
| |
if ($key eq $courseid.'_st') { $section=''; } |
| |
my ($dummy,$end,$start)=split(/\_/,&unescape($value)); |
| |
my $now=time; |
| |
if (defined($end) && ($now > $end)) { |
| |
$Expired{$end}=$section; |
| |
next; |
| |
} |
| |
if (defined($start) && ($now < $start)) { |
| |
$Pending{$start}=$section; |
| |
next; |
| |
} |
| |
return $section; |
| |
} |
| |
# |
| |
# Presumedly there will be few matching roles from the above |
| |
# loop and the sorting time will be negligible. |
| |
if (scalar(keys(%Pending))) { |
| |
my ($time) = sort {$a <=> $b} keys(%Pending); |
| |
return $Pending{$time}; |
| |
} |
| |
if (scalar(keys(%Expired))) { |
| |
my @sorted = sort {$a <=> $b} keys(%Expired); |
| |
my $time = pop(@sorted); |
| |
return $Expired{$time}; |
| |
} |
| |
return '-1'; |
| |
} |
| |
|
| sub usection { |
sub usection { |
| my ($udom,$unam,$courseid)=@_; |
my ($udom,$unam,$courseid)=@_; |
| $courseid=~s/\_/\//g; |
$courseid=~s/\_/\//g; |
|
Line 787 sub tokenwrapper {
|
Line 840 sub tokenwrapper {
|
| if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) { |
if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) { |
| &appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'}); |
&appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'}); |
| return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri. |
return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri. |
| (($uri=~/\?/)?'&':'?').'token='.$token; |
(($uri=~/\?/)?'&':'?').'token='.$token. |
| |
'&tokenissued='.$perlvar{'lonHostID'}; |
| } else { |
} else { |
| return '/adm/notfound.html'; |
return '/adm/notfound.html'; |
| } |
} |
|
Line 1050 sub devalidate {
|
Line 1104 sub devalidate {
|
| if ($cid) { |
if ($cid) { |
| my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':'; |
my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':'; |
| my $status= |
my $status= |
| &del('nohist_calculatedsheet', |
&del('nohist_calculatedsheets', |
| [$key.'studentcalc'], |
[$key.'studentcalc'], |
| $ENV{'course.'.$cid.'.domain'}, |
$ENV{'course.'.$cid.'.domain'}, |
| $ENV{'course.'.$cid.'.num'}) |
$ENV{'course.'.$cid.'.num'}) |
|
Line 1489 sub coursedescription {
|
Line 1543 sub coursedescription {
|
| $courseid=~s/\_/\//g; |
$courseid=~s/\_/\//g; |
| my ($cdomain,$cnum)=split(/\//,$courseid); |
my ($cdomain,$cnum)=split(/\//,$courseid); |
| my $chome=&homeserver($cnum,$cdomain); |
my $chome=&homeserver($cnum,$cdomain); |
| |
my $normalid=$cdomain.'_'.$cnum; |
| |
# need to always cache even if we get errors otherwise we keep |
| |
# trying and trying and trying to get the course description. |
| |
my %envhash=(); |
| |
my %returnhash=(); |
| |
$envhash{'course.'.$normalid.'.last_cache'}=time; |
| if ($chome ne 'no_host') { |
if ($chome ne 'no_host') { |
| my %returnhash=&dump('environment',$cdomain,$cnum); |
%returnhash=&dump('environment',$cdomain,$cnum); |
| if (!exists($returnhash{'con_lost'})) { |
if (!exists($returnhash{'con_lost'})) { |
| my $normalid=$cdomain.'_'.$cnum; |
|
| my %envhash=(); |
|
| $returnhash{'home'}= $chome; |
$returnhash{'home'}= $chome; |
| $returnhash{'domain'} = $cdomain; |
$returnhash{'domain'} = $cdomain; |
| $returnhash{'num'} = $cnum; |
$returnhash{'num'} = $cnum; |
|
Line 1503 sub coursedescription {
|
Line 1561 sub coursedescription {
|
| $returnhash{'url'}=&clutter($returnhash{'url'}); |
$returnhash{'url'}=&clutter($returnhash{'url'}); |
| $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. |
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. |
| $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum; |
$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum; |
| $envhash{'course.'.$normalid.'.last_cache'}=time; |
|
| $envhash{'course.'.$normalid.'.home'}=$chome; |
$envhash{'course.'.$normalid.'.home'}=$chome; |
| $envhash{'course.'.$normalid.'.domain'}=$cdomain; |
$envhash{'course.'.$normalid.'.domain'}=$cdomain; |
| $envhash{'course.'.$normalid.'.num'}=$cnum; |
$envhash{'course.'.$normalid.'.num'}=$cnum; |
| &appenv(%envhash); |
|
| return %returnhash; |
|
| } |
} |
| } |
} |
| return (); |
&appenv(%envhash); |
| |
return %returnhash; |
| } |
} |
| |
|
| # -------------------------------------------------------- Get user privileges |
# -------------------------------------------------------- Get user privileges |
|
Line 1749 sub allowed {
|
Line 1805 sub allowed {
|
| |
|
| if ($priv eq 'bre') { |
if ($priv eq 'bre') { |
| my $copyright=&metadata($uri,'copyright'); |
my $copyright=&metadata($uri,'copyright'); |
| if ($copyright eq 'public') { return 'F'; } |
if (($copyright eq 'public') && (!$ENV{'request.course.id'})) { |
| |
return 'F'; |
| |
} |
| if ($copyright eq 'priv') { |
if ($copyright eq 'priv') { |
| $uri=~/([^\/]+)\/([^\/]+)\//; |
$uri=~/([^\/]+)\/([^\/]+)\//; |
| unless (($ENV{'user.name'} eq $2) && ($ENV{'user.domain'} eq $1)) { |
unless (($ENV{'user.name'} eq $2) && ($ENV{'user.domain'} eq $1)) { |
|
Line 2320 sub modifystudent {
|
Line 2378 sub modifystudent {
|
| ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid, |
($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid, |
| $desiredhome); |
$desiredhome); |
| unless ($reply eq 'ok') { return $reply; } |
unless ($reply eq 'ok') { return $reply; } |
| |
# This will cause &modify_student_enrollment to get the uid from the |
| |
# students environment |
| |
$uid = undef if (!$forceid); |
| |
$reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle, |
| |
$last,$gene,$usec,$end,$start); |
| |
return $reply; |
| |
} |
| |
|
| |
sub modify_student_enrollment { |
| |
my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start) = @_; |
| |
# Get the course id from the environment |
| |
my $cid=''; |
| |
unless ($cid=$ENV{'request.course.id'}) { |
| |
return 'not_in_class'; |
| |
} |
| |
# Make sure the user exists |
| my $uhome=&homeserver($uname,$udom); |
my $uhome=&homeserver($uname,$udom); |
| if (($uhome eq '') || ($uhome eq 'no_host')) { |
if (($uhome eq '') || ($uhome eq 'no_host')) { |
| return 'error: no such user'; |
return 'error: no such user'; |
| } |
} |
| # -------------------------------------------------- Add student to course list |
# |
| if ($first eq '' || $last eq '' || $uid eq '') { |
# Get student data if we were not given enough information |
| |
if (!defined($first) || $first eq '' || |
| |
!defined($last) || $last eq '' || |
| |
!defined($uid) || $uid eq '' || |
| |
!defined($middle) || $middle eq '' || |
| |
!defined($gene) || $gene eq '') { |
| # They did not supply us with enough data to enroll the student, so |
# They did not supply us with enough data to enroll the student, so |
| # we need to pick up more information. |
# we need to pick up more information. |
| my %tmp = &dump('environment',$udom,$uname, |
my %tmp = &get('environment', |
| ['firstname','middlename','lastname', 'generation','id'] |
['firstname','middlename','lastname', 'generation','id'] |
| ); |
,$udom,$uname); |
| |
|
| |
foreach (keys(%tmp)) { |
| |
&logthis("key $_ = ".$tmp{$_}); |
| |
} |
| $first = $tmp{'firstname'} if (!defined($first) || $first eq ''); |
$first = $tmp{'firstname'} if (!defined($first) || $first eq ''); |
| $middle = $tmp{'middlename'} if (!defined($middle) || $middle eq ''); |
$middle = $tmp{'middlename'} if (!defined($middle) || $middle eq ''); |
| $last = $tmp{'lastname'} if (!defined($last) || $last eq ''); |
$last = $tmp{'lastname'} if (!defined($last) || $last eq ''); |
| $gene = $tmp{'genename'} if (!defined($gene) || $gene eq ''); |
$gene = $tmp{'generation'} if (!defined($gene) || $gene eq ''); |
| $uid = $tmp{'id'} if (!defined($uid) || $uid eq ''); |
$uid = $tmp{'id'} if (!defined($uid) || $uid eq ''); |
| } |
} |
| my $fullname = &Apache::loncoursedata::ProcessFullName($last,$gene, |
my $fullname = &Apache::loncoursedata::ProcessFullName($last,$gene, |
| $first,$middle); |
$first,$middle); |
| $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'. |
my $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'. |
| $ENV{'course.'.$cid.'.num'}.':classlist:'. |
$ENV{'course.'.$cid.'.num'}.':classlist:'. |
| &escape($uname.':'.$udom).'='. |
&escape($uname.':'.$udom).'='. |
| &escape(join(':',$end,$start,$uid,$usec,$fullname)), |
&escape(join(':',$end,$start,$uid,$usec,$fullname)), |
|
Line 2347 sub modifystudent {
|
Line 2430 sub modifystudent {
|
| unless (($reply eq 'ok') || ($reply eq 'delayed')) { |
unless (($reply eq 'ok') || ($reply eq 'delayed')) { |
| return 'error: '.$reply; |
return 'error: '.$reply; |
| } |
} |
| # ---------------------------------------------------- Add student role to user |
# Add student role to user |
| my $uurl='/'.$cid; |
my $uurl='/'.$cid; |
| $uurl=~s/\_/\//g; |
$uurl=~s/\_/\//g; |
| if ($usec) { |
if ($usec) { |
|
Line 3018 sub metadata_generate_part0 {
|
Line 3101 sub metadata_generate_part0 {
|
| } |
} |
| } |
} |
| |
|
| |
# ------------------------------------------------- Get the title of a resource |
| |
|
| |
sub gettitle { |
| |
my $urlsymb=shift; |
| |
my $symb=&symbread($urlsymb); |
| |
unless ($symb) { |
| |
unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; } |
| |
return &metadata($urlsymb,'title'); |
| |
} |
| |
if ($titlecache{$symb}) { return $titlecache{$symb}; } |
| |
my ($map,$resid,$url)=split(/\_\_\_/,$symb); |
| |
my $title=''; |
| |
my %bighash; |
| |
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
| |
&GDBM_READER(),0640)) { |
| |
my $mapid=$bighash{'map_pc_'.&clutter($map)}; |
| |
$title=$bighash{'title_'.$mapid.'.'.$resid}; |
| |
untie %bighash; |
| |
} |
| |
if ($title) { |
| |
$titlecache{$symb}=$title; |
| |
return $title; |
| |
} else { |
| |
return &metadata($urlsymb,'title'); |
| |
} |
| |
} |
| |
|
| # ------------------------------------------------- Update symbolic store links |
# ------------------------------------------------- Update symbolic store links |
| |
|
| sub symblist { |
sub symblist { |
|
Line 3364 BEGIN {
|
Line 3474 BEGIN {
|
| my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab"); |
my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab"); |
| |
|
| while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
| |
next if ($configline =~ /^(\#|\s*$)/); |
| chomp($configline); |
chomp($configline); |
| my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline); |
my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline); |
| if ($id && $domain && $role && $name && $ip) { |
if ($id && $domain && $role && $name && $ip) { |
| $hostname{$id}=$name; |
$hostname{$id}=$name; |
| $hostdom{$id}=$domain; |
$hostdom{$id}=$domain; |
| $hostip{$id}=$ip; |
$hostip{$id}=$ip; |
| |
$iphost{$ip}=$id; |
| if ($domdescr) { $domaindescription{$domain}=$domdescr; } |
if ($domdescr) { $domaindescription{$domain}=$domdescr; } |
| if ($role eq 'library') { $libserv{$id}=$name; } |
if ($role eq 'library') { $libserv{$id}=$name; } |
| } else { |
} else { |
|
Line 3657 The course id is resolved based on the c
|
Line 3769 The course id is resolved based on the c
|
| This means the envoking user must be a course coordinator or otherwise |
This means the envoking 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 |
This call is essentially a wrapper for lonnet::modifyuser and |
| |
lonnet::modify_student_enrollment |
| |
|
| Inputs: |
Inputs: |
| |
|
|
Line 3695 Inputs:
|
Line 3808 Inputs:
|
| |
|
| =item * |
=item * |
| |
|
| |
modify_student_enrollment |
| |
|
| |
Change a students enrollment status in a class. The environment variable |
| |
'role.request.course' must be defined for this function to proceed. |
| |
|
| |
Inputs: |
| |
|
| |
=over 4 |
| |
|
| |
=item $udom, students domain |
| |
|
| |
=item $uname, students name |
| |
|
| |
=item $uid, students user id |
| |
|
| |
=item $first, students first name |
| |
|
| |
=item $middle |
| |
|
| |
=item $last |
| |
|
| |
=item $gene |
| |
|
| |
=item $usec |
| |
|
| |
=item $end |
| |
|
| |
=item $start |
| |
|
| |
=back |
| |
|
| |
|
| |
=item * |
| |
|
| assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start) : assign |
assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start) : assign |
| custom role; give a custom role to a user for the level given by URL. Specify |
custom role; give a custom role to a user for the level given by URL. Specify |
| name and domain of role author, and role name |
name and domain of role author, and role name |
![[BACK]](/icons/back.gif){kind=icon}
Return to lonnet.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / lonnet / perl