File:
[LON-CAPA] /
loncom /
interface /
lonclonecourse.pm
Revision
1.7:
download - view:
text,
annotated -
select for diffs
Thu Sep 11 13:19:28 2008 UTC (15 years, 11 months ago) by
raeburn
Branches:
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_X,
version_2_7_99_1,
version_2_7_99_0,
version_2_7_1,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
loncapaMITrelate_1,
bz6209-base,
bz6209,
bz5969,
bz2851,
PRINT_INCOMPLETE_base,
PRINT_INCOMPLETE,
HEAD,
GCI_3,
GCI_2,
GCI_1,
BZ5971-printing-apage,
BZ5434-fox
Args in call to lonnet::dirlist() needed changing now propath calls have moved to lond.
1: # The LearningOnline Network
2: # routines for clone a course
3: #
4: # $Id: lonclonecourse.pm,v 1.7 2008/09/11 13:19:28 raeburn Exp $
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 $getpropath = 1;
51: my @listing=&Apache::lonnet::dirlist
52: ($which,$crsdata{'domain'},$crsdata{'num'},$getpropath);
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: return $data;
88: }
89:
90: # ===================================================================== Rewrite
91:
92: sub rewritefile {
93: my ($contents,%rewritehash)=@_;
94: foreach my $pattern (keys(%rewritehash)) {
95: my $new=$rewritehash{$pattern};
96: $contents=~s/\Q$pattern\E/$new/gs;
97: }
98: return $contents;
99: }
100:
101: # ============================================================= Copy a userfile
102:
103: sub copyfile {
104: my ($origcrsid,$newcrsid,$which)=@_;
105: unless ($which=~/\.sequence$/) {
106: return &writefile($newcrsid,$which,
107: &readfile($origcrsid,$which));
108: } else {
109: my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
110: my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
111: return &writefile($newcrsid,$which,
112: &rewritefile(
113: &readfile($origcrsid,$which),
114: (
115: '/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
116: => '/uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/',
117: '/public/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
118: => '/public/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/',
119: '/adm/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
120: => '/adm/'.$newcrsdata{'domain'}.'/'.$newcrsdata{'num'}.'/',
121: )));
122: }
123: }
124:
125: # =============================================================== Copy a dbfile
126:
127: sub copydb {
128: my ($origcrsid,$newcrsid,$which)=@_;
129: $which=~s/\.db$//;
130: my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
131: my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
132: my %data=&Apache::lonnet::dump
133: ($which,$origcrsdata{'domain'},$origcrsdata{'num'});
134: foreach my $key (keys(%data)) {
135: if ($key=~/^internal./) { delete($data{$key}); }
136: }
137: return &Apache::lonnet::put
138: ($which,\%data,$newcrsdata{'domain'},$newcrsdata{'num'});
139: }
140:
141: # ========================================================== Copy resourcesdata
142:
143: sub copyresourcedb {
144: my ($origcrsid,$newcrsid,$date_mode,$date_shift)=@_;
145: my $delta=$date_shift*60*60*24;
146: my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
147: my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
148: my %data=&Apache::lonnet::dump
149: ('resourcedata',$origcrsdata{'domain'},$origcrsdata{'num'});
150: $origcrsid=~s/^\///;
151: $origcrsid=~s/\//\_/;
152: $newcrsid=~s/^\///;
153: $newcrsid=~s/\//\_/;
154: my %newdata=();
155: undef %newdata;
156: my $startdate=$data{$origcrsid.'.0.opendate'};
157: if (!$startdate) {
158: # now global start date for assements try the enrollment start
159: my %start=&Apache::lonnet::get('environment',
160: ['default_enrollment_start_date'],
161: $origcrsdata{'domain'},$origcrsdata{'num'});
162:
163: $startdate = $start{'default_enrollment_start_date'};
164: }
165: # ugly retro fix for broken version of types
166: foreach my $key (keys %data) {
167: if ($key=~/\wtype$/) {
168: my $newkey=$key;
169: $newkey=~s/type$/\.type/;
170: $data{$newkey}=$data{$key};
171: delete $data{$key};
172: }
173: }
174: # adjust symbs
175: my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/';
176: my $new= 'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/';
177: foreach my $key (keys %data) {
178: if ($key=~/\Q$pattern\E/) {
179: my $newkey=$key;
180: $newkey=~s/\Q$pattern\E/$new/;
181: $data{$newkey}=$data{$key};
182: delete $data{$key};
183: }
184: }
185: # transfer hash
186: foreach my $key (keys %data) {
187: my $thiskey=$key;
188: $thiskey=~s/^$origcrsid/$newcrsid/;
189: $newdata{$thiskey}=$data{$key};
190: # date_mode empty or "preserve": transfer dates one-to-one
191: # date_mode "shift": shift dates by date_shift days
192: # date_mode other: do not transfer dates
193: if (($date_mode) && ($date_mode ne 'preserve')) {
194: if ($data{$key.'.type'}=~/^date_(start|end)$/) {
195: if ($date_mode eq 'shift') {
196: $newdata{$thiskey}=$newdata{$thiskey}+$delta;
197: } else {
198: delete($newdata{$thiskey});
199: delete($newdata{$thiskey.'.type'});
200: }
201: }
202: }
203: }
204: return &Apache::lonnet::put
205: ('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'});
206: }
207:
208: # ========================================================== Copy all userfiles
209:
210: sub copyuserfiles {
211: my ($origcrsid,$newcrsid)=@_;
212: foreach (&crsdirlist($origcrsid,'userfiles')) {
213: if ($_ !~m|^scantron_|) {
214: ©file($origcrsid,$newcrsid,$_);
215: }
216: }
217: }
218: # ========================================================== Copy all userfiles
219:
220: sub copydbfiles {
221: my ($origcrsid,$newcrsid)=@_;
222:
223: my ($origcrs_discussion) = ($origcrsid=~m|^/(.*)|);
224: $origcrs_discussion=~s|/|_|g;
225: foreach (&crsdirlist($origcrsid)) {
226: if ($_=~/\.db$/) {
227: unless
228: ($_=~/^(nohist\_|discussiontimes|classlist|versionupdate|resourcedata|\Q$origcrs_discussion\E|slots|slot_reservations|gradingqueue|reviewqueue|CODEs|groupmembership)/) {
229: ©db($origcrsid,$newcrsid,$_);
230: }
231: }
232: }
233: }
234:
235: # ======================================================= Copy all course files
236:
237: sub copycoursefiles {
238: my ($origcrsid,$newcrsid,$date_mode,$date_shift)=@_;
239: ©userfiles($origcrsid,$newcrsid);
240: ©dbfiles($origcrsid,$newcrsid);
241: ©resourcedb($origcrsid,$newcrsid,$date_mode,$date_shift);
242: }
243:
244: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>