".
- "$text";
+ "".
+ "| $text";
}
# Add the graphic
@@ -805,14 +819,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 +844,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 +878,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,});
@@ -1084,6 +1092,138 @@ 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.
+
+
+=cut
+
+sub resize_textarea_js {
+ my $geometry = &viewport_geometry_js();
+ return <<"RESIZE";
+
+RESIZE
+
+}
+
+=pod
+
=back
=head1 Excel and CSV file utility routines
@@ -1285,8 +1425,6 @@ sub domain_select {
=over 4
-=cut
-
=item * multiple_select_form($name,$value,$size,$hash,$order)
Returns a string containing a |
END_BLOCK
@@ -5737,7 +6429,58 @@ END_BLOCK
return $output;
}
-
+sub username_rule_check {
+ my ($srch,$caller) = @_;
+ my ($response,@curr_rules,%inst_results,$rulematch);
+ my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($srch->{'srchdomain'});
+ if (ref($srch) eq 'HASH') {
+ (my $inst_response,%inst_results) =
+ &Apache::lonnet::get_instuser($srch->{'srchdomain'},
+ $srch->{'srchterm'});
+ my %domconfig = &Apache::lonnet::get_dom('configuration',
+ ['usercreation'],$srch->{'srchdomain'});
+ if (ref($domconfig{'usercreation'}) eq 'HASH') {
+ if (ref($domconfig{'usercreation'}{'username_rule'}) eq 'ARRAY') {
+ @curr_rules = @{$domconfig{'usercreation'}{'username_rule'}};
+ }
+ }
+ if (@curr_rules > 0) {
+ my $domdesc = &Apache::lonnet::domain($srch->{'srchdomain'},'description');
+ my $instuser_reqd;
+ my %rule_check = &Apache::lonnet::inst_rulecheck($srch->{'srchdomain'},$srch->{'srchterm'},\@curr_rules);
+ foreach my $rule (@curr_rules) {
+ if ($rule_check{$rule}) {
+ $rulematch = $rule;
+ if ($inst_response eq 'ok') {
+ if (keys(%inst_results) == 0) {
+ if ($caller eq 'new') {
+ $response = &mt('The username you chose matches the format of usernames defined for [_1], but the user does not exist in the institutional directory.',$domdesc).'
'.&mt("You must choose a username with a different format -- one that will not conflict with 'official' institutional usernames.");
+ }
+ }
+ }
+ last;
+ }
+ }
+ if ($response) {
+ if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
+ if (@{$ruleorder} > 0) {
+ $response .= '
'.&mt('Usernames with the following format(s) may only be used for verified users at [_1]:',$domdesc).' ';
+ foreach my $rule (@{$ruleorder}) {
+ if (grep(/^\Q$rule\E$/,@curr_rules)) {
+ if (ref($rules->{$rule}) eq 'HASH') {
+ $response .= '- '.$rules->{$rule}{'name'}.': '.
+ $rules->{$rule}{'desc'}.'
';
+ }
+ }
+ }
+ }
+ $response .= ' ';
+ }
+ }
+ }
+ }
+ return ($response,$rulematch,$rules,%inst_results);
+}
=pod
@@ -5996,28 +6739,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;
}
@@ -6088,20 +6853,21 @@ sub csv_print_samples {
my ($r,$records) = @_;
my $samples = &get_samples($records,3);
- $r->print(&mt('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(' ');
+ $r->print(&end_data_table_header_row());
foreach my $hash (@$samples) {
- $r->print('');
+ $r->print(&start_data_table_row());
foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
$r->print('| ');
if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
$r->print(' | ');
}
- $r->print(' ');
+ $r->print(&end_data_table_row());
}
- $r->print('
'."\n");
+ $r->print(&end_data_table().'
'."\n");
}
######################################################
@@ -6126,12 +6892,13 @@ sub csv_print_select_table {
my $i=0;
my $samples = &get_samples($records,1);
$r->print(&mt('Associate columns with student attributes.')."\n".
- ''.
+ &start_data_table().&start_data_table_header_row().
'| '.&mt('Attribute').' | '.
- ''.&mt('Column').' | '."\n");
+ ''.&mt('Column').' | '.
+ &end_data_table_header_row()."\n");
foreach my $array_ref (@$d) {
my ($value,$display,$defaultcol)=@{ $array_ref };
- $r->print('| '.$display.' | ');
+ $r->print(&start_data_table_row().' | '.$display.' | ');
$r->print(' | '."\n");
+ $r->print(''.&end_data_table_row()."\n");
$i++;
}
+ $r->print(&end_data_table());
$i--;
return $i;
}
@@ -6170,11 +6938,13 @@ sub csv_samples_select_table {
my $i=0;
#
my $samples = &get_samples($records,3);
- $r->print('| '.
- &mt('Field').' | '.&mt('Samples').' |
|---|
');
+ $r->print(&start_data_table().
+ &start_data_table_header_row().''.
+ &mt('Field').' | '.&mt('Samples').' | '.
+ &end_data_table_header_row());
foreach my $key (sort(keys(%{ $samples->[0] }))) {
- $r->print(' | ');
+ $r->print(''.&end_data_table_row());
$i++;
}
+ $r->print(&end_data_table());
$i--;
return($i);
}
@@ -6876,6 +7647,45 @@ sub commit_studentrole {
############################################################
############################################################
+sub check_clone {
+ my ($args,$linefeed) = @_;
+ my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
+ my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
+ my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
+ my $clonemsg;
+ my $can_clone = 0;
+
+ 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'});
+ } else {
+ my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
+ if ($env{'request.role.domain'} eq $args->{'clonedomain'}) {
+ $can_clone = 1;
+ } else {
+ my %clonehash = &Apache::lonnet::get('environment',['cloners'],
+ $args->{'clonedomain'},$args->{'clonecourse'});
+ my @cloners = split(/,/,$clonehash{'cloners'});
+ if (grep(/^\*$/,@cloners)) {
+ $can_clone = 1;
+ } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
+ $can_clone = 1;
+ } else {
+ my %roleshash =
+ &Apache::lonnet::get_my_roles($args->{'ccuname'},
+ $args->{'ccdomain'},
+ 'userroles',['active'],['cc'],
+ [$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'});
+ }
+ }
+ }
+ }
+ return ($can_clone, $clonemsg, $cloneid, $clonehome);
+}
+
sub construct_course {
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context) = @_;
my $outcome;
@@ -6883,6 +7693,25 @@ sub construct_course {
if ($context eq 'auto') {
$linefeed = "\n";
}
+
+#
+# Are we cloning?
+#
+ my ($can_clone, $clonemsg, $cloneid, $clonehome);
+ if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
+ ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
+ if ($context ne 'auto') {
+ if ($clonemsg ne '') {
+ $clonemsg = ''.$clonemsg.'';
+ }
+ }
+ $outcome .= $clonemsg.$linefeed;
+
+ if (!$can_clone) {
+ return (0,$outcome);
+ }
+ }
+
#
# Open course
#
@@ -6903,81 +7732,39 @@ sub construct_course {
# 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;
-
#
# Check if created correctly
#
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
$outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
+
#
-# Are we cloning?
-#
- my $cloneid='';
- if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
- my $can_clone = 0;
- $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
- my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
- my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
- my $clonemsg;
- if ($clonehome eq 'no_host') {
- $clonemsg = &mt('Attempting to clone non-existing [_1]',$crstype);
- if ($context eq 'auto') {
- $outcome .= $clonemsg;
- } else {
- $outcome .= ''.$clonemsg.'';
- }
- $outcome .= $linefeed;
- } else {
- my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
- if ($env{'request.role.domain'} eq $args->{'form.clonedomain'}) {
- $can_clone = 1;
- } else {
- my %clonehash = &Apache::lonnet::get('environment',['cloners'],
- $args->{'clonedomain'},$args->{'clonecourse'});
- my @cloners = split(/,/,$clonehash{'cloners'});
- my %roleshash =
- &Apache::lonnet::get_my_roles($args->{'ccuname'},
- $args->{'ccdomain'},'userroles',['active'],['cc'],
- [$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('The new course was not cloned from an existing course because the course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
- if ($context eq 'auto') {
- $outcome .= $clonemsg;
- } else {
- $outcome .= ''.$clonemsg.'';
- }
- $outcome .= $linefeed;
- }
- }
- }
- if ($can_clone) {
- $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
- if ($context eq 'auto') {
- $outcome = $clonemsg;
- } else {
- $outcome .= ''.$clonemsg.'';
- }
- $outcome .= $linefeed;
- my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
+# Do the cloning
+#
+ if ($can_clone && $cloneid) {
+ $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
+ if ($context ne 'auto') {
+ $clonemsg = ''.$clonemsg.'';
+ }
+ $outcome .= $clonemsg.$linefeed;
+ my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
# Copy all files
- &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid);
+ &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid);
# Restore URL
- $cenv{'url'}=$oldcenv{'url'};
+ $cenv{'url'}=$oldcenv{'url'};
# Restore title
- $cenv{'description'}=$oldcenv{'description'};
+ $cenv{'description'}=$oldcenv{'description'};
# restore grading mode
- if (defined($oldcenv{'grading'})) {
- $cenv{'grading'}=$oldcenv{'grading'};
- }
-# Mark as cloned
- $cenv{'clonedfrom'}=$cloneid;
- delete($cenv{'default_enrollment_start_date'});
- delete($cenv{'default_enrollment_end_date'});
+ if (defined($oldcenv{'grading'})) {
+ $cenv{'grading'}=$oldcenv{'grading'};
}
+# Mark as cloned
+ $cenv{'clonedfrom'}=$cloneid;
+ delete($cenv{'default_enrollment_start_date'});
+ delete($cenv{'default_enrollment_end_date'});
}
+
#
# Set environment (will override cloned, if existing)
#
@@ -7085,7 +7872,7 @@ sub construct_course {
' ('.$lt{'adby'}.')';
if ($context eq 'auto') {
$outcome .= $badclass_msg.$linefeed;
- $outcome .= ''.$badclass_msg.$linefeed.'
|