".
+ "$text";
}
# Add the graphic
my $title = &mt('Online Help');
- my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");
+ my $helpicon=&lonhttpdurl("/adm/help/help.png");
$template .= <<"ENDTEMPLATE";
ENDTEMPLATE
@@ -764,11 +952,14 @@ sub helpLatexCheatsheet {
}
return '| '.
$addOther .
- &Apache::loncommon::help_open_topic("Greek_Symbols",'Greek Symbols',
+ &Apache::loncommon::help_open_topic("Greek_Symbols",&mt('Greek Symbols'),
undef,undef,600)
.' | '.
- &Apache::loncommon::help_open_topic("Other_Symbols",'Other Symbols',
+ &Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'),
undef,undef,600)
+ .' | '.
+ &Apache::loncommon::help_open_topic("Authoring_Output_Tags",&mt('Output Tags'),
+ undef,undef,600)
.' |
';
}
@@ -778,6 +969,8 @@ sub general_help {
$helptopic='Authoring_Intro';
} elsif ($env{'request.role'}=~/^cc/) {
$helptopic='Course_Coordination_Intro';
+ } elsif ($env{'request.role'}=~/^dc/) {
+ $helptopic='Domain_Coordination_Intro';
}
return $helptopic;
}
@@ -805,14 +998,10 @@ sub help_open_menu {
my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
= @_;
$stayOnPage = 0 if (not defined $stayOnPage);
- # formerly only used pop-up help (stayOnPage = 0)
+ # only use pop-up help (stayOnPage == 0)
# if environment.remote is on (using remote control UI)
- # if ($env{'browser.interface'} eq 'textual' ||
- # $env{'environment.remote'} eq 'off' ) {
- # $stayOnPage=1;
- #}
- # Now making pop-up help the default even with remote control
- if ($env{'browser.interface'} eq 'textual') {
+ if ($env{'browser.interface'} eq 'textual' ||
+ $env{'environment.remote'} eq 'off' ) {
$stayOnPage=1;
}
my $output;
@@ -834,15 +1023,13 @@ sub help_open_menu {
sub top_nav_help {
my ($text) = @_;
-
$text = &mt($text);
-
- my $stayOnPage =
+ my $stay_on_page =
($env{'browser.interface'} eq 'textual' ||
$env{'environment.remote'} eq 'off' );
- my $link= ($stayOnPage) ? "javascript:helpMenu('display')"
+ my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
: "javascript:helpMenu('open')";
- my $banner_link = &update_help_link(undef,undef,undef,undef,$stayOnPage);
+ my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
my $title = &mt('Get help');
@@ -870,7 +1057,7 @@ sub help_menu_js {
'js_ready' => 1,
'add_entries' => {
'border' => '0',
- 'rows' => "105,*",},});
+ 'rows' => "110,*",},});
my $end_page =
&Apache::loncommon::end_page({'frameset' => 1,
'js_ready' => 1,});
@@ -941,7 +1128,7 @@ sub help_open_bug {
{
$template .=
"".
- "| $text";
+ " | $text";
}
# Add the graphic
@@ -986,7 +1173,7 @@ sub help_open_faq {
{
$template .=
"".
- "| $text";
+ " | $text";
}
# Add the graphic
@@ -1005,7 +1192,7 @@ ENDTEMPLATE
=pod
-=item * change_content_javascript():
+=item * &change_content_javascript():
This and the next function allow you to create small sections of an
otherwise static HTML page that you can update on the fly with
@@ -1060,7 +1247,7 @@ DOMBASED
=pod
-=item * changable_area($name, $origContent):
+=item * &changable_area($name,$origContent):
This provides a "changable area" that can be modified on the fly via
the Javascript code provided in C. $name is
@@ -1084,8 +1271,139 @@ sub changable_area {
=pod
+=item * &viewport_geometry_js
+
+Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
+
+=cut
+
+
+sub viewport_geometry_js {
+ return <<"GEOMETRY";
+var Geometry = {};
+function init_geometry() {
+ if (Geometry.init) { return };
+ Geometry.init=1;
+ if (window.innerHeight) {
+ Geometry.getViewportHeight = function() { return window.innerHeight; };
+ Geometry.getViewportWidth = function() { return window.innerWidth; };
+ Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
+ Geometry.getVerticalScroll = function() { return window.pageYOffset; };
+ }
+ else if (document.documentElement && document.documentElement.clientHeight) {
+ Geometry.getViewportHeight =
+ function() { return document.documentElement.clientHeight; };
+ Geometry.getViewportWidth =
+ function() { return document.documentElement.clientWidth; };
+
+ Geometry.getHorizontalScroll =
+ function() { return document.documentElement.scrollLeft; };
+ Geometry.getVerticalScroll =
+ function() { return document.documentElement.scrollTop; };
+ }
+ else if (document.body.clientHeight) {
+ Geometry.getViewportHeight =
+ function() { return document.body.clientHeight; };
+ Geometry.getViewportWidth =
+ function() { return document.body.clientWidth; };
+ Geometry.getHorizontalScroll =
+ function() { return document.body.scrollLeft; };
+ Geometry.getVerticalScroll =
+ function() { return document.body.scrollTop; };
+ }
+}
+
+GEOMETRY
+}
+
+=pod
+
+=item * &viewport_size_js()
+
+Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window.
+
+=cut
+
+sub viewport_size_js {
+ my $geometry = &viewport_geometry_js();
+ return <<"DIMS";
+
+$geometry
+
+function getViewportDims(width,height) {
+ init_geometry();
+ width.value = Geometry.getViewportWidth();
+ height.value = Geometry.getViewportHeight();
+ return;
+}
+
+DIMS
+}
+
+=pod
+
+=item * &resize_textarea_js()
+
+emits the needed javascript to resize a textarea to be as big as possible
+
+creates a function resize_textrea that takes two IDs first should be
+the id of the element to resize, second should be the id of a div that
+surrounds everything that comes after the textarea, this routine needs
+to be attached to the for the onload and onresize events.
+
=back
-
+
+=cut
+
+sub resize_textarea_js {
+ my $geometry = &viewport_geometry_js();
+ return <<"RESIZE";
+
+RESIZE
+
+}
+
+=pod
+
=head1 Excel and CSV file utility routines
=over 4
@@ -1097,7 +1415,7 @@ sub changable_area {
=pod
-=item * csv_translate($text)
+=item * &csv_translate($text)
Translate $text to allow it to be output as a 'comma separated values'
format.
@@ -1118,7 +1436,7 @@ sub csv_translate {
=pod
-=item * define_excel_formats
+=item * &define_excel_formats()
Define some commonly used Excel cell formats.
@@ -1174,7 +1492,7 @@ sub define_excel_formats {
=pod
-=item * create_workbook
+=item * &create_workbook()
Create an Excel worksheet. If it fails, output message on the
request object and return undefs.
@@ -1217,7 +1535,7 @@ sub create_workbook {
=pod
-=item * create_text_file
+=item * &create_text_file()
Create a file to write to and eventually make available to the user.
If file creation fails, outputs an error message on the request object and
@@ -1242,9 +1560,9 @@ sub create_text_file {
$fh = Apache::File->new('>/home/httpd'.$filename);
if (! defined($fh)) {
$r->log_error("Couldn't open $filename for output $!");
- $r->print("Problems occured in creating the output file. ".
- "This error has been logged. ".
- "Please alert your LON-CAPA administrator.");
+ $r->print(&mt('Problems occurred in creating the output file. '
+ .'This error has been logged. '
+ .'Please alert your LON-CAPA administrator.'));
}
return ($fh,$filename)
}
@@ -1285,9 +1603,7 @@ sub domain_select {
=over 4
-=cut
-
-=item * multiple_select_form($name,$value,$size,$hash,$order)
+=item * &multiple_select_form($name,$value,$size,$hash,$order)
Returns a string containing a |
END_BLOCK
@@ -5737,7 +7170,224 @@ END_BLOCK
return $output;
}
+sub user_rule_check {
+ my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
+ my $response;
+ if (ref($usershash) eq 'HASH') {
+ foreach my $user (keys(%{$usershash})) {
+ my ($uname,$udom) = split(/:/,$user);
+ next if ($udom eq '' || $uname eq '');
+ my ($id,$newuser);
+ if (ref($usershash->{$user}) eq 'HASH') {
+ $newuser = $usershash->{$user}->{'newuser'};
+ $id = $usershash->{$user}->{'id'};
+ }
+ my $inst_response;
+ if (ref($checks) eq 'HASH') {
+ if (defined($checks->{'username'})) {
+ ($inst_response,%{$inst_results->{$user}}) =
+ &Apache::lonnet::get_instuser($udom,$uname);
+ } elsif (defined($checks->{'id'})) {
+ ($inst_response,%{$inst_results->{$user}}) =
+ &Apache::lonnet::get_instuser($udom,undef,$id);
+ }
+ } else {
+ ($inst_response,%{$inst_results->{$user}}) =
+ &Apache::lonnet::get_instuser($udom,$uname);
+ return;
+ }
+ if (!$got_rules->{$udom}) {
+ my %domconfig = &Apache::lonnet::get_dom('configuration',
+ ['usercreation'],$udom);
+ if (ref($domconfig{'usercreation'}) eq 'HASH') {
+ foreach my $item ('username','id') {
+ if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
+ $$curr_rules{$udom}{$item} =
+ $domconfig{'usercreation'}{$item.'_rule'};
+ }
+ }
+ }
+ $got_rules->{$udom} = 1;
+ }
+ foreach my $item (keys(%{$checks})) {
+ if (ref($$curr_rules{$udom}) eq 'HASH') {
+ if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
+ if (@{$$curr_rules{$udom}{$item}} > 0) {
+ my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
+ foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
+ if ($rule_check{$rule}) {
+ $$rulematch{$user}{$item} = $rule;
+ if ($inst_response eq 'ok') {
+ if (ref($inst_results) eq 'HASH') {
+ if (ref($inst_results->{$user}) eq 'HASH') {
+ if (keys(%{$inst_results->{$user}}) == 0) {
+ $$alerts{$item}{$udom}{$uname} = 1;
+ }
+ }
+ }
+ }
+ last;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return;
+}
+
+sub user_rule_formats {
+ my ($domain,$domdesc,$curr_rules,$check) = @_;
+ my %text = (
+ 'username' => 'Usernames',
+ 'id' => 'IDs',
+ );
+ my $output;
+ my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
+ if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
+ if (@{$ruleorder} > 0) {
+ $output = '
'.&mt("$text{$check} with the following format(s) may only be used for verified users at [_1]:",$domdesc).' ';
+ foreach my $rule (@{$ruleorder}) {
+ if (ref($curr_rules) eq 'ARRAY') {
+ if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
+ if (ref($rules->{$rule}) eq 'HASH') {
+ $output .= '- '.$rules->{$rule}{'name'}.': '.
+ $rules->{$rule}{'desc'}.'
';
+ }
+ }
+ }
+ }
+ $output .= ' ';
+ }
+ }
+ return $output;
+}
+
+sub instrule_disallow_msg {
+ my ($checkitem,$domdesc,$count,$mode) = @_;
+ my $response;
+ my %text = (
+ item => 'username',
+ items => 'usernames',
+ match => 'matches',
+ do => 'does',
+ action => 'a username',
+ one => 'one',
+ );
+ if ($count > 1) {
+ $text{'item'} = 'usernames';
+ $text{'match'} ='match';
+ $text{'do'} = 'do';
+ $text{'action'} = 'usernames',
+ $text{'one'} = 'ones';
+ }
+ if ($checkitem eq 'id') {
+ $text{'items'} = 'IDs';
+ $text{'item'} = 'ID';
+ $text{'action'} = 'an ID';
+ if ($count > 1) {
+ $text{'item'} = 'IDs';
+ $text{'action'} = 'IDs';
+ }
+ }
+ $response = &mt("The $text{'item'} you chose $text{'match'} the format of $text{'items'} defined for [_1], but the $text{'item'} $text{'do'} not exist in the institutional directory.",''.$domdesc.'').'
';
+ if ($mode eq 'upload') {
+ if ($checkitem eq 'username') {
+ $response .= &mt("You will need to modify your upload file so it will include $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
+ } elsif ($checkitem eq 'id') {
+ $response .= &mt("Either upload a file which includes $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or when associating fields with data columns, omit an association for the Student/Employee ID field.");
+ }
+ } elsif ($mode eq 'selfcreate') {
+ if ($checkitem eq 'id') {
+ $response .= &mt("You must either choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or leave the ID field blank.");
+ }
+ } else {
+ if ($checkitem eq 'username') {
+ $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
+ } elsif ($checkitem eq 'id') {
+ $response .= &mt("You must either choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or leave the ID field blank.");
+ }
+ }
+ return $response;
+}
+
+sub personal_data_fieldtitles {
+ my %fieldtitles = &Apache::lonlocal::texthash (
+ id => 'Student/Employee ID',
+ permanentemail => 'E-mail address',
+ lastname => 'Last Name',
+ firstname => 'First Name',
+ middlename => 'Middle Name',
+ generation => 'Generation',
+ gen => 'Generation',
+ );
+ return %fieldtitles;
+}
+
+sub sorted_inst_types {
+ my ($dom) = @_;
+ my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
+ my $othertitle = &mt('All users');
+ if ($env{'request.course.id'}) {
+ $othertitle = &mt('Any users');
+ }
+ my @types;
+ if (ref($order) eq 'ARRAY') {
+ @types = @{$order};
+ }
+ if (@types == 0) {
+ if (ref($usertypes) eq 'HASH') {
+ @types = sort(keys(%{$usertypes}));
+ }
+ }
+ if (keys(%{$usertypes}) > 0) {
+ $othertitle = &mt('Other users');
+ }
+ return ($othertitle,$usertypes,\@types);
+}
+
+sub get_institutional_codes {
+ my ($settings,$allcourses,$LC_code) = @_;
+# Get complete list of course sections to update
+ my @currsections = ();
+ my @currxlists = ();
+ my $coursecode = $$settings{'internal.coursecode'};
+
+ if ($$settings{'internal.sectionnums'} ne '') {
+ @currsections = split(/,/,$$settings{'internal.sectionnums'});
+ }
+ if ($$settings{'internal.crosslistings'} ne '') {
+ @currxlists = split(/,/,$$settings{'internal.crosslistings'});
+ }
+
+ if (@currxlists > 0) {
+ foreach (@currxlists) {
+ if (m/^([^:]+):(\w*)$/) {
+ unless (grep/^$1$/,@{$allcourses}) {
+ push @{$allcourses},$1;
+ $$LC_code{$1} = $2;
+ }
+ }
+ }
+ }
+
+ if (@currsections > 0) {
+ foreach (@currsections) {
+ if (m/^(\w+):(\w*)$/) {
+ my $sec = $coursecode.$1;
+ my $lc_sec = $2;
+ unless (grep/^$sec$/,@{$allcourses}) {
+ push @{$allcourses},$sec;
+ $$LC_code{$sec} = $lc_sec;
+ }
+ }
+ }
+ }
+ return;
+}
=pod
@@ -5747,7 +7397,7 @@ END_BLOCK
=over 4
-=item * get_unprocessed_cgi($query,$possible_names)
+=item * &get_unprocessed_cgi($query,$possible_names)
Modify the %env hash to contain unprocessed CGI form parameters held in
$query. The parameters listed in $possible_names (an array reference),
@@ -5776,7 +7426,7 @@ sub get_unprocessed_cgi {
=pod
-=item * cacheheader()
+=item * &cacheheader()
returns cache-controlling header code
@@ -5793,7 +7443,7 @@ sub cacheheader {
=pod
-=item * no_cache($r)
+=item * &no_cache($r)
specifies header code to not have cache
@@ -5829,7 +7479,7 @@ sub content_type {
=pod
-=item * add_to_env($name,$value)
+=item * &add_to_env($name,$value)
adds $name to the %env hash with value
$value, if $name already exists, the entry is converted to an array
@@ -5856,7 +7506,7 @@ sub add_to_env {
=pod
-=item * get_env_multiple($name)
+=item * &get_env_multiple($name)
gets $name from the %env hash, it seemlessly handles the cases where multiple
values may be defined and end up as an array ref.
@@ -5879,6 +7529,232 @@ sub get_env_multiple {
return(@values);
}
+sub ask_for_embedded_content {
+ my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
+ my $upload_output = '
+ ';
+ 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;
+ }
+ }
+ }
+ 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
@@ -5888,7 +7764,7 @@ sub get_env_multiple {
=over 4
-=item * upfile_store($r)
+=item * &upfile_store($r)
Store uploaded file, $r should be the HTTP Request object,
needs $env{'form.upfile'}
@@ -5918,7 +7794,7 @@ sub upfile_store {
=pod
-=item * load_tmp_file($r)
+=item * &load_tmp_file($r)
Load uploaded file from tmp, $r should be the HTTP Request object,
needs $env{'form.datatoken'},
@@ -5942,7 +7818,7 @@ sub load_tmp_file {
=pod
-=item * upfile_record_sep()
+=item * &upfile_record_sep()
Separate uploaded file into records
returns array of records,
@@ -5964,7 +7840,7 @@ sub upfile_record_sep {
=pod
-=item * record_sep($record)
+=item * &record_sep($record)
Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
@@ -5996,28 +7872,50 @@ sub record_sep {
$i++;
}
} else {
- my @allfields;
+ my $separator=',';
if ($env{'form.upfiletype'} eq 'semisv') {
- @allfields=split(/;/,$record,-1);
- } else {
- @allfields=split(/\,/,$record,-1);
+ $separator=';';
}
my $i=0;
- my $j;
- for ($j=0;$j<=$#allfields;$j++) {
- my $field=$allfields[$j];
- if ($field=~/^\s*(\"|\')/) {
- my $delimiter=$1;
- while (($field!~/$delimiter$/) && ($j<$#allfields)) {
- $j++;
- $field.=','.$allfields[$j];
- }
- $field=~s/^\s*$delimiter//;
- $field=~s/$delimiter\s*$//;
- }
- $components{&takeleft($i)}=$field;
- $i++;
+# the character we are looking for to indicate the end of a quote or a record
+ my $looking_for=$separator;
+# do not add the characters to the fields
+ my $ignore=0;
+# we just encountered a separator (or the beginning of the record)
+ my $just_found_separator=1;
+# store the field we are working on here
+ my $field='';
+# work our way through all characters in record
+ foreach my $character ($record=~/(.)/g) {
+ if ($character eq $looking_for) {
+ if ($character ne $separator) {
+# Found the end of a quote, again looking for separator
+ $looking_for=$separator;
+ $ignore=1;
+ } else {
+# Found a separator, store away what we got
+ $components{&takeleft($i)}=$field;
+ $i++;
+ $just_found_separator=1;
+ $ignore=0;
+ $field='';
+ }
+ next;
+ }
+# single or double quotation marks after a separator indicate beginning of a quote
+# we are now looking for the end of the quote and need to ignore separators
+ if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
+ $looking_for=$character;
+ next;
+ }
+# ignore would be true after we reached the end of a quote
+ if ($ignore) { next; }
+ if (($just_found_separator) && ($character=~/\s/)) { next; }
+ $field.=$character;
+ $just_found_separator=0;
}
+# catch the very last entry, since we never encountered the separator
+ $components{&takeleft($i)}=$field;
}
return %components;
}
@@ -6027,7 +7925,7 @@ sub record_sep {
=pod
-=item * upfile_select_html()
+=item * &upfile_select_html()
Return HTML code to select a file from the users machine and specify
the file type.
@@ -6045,7 +7943,7 @@ sub upfile_select_html {
# xml => &mt('HTML/XML'),
);
my $Str = ''.
- '
Type: |
|