';
if ($numremref) {
$output .= ''.&mt('reference is to a URL which points to another server').' '."\n";
}
@@ -12514,7 +9747,7 @@ sub ask_for_embedded_content {
$chgcount ++;
}
}
- if (($counter) || ($numunused)) {
+ if ($counter) {
if ($numpathchg) {
$output .= ''.&mt('or').'
';
- }
+ }
}
return ($output,$counter,$numpathchg);
}
-=pod
-
-=item * clean_path($name)
-
-Performs clean-up of directories, subdirectories and filename in an
-embedded object, referenced in an HTML file which is being uploaded
-to a course or portfolio, where
-"Upload embedded images/multimedia files if HTML file" checkbox was
-checked.
-
-Clean-up is similar to replacements in lonnet::clean_filename()
-except each / between sub-directory and next level is preserved.
-
-=cut
-
-sub clean_path {
- my ($embed_file) = @_;
- $embed_file =~s{^/+}{};
- my @contents;
- if ($embed_file =~ m{/}) {
- @contents = split(/\//,$embed_file);
- } else {
- @contents = ($embed_file);
- }
- my $lastidx = scalar(@contents)-1;
- for (my $i=0; $i<=$lastidx; $i++) {
- $contents[$i]=~s{\\}{/}g;
- $contents[$i]=~s/\s+/\_/g;
- $contents[$i]=~s{[^/\w\.\-]}{}g;
- if ($i == $lastidx) {
- $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
- }
- }
- if ($lastidx > 0) {
- return join('/',@contents);
- } else {
- return $contents[0];
- }
-}
-
sub embedded_file_element {
my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
@@ -12702,31 +9895,28 @@ sub upload_embedded {
# Check if extension is valid
if (($fname =~ /\.(\w+)$/) &&
(&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
- $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
- .' '.&mt('Rename the file with a different extension and re-upload.').''
.&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
@@ -12738,11 +9928,10 @@ sub upload_embedded {
$path.$fname.' ').''
.&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
@@ -12752,9 +9941,6 @@ sub upload_embedded {
} else {
$output .= &mt('Uploaded [_1]',''.
$path.$fname.' ').''.
$container.' ').'';
}
- if ($context eq 'syllabus') {
- unless ($saveresult eq 'ok') {
- $skiprewrites = 1;
- }
- }
} else {
- if (open(my $fh,'>',$container)) {
+ if (open(my $fh,">$container")) {
print $fh $content;
close($fh);
$output = ''.&mt('Updated [quant,_1,reference] in [_2].',
@@ -13013,47 +10189,6 @@ sub modify_html_refs {
}
}
}
- if (($context eq 'syllabus') && (!$skiprewrites)) {
- my ($actionurl,$state);
- $actionurl = "/public/$udom/$uname/syllabus";
- my ($ignore,$num,$numpathchanges,$existing,$mapping) =
- &ask_for_embedded_content($actionurl,$state,\%allfiles,
- \%codebase,
- {'context' => 'rewrites',
- 'ignore_remote_references' => 1,});
- if (ref($mapping) eq 'HASH') {
- my $rewrites = 0;
- foreach my $key (keys(%{$mapping})) {
- next if ($key =~ m{^https?://});
- my $ref = $mapping->{$key};
- my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
- my $attrib;
- if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
- $attrib = join('|',@{$allfiles{$mapping->{$key}}});
- }
- if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
- my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
- $rewrites += $numchg;
- }
- }
- if ($rewrites) {
- my $saveresult;
- my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
- if ($url eq $container) {
- my ($fname) = ($container =~ m{/([^/]+)$});
- $output .= '
'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
- $count,''.
- $fname.' ').'
';
- } else {
- $output .= ''.
- &mt('Error: could not update links in [_1].',
- ''.
- $container.' ').'
';
-
- }
- }
- }
- }
} else {
&logthis('Failed to parse '.$container.
' to modify references: '.$parse_result);
@@ -13143,11 +10278,11 @@ sub check_for_upload {
if ($currsize < $filesize) {
my $extra = $filesize - $currsize;
if (($current_disk_usage + $extra) > $disk_quota) {
- my $msg = ''.
+ my $msg = ''.
&mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
- ''.$fname.' ',$filesize,$currsize).'
'.
- ''.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
- $disk_quota,$current_disk_usage).'
';
+ ''.$fname.' ',$filesize,$currsize).' '.
+ ''.
- &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.',''.$fname.' ',$filesize).'
'.
- ''.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'
';
+ my $msg = ''.
+ &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.',''.$fname.' ',$filesize).' '.
+ '';
+ my $msg = '';
$msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].',''.$fname.' ',''.$port_path.$env{'form.currentpath'}.' ');
- $msg .= '
';
+ $msg .= ''.$fname.' ');
return ('file_locked',$msg);
} else {
- my $msg = '';
+ my $msg = '';
$msg .= &mt(' A file by that name: [_1] was found in [_2].',''.$fname.' ',$port_path.$env{'form.currentpath'});
- $msg .= '
';
+ $msg .= '';
return ('existingfile',$msg);
}
}
@@ -13261,66 +10396,16 @@ sub decompress_form {
}
}
if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
- my @camtasia6 = ("$topdir/","$topdir/index.html",
+ my @camtasia = ("$topdir/","$topdir/index.html",
"$topdir/media/",
"$topdir/media/$topdir.mp4",
"$topdir/media/FirstFrame.png",
"$topdir/media/player.swf",
"$topdir/media/swfobject.js",
"$topdir/media/expressInstall.swf");
- my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
- "$topdir/$topdir.mp4",
- "$topdir/$topdir\_config.xml",
- "$topdir/$topdir\_controller.swf",
- "$topdir/$topdir\_embed.css",
- "$topdir/$topdir\_First_Frame.png",
- "$topdir/$topdir\_player.html",
- "$topdir/$topdir\_Thumbnails.png",
- "$topdir/playerProductInstall.swf",
- "$topdir/scripts/",
- "$topdir/scripts/config_xml.js",
- "$topdir/scripts/handlebars.js",
- "$topdir/scripts/jquery-1.7.1.min.js",
- "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
- "$topdir/scripts/modernizr.js",
- "$topdir/scripts/player-min.js",
- "$topdir/scripts/swfobject.js",
- "$topdir/skins/",
- "$topdir/skins/configuration_express.xml",
- "$topdir/skins/express_show/",
- "$topdir/skins/express_show/player-min.css",
- "$topdir/skins/express_show/spritesheet.png");
- my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
- "$topdir/$topdir.mp4",
- "$topdir/$topdir\_config.xml",
- "$topdir/$topdir\_controller.swf",
- "$topdir/$topdir\_embed.css",
- "$topdir/$topdir\_First_Frame.png",
- "$topdir/$topdir\_player.html",
- "$topdir/$topdir\_Thumbnails.png",
- "$topdir/playerProductInstall.swf",
- "$topdir/scripts/",
- "$topdir/scripts/config_xml.js",
- "$topdir/scripts/techsmith-smart-player.min.js",
- "$topdir/skins/",
- "$topdir/skins/configuration_express.xml",
- "$topdir/skins/express_show/",
- "$topdir/skins/express_show/spritesheet.min.css",
- "$topdir/skins/express_show/spritesheet.png",
- "$topdir/skins/express_show/techsmith-smart-player.min.css");
- my @diffs = &compare_arrays(\@paths,\@camtasia6);
+ my @diffs = &compare_arrays(\@paths,\@camtasia);
if (@diffs == 0) {
- $is_camtasia = 6;
- } else {
- @diffs = &compare_arrays(\@paths,\@camtasia8_1);
- if (@diffs == 0) {
- $is_camtasia = 8;
- } else {
- @diffs = &compare_arrays(\@paths,\@camtasia8_4);
- if (@diffs == 0) {
- $is_camtasia = 8;
- }
- }
+ $is_camtasia = 1;
}
}
my $output;
@@ -13332,7 +10417,8 @@ sub decompress_form {
function camtasiaToggle() {
for (var i=0; i'.$lt{'proa'}.''.
- ' '.
' '.&mt('Not extracted.').'
'."\n";
- }
- unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
- return ''.&mt('Not extracted.').'
'."\n";
- }
- unless ($file eq &Apache::lonnet::clean_filename($file)) {
- return ''.&mt('Not extracted.').'
'."\n";
- }
my ($dir,$error,$warning,$output);
- if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
- $error = &mt('Filename not a supported archive file type.').
- ''.&mt('Folder: [_1] added to course',
- &HTML::Entities::encode($docstitle,'<>&"'))..
- ' '."\n";
+ $result .= ''.&mt('Folder: [_1] added to course',$docstitle).' '."\n";
}
}
} else {
@@ -14215,49 +11270,38 @@ sub process_extracted_files {
my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
$docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
$title;
- if (($outer !~ /\D/) &&
- (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) &&
- ($newidx !~ /\D/)) {
- if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
- mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
- }
- if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
- mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
- }
- if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
- if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
- $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
- unless ($ishome) {
- my $fetch = "$newdest{$i}/$title";
- $fetch =~ s/^\Q$prefix$dir\E//;
- $prompttofetch{$fetch} = 1;
- }
- }
+ if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
+ mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
+ }
+ if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
+ mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
+ }
+ if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
+ system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
+ $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
+ unless ($ishome) {
+ my $fetch = "$newdest{$i}/$title";
+ $fetch =~ s/^\Q$prefix$dir\E//;
+ $prompttofetch{$fetch} = 1;
}
- $LONCAPA::map::resources[$newidx]=
- $docstitle.':'.$url.':false:normal:res';
- push(@LONCAPA::map::order, $newidx);
- my ($outtext,$errtext)=
- &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
- $docuname.'/'.$folders{$outer}.
- '.'.$containers{$outer},1,1);
- unless ($errtext) {
- if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
- $result .= ''.&mt('File: [_1] added to course',
- &HTML::Entities::encode($docstitle,'<>&"')).
- ' '."\n";
- }
+ }
+ $LONCAPA::map::resources[$newidx]=
+ $docstitle.':'.$url.':false:normal:res';
+ push(@LONCAPA::map::order, $newidx);
+ my ($outtext,$errtext)=
+ &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
+ $docuname.'/'.$folders{$outer}.
+ '.'.$containers{$outer},1);
+ unless ($errtext) {
+ if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
+ $result .= ''.&mt('File: [_1] added to course',$docstitle).' '."\n";
}
- } else {
- $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
- &HTML::Entities::encode($path,'<>&"')).''.&mt('[_1] included as a dependency',
- &HTML::Entities::encode($showpath,'<>&"')).
- ' '."\n";
- unless ($ishome) {
- my $fetch = "$fullpath/$title";
- $fetch =~ s/^\Q$prefix$dir\E//;
- $prompttofetch{$fetch} = 1;
- }
+ }
+ $result .= ''.&mt('[_1] included as a dependency',$showpath).' '."\n";
+ }
+ unless ($ishome) {
+ my $fetch = "$fullpath/$title";
+ $fetch =~ s/^\Q$prefix$dir\E//;
+ $prompttofetch{$fetch} = 1;
}
}
}
} elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
$warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
- &HTML::Entities::encode($path,'<>&"'),
- &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
- ''.
' '.
+ $item.'"'.$checked.' />'.$parent_title.''.
'';
+ $text .= '';
for (my $j=0; $j<$numchildren; $j++) {
$name = $cats->[$depth]{$parent}[$j];
$item = &escape($name).':'.&escape($parent).':'.$depth;
@@ -16152,12 +12960,12 @@ sub assign_category_rows {
}
$text .= ''.
' ';
if (ref($path) eq 'ARRAY') {
push(@{$path},$name);
- $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
+ $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
pop(@{$path});
}
$text .= ' '.$env{'course.'.$scope.'.description'}.' ';
- } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
- my ($audom,$auname) = split(/\//,$scope);
- return &mt('[_1] Author Space',''.
- &Apache::loncommon::plainname($auname,$audom).' ');
- } else {
- $scope =~ s{/$}{};
- return &mt('Domain: [_1]',''.
- &Apache::lonnet::domain($scope,'description').' ');
- }
-}
-
############################################################
############################################################
@@ -16368,8 +13145,7 @@ sub check_clone {
my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
- my $clonetitle;
- my @clonemsg;
+ my $clonemsg;
my $can_clone = 0;
my $lctype = lc($args->{'crstype'});
if ($lctype ne 'community') {
@@ -16377,154 +13153,59 @@ sub check_clone {
}
if ($clonehome eq 'no_host') {
if ($args->{'crstype'} eq 'Community') {
- push(@clonemsg,({
- mt => 'No new community created.',
- args => [],
- },
- {
- mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
- args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
- }));
+ $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
} else {
- push(@clonemsg,({
- mt => 'No new course created.',
- args => [],
- },
- {
- mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
- args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
- }));
- }
+ $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
+ }
} else {
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
- $clonetitle = $clonedesc{'description'};
if ($args->{'crstype'} eq 'Community') {
if ($clonedesc{'type'} ne 'Community') {
- push(@clonemsg,({
- mt => 'No new community created.',
- args => [],
- },
- {
- mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
- args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
- }));
- return ($can_clone,\@clonemsg,$cloneid,$clonehome);
+ $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
+ return ($can_clone, $clonemsg, $cloneid, $clonehome);
}
}
- if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
+ if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
(&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
$can_clone = 1;
} else {
- my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
+ my %clonehash = &Apache::lonnet::get('environment',['cloners'],
$args->{'clonedomain'},$args->{'clonecourse'});
- if ($clonehash{'cloners'} eq '') {
- my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
- if ($domdefs{'canclone'}) {
- unless ($domdefs{'canclone'} eq 'none') {
- if ($domdefs{'canclone'} eq 'domain') {
- if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
- $can_clone = 1;
- }
- } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
- ($args->{'clonedomain'} eq $args->{'course_domain'})) {
- if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
- $clonehash{'internal.coursecode'},$args->{'crscode'})) {
- $can_clone = 1;
- }
- }
- }
- }
+ my @cloners = split(/,/,$clonehash{'cloners'});
+ if (grep(/^\*$/,@cloners)) {
+ $can_clone = 1;
+ } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
+ $can_clone = 1;
} else {
- my @cloners = split(/,/,$clonehash{'cloners'});
- if (grep(/^\*$/,@cloners)) {
- $can_clone = 1;
- } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
- $can_clone = 1;
- } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
- $can_clone = 1;
- }
- unless ($can_clone) {
- if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
- ($args->{'clonedomain'} eq $args->{'course_domain'})) {
- my (%gotdomdefaults,%gotcodedefaults);
- foreach my $cloner (@cloners) {
- if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
- ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
- my (%codedefaults,@code_order);
- if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
- if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
- %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
- }
- if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
- @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
- }
- } else {
- &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
- \%codedefaults,
- \@code_order);
- $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
- $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
- }
- if (@code_order > 0) {
- if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
- $cloner,$clonehash{'internal.coursecode'},
- $args->{'crscode'})) {
- $can_clone = 1;
- last;
- }
- }
- }
- }
- }
- }
- }
- unless ($can_clone) {
my $ccrole = 'cc';
if ($args->{'crstype'} eq 'Community') {
$ccrole = 'co';
}
- my %roleshash =
- &Apache::lonnet::get_my_roles($args->{'ccuname'},
- $args->{'ccdomain'},
- 'userroles',['active'],[$ccrole],
- [$args->{'clonedomain'}]);
- if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
+ my %roleshash =
+ &Apache::lonnet::get_my_roles($args->{'ccuname'},
+ $args->{'ccdomain'},
+ 'userroles',['active'],[$ccrole],
+ [$args->{'clonedomain'}]);
+ if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
$can_clone = 1;
- } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
- $args->{'ccuname'},$args->{'ccdomain'})) {
+ } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
$can_clone = 1;
- }
- }
- unless ($can_clone) {
- if ($args->{'crstype'} eq 'Community') {
- push(@clonemsg,({
- mt => 'No new community created.',
- args => [],
- },
- {
- mt => 'The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',
- args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
- }));
} else {
- push(@clonemsg,({
- mt => 'No new course created.',
- args => [],
- },
- {
- mt => 'The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',
- args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
- }));
+ if ($args->{'crstype'} eq 'Community') {
+ $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+ } else {
+ $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+ }
}
}
}
}
- return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
+ return ($can_clone, $clonemsg, $cloneid, $clonehome);
}
sub construct_course {
- my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
- $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
- my ($outcome,$msgref,$clonemsgref);
+ my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
+ my $outcome;
my $linefeed = ''.$clonemsg.' ';
+ }
+ }
+ $outcome .= $clonemsg.$linefeed;
+
if (!$can_clone) {
- return (0,$outcome,$clonemsgref);
+ return (0,$outcome);
}
}
@@ -16555,20 +13243,15 @@ sub construct_course {
$args->{'ccuname'}.':'.
$args->{'ccdomain'},
$args->{'crstype'},
- $cnum,$context,$category,
- $callercontext);
+ $cnum,$context,$category);
# Note: The testing routines depend on this being output; see
# Utils::Course. This needs to at least be output as a comment
# if anyone ever decides to not show this, and Utils::Course::new
# will need to be suitably modified.
- if (($callercontext eq 'auto') && ($user_lh ne '')) {
- $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
- } else {
- $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
- }
+ $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
if ($$courseid =~ /^error:/) {
- return (0,$outcome,$clonemsgref);
+ return (0,$outcome);
}
#
@@ -16577,37 +13260,23 @@ sub construct_course {
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
if ($crsuhome eq 'no_host') {
- if (($callercontext eq 'auto') && ($user_lh ne '')) {
- $outcome .= &mt_user($user_lh,
- 'Course creation failed, unrecognized course home server.');
- } else {
- $outcome .= &mt('Course creation failed, unrecognized course home server.');
- }
- $outcome .= $linefeed;
- return (0,$outcome,$clonemsgref);
+ $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
+ return (0,$outcome);
}
$outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
#
# Do the cloning
-#
- my @clonemsg;
+#
if ($can_clone && $cloneid) {
- push(@clonemsg,
- {
- mt => 'Created [_1] by cloning from [_2]',
- args => [$crstype,$clonetitle],
- });
+ $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
+ if ($context ne 'auto') {
+ $clonemsg = ''.$clonemsg.' ';
+ }
+ $outcome .= $clonemsg.$linefeed;
my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
# Copy all files
- my @info =
- &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
- $args->{'dateshift'},$args->{'crscode'},
- $args->{'ccuname'}.':'.$args->{'ccdomain'},
- $args->{'tinyurls'});
- if (@info) {
- push(@clonemsg,@info);
- }
+ &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
# Restore URL
$cenv{'url'}=$oldcenv{'url'};
# Restore title
@@ -16631,12 +13300,8 @@ sub construct_course {
'pch.users.denied',
'plc.users.denied',
'hidefromcat',
- 'checkforpriv',
'categories'],
$$crsudom,$$crsunum);
- if ($args->{'textbook'}) {
- $cenv{'internal.textbook'} = $args->{'textbook'};
- }
}
#
@@ -16647,9 +13312,6 @@ sub construct_course {
if ($args->{'crstype'}) {
$cenv{'type'}=$args->{'crstype'};
}
- if ($args->{'lti'}) {
- $cenv{'internal.lti'}=$args->{'lti'};
- }
if ($args->{'crsid'}) {
$cenv{'courseid'}=$args->{'crsid'};
}
@@ -16667,11 +13329,7 @@ sub construct_course {
} else {
$cenv{'internal.courseowner'} = $args->{'curruser'};
}
- if ($args->{'defaultcredits'}) {
- $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
- }
my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
- my @oklcsecs = (); # Used to accumulate LON-CAPA sections for validated institutional sections.
if ($args->{'crssections'}) {
$cenv{'internal.sectionnums'} = '';
if ($args->{'crssections'} =~ m/,/) {
@@ -16685,12 +13343,8 @@ sub construct_course {
my $class = $args->{'crscode'}.$sec;
my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
$cenv{'internal.sectionnums'} .= $item.',';
- if ($addcheck eq 'ok') {
- unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
- push(@oklcsecs,$gp);
- }
- } else {
- push(@badclasses,$class);
+ unless ($addcheck eq 'ok') {
+ push @badclasses, $class;
}
}
$cenv{'internal.sectionnums'} =~ s/,$//;
@@ -16699,11 +13353,6 @@ sub construct_course {
# do not hide course coordinator from staff listing,
# even if privileged
$cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
-# add course coordinator's domain to domains to check for privileged users
-# if different to course domain
- if ($$crsudom ne $args->{'ccdomain'}) {
- $cenv{'checkforpriv'} = $args->{'ccdomain'};
- }
# add crosslistings
if ($args->{'crsxlist'}) {
$cenv{'internal.crosslistings'}='';
@@ -16717,12 +13366,8 @@ sub construct_course {
my ($xl,$gp) = split/:/,$item;
my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
$cenv{'internal.crosslistings'} .= $item.',';
- if ($addcheck eq 'ok') {
- unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
- push(@oklcsecs,$gp);
- }
- } else {
- push(@badclasses,$xl);
+ unless ($addcheck eq 'ok') {
+ push @badclasses, $xl;
}
}
$cenv{'internal.crosslistings'} =~ s/,$//;
@@ -16757,63 +13402,32 @@ sub construct_course {
}
if (@badclasses > 0) {
my %lt=&Apache::lonlocal::texthash(
- 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
- 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
- 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
+ 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course. However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',
+ 'dnhr' => 'does not have rights to access enrollment in these classes',
+ 'adby' => 'as determined by the policies of your institution on access to official classlists'
);
- my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
- &mt('That is because the user identified as the course owner ([_1]) does not have rights to access enrollment in these classes, as determined by the policies of your institution on access to official classlists',$cenv{'internal.courseowner'}).$linefeed.$lt{'itis'};
+ my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
+ ' ('.$lt{'adby'}.')';
if ($context eq 'auto') {
$outcome .= $badclass_msg.$linefeed;
- } else {
$outcome .= ''.$badclass_msg.$linefeed.'
'."\n";
- }
- foreach my $item (@badclasses) {
+ foreach my $item (@badclasses) {
+ if ($context eq 'auto') {
+ $outcome .= " - $item\n";
+ } else {
+ $outcome .= "$item \n";
+ }
+ }
if ($context eq 'auto') {
- $outcome .= " - $item\n";
+ $outcome .= $linefeed;
} else {
- $outcome .= "$item \n";
+ $outcome .= " ".&mt($posstype)."\n";
- }
- $typeselectform.=" ";
- }
-
- my ($cloneableonlyform,$cloneabletitle);
- if (exists($filter->{'cloneableonly'})) {
- my $cloneableon = '';
- my $cloneableoff = ' checked="checked"';
- if ($filter->{'cloneableonly'}) {
- $cloneableon = $cloneableoff;
- $cloneableoff = '';
- }
- $cloneableonlyform = '
-// {major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
+ ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
return;
}
-// ]]>
-
-
-ENDJS
-}
-
-=pod
-
-=item * &search_courses()
-
-Process selected filters form course search form and pass to lonnet::courseiddump
-to retrieve a hash for which keys are courseIDs which match the selected filters.
-
-Inputs:
-
-dom - domain being searched
-
-type - course type ('Course' or 'Community' or '.' if any).
-
-filter - anonymous hash of criteria and their values
-
-numtitles - for institutional codes - number of categories
-
-cloneruname - optional username of new course owner
-
-clonerudom - optional domain of new course owner
-
-domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
- (used when DC is using course creation form)
-
-codetitles - reference to array of titles of components in institutional codes (official courses).
-
-cc_clone - escaped comma separated list of courses for which course cloner has active CC role
- (and so can clone automatically)
-
-reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
-
-reqinstcode - institutional code of new course, where search_courses is used to identify potential
- courses to clone
-
-Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
-
-
-Side Effects: None
-
-=cut
-
-
-sub search_courses {
- my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
- $cc_clone,$reqcrsdom,$reqinstcode) = @_;
- my (%courses,%showcourses,$cloner);
- if (($filter->{'ownerfilter'} ne '') ||
- ($filter->{'ownerdomfilter'} ne '')) {
- $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
- $filter->{'ownerdomfilter'};
- }
- foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
- if (!$filter->{$item}) {
- $filter->{$item}='.';
- }
- }
- my $now = time;
- my $timefilter =
- ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
- my ($createdbefore,$createdafter);
- if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
- $createdbefore = $now;
- $createdafter = $now-$filter->{'createdfilter'};
- }
- my ($instcodefilter,$regexpok);
- if ($numtitles) {
- if ($env{'form.official'} eq 'on') {
- $instcodefilter =
- &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
- $regexpok = 1;
- } elsif ($env{'form.official'} eq 'off') {
- $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
- unless ($instcodefilter eq '') {
- $regexpok = -1;
- }
- }
- } else {
- $instcodefilter = $filter->{'instcodefilter'};
- }
- if ($instcodefilter eq '') { $instcodefilter = '.'; }
- if ($type eq '') { $type = '.'; }
-
- if (($clonerudom ne '') && ($cloneruname ne '')) {
- $cloner = $cloneruname.':'.$clonerudom;
- }
- %courses = &Apache::lonnet::courseiddump($dom,
- $filter->{'descriptfilter'},
- $timefilter,
- $instcodefilter,
- $filter->{'combownerfilter'},
- $filter->{'coursefilter'},
- undef,undef,$type,$regexpok,undef,undef,
- undef,undef,$cloner,$cc_clone,
- $filter->{'cloneableonly'},
- $createdbefore,$createdafter,undef,
- $domcloner,undef,$reqcrsdom,$reqinstcode);
- if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
- my $ccrole;
- if ($type eq 'Community') {
- $ccrole = 'co';
- } else {
- $ccrole = 'cc';
- }
- my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
- $filter->{'persondomfilter'},
- 'userroles',undef,
- [$ccrole,'in','ad','ep','ta','cr'],
- $dom);
- foreach my $role (keys(%rolehash)) {
- my ($cnum,$cdom,$courserole) = split(':',$role);
- my $cid = $cdom.'_'.$cnum;
- if (exists($courses{$cid})) {
- if (ref($courses{$cid}) eq 'HASH') {
- if (ref($courses{$cid}{roles}) eq 'ARRAY') {
- if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
- push(@{$courses{$cid}{roles}},$courserole);
- }
- } else {
- $courses{$cid}{roles} = [$courserole];
- }
- $showcourses{$cid} = $courses{$cid};
- }
- }
- }
- %courses = %showcourses;
- }
- return %courses;
-}
-
-=pod
-
-=back
-
-=head1 Routines for version requirements for current course.
-
-=over 4
-
-=item * &check_release_required()
-
-Compares required LON-CAPA version with version on server, and
-if required version is newer looks for a server with the required version.
-
-Looks first at servers in user's owen domain; if none suitable, looks at
-servers in course's domain are permitted to host sessions for user's domain.
-
-Inputs:
-
-$loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
-
-$courseid - Course ID of current course
-
-$rolecode - User's current role in course (for switchserver query string).
-
-$required - LON-CAPA version needed by course (format: Major.Minor).
-
-
-Returns:
-
-$switchserver - query string tp append to /adm/switchserver call (if
- current server's LON-CAPA version is too old.
-
-$warning - Message is displayed if no suitable server could be found.
-
-=cut
-
-sub check_release_required {
- my ($loncaparev,$courseid,$rolecode,$required) = @_;
- my ($switchserver,$warning);
- if ($required ne '') {
- my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
- my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
- if ($reqdmajor ne '' && $reqdminor ne '') {
- my $otherserver;
- if (($major eq '' && $minor eq '') ||
- (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
- my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
- my $switchlcrev =
- &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
- $userdomserver);
- my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
- if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
- (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
- my $cdom = $env{'course.'.$courseid.'.domain'};
- if ($cdom ne $env{'user.domain'}) {
- my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
- my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
- my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
- my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
- my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
- my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
- my $canhost =
- &Apache::lonnet::can_host_session($env{'user.domain'},
- $coursedomserver,
- $remoterev,
- $udomdefaults{'remotesessions'},
- $defdomdefaults{'hostedsessions'});
-
- if ($canhost) {
- $otherserver = $coursedomserver;
- } else {
- $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'';
- if ($switchwarning) {
- $output .= $switchwarning.'';
- if (&show_course()) {
- $output .= &mt('Display courses');
- } else {
- $output .= &mt('Display roles');
- }
- $output .= ' ';
- } elsif ($switchserver) {
- $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
- ''.
- &mt('Switch Server').
- ' ';
- }
- $output .= '
'.&end_page();
- return $output;
-}
-
-=pod
-
-=item * &needs_coursereinit()
-
-Determine if course contents stored for user's session needs to be
-refreshed, because content has changed since "Big Hash" last tied.
-
-Check for change is made if time last checked is more than 10 minutes ago
-(by default).
-
-Inputs:
-
-$loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
-
-$interval (optional) - Time which may elapse (in s) between last check for content
- change in current course. (default: 600 s).
-
-Returns: an array; first element is:
-
-=over 4
-
-'switch' - if content updates mean user's session
- needs to be switched to a server running a newer LON-CAPA version
-
-'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
- on current server hosting user's session
-
-'' - if no action required.
-
-=back
-
-If first item element is 'switch':
-
-second item is $switchwarning - Warning message if no suitable server found to host session.
-
-third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
- and current role.
-
-otherwise: no other elements returned.
-
-=back
-
-=cut
-
-sub needs_coursereinit {
- my ($loncaparev,$interval) = @_;
- return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
- my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
- my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
- my $now = time;
- if ($interval eq '') {
- $interval = 600;
- }
- if (($now-$env{'request.course.timechecked'})>$interval) {
- &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
- my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
- if ($blocked) {
- return ();
- }
- my $update;
- my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
- my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum);
- if ($lastmainchange > $env{'request.course.tied'}) {
- my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
- if ($needswitch) {
- return ('switch',$switchwarning,$switchserver);
- }
- $update = 'main';
- }
- if ($lastsuppchange > $env{'request.course.suppupdated'}) {
- if ($update) {
- $update = 'both';
- } else {
- my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
- if ($needswitch) {
- return ('switch',$switchwarning,$switchserver);
- } else {
- $update = 'supp';
- }
- }
- return ($update);
- }
- }
- return ();
-}
-
-sub switch_for_update {
- my ($loncaparev,$cdom,$cnum) = @_;
- my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
- if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
- my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
- if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
- &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
- $curr_reqd_hash{'internal.releaserequired'}});
- my ($switchserver,$switchwarning) =
- &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
- $curr_reqd_hash{'internal.releaserequired'});
- if ($switchwarning ne '' || $switchserver ne '') {
- return ('switch',$switchwarning,$switchserver);
- }
- }
- }
- return ();
-}
-
sub update_content_constraints {
my ($cdom,$cnum,$chome,$cid) = @_;
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
@@ -18234,32 +13929,6 @@ sub update_content_constraints {
return;
}
-sub allmaps_incourse {
- my ($cdom,$cnum,$chome,$cid) = @_;
- if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
- $cid = $env{'request.course.id'};
- $cdom = $env{'course.'.$cid.'.domain'};
- $cnum = $env{'course.'.$cid.'.num'};
- $chome = $env{'course.'.$cid.'.home'};
- }
- my %allmaps = ();
- my $lastchange =
- &Apache::lonnet::get_coursechange($cdom,$cnum);
- if ($lastchange > $env{'request.course.tied'}) {
- my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
- unless ($ferr) {
- &update_content_constraints($cdom,$cnum,$chome,$cid);
- }
- }
- my $navmap = Apache::lonnavmaps::navmap->new();
- if (defined($navmap)) {
- foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
- $allmaps{$res->src()} = 1;
- }
- }
- return \%allmaps;
-}
-
sub parse_supplemental_title {
my ($title) = @_;
@@ -18274,10 +13943,8 @@ sub parse_supplemental_title {
my $name = &plainname($uname,$udom);
$name = &HTML::Entities::encode($name,'"<>&\'');
$renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
- $title=''.&Apache::lonlocal::locallocaltime($time).' '.$name;
- if ($foldertitle ne '') {
- $title .= ': '.&Apache::lonlocal::locallocaltime($time).' '.
+ $name.': '.
- &mt('Type in the letters/numbers shown below').' '.
- '
'.
- '
';
- } else {
- my $use_ssl;
- if ($ENV{'SERVER_PORT'} == 443) {
- $use_ssl = 1;
- }
- my $captcha = Captcha::reCAPTCHA->new;
- return $captcha->get_options_setter({theme => 'white'})."\n".
- $captcha->get_html($pubkey,undef,$use_ssl).
- &mt('If the text is hard to read, [_1] will replace them.',
- '