[LON-CAPA-cvs] cvs: loncom /interface londocs.pm
raeburn
raeburn at source.lon-capa.org
Sat Sep 12 11:47:57 EDT 2015
raeburn Sat Sep 12 15:47:57 2015 EDT
Modified files:
/loncom/interface londocs.pm
Log:
- Bug 6794. Simple problems can be copied within a course, and between
courses using the clipboard. Submission/grade data are not copied.
-------------- next part --------------
Index: loncom/interface/londocs.pm
diff -u loncom/interface/londocs.pm:1.596 loncom/interface/londocs.pm:1.597
--- loncom/interface/londocs.pm:1.596 Thu Aug 20 00:28:52 2015
+++ loncom/interface/londocs.pm Sat Sep 12 15:47:57 2015
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Documents
#
-# $Id: londocs.pm,v 1.596 2015/08/20 00:28:52 raeburn Exp $
+# $Id: londocs.pm,v 1.597 2015/09/12 15:47:57 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1022,27 +1022,33 @@
foreach my $suffix (@currpaste) {
my $cid = $env{'docs.markedcopy_crs_'.$suffix};
my $url = $env{'docs.markedcopy_url_'.$suffix};
+ my $mapidx = $env{'docs.markedcopy_map_'.$suffix};
if (($cid =~ /^$match_domain(?:_)$match_courseid$/) &&
($url ne '')) {
- $pasteurls{$cid.'_'.$url} = 1;
+ $pasteurls{$cid.'_'.$url.'_'.$mapidx} = 1;
}
}
}
# Mark items for copying (skip any items already in user's paste buffer)
my %addtoenv;
-
+
+ my @pathitems = split(/\&/,$env{'form.folderpath'});
+ my @folderconf = split(/\:/,$pathitems[-1]);
+ my $ispage = $folderconf[4];
+
foreach my $item (@possibles) {
my ($orderidx,$cmd) = split(/:/,$item);
next if ($orderidx =~ /\D/);
next unless (($cmd eq 'cut') || ($cmd eq 'copy') || ($cmd eq 'remove'));
+ my $mapidx = $folder.':'.$orderidx.':'.$ispage;
my ($title,$url)=split(':',$LONCAPA::map::resources[$orderidx]);
my %denied = &action_restrictions($coursenum,$coursedom,
&LONCAPA::map::qtescape($url),
$env{'form.folderpath'},\%curr_groups);
next if ($denied{'copy'});
$url=~s{http(:|:)//https(:|:)//}{https$2//};
- next if (exists($pasteurls{$coursedom.'_'.$coursenum.'_'.$url}));
+ next if (exists($pasteurls{$coursedom.'_'.$coursenum.'_'.$mapidx}));
my ($suffix,$errortxt,$locknotfreed) =
&new_timebased_suffix($env{'user.domain'},$env{'user.name'},'paste');
if ($suffix ne '') {
@@ -1061,7 +1067,7 @@
$addtoenv{'docs.markedcopy_url_'.$suffix} = $url,
$addtoenv{'docs.markedcopy_cmd_'.$suffix} = $cmd,
$addtoenv{'docs.markedcopy_crs_'.$suffix} = $env{'request.course.id'};
-
+ $addtoenv{'docs.markedcopy_map_'.$suffix} = $mapidx;
if ($url =~ m{^/uploaded/$match_domain/$match_courseid/(default|supplemental)_?(\d*)\.(page|sequence)$}) {
my $prefix = $1;
my $subdir =$2;
@@ -1139,6 +1145,7 @@
next if ($suffix =~ /\D/);
my $cid = $env{'docs.markedcopy_crs_'.$suffix};
my $url = $env{'docs.markedcopy_url_'.$suffix};
+ my $mapidx = $env{'docs.markedcopy_map_'.$suffix};
if (($cid =~ /^$match_domain\_$match_courseid$/) &&
($url ne '')) {
$clipboardcount ++;
@@ -1178,7 +1185,8 @@
}
$is_uploaded_map = 1;
}
- } elsif ($url =~ m{^/adm/($match_domain)/($match_username)/\d+/(bulletinboard|smppg)$}) {
+ } elsif (($url =~ m{^/res/lib/templates/\w+\.problem$}) ||
+ ($url =~ m{^/adm/($match_domain)/($match_username)/\d+/(bulletinboard|smppg)$})) {
if ($cid ne $env{'request.course.id'}) {
my ($srcdom,$srcnum) = split(/_/,$cid);
if ($env{"user.priv.cm./$srcdom/$srcnum"} =~ /\Q:mdc&F\E/) {
@@ -1477,11 +1485,12 @@
}
my (%msgs,%before,%after, at dopaste,%is_map,%notinsupp,%notincrs,%duplicate,
- %prefixchg,%srcdom,%srcnum,%marktomove,$save_err,$lockerrors,$allresult);
+ %prefixchg,%srcdom,%srcnum,%srcmapidx,%marktomove,$save_err,$lockerrors,$allresult);
foreach my $suffix (@topaste) {
my $url=&LONCAPA::map::qtescape($env{'docs.markedcopy_url_'.$suffix});
my $cid=&LONCAPA::map::qtescape($env{'docs.markedcopy_crs_'.$suffix});
+ my $mapidx=&LONCAPA::map::qtescape($env{'docs.markedcopy_map_'.$suffix});
# Supplemental content may only include certain types of content
# Early out if pasted content is not supported in Supplemental area
if ($folder =~ /^supplemental/) {
@@ -1503,7 +1512,8 @@
}
$srcdom{$suffix} = $srcd;
$srcnum{$suffix} = $srcn;
- } elsif ($url =~ m{^/adm/$match_domain/$match_username/\d+/(bulletinboard|smppg)$}) {
+ } elsif (($url =~ m{^/res/lib/templates/\w+\.problem$}) ||
+ ($url =~ m{^/adm/$match_domain/$match_username/\d+/(bulletinboard|smppg)$})) {
my ($srcd,$srcn) = split(/_/,$cid);
# When paste buffer was populated using an active role in a different course
# check for mdc privilege in the course from which the resource was pasted
@@ -1516,6 +1526,7 @@
$srcdom{$suffix} = $srcd;
$srcnum{$suffix} = $srcn;
}
+ $srcmapidx{$suffix} = $mapidx;
push(@dopaste,$suffix);
if ($url=~/\.(page|sequence)$/) {
$is_map{$suffix} = 1;
@@ -1525,7 +1536,7 @@
my $oldprefix = $1;
# When pasting content from Main Content to Supplemental Content and vice versa
# URLs will contain different paths (which depend on whether pasted item is
-# a folder/page or a document.
+# a folder/page or a document).
if (($folder =~ /^supplemental/) && (($oldprefix =~ /^default/) || ($oldprefix eq 'docs'))) {
$prefixchg{$suffix} = 'docstosupp';
} elsif (($folder =~ /^default/) && ($oldprefix =~ /^supplemental/)) {
@@ -1607,7 +1618,7 @@
# Maps need to be copied first
my (%removefrommap,%removeparam,%addedmaps,%rewrites,%retitles,%copies,
%dbcopies,%zombies,%params,%docmoves,%mapmoves,%mapchanges,%newsubdir,
- %newurls,%tomove);
+ %newurls,%tomove,%resdatacopy);
if (ref($marktomove{$suffix}) eq 'ARRAY') {
map { $tomove{$_} = 1; } @{$marktomove{$suffix}};
}
@@ -1649,7 +1660,7 @@
\%retitles,\%copies,\%dbcopies,
\%zombies,\%params,\%mapmoves,
\%mapchanges,\%tomove,\%newsubdir,
- \%newurls)) {
+ \%newurls,\%resdatacopy)) {
$mapmoves{$url} = 1;
}
$url = $newurl;
@@ -1658,10 +1669,10 @@
$coursenum,$srcdom{$suffix},$srcnum{$suffix},
$allmaps,\%rewrites,\%retitles,\%copies,\%dbcopies,
\%zombies,\%params,\%mapmoves,\%mapchanges,
- \%tomove,\%newsubdir,\%newurls);
+ \%tomove,\%newsubdir,\%newurls,\%resdatacopy);
}
} elsif ($url=~m {^/res/}) {
-# published map can only exists once, so remove from paste buffer when done
+# published map can only exist once, so remove from paste buffer when done
push(@toclear,$suffix);
# if pasting published map (main content area only) check map not already in course
if ($folder =~ /^default/) {
@@ -1764,6 +1775,12 @@
}
}
}
+ } elsif ($url =~ m{^/res/lib/templates/(\w+)\.problem$}) {
+ my $template = $1;
+ if ($newidx) {
+ ©_templated_files($url,$srcdom{$suffix},$srcnum{$suffix},$srcmapidx{$suffix},
+ $coursedom,$coursenum,$template,$newidx,"$folder.$container");
+ }
}
$LONCAPA::map::resources[$newidx]=$title.':'.&LONCAPA::map::qtunescape($url).
':'.$ext.':normal:res';
@@ -1777,7 +1794,8 @@
}
}
-# Apply any changes to maps, or copy dependencies for uploaded HTML pages
+# Apply any changes to maps, or copy dependencies for uploaded HTML pages, or update
+# resourcedata for simpleproblems copied from another course
unless ($allresult eq 'fail') {
my %updated = (
rewrites => \%rewrites,
@@ -1785,6 +1803,7 @@
removefrommap => \%removefrommap,
removeparam => \%removeparam,
dbcopies => \%dbcopies,
+ resdatacopy => \%resdatacopy,
retitles => \%retitles,
);
my %info = (
@@ -2041,6 +2060,95 @@
return ($url,$result,$errtext);
}
+sub copy_templated_files {
+ my ($srcurl,$srcdom,$srcnum,$srcmapinfo,$coursedom,$coursenum,$template,$newidx,$newmapname) = @_;
+ my ($srcfolder,$srcid,$srcwaspage) = split(/:/,$srcmapinfo);
+ my $srccontainer = 'sequence';
+ if ($srcwaspage) {
+ $srccontainer = 'page';
+ }
+ my $srcsymb = "uploaded/$srcdom/$srcnum/$srcfolder.$srccontainer".
+ '___'.$srcid.'___'.&Apache::lonnet::declutter($srcurl);
+ my $srcprefix = $srcdom.'_'.$srcnum.'.'.$srcsymb;
+ my %srcparms=&Apache::lonnet::dump('resourcedata',$srcdom,$srcnum,$srcprefix);
+ my $newsymb = "uploaded/$coursedom/$coursenum/$newmapname".'___'.$newidx.'___lib/templates/'.
+ $template.'.problem';
+ my $newprefix = $coursedom.'_'.$coursenum.'.'.$newsymb;
+ if ($template eq 'simpleproblem') {
+ $srcprefix .= '.0.';
+ my $weightprefix = $newprefix;
+ $newprefix .= '.0.';
+ my @simpleprobqtypes = qw(radio option string essay numerical);
+ my $qtype=$srcparms{$srcprefix.'questiontype'};
+ if (grep(/^\Q$qtype\E$/, at simpleprobqtypes)) {
+ my %newdata;
+ foreach my $type (@simpleprobqtypes) {
+ if ($type eq $qtype) {
+ $newdata{"$weightprefix.$type.weight"}=1;
+ } else {
+ $newdata{"$weightprefix.$type.weight"}=0;
+ }
+ }
+ $newdata{$newprefix.'hiddenparts'} = '!'.$qtype;
+ $newdata{$newprefix.'questiontext'} = $srcparms{$srcprefix.'questiontext'};
+ $newdata{$newprefix.'hinttext'} = $srcparms{$srcprefix.'hinttext'};
+ if ($qtype eq 'numerical') {
+ $newdata{$newprefix.'numericalscript'} = $srcparms{$srcprefix.'numericalscript'};
+ $newdata{$newprefix.'numericalanswer'} = $srcparms{$srcprefix.'numericalanswer'};
+ $newdata{$newprefix.'numericaltolerance'} = $srcparms{$srcprefix.'numericaltolerance'};
+ $newdata{$newprefix.'numericalsigfigs'} = $srcparms{$srcprefix.'numericalsigfigs'};
+ } elsif (($qtype eq 'option') || ($qtype eq 'radio')) {
+ my $maxfoils=$srcparms{$srcprefix.'maxfoils'};
+ unless (defined($maxfoils)) { $maxfoils=10; }
+ unless ($maxfoils=~/^\d+$/) { $maxfoils=10; }
+ if ($maxfoils<=0) { $maxfoils=10; }
+ my $randomize=$srcparms{$srcprefix.'randomize'};
+ unless (defined($randomize)) { $randomize='yes'; }
+ unless ($randomize eq 'no') { $randomize='yes'; }
+ $newdata{$newprefix.'maxfoils'} = $maxfoils;
+ $newdata{$newprefix.'randomize'} = $randomize;
+ if ($qtype eq 'option') {
+ $newdata{$newprefix.'options'} = $srcparms{$srcprefix.'options'};
+ }
+ for (my $i=1; $i<=10; $i++) {
+ $newdata{$newprefix.'value'.$i} = $srcparms{$srcprefix.'value'.$i};
+ $newdata{$newprefix.'position'.$i} = $srcparms{$srcprefix.'position'.$i};
+ $newdata{$newprefix.'text'.$i} = $srcparms{$srcprefix.'text'.$i};
+ }
+
+ } elsif (($qtype eq 'option') || ($qtype eq 'radio')) {
+ my $maxfoils=$srcparms{$srcprefix.'maxfoils'};
+ unless (defined($maxfoils)) { $maxfoils=10; }
+ unless ($maxfoils=~/^\d+$/) { $maxfoils=10; }
+ if ($maxfoils<=0) { $maxfoils=10; }
+ my $randomize=$srcparms{$srcprefix.'randomize'};
+ unless (defined($randomize)) { $randomize='yes'; }
+ unless ($randomize eq 'no') { $randomize='yes'; }
+ $newdata{$newprefix.'maxfoils'} = $maxfoils;
+ $newdata{$newprefix.'randomize'} = $randomize;
+ if ($qtype eq 'option') {
+ $newdata{$newprefix.'options'} = $srcparms{$srcprefix.'options'};
+ }
+ for (my $i=1; $i<=10; $i++) {
+ $newdata{$newprefix.'value'.$i} = $srcparms{$srcprefix.'value'.$i};
+ $newdata{$newprefix.'position'.$i} = $srcparms{$srcprefix.'position'.$i};
+ $newdata{$newprefix.'text'.$i} = $srcparms{$srcprefix.'text'.$i};
+ }
+ } elsif ($qtype eq 'string') {
+ $newdata{$newprefix.'stringanswer'} = $srcparms{$srcprefix.'stringanswer'};
+ $newdata{$newprefix.'stringtype'} = $srcparms{$srcprefix.'stringtype'};
+ }
+ if (keys(%newdata)) {
+ my $putres = &Apache::lonnet::cput('resourcedata',\%newdata,$coursedom,
+ $coursenum);
+ if ($putres eq 'ok') {
+ &Apache::lonnet::devalidatecourseresdata($coursenum,$coursedom);
+ }
+ }
+ }
+ }
+}
+
sub uniqueness_check {
my ($newurl) = @_;
my $unique = 1;
@@ -2106,7 +2214,7 @@
sub url_paste_fixups {
my ($oldurl,$folder,$prefixchg,$cdom,$cnum,$fromcdom,$fromcnum,$allmaps,
$rewrites,$retitles,$copies,$dbcopies,$zombies,$params,$mapmoves,
- $mapchanges,$tomove,$newsubdir,$newurls) = @_;
+ $mapchanges,$tomove,$newsubdir,$newurls,$resdatacopy) = @_;
my $checktitle;
if (($prefixchg) &&
($oldurl =~ m{^/uploaded/$match_domain/$match_courseid/supplemental})) {
@@ -2155,7 +2263,7 @@
$srcdom,$srcnum,$allmaps,$rewrites,
$retitles,$copies,$dbcopies,$zombies,
$params,$mapmoves,$mapchanges,$tomove,
- $newsubdir,$newurls);
+ $newsubdir,$newurls,$resdatacopy);
next;
} else {
($newurl,my $error) =
@@ -2179,7 +2287,7 @@
$cnum,$srcdom,$srcnum,$allmaps,
$rewrites,$retitles,$copies,$dbcopies,
$zombies,$params,$mapmoves,$mapchanges,
- $tomove,$newsubdir,$newurls)) {
+ $tomove,$newsubdir,$newurls,$resdatacopy)) {
$mapmoves->{$ressrc} = 1;
}
$changed = 1;
@@ -2208,6 +2316,12 @@
$dbcopies->{$oldurl}{$id}{'cnum'} = $fromcnum;
$changed = 1;
}
+ } elsif ($ressrc eq '/res/lib/templates/simpleproblem.problem') {
+ if (($fromcdom ne $cdom) || ($fromcnum ne $cnum)) {
+ $resdatacopy->{$oldurl}{$id}{'src'} = $ressrc;
+ $resdatacopy->{$oldurl}{$id}{'cdom'} = $fromcdom;
+ $resdatacopy->{$oldurl}{$id}{'cnum'} = $fromcnum;
+ }
} elsif ($ressrc =~ m{^/public/($match_domain)/($match_courseid)/(.+)$}) {
next if ($skip);
my $srcdom = $1;
@@ -2239,7 +2353,7 @@
$oldurl,$url,$caller) = @_;
my (%rewrites,%zombies,%removefrommap,%removeparam,%dbcopies,%retitles,
%params,%newsubdir,%before,%after,%copies,%docmoves,%mapmoves, at msgs,
- %lockerrors,$lockmsg);
+ %resdatacopy,%lockerrors,$lockmsg);
if (ref($updated) eq 'HASH') {
if (ref($updated->{'rewrites'}) eq 'HASH') {
%rewrites = %{$updated->{'rewrites'}};
@@ -2259,6 +2373,9 @@
if (ref($updated->{'retitles'}) eq 'HASH') {
%retitles = %{$updated->{'retitles'}};
}
+ if (ref($updated->{'resdatacopy'}) eq 'HASH') {
+ %resdatacopy = %{$updated->{'resdatacopy'}};
+ }
}
if (ref($info) eq 'HASH') {
if (ref($info->{'newsubdir'}) eq 'HASH') {
@@ -2409,6 +2526,35 @@
}
}
}
+ if (ref($resdatacopy{$key}) eq 'HASH') {
+ if ($newsubdir{$key}) {
+
+ }
+ foreach my $idx (keys(%{$resdatacopy{$key}})) {
+ if (ref($resdatacopy{$key}{$idx}) eq 'HASH') {
+ my $srcurl = $resdatacopy{$key}{$idx}{'src'};
+ if ($srcurl =~ m{^/res/lib/templates/(\w+)\.problem$}) {
+ my $template = $1;
+ if (($resdatacopy{$key}{$idx}{'cdom'} =~ /^$match_domain$/) &&
+ ($resdatacopy{$key}{$idx}{'cnum'} =~ /^$match_courseid$/)) {
+ my $srcdom = $resdatacopy{$key}{$idx}{'cdom'};
+ my $srcnum = $resdatacopy{$key}{$idx}{'cnum'};
+ my ($newmapname) = ($key =~ m{/([^/]+)$});
+ my ($srcfolder,$srccontainer) = split(/\./,$newmapname);
+ my $srcmapinfo = $srcfolder.':'.$idx;
+ if ($srccontainer eq 'page') {
+ $srcmapinfo .= ':1';
+ }
+ if ($newsubdir{$key}) {
+ $newmapname =~ s/^((?:default|supplemental)_)(\d+)/$1$newsubdir{$key}/;
+ }
+ ©_templated_files($srcurl,$srcdom,$srcnum,$srcmapinfo,$cdom,
+ $cnum,$template,$idx,$newmapname);
+ }
+ }
+ }
+ }
+ }
if (ref($params{$key}) eq 'HASH') {
%currparam = %{$params{$key}};
}
@@ -3830,9 +3976,11 @@
if ($url=~ m{^/res/.+\.(page|sequence)$}) {
# no copy for published maps
$denied{'copy'} = 1;
- } elsif ($url=~m{^/res/lib/templates/}) {
- $denied{'copy'} = 1;
- $denied{'cut'} = 1;
+ } elsif ($url=~m{^/res/lib/templates/([^/]+)\.problem$}) {
+ unless ($1 eq 'simpleproblem') {
+ $denied{'copy'} = 1;
+ }
+ $denied{'cut'} = 1;
} elsif ($url eq "/uploaded/$cdom/$cnum/group_allfolders.sequence") {
if ($folderpath =~ /^default&[^\&]+$/) {
if ((ref($currgroups) eq 'HASH') && (keys(%{$currgroups}) > 0)) {
More information about the LON-CAPA-cvs
mailing list