Annotation of loncom/interface/lonmanagekeys.pm, revision 1.26
1.1 www 1: # The LearningOnline Network with CAPA
2: # Handler to manage course access keys
3: #
1.26 ! bisitz 4: # $Id: lonmanagekeys.pm,v 1.25 2009/10/29 14:23:23 bisitz Exp $
1.1 www 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: ###############################################################
29: ###############################################################
30:
31: package Apache::lonmanagekeys;
32:
33: use strict;
1.17 albertel 34: use Apache::lonnet;
1.1 www 35: use Apache::loncommon();
36: use Apache::lonhtmlcommon();
37: use Apache::Constants qw(:common :http REDIRECT);
38: use Spreadsheet::WriteExcel;
1.12 www 39: use Apache::lonlocal;
1.1 www 40:
41: ###############################################################
42: ###############################################################
43: sub header {
1.25 bisitz 44: # Breadcrumbs
45: my $brcrum = [{'href' => '/adm/managekeys',
46: 'text' => 'Access Key Management'}];
47:
48: my $start_page=&Apache::loncommon::start_page('Access Key Management',
49: undef,
50: {'bread_crumbs' => $brcrum,});
1.1 www 51: return(<<ENDHEAD);
1.18 albertel 52: $start_page
1.1 www 53: <form method="post" enctype="multipart/form-data"
1.2 www 54: action="/adm/managekeys" name="keyform">
1.1 www 55: ENDHEAD
56: }
57:
58: # =================================================== Show student list to drop
59: sub show_key_list {
1.11 www 60: my ($r,$csvlist,$comment,$newonly,$checkonly,%cenv)=@_;
1.7 www 61: $comment=~s/\W/\./g;
1.6 www 62: my %accesskeys=&Apache::lonnet::dump
63: ('accesskeys',$cenv{'domain'},$cenv{'num'});
1.11 www 64: unless ($csvlist) {
65: $r->print(<<ENDTABLEHEADER);
1.10 www 66: <script>
67: function copyallcom(tf) {
68: for (i=0; i<tf.elements.length; i++) {
69: if (tf.elements[i].name.indexOf('com_')==0) {
70: tf.elements[i].value+=tf.copyall.value;
71: }
72: }
73:
74: }
75: </script>
76: <h3>List of Keys/Enter New Comments</h3>
77: <table border="2"><tr><th>Key</th><th>Checked Out</th>
78: <th>Comments/Remarks/Notes</th>
79: <th>Enter Additional Comments/Remarks/Notes<br />
80: <input type="text" size="40" name="copyall" />
1.26 ! bisitz 81: <input type="button" value="Copy to All" onclick="copyallcom(this.form);" />
1.10 www 82: </th></tr>
83: ENDTABLEHEADER
1.11 www 84: }
1.6 www 85: foreach (keys %accesskeys) {
1.7 www 86: if ($_=~/^error\:/) {
87: $r->print('<tr><td>No keys have been generated yet.</td></tr>');
88: } elsif ($accesskeys{$_}=~/$comment/) {
89: my ($checkout,$com)=split(/\s*\#\s*/,$accesskeys{$_});
90: unless ($checkout) {
91: if ($checkonly) { next; }
92: } else {
93: if ($newonly) { next; }
94: }
1.11 www 95: unless ($csvlist) {
96: $r->print("\n<tr><td><tt>".$_.'</tt></td><td>'.($checkout?
1.7 www 97: $checkout:'-').'</td><td>'.
1.8 www 98: join('<br />',split(/\s*\;\s*/,$com)).
1.9 www 99: '</td><td><input type="text" size="40" name="com_'.$_.
1.10 www 100: '" value="" /></td></tr>');
1.11 www 101: } else {
102: my @line = ();
103: push @line,&Apache::loncommon::csv_translate($_);
104: push @line,&Apache::loncommon::csv_translate($checkout);
105: foreach (split(/\s*\;\s*/,$com)) {
106: push @line,&Apache::loncommon::csv_translate($_);
107: }
108: my $tmp = $";
109: $" = '","';
110: $r->print("\"@line\"\n");
111: $" = $tmp;
112: }
1.7 www 113: }
1.6 www 114: }
1.11 www 115: unless ($csvlist) {
116: $r->print('</table>');
117: $r->print('<input type="submit" name="addcom" value="Add Above Comments to Keys" /><hr />');
118: }
1.6 www 119: return '';
1.2 www 120: }
121:
122:
123: # ----------------------------------------------------------- Toggle Key Access
124:
125: sub togglekeyaccess {
126: my %cenv=@_;
127: unless ($cenv{'domain'}) { return; }
128: if ($cenv{'keyaccess'} eq 'yes') {
1.3 www 129: return 'Removing key access: '.
1.2 www 130: &Apache::lonnet::del('environment',['keyaccess'],
131: $cenv{'domain'},$cenv{'num'});
132: } else {
1.3 www 133: return 'Establishing key access: '.
1.2 www 134: &Apache::lonnet::put('environment',{'keyaccess' => 'yes'},
135: $cenv{'domain'},$cenv{'num'});
1.1 www 136: }
137: }
138:
1.3 www 139: # --------------------------------------------------------------- Generate Keys
140:
141: sub genkeys {
142: my ($num,$comments,%cenv)=@_;
1.5 www 143: unless ($comments) { $comments=''; }
144: $comments=~s/\#/ /g;
145: $comments=~s/\;/ /g;
1.3 www 146: unless ($num) { return 'No number of keys given.'; }
147: unless (($num=~/^\d+$/) && ($num>0)) {
148: return 'Invalid number of keys given.';
149: }
1.5 www 150: my $batchnumber='BATCH_'.time().'_'.$$;
1.3 www 151: return 'Generated '.&Apache::lonnet::generate_access_keys
1.5 www 152: ($num,$cenv{'domain'},$cenv{'num'},$batchnumber.'; '.$comments).' of '.
153: $num.' access keys (Batch Number: '.$batchnumber.')',$batchnumber;
1.3 www 154: }
155:
1.9 www 156: # ---------------------------------------------------------------- Add comments
157:
158: sub addcom {
159: my %cenv=@_;
160: my %newcomment=();
161: undef %newcomment;
1.17 albertel 162: foreach (keys %env) {
1.9 www 163: if ($_=~/^form\.com\_(.+)$/) {
164: my $key=$1;
1.17 albertel 165: my $comment=$env{$_};
1.9 www 166: $comment=~s/^\s+//gs;
167: if ($comment) {
168: &Apache::lonnet::comment_access_key
169: ($key,$cenv{'domain'},$cenv{'num'},$comment);
170: }
171: }
172: }
173: return '';
174: }
1.1 www 175: ###################################################################
176: ###################################################################
177: sub handler {
178: my $r=shift;
179: if ($r->header_only) {
1.12 www 180: &Apache::loncommon::content_type($r,'text/html');
1.1 www 181: $r->send_http_header;
182: return OK;
183: }
1.2 www 184: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
185: ['state','cid']);
1.17 albertel 186: if (($env{'form.domain'}) && ($env{'form.course'})) {
187: $env{'form.cid'}=$env{'form.domain'}.'_'.$env{'form.course'};
1.2 www 188: }
1.1 www 189:
1.17 albertel 190: unless (&Apache::lonnet::allowed('mky',$env{'request.role.domain'})) {
191: $env{'user.error.msg'}=
1.1 www 192: "/adm/managekeys:mky:0:0:Cannot manage access keys";
193: return HTTP_NOT_ACCEPTABLE;
194: }
1.17 albertel 195: if ($env{'form.cid'}) {
196: my %cenv=&Apache::lonnet::coursedescription($env{'form.cid'});
1.14 www 197: my $keytype='';
198: if ($cenv{'url'} eq '/res/') {
1.17 albertel 199: ($cenv{'domain'},$cenv{'num'})=split(/\_/,$env{'form.cid'});
1.14 www 200: $keytype='auth';
201: } elsif ($cenv{'keyauth'}) {
1.21 albertel 202: ($cenv{'num'},$cenv{'domain'})=split(/:/,$cenv{'keyauth'});
1.14 www 203: $keytype='auth';
204: } else {
205: $keytype='course';
206: }
1.17 albertel 207: if ($env{'form.listkeyscsv'}) {
1.3 www 208: #
209: # CSV Output
210: #
1.2 www 211: $r->content_type('text/csv');
1.11 www 212: $r->send_http_header;
1.3 www 213: #
214: # Do CSV
215: #
1.17 albertel 216: &show_key_list($r,1,$env{'form.listcom'},
217: $env{'form.newonly'},$env{'form.checkonly'},%cenv);
1.11 www 218:
1.2 www 219: } else {
1.3 www 220: #
221: # Normal web stuff
222: #
1.12 www 223: &Apache::loncommon::content_type($r,'text/html');
1.2 www 224: $r->send_http_header;
225: $r->print(&header());
1.3 www 226:
227: $r->print(
1.17 albertel 228: '<input type="hidden" name="cid" value="'.$env{'form.cid'}.'" />');
1.3 www 229: # --- Actions
1.17 albertel 230: if ($env{'form.toggle'}) {
1.3 www 231: $r->print(&togglekeyaccess(%cenv).'<br />');
1.19 albertel 232: %cenv=&Apache::lonnet::coursedescription($env{'form.cid'},
233: {'freshen_cache'=> 1});
1.3 www 234: }
1.5 www 235: my $batchnumber='';
1.17 albertel 236: if ($env{'form.genkeys'}) {
1.5 www 237: (my $msg,$batchnumber)=
1.17 albertel 238: &genkeys($env{'form.num'},$env{'form.comments'},%cenv);
1.5 www 239: $r->print($msg.'<br />');
1.3 www 240: }
1.17 albertel 241: if ($env{'form.listkeys'}) {
242: &show_key_list($r,0,$env{'form.listcom'},
243: $env{'form.newonly'},$env{'form.checkonly'},%cenv);
1.9 www 244: }
1.17 albertel 245: if ($env{'form.addcom'}) {
1.9 www 246: &addcom(%cenv);
1.5 www 247: }
1.3 www 248: # --- Menu
1.14 www 249: if ($keytype eq 'course') {
250: $r->print('<h3>'.&mt('Key Access').'</h3>');
251: if ($cenv{'keyaccess'} eq 'yes') {
252: $r->print(&mt('Access to this course is key controlled.').
1.12 www 253: '<br /><input type="submit" name="toggle" value="'.&mt('Open Access').'" />')
1.3 www 254: } else {
1.12 www 255: $r->print(&mt('Access to this course is open, no access keys').'<br /><input type="submit" name="toggle" value="'.&mt('Control Access').'" />');
1.14 www 256: }
257: } else {
258: $r->print('<h3>'.&mt('Key Authority').
259: ' <tt>'.$cenv{'num'}.'@'.$cenv{'domain'}.'</tt></h3>');
1.2 www 260: }
1.5 www 261: $r->print(<<ENDKEYMENU);
1.3 www 262: <hr /><h3>Generate New Keys</h3>
263: Number of keys to be generated: <input type="text" name="num" size="6" /><br />
264: Comments/Remarks/Notes: <input type="text" name="comments" size="30" /><br />
265: <input type="submit" name="genkeys" value="Generate Keys" />
1.5 www 266: <hr /><h3>List Keys</h3>
1.11 www 267: Comments/Remarks/Notes/User/Batch Number Filter:
1.5 www 268: <input type="text" name="listcom" size="30" value="$batchnumber" /><br />
1.22 albertel 269: <label><input type="checkbox" name="newonly" /> Unused keys only</label><br />
270: <label><input type="checkbox" name="checkonly" /> Used keys only</label><br />
1.11 www 271: <input type="submit" name="listkeys" value="List Keys/Add Comments" />
272: <input type="submit" name="listkeyscsv" value="CSV List of Keys" />
1.5 www 273: ENDKEYMENU
1.18 albertel 274: $r->print('</form>'.&Apache::loncommon::end_page());
1.2 www 275: }
1.1 www 276: } else {
1.2 www 277: # Start page no course id
1.13 www 278: &Apache::loncommon::content_type($r,'text/html');
1.2 www 279: $r->send_http_header;
280: $r->print(&header().&Apache::loncommon::coursebrowser_javascript());
1.25 bisitz 281: $r->print('<br />');
1.24 bisitz 282: $r->print(&Apache::lonhtmlcommon::start_pick_box()
283: .&Apache::lonhtmlcommon::row_title(&mt('Course ID of Key Authority'))
284: .'<input input type="text" size="25" name="course" value="" />'
285: .' '.&Apache::loncommon::selectcourse_link(
286: 'keyform','course','domain',
287: undef,undef,undef,'Course')
288: .&Apache::lonhtmlcommon::row_closure()
289: .&Apache::lonhtmlcommon::row_title(&mt('Domain'))
290: .&Apache::loncommon::select_dom_form($env{'request.role.domain'},'domain')
291: .&Apache::lonhtmlcommon::row_closure(1)
292: .&Apache::lonhtmlcommon::end_pick_box()
293: );
294: $r->print('<input type="submit" value="'.&mt('Next').'" />'
295: .'</form>'
296: .&Apache::loncommon::end_page()
297: );
1.1 www 298: }
299: return OK;
300: }
301:
302: ###################################################################
303: ###################################################################
304:
305: 1;
306: __END__
307:
308:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonmanagekeys.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface