Annotation of loncom/interface/lonclonecourse.pm, revision 1.2
1.1 albertel 1: # The LearningOnline Network
2: # routines for clone a course
3: #
1.2 ! albertel 4: # $Id: lonclonecourse.pm,v 1.1 2006/08/11 22:00:08 albertel Exp $
1.1 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: ###
29:
30: package Apache::lonclonecourse;
31: use LONCAPA;
32: use Apache::lonnet;
33:
34: # ================================================ Get course directory listing
35:
36: my @output=();
37:
38: sub crsdirlist {
39: my ($courseid,$which)=@_;
40: @output=();
41: return &innercrsdirlist($courseid,$which);
42: }
43:
44: sub innercrsdirlist {
45: my ($courseid,$which,$path)=@_;
46: my $dirptr=16384;
47: unless ($which) { $which=''; } else { $which.='/'; }
48: unless ($path) { $path=''; } else { $path.='/'; }
49: my %crsdata=&Apache::lonnet::coursedescription($courseid);
50: my @listing=&Apache::lonnet::dirlist
51: ($which,$crsdata{'domain'},$crsdata{'num'},
52: &propath($crsdata{'domain'},$crsdata{'num'}));
53: foreach (@listing) {
54: unless ($_=~/^\./) {
55: my @unpackline = split (/\&/,$_);
56: if ($unpackline[3]&$dirptr) {
57: # is a directory, recurse
58: &innercrsdirlist($courseid,$which.$unpackline[0],
59: $path.$unpackline[0]);
60: } else {
61: # is a file, put into output
62: push (@output,$path.$unpackline[0]);
63: }
64: }
65: }
66: return @output;
67: }
68:
69: # ============================================================= Read a userfile
70:
71: sub readfile {
72: my ($courseid,$which)=@_;
73: my %crsdata=&Apache::lonnet::coursedescription($courseid);
74: my $file = &Apache::lonnet::getfile('/uploaded/'.$crsdata{'domain'}.'/'.
75: $crsdata{'num'}.'/'.$which);
76: return $file;
77: }
78:
79: # ============================================================ Write a userfile
80:
81: sub writefile {
82: (my $courseid, my $which,$env{'form.output'})=@_;
83: my %crsdata=&Apache::lonnet::coursedescription($courseid);
84: my $data = &Apache::lonnet::finishuserfileupload(
85: $crsdata{'num'},$crsdata{'domain'},
86: 'output',$which);
87: &Apache::lonnet::logthis("gor $data $crsdata{'num'} $crsdata{'domain'}");
88: return $data;
89: }
90:
91: # ===================================================================== Rewrite
92:
93: sub rewritefile {
94: my ($contents,%rewritehash)=@_;
1.2 ! albertel 95: foreach my $pattern (keys(%rewritehash)) {
! 96: my $new=$rewritehash{$pattern};
! 97: $contents=~s/\Q$pattern\E/$new/gs;
1.1 albertel 98: }
99: return $contents;
100: }
101:
102: # ============================================================= Copy a userfile
103:
104: sub copyfile {
105: my ($origcrsid,$newcrsid,$which)=@_;
106: unless ($which=~/\.sequence$/) {
107: return &writefile($newcrsid,$which,
108: &readfile($origcrsid,$which));
109: } else {
110: my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
111: my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
112: return &writefile($newcrsid,$which,
113: &rewritefile(
114: &readfile($origcrsid,$which),
115: (
116: '/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
117: => '/uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/',
118: '/public/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
119: => '/public/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/'
120: )));
121: }
122: }
123:
124: # =============================================================== Copy a dbfile
125:
126: sub copydb {
127: my ($origcrsid,$newcrsid,$which)=@_;
128: $which=~s/\.db$//;
129: my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
130: my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
131: my %data=&Apache::lonnet::dump
132: ($which,$origcrsdata{'domain'},$origcrsdata{'num'});
133: foreach my $key (keys(%data)) {
134: if ($key=~/^internal./) { delete($data{$key}); }
135: }
136: return &Apache::lonnet::put
137: ($which,\%data,$newcrsdata{'domain'},$newcrsdata{'num'});
138: }
139:
140: # ========================================================== Copy resourcesdata
141:
142: sub copyresourcedb {
143: my ($origcrsid,$newcrsid)=@_;
144: my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
145: my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
146: my %data=&Apache::lonnet::dump
147: ('resourcedata',$origcrsdata{'domain'},$origcrsdata{'num'});
148: $origcrsid=~s/^\///;
149: $origcrsid=~s/\//\_/;
150: $newcrsid=~s/^\///;
151: $newcrsid=~s/\//\_/;
152: my %newdata=();
153: undef %newdata;
154: my $startdate=$data{$origcrsid.'.0.opendate'};
155: if (!$startdate) {
156: # now global start date for assements try the enrollment start
157: my %start=&Apache::lonnet::get('environment',
158: ['default_enrollment_start_date'],
159: $origcrsdata{'domain'},$origcrsdata{'num'});
160:
161: $startdate = $start{'default_enrollment_start_date'};
162: }
163: my $today=time;
164: my $delta=0;
165: if ($startdate) {
166: my $oneday=60*60*24;
167: $delta=$today-$startdate;
168: $delta=int($delta/$oneday)*$oneday;
169: }
170: # ugly retro fix for broken version of types
171: foreach (keys %data) {
172: if ($_=~/\wtype$/) {
173: my $newkey=$_;
174: $newkey=~s/type$/\.type/;
175: $data{$newkey}=$data{$_};
176: delete $data{$_};
177: }
178: }
179: # adjust symbs
180: my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/';
181: my $new= 'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/';
182: foreach (keys %data) {
1.2 ! albertel 183: if ($_=~/\Q$pattern\E/) {
1.1 albertel 184: my $newkey=$_;
1.2 ! albertel 185: $newkey=~s/\Q$pattern\E/$new/;
1.1 albertel 186: $data{$newkey}=$data{$_};
187: delete $data{$_};
188: }
189: }
190: # adjust dates
191: foreach (keys %data) {
192: my $thiskey=$_;
193: $thiskey=~s/^$origcrsid/$newcrsid/;
194: $newdata{$thiskey}=$data{$_};
195: if ($data{$_.'.type'}=~/^date_(start|end)$/) {
196: if ($delta > 0) {
197: $newdata{$thiskey}=$newdata{$thiskey}+$delta;
198: } else {
199: # no delta, it's unlikely we want the old dates and times
200: delete($newdata{$thiskey});
201: delete($newdata{$thiskey.'.type'});
202: }
203: }
204: }
205: return &Apache::lonnet::put
206: ('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'});
207: }
208:
209: # ========================================================== Copy all userfiles
210:
211: sub copyuserfiles {
212: my ($origcrsid,$newcrsid)=@_;
213: foreach (&crsdirlist($origcrsid,'userfiles')) {
214: if ($_ !~m|^scantron_|) {
215: ©file($origcrsid,$newcrsid,$_);
216: }
217: }
218: }
219: # ========================================================== Copy all userfiles
220:
221: sub copydbfiles {
222: my ($origcrsid,$newcrsid)=@_;
223:
224: my ($origcrs_discussion) = ($origcrsid=~m|^/(.*)|);
225: $origcrs_discussion=~s|/|_|g;
226: foreach (&crsdirlist($origcrsid)) {
227: if ($_=~/\.db$/) {
228: unless
229: ($_=~/^(nohist\_|discussiontimes|classlist|versionupdate|resourcedata|\Q$origcrs_discussion\E|slots|slot_reservations|gradingqueue|reviewqueue|CODEs|groupmembership)/) {
230: ©db($origcrsid,$newcrsid,$_);
231: }
232: }
233: }
234: }
235:
236: # ======================================================= Copy all course files
237:
238: sub copycoursefiles {
239: my ($origcrsid,$newcrsid)=@_;
240: ©userfiles($origcrsid,$newcrsid);
241: ©dbfiles($origcrsid,$newcrsid);
242: ©resourcedb($origcrsid,$newcrsid);
243: }
244:
245: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonclonecourse.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface