--- loncom/interface/loncommon.pm 2007/07/11 20:37:52 1.549
+++ loncom/interface/loncommon.pm 2007/08/30 20:26:50 1.564.2.3
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.549 2007/07/11 20:37:52 albertel Exp $
+# $Id: loncommon.pm,v 1.564.2.3 2007/08/30 20:26:50 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -334,10 +334,12 @@ sub studentbrowser_javascript {
return (<<'ENDSTDBRW');
+
+$new_user_create
+
+
+
+END_BLOCK
+
+ return $output;
+}
+
+
+
=pod
=back
@@ -5773,28 +6010,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;
}
@@ -6653,6 +6912,40 @@ sub commit_studentrole {
############################################################
############################################################
+sub check_clone {
+ my ($args) = @_;
+ 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('Attempting to clone non-existing [_1]',
+ $args->{'crstype'});
+ } 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'});
+ 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 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;
@@ -6660,6 +6953,23 @@ 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);
+ if ($context ne 'auto') {
+ $clonemsg = ''.$clonemsg.'';
+ }
+ $outcome .= $clonemsg.$linefeed;
+
+ if (!$can_clone) {
+ return (0,$outcome);
+ }
+ }
+
#
# Open course
#
@@ -6680,81 +6990,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)
#
@@ -6862,7 +7130,7 @@ sub construct_course {
' ('.$lt{'adby'}.')';
if ($context eq 'auto') {
$outcome .= $badclass_msg.$linefeed;
- $outcome .= ''.$badclass_msg.$linefeed.'