Annotation of loncom/interface/lonclonecourse.pm, revision 1.14
1.1 albertel 1: # The LearningOnline Network
2: # routines for clone a course
3: #
1.14 ! raeburn 4: # $Id: lonclonecourse.pm,v 1.13 2019/06/29 23:21:05 raeburn 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;
1.12 raeburn 33: use DateTime();
34: use DateTime::TimeZone;
1.1 albertel 35:
36: # ================================================ Get course directory listing
37:
38: my @output=();
39:
40: sub crsdirlist {
41: my ($courseid,$which)=@_;
42: @output=();
43: return &innercrsdirlist($courseid,$which);
44: }
45:
46: sub innercrsdirlist {
47: my ($courseid,$which,$path)=@_;
48: my $dirptr=16384;
49: unless ($which) { $which=''; } else { $which.='/'; }
50: unless ($path) { $path=''; } else { $path.='/'; }
51: my %crsdata=&Apache::lonnet::coursedescription($courseid);
1.7 raeburn 52: my $getpropath = 1;
1.8 raeburn 53: my ($dirlistref,$listerror) =
54: &Apache::lonnet::dirlist($which,$crsdata{'domain'},
55: $crsdata{'num'},$getpropath);
56: if (ref($dirlistref) eq 'ARRAY') {
57: foreach (@{$dirlistref}) {
58: unless ($_=~/^\./) {
59: my @unpackline = split (/\&/,$_);
60: if ($unpackline[3]&$dirptr) {
1.1 albertel 61: # is a directory, recurse
1.8 raeburn 62: &innercrsdirlist($courseid,$which.$unpackline[0],
63: $path.$unpackline[0]);
64: } else {
1.1 albertel 65: # is a file, put into output
1.8 raeburn 66: push (@output,$path.$unpackline[0]);
67: }
1.1 albertel 68: }
1.8 raeburn 69: }
1.1 albertel 70: }
71: return @output;
72: }
73:
74: # ============================================================= Read a userfile
75:
76: sub readfile {
77: my ($courseid,$which)=@_;
78: my %crsdata=&Apache::lonnet::coursedescription($courseid);
79: my $file = &Apache::lonnet::getfile('/uploaded/'.$crsdata{'domain'}.'/'.
80: $crsdata{'num'}.'/'.$which);
81: return $file;
82: }
83:
84: # ============================================================ Write a userfile
85:
86: sub writefile {
87: (my $courseid, my $which,$env{'form.output'})=@_;
88: my %crsdata=&Apache::lonnet::coursedescription($courseid);
89: my $data = &Apache::lonnet::finishuserfileupload(
90: $crsdata{'num'},$crsdata{'domain'},
91: 'output',$which);
92: return $data;
93: }
94:
95: # ===================================================================== Rewrite
96:
97: sub rewritefile {
98: my ($contents,%rewritehash)=@_;
1.2 albertel 99: foreach my $pattern (keys(%rewritehash)) {
100: my $new=$rewritehash{$pattern};
101: $contents=~s/\Q$pattern\E/$new/gs;
1.1 albertel 102: }
103: return $contents;
104: }
105:
106: # ============================================================= Copy a userfile
107:
108: sub copyfile {
109: my ($origcrsid,$newcrsid,$which)=@_;
110: unless ($which=~/\.sequence$/) {
111: return &writefile($newcrsid,$which,
112: &readfile($origcrsid,$which));
113: } else {
114: my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
115: my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
116: return &writefile($newcrsid,$which,
117: &rewritefile(
118: &readfile($origcrsid,$which),
119: (
120: '/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
121: => '/uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/',
122: '/public/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
1.4 raeburn 123: => '/public/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/',
124: '/adm/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
125: => '/adm/'.$newcrsdata{'domain'}.'/'.$newcrsdata{'num'}.'/',
1.1 albertel 126: )));
127: }
128: }
129:
130: # =============================================================== Copy a dbfile
131:
132: sub copydb {
1.14 ! raeburn 133: my ($origcrsid,$newcrsid,$which,$newinstcode)=@_;
1.1 albertel 134: $which=~s/\.db$//;
135: my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
136: my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
137: my %data=&Apache::lonnet::dump
138: ($which,$origcrsdata{'domain'},$origcrsdata{'num'});
139: foreach my $key (keys(%data)) {
140: if ($key=~/^internal./) { delete($data{$key}); }
141: }
1.14 ! raeburn 142: if ($which =~ /^exttool_\d+$/) {
! 143: if ($origcrsdata{'description'} ne $newcrsdata{'description'}) {
! 144: $data{'crstitle'} =~s/\Q$origcrsdata{'description'}\E/$newcrsdata{'description'}/;
! 145: }
! 146: if ($origcrsdata{'internal.coursecode'} ne $newinstcode) {
! 147: $data{'crslabel'} =~ s/\Q$origcrsdata{'internal.coursecode'}\E/$newinstcode/;
! 148: }
! 149: }
1.1 albertel 150: return &Apache::lonnet::put
151: ($which,\%data,$newcrsdata{'domain'},$newcrsdata{'num'});
152: }
153:
154: # ========================================================== Copy resourcesdata
155:
156: sub copyresourcedb {
1.6 www 157: my ($origcrsid,$newcrsid,$date_mode,$date_shift)=@_;
158: my $delta=$date_shift*60*60*24;
1.1 albertel 159: my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
160: my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
1.12 raeburn 161: my $origtz;
162: if (($date_mode) && ($date_mode ne 'preserve') && ($date_shift) &&
163: (int($date_shift) == $date_shift)) {
164: $origtz = $origcrsdata{'timezone'};
165: if ($origtz eq '') {
166: my %domdefaults = &Apache::lonnet::get_domain_defaults($origcrsdata{'domain'});
167: if ($domdefaults{'timezone_def'} ne '') {
168: $origtz = $domdefaults{'timezone_def'};
169: }
170: }
171: if ($origtz eq '') {
172: $origtz = 'local';
173: } elsif (!DateTime::TimeZone->is_valid_name($origtz)) {
174: $origtz = 'local';
175: }
176: }
1.1 albertel 177: my %data=&Apache::lonnet::dump
178: ('resourcedata',$origcrsdata{'domain'},$origcrsdata{'num'});
179: $origcrsid=~s/^\///;
180: $origcrsid=~s/\//\_/;
181: $newcrsid=~s/^\///;
182: $newcrsid=~s/\//\_/;
183: my %newdata=();
184: undef %newdata;
185: my $startdate=$data{$origcrsid.'.0.opendate'};
186: if (!$startdate) {
187: # now global start date for assements try the enrollment start
188: my %start=&Apache::lonnet::get('environment',
189: ['default_enrollment_start_date'],
190: $origcrsdata{'domain'},$origcrsdata{'num'});
191:
192: $startdate = $start{'default_enrollment_start_date'};
193: }
194: # ugly retro fix for broken version of types
1.10 raeburn 195: foreach my $key (keys(%data)) {
1.6 www 196: if ($key=~/\wtype$/) {
197: my $newkey=$key;
1.1 albertel 198: $newkey=~s/type$/\.type/;
1.6 www 199: $data{$newkey}=$data{$key};
200: delete $data{$key};
1.1 albertel 201: }
202: }
203: # adjust symbs
204: my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/';
205: my $new= 'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/';
1.10 raeburn 206: foreach my $key (keys(%data)) {
1.6 www 207: if ($key=~/\Q$pattern\E/) {
208: my $newkey=$key;
1.2 albertel 209: $newkey=~s/\Q$pattern\E/$new/;
1.6 www 210: $data{$newkey}=$data{$key};
211: delete $data{$key};
212: }
213: }
214: # transfer hash
1.10 raeburn 215: foreach my $key (keys(%data)) {
1.6 www 216: my $thiskey=$key;
217: $thiskey=~s/^$origcrsid/$newcrsid/;
218: $newdata{$thiskey}=$data{$key};
219: # date_mode empty or "preserve": transfer dates one-to-one
220: # date_mode "shift": shift dates by date_shift days
221: # date_mode other: do not transfer dates
222: if (($date_mode) && ($date_mode ne 'preserve')) {
223: if ($data{$key.'.type'}=~/^date_(start|end)$/) {
1.12 raeburn 224: if ($date_mode eq 'shift') {
225: if (($date_shift) && ($date_shift == int($date_shift))) {
226: my $dt = DateTime->from_epoch(epoch => $newdata{$thiskey})
227: ->set_time_zone($origtz);
228: if (($origtz eq 'local') && (!$ENV{TZ})) {
229: $ENV{TZ} = $dt->time_zone()->name();
230: }
1.13 raeburn 231: eval {
232: $dt->add(days => int($date_shift));
233: };
234: if ($@) {
235: $newdata{$thiskey} = $newdata{$thiskey}+$delta+(60*60);
236: } else {
237: $newdata{$thiskey} = $dt->epoch();
238: }
1.12 raeburn 239: } else {
240: $newdata{$thiskey} = $newdata{$thiskey}+$delta;
241: }
242: } else {
243: delete($newdata{$thiskey});
244: delete($newdata{$thiskey.'.type'});
245: }
1.6 www 246: }
1.12 raeburn 247: }
1.1 albertel 248: }
249: return &Apache::lonnet::put
250: ('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'});
251: }
252:
253: # ========================================================== Copy all userfiles
254:
255: sub copyuserfiles {
256: my ($origcrsid,$newcrsid)=@_;
257: foreach (&crsdirlist($origcrsid,'userfiles')) {
258: if ($_ !~m|^scantron_|) {
259: ©file($origcrsid,$newcrsid,$_);
260: }
261: }
262: }
263: # ========================================================== Copy all userfiles
264:
265: sub copydbfiles {
1.14 ! raeburn 266: my ($origcrsid,$newcrsid,$newinstcode)=@_;
1.1 albertel 267:
268: my ($origcrs_discussion) = ($origcrsid=~m|^/(.*)|);
269: $origcrs_discussion=~s|/|_|g;
270: foreach (&crsdirlist($origcrsid)) {
271: if ($_=~/\.db$/) {
1.11 musolffc 272: unless ($_=~/^(nohist\_|disclikes|discussiontimes|classlist|versionupdate
273: |resourcedata|\Q$origcrs_discussion\E|slots|slot_reservations
274: |gradingqueue|reviewqueue|CODEs|groupmembership|comm_block)/) {
1.14 ! raeburn 275: ©db($origcrsid,$newcrsid,$_,$newinstcode);
1.11 musolffc 276: }
1.1 albertel 277: }
278: }
279: }
280:
281: # ======================================================= Copy all course files
282:
283: sub copycoursefiles {
1.14 ! raeburn 284: my ($origcrsid,$newcrsid,$date_mode,$date_shift,$newinstcode)=@_;
1.1 albertel 285: ©userfiles($origcrsid,$newcrsid);
1.14 ! raeburn 286: ©dbfiles($origcrsid,$newcrsid,$newinstcode);
1.6 www 287: ©resourcedb($origcrsid,$newcrsid,$date_mode,$date_shift);
1.1 albertel 288: }
289:
290: 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