--- loncom/automation/batchcreatecourse.pm 2005/07/12 15:44:01 1.7 +++ loncom/automation/batchcreatecourse.pm 2009/10/31 17:54:51 1.32 @@ -1,5 +1,5 @@ # -# $Id: batchcreatecourse.pm,v 1.7 2005/07/12 15:44:01 raeburn Exp $ +# $Id: batchcreatecourse.pm,v 1.32 2009/10/31 17:54:51 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -29,12 +29,12 @@ use LONCAPA::Configuration; use LONCAPA::Enrollment; use HTML::Parser; use Time::Local; -use Apache::Constants; use Apache::lonnet; use Apache::loncommon; -use Apache::loncreatecourse; -use Apache::loncreateuser; use Apache::lonlocal; +use LONCAPA qw(:match); + +use strict; # Collection of routines used for batch creation of courses and users. # &create_courses() should be called by an Autocreate.pl @@ -54,6 +54,7 @@ use Apache::lonlocal; # # # Underwater Basket Weaving +# Course # ss05ubw101 # msul1 # msu @@ -72,13 +73,16 @@ use Apache::lonlocal; # # # nav +# 20 # 466011437c34194msul1 # msu +# shift +# 365 # # 1 # 1 # 0 -# keyadmin@msu +# keyadmin:msu # 1 # 1 # @@ -152,8 +156,14 @@ use Apache::lonlocal; # A value of 0 or blank is equivalent to an unchecked box or 'No' # response. Dates are in format YYYY:MM:DD:HH:MM:SS (:separators required) # -# firstres can be nav, syl , or blank for "Navigate Contents", Syllabus, or +# firstres can be nav, syl, or blank for "Navigate Contents", Syllabus, or # no entry respectively. +# +# crstype can be Course or Group +# +# crsquota is the total disk space permitted for course group portfolio files +# in all course groups. +# # For format of other parameters, refer to the interactive CCRS page # and view how the equivalent parameter is displayed in the web form. # @@ -164,7 +174,7 @@ use Apache::lonlocal; # # Directory for retrieval of files listed in @$requests is: # /home/httpd/perl/tmp/addcourse/$dom/auto/pending if $context = auto -# /home/httpd/perl/tmp/addcourse/$dom/web/$udom_$uname if $context = web +# /home/httpd/perl/tmp/addcourse/$dom/web/$uname_$udom/pending if $context = web # # inputs (five) - requests - ref to array of filename(s) containing course requests # courseids - ref to hash to store LON-CAPA course ids of new courses @@ -184,12 +194,13 @@ sub create_courses { my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf'); # Get role names my %longroles = (); - open(FILE,"<$perlvarref{'lonTabDir'}.'/rolesplain.tab"); + open(FILE,"<$$perlvarref{'lonTabDir'}.'/rolesplain.tab"); my @rolesplain = ; close(FILE); - foreach (@rolesplain) { - if ($_ =~ /^(st|ta|ex|ad|in|cc):([\w\s]+)$/) { - $longroles{$1} = $2; + foreach my $item (@rolesplain) { + if ($item =~ /^(st|ta|ep|ad|in|cc|co):([\w\s]+):?([\w\s]*)/) { + $longroles{'Course'}{$1} = $2; + $longroles{'Community'}{$1} = $3; } } my ($logmsg,$keysmsg,$newusermsg,$addresult); @@ -199,7 +210,7 @@ sub create_courses { $newcoursedir .= '/pending'; } else { if ($uname && $udom) { - $newcoursedir .= '/'.$udom.'_'.$uname; + $newcoursedir .= '/'.$uname.'_'.$udom.'/pending'; } else { $logmsg = "batchcreatecourse::create_courses() called without username and/or domain of requesting Domain Coordinator"; } @@ -209,9 +220,12 @@ sub create_courses { my %details = (); if (-e $newcoursedir.'/'.$request) { &parse_coursereqs($newcoursedir.'/'.$request, \%details); - foreach my $num (sort keys %details) { - my $courseid = &build_course($dom,$num,$context,\%details,\%longroles,\$logmsg,\$newusermsg,\$addresult,\%enrollcount,\$output,\$keysmsg); - $$courseids{$courseid} = $details{$num}{'class'}; + foreach my $num (sort(keys(%details))) { + my $reqdetails = $details{$num}; + my $courseid = &build_course($dom,$num,$context,$reqdetails,\%longroles,\$logmsg,\$newusermsg,\$addresult,\%enrollcount,\$output,\$keysmsg); + if ($courseid =~m{^/$match_domain/$match_courseid}) { + $$courseids{$courseid} = $details{$num}{'class'}; + } } } } @@ -239,7 +253,7 @@ sub parse_coursereqs { my $xlist = 0; my $userkey = ''; my $role = ''; - my @items = ('title','optional_id','coursecode','coursehome','reshome','nonstandard','adds','drops','topmap','firstres','clonecrs','clonedom','showphotos','setpolicy','setcontent','setkeys','keyauth','disresdis','disablechat','openall','notify_owner','notify_dc'); + my @items = ('title','optional_id','coursecode','coursehome','reshome','nonstandard','adds','drops','topmap','firstres','clonecrs','clonedom','datemode','dateshift','showphotos','setpolicy','setcontent','setkeys','keyauth','disresdis','disablechat','openall','notify_owner','notify_dc','crstype','crsquota'); my @dateitems = ('enrollstart','enrollend','accessstart','accessend'); my @useritems = ('autharg','authtype','firstname','generation','lastname','middlename','studentID'); my $p = HTML::Parser->new @@ -358,7 +372,7 @@ sub parse_coursereqs { # build_course() # # inputs -# domain +# course domain # course request number # context - auto if called from command line, web if called from DC web interface # ref to hash of course creation information @@ -367,8 +381,13 @@ sub parse_coursereqs { # ref to scalar used to accumulate messages sent to new users # ref to scalar used to accumulate results of new user additions # ref to hash of enrollment counts for different roles -# ref to scalar used to accumulate iformation about added roles -# ref to scalar used to accumulate +# ref to scalar used to accumulate information about added roles +# ref to scalar used to accumulate +# ref to scalar used to accumulate information about access keys +# domain of DC creating course +# username of DC creating course +# optional course number, if unique course number already obtained (e.g., for +# course requests submitted via course request form. # # outputs # LON-CAPA courseID for new (created) course @@ -376,226 +395,329 @@ sub parse_coursereqs { ######################################################### sub build_course { - my ($cdom,$num,$context,$details,$longoles,$logmsg,$newusermsg,$addresult,$enrollcount,$output,$keysmsg,$udom,$uname) = @_; - my $owner_uname = $$details{$num}{'owner'}; - my $owner_domain = $$details{$num}{'domain'}; + my ($cdom,$num,$context,$details,$longroles,$logmsg,$newusermsg,$addresult,$enrollcount,$output,$keysmsg,$udom,$uname,$cnum,$category) = @_; + return unless (ref($details) eq 'HASH'); + my $owner_uname = $details->{'owner'}; + my $owner_domain = $details->{'domain'}; my $owner = $owner_uname.':'.$owner_domain; my $sectionstr = ''; my $xliststr = ''; my $noenddate = ''; my $outcome; - my ($courseid,$crsudom,$crsunum); + my ($courseid,$crsudom,$crsunum,$crstype,$ccrole,$rolenames); + if ($details->{'crstype'} eq 'Community') { + $crstype = $details->{'crstype'}; + $ccrole ='co'; + if (ref($longroles) eq 'HASH') { + $rolenames = $longroles->{'Community'}; + } + } else { + $crstype = 'Course'; + $ccrole = 'cc'; + if (ref($longroles) eq 'HASH') { + $rolenames = $longroles->{'Course'}; + } + } my $linefeed; if ($context eq 'auto') { $linefeed = "\n"; } else { $linefeed = "
\n"; } - if ($$details{$num}{'accessend'} eq '') { + if ($details->{'accessend'} eq '') { $noenddate = 1; } - my $reshome = $$details{$num}{'reshome'}; + my $reshome = $details->{'reshome'}; if ($reshome eq '') { $reshome = '/res/'.$cdom; } - my $firstres = $$details{$num}{'firstres'}; + my $firstres = $details->{'firstres'}; if ($firstres eq '') { $firstres = 'syl'; } - foreach my $secid (sort keys %{$$details{$num}{'sections'}}) { - $sectionstr .= $$details{$num}{'sections'}{$secid}{'inst'}.':'.$$details{$num}{'sections'}{$secid}{'loncapa'}.','; + foreach my $secid (sort(keys(%{$details->{'sections'}}))) { + $sectionstr .= $details->{'sections'}{$secid}{'inst'}.':'.$details->{'sections'}{$secid}{'loncapa'}.','; } $sectionstr =~ s/,$//; - foreach my $xlist (sort keys %{$$details{$num}{'crosslists'}}) { - $xliststr .= $$details{$num}{'crosslists'}{$xlist}{'inst'}.':'.$$details{$num}{'crosslists'}{$xlist}{'loncapa'}.','; + foreach my $xlist (sort(keys(%{$details->{'crosslists'}}))) { + $xliststr .= $details->{'crosslists'}{$xlist}{'inst'}.':'.$details->{'crosslists'}{$xlist}{'loncapa'}.','; } $xliststr =~ s/,$//; my %courseinfo = ( - inst_code => $$details{$num}{'coursecode'}, - description => $$details{$num}{'title'} + inst_code => $details->{'coursecode'}, + description => $details->{'title'} ); - if (&Apache::lonnet::homeserver($$details{$num}{'owner'},$$details{$num}{'domain'}) eq 'no_host') { # Add user if no account - my $ownerargs = {'auth' => $$details{$num}{'ownerauthtype'}, - 'authparam' => $$details{$num}{'ownerauthparam'}, - 'emailenc' => $$details{$num}{'emailenc'}, - 'udom' => $$details{$num}{'domain'}, - 'uname' => $$details{$num}{'owner'}, - 'pid' => '', - 'first' => $$details{$num}{'users'}{$owner}{'first'}, - 'middle' => $$details{$num}{'users'}{$owner}{'middle'}, - 'last' => $$details{$num}{'users'}{$owner}{'last'}, - 'gene' => $$details{$num}{'users'}{$owner}{'gene'}, + if (&Apache::lonnet::homeserver($details->{'owner'},$details->{'domain'}) eq 'no_host') { # Add user if no account + my $ownerargs = {'auth' => $details->{'ownerauthtype'}, + 'authparam' => $details->{'ownerauthparam'}, + 'emailenc' => $details->{'emailenc'}, + 'udom' => $details->{'domain'}, + 'uname' => $details->{'owner'}, + 'pid' => $details->{'users'}{$owner}{'studentID'}, + 'first' => $details->{'users'}{$owner}{'firstname'}, + 'middle' => $details->{'users'}{$owner}{'middlename'}, + 'last' => $details->{'users'}{$owner}{'lastname'}, + 'gene' => $details->{'users'}{$owner}{'generation'}, 'usec' => '', 'end' => '', 'start' => '', - 'emailaddr' => $$details{$num}{'users'}{$owner}{'email'}, + 'emailaddr' => $details->{'users'}{$owner}{'email'}, 'cid' => '', 'context' => 'createowner', 'linefeed' => $linefeed, - 'role' => 'cc', + 'role' => $ccrole, }; - $outcome = &LONCAPA::Enrollment::create_newuser($ownerargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,\%courseinfo); + $outcome = &LONCAPA::Enrollment::create_newuser($ownerargs,$logmsg,$newusermsg,$enrollcount,$addresult,$rolenames,\%courseinfo,$context); } else { $outcome = 'ok'; } if ($outcome eq 'ok') { + if ($details->{'datemode'} !~ /^(preserve|shift|delete)$/) { + $details->{'datemode'} = 'shift'; + $details->{'dateshift'} = 365; + } my $courseargs = { - ccuname => $$details{$num}{'owner'}, - ccdomain => $$details{$num}{'domain'}, - cdescr => $$details{$num}{'title'}, - curl => $$details{$num}{'topmap'}, + ccuname => $details->{'owner'}, + ccdomain => $details->{'domain'}, + cdescr => $details->{'title'}, + crstype => $details->{'crstype'}, + curl => $details->{'topmap'}, course_domain => $cdom, - course_home => $$details{$num}{'coursehome'}, - nonstandard => $$details{$num}{'nonstandard'}, - crscode => $$details{$num}{'coursecode'}, - clonecourse => $$details{$num}{'clonecrs'}, - clonedomain => $$details{$num}{'clonedom'}, - crsid => $$details{$num}{'optional_id'}, - curruser => $$details{$num}{'owner'}, + course_home => $details->{'coursehome'}, + nonstandard => $details->{'nonstandard'}, + crscode => $details->{'coursecode'}, + crsquota => $details->{'crsquota'}, + clonecourse => $details->{'clonecrs'}, + clonedomain => $details->{'clonedom'}, + datemode => $details->{'datemode'}, + dateshift => $details->{'dateshift'}, + crsid => $details->{'optional_id'}, + curruser => $details->{'owner'}, crssections => $sectionstr, crsxlist => $xliststr, - autoadds => $$details{$num}{'adds'}, - autodrops => $$details{$num}{'drops'}, - notify => $$details{$num}{'notify_owner'}, - notify_dc => $$details{$num}{'notify_dc'}, + autoadds => $details->{'adds'}, + autodrops => $details->{'drops'}, + notify => $details->{'notify_owner'}, + notify_dc => $details->{'notify_dc'}, no_end_date => $noenddate, - showphotos => $$details{$num}{'showphotos'}, - authtype => $$details{$num}{'authtype'}, - autharg => $$details{$num}{'authparam'}, - enrollstart => $$details{$num}{'enrollstart'}, - enrollend => $$details{$num}{'enrollend'}, - startaccess => $$details{$num}{'accessstart'}, - endaccess => $$details{$num}{'accessend'}, - setpolicy => $Sdetails{$num}{'setpolicy'}, - setcontent => $$details{$num}{'setcontent'}, + showphotos => $details->{'showphotos'}, + authtype => $details->{'authtype'}, + autharg => $details->{'authparam'}, + enrollstart => $details->{'enrollstart'}, + enrollend => $details->{'enrollend'}, + startaccess => $details->{'accessstart'}, + endaccess => $details->{'accessend'}, + setpolicy => $details->{'setpolicy'}, + setcontent => $details->{'setcontent'}, reshome => $reshome, - setkeys => $$details{$num}{'setkeys'}, - keyauth => $$details{$num}{'keyauth'}, - disresdis => $$details{$num}{'disresdis'}, - disablechat => $$details{$num}{'disablechat'}, - openall => $$details{$num}{'openall'}, + setkeys => $details->{'setkeys'}, + keyauth => $details->{'keyauth'}, + disresdis => $details->{'disresdis'}, + disablechat => $details->{'disablechat'}, + openall => $details->{'openall'}, firstres => $firstres }; - - my %host_servers = &Apache::loncommon::get_library_servers($cdom); - if (! exists($host_servers{$$details{$num}{'coursehome'}})) { - $$logmsg .= &mt('Invalid home server for course').': '.$$details{$num}{'coursehome'}; + my %host_servers = &Apache::lonnet::get_servers($cdom,'library'); + if (! exists($host_servers{$details->{'coursehome'}})) { + $$logmsg .= &mt('Invalid home server for course').': '.$details->{'coursehome'}; + return; + } + my ($success, $msg) = &Apache::loncommon::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum,$udom,$uname,$context,$cnum,$category); + $$logmsg .= $msg; + if (!$success) { return; } - - &Apache::loncreatecourse::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum,$udom,$uname); } else { return; } # -# Make owner a course coordinator +# Make owner a coordinator # if (($owner_domain) && ($owner_uname)) { - &Apache::lonnet::assignrole($owner_domain,$owner_uname,$courseid,'cc'); + &Apache::lonnet::assignrole($owner_domain,$owner_uname,$courseid,$ccrole,'','','','',$context); } # # Process other reqested users # + + my @courseroles = qw(st ep ta in); + push(@courseroles,$ccrole); + if (&owner_is_dc($owner_uname,$owner_domain,$crsudom)) { + push(@courseroles,'ad'); + } my $stulogmsg = ''; - foreach my $userkey (sort keys %{$$details{$num}{'users'}}) { + foreach my $userkey (sort(keys(%{$details->{'users'}}))) { my $url = '/'.$crsudom.'/'.$crsunum; - if (@{$$details{$num}{'users'}{$userkey}{'roles'}} > 0) { + next if (ref($details->{'users'}{$userkey}{'roles'}) ne 'ARRAY'); + if (@{$details->{'users'}{$userkey}{'roles'}} > 0) { my ($username,$userdom) = split/:/,$userkey; if (&Apache::lonnet::homeserver($username,$userdom) eq 'no_host') { # Add user if no account - my $firstrole = $$details{$num}{'users'}{$userkey}{'roles'}[0]; - my $firssec = $$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}[0]; + my @reqroles = @{$details->{'users'}{$userkey}{'roles'}}; + my @badroles; + my $firstrole = shift(@reqroles); + while (@reqroles > 0) { + if ($firstrole =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) { + if (($1 eq $owner_domain) && ($2 eq $owner_uname)) { + last; + } else { + push(@badroles,$firstrole); + $firstrole = shift(@reqroles); + } + } elsif (grep(/^\Q$firstrole\E$/,@courseroles)) { + last; + } else { + push(@badroles,$firstrole); + $firstrole = shift(@reqroles); + } + } + if (@badroles > 0) { + if (@badroles > 1) { + $$output .= &mt('The following requested roles are unavailable:').' '.join(', ',@badroles); + } else { + $$output .= &mt('The following requested role: [_1] is unavailable.',$badroles[0]); + } + } + my $firstsec; + unless (($firstrole eq $ccrole) || ($firstrole eq '')) { + $firstsec = $details->{'users'}{$userkey}{$firstrole}{'usec'}[0]; + } my $userargs = { - 'auth' => $$details{$num}{'users'}{$userkey}{'authtype'}, - 'authparam' => $$details{$num}{'users'}{$userkey}{'autharg'}, - 'emailenc' => $$details{$num}{'users'}{$userkey}{'emailenc'}, + 'auth' => $details->{'users'}{$userkey}{'authtype'}, + 'authparam' => $details->{'users'}{$userkey}{'autharg'}, + 'emailenc' => $details->{'users'}{$userkey}{'emailenc'}, 'udom' => $userdom, 'uname' => $username, - 'pid' => $$details{$num}{'users'}{$userkey}{'studentID'}, - 'first' => $$details{$num}{'users'}{$userkey}{'first'}, - 'middle' => $$details{$num}{'users'}{$userkey}{'middle'}, - 'last' => $$details{$num}{'users'}{$userkey}{'last'}, - 'gene' => $$details{$num}{'users'}{$userkey}{'gene'}, + 'pid' => $details->{'users'}{$userkey}{'studentID'}, + 'first' => $details->{'users'}{$userkey}{'firstname'}, + 'middle' => $details->{'users'}{$userkey}{'middlename'}, + 'last' => $details->{'users'}{$userkey}{'lastname'}, + 'gene' => $details->{'users'}{$userkey}{'generation'}, 'usec' => $firstsec, - 'end' => $$details{$num}{'users'}{$userkey}{'end'}, - 'start' => $$details{$num}{'users'}{$userkey}{'start'}, - 'emailaddr' => $$details{$num}{'users'}{$userkey}{'email'}, + 'end' => $details->{'users'}{$userkey}{'end'}, + 'start' => $details->{'users'}{$userkey}{'start'}, + 'emailaddr' => $details->{'users'}{$userkey}{'emailaddr'}, 'cid' => $courseid, - 'crs' => $crsudom, - 'cdom' => $crsunum, + 'crs' => $crsunum, + 'cdom' => $crsudom, 'context' => 'createcourse', 'linefeed' => $linefeed, - 'role' => $$details{$num}{'users'}{$userkey}{'roles'}[0], + 'role' => $details->{'users'}{$userkey}{'roles'}[0], }; - $outcome = &LONCAPA::Enrollment::create_newuser($userargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,\%courseinfo); + $outcome = &LONCAPA::Enrollment::create_newuser($userargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,\%courseinfo,$context); # now add other roles and other sections. if ($outcome eq 'ok') { - if (($firstrole ne 'st') && (@{$$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}} > 1)) { - for (my $i=1; $i<@{$$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}}; $i++) { + if ((($firstrole ne 'st') && ($firstrole ne $ccrole) && ($firstrole ne '')) && (@{$details->{'users'}{$userkey}{$firstrole}{'usec'}} > 1)) { + for (my $i=1; $i<@{$details->{'users'}{$userkey}{$firstrole}{'usec'}}; $i++) { my $curr_role = $firstrole; - my $start = $$details{$num}{'users'}{$userkey}{$curr_role}{'start'}; - my $end = $$details{$num}{'users'}{$userkey}{$curr_role}{'end'}; - my $usec = $$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}[$i]; + my $start = $details->{'users'}{$userkey}{$curr_role}{'start'}; + my $end = $details->{'users'}{$userkey}{$curr_role}{'end'}; + my $usec = $details->{'users'}{$userkey}{$firstrole}{'usec'}[$i]; $url = '/'.$crsudom.'/'.$crsunum; if ($usec ne '') { $url .= '/'.$usec; } - $$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec); + if ($firstrole =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) { + $$output .= &Apache::loncommon::commit_customrole($userdom,$username,$url,$1,$2,$3,$start,$end,$context); + } else { + $$output .= &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); + } } } - if (@{$$details{$num}{'users'}{$userkey}{'roles'}} > 1) { - for (my $j=1; $j<@{$$details{$num}{'users'}{$userkey}{'roles'}}; $j++) { - my $curr_role = $$details{$num}{'users'}{$userkey}{'roles'}[$j]; - my $start = $$details{$num}{'users'}{$userkey}{$curr_role}{'start'}; - my $end = $$details{$num}{'users'}{$userkey}{$curr_role}{'end'}; + if (@reqroles > 0) { + foreach my $curr_role (@reqroles) { + my $start = $details->{'users'}{$userkey}{$curr_role}{'start'}; + my $end = $details->{'users'}{$userkey}{$curr_role}{'end'}; if ($curr_role eq 'st') { - my $usec = $$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}[0]; + my $usec = $details->{'users'}{$userkey}{$curr_role}{'usec'}[0]; $url = '/'.$crsudom.'/'.$crsunum; if ($usec ne '') { $url .= '/'.$usec; } - $$output .= &Apache::loncreateuser::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec); - } else { - foreach my $usec (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}}) { + $$output .= &Apache::loncommon::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); + } elsif ($curr_role eq $ccrole) { + $url = '/'.$crsudom.'/'.$crsunum; + my $usec = ''; + $$output .= + &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); + } elsif ((grep(/^\Q$curr_role\E$/,@courseroles)) || + ($curr_role =~ m{^cr/$match_domain/$match_username/[^/]+$})) { + foreach my $usec (@{$details->{'users'}{$userkey}{$curr_role}{'usec'}}) { $url = '/'.$crsudom.'/'.$crsunum; if ($usec ne '') { $url .= '/'.$usec; } - $$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec); + if ($curr_role =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) { + if (($1 eq $owner_domain) && ($2 eq $owner_uname)) { + $$output .= + &Apache::loncommon::commit_customrole($userdom,$username,$url,$1,$2,$3,$start,$end,$context); + } else { + $$output = &mt('Requested custom role: [_1] unavailable, as it was not defined by the course owner.',$curr_role); + } + } else { + $$output .= + &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); + } } + } else { + $$output .= &mt('Requested role: [_1] is unavailable.',$curr_role); } } } } } else { - foreach my $curr_role (@{$$details{$num}{'users'}{$userkey}{'roles'}}) { - my $start = $$details{$num}{'users'}{$userkey}{$curr_role}{'start'}; - my $end = $$details{$num}{'users'}{$userkey}{$curr_role}{'end'}; + foreach my $curr_role (@{$details->{'users'}{$userkey}{'roles'}}) { + my $start = $details->{'users'}{$userkey}{$curr_role}{'start'}; + my $end = $details->{'users'}{$userkey}{$curr_role}{'end'}; if ($curr_role eq 'st') { - my $usec = $$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}[0]; + my $usec = $details->{'users'}{$userkey}{$curr_role}{'usec'}[0]; $url = '/'.$crsudom.'/'.$crsunum; if ($usec ne '') { $url .= '/'.$usec; } - $$output .= &Apache::loncreateuser::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec); - } else { - if (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}} > 0) { - foreach my $usec (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}}) { + $$output .= &Apache::loncommon::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); + } elsif ((grep(/^\Q$curr_role\E$/,@courseroles)) || + ($curr_role =~ m{^cr/$match_domain/$match_username/[^/]+$})) { + if (@{$details->{'users'}{$userkey}{$curr_role}{'usec'}} > 0) { + foreach my $usec (@{$details->{'users'}{$userkey}{$curr_role}{'usec'}}) { $url = '/'.$crsudom.'/'.$crsunum; if ($usec ne '') { $url .= '/'.$usec; } - my $stdresult = &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec); + my $stdresult; + if ($curr_role =~ m{/^cr/($match_domain)/($match_username)/([^/]+)$}) { + if (($1 eq $owner_domain) && ($2 eq $owner_uname)) { + $stdresult = + &Apache::loncommon::commit_customrole($userdom,$username,$url,$1,$2,$3,$start,$end,$context); + } else { + $stdresult = &mt('Requested custom role: [_1] unavailable, as it was not defined by the course owner.',$curr_role); + } + } else { + $stdresult = + &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); + } $$output .= $stdresult; } } else { $url = '/'.$crsudom.'/'.$crsunum; - $$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,''); + if ($curr_role =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) { + if (($1 eq $owner_domain) && ($2 eq $owner_uname)) { + $$output .= + &Apache::loncommon::commit_customrole($userdom,$username,$url,$1,$2,$3,$start,$end,$context); + } else { + $$output .= &mt('Requested custom role: [_1] unavailable, as it was not defined by the course owner.',$curr_role); + } + } else { + $$output .= + &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,'',$context); + } } + } else { + $$output .= &mt('Requested role: [_1] is unavailable.',$curr_role); } } } @@ -603,15 +725,26 @@ sub build_course { } # Information about keys. - if ($$details{$num}{'setkeys'}) { + if ($details->{'setkeys'}) { $$keysmsg .= - ''.&mt('Manage Access Keys').' for '.$$details{$num}{'title'}.$linefeed; + ''.&mt('Manage Access Keys').' for '.$details->{'title'}.$linefeed; } # Flush the course logs so reverse user roles immediately updated &Apache::lonnet::flushcourselogs(); return $courseid; } +sub owner_is_dc { + my ($owner_uname,$owner_dom,$cdom) = @_; + my $is_dc = 0; + my %roles = &Apache::lonnet::get_my_roles($owner_uname,$owner_dom,'userroles', + ['active'],['dc'],[$cdom]); + if ($roles{$owner_uname.':'.$owner_dom.':dc'}) { + $is_dc = 1; + } + return $is_dc; +} + ######################################################### # # process_date() @@ -627,15 +760,53 @@ sub process_date { if ($timestr !~ /:/) { $timestamp = ''; } else { - my @entries = split/:/,$timestr; + my @entries = split(/:/,$timestr); for (my $j=0; $j<@entries; $j++) { if ( length($entries[$j]) > 1 ) { $entries[$j] =~ s/^0//; } + $entries[$j] =~ s/\D//g; + if ($entries[$j] < 0) { + $entries[$j] = 0; + } } if ($entries[1] > 0) { $entries[1] = $entries[1] - 1; } + if ($entries[5] > 60) { + $entries[5] = 60; + } + if ($entries[4] > 59) { + $entries[4] = 59; + } + if ($entries[3] > 23) { + $entries[3] = 23; + } + if ($entries[2] > 31) { + $entries[2] = 31; + } + if ($entries[1] > 11) { + $entries[1] = 11; + } + if ($entries[2] == 31) { + if (($entries[1] == 3) || ($entries[1] == 5) || + ($entries[1] == 8) || ($entries[1] == 10)) { + $entries[2] = 30; + } + } + if ($entries[1] == 1) { + if ($entries[2] > 29) { + $entries[2] = 29; + } + if ($entries[2] == 29) { + if ($entries[0]%4 != 0) { + $entries[2] = 28; + } elsif ( $entries[0]%100 == 0 + && $entries[0]%400 != 0) { + $entries[2] = 28; + } + } + } $timestamp = timelocal($entries[5],$entries[4],$entries[3],$entries[2],$entries[1],$entries[0]); } return $timestamp;