--- loncom/interface/loncommon.pm 2008/06/09 22:34:55 1.660 +++ loncom/interface/loncommon.pm 2008/07/08 01:08:57 1.667 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.660 2008/06/09 22:34:55 raeburn Exp $ +# $Id: loncommon.pm,v 1.667 2008/07/08 01:08:57 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -878,7 +878,7 @@ sub help_open_topic { # Add the graphic my $title = &mt('Online Help'); - my $helpicon=&lonhttpdurl("/res/adm/pages/help.png"); + my $helpicon=&lonhttpdurl("/adm/help/help.png"); $template .= <<"ENDTEMPLATE"; (Help: $topic) ENDTEMPLATE @@ -4569,6 +4569,10 @@ td.LC_menubuttons_img { text-align: right; } +.LC_roleslog_note { + font-size: smaller; +} + table.LC_aboutme_port { border: 0px; border-collapse: collapse; @@ -7041,7 +7045,7 @@ sub ask_for_embedded_content {
'; $upload_output .= $state; - $upload_output .= 'Upload embedded files:
'.start_data_table(); + $upload_output .= 'Upload embedded files:
'.&start_data_table(); my $num = 0; foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%{$allfiles})) { @@ -7056,9 +7060,8 @@ sub ask_for_embedded_content { $upload_output.=''.&mt("Invalid characters").''; } else { - $upload_output .=' - + '; my $attrib = join(':',@{$$allfiles{$embed_file}}); $upload_output .= @@ -7083,6 +7086,186 @@ sub ask_for_embedded_content { return $upload_output; } +sub upload_embedded { + my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota, + $current_disk_usage) = @_; + my $output; + 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}); + 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 ''); + + # Check if file already exists as a file or directory. + my ($state,$msg); + if ($context eq 'portfolio') { + my $port_path = $dirpath; + if ($group ne '') { + $port_path = "groups/$group/$port_path"; + } + ($state,$msg) = &check_for_upload($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' ) { + $output .= $msg; + next; + } + } elsif (($context eq 'author') || ($context eq 'testbank')) { + ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i); + if ($state eq 'exists') { + $output .= $msg; + next; + } + } + # 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); + 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); + 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); + next; + } + + $env{'form.embedded_item_'.$i.'.filename'}=$fname; + if ($context eq 'portfolio') { + my $result= + &Apache::lonnet::userfileupload('embedded_item_'.$i,'', + $dirpath.$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.'').'

'; + } + } else { +# Save the file + my $target = $env{'form.embedded_item_'.$i}; + my $fullpath = $dir_root.$dirpath.'/'.$path; + my $dest = $fullpath.$fname; + my $url = $url_root.$dirpath.'/'.$path.$fname; + my @parts=split(/\//,$fullpath); + my $count; + my $filepath = $dir_root; + for ($count=4;$count<=$#parts;$count++) { + $filepath .= "/$parts[$count]"; + if ((-e $filepath)!=1) { + mkdir($filepath,0770); + } + } + my $fh; + if (!open($fh,'>'.$dest)) { + &Apache::lonnet::logthis('Failed to create '.$dest); + $output .= ''. + &mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}). + '
'; + } else { + if (!print $fh $env{'form.embedded_item_'.$i}) { + &Apache::lonnet::logthis('Failed to write to '.$dest); + $output .= ''. + &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.'').'
'; + } + } + close($fh); + } + } + } + return $output; +} + +sub check_for_existing { + my ($path,$fname,$element) = @_; + my ($state,$msg); + if (-d $path.'/'.$fname) { + $state = 'exists'; + $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].',''.$fname.'',$path); + } elsif (-e $path.'/'.$fname) { + $state = 'exists'; + $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].',''.$fname.'',$path); + } + if ($state eq 'exists') { + $msg = ''.$msg.'
'; + } + return ($state,$msg); +} + +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 $getpropath = 1; + my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname, + $getpropath); + my $found_file = 0; + my $locked_file = 0; + foreach my $line (@dir_list) { + my ($file_name)=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; + } + } + } + my $getpropath = 1; + if (($current_disk_usage + $filesize) > $disk_quota){ + my $msg = ''. + &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); + return ('will_exceed_quota',$msg); + } elsif ($found_file) { + if ($locked_file) { + 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 .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.',''.$fname.''); + 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 .= ''; + $msg .= '
'; + $msg .= &mt('To upload, rename or delete existing [_1] in [_2].',''.$fname.'', $port_path.$env{'form.currentpath'}); + return ('file_exists',$msg); + } + } +} + =pod @@ -7312,7 +7495,7 @@ Apache Request ref, $records is an array ###################################################### sub csv_print_samples { my ($r,$records) = @_; - my $samples = &get_samples($records,3); + my $samples = &get_samples($records,5); $r->print(&mt('Samples').'
'.&start_data_table(). &start_data_table_header_row()); @@ -7367,7 +7550,7 @@ sub csv_print_select_table { foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { $r->print(''); + '>'.&mt('Column [_1]',($sample+1)).''); } $r->print(''.&end_data_table_row()."\n"); $i++; @@ -7398,7 +7581,8 @@ sub csv_samples_select_table { my ($r,$records,$d) = @_; my $i=0; # - my $samples = &get_samples($records,3); + my $max_samples = 5; + my $samples = &get_samples($records,$max_samples); $r->print(&start_data_table(). &start_data_table_header_row().''. &mt('Field').''.&mt('Samples').''. @@ -7414,7 +7598,7 @@ sub csv_samples_select_table { $display.''); } $r->print(''); - foreach my $line (0..2) { + foreach my $line (0..($max_samples-1)) { if (defined($samples->[$line]{$key})) { $r->print($samples->[$line]{$key}."
\n"); } @@ -8092,11 +8276,15 @@ domain - to an array. Also generates ja generate Domain Coordinator interface for editing Course Categories. Inputs: + categories (reference to hash of category definitions). + cats (reference to array of arrays/hashes which encapsulates hierarchy of categories and subcategories). + idx (reference to hash of counters used in Domain Coordinator interface for editing Course Categories). + jsarray (reference to array of categories used to create Javascript arrays for Domain Coordinator interface for editing Course Categories). @@ -8139,17 +8327,26 @@ sub gather_categories { Used to generate breadcrumb trails for course categories. Inputs: + categories (reference to hash of category definitions). + cats (reference to array of arrays/hashes which encapsulates hierarchy of categories and subcategories). + trails (reference to array of breacrumb trails for each category). + allitems (reference to hash - key is category key (format: escaped(name):escaped(parent category):depth in hierarchy). + idx (reference to hash of counters used in Domain Coordinator interface for editing Course Categories). + jsarray (reference to array of categories used to create Javascript arrays for Domain Coordinator interface for editing Course Categories). +subcats (reference to hash of arrays containing all subcategories within each + category, -recursive) + Returns: nothing Side effects: populates trails and allitems hash references. @@ -8157,7 +8354,7 @@ Side effects: populates trails and allit =cut sub extract_categories { - my ($categories,$cats,$trails,$allitems,$idx,$jsarray) = @_; + my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_; if (ref($categories) eq 'HASH') { &gather_categories($categories,$cats,$idx,$jsarray); if (ref($cats->[0]) eq 'ARRAY') { @@ -8178,7 +8375,14 @@ sub extract_categories { if (ref($cats->[1]{$name}) eq 'ARRAY') { for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) { my $category = $cats->[1]{$name}[$j]; - &recurse_categories($cats,2,$category,$trails,$allitems,\@parents); + if (ref($subcats) eq 'HASH') { + push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1'); + } + &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats); + } + } else { + if (ref($subcats) eq 'HASH') { + $subcats->{$item} = []; } } } @@ -8194,13 +8398,19 @@ sub extract_categories { Recursively used to generate breadcrumb trails for course categories. Inputs: + cats (reference to array of arrays/hashes which encapsulates hierarchy of categories and subcategories). + depth (current depth in hierarchy of categories and sub-categories - 0 indexed). -category (current course category, for which breadcrumb trail is being generated). -trails (reference to array of breacrumb trails for each category). + +category (current course category, for which breadcrumb trail is being generated). + +trails (reference to array of breadcrumb trails for each category). + allitems (reference to hash - key is category key (format: escaped(name):escaped(parent category):depth in hierarchy). + parents (array containing containers directories for current category, back to top level). @@ -8208,12 +8418,10 @@ Returns: nothing Side effects: populates trails and allitems hash references -=back - =cut sub recurse_categories { - my ($cats,$depth,$category,$trails,$allitems,$parents) = @_; + my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_; my $shallower = $depth - 1; if (ref($cats->[$depth]{$category}) eq 'ARRAY') { for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) { @@ -8226,7 +8434,21 @@ sub recurse_categories { } my $deeper = $depth+1; push(@{$parents},$category); - &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents); + if (ref($subcats) eq 'HASH') { + my $subcat = &escape($name).':'.$category.':'.$depth; + for (my $j=@{$parents}; $j>=0; $j--) { + my $higher; + if ($j > 0) { + $higher = &escape($parents->[$j]).':'. + &escape($parents->[$j-1]).':'.$j; + } else { + $higher = &escape($parents->[$j]).'::'.$j; + } + push(@{$subcats->{$higher}},$subcat); + } + } + &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents, + $subcats); pop(@{$parents}); } } else { @@ -8240,17 +8462,144 @@ sub recurse_categories { return; } +=pod + +=item *&assign_categories_table() + +Create a datatable for display of hierarchical categories in a domain, +with checkboxes to allow a course to be categorized. + +Inputs: + +cathash - reference to hash of categories defined for the domain (from + configuration.db) + +currcat - scalar with an & separated list of categories assigned to a course. + +Returns: $output (markup to be displayed) + +=cut + +sub assign_categories_table { + my ($cathash,$currcat) = @_; + my $output; + if (ref($cathash) eq 'HASH') { + my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth); + &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray); + $maxdepth = scalar(@cats); + 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); + } + 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'); + my $item = &escape($parent).'::0'; + my $checked = ''; + if (@currcategories > 0) { + if (grep(/^\Q$item\E$/,@currcategories)) { + $checked = ' checked="checked" '; + } + } + $output .= '' + .''.&escape($parent).''; + my $depth = 1; + push(@path,$parent); + $output .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories); + pop(@path); + $output .= ''; + $itemcount ++; + } + $output .= &Apache::loncommon::end_data_table(); + } + } + } + return $output; +} + +=pod + +=item *&assign_category_rows() + +Create a datatable row for display of nested categories in a domain, +with checkboxes to allow a course to be categorized,called recursively. + +Inputs: + +itemcount - track row number for alternating colors + +cats - reference to array of arrays/hashes which encapsulates hierarchy of + categories and subcategories. + +depth - current depth in hierarchy of categories and sub-categories - 0 indexed. + +parent - parent of current category item + +path - Array containing all categories back up through the hierarchy from the + current category to the top level. + +currcategories - reference to array of current categories assigned to the course + +Returns: $output (markup to be displayed). + +=cut + +sub assign_category_rows { + my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_; + my ($text,$name,$item,$chgstr); + if (ref($cats) eq 'ARRAY') { + my $maxdepth = scalar(@{$cats}); + if (ref($cats->[$depth]) eq 'HASH') { + if (ref($cats->[$depth]{$parent}) eq 'ARRAY') { + my $numchildren = @{$cats->[$depth]{$parent}}; + my $css_class = $itemcount%2?' class="LC_odd_row"':''; + $text .= ''; + for (my $j=0; $j<$numchildren; $j++) { + $name = $cats->[$depth]{$parent}[$j]; + $item = &escape($name).':'.&escape($parent).':'.$depth; + my $deeper = $depth+1; + my $checked = ''; + if (ref($currcategories) eq 'ARRAY') { + if (@{$currcategories} > 0) { + if (grep(/^\Q$item\E$/,@{$currcategories})) { + $checked = ' checked="checked" '; + } + } + } + $text .= ''; + } + $text .= '
'; + if (ref($path) eq 'ARRAY') { + push(@{$path},$name); + $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories); + pop(@{$path}); + } + $text .= '
'; + } + } + } + return $text; +} + ############################################################ ############################################################ sub commit_customrole { - my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_; + my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_; my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url. ($start?', '.&mt('starting').' '.localtime($start):''). ($end?', ending '.localtime($end):'').': '. &Apache::lonnet::assigncustomrole( - $udom,$uname,$url,$three,$four,$five,$end,$start). + $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context). '
'; return $output; }