Diff for /loncom/automation/batchcreatecourse.pm between versions 1.12 and 1.28

version 1.12, 2006/05/26 15:37:14 version 1.28, 2009/08/08 19:55:15
Line 29  use LONCAPA::Configuration; Line 29  use LONCAPA::Configuration;
 use LONCAPA::Enrollment;  use LONCAPA::Enrollment;
 use HTML::Parser;  use HTML::Parser;
 use Time::Local;  use Time::Local;
 use Apache::Constants;   
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon;  use Apache::loncommon;
 use Apache::loncreatecourse;  
 use Apache::loncreateuser;  
 use Apache::lonlocal;  use Apache::lonlocal;
   use LONCAPA qw(:match);
   
 use strict;  use strict;
   
Line 56  use strict; Line 54  use strict;
 #<!DOCTYPE text>  #<!DOCTYPE text>
 #<class id="ss05ubw101">  #<class id="ss05ubw101">
 # <title>Underwater Basket Weaving</title>  # <title>Underwater Basket Weaving</title>
   # <crstype>Course</crstype>
 # <coursecode>ss05ubw101</coursecode>  # <coursecode>ss05ubw101</coursecode>
 # <coursehome>msul1</coursehome>  # <coursehome>msul1</coursehome>
 # <coursedomain>msu</coursedomain>  # <coursedomain>msu</coursedomain>
Line 74  use strict; Line 73  use strict;
 # <nonstandard></nonstandard>  # <nonstandard></nonstandard>
 # <topmap></topmap>  # <topmap></topmap>
 # <firstres>nav</firstres>  # <firstres>nav</firstres>
   # <crsquota>20</crsquota>
 # <clonecrs>466011437c34194msul1</clonecrs>  # <clonecrs>466011437c34194msul1</clonecrs>
 # <clonedom>msu</clonedom>  # <clonedom>msu</clonedom>
   # <datemode>shift</datemode>
   # <dateshift>365</dateshift>
 # <showphotos></showphotos>  # <showphotos></showphotos>
 # <setpolicy>1</setpolicy>  # <setpolicy>1</setpolicy>
 # <setcontent>1</setcontent>  # <setcontent>1</setcontent>
 # <setkeys>0</setkeys>  # <setkeys>0</setkeys>
 # <keyauth>keyadmin@msu</keyauth>  # <keyauth>keyadmin:msu</keyauth>
 # <disresdis>1</disresdis>  # <disresdis>1</disresdis>
 # <disablechat>1</disablechat>  # <disablechat>1</disablechat>
 # <openall></openall>  # <openall></openall>
Line 154  use strict; Line 156  use strict;
 # A value of 0 or blank is equivalent to an unchecked box or 'No'  # 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)  # 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.  # 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  # For format of other parameters, refer to the interactive CCRS page
 # and view how the equivalent parameter is displayed in the web form.    # and view how the equivalent parameter is displayed in the web form.  
 #    #  
Line 166  use strict; Line 174  use strict;
 #  #
 #                    Directory for retrieval of files listed in @$requests is:   #                    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/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   # 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   #                   courseids - ref to hash to store LON-CAPA course ids of new courses 
Line 201  sub create_courses { Line 209  sub create_courses {
         $newcoursedir .= '/pending';          $newcoursedir .= '/pending';
     } else {      } else {
         if ($uname && $udom) {          if ($uname && $udom) {
             $newcoursedir .= '/'.$udom.'_'.$uname;              $newcoursedir .= '/'.$uname.'_'.$udom.'/pending';
         } else {          } else {
             $logmsg = "batchcreatecourse::create_courses() called without username and/or domain of requesting Domain Coordinator";              $logmsg = "batchcreatecourse::create_courses() called without username and/or domain of requesting Domain Coordinator";
         }          }
Line 213  sub create_courses { Line 221  sub create_courses {
                 &parse_coursereqs($newcoursedir.'/'.$request, \%details);                  &parse_coursereqs($newcoursedir.'/'.$request, \%details);
                 foreach my $num (sort keys %details) {                  foreach my $num (sort keys %details) {
                     my $courseid = &build_course($dom,$num,$context,\%details,\%longroles,\$logmsg,\$newusermsg,\$addresult,\%enrollcount,\$output,\$keysmsg);                      my $courseid = &build_course($dom,$num,$context,\%details,\%longroles,\$logmsg,\$newusermsg,\$addresult,\%enrollcount,\$output,\$keysmsg);
                     $$courseids{$courseid} = $details{$num}{'class'};                      if ($courseid =~m{^/$match_domain/$match_courseid}) {
                           $$courseids{$courseid} = $details{$num}{'class'};
                       }
                 }                  }
             }              }
         }          }
Line 241  sub parse_coursereqs { Line 251  sub parse_coursereqs {
     my $xlist = 0;      my $xlist = 0;
     my $userkey = '';      my $userkey = '';
     my $role = '';      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 @dateitems = ('enrollstart','enrollend','accessstart','accessend');
     my @useritems = ('autharg','authtype','firstname','generation','lastname','middlename','studentID');      my @useritems = ('autharg','authtype','firstname','generation','lastname','middlename','studentID');
     my $p = HTML::Parser->new      my $p = HTML::Parser->new
Line 360  sub parse_coursereqs { Line 370  sub parse_coursereqs {
 # build_course()   # build_course() 
 #  #
 # inputs  # inputs
 #   domain  #   course domain
 #   course request number  #   course request number
 #   context - auto if called from command line, web if called from DC web interface  #   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 course creation information
Line 369  sub parse_coursereqs { Line 379  sub parse_coursereqs {
 #   ref to scalar used to accumulate messages sent to new users  #   ref to scalar used to accumulate messages sent to new users
 #   ref to scalar used to accumulate results of new user additions  #   ref to scalar used to accumulate results of new user additions
 #   ref to hash of enrollment counts for different roles  #   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 information about added roles
 #   ref to scalar used to accumulate   #   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  # outputs
 #   LON-CAPA courseID for new (created) course  #   LON-CAPA courseID for new (created) course
Line 378  sub parse_coursereqs { Line 393  sub parse_coursereqs {
 #########################################################  #########################################################
   
 sub build_course {  sub build_course {
     my ($cdom,$num,$context,$details,$longroles,$logmsg,$newusermsg,$addresult,$enrollcount,$output,$keysmsg,$udom,$uname) = @_;      my ($cdom,$num,$context,$details,$longroles,$logmsg,$newusermsg,$addresult,$enrollcount,$output,$keysmsg,$udom,$uname,$cnum) = @_;
     my $owner_uname = $$details{$num}{'owner'};      my $owner_uname = $$details{$num}{'owner'};
     my $owner_domain = $$details{$num}{'domain'};      my $owner_domain = $$details{$num}{'domain'};
     my $owner = $owner_uname.':'.$owner_domain;      my $owner = $owner_uname.':'.$owner_domain;
Line 438  sub build_course { Line 453  sub build_course {
                     'linefeed' => $linefeed,                      'linefeed' => $linefeed,
                     'role' => 'cc',                      'role' => 'cc',
                    };                     };
         $outcome = &LONCAPA::Enrollment::create_newuser($ownerargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,\%courseinfo);          $outcome = &LONCAPA::Enrollment::create_newuser($ownerargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,\%courseinfo,$context);
     } else {      } else {
         $outcome = 'ok';          $outcome = 'ok';
     }      }
   
     if ($outcome eq 'ok') {      if ($outcome eq 'ok') {
           if ($$details{$num}{'datemode'} !~ /^(preserve|shift|delete)$/) {
               $$details{$num}{'datemode'} = 'shift';
               $$details{$num}{'dateshift'} = 365;
           }
         my $courseargs = {          my $courseargs = {
                ccuname => $$details{$num}{'owner'},                 ccuname => $$details{$num}{'owner'},
                ccdomain => $$details{$num}{'domain'},                 ccdomain => $$details{$num}{'domain'},
                cdescr => $$details{$num}{'title'},                 cdescr => $$details{$num}{'title'},
                  crstype => $$details{$num}{'crstype'},
                curl => $$details{$num}{'topmap'},                 curl => $$details{$num}{'topmap'},
                course_domain => $cdom,                 course_domain => $cdom,
                course_home =>  $$details{$num}{'coursehome'},                 course_home =>  $$details{$num}{'coursehome'},
                nonstandard => $$details{$num}{'nonstandard'},                 nonstandard => $$details{$num}{'nonstandard'},
                crscode => $$details{$num}{'coursecode'},                 crscode => $$details{$num}{'coursecode'},
                  crsquota => $$details{$num}{'crsquota'},
                clonecourse => $$details{$num}{'clonecrs'},                 clonecourse => $$details{$num}{'clonecrs'},
                clonedomain => $$details{$num}{'clonedom'},                 clonedomain => $$details{$num}{'clonedom'},
                  datemode => $$details{$num}{'datemode'},
                  dateshift => $$details{$num}{'dateshift'},
                crsid => $$details{$num}{'optional_id'},                 crsid => $$details{$num}{'optional_id'},
                curruser => $$details{$num}{'owner'},                 curruser => $$details{$num}{'owner'},
                crssections => $sectionstr,                 crssections => $sectionstr,
Line 481  sub build_course { Line 504  sub build_course {
                openall => $$details{$num}{'openall'},                 openall => $$details{$num}{'openall'},
                firstres => $firstres                 firstres => $firstres
                };                 };
           my %host_servers = &Apache::lonnet::get_servers($cdom,'library');
         my %host_servers = &Apache::loncommon::get_library_servers($cdom);  
         if (! exists($host_servers{$$details{$num}{'coursehome'}})) {          if (! exists($host_servers{$$details{$num}{'coursehome'}})) {
             $$logmsg .= &mt('Invalid home server for course').': '.$$details{$num}{'coursehome'};              $$logmsg .= &mt('Invalid home server for course').': '.$$details{$num}{'coursehome'};
             return;              return;
         }          }
           my ($success, $msg) = &Apache::loncommon::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum,$udom,$uname,$context,$cnum);
         &Apache::loncreatecourse::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum,$udom,$uname);   $$logmsg .= $msg;
           if (!$success) {
               return;
           }
     } else {      } else {
         return;          return;
     }      }
Line 497  sub build_course { Line 522  sub build_course {
 # Make owner a course coordinator  # Make owner a course coordinator
 #  #
     if (($owner_domain) && ($owner_uname)) {      if (($owner_domain) && ($owner_uname)) {
         &Apache::lonnet::assignrole($owner_domain,$owner_uname,$courseid,'cc');          &Apache::lonnet::assignrole($owner_domain,$owner_uname,$courseid,'cc','','','','',$context);
     }      }
   
 #  #
Line 533  sub build_course { Line 558  sub build_course {
                     'linefeed' => $linefeed,                      'linefeed' => $linefeed,
                     'role' => $$details{$num}{'users'}{$userkey}{'roles'}[0],                       '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.  # now add other roles and other sections.
                 if ($outcome eq 'ok') {                  if ($outcome eq 'ok') {
                     if (($firstrole ne 'st') && (@{$$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}} > 1)) {                      if (($firstrole ne 'st') && (@{$$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}} > 1)) {
Line 546  sub build_course { Line 571  sub build_course {
                             if ($usec ne '') {                              if ($usec ne '') {
                                 $url .= '/'.$usec;                                  $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) {                      if (@{$$details{$num}{'users'}{$userkey}{'roles'}} > 1) {
Line 560  sub build_course { Line 585  sub build_course {
                                 if ($usec ne '') {                                  if ($usec ne '') {
                                     $url .= '/'.$usec;                                      $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 {                              } else {
                                 foreach my $usec (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}}) {                                  foreach my $usec (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}}) {
                                     $url = '/'.$crsudom.'/'.$crsunum;                                      $url = '/'.$crsudom.'/'.$crsunum;
                                     if ($usec ne '') {                                      if ($usec ne '') {
                                         $url .= '/'.$usec;                                          $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);
                                 }                                  }
                             }                              }
                         }                          }
Line 583  sub build_course { Line 608  sub build_course {
                         if ($usec ne '') {                          if ($usec ne '') {
                             $url .= '/'.$usec;                              $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 {                      } else {
                         if (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}} > 0) {                          if (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}} > 0) {
                             foreach my $usec (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}}) {                              foreach my $usec (@{$$details{$num}{'users'}{$userkey}{$curr_role}{'usec'}}) {
Line 591  sub build_course { Line 616  sub build_course {
                                 if ($usec ne '') {                                  if ($usec ne '') {
                                     $url .= '/'.$usec;                                      $url .= '/'.$usec;
                                 }                                  }
                                 my $stdresult = &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec);                                  my $stdresult = &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec,$context);
                                 $$output .= $stdresult;                                  $$output .= $stdresult;
                             }                              }
                         } else {                          } else {
                             $url = '/'.$crsudom.'/'.$crsunum;                              $url = '/'.$crsudom.'/'.$crsunum;
                             $$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,'');                              $$output .= &Apache::loncommon::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,'',$context);
                         }                          }
                     }                      }
                 }                  }
Line 669  sub process_date { Line 694  sub process_date {
             }              }
             if ($entries[2] == 29) {              if ($entries[2] == 29) {
                 if ($entries[0]%4 != 0) {                  if ($entries[0]%4 != 0) {
                     $entries[2] == 28;                      $entries[2] = 28;
                 } elsif ( $entries[0]%100 == 0                  } elsif ( $entries[0]%100 == 0
   && $entries[0]%400 != 0) {    && $entries[0]%400 != 0) {
     $entries[2] == 28;      $entries[2] = 28;
  }   }
             }              }
         }               }     

Removed from v.1.12  
changed lines
  Added in v.1.28


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>