-
- $lt{'doma'}:
- $domform
-
-
-
- $lt{'usr'}:
- $srchbysel
- $srchtypesel
-
- $srchinsel
-
-
-
-
END_BLOCK
+ $output .= &Apache::lonhtmlcommon::start_pick_box().
+ &Apache::lonhtmlcommon::row_title($lt{'doma'}).
+ $domform.
+ &Apache::lonhtmlcommon::row_closure().
+ &Apache::lonhtmlcommon::row_title($lt{'usr'}).
+ $srchbysel.
+ $srchtypesel.
+ ' '.
+ $srchinsel.
+ &Apache::lonhtmlcommon::row_closure(1).
+ &Apache::lonhtmlcommon::end_pick_box().
+ ' ';
return $output;
}
@@ -7940,6 +8291,10 @@ sub get_institutional_codes {
return;
}
+sub get_standard_codeitems {
+ return ('Year','Semester','Department','Number','Section');
+}
+
=pod
=head1 Slot Helpers
@@ -8131,68 +8486,307 @@ sub get_env_multiple {
sub ask_for_embedded_content {
my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
- my $upload_output = '
- ';
- return $upload_output;
+ $upload_output .= &embedded_file_element('upload_embedded',$num,
+ $embed_file,\%mapping,
+ $allfiles,$codebase);
+ $num++;
+ }
+ $upload_output .= ''.&Apache::loncommon::end_data_table_row()."\n";
+ }
+ foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
+ $upload_output .= &start_data_table_row().
+ ''.$embed_file.' '.
+ ''.&mt('Already exists').' '.
+ &Apache::loncommon::end_data_table_row()."\n";
+ }
+ if ($upload_output) {
+ $upload_output = &start_data_table().
+ $upload_output.
+ &end_data_table()."\n";
+ }
+ my $applies = 0;
+ if ($numremref) {
+ $applies ++;
+ }
+ if ($numinvalid) {
+ $applies ++;
+ }
+ if ($numexisting) {
+ $applies ++;
+ }
+ if ($num) {
+ $output = ''."\n";
+ } elsif ($numpathchg) {
+ my %pathchange = ();
+ $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
+ if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
+ $output .= ''.&mt('or').'
';
+ }
+ }
+ return ($output,$num,$numpathchg);
+}
+
+sub embedded_file_element {
+ my ($context,$num,$embed_file,$mapping,$allfiles,$codebase) = @_;
+ return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
+ (ref($codebase) eq 'HASH'));
+ my $output;
+ if ($context eq 'upload_embedded') {
+ $output = ' '."\n";
+ }
+ $output .= ' ';
+ unless (($context eq 'upload_embedded') &&
+ ($mapping->{$embed_file} eq $embed_file)) {
+ $output .='
+ ';
+ }
+ my $attrib;
+ if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
+ $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
+ }
+ $output .=
+ "\n\t\t".
+ ' ';
+ if (exists($codebase->{$mapping->{$embed_file}})) {
+ $output .=
+ "\n\t\t".
+ ' ';
+ }
+ return $output;
}
sub upload_embedded {
my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
- $current_disk_usage) = @_;
- my $output;
+ $current_disk_usage,$hiddenstate,$actionurl) = @_;
+ my (%pathchange,$output,$modifyform,$footer,$returnflag);
for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
my $orig_uploaded_filename =
$env{'form.embedded_item_'.$i.'.filename'};
-
- $env{'form.embedded_orig_'.$i} =
- &unescape($env{'form.embedded_orig_'.$i});
+ foreach my $type ('orig','ref','attrib','codebase') {
+ if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
+ $env{'form.embedded_'.$type.'_'.$i} =
+ &unescape($env{'form.embedded_'.$type.'_'.$i});
+ }
+ }
my ($path,$fname) =
($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
# no path, whole string is fname
if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
-
- $path = $env{'form.currentpath'}.$path;
$fname = &Apache::lonnet::clean_filename($fname);
# See if there is anything left
next if ($fname eq '');
@@ -8204,12 +8798,12 @@ sub upload_embedded {
if ($group ne '') {
$port_path = "groups/$group/$port_path";
}
- ($state,$msg) = &check_for_upload($path,$fname,$group,'embedded_item_'.$i,
+ ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
+ $fname,$group,'embedded_item_'.$i,
$dir_root,$port_path,$disk_quota,
$current_disk_usage,$uname,$udom);
if ($state eq 'will_exceed_quota'
- || $state eq 'file_locked'
- || $state eq 'file_exists' ) {
+ || $state eq 'file_locked') {
$output .= $msg;
next;
}
@@ -8223,31 +8817,53 @@ 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 LONCAPA use - rename the file with a different extension and re-upload. ',$1);
+ $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1).' ';
next;
} elsif (($fname =~ /\.(\w+)$/) &&
(!defined(&Apache::loncommon::fileembstyle($1)))) {
- $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);
+ $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).' ';
next;
} elsif ($fname=~/\.(\d+)\.(\w+)$/) {
- $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
+ $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).' ';
next;
}
$env{'form.embedded_item_'.$i.'.filename'}=$fname;
if ($context eq 'portfolio') {
- my $result=
- &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
- $dirpath.$path);
+ my $result;
+ if ($state eq 'existingfile') {
+ $result=
+ &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
+ $dirpath.$env{'form.currentpath'}.$path);
+ } else {
+ $result=
+ &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
+ $dirpath.
+ $env{'form.currentpath'}.$path);
+ if ($result !~ m|^/uploaded/|) {
+ $output .= ''
+ .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
+ ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
+ .' ';
+ next;
+ } else {
+ $output .= &mt('Uploaded [_1]',''.
+ $path.$fname.' ').' ';
+ }
+ }
+ } elsif ($context eq 'coursedoc') {
+ my $result =
+ &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
+ $dirpath.'/'.$path);
if ($result !~ m|^/uploaded/|) {
$output .= ''
- .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
+ .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
- .' ';
- next;
+ .' ';
+ next;
} else {
- $output .= ''.&mt('Uploaded [_1]',''.
- $path.$fname.' ').'
';
+ $output .= &mt('Uploaded [_1]',''.
+ $path.$fname.' ').' ';
}
} else {
# Save the file
@@ -8277,19 +8893,190 @@ sub upload_embedded {
&mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
' ';
} else {
- if ($context eq 'testbank') {
- $output .= &mt('Embedded file uploaded successfully:').
- ' '.
- $orig_uploaded_filename.' ';
- } else {
- $output .= ''.
- &mt('View embedded file: [_1]',''.
- $orig_uploaded_filename.' ').' ';
+ $output .= &mt('Uploaded [_1]',''.
+ $url.' ').' ';
+ unless ($context eq 'testbank') {
+ $footer .= &mt('View embedded file: [_1]',
+ ''.$fname.' ').' ';
}
}
close($fh);
}
}
+ if ($env{'form.embedded_ref_'.$i}) {
+ $pathchange{$i} = 1;
+ }
+ }
+ if ($output) {
+ $output = ''.$output.'
';
+ }
+ $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
+ $returnflag = 'ok';
+ if (keys(%pathchange) > 0) {
+ if ($context eq 'portfolio') {
+ $output .= ''.&mt('or').'
';
+ } elsif ($context eq 'testbank') {
+ $output .= ''.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).','',' ').'
';
+ $returnflag = 'modify_orightml';
+ }
+ }
+ return ($output.$footer,$returnflag);
+}
+
+sub modify_html_form {
+ my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
+ my $end = 0;
+ my $modifyform;
+ if ($context eq 'upload_embedded') {
+ return unless (ref($pathchange) eq 'HASH');
+ if ($env{'form.number_embedded_items'}) {
+ $end += $env{'form.number_embedded_items'};
+ }
+ if ($env{'form.number_pathchange_items'}) {
+ $end += $env{'form.number_pathchange_items'};
+ }
+ if ($end) {
+ for (my $i=0; $i<$end; $i++) {
+ if ($i < $env{'form.number_embedded_items'}) {
+ next unless($pathchange->{$i});
+ }
+ $modifyform .=
+ &start_data_table_row().
+ ' '.
+ ''.$env{'form.embedded_ref_'.$i}.
+ ' '.
+ ' '.
+ ' '.
+ ''.$env{'form.embedded_orig_'.$i}.
+ ' '.
+ &end_data_table_row();
+ }
+ }
+ } else {
+ $modifyform = $pathchgtable;
+ if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
+ $hiddenstate .= ' ';
+ } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
+ $hiddenstate .= ' ';
+ }
+ }
+ if ($modifyform) {
+ return ''.&mt('Changes in content of HTML file required').' '."\n".
+ ''.&mt('Changes need to be made to the reference(s) used for one or more of the dependencies, if your HTML file is to work correctly:').'
'."\n".
+ ''.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').' '."\n".
+ ''.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').' '."\n".
+ ' '."\n".''.
+ &mt('LON-CAPA can make the required changes to your HTML file.').'
'."\n".
+ ''."\n";
+ }
+ return;
+}
+
+sub modify_html_refs {
+ my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
+ my $container;
+ if ($context eq 'portfolio') {
+ $container = $env{'form.container'};
+ } elsif ($context eq 'coursedoc') {
+ $container = $env{'form.primaryurl'};
+ } else {
+ $container = $env{'form.filename'};
+ $container =~ s{^/priv/(\Q$uname\E)/(.*)}{/home/$1/public_html/$2};
+ }
+ my (%allfiles,%codebase,$output,$content);
+ my @changes = &get_env_multiple('form.namechange');
+ return unless (@changes > 0);
+ if (($context eq 'portfolio') || ($context eq 'coursedoc')) {
+ return unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/});
+ $content = &Apache::lonnet::getfile($container);
+ return if ($content eq '-1');
+ } else {
+ return unless ($container =~ /^\Q$dir_root\E/);
+ if (open(my $fh,"<$container")) {
+ $content = join('', <$fh>);
+ close($fh);
+ } else {
+ return;
+ }
+ }
+ my ($count,$codebasecount) = (0,0);
+ my $mm = new File::MMagic;
+ my $mime_type = $mm->checktype_contents($content);
+ if ($mime_type eq 'text/html') {
+ my $parse_result =
+ &Apache::lonnet::extract_embedded_items($container,\%allfiles,
+ \%codebase,\$content);
+ if ($parse_result eq 'ok') {
+ foreach my $i (@changes) {
+ my $orig = &unescape($env{'form.embedded_orig_'.$i});
+ my $ref = &unescape($env{'form.embedded_ref_'.$i});
+ if ($allfiles{$ref}) {
+ my $newname = $orig;
+ my ($attrib_regexp,$codebase);
+ my $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
+ if ($attrib_regexp =~ /:/) {
+ $attrib_regexp =~ s/\:/|/g;
+ }
+ if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
+ my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
+ $count += $numchg;
+ }
+ if ($env{'form.embedded_codebase_'.$i} ne '') {
+ my $codebase = &unescape($env{'form.embedded_codebase_'.$i});
+ my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
+ $codebasecount ++;
+ }
+ }
+ }
+ if ($count || $codebasecount) {
+ my $saveresult;
+ if ($context eq 'portfolio' || $context eq 'coursedoc') {
+ my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
+ if ($url eq $container) {
+ my ($fname) = ($container =~ m{/([^/]+)$});
+ $output = ''.&mt('Updated [quant,_1,reference] in [_2].',
+ $count,''.
+ $fname.' ').'
';
+ } else {
+ $output = ''.
+ &mt('Error: update failed for: [_1].',
+ ''.
+ $container.' ').'
';
+ }
+ } else {
+ if (open(my $fh,">$container")) {
+ print $fh $content;
+ close($fh);
+ $output = ''.&mt('Updated [quant,_1,reference] in [_2].',
+ $count,''.
+ $container.' ').'
';
+ } else {
+ $output = ''.
+ &mt('Error: could not update [_1].',
+ ''.
+ $container.' ').'
';
+ }
+ }
+ }
+ } else {
+ &logthis('Failed to parse '.$container.
+ ' to modify references: '.$parse_result);
+ }
}
return $output;
}
@@ -8313,22 +9100,71 @@ sub check_for_existing {
sub check_for_upload {
my ($path,$fname,$group,$element,$portfolio_root,$port_path,
$disk_quota,$current_disk_usage,$uname,$udom) = @_;
- my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?)
+ my $filesize = length($env{'form.'.$element});
+ if (!$filesize) {
+ my $msg = ''.
+ &mt('Unable to upload [_1]. (size = [_2] bytes)',
+ ''.$fname.' ',
+ $filesize).' '.
+ &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').' ';
+ ' ';
+ return ('zero_bytes',$msg);
+ }
+ $filesize = $filesize/1000; #express in k (1024?)
my $getpropath = 1;
my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,
$getpropath);
my $found_file = 0;
my $locked_file = 0;
+ my @lockers;
+ my $navmap;
+ if ($env{'request.course.id'}) {
+ $navmap = Apache::lonnavmaps::navmap->new();
+ }
foreach my $line (@dir_list) {
- my ($file_name)=split(/\&/,$line,2);
+ my ($file_name,$rest)=split(/\&/,$line,2);
if ($file_name eq $fname){
$file_name = $path.$file_name;
if ($group ne '') {
$file_name = $group.$file_name;
}
$found_file = 1;
- if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {
- $locked_file = 1;
+ if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
+ foreach my $lock (@lockers) {
+ if (ref($lock) eq 'ARRAY') {
+ my ($symb,$crsid) = @{$lock};
+ if ($crsid eq $env{'request.course.id'}) {
+ if (ref($navmap)) {
+ my $res = $navmap->getBySymb($symb);
+ foreach my $part (@{$res->parts()}) {
+ my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
+ unless (($slot_status == $res->RESERVED) ||
+ ($slot_status == $res->RESERVED_LOCATION)) {
+ $locked_file = 1;
+ }
+ }
+ } else {
+ $locked_file = 1;
+ }
+ } else {
+ $locked_file = 1;
+ }
+ }
+ }
+ } else {
+ my @info = split(/\&/,$rest);
+ my $currsize = $info[6]/1000;
+ if ($currsize < $filesize) {
+ my $extra = $filesize - $currsize;
+ if (($current_disk_usage + $extra) > $disk_quota) {
+ 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);
+ return ('will_exceed_quota',$msg);
+ }
+ }
}
}
}
@@ -8346,15 +9182,55 @@ sub check_for_upload {
return ('file_locked',$msg);
} else {
my $msg = '';
- $msg .= &mt('Unable to upload [_1]. A file by that name was found in [_2].',''.$fname.' ',$port_path.$env{'form.currentpath'});
+ $msg .= &mt(' A file by that name: [_1] was found in [_2].',''.$fname.' ',$port_path.$env{'form.currentpath'});
$msg .= ' ';
- $msg .= ' ';
- $msg .= &mt('To upload, rename or delete existing [_1] in [_2].',''.$fname.' ', $port_path.$env{'form.currentpath'});
- return ('file_exists',$msg);
+ return ('existingfile',$msg);
}
}
}
+sub check_for_traversal {
+ my ($path,$url,$toplevel) = @_;
+ my @parts=split(/\//,$path);
+ my $cleanpath;
+ my $fullpath = $url;
+ for (my $i=0;$i<@parts;$i++) {
+ next if ($parts[$i] eq '.');
+ if ($parts[$i] eq '..') {
+ $fullpath =~ s{([^/]+/)$}{};
+ } else {
+ $fullpath .= $parts[$i].'/';
+ }
+ }
+ if ($fullpath =~ /^\Q$url\E(.*)$/) {
+ $cleanpath = $1;
+ } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
+ my $curr_toprel = $1;
+ my @parts = split(/\//,$curr_toprel);
+ my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
+ my @urlparts = split(/\//,$url_toprel);
+ my $doubledots;
+ my $startdiff = -1;
+ for (my $i=0; $i<@urlparts; $i++) {
+ if ($startdiff == -1) {
+ unless ($urlparts[$i] eq $parts[$i]) {
+ $startdiff = $i;
+ $doubledots .= '../';
+ }
+ } else {
+ $doubledots .= '../';
+ }
+ }
+ if ($startdiff > -1) {
+ $cleanpath = $doubledots;
+ for (my $i=$startdiff; $i<@parts; $i++) {
+ $cleanpath .= $parts[$i].'/';
+ }
+ }
+ }
+ $cleanpath =~ s{(/)$}{};
+ return $cleanpath;
+}
=pod
@@ -8589,7 +9465,7 @@ sub csv_print_samples {
$r->print(&mt('Samples').' '.&start_data_table().
&start_data_table_header_row());
foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
- $r->print(''.&mt('Column [_1]',($sample+1)).' '); }
+ $r->print(''.&mt('Column [_1]',($sample+1)).' '); }
$r->print(&end_data_table_header_row());
foreach my $hash (@$samples) {
$r->print(&start_data_table_row());
@@ -8633,7 +9509,7 @@ sub csv_print_select_table {
my ($value,$display,$defaultcol)=@{ $array_ref };
$r->print(&start_data_table_row().''.$display.' ');
- $r->print('print('');
$r->print(' ');
foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
@@ -9287,10 +10163,11 @@ sub restore_settings {
=item * &build_recipient_list()
-Build recipient lists for four types of e-mail:
+Build recipient lists for five types of e-mail:
(a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
-(d) Help requests, generated by
-lonerrorhandler.pm, CHECKRPMS, loncron, and lonsupportreq.pm respectively.
+(d) Help requests, (e) Course requests needing approval, generated by
+lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
+loncoursequeueadmin.pm respectively.
Inputs:
defmail (scalar - email address of default recipient),
@@ -9460,6 +10337,8 @@ sub extract_categories {
my $trailstr;
if ($name eq 'instcode') {
$trailstr = &mt('Official courses (with institutional codes)');
+ } elsif ($name eq 'communities') {
+ $trailstr = &mt('Communities');
} else {
$trailstr = $name;
}
@@ -9572,12 +10451,14 @@ cathash - reference to hash of categorie
currcat - scalar with an & separated list of categories assigned to a course.
+type - scalar contains course type (Course or Community).
+
Returns: $output (markup to be displayed)
=cut
sub assign_categories_table {
- my ($cathash,$currcat) = @_;
+ my ($cathash,$currcat,$type) = @_;
my $output;
if (ref($cathash) eq 'HASH') {
my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
@@ -9586,15 +10467,20 @@ sub assign_categories_table {
if (@cats > 0) {
my $itemcount = 0;
if (ref($cats[0]) eq 'ARRAY') {
- $output = &Apache::loncommon::start_data_table();
my @currcategories;
if ($currcat ne '') {
@currcategories = split('&',$currcat);
}
+ my $table;
for (my $i=0; $i<@{$cats[0]}; $i++) {
my $parent = $cats[0][$i];
- my $css_class = $itemcount%2?' class="LC_odd_row"':'';
next if ($parent eq 'instcode');
+ if ($type eq 'Community') {
+ next unless ($parent eq 'communities');
+ } else {
+ next if ($parent eq 'communities');
+ }
+ my $css_class = $itemcount%2?' class="LC_odd_row"':'';
my $item = &escape($parent).'::0';
my $checked = '';
if (@currcategories > 0) {
@@ -9602,18 +10488,26 @@ sub assign_categories_table {
$checked = ' checked="checked"';
}
}
- $output .= ''.
- ' '.$parent.' '.
- ' ';
+ my $parent_title = $parent;
+ if ($parent eq 'communities') {
+ $parent_title = &mt('Communities');
+ }
+ $table .= ''.
+ ' '.$parent_title.' '.
+ ' ';
my $depth = 1;
push(@path,$parent);
- $output .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
+ $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
pop(@path);
- $output .= ' ';
+ $table .= ' ';
$itemcount ++;
}
- $output .= &Apache::loncommon::end_data_table();
+ if ($itemcount) {
+ $output = &Apache::loncommon::start_data_table().
+ $table.
+ &Apache::loncommon::end_data_table();
+ }
}
}
}
@@ -9858,12 +10752,26 @@ sub check_clone {
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
my $clonemsg;
my $can_clone = 0;
-
+ my $lctype = lc($args->{'crstype'});
+ if ($lctype ne 'community') {
+ $lctype = 'course';
+ }
if ($clonehome eq 'no_host') {
- $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'});
+ if ($args->{'crstype'} eq 'Community') {
+ $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 {
+ $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});
- if ($env{'request.role.domain'} eq $args->{'clonedomain'}) {
+ if ($args->{'crstype'} eq 'Community') {
+ if ($clonedesc{'type'} ne 'Community') {
+ $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'}) &&
+ (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
$can_clone = 1;
} else {
my %clonehash = &Apache::lonnet::get('environment',['cloners'],
@@ -9874,15 +10782,25 @@ sub check_clone {
} elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
$can_clone = 1;
} else {
+ my $ccrole = 'cc';
+ if ($args->{'crstype'} eq 'Community') {
+ $ccrole = 'co';
+ }
my %roleshash =
&Apache::lonnet::get_my_roles($args->{'ccuname'},
$args->{'ccdomain'},
- 'userroles',['active'],['cc'],
+ 'userroles',['active'],[$ccrole],
[$args->{'clonedomain'}]);
- if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':cc'}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
- $can_clone = 1;
- } 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'});
+ 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'})) {
+ $can_clone = 1;
+ } else {
+ 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'});
+ }
}
}
}
@@ -9891,7 +10809,7 @@ sub check_clone {
}
sub construct_course {
- my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context) = @_;
+ my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
my $outcome;
my $linefeed = ' '."\n";
if ($context eq 'auto') {
@@ -9929,18 +10847,27 @@ sub construct_course {
$args->{'crscode'},
$args->{'ccuname'}.':'.
$args->{'ccdomain'},
- $args->{'crstype'});
+ $args->{'crstype'},
+ $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.
$outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
+ if ($$courseid =~ /^error:/) {
+ return (0,$outcome);
+ }
+
#
# Check if created correctly
#
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
+ if ($crsuhome eq 'no_host') {
+ $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
+ return (0,$outcome);
+ }
$outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
#
@@ -9959,6 +10886,10 @@ sub construct_course {
$cenv{'url'}=$oldcenv{'url'};
# Restore title
$cenv{'description'}=$oldcenv{'description'};
+# Restore creation date, creator and creation context.
+ $cenv{'internal.created'}=$oldcenv{'internal.created'};
+ $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
+ $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
# Mark as cloned
$cenv{'clonedfrom'}=$cloneid;
# Need to clone grading mode
@@ -10205,7 +11136,7 @@ sub construct_course {
$title=&mt('Syllabus');
$url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
} else {
- $title=&mt('Navigate Contents');
+ $title=&mt('Table of Contents');
$url='/adm/navmaps';
}
@@ -10238,11 +11169,21 @@ sub group_term {
my $crstype = &course_type();
my %names = (
'Course' => 'group',
- 'Group' => 'team',
+ 'Community' => 'group',
);
return $names{$crstype};
}
+sub course_types {
+ my @types = ('official','unofficial','community');
+ my %typename = (
+ official => 'Official course',
+ unofficial => 'Unofficial course',
+ community => 'Community',
+ );
+ return (\@types,\%typename);
+}
+
sub icon {
my ($file)=@_;
my $curfext = lc((split(/\./,$file))[-1]);
@@ -10425,16 +11366,20 @@ sub init_user_environment {
$initial_env{"browser.interface"} = $form->{'interface'};
$env{'browser.interface'}=$form->{'interface'};
}
+ my %is_adv = ( is_adv => $env{'user.adv'} );
+ my %domdef = &Apache::lonnet::get_domain_defaults($domain);
foreach my $tool ('aboutme','blog','portfolio') {
$userenv{'availabletools.'.$tool} =
- &Apache::lonnet::usertools_access($username,$domain,$tool,'reload');
+ &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
+ undef,\%userenv,\%domdef,\%is_adv);
}
- foreach my $crstype ('official','unofficial') {
+ foreach my $crstype ('official','unofficial','community') {
$userenv{'canrequest.'.$crstype} =
&Apache::lonnet::usertools_access($username,$domain,$crstype,
- 'reload','requestcourses');
+ 'reload','requestcourses',
+ \%userenv,\%domdef,\%is_adv);
}
$env{'user.environment'} = "$lonids/$cookie.id";
@@ -10513,6 +11458,36 @@ sub clean_symb {
return ($symb,$enc);
}
+sub build_release_hashes {
+ my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
+ return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
+ (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
+ (ref($randomizetry) eq 'HASH'));
+ foreach my $key (keys(%Apache::lonnet::needsrelease)) {
+ my ($item,$name,$value) = split(/:/,$key);
+ if ($item eq 'parameter') {
+ if (ref($checkparms->{$name}) eq 'ARRAY') {
+ unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
+ push(@{$checkparms->{$name}},$value);
+ }
+ } else {
+ push(@{$checkparms->{$name}},$value);
+ }
+ } elsif ($item eq 'resourcetag') {
+ if ($name eq 'responsetype') {
+ $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
+ }
+ } elsif ($item eq 'course') {
+ if ($name eq 'crstype') {
+ $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
+ }
+ }
+ }
+ ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
+ ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
+ return;
+}
+
=pod
=back