File:  [LON-CAPA] / loncom / interface / lonmanagekeys.pm
Revision 1.21: download - view: text, annotated - select for diffs
Tue Dec 5 02:55:53 2006 UTC (17 years, 3 months ago) by albertel
Branches: MAIN
CVS tags: version_2_4_X, version_2_4_2, version_2_4_1, version_2_4_0, version_2_3_X, version_2_3_99_0, version_2_3_2, version_2_3_1, version_2_3_0, version_2_2_99_1, version_2_2_99_0, HEAD
- lots of \w -> probper regexp replacements

# The LearningOnline Network with CAPA
# Handler to manage course access keys 
#
# $Id: lonmanagekeys.pm,v 1.21 2006/12/05 02:55:53 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/
#
###############################################################
###############################################################

package Apache::lonmanagekeys;

use strict;
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonhtmlcommon();
use Apache::Constants qw(:common :http REDIRECT);
use Spreadsheet::WriteExcel;
use Apache::lonlocal;

###############################################################
###############################################################
sub header {
    my $start_page=&Apache::loncommon::start_page('Access Key Management');
    return(<<ENDHEAD);
$start_page
<form method="post" enctype="multipart/form-data"  
      action="/adm/managekeys" name="keyform">
ENDHEAD
}

# =================================================== Show student list to drop
sub show_key_list {
    my ($r,$csvlist,$comment,$newonly,$checkonly,%cenv)=@_;
    $comment=~s/\W/\./g;
    my %accesskeys=&Apache::lonnet::dump
	('accesskeys',$cenv{'domain'},$cenv{'num'});
    unless ($csvlist) {
	$r->print(<<ENDTABLEHEADER);
<script>
    function copyallcom(tf) {
	for (i=0; i<tf.elements.length; i++) {
            if  (tf.elements[i].name.indexOf('com_')==0) {
	      tf.elements[i].value+=tf.copyall.value;
            }
        }

    }
</script>
<h3>List of Keys/Enter New Comments</h3>
<table border="2"><tr><th>Key</th><th>Checked Out</th>
<th>Comments/Remarks/Notes</th>
<th>Enter Additional Comments/Remarks/Notes<br />
<input type="text" size="40" name="copyall" />
<input type="button" value="Copy to All" onClick="copyallcom(this.form);" />
</th></tr>
ENDTABLEHEADER
    }
    foreach (keys %accesskeys) {
        if ($_=~/^error\:/) {
	    $r->print('<tr><td>No keys have been generated yet.</td></tr>');
        } elsif ($accesskeys{$_}=~/$comment/) {
	    my ($checkout,$com)=split(/\s*\#\s*/,$accesskeys{$_});
            unless ($checkout) {
		if ($checkonly) { next; }
            } else {
		if ($newonly) { next; }
            }
            unless ($csvlist) {
		$r->print("\n<tr><td><tt>".$_.'</tt></td><td>'.($checkout?
                     $checkout:'-').'</td><td>'.
                     join('<br />',split(/\s*\;\s*/,$com)).
		     '</td><td><input type="text" size="40" name="com_'.$_.
		     '" value="" /></td></tr>');
	    } else {
		my @line = ();
		push @line,&Apache::loncommon::csv_translate($_);
		push @line,&Apache::loncommon::csv_translate($checkout);
		foreach (split(/\s*\;\s*/,$com)) {
 		   push @line,&Apache::loncommon::csv_translate($_);
		}
		my $tmp = $";
		$" = '","';
		$r->print("\"@line\"\n");
		$" = $tmp;
	    }
       }
    }
    unless ($csvlist) {
	$r->print('</table>');
	$r->print('<input type="submit" name="addcom" value="Add Above Comments to Keys" /><hr />');
    }
    return '';
}


# ----------------------------------------------------------- Toggle Key Access

sub togglekeyaccess {
    my %cenv=@_;
    unless ($cenv{'domain'}) { return; }
    if ($cenv{'keyaccess'} eq 'yes') {
       return 'Removing key access: '.
       &Apache::lonnet::del('environment',['keyaccess'],
			    $cenv{'domain'},$cenv{'num'});
   } else {
      return 'Establishing key access: '.
       &Apache::lonnet::put('environment',{'keyaccess' => 'yes'},
			    $cenv{'domain'},$cenv{'num'});
    }
}

# --------------------------------------------------------------- Generate Keys

sub genkeys {
    my ($num,$comments,%cenv)=@_;
    unless ($comments) { $comments=''; }
    $comments=~s/\#/ /g;
    $comments=~s/\;/ /g;
    unless ($num) { return 'No number of keys given.'; }
    unless (($num=~/^\d+$/) && ($num>0)) { 
	return 'Invalid number of keys given.'; 
    }
    my $batchnumber='BATCH_'.time().'_'.$$;
    return 'Generated '.&Apache::lonnet::generate_access_keys
    ($num,$cenv{'domain'},$cenv{'num'},$batchnumber.'; '.$comments).' of '.
    $num.' access keys (Batch Number: '.$batchnumber.')',$batchnumber;
}

# ---------------------------------------------------------------- Add comments

sub addcom {
    my %cenv=@_;
    my %newcomment=();
    undef %newcomment;
    foreach (keys %env) {
	if ($_=~/^form\.com\_(.+)$/) {
            my $key=$1;
	    my $comment=$env{$_};
            $comment=~s/^\s+//gs;
            if ($comment) {
               &Apache::lonnet::comment_access_key
		   ($key,$cenv{'domain'},$cenv{'num'},$comment); 
	   }
	}
    }
    return '';
}
###################################################################
###################################################################
sub handler {
    my $r=shift;
    if ($r->header_only) {
        &Apache::loncommon::content_type($r,'text/html');
        $r->send_http_header;
        return OK;
    }
    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
					    ['state','cid']);
    if (($env{'form.domain'}) && ($env{'form.course'})) {
	$env{'form.cid'}=$env{'form.domain'}.'_'.$env{'form.course'};
    }

    unless (&Apache::lonnet::allowed('mky',$env{'request.role.domain'})) {
        $env{'user.error.msg'}=
            "/adm/managekeys:mky:0:0:Cannot manage access keys";
        return HTTP_NOT_ACCEPTABLE; 
    }
    if ($env{'form.cid'}) {
	my %cenv=&Apache::lonnet::coursedescription($env{'form.cid'});
	my $keytype='';
	if ($cenv{'url'} eq '/res/') {
	    ($cenv{'domain'},$cenv{'num'})=split(/\_/,$env{'form.cid'});
	    $keytype='auth';
	} elsif ($cenv{'keyauth'}) {
	    ($cenv{'num'},$cenv{'domain'})=split(/:/,$cenv{'keyauth'});
	    $keytype='auth';
	} else {
	    $keytype='course';
	}
  	if ($env{'form.listkeyscsv'}) {
#
# CSV Output
#
	    $r->content_type('text/csv');
            $r->send_http_header;
#
# Do CSV
#
	    &show_key_list($r,1,$env{'form.listcom'},
                          $env{'form.newonly'},$env{'form.checkonly'},%cenv);

	} else {
#
# Normal web stuff
#
	    &Apache::loncommon::content_type($r,'text/html');
	    $r->send_http_header;
	    $r->print(&header());
	
	    $r->print(
	    '<input type="hidden" name="cid" value="'.$env{'form.cid'}.'" />');
# --- Actions
	    if ($env{'form.toggle'}) {
		$r->print(&togglekeyaccess(%cenv).'<br />');
		%cenv=&Apache::lonnet::coursedescription($env{'form.cid'},
							 {'freshen_cache'=> 1});
	    }
            my $batchnumber='';
	    if ($env{'form.genkeys'}) {
		(my $msg,$batchnumber)=
		    &genkeys($env{'form.num'},$env{'form.comments'},%cenv);
                $r->print($msg.'<br />');
	    }
            if ($env{'form.listkeys'}) {
		&show_key_list($r,0,$env{'form.listcom'},
                          $env{'form.newonly'},$env{'form.checkonly'},%cenv);
            }
            if ($env{'form.addcom'}) {
		&addcom(%cenv);
            }
# --- Menu
	    if ($keytype eq 'course') {
		$r->print('<h3>'.&mt('Key Access').'</h3>');
		if ($cenv{'keyaccess'} eq 'yes') {
		    $r->print(&mt('Access to this course is key controlled.').
'<br /><input type="submit" name="toggle" value="'.&mt('Open Access').'" />')
		} else {
		    $r->print(&mt('Access to this course is open, no access keys').'<br /><input type="submit" name="toggle" value="'.&mt('Control Access').'" />');
		}
	    } else {
		$r->print('<h3>'.&mt('Key Authority').
			  ' <tt>'.$cenv{'num'}.'@'.$cenv{'domain'}.'</tt></h3>');
	    }
	    $r->print(<<ENDKEYMENU);
<hr /><h3>Generate New Keys</h3>
Number of keys to be generated: <input type="text" name="num" size="6" /><br />
Comments/Remarks/Notes: <input type="text" name="comments" size="30" /><br />
<input type="submit" name="genkeys" value="Generate Keys" />
<hr /><h3>List Keys</h3>
Comments/Remarks/Notes/User/Batch Number Filter:
<input type="text" name="listcom" size="30" value="$batchnumber" /><br />
<input type="checkbox" name="newonly" /> Unused keys only<br />
<input type="checkbox" name="checkonly" /> Used keys only<br />
<input type="submit" name="listkeys" value="List Keys/Add Comments" />
<input type="submit" name="listkeyscsv" value="CSV List of Keys" />
ENDKEYMENU
	    $r->print('</form>'.&Apache::loncommon::end_page());
	}
    } else {
	# Start page no course id
	&Apache::loncommon::content_type($r,'text/html');
	$r->send_http_header;
	$r->print(&header().&Apache::loncommon::coursebrowser_javascript());
        $r->print(
   &mt('Course ID of Key Authority').': <input input type="text" size="25" name="course" value="" />');
        $r->print(&mt('Domain').': '.&Apache::loncommon::select_dom_form(
               $env{'request.role.domain'},'domain'));
        $r->print(&Apache::loncommon::selectcourse_link(
					        'keyform','course','domain',
                                                undef,undef,undef,'Course'));
        $r->print('<br /><input type="submit" value="'.&mt('Manage Access Keys').'" />');
	$r->print('</form>'.&Apache::loncommon::end_page());
    }
    return OK;
}

###################################################################
###################################################################

1;
__END__



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