--- loncom/interface/loncreatecourse.pm 2003/09/03 21:31:59 1.34
+++ loncom/interface/loncreatecourse.pm 2003/11/12 21:37:07 1.39
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Create a course
#
-# $Id: loncreatecourse.pm,v 1.34 2003/09/03 21:31:59 www Exp $
+# $Id: loncreatecourse.pm,v 1.39 2003/11/12 21:37:07 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -47,18 +47,7 @@ use Apache::lonnet;
use Apache::loncommon;
use Apache::lonratedt;
use Apache::londocs;
-
-# -------------------------------------------- Return path to profile directory
-
-sub propath {
- my ($udom,$uname)=@_;
- $udom=~s/\W//g;
- $uname=~s/\W//g;
- my $subdir=$uname.'__';
- $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
- my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
- return $proname;
-}
+use Apache::lonlocal;
# ================================================ Get course directory listing
@@ -68,7 +57,7 @@ sub crsdirlist {
my %crsdata=&Apache::lonnet::coursedescription($courseid);
my @listing=&Apache::lonnet::dirlist
($which,$crsdata{'domain'},$crsdata{'num'},
- &propath($crsdata{'domain'},$crsdata{'num'}));
+ &Apache::loncommon::propath($crsdata{'domain'},$crsdata{'num'}));
my @output=();
foreach (@listing) {
unless ($_=~/^\./) {
@@ -98,11 +87,37 @@ sub writefile {
'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)=@_;
- return &writefile($newcrsid,$which,&readfile($origcrsid,$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
@@ -118,6 +133,62 @@ sub copydb {
($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 {
@@ -146,6 +217,7 @@ sub copycoursefiles {
my ($origcrsid,$newcrsid)=@_;
©userfiles($origcrsid,$newcrsid);
©dbfiles($origcrsid,$newcrsid);
+ ©resourcedb($origcrsid,$newcrsid);
}
# ===================================================== Phase one: fill-in form
@@ -350,10 +422,15 @@ ENDENHEAD
} else {
$r->print(
'
Cloning course from '.$clonehome.'');
+ my %oldcenv=&Apache::lonnet::dump('environment',$crsudom,$crsunum);
# Copy all files
©coursefiles($cloneid,$courseid);
+# Restore URL
+ $cenv{'url'}=$oldcenv{'url'};
# Restore title
- $cenv{'description'}=$cdescr;
+ $cenv{'description'}=$oldcenv{'description'};
+# Mark as cloned
+ $cenv{'clonedfrom'}=$cloneid;
}
}
#
@@ -454,13 +531,13 @@ sub handler {
my $r = shift;
if ($r->header_only) {
- $r->content_type('text/html');
+ &Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
return OK;
}
if (&Apache::lonnet::allowed('ccc',$ENV{'request.role.domain'})) {
- $r->content_type('text/html');
+ &Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
if ($ENV{'form.phase'} eq 'two') {