# # $Id: batchcreatecourse.pm,v 1.23 2007/08/23 21:54:37 albertel 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::lonnet; 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 # script via a cron entry, or alternatively from a web page, after upload # 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 # # &create_courses() will create an account for the course owner # (if one does not currently exist), will create the course (cloning if necessary), # and will add additional instructional staff (creating accounts if necessary). # # Example of XML file (which could contain more than one class to be created): # # # # # Underwater Basket Weaving # Course # ss05ubw101 # msul1 # msu # /res/msu/ # # 1 # 1 # 2005:01:04:10:30 # 2005:07:04:20:30 # 2005:01:10:10:30 # 2005:05:31:10:30 # # krb4 # MSU.EDU # # # # nav # 20 # 466011437c34194msul1 # msu # # 1 # 1 # 0 # keyadmin:msu # 1 # 1 # # 1 # 1 # # sparty # msu # krb4 # MSU.EDU # # #
# 001 # 1 #
#
# 002 # 2 #
#
# # # ss05zzz101001 # 1 # # # # # sparty # msu # sparty@msu.edu # krb4 # # MSU # # Spartanx # # # # # # itds0001 # northwood5 # itds0001@msu.edu # int # # Info # # Techcx # # # # # 2005:01:01:12:10 # 2005:12:01:12:10 # 1 # 2 # # # # #
# # Many of these are binary options (corresponding to either checkboxes or # radio buttons in the interactive CCRS page). Examples include: # setpolicy, setcontent, setkeys, disableresdis, disablechat, openall # # A value of 1 between opening and closing tags is equivalent to a # checked checkbox or 'Yes' response in the original CCRS web page. # 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 # 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. # ############################################################## # create_courses() - creates courses described in @$requests, # files listed in @$requests are deleted # after the files have been parsed. # # 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 # udom - domain of DC who is requesting course creation # # outputs (three) - output - text recording user roles added etc. # logmsg - text to be logged # keysmsg - text containing link(s) to manage keys page(s) ############################################################# sub create_courses { 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"); my @rolesplain = ; close(FILE); foreach (@rolesplain) { if ($_ =~ /^(st|ta|ex|ad|in|cc):([\w\s]+)$/) { $longroles{$1} = $2; } } my ($logmsg,$keysmsg,$newusermsg,$addresult); my %enrollcount = (); my $newcoursedir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$dom.'/'.$context; 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) { foreach my $request (@{$requests}) { 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); if ($courseid =~ /^$match_courseid$/) { $$courseids{$courseid} = $details{$num}{'class'}; } } } } } return ($output,$logmsg,$keysmsg); } ############################################################# # # parse_coursereqs() # inputs (two) - coursefile - path to XML file containing course(s) to be created. # - details - reference to hash containing extracted information. # outputs (none) # ############################################################ sub parse_coursereqs { my ($coursefile,$details) = @_; # Note all start and end dates should be in this format: # YYYY:MM:DD:HH:MM:SS (:separators required). my $uname = ''; my @state = (); my $num = 0; my $secid = 0; 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','crstype','crsquota'); my @dateitems = ('enrollstart','enrollend','accessstart','accessend'); my @useritems = ('autharg','authtype','firstname','generation','lastname','middlename','studentID'); my $p = HTML::Parser->new ( xml_mode => 1, start_h => [sub { my ($tagname, $attr) = @_; push(@state, $tagname); if ("@state" eq "class") { %{$$details{$num}} = (); $$details{$num}{'class'} = $attr->{id}; %{$$details{$num}{'users'}} = (); %{$$details{$num}{'sections'}} = (); $secid = 0; $xlist = 0; } if ("@state" eq "class users user roles role") { $role = $attr->{id}; if ($role =~ /^(st|ad|ep|ta|in|cc)$/) { push(@{$$details{$num}{'users'}{$userkey}{'roles'}}, $role); %{$$details{$num}{'users'}{$userkey}{$role}} = (); @{$$details{$num}{'users'}{$userkey}{$role}{'usec'}} = (); } } if ("@state" eq "class sections section") { $secid ++; %{$$details{$num}{'sections'}{$secid}} = (); } if ("@state" eq "class crosslists xlist") { $xlist ++; %{$$details{$num}{'crosslists'}{$xlist}} = (); } }, "tagname, attr"], text_h => [sub { my ($text) = @_; if ("@state" eq "class owner username") { $$details{$num}{'owner'} = $text; } elsif ("@state" eq "class owner domain") { $$details{$num}{'domain'} = $text; } elsif ("@state" eq "class sections section inst") { $$details{$num}{'sections'}{$secid}{'inst'} = $text; } elsif ("@state" eq "class sections section loncapa") { $$details{$num}{'sections'}{$secid}{'loncapa'} = $text; } elsif ("@state" eq "class crosslists xlist inst") { $$details{$num}{'crosslists'}{$xlist}{'inst'} = $text; } elsif ("@state" eq "class crosslists xlist loncapa") { $$details{$num}{'crosslists'}{$xlist}{'loncapa'} = $text; } elsif ("@state" eq "class owner authtype") { $$details{$num}{'ownerauthtype'} = $text; } elsif ("@state" eq "class owner autharg") { $$details{$num}{'ownerauthparam'} = $text; } elsif ("@state" eq "class authentication method") { $$details{$num}{'authtype'} = $text; } elsif ("@state" eq "class authentication param") { $$details{$num}{'authparam'} = $text; } elsif ("@state" eq "class users user username") { $userkey = $text; } elsif ("@state" eq "class users user domain") { $userkey .= ':'.$text; %{$$details{$num}{'users'}{$userkey}} = (); @{$$details{$num}{'users'}{$userkey}{'roles'}} = (); } elsif ("@state" eq "class users user email") { $$details{$num}{'users'}{$userkey}{'emailaddr'} = $text; $$details{$num}{'users'}{$userkey}{'emailenc'} = &Apache::lonnet::escape($text); } elsif ("@state" eq "class users user roles role start") { if ($role =~ /^(st|ad|ep|ta|in|cc)$/) { $$details{$num}{'users'}{$userkey}{$role}{'start'} = &process_date($text); } } elsif ("@state" eq "class users user roles role end") { if ($role =~ /^(st|ad|ep|ta|in|cc)$/) { $$details{$num}{'users'}{$userkey}{$role}{'end'} = &process_date($text); } } elsif ("@state" eq "class users user roles role usec") { if ($role =~ /^(st|ad|ep|ta|in|cc)$/) { unless ($text eq '') { push(@{$$details{$num}{'users'}{$userkey}{$role}{'usec'}},$text); } } } else { foreach my $item (@items) { if ("@state" eq "class $item") { $$details{$num}{$item} = $text; } } foreach my $item (@dateitems) { if ("@state" eq "class $item") { $$details{$num}{$item} = &process_date($text); } } foreach my $item (@useritems) { if ("@state" eq "class users user $item") { $$details{$num}{'users'}{$userkey}{$item} = $text; } } } }, "dtext"], end_h => [sub { my ($tagname) = @_; if ("@state" eq "class") { $num ++; } pop @state; }, "tagname"], ); $p->parse_file($coursefile); $p->eof; return; } ######################################################### # # build_course() # # inputs # 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 # ref to hash of role descriptions # ref to scalar used to accumulate log messages # 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 # # outputs # LON-CAPA courseID for new (created) course # ######################################################### sub build_course { 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; my $sectionstr = ''; my $xliststr = ''; my $noenddate = ''; my $outcome; my ($courseid,$crsudom,$crsunum); my $linefeed; if ($context eq 'auto') { $linefeed = "\n"; } else { $linefeed = "
\n"; } if ($$details{$num}{'accessend'} eq '') { $noenddate = 1; } my $reshome = $$details{$num}{'reshome'}; if ($reshome eq '') { $reshome = '/res/'.$cdom; } my $firstres = $$details{$num}{'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'}.','; } $sectionstr =~ s/,$//; foreach my $xlist (sort keys %{$$details{$num}{'crosslists'}}) { $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'}, 'authparam' => $$details{$num}{'ownerauthparam'}, 'emailenc' => $$details{$num}{'emailenc'}, 'udom' => $$details{$num}{'domain'}, 'uname' => $$details{$num}{'owner'}, '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' => '', 'emailaddr' => $$details{$num}{'users'}{$owner}{'email'}, 'cid' => '', 'context' => 'createowner', 'linefeed' => $linefeed, 'role' => 'cc', }; $outcome = &LONCAPA::Enrollment::create_newuser($ownerargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,\%courseinfo,$context); } else { $outcome = 'ok'; } 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'}, curruser => $$details{$num}{'owner'}, crssections => $sectionstr, crsxlist => $xliststr, autoadds => $$details{$num}{'adds'}, autodrops => $$details{$num}{'drops'}, notify => $$details{$num}{'notify_owner'}, notify_dc => $$details{$num}{'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 => $$details{$num}{'setpolicy'}, setcontent => $$details{$num}{'setcontent'}, reshome => $reshome, setkeys => $$details{$num}{'setkeys'}, keyauth => $$details{$num}{'keyauth'}, disresdis => $$details{$num}{'disresdis'}, disablechat => $$details{$num}{'disablechat'}, openall => $$details{$num}{'openall'}, firstres => $firstres }; 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; } my ($success, $msg) = &Apache::loncommon::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum,$udom,$uname,$context); $$logmsg .= $msg; } else { return; } # # Make owner a course coordinator # if (($owner_domain) && ($owner_uname)) { &Apache::lonnet::assignrole($owner_domain,$owner_uname,$courseid,'cc'); } # # Process other reqested users # my $stulogmsg = ''; foreach my $userkey (sort keys %{$$details{$num}{'users'}}) { my $url = '/'.$crsudom.'/'.$crsunum; if (@{$$details{$num}{'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 $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'}, 'udom' => $userdom, 'uname' => $username, 'pid' => $$details{$num}{'users'}{$userkey}{'studentID'}, '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}{'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,$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++) { 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]; $url = '/'.$crsudom.'/'.$crsunum; if ($usec ne '') { $url .= '/'.$usec; } $$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 ($curr_role eq 'st') { my $usec = $$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}[0]; $url = '/'.$crsudom.'/'.$crsunum; if ($usec ne '') { $url .= '/'.$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::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context); } } } } } } 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'}; if ($curr_role eq 'st') { my $usec = $$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}[0]; $url = '/'.$crsudom.'/'.$crsunum; if ($usec ne '') { $url .= '/'.$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'}}) { $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 { $url = '/'.$crsudom.'/'.$crsunum; $$output .= &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,'',$context); } } } } } } # Information about keys. if ($$details{$num}{'setkeys'}) { $$keysmsg .= ''.&mt('Manage Access Keys').' for '.$$details{$num}{'title'}.$linefeed; } # Flush the course logs so reverse user roles immediately updated &Apache::lonnet::flushcourselogs(); return $courseid; } ######################################################### # # process_date() # # input - date/time string in format YYYY:MM:DD:HH:MM:SS (:separators required). # output - corresponding UNIX time (seconds since epoch). # ######################################################### sub process_date { my $timestr = shift; my $timestamp = ''; if ($timestr !~ /:/) { $timestamp = ''; } else { 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; } 1;