--- 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') {