version 1.1053, 2010/03/08 14:28:50
|
version 1.1057, 2010/03/21 18:31:53
|
Line 3019 sub getannounce {
|
Line 3019 sub getannounce {
|
|
|
sub courseidput { |
sub courseidput { |
my ($domain,$storehash,$coursehome,$caller) = @_; |
my ($domain,$storehash,$coursehome,$caller) = @_; |
|
return unless (ref($storehash) eq 'HASH'); |
my $outcome; |
my $outcome; |
if ($caller eq 'timeonly') { |
if ($caller eq 'timeonly') { |
my $cids = ''; |
my $cids = ''; |
Line 3103 sub courseiddump {
|
Line 3104 sub courseiddump {
|
return %returnhash; |
return %returnhash; |
} |
} |
|
|
|
sub courselastaccess { |
|
my ($cdom,$cnum,$hostidref) = @_; |
|
my %returnhash; |
|
if ($cdom && $cnum) { |
|
my $chome = &homeserver($cnum,$cdom); |
|
if ($chome ne 'no_host') { |
|
my $rep = &reply('courselastaccess:'.$cdom.':'.$cnum,$chome); |
|
&extract_lastaccess(\%returnhash,$rep); |
|
} |
|
} else { |
|
if (!$cdom) { $cdom=''; } |
|
my %libserv = &all_library(); |
|
foreach my $tryserver (keys(%libserv)) { |
|
if (ref($hostidref) eq 'ARRAY') { |
|
next unless (grep(/^\Q$tryserver\E$/,@{$hostidref})); |
|
} |
|
if (($cdom eq '') || (&host_domain($tryserver) eq $cdom)) { |
|
my $rep = &reply('courselastaccess:'.&host_domain($tryserver).':',$tryserver); |
|
&extract_lastaccess(\%returnhash,$rep); |
|
} |
|
} |
|
} |
|
return %returnhash; |
|
} |
|
|
|
sub extract_lastaccess { |
|
my ($returnhash,$rep) = @_; |
|
if (ref($returnhash) eq 'HASH') { |
|
unless ($rep eq 'unknown_command' || $rep eq 'no_such_host' || |
|
$rep eq 'con_lost' || $rep eq 'rejected' || $rep eq 'refused' || |
|
$rep eq '') { |
|
my @pairs=split(/\&/,$rep); |
|
foreach my $item (@pairs) { |
|
my ($key,$value)=split(/\=/,$item,2); |
|
$key = &unescape($key); |
|
next if ($key =~ /^error: 2 /); |
|
$returnhash->{$key} = &thaw_unescape($value); |
|
} |
|
} |
|
} |
|
return; |
|
} |
|
|
# ---------------------------------------------------------- DC e-mail |
# ---------------------------------------------------------- DC e-mail |
|
|
sub dcmailput { |
sub dcmailput { |
Line 3163 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 3199 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 6374 sub autoupdate_coowners {
|
Line 6333 sub autoupdate_coowners {
|
my %coursehash = &coursedescription($cdom.'_'.$cnum); |
my %coursehash = &coursedescription($cdom.'_'.$cnum); |
my $instcode = $coursehash{'internal.coursecode'}; |
my $instcode = $coursehash{'internal.coursecode'}; |
if ($instcode ne '') { |
if ($instcode ne '') { |
unless ($coursehash{'internal.courseowner'} eq $uname.':'.$udom) { |
if (($start && $start <= $now) && ($end == 0) || ($end > $now)) { |
my ($result,$desc) = &auto_validate_instcode($cnum,$cdom,$instcode,$uname.':'.$udom); |
unless ($coursehash{'internal.courseowner'} eq $uname.':'.$udom) { |
if ($result eq 'valid') { |
|
my ($delcoowners,@newcoowners,$putresult,$delresult,$coowners); |
my ($delcoowners,@newcoowners,$putresult,$delresult,$coowners); |
if (($end == 0) || ($end > $now)) { |
my ($result,$desc) = &auto_validate_instcode($cnum,$cdom,$instcode,$uname.':'.$udom); |
if ($coursehash{'internal.co-owners'}) { |
if ($result eq 'valid') { |
|
if ($coursehash{'internal.co-owners'}) { |
foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) { |
foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) { |
push(@newcoowners,$coowner); |
push(@newcoowners,$coowner); |
} |
} |
Line 6829 ENDINITMAP
|
Line 6788 ENDINITMAP
|
} |
} |
# ----------------------------------------------------------- Write preferences |
# ----------------------------------------------------------- Write preferences |
&writecoursepref($udom.'_'.$uname, |
&writecoursepref($udom.'_'.$uname, |
('description' => $description, |
('description' => $description, |
'url' => $topurl)); |
'url' => $topurl, |
|
'internal.creator' => $env{'user.name'}.':'. |
|
$env{'user.domain'}, |
|
'internal.created' => $now, |
|
'internal.creationcontext' => $context) |
|
); |
return '/'.$udom.'/'.$uname; |
return '/'.$udom.'/'.$uname; |
} |
} |
|
|