# The LearningOnline Network
# routines for clone a course
#
# $Id: lonclonecourse.pm,v 1.3 2007/08/02 01:34:07 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 Apache::lonclonecourse;
use LONCAPA;
use Apache::lonnet;
# ================================================ Get course directory listing
my @output=();
sub crsdirlist {
my ($courseid,$which)=@_;
@output=();
return &innercrsdirlist($courseid,$which);
}
sub innercrsdirlist {
my ($courseid,$which,$path)=@_;
my $dirptr=16384;
unless ($which) { $which=''; } else { $which.='/'; }
unless ($path) { $path=''; } else { $path.='/'; }
my %crsdata=&Apache::lonnet::coursedescription($courseid);
my @listing=&Apache::lonnet::dirlist
($which,$crsdata{'domain'},$crsdata{'num'},
&propath($crsdata{'domain'},$crsdata{'num'}));
foreach (@listing) {
unless ($_=~/^\./) {
my @unpackline = split (/\&/,$_);
if ($unpackline[3]&$dirptr) {
# is a directory, recurse
&innercrsdirlist($courseid,$which.$unpackline[0],
$path.$unpackline[0]);
} else {
# is a file, put into output
push (@output,$path.$unpackline[0]);
}
}
}
return @output;
}
# ============================================================= Read a userfile
sub readfile {
my ($courseid,$which)=@_;
my %crsdata=&Apache::lonnet::coursedescription($courseid);
my $file = &Apache::lonnet::getfile('/uploaded/'.$crsdata{'domain'}.'/'.
$crsdata{'num'}.'/'.$which);
return $file;
}
# ============================================================ Write a userfile
sub writefile {
(my $courseid, my $which,$env{'form.output'})=@_;
my %crsdata=&Apache::lonnet::coursedescription($courseid);
my $data = &Apache::lonnet::finishuserfileupload(
$crsdata{'num'},$crsdata{'domain'},
'output',$which);
return $data;
}
# ===================================================================== Rewrite
sub rewritefile {
my ($contents,%rewritehash)=@_;
foreach my $pattern (keys(%rewritehash)) {
my $new=$rewritehash{$pattern};
$contents=~s/\Q$pattern\E/$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'}.'/',
'/public/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
=> '/public/'. $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'});
foreach my $key (keys(%data)) {
if ($key=~/^internal./) { delete($data{$key}); }
}
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'};
if (!$startdate) {
# now global start date for assements try the enrollment start
my %start=&Apache::lonnet::get('environment',
['default_enrollment_start_date'],
$origcrsdata{'domain'},$origcrsdata{'num'});
$startdate = $start{'default_enrollment_start_date'};
}
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'}.'/';
my $new= 'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/';
foreach (keys %data) {
if ($_=~/\Q$pattern\E/) {
my $newkey=$_;
$newkey=~s/\Q$pattern\E/$new/;
$data{$newkey}=$data{$_};
delete $data{$_};
}
}
# adjust dates
foreach (keys %data) {
my $thiskey=$_;
$thiskey=~s/^$origcrsid/$newcrsid/;
$newdata{$thiskey}=$data{$_};
if ($data{$_.'.type'}=~/^date_(start|end)$/) {
if ($delta > 0) {
$newdata{$thiskey}=$newdata{$thiskey}+$delta;
} else {
# no delta, it's unlikely we want the old dates and times
delete($newdata{$thiskey});
delete($newdata{$thiskey.'.type'});
}
}
}
return &Apache::lonnet::put
('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'});
}
# ========================================================== Copy all userfiles
sub copyuserfiles {
my ($origcrsid,$newcrsid)=@_;
foreach (&crsdirlist($origcrsid,'userfiles')) {
if ($_ !~m|^scantron_|) {
©file($origcrsid,$newcrsid,$_);
}
}
}
# ========================================================== Copy all userfiles
sub copydbfiles {
my ($origcrsid,$newcrsid)=@_;
my ($origcrs_discussion) = ($origcrsid=~m|^/(.*)|);
$origcrs_discussion=~s|/|_|g;
foreach (&crsdirlist($origcrsid)) {
if ($_=~/\.db$/) {
unless
($_=~/^(nohist\_|discussiontimes|classlist|versionupdate|resourcedata|\Q$origcrs_discussion\E|slots|slot_reservations|gradingqueue|reviewqueue|CODEs|groupmembership)/) {
©db($origcrsid,$newcrsid,$_);
}
}
}
}
# ======================================================= Copy all course files
sub copycoursefiles {
my ($origcrsid,$newcrsid)=@_;
©userfiles($origcrsid,$newcrsid);
©dbfiles($origcrsid,$newcrsid);
©resourcedb($origcrsid,$newcrsid);
}
1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>