--- loncom/automation/batchcreatecourse.pm 2005/01/30 15:37:03 1.1 +++ loncom/automation/batchcreatecourse.pm 2008/02/07 01:43:21 1.25 @@ -1,12 +1,40 @@ +# +# $Id: batchcreatecourse.pm,v 1.25 2008/02/07 01:43:21 raeburn Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# + package LONCAPA::batchcreatecourse; use LONCAPA::Configuration; use LONCAPA::Enrollment; use HTML::Parser; use Time::Local; -use Apache::Constants; use Apache::lonnet; -use Apache::loncreatecourse; +use Apache::loncommon; 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 @@ -14,8 +42,7 @@ use Apache::lonlocal; # of a file containing an XML description of a course request (lonbatchccrs.pm). # # XML file(s) describing courses that are to be created in domain $dom are stored in -# /home/httpd/perl/tmp/addcourse/$dom. Each XML file is deleted after it has been -# parsed. +# /home/httpd/perl/tmp/addcourse/$dom # # &create_courses() will create an account for the course owner # (if one does not currently exist), will create the course (cloning if necessary), @@ -27,6 +54,7 @@ use Apache::lonlocal; # # # Underwater Basket Weaving +# Course # ss05ubw101 # msul1 # msu @@ -45,13 +73,14 @@ use Apache::lonlocal; # # # nav +# 20 # 466011437c34194msul1 # msu # # 1 # 1 # 0 -# keyadmin@msu +# keyadmin:msu # 1 # 1 # @@ -125,8 +154,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. # @@ -135,15 +170,16 @@ use Apache::lonlocal; # files listed in @$requests are deleted # after the files have been parsed. # -# Directory searched for files listed in @$requests -# is /home/httpd/perl/tmp/addcourse/$dom/auto if $context is auto -# and /home/httpd/perl/tmp/addcourse/$dom/web/$uname if $context is web +# 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/$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 # context - auto if called from command line, web if called from browser # dom - domain for which the course is being created -# uname - username of DC who is requesting course creation from browser +# uname - username of DC who is requesting course creation +# udom - domain of DC who is requesting course creation # # outputs (three) - output - text recording user roles added etc. # logmsg - text to be logged @@ -151,12 +187,12 @@ use Apache::lonlocal; ############################################################# sub create_courses { - my ($requests,$courseids,$context,$dom,$uname) = @_; + my ($requests,$courseids,$context,$dom,$uname,$udom) = @_; my $output; 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) { @@ -167,9 +203,13 @@ sub create_courses { my ($logmsg,$keysmsg,$newusermsg,$addresult); my %enrollcount = (); my $newcoursedir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$dom.'/'.$context; - if ($uname) { - unless ($context eq 'auto') { - $newcoursedir .= '/'.$uname; + if ($context eq 'auto') { + $newcoursedir .= '/pending'; + } else { + if ($uname && $udom) { + $newcoursedir .= '/'.$uname.'_'.$udom.'/pending'; + } else { + $logmsg = "batchcreatecourse::create_courses() called without username and/or domain of requesting Domain Coordinator"; } } if (@{$requests} > 0) { @@ -179,7 +219,9 @@ sub create_courses { &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} = $enrollcount; + if ($courseid =~m{^/$match_domain/$match_courseid}) { + $$courseids{$courseid} = $details{$num}{'class'}; + } } } } @@ -207,7 +249,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','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 @@ -260,7 +302,7 @@ sub parse_coursereqs { } elsif ("@state" eq "class owner authtype") { $$details{$num}{'ownerauthtype'} = $text; } elsif ("@state" eq "class owner autharg") { - $$details{$num}{'ownerautharg'} = $text; + $$details{$num}{'ownerauthparam'} = $text; } elsif ("@state" eq "class authentication method") { $$details{$num}{'authtype'} = $text; } elsif ("@state" eq "class authentication param") { @@ -318,9 +360,6 @@ sub parse_coursereqs { $p->parse_file($coursefile); $p->eof; - if (-e "$coursefile") { -# unlink $coursefile; - } return; } @@ -347,7 +386,7 @@ sub parse_coursereqs { ######################################################### sub build_course { - my ($cdom,$num,$context,$details,$longoles,$logmsg,$newusermsg,$addresult,$enrollcount,$output,$keysmsg) = @_; + my ($cdom,$num,$context,$details,$longroles,$logmsg,$newusermsg,$addresult,$enrollcount,$output,$keysmsg,$udom,$uname) = @_; my $owner_uname = $$details{$num}{'owner'}; my $owner_domain = $$details{$num}{'domain'}; my $owner = $owner_uname.':'.$owner_domain; @@ -374,28 +413,30 @@ sub build_course { $firstres = 'syl'; } foreach my $secid (sort keys %{$$details{$num}{'sections'}}) { - $sectionstr .= $$details{$num}{'sections'}{$secid}{'inst'}.':'.$$details{$num}{'sections'}{$secid}{'loncapa'}; + $sectionstr .= $$details{$num}{'sections'}{$secid}{'inst'}.':'.$$details{$num}{'sections'}{$secid}{'loncapa'}.','; } + $sectionstr =~ s/,$//; foreach my $xlist (sort keys %{$$details{$num}{'crosslists'}}) { - $xliststr .= $$details{$num}{'crosslists'}{$xlist}{'inst'}.':'.$$details{$num}{'crosslists'}{$xlist}{'loncapa'}; + $xliststr .= $$details{$num}{'crosslists'}{$xlist}{'inst'}.':'.$$details{$num}{'crosslists'}{$xlist}{'loncapa'}.','; } + $xliststr =~ s/,$//; my %courseinfo = ( inst_code => $$details{$num}{'coursecode'}, description => $$details{$num}{'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'}, + my $ownerargs = {'auth' => $$details{$num}{'ownerauthtype'}, 'authparam' => $$details{$num}{'ownerauthparam'}, 'emailenc' => $$details{$num}{'emailenc'}, - 'dom' => $$details{$num}{'domain'}, + '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'}, + 'pid' => $$details{$num}{'users'}{$owner}{'studentID'}, + 'first' => $$details{$num}{'users'}{$owner}{'firstname'}, + 'middle' => $$details{$num}{'users'}{$owner}{'middlename'}, + 'last' => $$details{$num}{'users'}{$owner}{'lastname'}, + 'gene' => $$details{$num}{'users'}{$owner}{'generation'}, 'usec' => '', 'end' => '', 'start' => '', @@ -403,22 +444,25 @@ sub build_course { 'cid' => '', 'context' => 'createowner', 'linefeed' => $linefeed, - 'role' => 'cc' - ); - $outcome = &LONCAPA::Enrollment::create_newuser($ownerargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,$courseinfo); + 'role' => 'cc', + }; + $outcome = &LONCAPA::Enrollment::create_newuser($ownerargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,\%courseinfo,$context); } else { $outcome = 'ok'; } - my $courseargs = { + if ($outcome eq 'ok') { + my $courseargs = { ccuname => $$details{$num}{'owner'}, ccdomain => $$details{$num}{'domain'}, cdescr => $$details{$num}{'title'}, + crstype => $$details{$num}{'crstype'}, curl => $$details{$num}{'topmap'}, course_domain => $cdom, course_home => $$details{$num}{'coursehome'}, nonstandard => $$details{$num}{'nonstandard'}, crscode => $$details{$num}{'coursecode'}, + crsquota => $$details{$num}{'crsquota'}, clonecourse => $$details{$num}{'clonecrs'}, clonedomain => $$details{$num}{'clonedom'}, crsid => $$details{$num}{'optional_id'}, @@ -437,7 +481,7 @@ sub build_course { enrollend => $$details{$num}{'enrollend'}, startaccess => $$details{$num}{'accessstart'}, endaccess => $$details{$num}{'accessend'}, - setpolicy => $Sdetails{$num}{'setpolicy'}, + setpolicy => $$details{$num}{'setpolicy'}, setcontent => $$details{$num}{'setcontent'}, reshome => $reshome, setkeys => $$details{$num}{'setkeys'}, @@ -448,14 +492,16 @@ sub build_course { firstres => $firstres }; - if ($outcome eq 'ok') { - my %host_servers = &Apache::loncommon::get_library_servers($cdom); + my %host_servers = &Apache::lonnet::get_servers($cdom,'library'); if (! exists($host_servers{$$details{$num}{'coursehome'}})) { $$logmsg .= &mt('Invalid home server for course').': '.$$details{$num}{'coursehome'}; return; } - - &Apache::loncreatecourse::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum); + my ($success, $msg) = &Apache::loncommon::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum,$udom,$uname,$context); + $$logmsg .= $msg; + if (!$success) { + return; + } } else { return; } @@ -477,27 +523,30 @@ sub build_course { 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 $userargs = ('auth' => $$details{$num}{'users'}{$userkey}{'authtype'}, - 'authparam' => $$details{$num}{'users'}{$userkey}{'authparam'}, + my $firstsec = $$details{$num}{'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'}, - 'dom' => $userdom, + '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'}, + 'first' => $$details{$num}{'users'}{$userkey}{'firstname'}, + 'middle' => $$details{$num}{'users'}{$userkey}{'middlename'}, + 'last' => $$details{$num}{'users'}{$userkey}{'lastname'}, + 'gene' => $$details{$num}{'users'}{$userkey}{'generation'}, 'usec' => $firstsec, 'end' => $$details{$num}{'users'}{$userkey}{'end'}, 'start' => $$details{$num}{'users'}{$userkey}{'start'}, - 'emailaddr' => $$details{$num}{'users'}{$userkey}{'email'}, + 'emailaddr' => $$details{$num}{'users'}{$userkey}{'emailaddr'}, 'cid' => $courseid, + 'crs' => $crsunum, + 'cdom' => $crsudom, 'context' => 'createcourse', 'linefeed' => $linefeed, 'role' => $$details{$num}{'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)) { @@ -510,7 +559,7 @@ sub build_course { if ($usec ne '') { $url .= '/'.$usec; } - $$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec); + $$output .= &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); } } if (@{$$details{$num}{'users'}{$userkey}{'roles'}} > 1) { @@ -524,14 +573,14 @@ sub build_course { if ($usec ne '') { $url .= '/'.$usec; } - $$output .= &Apache::loncreateuser::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec); + $$output .= &Apache::loncommon::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); } else { foreach my $usec (@{$$details{$num}{'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); + $$output .= &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); } } } @@ -547,7 +596,7 @@ sub build_course { if ($usec ne '') { $url .= '/'.$usec; } - $$output .= &Apache::loncreateuser::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec); + $$output .= &Apache::loncommon::commit_studentrole(\$stulogmsg,$userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); } else { if (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}} > 0) { foreach my $usec (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}}) { @@ -555,14 +604,12 @@ sub build_course { if ($usec ne '') { $url .= '/'.$usec; } - $$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec); - $url = '/'.$crsudom.'/'.$crsunum; - if ($usec ne '') { - $url .= '/'.$usec; - } + my $stdresult = &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); + $$output .= $stdresult; } } else { - $$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,''); + $url = '/'.$crsudom.'/'.$crsunum; + $$output .= &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,'',$context); } } } @@ -592,16 +639,56 @@ sub build_course { sub process_date { my $timestr = shift; my $timestamp = ''; - if ($timestr eq "No end 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; } - $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;