# The LearningOnline Network
# Create a course
#
# $Id: loncreatecourse.pm,v 1.40 2003/12/05 15:57:37 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/
#
# (My Desk
#
# (Internal Server Error Handler
#
# (Login Screen
# 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14,
# 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer)
#
# 3/1/1 Gerd Kortemeyer)
#
# 3/1 Gerd Kortemeyer)
#
# 2/14,2/16,2/17,7/6 Gerd Kortemeyer
#
package Apache::loncreatecourse;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonratedt;
use Apache::londocs;
use Apache::lonlocal;
# ================================================ Get course directory listing
sub crsdirlist {
my ($courseid,$which)=@_;
unless ($which) { $which=''; }
my %crsdata=&Apache::lonnet::coursedescription($courseid);
my @listing=&Apache::lonnet::dirlist
($which,$crsdata{'domain'},$crsdata{'num'},
&Apache::loncommon::propath($crsdata{'domain'},$crsdata{'num'}));
my @output=();
foreach (@listing) {
unless ($_=~/^\./) {
push (@output,(split(/\&/,$_))[0]);
}
}
return @output;
}
# ============================================================= Read a userfile
sub readfile {
my ($courseid,$which)=@_;
my %crsdata=&Apache::lonnet::coursedescription($courseid);
return &Apache::lonnet::getfile('/uploaded/'.$crsdata{'domain'}.'/'.
$crsdata{'num'}.'/'.$which);
}
# ============================================================ Write a userfile
sub writefile {
(my $courseid, my $which,$ENV{'form.output'})=@_;
my %crsdata=&Apache::lonnet::coursedescription($courseid);
return &Apache::lonnet::finishuserfileupload(
$crsdata{'num'},$crsdata{'domain'},
$crsdata{'home'},
'output',$which);
}
# ===================================================================== Rewrite
sub rewritefile {
my ($contents,%rewritehash)=@_;
foreach (keys %rewritehash) {
my $pattern=$_;
$pattern=~s/(\W)/\\$1/gs;
my $new=$rewritehash{$_};
$contents=~s/$pattern/$new/gs;
}
return $contents;
}
# ============================================================= Copy a userfile
sub copyfile {
my ($origcrsid,$newcrsid,$which)=@_;
unless ($which=~/\.sequence$/) {
return &writefile($newcrsid,$which,
&readfile($origcrsid,$which));
} else {
my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
return &writefile($newcrsid,$which,
&rewritefile(
&readfile($origcrsid,$which),
(
'/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
=> '/uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/'
)));
}
}
# =============================================================== Copy a dbfile
sub copydb {
my ($origcrsid,$newcrsid,$which)=@_;
$which=~s/\.db$//;
my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
my %data=&Apache::lonnet::dump
($which,$origcrsdata{'domain'},$origcrsdata{'num'});
return &Apache::lonnet::put
($which,\%data,$newcrsdata{'domain'},$newcrsdata{'num'});
}
# ========================================================== Copy resourcesdata
sub copyresourcedb {
my ($origcrsid,$newcrsid)=@_;
my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
my %data=&Apache::lonnet::dump
('resourcedata',$origcrsdata{'domain'},$origcrsdata{'num'});
$origcrsid=~s/^\///;
$origcrsid=~s/\//\_/;
$newcrsid=~s/^\///;
$newcrsid=~s/\//\_/;
my %newdata=();
undef %newdata;
my $startdate=$data{$origcrsid.'.0.opendate'};
my $today=time;
my $delta=0;
if ($startdate) {
my $oneday=60*60*24;
$delta=$today-$startdate;
$delta=int($delta/$oneday)*$oneday;
}
# ugly retro fix for broken version of types
foreach (keys %data) {
if ($_=~/\wtype$/) {
my $newkey=$_;
$newkey=~s/type$/\.type/;
$data{$newkey}=$data{$_};
delete $data{$_};
}
}
# adjust symbs
my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/';
$pattern=~s/(\W)/\\$1/gs;
my $new= 'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/';
foreach (keys %data) {
if ($_=~/$pattern/) {
my $newkey=$_;
$newkey=~s/$pattern/$new/;
$data{$newkey}=$data{$_};
delete $data{$_};
}
}
# adjust dates
foreach (keys %data) {
my $thiskey=$_;
$thiskey=~s/^$origcrsid/$newcrsid/;
$newdata{$thiskey}=$data{$_};
if ($data{$_.'.type'}=~/^date/) {
$newdata{$thiskey}=$newdata{$thiskey}+$delta;
}
}
return &Apache::lonnet::put
('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'});
}
# ========================================================== Copy all userfiles
sub copyuserfiles {
my ($origcrsid,$newcrsid)=@_;
foreach (&crsdirlist($origcrsid,'userfiles')) {
©file($origcrsid,$newcrsid,$_);
}
}
# ========================================================== Copy all userfiles
sub copydbfiles {
my ($origcrsid,$newcrsid)=@_;
foreach (&crsdirlist($origcrsid)) {
if ($_=~/\.db$/) {
unless
($_=~/^(nohist\_|discussiontimes|classlist|versionupdate|resourcedata)/) {
©db($origcrsid,$newcrsid,$_);
}
}
}
}
# ======================================================= Copy all course files
sub copycoursefiles {
my ($origcrsid,$newcrsid)=@_;
©userfiles($origcrsid,$newcrsid);
©dbfiles($origcrsid,$newcrsid);
©resourcedb($origcrsid,$newcrsid);
}
# ===================================================== Phase one: fill-in form
sub print_course_creation_page {
my $r=shift;
my $defdom=$ENV{'request.role.domain'};
my %host_servers = &Apache::loncommon::get_library_servers($defdom);
my $course_home = '\n";
my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');
my $bodytag=&Apache::loncommon::bodytag('Create a New Course');
my $helplink=&Apache::loncommon::help_open_topic('Create_Course','Help on Creating Courses');
my $cloneform=&Apache::loncommon::select_dom_form
($ENV{'request.role.domain'},'clonedomain').
&Apache::loncommon::selectcourse_link
('ccrs','clonecourse','clonedomain');
my $coursebrowserjs=&Apache::loncommon::coursebrowser_javascript();
my $date_table = &date_setting_table();
my ($krbdef,$krbdefdom) =
&Apache::loncommon::get_kerberos_defaults($defdom);
my $javascript_validations=&javascript_validations($krbdefdom);
my %param = ( formname => 'document.ccrs',
kerb_def_dom => $krbdefdom,
kerb_def_auth => $krbdef
);
my $krbform = &Apache::loncommon::authform_kerberos(%param);
my $intform = &Apache::loncommon::authform_internal(%param);
my $locform = &Apache::loncommon::authform_local(%param);
$r->print(<
Automated adds Yes No
Automated drops Yes No
Duration of automated classlist updates $date_table
Please select the authentication mechanism.
Please choose the default authentication method to be used by new users added to this LON-CAPA domain by the automated enrollment process.
$krbform
$intform
$locform
Notification of enrollment changes
Notification to course coordinator via LON-CAPA message when enrollment changes occur during the automated update?
Yes No
Include retrieval of student photographs? Yes No