loncom/interface/lonmanagekeys.pm - view

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, 6 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__

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.