--- loncom/interface/loncommon.pm 2011/09/28 15:44:16 1.948.2.30
+++ loncom/interface/loncommon.pm 2012/01/09 19:56:28 1.1052
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.948.2.30 2011/09/28 15:44:16 raeburn Exp $
+# $Id: loncommon.pm,v 1.1052 2012/01/09 19:56:28 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -154,6 +154,8 @@ sub ssi_with_retries {
# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;
my %supported_language;
+my %latex_language; # For choosing hyphenation in
+my %latex_language_bykey; # for choosing hyphenation from metadata
my %cprtag;
my %scprtag;
my %fe; my %fd; my %fm;
@@ -186,11 +188,15 @@ BEGIN {
while (my $line = <$fh>) {
next if ($line=~/^\#/);
chomp($line);
- my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line));
+ my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
$language{$key}=$val.' - '.$enc;
if ($sup) {
$supported_language{$key}=$sup;
}
+ if ($latex) {
+ $latex_language_bykey{$key} = $latex;
+ $latex_language{$two} = $latex;
+ }
}
close($fh);
}
@@ -409,7 +415,7 @@ sub studentbrowser_javascript {
+ENDRESBRW
+}
+
sub selectstudent_link {
- my ($form,$unameele,$udomele,$courseadvonly)=@_;
- my $callargs = "'".$form."','".$unameele."','".$udomele."'";
+ my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
+ my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
+ &Apache::lonhtmlcommon::entity_encode($unameele)."','".
+ &Apache::lonhtmlcommon::entity_encode($udomele)."'";
if ($env{'request.course.id'}) {
if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
&& !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
'/'.$env{'request.course.sec'})) {
return '';
}
+ $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
if ($courseadvonly) {
$callargs .= ",'',1,1";
}
@@ -452,7 +481,7 @@ sub selectstudent_link {
&mt('Select User').'';
}
if ($env{'request.role'}=~/^(au|dc|su)/) {
- $callargs .= ",1";
+ $callargs .= ",'',1";
return ''.
''.
&mt('Select User').'';
@@ -460,6 +489,19 @@ sub selectstudent_link {
return '';
}
+sub selectresource_link {
+ my ($form,$reslink,$arg)=@_;
+
+ my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
+ &Apache::lonhtmlcommon::entity_encode($reslink)."'";
+ unless ($env{'request.course.id'}) { return $arg; }
+ return ''.
+ ''.
+ $arg.'';
+}
+
+
+
sub authorbrowser_javascript {
return <<"ENDAUTHORBRW";
+
+ENDJS
+
+}
+
sub userbrowser_javascript {
my $id_functions = &javascript_index_functions();
return <<"ENDUSERBRW";
@@ -766,6 +853,9 @@ sub selectcourse_link {
} elsif ($selecttype eq 'Course/Community') {
$linktext = &mt('Select Course/Community');
$type = '';
+ } elsif ($selecttype eq 'Select') {
+ $linktext = &mt('Select');
+ $type = '';
}
return ''
."'
.'';
- if ($text ne "") {
+ if ($text ne "") {
$template.='';
}
return $template;
@@ -1142,27 +1238,22 @@ sub help_open_topic {
# This is a quicky function for Latex cheatsheet editing, since it
# appears in at least four places
sub helpLatexCheatsheet {
- my ($topic,$text,$not_author) = @_;
+ my ($topic,$text,$not_author,$stayOnPage) = @_;
my $out;
my $addOther = '';
if ($topic) {
- $addOther = ''.&Apache::loncommon::help_open_topic($topic,&mt($text),
- undef, undef, 600).
- ' ';
+ $addOther = ''.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).' ';
}
$out = '' # Start cheatsheet
.$addOther
.''
- .&Apache::loncommon::help_open_topic('Greek_Symbols',&mt('Greek Symbols'),
- undef,undef,600)
+ .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
.' '
- .&Apache::loncommon::help_open_topic('Other_Symbols',&mt('Other Symbols'),
- undef,undef,600)
+ .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
.'';
unless ($not_author) {
$out .= ' '
- .&Apache::loncommon::help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),
- undef,undef,600)
+ .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
.'';
}
$out .= ''; # End cheatsheet
@@ -1205,12 +1296,7 @@ ENDOUTPUT
sub help_open_menu {
my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
= @_;
- $stayOnPage = 0 if (not defined $stayOnPage);
- # only use pop-up help (stayOnPage == 0)
- # if environment.remote is on (using remote control UI)
- if ($env{'environment.remote'} eq 'off' ) {
- $stayOnPage=1;
- }
+ $stayOnPage = 1;
my $output;
if ($component_help) {
if (!$text) {
@@ -1231,8 +1317,8 @@ sub help_open_menu {
sub top_nav_help {
my ($text) = @_;
$text = &mt($text);
- my $stay_on_page =
- ($env{'environment.remote'} eq 'off' );
+ my $stay_on_page = 1;
+
my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
: "javascript:helpMenu('open')";
my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
@@ -1247,10 +1333,7 @@ END
sub help_menu_js {
my ($text) = @_;
-
- my $stayOnPage =
- ($env{'environment.remote'} eq 'off' );
-
+ my $stayOnPage = 1;
my $width = 620;
my $height = 600;
my $helptopic=&general_help();
@@ -1307,10 +1390,7 @@ sub help_open_bug {
unless ($env{'user.adv'}) { return ''; }
unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
$text = "" if (not defined $text);
- $stayOnPage = 0 if (not defined $stayOnPage);
- if ($env{'environment.remote'} eq 'off' ) {
$stayOnPage=1;
- }
$width = 600 if (not defined $width);
$height = 600 if (not defined $height);
@@ -1351,10 +1431,7 @@ sub help_open_faq {
unless ($env{'user.adv'}) { return ''; }
unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
$text = "" if (not defined $text);
- $stayOnPage = 0 if (not defined $stayOnPage);
- if ($env{'environment.remote'} eq 'off' ) {
$stayOnPage=1;
- }
$width = 350 if (not defined $width);
$height = 400 if (not defined $height);
@@ -1732,7 +1809,7 @@ sub create_workbook {
return (undef);
}
#
- $workbook->set_tempdir('/home/httpd/perl/tmp');
+ $workbook->set_tempdir(LONCAPA::tempdir());
#
my $format = &Apache::loncommon::define_excel_formats($workbook);
return ($workbook,$filename,$format);
@@ -1870,7 +1947,7 @@ sub multiple_select_form {
Returns a string containing a
+ENDPROGBAR
+ &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
+}
+
+sub LCprogressbarUpdate {
+ my ($r,$val,$text)=@_;
+ unless ($val) {
+ if ($LClastpercent) {
+ $val=$LClastpercent;
+ } else {
+ $val=0;
+ }
+ }
+ if ($val<0) { $val=0; }
+ if ($val>100) { $val=0; }
+ $LClastpercent=$val;
+ unless ($text) { $text=$val.'%'; }
+ $text=&js_ready($text);
+ &r_print($r,<
+//
+
+ENDUPDATE
+}
+
+sub LCprogressbarClose {
+ my ($r)=@_;
+ $LClastpercent=0;
+ &r_print($r,<
+//
+
+ENDCLOSE
+}
+
+sub r_print {
+ my ($r,$to_print)=@_;
+ if ($r) {
+ $r->print($to_print);
+ $r->rflush();
+ } else {
+ print($to_print);
+ }
+}
+
sub html_encode {
my ($result) = @_;
@@ -6996,6 +7311,7 @@ sub html_encode {
return $result;
}
+
sub js_ready {
my ($result) = @_;
@@ -7032,6 +7348,24 @@ sub validate_page {
}
}
+
+sub start_scrollbox {
+ my ($outerwidth,$width,$height,$id)=@_;
+ unless ($outerwidth) { $outerwidth='520px'; }
+ unless ($width) { $width='500px'; }
+ unless ($height) { $height='200px'; }
+ my ($table_id,$div_id);
+ if ($id ne '') {
+ $table_id = " id='table_$id'";
+ $div_id = " id='div_$id'";
+ }
+ return "";
+}
+
+sub end_scrollbox {
+ return ' |
';
+}
+
sub simple_error_page {
my ($r,$title,$msg) = @_;
my $page =
@@ -7059,30 +7393,36 @@ sub simple_error_page {
}
sub start_data_table {
- my ($add_class) = @_;
+ my ($add_class,$id) = @_;
my $css_class = (join(' ','LC_data_table',$add_class));
- &start_data_table_count();
- return ''."\n";
+ my $table_id;
+ if (defined($id)) {
+ $table_id = ' id="'.$id.'"';
+ }
+ &start_data_table_count();
+ return ''."\n";
}
sub end_data_table {
- &end_data_table_count();
+ &end_data_table_count();
return '
'."\n";;
}
sub start_data_table_row {
- my ($add_class) = @_;
+ my ($add_class, $id) = @_;
$row_count[0]++;
my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
- return ''."\n";;
+ $id = (' id="'.$id.'"') unless ($id eq '');
+ return '
'."\n";
}
sub continue_data_table_row {
- my ($add_class) = @_;
+ my ($add_class, $id) = @_;
my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
- $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');;
- return '
'."\n";;
+ $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
+ $id = (' id="'.$id.'"') unless ($id eq '');
+ return '
'."\n";
}
sub end_data_table_row {
@@ -7187,7 +7527,7 @@ sub get_users_function {
$function='admin';
}
if (($env{'request.role'}=~/^(au|ca|aa)/) ||
- ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
+ ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
$function='author';
}
return $function;
@@ -7922,7 +8262,7 @@ sub user_picker {
my ($newuserscript,$new_user_create);
my $context_dom = $env{'request.role.domain'};
if ($context eq 'requestcrs') {
- if ($env{'form.coursedom'} ne '') {
+ if ($env{'form.coursedom'} ne '') {
$context_dom = $env{'form.coursedom'};
}
}
@@ -8302,7 +8642,8 @@ sub get_standard_codeitems {
=item * sorted_slots()
-Sorts an array of slot names in order of slot start time (earliest first).
+Sorts an array of slot names in order of an optional sort key,
+default sort is by slot start time (earliest first).
Inputs:
@@ -8312,15 +8653,16 @@ slotsarr - Reference to array of unsort
slots - Reference to hash of hash, where outer hash keys are slot names.
+sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
+
=back
Returns:
=over 4
-sorted - An array of slot names sorted by the start time of the slot.
-
-=back
+sorted - An array of slot names sorted by a specified sort key
+ (default sort key is start time of the slot).
=back
@@ -8328,13 +8670,16 @@ sorted - An array of slot names sorted
sub sorted_slots {
- my ($slotsarr,$slots) = @_;
+ my ($slotsarr,$slots,$sortkey) = @_;
+ if ($sortkey eq '') {
+ $sortkey = 'starttime';
+ }
my @sorted;
if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
@sorted =
sort {
if (ref($slots->{$a}) && ref($slots->{$b})) {
- return $slots->{$a}{'starttime'} <=> $slots->{$b}{'starttime'}
+ return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
}
if (ref($slots->{$a})) { return -1;}
if (ref($slots->{$b})) { return 1;}
@@ -8344,6 +8689,131 @@ sub sorted_slots {
return @sorted;
}
+=pod
+
+=item * get_future_slots()
+
+Inputs:
+
+=over 4
+
+cnum - course number
+
+cdom - course domain
+
+now - current UNIX time
+
+symb - optional symb
+
+=back
+
+Returns:
+
+=over 4
+
+sorted_reservable - ref to array of student_schedulable slots currently
+ reservable, ordered by end date of reservation period.
+
+reservable_now - ref to hash of student_schedulable slots currently
+ reservable.
+
+ Keys in inner hash are:
+ (a) symb: either blank or symb to which slot use is restricted.
+ (b) endreserve: end date of reservation period.
+
+sorted_future - ref to array of student_schedulable slots reservable in
+ the future, ordered by start date of reservation period.
+
+future_reservable - ref to hash of student_schedulable slots reservable
+ in the future.
+
+ Keys in inner hash are:
+ (a) symb: either blank or symb to which slot use is restricted.
+ (b) startreserve: start date of reservation period.
+
+=back
+
+=cut
+
+sub get_future_slots {
+ my ($cnum,$cdom,$now,$symb) = @_;
+ my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
+ my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
+ foreach my $slot (keys(%slots)) {
+ next unless($slots{$slot}->{'type'} eq 'schedulable_student');
+ if ($symb) {
+ next if (($slots{$slot}->{'symb'} ne '') &&
+ ($slots{$slot}->{'symb'} ne $symb));
+ }
+ if (($slots{$slot}->{'starttime'} > $now) &&
+ ($slots{$slot}->{'endtime'} > $now)) {
+ if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
+ my $userallowed = 0;
+ if ($slots{$slot}->{'allowedsections'}) {
+ my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
+ if (!defined($env{'request.role.sec'})
+ && grep(/^No section assigned$/,@allowed_sec)) {
+ $userallowed=1;
+ } else {
+ if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
+ $userallowed=1;
+ }
+ }
+ unless ($userallowed) {
+ if (defined($env{'request.course.groups'})) {
+ my @groups = split(/:/,$env{'request.course.groups'});
+ foreach my $group (@groups) {
+ if (grep(/^\Q$group\E$/,@allowed_sec)) {
+ $userallowed=1;
+ last;
+ }
+ }
+ }
+ }
+ }
+ if ($slots{$slot}->{'allowedusers'}) {
+ my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
+ my $user = $env{'user.name'}.':'.$env{'user.domain'};
+ if (grep(/^\Q$user\E$/,@allowed_users)) {
+ $userallowed = 1;
+ }
+ }
+ next unless($userallowed);
+ }
+ my $startreserve = $slots{$slot}->{'startreserve'};
+ my $endreserve = $slots{$slot}->{'endreserve'};
+ my $symb = $slots{$slot}->{'symb'};
+ if (($startreserve < $now) &&
+ (!$endreserve || $endreserve > $now)) {
+ my $lastres = $endreserve;
+ if (!$lastres) {
+ $lastres = $slots{$slot}->{'starttime'};
+ }
+ $reservable_now{$slot} = {
+ symb => $symb,
+ endreserve => $lastres
+ };
+ } elsif (($startreserve > $now) &&
+ (!$endreserve || $endreserve > $startreserve)) {
+ $future_reservable{$slot} = {
+ symb => $symb,
+ startreserve => $startreserve
+ };
+ }
+ }
+ }
+ my @unsorted_reservable = keys(%reservable_now);
+ if (@unsorted_reservable > 0) {
+ @sorted_reservable =
+ &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
+ }
+ my @unsorted_future = keys(%future_reservable);
+ if (@unsorted_future > 0) {
+ @sorted_future =
+ &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
+ }
+ return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
+}
=pod
@@ -8510,9 +8980,9 @@ sub ask_for_embedded_content {
$url .= $current_path;
$getpropath = 1;
} elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
- ($actionurl eq '/adm/imsimport')) {
- ($uname,my $rest) = ($args->{'current_path'} =~ m{/priv/($match_username)/?(.*)$});
- $url = '/home/'.$uname.'/public_html/';
+ ($actionurl eq '/adm/imsimport')) {
+ my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
+ $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
$toplevel = $url;
if ($rest ne '') {
$url .= $rest;
@@ -8561,11 +9031,14 @@ sub ask_for_embedded_content {
}
foreach my $path (keys(%subdependencies)) {
my %currsubfile;
- if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
- my @subdir_list = &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
- foreach my $line (@subdir_list) {
- my ($file_name,$rest) = split(/\&/,$line,2);
- $currsubfile{$file_name} = 1;
+ if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
+ my ($sublistref,$listerror) =
+ &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
+ if (ref($sublistref) eq 'ARRAY') {
+ foreach my $line (@{$sublistref}) {
+ my ($file_name,$rest) = split(/\&/,$line,2);
+ $currsubfile{$file_name} = 1;
+ }
}
} elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
if (opendir(my $dir,$url.'/'.$path)) {
@@ -8588,10 +9061,13 @@ sub ask_for_embedded_content {
}
my %currfile;
if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
- my @dir_list = &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
- foreach my $line (@dir_list) {
- my ($file_name,$rest) = split(/\&/,$line,2);
- $currfile{$file_name} = 1;
+ my ($dirlistref,$listerror) =
+ &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
+ if (ref($dirlistref) eq 'ARRAY') {
+ foreach my $line (@{$dirlistref}) {
+ my ($file_name,$rest) = split(/\&/,$line,2);
+ $currfile{$file_name} = 1;
+ }
}
} elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
if (opendir(my $dir,$url)) {
@@ -8669,7 +9145,7 @@ sub ask_for_embedded_content {
} elsif ($applies) {
$output = ''.&mt('Referenced files').':
';
if ($applies > 1) {
- $output .=
+ $output .=
&mt('No files need to be uploaded, as one of the following applies to each reference:').'';
if ($numremref) {
$output .= '- '.&mt('reference is to a URL which points to another server').'
'."\n";
@@ -8699,7 +9175,7 @@ sub ask_for_embedded_content {
$embed_file,\%mapping,
$allfiles,$codebase);
} else {
- $pathchange_output .=
+ $pathchange_output .=
&start_data_table_row().
' | '.
@@ -8718,7 +9194,7 @@ sub ask_for_embedded_content {
$output .= ''."\n";
}
- if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
+ if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
($actionurl eq '/adm/imsimport')) {
$output .= ''."\n";
} elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
@@ -8730,8 +9206,8 @@ sub ask_for_embedded_content {
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').'
';
- }
+ $output .= ''.&mt('or').'
';
+ }
}
return ($output,$num,$numpathchg);
}
@@ -8746,7 +9222,7 @@ sub embedded_file_element {
}
$output .= '';
- unless (($context eq 'upload_embedded') &&
+ unless (($context eq 'upload_embedded') &&
($mapping->{$embed_file} eq $embed_file)) {
$output .='
';
@@ -8847,7 +9323,7 @@ sub upload_embedded {
next;
} else {
$output .= &mt('Uploaded [_1]',''.
- $path.$fname.'').'
';
+ $path.$fname.'').'
';
}
}
} elsif ($context eq 'coursedoc') {
@@ -8870,12 +9346,12 @@ sub upload_embedded {
my $fullpath = $dir_root.$dirpath.'/'.$path;
my $dest = $fullpath.$fname;
my $url = $url_root.$dirpath.'/'.$path.$fname;
- my @parts=split(/\//,$fullpath);
+ my @parts=split(/\//,"$dirpath/$path");
my $count;
my $filepath = $dir_root;
- for ($count=4;$count<=$#parts;$count++) {
- $filepath .= "/$parts[$count]";
- if ((-e $filepath)!=1) {
+ foreach my $subdir (@parts) {
+ $filepath .= "/$subdir";
+ if (!-e $filepath) {
mkdir($filepath,0770);
}
}
@@ -8954,7 +9430,7 @@ sub modify_html_form {
''.
&end_data_table_row();
- }
+ }
}
} else {
$modifyform = $pathchgtable;
@@ -8994,8 +9470,7 @@ sub modify_html_refs {
} elsif ($context eq 'coursedoc') {
$container = $env{'form.primaryurl'};
} else {
- $container = $env{'form.filename'};
- $container =~ s{^/priv/(\Q$uname\E)/(.*)}{/home/$1/public_html/$2};
+ $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
}
my (%allfiles,%codebase,$output,$content);
my @changes = &get_env_multiple('form.namechange');
@@ -9005,7 +9480,7 @@ sub modify_html_refs {
$content = &Apache::lonnet::getfile($container);
return if ($content eq '-1');
} else {
- return unless ($container =~ /^\Q$dir_root\E/);
+ return unless ($container =~ /^\Q$dir_root\E/);
if (open(my $fh,"<$container")) {
$content = join('', <$fh>);
close($fh);
@@ -9017,7 +9492,7 @@ sub modify_html_refs {
my $mm = new File::MMagic;
my $mime_type = $mm->checktype_contents($content);
if ($mime_type eq 'text/html') {
- my $parse_result =
+ my $parse_result =
&Apache::lonnet::extract_embedded_items($container,\%allfiles,
\%codebase,\$content);
if ($parse_result eq 'ok') {
@@ -9050,7 +9525,7 @@ sub modify_html_refs {
my ($fname) = ($container =~ m{/([^/]+)$});
$output = ''.&mt('Updated [quant,_1,reference] in [_2].',
$count,''.
- $fname.'').'
';
+ $fname.'').'';
} else {
$output = ''.
&mt('Error: update failed for: [_1].',
@@ -9102,7 +9577,7 @@ sub check_for_upload {
my $filesize = length($env{'form.'.$element});
if (!$filesize) {
my $msg = ''.
- &mt('Unable to upload [_1]. (size = [_2] bytes)',
+ &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.').'
'.
@@ -9111,8 +9586,8 @@ sub check_for_upload {
}
$filesize = $filesize/1000; #express in k (1024?)
my $getpropath = 1;
- my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,
- $getpropath);
+ my ($dirlistref,$listerror) =
+ &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
my $found_file = 0;
my $locked_file = 0;
my @lockers;
@@ -9120,48 +9595,50 @@ sub check_for_upload {
if ($env{'request.course.id'}) {
$navmap = Apache::lonnavmaps::navmap->new();
}
- foreach my $line (@dir_list) {
- 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,\@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;
+ if (ref($dirlistref) eq 'ARRAY') {
+ foreach my $line (@{$dirlistref}) {
+ 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,\@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 {
- $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);
+ }
+ } 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);
+ }
}
}
}
@@ -9233,6 +9710,113 @@ sub check_for_traversal {
=pod
+=item * &get_turnedin_filepath()
+
+Determines path in a user's portfolio file for storage of files uploaded
+to a specific essayresponse or dropbox item.
+
+Inputs: 3 required + 1 optional.
+$symb is symb for resource, $uname and $udom are for current user (required).
+$caller is optional (can be "submission", if routine is called when storing
+an upoaded file when "Submit Answer" button was pressed).
+
+Returns array containing $path and $multiresp.
+$path is path in portfolio. $multiresp is 1 if this resource contains more
+than one file upload item. Callers of routine should append partid as a
+subdirectory to $path in cases where $multiresp is 1.
+
+Called by: homework/essayresponse.pm and homework/structuretags.pm
+
+=cut
+
+sub get_turnedin_filepath {
+ my ($symb,$uname,$udom,$caller) = @_;
+ my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
+ my $turnindir;
+ my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
+ $turnindir = $userhash{'turnindir'};
+ my ($path,$multiresp);
+ if ($turnindir eq '') {
+ if ($caller eq 'submission') {
+ $turnindir = &mt('turned in');
+ $turnindir =~ s/\W+/_/g;
+ my %newhash = (
+ 'turnindir' => $turnindir,
+ );
+ &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
+ }
+ }
+ if ($turnindir ne '') {
+ $path = '/'.$turnindir.'/';
+ my ($multipart,$turnin,@pathitems);
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ if (defined($navmap)) {
+ my $mapres = $navmap->getResourceByUrl($map);
+ if (ref($mapres)) {
+ my $pcslist = $mapres->map_hierarchy();
+ if ($pcslist ne '') {
+ foreach my $pc (split(/,/,$pcslist)) {
+ my $res = $navmap->getByMapPc($pc);
+ if (ref($res)) {
+ my $title = $res->compTitle();
+ $title =~ s/\W+/_/g;
+ if ($title ne '') {
+ push(@pathitems,$title);
+ }
+ }
+ }
+ }
+ my $maptitle = $mapres->compTitle();
+ $maptitle =~ s/\W+/_/g;
+ if ($maptitle ne '') {
+ push(@pathitems,$maptitle);
+ }
+ unless ($env{'request.state'} eq 'construct') {
+ my $res = $navmap->getBySymb($symb);
+ if (ref($res)) {
+ my $partlist = $res->parts();
+ my $totaluploads = 0;
+ if (ref($partlist) eq 'ARRAY') {
+ foreach my $part (@{$partlist}) {
+ my @types = $res->responseType($part);
+ my @ids = $res->responseIds($part);
+ for (my $i=0; $i < scalar(@ids); $i++) {
+ if ($types[$i] eq 'essay') {
+ my $partid = $part.'_'.$ids[$i];
+ if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
+ $totaluploads ++;
+ }
+ }
+ }
+ }
+ if ($totaluploads > 1) {
+ $multiresp = 1;
+ }
+ }
+ }
+ }
+ } else {
+ return;
+ }
+ } else {
+ return;
+ }
+ my $restitle=&Apache::lonnet::gettitle($symb);
+ $restitle =~ s/\W+/_/g;
+ if ($restitle eq '') {
+ $restitle = ($resurl =~ m{/[^/]+$});
+ if ($restitle eq '') {
+ $restitle = time;
+ }
+ }
+ push(@pathitems,$restitle);
+ $path .= join('/',@pathitems);
+ }
+ return ($path,$multiresp);
+}
+
+=pod
+
=back
=head1 CSV Upload/Handling functions
@@ -11152,6 +11736,8 @@ sub construct_course {
############################################################
############################################################
+#SD
+# only Community and Course, or anything else?
sub course_type {
my ($cid) = @_;
if (!defined($cid)) {
@@ -11317,15 +11903,12 @@ sub init_user_environment {
my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
my ($tmp) = keys(%userenv);
if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
- # default remote control to off
- if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
} else {
undef(%userenv);
}
if (($userenv{'interface'}) && (!$form->{'interface'})) {
$form->{'interface'}=$userenv{'interface'};
}
- $env{'environment.remote'}=$userenv{'remote'};
if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
# --------------- Do not trust query string to be put directly into environment
@@ -11357,16 +11940,17 @@ sub init_user_environment {
$initial_env{"browser.localres"} = $form->{'localres'};
}
- if ($public) {
- $initial_env{"environment.remote"} = "off";
- }
if ($form->{'interface'}) {
$form->{'interface'}=~s/\W//gs;
$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);
+ my %domdef;
+ unless ($domain eq 'public') {
+ %domdef = &Apache::lonnet::get_domain_defaults($domain);
+ }
foreach my $tool ('aboutme','blog','portfolio') {
$userenv{'availabletools.'.$tool} =