package LONCAPA::batchcreatecourse; 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; # 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. Each XML file is deleted after it has been # parsed. # # &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 # 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 # 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. # 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 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 # # 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 # # 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) = @_; 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 ($uname) { unless ($context eq 'auto') { $newcoursedir .= '/'.$uname; } } 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); $$courseids{$courseid} = $enrollcount; } } } } 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'); 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}{'ownerautharg'} = $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; if (-e "$coursefile") { # unlink $coursefile; } 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,$longoles,$logmsg,$newusermsg,$addresult,$enrollcount,$output,$keysmsg) = @_; 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'}; } foreach my $xlist (sort keys %{$$details{$num}{'crosslists'}}) { $xliststr .= $$details{$num}{'crosslists'}{$xlist}{'inst'}.':'.$$details{$num}{'crosslists'}{$xlist}{'loncapa'}; } 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'}, 'dom' => $$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'}, '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); } else { $outcome = 'ok'; } my $courseargs = { ccuname => $$details{$num}{'owner'}, ccdomain => $$details{$num}{'domain'}, cdescr => $$details{$num}{'title'}, curl => $$details{$num}{'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'}, 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 => $Sdetails{$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 }; if ($outcome eq 'ok') { 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'}; return; } &Apache::loncreatecourse::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum); } 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 $firssec = $$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}[0]; my $userargs = ('auth' => $$details{$num}{'users'}{$userkey}{'authtype'}, 'authparam' => $$details{$num}{'users'}{$userkey}{'authparam'}, 'emailenc' => $$details{$num}{'users'}{$userkey}{'emailenc'}, 'dom' => $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'}, 'usec' => $firstsec, 'end' => $$details{$num}{'users'}{$userkey}{'end'}, 'start' => $$details{$num}{'users'}{$userkey}{'start'}, 'emailaddr' => $$details{$num}{'users'}{$userkey}{'email'}, 'cid' => $courseid, 'context' => 'createcourse', 'linefeed' => $linefeed, 'role' => $$details{$num}{'users'}{$userkey}{'roles'}[0], ); $outcome = &LONCAPA::Enrollment::create_newuser($userargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,$courseinfo); # 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::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec); } } 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::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'}}) { $url = '/'.$crsudom.'/'.$crsunum; if ($usec ne '') { $url .= '/'.$usec; } $$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec); } } } } } } 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::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'}}) { $url = '/'.$crsudom.'/'.$crsunum; 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; } } } else { $$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,''); } } } } } } # 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 eq "No end date") { $timestamp = ''; } else { my @entries = split/:/,$timestr; for (my $j=0; $j<@entries; $j++) { if ( length($entries[$j]) > 1 ) { $entries[$j] =~ s/^0//; } } $entries[1] = $entries[1] - 1; $timestamp = timelocal($entries[5],$entries[4],$entries[3],$entries[2],$entries[1],$entries[0]); } return $timestamp; } 1; 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.