'.
- &mt('Field').' '.&mt('Samples').' '.
+ &mt('Field').' '.&mt('Samples').' '.
+ &end_data_table_header_row());
foreach my $key (sort(keys(%{ $samples->[0] }))) {
- $r->print('print(&start_data_table_row().'');
foreach my $option (@$d) {
my ($value,$display,$defaultcol)=@{ $option };
@@ -4825,14 +8619,15 @@ 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}." '.
+ ' '.
+ ''.
+ &Apache::lonnet::assigncustomrole(
+ $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
+ ' '.$result.' '.$linefeed.
+ &mt('Add to classlist').': ok ';
+ }
+ $output .= $linefeed;
+ }
+ } else {
+ $output = &mt('Assigning').' '.$three.' in '.$url.
+ ($start?', '.&mt('starting').' '.localtime($start):'').
+ ($end?', '.&mt('ending').' '.localtime($end):'').': ';
+ my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
+ if ($context eq 'auto') {
+ $output .= $result.$linefeed;
+ } else {
+ $output .= ''.$result.' '.$linefeed;
+ }
+ }
+ return $output;
+}
+
+sub commit_studentrole {
+ my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
+ my ($result,$linefeed,$oldsecurl,$newsecurl);
+ if ($context eq 'auto') {
+ $linefeed = "\n";
+ } else {
+ $linefeed = ''.$clonemsg.' ';
+ }
+ }
+ $outcome .= $clonemsg.$linefeed;
+
+ if (!$can_clone) {
+ return (0,$outcome);
+ }
+ }
+
+#
+# Open course
+#
+ my $crstype = lc($args->{'crstype'});
+ my %cenv=();
+ $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
+ $args->{'cdescr'},
+ $args->{'curl'},
+ $args->{'course_home'},
+ $args->{'nonstandard'},
+ $args->{'crscode'},
+ $args->{'ccuname'}.':'.
+ $args->{'ccdomain'},
+ $args->{'crstype'});
+
+ # Note: The testing routines depend on this being output; see
+ # Utils::Course. This needs to at least be output as a comment
+ # 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;
+
+#
+# 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,$args->{'datemode'},$args->{'dateshift'});
+# Restore URL
+ $cenv{'url'}=$oldcenv{'url'};
+# Restore title
+ $cenv{'description'}=$oldcenv{'description'};
+# Mark as cloned
+ $cenv{'clonedfrom'}=$cloneid;
+# Need to clone grading mode
+ my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
+ $cenv{'grading'}=$newenv{'grading'};
+# Do not clone these environment entries
+ &Apache::lonnet::del('environment',
+ ['default_enrollment_start_date',
+ 'default_enrollment_end_date',
+ 'question.email',
+ 'policy.email',
+ 'comment.email',
+ 'pch.users.denied',
+ 'plc.users.denied',
+ 'hidefromcat',
+ 'categories'],
+ $$crsudom,$$crsunum);
+ }
+
+#
+# Set environment (will override cloned, if existing)
+#
+ my @sections = ();
+ my @xlists = ();
+ if ($args->{'crstype'}) {
+ $cenv{'type'}=$args->{'crstype'};
+ }
+ if ($args->{'crsid'}) {
+ $cenv{'courseid'}=$args->{'crsid'};
+ }
+ if ($args->{'crscode'}) {
+ $cenv{'internal.coursecode'}=$args->{'crscode'};
+ }
+ if ($args->{'crsquota'} ne '') {
+ $cenv{'internal.coursequota'}=$args->{'crsquota'};
+ } else {
+ $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
+ }
+ if ($args->{'ccuname'}) {
+ $cenv{'internal.courseowner'} = $args->{'ccuname'}.
+ ':'.$args->{'ccdomain'};
+ } else {
+ $cenv{'internal.courseowner'} = $args->{'curruser'};
+ }
+ my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
+ if ($args->{'crssections'}) {
+ $cenv{'internal.sectionnums'} = '';
+ if ($args->{'crssections'} =~ m/,/) {
+ @sections = split/,/,$args->{'crssections'};
+ } else {
+ $sections[0] = $args->{'crssections'};
+ }
+ if (@sections > 0) {
+ foreach my $item (@sections) {
+ my ($sec,$gp) = split/:/,$item;
+ my $class = $args->{'crscode'}.$sec;
+ my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
+ $cenv{'internal.sectionnums'} .= $item.',';
+ unless ($addcheck eq 'ok') {
+ push @badclasses, $class;
+ }
+ }
+ $cenv{'internal.sectionnums'} =~ s/,$//;
+ }
+ }
+# do not hide course coordinator from staff listing,
+# even if privileged
+ $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
+# add crosslistings
+ if ($args->{'crsxlist'}) {
+ $cenv{'internal.crosslistings'}='';
+ if ($args->{'crsxlist'} =~ m/,/) {
+ @xlists = split/,/,$args->{'crsxlist'};
+ } else {
+ $xlists[0] = $args->{'crsxlist'};
+ }
+ if (@xlists > 0) {
+ foreach my $item (@xlists) {
+ my ($xl,$gp) = split/:/,$item;
+ my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
+ $cenv{'internal.crosslistings'} .= $item.',';
+ unless ($addcheck eq 'ok') {
+ push @badclasses, $xl;
+ }
+ }
+ $cenv{'internal.crosslistings'} =~ s/,$//;
+ }
+ }
+ if ($args->{'autoadds'}) {
+ $cenv{'internal.autoadds'}=$args->{'autoadds'};
+ }
+ if ($args->{'autodrops'}) {
+ $cenv{'internal.autodrops'}=$args->{'autodrops'};
+ }
+# check for notification of enrollment changes
+ my @notified = ();
+ if ($args->{'notify_owner'}) {
+ if ($args->{'ccuname'} ne '') {
+ push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
+ }
+ }
+ if ($args->{'notify_dc'}) {
+ if ($uname ne '') {
+ push(@notified,$uname.':'.$udom);
+ }
+ }
+ if (@notified > 0) {
+ my $notifylist;
+ if (@notified > 1) {
+ $notifylist = join(',',@notified);
+ } else {
+ $notifylist = $notified[0];
+ }
+ $cenv{'internal.notifylist'} = $notifylist;
+ }
+ if (@badclasses > 0) {
+ my %lt=&Apache::lonlocal::texthash(
+ 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course. However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',
+ 'dnhr' => 'does not have rights to access enrollment in these classes',
+ 'adby' => 'as determined by the policies of your institution on access to official classlists'
+ );
+ my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
+ ' ('.$lt{'adby'}.')';
+ if ($context eq 'auto') {
+ $outcome .= $badclass_msg.$linefeed;
+ $outcome .= ''.$badclass_msg.$linefeed.'
'."\n";
+ foreach my $item (@badclasses) {
+ if ($context eq 'auto') {
+ $outcome .= " - $item\n";
+ } else {
+ $outcome .= "$item \n";
+ }
+ }
+ if ($context eq 'auto') {
+ $outcome .= $linefeed;
+ } else {
+ $outcome .= " '.$krb_msg.' ';
+ }
+ $outcome .= $linefeed;
+ }
+ }
+ if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
+ if ($args->{'setpolicy'}) {
+ $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
+ }
+ if ($args->{'setcontent'}) {
+ $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
+ }
+ }
+ if ($args->{'reshome'}) {
+ $cenv{'reshome'}=$args->{'reshome'}.'/';
+ $cenv{'reshome'}=~s/\/+$/\//;
+ }
+#
+# course has keyed access
+#
+ if ($args->{'setkeys'}) {
+ $cenv{'keyaccess'}='yes';
+ }
+# if specified, key authority is not course, but user
+# only active if keyaccess is yes
+ if ($args->{'keyauth'}) {
+ my ($user,$domain) = split(':',$args->{'keyauth'});
+ $user = &LONCAPA::clean_username($user);
+ $domain = &LONCAPA::clean_username($domain);
+ if ($user ne '' && $domain ne '') {
+ $cenv{'keyauth'}=$user.':'.$domain;
+ }
+ }
+
+ if ($args->{'disresdis'}) {
+ $cenv{'pch.roles.denied'}='st';
+ }
+ if ($args->{'disablechat'}) {
+ $cenv{'plc.roles.denied'}='st';
+ }
+
+ # Record we've not yet viewed the Course Initialization Helper for this
+ # course
+ $cenv{'course.helper.not.run'} = 1;
+ #
+ # Use new Randomseed
+ #
+ $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
+ $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
+ #
+ # The encryption code and receipt prefix for this course
+ #
+ $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
+ $cenv{'internal.encpref'}=100+int(9*rand(99));
+ #
+ # By default, use standard grading
+ if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
+
+ $outcome .= $linefeed.&mt('Setting environment').': '.
+ &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
+#
+# Open all assignments
+#
+ if ($args->{'openall'}) {
+ my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
+ my %storecontent = ($storeunder => time,
+ $storeunder.'.type' => 'date_start');
+
+ $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
+ ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
+ }
+#
+# Set first page
+#
+ unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
+ || ($cloneid)) {
+ use LONCAPA::map;
+ $outcome .= &mt('Setting first resource').': ';
+
+ my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
+ my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
+
+ $outcome .= ($fatal?$errtext:'read ok').' - ';
+ my $title; my $url;
+ if ($args->{'firstres'} eq 'syl') {
+ $title=&mt('Syllabus');
+ $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
+ } else {
+ $title=&mt('Navigate Contents');
+ $url='/adm/navmaps';
+ }
+
+ $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
+ (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
+
+ if ($errtext) { $fatal=2; }
+ $outcome .= ($fatal?$errtext:'write ok').$linefeed;
+ }
+
+ return (1,$outcome);
+}
+
############################################################
############################################################
@@ -5431,7 +10177,7 @@ sub group_term {
sub icon {
my ($file)=@_;
- my $curfext = (split(/\./,$file))[-1];
+ my $curfext = lc((split(/\./,$file))[-1]);
my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
my $embstyle = &Apache::loncommon::fileembstyle($curfext);
if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
@@ -5446,10 +10192,13 @@ sub icon {
}
sub lonhttpdurl {
+#
+# Had been used for "small fry" static images on separate port 8080.
+# Modify here if lightweight http functionality desired again.
+# Currently eliminated due to increasing firewall issues.
+#
my ($url)=@_;
- my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'};
- if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; }
- return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
+ return $url;
}
sub connection_aborted {
@@ -5484,6 +10233,224 @@ sub escape_url {
my $lastitem = &escape(pop(@urlslices));
return join('/',@urlslices).'/'.$lastitem;
}
+
+# -------------------------------------------------------- Initliaze user login
+sub init_user_environment {
+ my ($r, $username, $domain, $authhost, $form, $args) = @_;
+ my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
+
+ my $public=($username eq 'public' && $domain eq 'public');
+
+# See if old ID present, if so, remove
+
+ my ($filename,$cookie,$userroles);
+ my $now=time;
+
+ if ($public) {
+ my $max_public=100;
+ my $oldest;
+ my $oldest_time=0;
+ for(my $next=1;$next<=$max_public;$next++) {
+ if (-e $lonids."/publicuser_$next.id") {
+ my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
+ if ($mtime<$oldest_time || !$oldest_time) {
+ $oldest_time=$mtime;
+ $oldest=$next;
+ }
+ } else {
+ $cookie="publicuser_$next";
+ last;
+ }
+ }
+ if (!$cookie) { $cookie="publicuser_$oldest"; }
+ } else {
+ # if this isn't a robot, kill any existing non-robot sessions
+ if (!$args->{'robot'}) {
+ opendir(DIR,$lonids);
+ while ($filename=readdir(DIR)) {
+ if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
+ unlink($lonids.'/'.$filename);
+ }
+ }
+ closedir(DIR);
+ }
+# Give them a new cookie
+ my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
+ : $now.$$.int(rand(10000)));
+ $cookie="$username\_$id\_$domain\_$authhost";
+
+# Initialize roles
+
+ $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
+ }
+# ------------------------------------ Check browser type and MathML capability
+
+ my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
+ $clientunicode,$clientos) = &decode_user_agent($r);
+
+# -------------------------------------- Any accessibility options to remember?
+ if (($form->{'interface'}) && ($form->{'remember'} eq 'true')) {
+ foreach my $option ('imagesuppress','appletsuppress',
+ 'embedsuppress','fontenhance','blackwhite') {
+ if ($form->{$option} eq 'true') {
+ &Apache::lonnet::put('environment',{$option => 'on'},
+ $domain,$username);
+ } else {
+ &Apache::lonnet::del('environment',[$option],
+ $domain,$username);
+ }
+ }
+ }
+# ------------------------------------------------------------- Get 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
+ foreach my $option ('imagesuppress','appletsuppress',
+ 'embedsuppress','fontenhance','blackwhite',
+ 'interface','localpath','localres') {
+ $form->{$option}=~s/[\n\r\=]//gs;
+ }
+# --------------------------------------------------------- Write first profile
+
+ {
+ my %initial_env =
+ ("user.name" => $username,
+ "user.domain" => $domain,
+ "user.home" => $authhost,
+ "browser.type" => $clientbrowser,
+ "browser.version" => $clientversion,
+ "browser.mathml" => $clientmathml,
+ "browser.unicode" => $clientunicode,
+ "browser.os" => $clientos,
+ "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
+ "request.course.fn" => '',
+ "request.course.uri" => '',
+ "request.course.sec" => '',
+ "request.role" => 'cm',
+ "request.role.adv" => $env{'user.adv'},
+ "request.host" => $ENV{'REMOTE_ADDR'},);
+
+ if ($form->{'localpath'}) {
+ $initial_env{"browser.localpath"} = $form->{'localpath'};
+ $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'};
+ foreach my $option ('imagesuppress','appletsuppress',
+ 'embedsuppress','fontenhance','blackwhite') {
+ if (($form->{$option} eq 'true') ||
+ ($userenv{$option} eq 'on')) {
+ $initial_env{"browser.$option"} = "on";
+ }
+ }
+ }
+
+ foreach my $tool ('aboutme','blog','portfolio') {
+ $userenv{'availabletools.'.$tool} =
+ &Apache::lonnet::usertools_access($username,$domain,$tool,'reload');
+ }
+
+ foreach my $crstype ('official','unofficial') {
+ $userenv{'canrequest.'.$crstype} =
+ &Apache::lonnet::usertools_access($username,$domain,$crstype,
+ 'reload','requestcourses');
+ }
+
+ $env{'user.environment'} = "$lonids/$cookie.id";
+
+ if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
+ &GDBM_WRCREAT(),0640)) {
+ &_add_to_env(\%disk_env,\%initial_env);
+ &_add_to_env(\%disk_env,\%userenv,'environment.');
+ &_add_to_env(\%disk_env,$userroles);
+ if (ref($args->{'extra_env'})) {
+ &_add_to_env(\%disk_env,$args->{'extra_env'});
+ }
+ untie(%disk_env);
+ } else {
+ &Apache::lonnet::logthis("WARNING: ".
+ 'Could not create environment storage in lonauth: '.$!.' ');
+ return 'error: '.$!;
+ }
+ }
+ $env{'request.role'}='cm';
+ $env{'request.role.adv'}=$env{'user.adv'};
+ $env{'browser.type'}=$clientbrowser;
+
+ return $cookie;
+
+}
+
+sub _add_to_env {
+ my ($idf,$env_data,$prefix) = @_;
+ if (ref($env_data) eq 'HASH') {
+ while (my ($key,$value) = each(%$env_data)) {
+ $idf->{$prefix.$key} = $value;
+ $env{$prefix.$key} = $value;
+ }
+ }
+}
+
+# --- Get the symbolic name of a problem and the url
+sub get_symb {
+ my ($request,$silent) = @_;
+ (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
+ my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
+ if ($symb eq '') {
+ if (!$silent) {
+ $request->print("Unable to handle ambiguous references:$url:.");
+ return ();
+ }
+ }
+ &Apache::lonenc::check_decrypt(\$symb);
+ return ($symb);
+}
+
+# --------------------------------------------------------------Get annotation
+
+sub get_annotation {
+ my ($symb,$enc) = @_;
+
+ my $key = $symb;
+ if (!$enc) {
+ $key =
+ &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
+ }
+ my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
+ return $annotation{$key};
+}
+
+sub clean_symb {
+ my ($symb,$delete_enc) = @_;
+
+ &Apache::lonenc::check_decrypt(\$symb);
+ my $enc = $env{'request.enc'};
+ if ($delete_enc) {
+ delete($env{'request.enc'});
+ }
+
+ return ($symb,$enc);
+}
+
=pod
=back