File:  [LON-CAPA] / loncom / interface / Attic / londropadd.pm
Revision 1.45.2.1: download - view: text, annotated - select for diffs
Thu Aug 22 21:22:30 2002 UTC (21 years, 8 months ago) by albertel
Diff to branchpoint 1.45: preferred, colored
- krb5 stuff backport to version 0.5

# The LearningOnline Network with CAPA
# Handler to drop and add students in courses 
#
# $Id: londropadd.pm,v 1.45.2.1 2002/08/22 21:22:30 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# (Handler to set parameters for assessments
#
# (Handler to resolve ambiguous file locations
#
# (TeX Content Handler
#
# YEAR=2000
# 05/29/00,05/30,10/11 Gerd Kortemeyer)
#
# 10/11,10/12,10/16 Gerd Kortemeyer)
#
# 11/20,11/21,11/22,11/23,11/24,11/25,11/27,11/28,
# 12/08,12/12 Gerd Kortemeyer)
#
# 12/26,12/27,12/28,
# YEAR=2001
# 01/01/01,01/15,02/10,02/13,02/14,02/22 Gerd Kortemeyer
# 8/6 Scott Harrison
# Guy Albertelli
# 9/25 Gerd Kortemeyer
# 12/19 Guy Albertelli
# YEAR=2002
# 1/4 Gerd Kortemeyer

package Apache::londropadd;

use strict;
use Apache::lonnet();
use Apache::loncommon();
use Apache::Constants qw(:common :http REDIRECT);

# ================================================================ Print header

sub header {
    return(<<ENDHEAD);
<html>
<head>
<title>LON-CAPA Enrollment Manager</title>
</head>
<body bgcolor="#FFFFFF">
<img align=right src=/adm/lonIcons/lonlogos.gif>
<h1>$ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h1>
<h2>Enrollment Manager</h2>
<form method="post" enctype="multipart/form-data"  
      action="/adm/dropadd" name="studentform">
ENDHEAD
}

# =========== Drop student from all sections of a course, except optional $csec
sub modifystudent {
    my ($udom,$unam,$courseid,$csec,$desiredhost)=@_;
    # if $csec is undefined, drop the student from all the courses matching
    # this one.  If $csec is defined, drop them from all other sections of 
    # this course and add them to section $csec
    $courseid=~s/\_/\//g;
    $courseid=~s/^(\w)/\/$1/;
    my %roles = &Apache::lonnet::dump('roles',$udom,$unam);
    my ($tmp) = keys(%roles);
    # Bail out if we were unable to get the students roles
    return "$1" if ($tmp =~ /^(con_lost|error|no_such_host)/i);
    # Go through the roles looking for enrollment in this course
    my $result = '';
    foreach my $course (keys(%roles)) {
        if ($course=~/^$courseid(?:\/)*(?:\s+)*(\w+)*\_st$/) {
            # We are in this course
            my $section=$1;
            $section='' if ($course eq $courseid.'_st');
            if ( ((!$section) && (!$csec)) || ($section ne $csec) ) {
                my (undef,$end,$start)=split(/\_/,$roles{$course});
                my $now=time;
                if (!($start && ($now<$start)) || !($end && ($now>$end))) {
                    my $reply=&Apache::lonnet::modifystudent
                        ($udom,$unam,'','','','','','','',
                         $section,time,undef,undef,$desiredhost);
                    $result .= $reply.':';
                }
            }
        }
    }
    if ($result eq '') {
        $result eq 'Unable to find section for this student';
    } else {
        $result =~ s/(ok:)+/ok/g;
    }
    return $result;
}

# ============ build a domain and server selection form
sub domain_form {
    my ($defdom) = @_;
    # Set up domain and server selection forms
    #
    # Get the domains
    my @domains = &Apache::loncommon::get_domains();
    # build up the menu information to be passed to 
    # &Apache::loncommon::linked_select_forms
    my %select_menus;
    foreach my $dom (@domains) {
        # set up the text for this domain
        $select_menus{$dom}->{'text'}= $dom;
        # we want a choice of 'default' as the default in the second menu
        $select_menus{$dom}->{'default'}= 'default';
        $select_menus{$dom}->{'select2'}->{'default'} = 'default';
        # Now build up the other items in the second menu
        my %servers = &Apache::loncommon::get_library_servers($dom);
        foreach my $server (keys(%servers)) {
            $select_menus{$dom}->{'select2'}->{$server} 
                                            = "$server $servers{$server}";
        }
    }
    my $result  = &Apache::loncommon::linked_select_forms
        ('studentform',' with home server ',$defdom,
         'lcdomain','lcserver',\%select_menus);
    return $result;
}

# ============================================================== Menu Phase One
sub menu_phase_one {
    my $r=shift;
    my $upfile_select=&Apache::loncommon::upfile_select_html();
    my $create_classlist_help = 
	&Apache::loncommon::help_open_topic("Course_Create_Class_List",
           "How do I create a class list from a spreadsheet");
    my $create_csv_help =
	&Apache::loncommon::help_open_topic("Course_Convert_To_CSV",
           "How do I create a CSV file from a spreadsheet");
    $r->print(<<ENDUPFORM);
<input type=hidden name=phase value=two>
<hr>
<h3>Upload a courselist</h3>
$upfile_select
<p><input type=submit name="fileupload" value="Upload Courselist">
<br />
$create_classlist_help <br />
$create_csv_help

<hr />
<h3>Enroll a single student</h3>
<p><input type=submit name="enroll" value="Enroll Student"></p>
<hr />
<h3>Classlist</h3>
<p><input type=submit name="view" value="View Class List">
<input type=submit name="viewcsv" value="Comma Separated Class List"></p>
<hr />
<h3>Drop students</h3>
<p><input type=submit name="drop" value="Selection List"></p>
ENDUPFORM
}

sub phase_two_header {
    my ($r,$datatoken,$distotal,$krbdefdom)=@_;
    my $javascript;
    if ($ENV{'form.upfile_associate'} eq 'reverse') {
	$javascript=&phase_two_javascript_reverse_associate();
    } else {
	$javascript=&phase_two_javascript_forward_associate();
    }
    my $javascript_validations=&javascript_validations($krbdefdom);
    $r->print(<<ENDPICK);
<h3>Uploading Class List</h3>
<hr>
<h3>Identify fields</h3>
Total number of records found in file: $distotal <hr />
Enter as many fields as you can. The system will inform you and bring you back
to this page if the data selected is insufficient to run your class.<hr />
<input type="button" value="Reverse Association" onClick="javascript:this.form.associate.value='Reverse Association';submit(this.form);" />
<input type="hidden" name="associate"  value="" />
<input type="hidden" name="phase"      value="three" />
<input type="hidden" name="datatoken"  value="$datatoken" />
<input type="hidden" name="fileupload" value="$ENV{'form.fileupload'}" />
<input type="hidden" name="upfiletype" value="$ENV{'form.upfiletype'}" />
<input type="hidden" name="upfile_associate" 
                                       value="$ENV{'form.upfile_associate'}" />
<hr />
<script type="text/javascript" language="Javascript">
$javascript
$javascript_validations
</script>
ENDPICK
}

sub javascript_validations {
    my ($krbdefdom)=@_;
    my %param = ( formname => 'studentform',
                  kerb_def_dom => $krbdefdom );
    my $authheader = &Apache::loncommon::authform_header(%param);
    return (<<ENDPICK);
function verify_message (vf,founduname,foundpwd,foundname,foundid,foundsec) {
    var foundatype=0;
    var message='';
    if (founduname==0) {
	alert('You need to specify the username field');
        return;
    }
    if (current.radiovalue == null || current.radiovalue == 'nochange') {
        // They did not check any of the login radiobuttons.
        alert('You must choose an authentication type');
        return;
    }
    foundatype=1;
    if (current.argfield == null || current.argfield == '') {
        var alertmsg = '';
        switch (current.value) {
            case 'krb': 
                alertmsg = 'You need to specify the Kerberos domain';
                break;
            case 'loc':
            case 'fsys':
                alertmsg = 'You need to specify the initial password';
                break;
            case 'fsys':
                alertmsg = '';
                break;
            default: 
                alertmsg = '';
        }
        if (alertmsg != '') {
            alert(alertmsg);
            return;
        }
    }

    if (foundname==0) { message='No name fields specified. '; }
    if (foundid==0) { message+='No ID or student number field specified. '; }
    if (foundsec==0) { message+='No section or group field specified. '; }
    if (vf.startdate.value=='') {
	message+='No starting date set. ';
    }
    if (vf.enddate.value=='') {
        message+='No ending date set. ';
    }
    if ((vf.enddate.value!='') && (vf.startdate.value!='')) {
       if (Math.round(vf.enddate.value)<Math.round(vf.startdate.value)) {
          alert('Ending date is before starting date');
          return;
       }
    }
    if (message!='') {
       message+='Continue enrollment?';
       if (confirm(message)) {
	  pclose();
	  vf.submit();
       }
    } else {
      pclose();
      vf.submit();
    }
}


    function pclose() {
        parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
                 "height=350,width=350,scrollbars=no,menubar=no");
        parmwin.close();
    }

    function pjump(type,dis,value,marker,ret,call) {
        parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
                 +"&value="+escape(value)+"&marker="+escape(marker)
                 +"&return="+escape(ret)
                 +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
                 "height=350,width=350,scrollbars=no,menubar=no");

    }

    function dateset() {
        if (document.studentform.pres_marker.value=='end') {
           document.studentform.enddate.value=
	       document.studentform.pres_value.value;
        }
        if (document.studentform.pres_marker.value=='start') {
           document.studentform.startdate.value=
	       document.studentform.pres_value.value;
        }
        pclose();
    }

$authheader
ENDPICK

}

sub phase_two_javascript_forward_associate {
    return(<<ENDPICK);
function verify(vf) {
    var founduname=0;
    var foundpwd=0;
    var foundname=0;
    var foundid=0;
    var foundsec=0;
    var tw;
    for (i=0;i<=vf.nfields.value;i++) {
        tw=eval('vf.f'+i+'.selectedIndex');
        if (tw==1) { founduname=1; }
        if ((tw>=2) && (tw<=6)) { foundname=1; }
        if (tw==7) { foundid=1; }
        if (tw==8) { foundsec=1; }
        if (tw==9) { foundpwd=1; }
    }
    verify_message(vf,founduname,foundpwd,foundname,foundid,foundsec);
}

function flip(vf,tf) {
   var nw=eval('vf.f'+tf+'.selectedIndex');
   var i;
   for (i=0;i<=vf.nfields.value;i++) {
      if ((i!=tf) && (eval('vf.f'+i+'.selectedIndex')==nw)) {
          eval('vf.f'+i+'.selectedIndex=0;')
      }
   }
   if (tf==1 && nw!=0) {
      for (i=2;i<=5;i++) {
         eval('vf.f'+i+'.selectedIndex=0;')
      }
   }
   if (nw==2) {
      for (i=0;i<=vf.nfields.value;i++) {
         if ((eval('vf.f'+i+'.selectedIndex')>=3) &&
             (eval('vf.f'+i+'.selectedIndex')<=6)) {
             eval('vf.f'+i+'.selectedIndex=0;')
         }
      }
   }
   if ((nw>=3) && (nw<=6)) {
      for (i=0;i<=vf.nfields.value;i++) {
         if (eval('vf.f'+i+'.selectedIndex')==2) {
             eval('vf.f'+i+'.selectedIndex=0;')
         }
      }
   }
   if (nw==9) {
       changed_radio('int',document.studentform);
       set_auth_radio_buttons('int',document.studentform);
       vf.intarg.value='';
       vf.krbarg.value='';
       vf.locarg.value='';
   }
}

function clearpwd(vf) {
    var i;
    for (i=0;i<=vf.nfields.value;i++) {
        if (eval('vf.f'+i+'.selectedIndex')==9) {
            eval('vf.f'+i+'.selectedIndex=0;')
        }
    }
}

ENDPICK
}

sub phase_two_javascript_reverse_associate {
    return(<<ENDPICK);
function verify(vf) {
    var founduname=0;
    var foundpwd=0;
    var foundname=0;
    var foundid=0;
    var foundsec=0;
    var tw;
    for (i=0;i<=vf.nfields.value;i++) {
        tw=eval('vf.f'+i+'.selectedIndex');
        if (i==0 && tw!=0) { founduname=1; }
        if (((i>=1) && (i<=5)) && tw!=0 ) { foundname=1; }
        if (i==6 && tw!=0) { foundid=1; }
        if (i==7 && tw!=0) { foundsec=1; }
        if (i==8 && tw!=0) { foundpwd=1; }
    }
    verify_message(vf,founduname,foundpwd,foundname,foundid,foundsec);
}

function flip(vf,tf) {
   var nw=eval('vf.f'+tf+'.selectedIndex');
   var i;
   // picked the all one one name field, reset the other name ones to blank
   if (tf==1 && nw!=0) {
      for (i=2;i<=5;i++) {
         eval('vf.f'+i+'.selectedIndex=0;')
      }
   }
   //picked one of the piecewise name fields, reset the all in
   //one field to blank
   if ((tf>=2) && (tf<=5) && (nw!=0)) {
      eval('vf.f1.selectedIndex=0;')
   }
   // intial password specified, pick internal authentication
   if (tf==8 && nw!=0) {
       changed_radio('int',document.studentform);
       set_auth_radio_buttons('int',document.studentform);
       vf.krbarg.value='';
       vf.intarg.value='';
       vf.locarg.value='';
   }
}

function clearpwd(vf) {
    var i;
    if (eval('vf.f8.selectedIndex')!=0) {
        eval('vf.f8.selectedIndex=0;')
    }
}
ENDPICK
}

sub phase_two_end {
    my ($r,$i,$keyfields,$defdom,$today,$halfyear)=@_;
    my %param = ( formname => 'document.studentform');
    my $krbform = &Apache::loncommon::authform_kerberos(%param);
    my $intform = &Apache::loncommon::authform_internal(%param);
    my $locform = &Apache::loncommon::authform_local(%param);
    my $domform = &domain_form($defdom);
    $r->print(<<ENDPICK);
</table>
<input type=hidden name=nfields value=$i>
<input type=hidden name=keyfields value="$keyfields">
<h3>Login Type</h3>
<p>Note: this will not take effect if the user already exists</p>
<p>
$krbform
</p>
<p>
$intform
</p>
<p>
$locform
</p>
<h3>LON-CAPA Domain for Students</h3>
LON-CAPA domain: $domform <p>
<h3>Starting and Ending Dates</h3>
<input type="hidden" value=''          name="pres_value"  >
<input type="hidden" value=''          name="pres_type"   >
<input type="hidden" value=''          name="pres_marker" >
<input type="hidden" value='$today'    name="startdate"   >
<input type="hidden" value='$halfyear' name="enddate"     >
<a 
 href="javascript:pjump('date_start','Enrollment Starting Date',document.studentform.startdate.value,'start','studentform.pres','dateset');"
>Set Starting Date</a><p>

<a 
 href="javascript:pjump('date_end','Enrollment Ending Date',document.studentform.enddate.value,'end','studentform.pres','dateset');"
>Set Ending Date</a><p>
<h3>Full Update</h3>
<input type=checkbox name=fullup value=yes> Full update 
(also print list of users not enrolled anymore)<p>
<h3>ID/Student Number</h3>
<input type=checkbox name=forceid value=yes> 
Disable ID/Student Number Safeguard and Force Change of Conflicting IDs
(only do if you know what you are doing)<p>
<input type="button" onClick="javascript:verify(this.form)" value="Update Courselist" /><br />
Note: for large courses, this operation might be time consuming.
ENDPICK
}

# ======================================================= Menu Phase Two Upload
sub menu_phase_two_upload {
    my $r=shift;

    my $datatoken;
    if (!$ENV{'form.datatoken'}) {
      $datatoken=&Apache::loncommon::upfile_store($r);
    } else {
      $datatoken=$ENV{'form.datatoken'};
      &Apache::loncommon::load_tmp_file($r);
    }
    my @records=&Apache::loncommon::upfile_record_sep();
    my $total=$#records;
    my $distotal=$total+1;
    $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
    my $krbdefdom=$1;
    $krbdefdom=~tr/a-z/A-Z/;
    my $today=time;
    my $halfyear=$today+15552000;
    my $defdom=$r->dir_config('lonDefDomain');
    &phase_two_header($r,$datatoken,$distotal,$krbdefdom);
    my $i;
    my $keyfields;
    if ($total>=0) {
	my @d=(['username','Username'],['names','Last Name, First Names'],
	       ['fname','First Name'],['mname','Middle Names/Initials'],
	       ['lname','Last Name'],['gen','Generation'],
	       ['id','ID/Student Number'],['sec','Group/Section'],
	       ['ipwd','Initial Password']);
	if ($ENV{'form.upfile_associate'} eq 'reverse') {	
	    &Apache::loncommon::csv_print_samples($r,\@records);
	    $i=&Apache::loncommon::csv_print_select_table($r,\@records,\@d);
	    foreach (@d) { $keyfields.=$_->[0].','; }
	    chop($keyfields);
	} else {
	    unshift(@d,['none','']);
	    $i=&Apache::loncommon::csv_samples_select_table($r,\@records,\@d);
	    my %sone=&Apache::loncommon::record_sep($records[0]);
	    $keyfields=join(',',sort(keys(%sone)));
	}
    }
    &phase_two_end($r,$i,$keyfields,$defdom,$today,$halfyear);
}

# ======================================================= Enroll single student
sub enroll_single_student {
    my $r=shift;
    $r->print('<h3>Enrolling Student</h3>');
    $r->print('<p>Enrolling '.$ENV{'form.cuname'}." in domain ".
              $ENV{'form.lcdomain'}.'</p>');
    if (($ENV{'form.cuname'})&&($ENV{'form.cuname'}!~/\W/)&&
        ($ENV{'form.lcdomain'})&&($ENV{'form.lcdomain'}!~/\W/)) {
        # Deal with home server selection
        my $domain=$ENV{'form.lcdomain'};
        my $desiredhost = $ENV{'form.lcserver'};
        if (lc($desiredhost) eq 'default') {
            $desiredhost = undef;
        } else {
            my %home_servers =&Apache::loncommon::get_library_servers($domain);
            if (! exists($home_servers{$desiredhost})) {
                $r->print('<font color="#ff0000">Error:</font>'.
                          'Invalid home server specified');
                return;
            }
        }
        $r->print(" with server $desiredhost :") if (defined($desiredhost));
        # End of home server selection logic
	my $amode='';
        my $genpwd='';
        if ($ENV{'form.login'} eq 'krb') {
           $amode='krb';
	   $amode.=$ENV{'form.krbver'};
           $genpwd=$ENV{'form.krbarg'};
        } elsif ($ENV{'form.login'} eq 'int') {
           $amode='internal';
           $genpwd=$ENV{'form.intarg'};
        }  elsif ($ENV{'form.login'} eq 'loc') {
	    $amode='localauth';
	    $genpwd=$ENV{'form.locarg'};
	    if (!$genpwd) { $genpwd=" "; }
	}
        my $home = &Apache::lonnet::homeserver($ENV{'form.cuname'},
                                                   $ENV{'form.lcdomain'});
        if ((($amode) && ($genpwd)) || ($home ne 'no_host')) {
            &modifystudent($ENV{'form.lcdomain'},$ENV{'form.cuname'},
                           $ENV{'request.course.id'},$ENV{'form.csec'},
                            $desiredhost);
          $r->print(&Apache::lonnet::modifystudent(
                      $ENV{'form.lcdomain'},$ENV{'form.cuname'},
                      $ENV{'form.cstid'},$amode,$genpwd,
 	              $ENV{'form.cfirst'},$ENV{'form.cmiddle'},
                      $ENV{'form.clast'},$ENV{'form.cgen'},
                      $ENV{'form.csec'},$ENV{'form.enddate'},
                      $ENV{'form.startdate'},$ENV{'form.forceid'},
                    $desiredhost));
	} else {
            $r->print('<p><font color="#ff0000">ERROR</font>&nbsp;'.
                      'Invalid login mode or password.  '.
                      'Unable to enroll '.$ENV{'form.cuname'}.'.</p>');
        }          
    } else {
        $r->print('Invalid username or domain');
    }    
}

# ======================================================= Menu Phase Two Enroll
sub menu_phase_two_enroll {
    my $r=shift;
    $r->print("<h3>Enroll One Student</h3>");
    my ($krbdefdom) = $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
    $krbdefdom=~tr/a-z/A-Z/;
    my $today    = time;
    my $halfyear = $today+15552000;
    my $defdom=$r->dir_config('lonDefDomain');
    my $javascript_validations=&javascript_validations($krbdefdom);
    # Set up authentication forms
    my %param = ( formname => 'document.studentform');
    my $krbform = &Apache::loncommon::authform_kerberos(%param);
    my $intform = &Apache::loncommon::authform_internal(%param);
    my $locform = &Apache::loncommon::authform_local(%param);
    # Set up domain selection form
    my $domform = &domain_form($defdom);
    # Print it all out
    $r->print(<<ENDSENROLL);
<script type="text/javascript" language="Javascript">
function verify(vf) {
    var founduname=0;
    var foundpwd=0;
    var foundname=0;
    var foundid=0;
    var foundsec=0;
    var tw;
    if ((typeof(vf.cuname.value) !="undefined") && (vf.cuname.value!='') && 
	(typeof(vf.lcdomain.value)!="undefined") && (vf.lcdomain.value!='')) {
        founduname=1;
    }
    if ((typeof(vf.cfirst.value)!="undefined") && (vf.cfirst.value!='') &&
	(typeof(vf.clast.value) !="undefined") && (vf.clast.value!='')) {
        foundname=1;
    }
    if ((typeof(vf.csec.value)!="undefined") && (vf.csec.value!='')) {
        foundsec=1;
    }
    if ((typeof(vf.cstid.value)!="undefined") && (vf.cstid.value!='')) {
	foundid=1;
    }
    if (founduname==0) {
	alert('You need to specify at least the username and domain fields');
        return;
    }
    verify_message(vf,founduname,foundpwd,foundname,foundid,foundsec);
}

$javascript_validations

function clearpwd(vf) {
    //nothing else needs clearing
}

</script>
<h3>Personal Data</h3>
First Name:  <input type="text" name="cfirst"  size="15"><br>
Middle Name: <input type="text" name="cmiddle" size="15"><br>
Last Name:   <input type="text" name="clast"   size="15"><br>
Generation:  <input type="text" name="cgen"    size="5"> 

<p>ID/Student Number: <input type="text" name="cstid" size="10"></p>

<p>Group/Section: <input type=text name=csec size=5></p>

<h3>Login Data</h3>
<p>Username: <input type="text" name="cuname"  size="15"></p>
<p>Domain:   $domform</p>
<p>Note: login settings below  will not take effect if the user already exists
</p><p>
$krbform
</p><p>
$intform
</p><p>
$locform
</p><p>
<h3>Starting and Ending Dates</h3>
<input type="hidden" value='' name="pres_value">
<input type="hidden" value='' name="pres_type">
<input type="hidden" value='' name="pres_marker">
<input type="hidden" value='$today' name=startdate>
<input type="hidden" value='$halfyear' name=enddate>
</p><p>
<a 
 href="javascript:pjump('date_start','Enrollment Starting Date',document.studentform.startdate.value,'start','studentform.pres','dateset');"
>Set Starting Date</a>
</p><p>
<a 
 href="javascript:pjump('date_end','Enrollment Ending Date',document.studentform.enddate.value,'end','studentform.pres','dateset');"
>Set Ending Date</a>
</p><p>
<h3>ID/Student Number</h3>
<input type="checkbox" name="forceid" value="yes"> 
Disable ID/Student Number Safeguard and Force Change of Conflicting IDs
(only do if you know what you are doing)<p>
<input type="button" onClick="verify(this.form)" value="Enroll as student"><br>
<input type="hidden" name="phase" value="five">
</p>
ENDSENROLL
}

# =================================================== get the current classlist
sub get_current_classlist {
    my ($domain,$identifier) = @_;
    # domain is the domain the class is being run in
    # identifier is the internal, unique identifier for the class.
    my %currentlist=();
    my $now=time;
    my %results=&Apache::lonnet::dump('classlist',$domain,$identifier);
    my ($tmp) = keys(%results);
    if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
        foreach my $student (keys(%results)) {
            # Extract the start and end dates
            my ($end,$start)=split(/\:/,$results{$student});
            # If the class isn't over, put it in the list
            unless (($end) && ($now>$end)) { 
                $currentlist{$student}=1;
            }
        }
        return (undef,%currentlist);
    } else {
        $tmp =~ s/^error://;
        return ($tmp,undef);
    }
}

# ========================================================= Menu Phase Two Drop
sub menu_phase_two_drop {
    my $r=shift;
    $r->print("<h3>Drop Students</h3>");
    my $cid=$ENV{'request.course.id'};
    my ($error,%currentlist)=&get_current_classlist
        ($ENV{'course.'.$cid.'.domain'},$ENV{'course.'.$cid.'.num'});
    if (defined($error)) {
        if ($error =~ /^No such file or directory/) {
            $r->print("There are no students currently enrolled.\n");
        } else {
            $r->print("<pre>ERROR:$error</pre>");
        }
    } elsif (!defined(%currentlist)) { 
        $r->print("There are no students currently enrolled.\n");
    } else {
        # Print out the available choices
        &show_drop_list($r,%currentlist);
    }
}

# ============================================== view classlist
sub menu_phase_two_view {
    my $r=shift;
    $r->print("<h3>Current Classlist</h3>");
    my $cid=$ENV{'request.course.id'};
    my ($error,%currentlist)=&get_current_classlist
        ($ENV{'course.'.$cid.'.domain'},$ENV{'course.'.$cid.'.num'});
    if (defined($error)) {
        if ($error =~ /^No such file or directory/) {
            $r->print("There are no students currently enrolled.\n");
        } else {
            $r->print("<pre>ERROR:$error</pre>");
        }
    } elsif (!defined(%currentlist)) { 
        $r->print("There are no students currently enrolled.\n");
    } else {
        # Print out the available choices
        &show_class_list($r,'view',%currentlist);
    }
}

# ============================================== view classlist
sub menu_phase_two_viewcsv {
    my $r=shift;
    my $cid=$ENV{'request.course.id'};
    my ($error,%currentlist)=&get_current_classlist
        ($ENV{'course.'.$cid.'.domain'},$ENV{'course.'.$cid.'.num'});
    if (defined($error)) {
        if ($error =~ /^No such file or directory/) {
            $r->print("There are no students currently enrolled.\n");
        } else {
            $r->print("<pre>ERROR:$error</pre>");
        }
    } elsif (!defined(%currentlist)) { 
        $r->print("There are no students currently enrolled.\n");
    } else {
        &show_class_list($r,'csv',%currentlist);
    }
}

# =================================================== Show student list to drop
sub show_class_list {
    my ($r,$mode,%currentlist)=@_;
    my $cid=$ENV{'request.course.id'};
    # Print out header 
    if ($mode eq 'view') {
        $r->print(<<END);
<p>
<table border=2>
<tr><th>username</th><th>domain</th><th>ID</th>
    <th>student name</th><th>generation</th><th>section</th></tr>
END
    } elsif ($mode eq 'csv') {
        $r->print(<<END);
username,domain,ID,last name,first name,middle name,generation,section
END
    }
    foreach (sort keys %currentlist) {
        my ($sname,$sdom)=split(/\:/,$_);
        my %reply=&Apache::lonnet::idrget($sdom,$sname);
        my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);
        my %info=&Apache::lonnet::get('environment',
                                      ['firstname','middlename',
                                       'lastname','generation'],
                                      $sdom, $sname);
        my ($tmp) = keys(%info);
        if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
            $r->print( ($mode eq 'view' ? 
                       '<tr><td colspan="6"><font color="red">' :'').
                       'Internal error: unable to get environment '.
                       'for '.$sname.' in domain '.$sdom.
                       ( $mode eq 'view' ?'</font></td></tr>' :''));
        } else {
            if ($mode eq 'view') {
                $r->print(<<"END");
<tr>
    <td>$sname</td>
    <td>$sdom</td>
    <td>$reply{$sname}</td>
    <td>$info{'lastname'}, $info{'firstname'} $info{'middlename'}</td>
    <td>$info{'generation'}</td>
    <td>$ssec</td>
</tr>
END
            } elsif ($mode eq 'csv') {
                my @line = ();
                foreach ($sname,$sdom,$reply{$sname},
                         $info{'lastname'},$info{'firstname'},
                         $info{'middlename'},$info{'generation'},$ssec) {
                    push @line,&Apache::loncommon::csv_translate($_);
                }
                my $tmp = $";
                $" = '","';
                $r->print("\"@line\"\n");
                $" = $tmp;
            }
        }
    }
    $r->print('</table><br>') if ($mode eq 'view');
}

# =================================================== Show student list to drop
sub show_drop_list {
    my ($r,%currentlist)=@_;
    my $cid=$ENV{'request.course.id'};
    $r->print(<<'END');
<script>
function checkAll(field)
{
    for (i = 0; i < field.length; i++)
        field[i].checked = true ;
}

function uncheckAll(field)
{
    for (i = 0; i < field.length; i++)
        field[i].checked = false ;
}
</script>
<p>
<input type="hidden" name="phase" value="four">
<table border=2>
<tr><th>&nbsp;</th><th>username</th><th>domain</th>
<th>ID</th><th>student name</th><th>generation</th>
<th>section</th></tr>
END
    foreach (sort keys %currentlist) {
        my ($sname,$sdom)=split(/\:/,$_);
        my %reply=&Apache::lonnet::idrget($sdom,$sname);
        my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);
        my %info=&Apache::lonnet::get('environment',
                                      ['firstname','middlename',
                                       'lastname','generation'],
                                      $sdom, $sname);
        my ($tmp) = keys(%info);
        if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
            $r->print('<tr><td colspan="7"><font color="red">'.
                      'Internal error: unable to get environment '.
                      'for '.$sname.' in domain '.$sdom.'</font></td></tr>');
        } else {
            $r->print(<<"END");
<tr>
    <td><input type="checkbox" name="droplist" value="$_"></td>
    <td>$sname</td>
    <td>$sdom</td>
    <td>$reply{$sname}</td>
    <td>$info{'lastname'}, $info{'firstname'} $info{'middlename'}</td>
    <td>$info{'generation'}</td>
    <td>$ssec</td>
</tr>
END
        }
    }
    $r->print('</table><br>');
    $r->print(<<"END");
</p><p>
<input type="button" value="check all" onclick="javascript:checkAll(document.studentform.droplist)"> &nbsp;
<input type="button" value="uncheck all" onclick="javascript:uncheckAll(document.studentform.droplist)"> 
<p><input type=submit value="Drop Students"></p>
END
}

# ================================================= Drop/Add from uploaded file
sub upfile_drop_add {
    my $r=shift;
    &Apache::loncommon::load_tmp_file($r);
    my @studentdata=&Apache::loncommon::upfile_record_sep();
    my @keyfields = split(/\,/,$ENV{'form.keyfields'});
    my $cid = $ENV{'request.course.id'};
    my %fields=();
    for (my $i=0; $i<=$ENV{'form.nfields'}; $i++) {
        if ($ENV{'form.upfile_associate'} eq 'reverse') {
            if ($ENV{'form.f'.$i} ne 'none') {
                $fields{$keyfields[$i]}=$ENV{'form.f'.$i};
            }
        } else {
            $fields{$ENV{'form.f'.$i}}=$keyfields[$i];
        }
    }
    #
    my $startdate = $ENV{'form.startdate'};
    my $enddate   = $ENV{'form.enddate'};
    if ($startdate=~/\D/) { $startdate=''; }
    if ($enddate=~/\D/)   { $enddate=''; }
    # Determine domain and desired host (home server)
    my $domain=$ENV{'form.lcdomain'};
    my $desiredhost = $ENV{'form.lcserver'};
    if (lc($desiredhost) eq 'default') {
        $desiredhost = undef;
    } else {
        my %home_servers = &Apache::loncommon::get_library_servers($domain);
        if (! exists($home_servers{$desiredhost})) {
            $r->print('<font color="#ff0000">Error:</font>'.
                      'Invalid home server specified');
            return;
        }
    }
    # Determine authentication mechanism
    my $amode  = '';
    my $genpwd = '';
    if ($ENV{'form.login'} eq 'krb') {
        $amode='krb';
	$amode.=$ENV{'form.krbver'};
        $genpwd=$ENV{'form.krbarg'};
    } elsif ($ENV{'form.login'} eq 'int') {
        $amode='internal';
        if ((defined($ENV{'form.intarg'})) && ($ENV{'form.intarg'})) {
            $genpwd=$ENV{'form.intarg'};
        }
    } elsif ($ENV{'form.login'} eq 'loc') {
        $amode='localauth';
        if ((defined($ENV{'form.locarg'})) && ($ENV{'form.locarg'})) {
            $genpwd=$ENV{'form.locarg'};
        }
    }
    unless (($domain=~/\W/) || ($amode eq '')) {
        #######################################
        ##         Enroll Students           ##
        #######################################
        $r->print('<h3>Enrolling Students</h3>');
        my $count=0;
        my $flushc=0;
        my %student=();
        # Get new classlist
        foreach (@studentdata) {
            my %entries=&Apache::loncommon::record_sep($_);
            # Determine student name
            unless (($entries{$fields{'username'}} eq '') ||
                    (!defined($entries{$fields{'username'}}))) {
                my ($fname, $mname, $lname,$gen) = ('','','','');
                if (defined($fields{'names'})) {
                    ($lname,$fname,$mname)=($entries{$fields{'names'}}=~
                                            /([^\,]+)\,\s*(\w+)\s*(.*)$/);
                } else {
                    if (defined($fields{'fname'})) {
                        $fname=$entries{$fields{'fname'}};
                    }
                    if (defined($fields{'mname'})) {
                        $mname=$entries{$fields{'mname'}};
                    }
                    if (defined($fields{'lname'})) {
                        $lname=$entries{$fields{'lname'}};
                    }
                    if (defined($fields{'gen'})) {
                        $gen=$entries{$fields{'gen'}};
                    }
                }
                if ($entries{$fields{'username'}}=~/\W/) {
                    $r->print('<p><b>Unacceptable username: '.
                              $entries{$fields{'username'}}.' for user '.
                              $fname.' '.$mname.' '.$lname.' '.$gen.'</b><p>');
                } else {
                    # determine section number
                    my $sec='';
                    my $username=$entries{$fields{'username'}};
                    if (defined($fields{'sec'})) {
                        if (defined($entries{$fields{'sec'}})) {
                            $sec=$entries{$fields{'sec'}};
                        }
                    }
                    # determine student id number
                    my $id='';
                    if (defined($fields{'id'})) {
                        if (defined($entries{$fields{'id'}})) {
                            $id=$entries{$fields{'id'}};
                        }
                        $id=~tr/A-Z/a-z/;
                    }
                    # determine student password
                    my $password='';
                    if ($genpwd) { 
                        $password=$genpwd; 
                    } else {
                        if (defined($fields{'ipwd'})) {
                            if ($entries{$fields{'ipwd'}}) {
                                $password=$entries{$fields{'ipwd'}};
                            }
                        }
                    }
                    if ($password) {
                        &modifystudent($domain,$username,$cid,$sec,
                                       $desiredhost);
                        my $reply=&Apache::lonnet::modifystudent
                            ($domain,$username,$id,$amode,$password,
                             $fname,$mname,$lname,$gen,$sec,$enddate,
                             $startdate,$ENV{'form.forceid'},$desiredhost);
                        if ($reply ne 'ok') {
                            $r->print('<p><b>'.
                                      'Error enrolling '.$username.': '.
                                      $reply.'</b></p>');
         		} else {
                            $count++; $flushc++;
                            $student{$username}=1;
                            $r->print('. ');
                            if ($flushc>15) {
				$r->rflush;
                                $flushc=0;
                            }
                        }
                    } else {
                        $r->print("<p><b>No password for $username</b><p>");
                    }
                }
            }
        } # end of foreach (@studentdata)
        $r->print('<p>Processed Students: '.$count);
        #####################################
        #           Drop students           #
        #####################################
        if ($ENV{'form.fullup'} eq 'yes') {
            $r->print('<h3>Dropping Students</h3>');
            #  Get current classlist
            my ($error,%currentlist)=&get_current_classlist
                ($ENV{'course.'.$cid.'.domain'},
                 $ENV{'course.'.$cid.'.num'});
            if (defined($error)) {
                $r->print('<pre>ERROR:$error</pre>');
            }
            if (defined(%currentlist)) {
                # Drop the students
                foreach (@studentdata) {
                    my %entries=&Apache::loncommon::record_sep($_);
                    unless (($entries{$fields{'username'}} eq '') ||
                            (!defined($entries{$fields{'username'}}))) {
                        delete($currentlist{$entries{$fields{'username'}}.
                                                ':'.$domain});
                    }
                }
                # Print out list of dropped students
                &show_drop_list($r,%currentlist);
            } else {
                $r->print("There are no students currently enrolled.\n");
            }
        }
    } # end of unless
}

# ================================================================== Phase four
sub drop_student_list {
    my $r=shift;
    my $count=0;
    my @droplist;
    if (ref($ENV{'form.droplist'})) {
        @droplist = @{$ENV{'form.droplist'}};
    } else {
        @droplist = ($ENV{'form.droplist'});
    }
    foreach (@droplist) {
        my ($uname,$udom)=split(/\:/,$_);
        my $result = &modifystudent($udom,$uname,$ENV{'request.course.id'});
        if ($result eq 'ok' || $result eq 'ok:') {
            $r->print('Dropped '.$uname.' at '.$udom.'<br>');
        } else {
            $r->print('Error dropping '.$uname.' at '.$udom.': '.$result.
                      '<br />');
        }
        $count++;
    }
    $r->print('<p><b>Dropped '.$count.' student(s).</b>');
    $r->print('<p>Re-enrollment will re-activate data.');
}

# ================================================================ Main Handler
sub handler {
    my $r=shift;
    if ($r->header_only) {
        $r->content_type('text/html');
        $r->send_http_header;
        return OK;
    }
    #  Needs to be in a course
    if (($ENV{'request.course.fn'}) && 
        (&Apache::lonnet::allowed('cst',$ENV{'request.course.id'}))) {
        # Start page
        $r->content_type('text/html') if (! exists($ENV{'form.viewcsv'}));
        $r->send_http_header;
        $r->print(&header()) if (! exists($ENV{'form.viewcsv'}));
        # Phase one, initial screen
        unless ($ENV{'form.phase'}) {
            &menu_phase_one($r);
        }
        # Phase two
        if ($ENV{'form.associate'} eq 'Reverse Association') {
            $ENV{'form.phase'} = 'two';
            if ( $ENV{'form.upfile_associate'} ne 'reverse' ) {
                $ENV{'form.upfile_associate'} = 'reverse';
            } else {
                $ENV{'form.upfile_associate'} = 'forward';
            }
        }
        if ($ENV{'form.phase'} eq 'two') {
            if ($ENV{'form.fileupload'}) {
                &menu_phase_two_upload($r);
            } elsif ($ENV{'form.enroll'}) {
                &menu_phase_two_enroll($r);
            } elsif ($ENV{'form.drop'}) {
                &menu_phase_two_drop($r);
            } elsif ($ENV{'form.view'}) {
                &menu_phase_two_view($r);
            } elsif ($ENV{'form.viewcsv'}) {
                &menu_phase_two_viewcsv($r);
            }
        }
        # Phase three
        if ($ENV{'form.phase'} eq 'three') {
            if ($ENV{'form.datatoken'}) {
                &upfile_drop_add($r);
            }
        }
        # Phase four
        if ($ENV{'form.phase'} eq 'four') {
            &drop_student_list($r);
        }
        # Phase five
        if ($ENV{'form.phase'} eq 'five') {
            &enroll_single_student($r);
        }
         # End
        $r->print('</form></body></html>') if (! exists($ENV{'form.viewcsv'}));
    } else {
        # Not in a course, or not allowed to modify parms
        $ENV{'user.error.msg'}=
            "/adm/dropadd:cst:0:0:Cannot drop or add students";
        return HTTP_NOT_ACCEPTABLE; 
    }
    return OK;
}

1;
__END__


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>