Return to lonclonecourse.pm CVS log

Up to [LON-CAPA] / loncom / interface

Args in call to lonnet::dirlist() needed changing now propath calls have moved to lond.

# The LearningOnline Network
# routines for clone a course
#
# $Id: lonclonecourse.pm,v 1.7 2008/09/11 13:19:28 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/
#
###

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 $getpropath = 1;
    my @listing=&Apache::lonnet::dirlist
	($which,$crsdata{'domain'},$crsdata{'num'},$getpropath);
    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'}.'/',
       '/adm/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
    => '/adm/'.$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,$date_mode,$date_shift)=@_;
    my $delta=$date_shift*60*60*24;
    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'};
    }
# ugly retro fix for broken version of types
    foreach my $key (keys %data) {
	if ($key=~/\wtype$/) {
	    my $newkey=$key;
	    $newkey=~s/type$/\.type/;
	    $data{$newkey}=$data{$key};
	    delete $data{$key};
	}
    }
# adjust symbs
    my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/';
    my $new=    'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/';
    foreach my $key (keys %data) {
	if ($key=~/\Q$pattern\E/) {
	    my $newkey=$key;
	    $newkey=~s/\Q$pattern\E/$new/;
	    $data{$newkey}=$data{$key};
	    delete $data{$key};
	}
    }
#  transfer hash
    foreach my $key (keys %data) {
	my $thiskey=$key;
	$thiskey=~s/^$origcrsid/$newcrsid/;
	$newdata{$thiskey}=$data{$key};
# date_mode empty or "preserve": transfer dates one-to-one
# date_mode "shift": shift dates by date_shift days
# date_mode other: do not transfer dates
        if (($date_mode) && ($date_mode ne 'preserve')) {
	    if ($data{$key.'.type'}=~/^date_(start|end)$/) {
	       if ($date_mode eq 'shift') {
		  $newdata{$thiskey}=$newdata{$thiskey}+$delta;
	       } else {
		  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_|) {
	    &copyfile($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)/) {
		 &copydb($origcrsid,$newcrsid,$_);
	     }
	}
    }
}

# ======================================================= Copy all course files

sub copycoursefiles {
    my ($origcrsid,$newcrsid,$date_mode,$date_shift)=@_;
    &copyuserfiles($origcrsid,$newcrsid);
    &copydbfiles($origcrsid,$newcrsid);
    &copyresourcedb($origcrsid,$newcrsid,$date_mode,$date_shift);
}

1;