version 1.1056.2.2, 2010/03/26 21:27:41
|
version 1.1057, 2010/03/21 18:31:53
|
Line 3207 sub get_domain_roles {
|
Line 3207 sub get_domain_roles {
|
return %personnel; |
return %personnel; |
} |
} |
|
|
# ----------------------------------------------------------- Check out an item |
# ----------------------------------------------------------- Interval timing |
|
|
sub get_first_access { |
sub get_first_access { |
my ($type,$argsymb)=@_; |
my ($type,$argsymb)=@_; |
Line 3243 sub set_first_access {
|
Line 3243 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 4624 sub get_portfolio_access {
|
Line 4539 sub get_portfolio_access {
|
my (%allgroups,%allroles); |
my (%allgroups,%allroles); |
my ($start,$end,$role,$sec,$group); |
my ($start,$end,$role,$sec,$group); |
foreach my $envkey (%env) { |
foreach my $envkey (%env) { |
if ($envkey =~ m-^user\.role\.(gr|cc|co|in|ta|ep|ad|st)\./($match_domain)/($match_courseid)/?([^/]*)$-) { |
if ($envkey =~ m-^user\.role\.(gr|cc|in|ta|ep|st)\./($match_domain)/($match_courseid)/?([^/]*)$-) { |
my $cid = $2.'_'.$3; |
my $cid = $2.'_'.$3; |
if ($1 eq 'gr') { |
if ($1 eq 'gr') { |
$group = $4; |
$group = $4; |
Line 6524 sub modifyuser {
|
Line 6439 sub modifyuser {
|
my ($udom, $uname, $uid, |
my ($udom, $uname, $uid, |
$umode, $upass, $first, |
$umode, $upass, $first, |
$middle, $last, $gene, |
$middle, $last, $gene, |
$forceid, $desiredhome, $email, $inststatus, $candelete)=@_; |
$forceid, $desiredhome, $email, $inststatus)=@_; |
$udom= &LONCAPA::clean_domain($udom); |
$udom= &LONCAPA::clean_domain($udom); |
$uname=&LONCAPA::clean_username($uname); |
$uname=&LONCAPA::clean_username($uname); |
my $showcandelete = 'none'; |
|
if (ref($candelete) eq 'ARRAY') { |
|
if (@{$candelete} > 0) { |
|
$showcandelete = join(', ',@{$candelete}); |
|
} |
|
} |
|
&logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '. |
&logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '. |
$umode.', '.$first.', '.$middle.', '. |
$umode.', '.$first.', '.$middle.', '. |
$last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'. |
$last.', '.$gene.'(forceid: '.$forceid.')'. |
(defined($desiredhome) ? ' desiredhome = '.$desiredhome : |
(defined($desiredhome) ? ' desiredhome = '.$desiredhome : |
' desiredhome not specified'). |
' desiredhome not specified'). |
' by '.$env{'user.name'}.' at '.$env{'user.domain'}. |
' by '.$env{'user.name'}.' at '.$env{'user.domain'}. |
Line 6600 sub modifyuser {
|
Line 6509 sub modifyuser {
|
%names = @tmp; |
%names = @tmp; |
} |
} |
# |
# |
# If name, email and/or uid are blank (e.g., because an uploaded file |
# Make sure to not trash student environment if instructor does not bother |
# of users did not contain them), do not overwrite existing values |
# to supply name and email information |
# unless field is in $candelete array ref. |
|
# |
# |
my @fields = ('firstname','middlename','lastname','generation', |
|
'permanentemail','id'); |
|
my %newvalues; |
|
if (ref($candelete) eq 'ARRAY') { |
|
foreach my $field (@fields) { |
|
if (grep(/^\Q$field\E$/,@{$candelete})) { |
|
if ($field eq 'firstname') { |
|
$names{$field} = $first; |
|
} elsif ($field eq 'middlename') { |
|
$names{$field} = $middle; |
|
} elsif ($field eq 'lastname') { |
|
$names{$field} = $last; |
|
} elsif ($field eq 'generation') { |
|
$names{$field} = $gene; |
|
} elsif ($field eq 'permanentemail') { |
|
$names{$field} = $email; |
|
} elsif ($field eq 'id') { |
|
$names{$field} = $uid; |
|
} |
|
} |
|
} |
|
} |
|
|
|
if ($first) { $names{'firstname'} = $first; } |
if ($first) { $names{'firstname'} = $first; } |
if (defined($middle)) { $names{'middlename'} = $middle; } |
if (defined($middle)) { $names{'middlename'} = $middle; } |
if ($last) { $names{'lastname'} = $last; } |
if ($last) { $names{'lastname'} = $last; } |
Line 10353 modifyuserauth($udom,$uname,$umode,$upas
|
Line 10238 modifyuserauth($udom,$uname,$umode,$upas
|
|
|
=item * |
=item * |
|
|
modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last, $gene, |
modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene, |
$forceid,$desiredhome,$email,$inststatus,$candelete) : |
$forceid,$desiredhome,$email,$inststatus) : |
|
modify user |
will update user information (firstname,middlename,lastname,generation, |
|
permanentemail), and if forceid is true, student/employee ID also. |
|
A user's institutional affiliation(s) can also be updated. |
|
User information fields will not be overwritten with empty entries |
|
unless the field is included in the $candelete array reference. |
|
This array is included when a single user is modified via "Manage Users", |
|
or when Autoupdate.pl is run by cron in a domain. |
|
|
|
=item * |
=item * |
|
|