File:  [LON-CAPA] / loncom / publisher / lonrights.pm
Revision 1.9: download - view: text, annotated - select for diffs
Fri Mar 28 01:53:55 2003 UTC (21 years, 1 month ago) by www
Branches: MAIN
CVS tags: version_1_0_3, version_1_0_2, version_1_0_1, version_1_0_0, version_0_99_5, version_0_99_4, version_0_99_3, version_0_99_2, version_0_99_1, version_0_99_0, conference_2003, HEAD
Bugfixes and enhancements on pickstudent and pickcourse.

    1: # The LearningOnline Network with CAPA
    2: # Handler to show and edit custom distribution rights
    3: #
    4: # $Id: lonrights.pm,v 1.9 2003/03/28 01:53:55 www Exp $
    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::lonrights;
   32: 
   33: use strict;
   34: use Apache::Constants qw(:common :http);
   35: use Apache::lonnet();
   36: use Apache::loncommon();
   37: use HTML::LCParser;
   38: use Apache::File;
   39: 
   40: sub handler {
   41: 
   42:   my $r=shift;
   43:   $r->content_type('text/html');
   44:   $r->send_http_header;
   45: 
   46:   $r->print(
   47:      '<html><head><title>LON-CAPA Custom Distribution Rights</title>'.
   48:    &Apache::loncommon::coursebrowser_javascript().'</head>');
   49: 
   50:   $r->print(&Apache::loncommon::bodytag('Custom Distribution Rights'));
   51:   $r->rflush();
   52: 
   53:   my $uri=$r->uri;
   54:   my $fn=&Apache::lonnet::filelocation('',$uri);
   55:   my $contents='';
   56:   my $constructmode=($uri=~/^\/\~/);
   57: 
   58: # ============================================================ Modify and store
   59:   if ($constructmode) {
   60:       if ($ENV{'form.store'}) {
   61: 	  my @newrules=();
   62:           undef @newrules;
   63: # read rules from form
   64:           foreach (keys %ENV) {
   65: 	      if ($_=~/^form\.effect\_(\d+)$/) {
   66: 		  my $number=$1;
   67:                   my %rulehash=();
   68:                   foreach ('effect','domain','course','section','role') {
   69: 		      $rulehash{$_}=$ENV{'form.'.$_.'_'.$number};
   70:                   }
   71:                   if ($rulehash{'role'} eq 'au') {
   72: 		      $rulehash{'course'}='';
   73:                       $rulehash{'section'}='';
   74:                   }
   75:                   if ($rulehash{'role'} eq 'cc') {
   76:                       $rulehash{'section'}='';
   77:                   }
   78:                   unless (($rulehash{'effect'} eq 'deny') ||
   79: 		          ($rulehash{'effect'} eq 'allow')) {
   80: 		      $rulehash{'effect'}='deny';
   81:                   }
   82:                   $rulehash{'domain'}=~s/\W//g;
   83:                   $rulehash{'course'}=~s/\W//g;
   84:                   $rulehash{'section'}=~s/\W//g;
   85:                   unless ($rulehash{'domain'}) { 
   86:                      $rulehash{'domain'}=$ENV{'user.domain'}; 
   87:                   }
   88:                   my $realm='';
   89:                   if ($number) {
   90:                      $realm=$rulehash{'domain'};
   91:                      if ($rulehash{'course'}) {
   92: 			 $realm.='_'.$rulehash{'course'};
   93:                      }
   94:                      if ($rulehash{'section'}) {
   95: 			 $realm.='_'.$rulehash{'section'};
   96:                      }
   97: 		 }
   98: 		  $newrules[$number]=$rulehash{'effect'}.':'.
   99: 		                     $realm.':'.$rulehash{'role'};
  100:               }
  101:           }
  102: # edit actions?
  103:           foreach (keys %ENV) {
  104: 	      if ($_=~/^form\.action\_(\d+)$/) {
  105:                   my $number=$1;
  106: 		  if ($ENV{$_} eq 'delete') { $newrules[$number]=''; }
  107:                   if (($ENV{$_} eq 'moveup') && ($number>2)) {
  108: 		      my $buffer=$newrules[$number];
  109:                       $newrules[$number]=$newrules[$number-1];
  110:                       $newrules[$number-1]=$buffer;
  111:                   }
  112:                   if (($ENV{$_} eq 'movedown') && ($number<$#newrules)) {
  113: 		      my $buffer=$newrules[$number];
  114:                       $newrules[$number]=$newrules[$number+1];
  115:                       $newrules[$number+1]=$buffer;
  116:                   }
  117:                   if ($ENV{$_} eq 'insertabove') {
  118: 		      for (my $i=$#newrules;$i>=$number;$i--) {
  119: 			  $newrules[$i+1]=$newrules[$i];
  120:                       }
  121:                       $newrules[$number]='deny';
  122:                   }
  123:                   if ($ENV{$_} eq 'insertbelow') {
  124:  		      for (my $i=$#newrules;$i>$number;$i--) {
  125: 			  $newrules[$i+1]=$newrules[$i];
  126:                       }
  127:                       $newrules[$number+1]='deny';
  128:                  }
  129: 	      }
  130:           }
  131: 
  132: # store file
  133:           my $fh=Apache::File->new('>'.$fn);
  134:           foreach (my $i=0;$i<=$#newrules;$i++) {
  135:               if ($newrules[$i]) {
  136: 	         my ($effect,$realm,$role)=split(/\:/,$newrules[$i]);
  137:                  print $fh
  138: 	       "<accessrule effect='$effect' realm='$realm' role='$role' />\n";
  139: 	     }
  140:           }
  141:           $fh->close;
  142:       }
  143:   }
  144: # ============================================================ Read and display
  145:   unless ($constructmode) { 
  146: # =========================================== This is not in construction space
  147:       $contents=&Apache::lonnet::getfile($fn);
  148:       if ($contents==-1) { $contents=''; }
  149:   } else {
  150: # =============================================== This is in construction space
  151:       if (-e $fn) {
  152: 	  my $fh=Apache::File->new($fn);
  153:           $contents=join('',<$fh>);
  154:           $fh->close();
  155:       }
  156:       $r->print('<form name="rules" method="post">');
  157:   }
  158:   unless ($contents=~/\<accessrule/s) {
  159:       $contents='<accessrule effect="deny" />';
  160:   }
  161:   my $parser=HTML::LCParser->new(\$contents);
  162:   my $token;
  163:   my $rulecounter=0;
  164:   my $colzero=($constructmode?'Edit action':'Rule');
  165: # ---------------------------------------------------------- Start table output
  166:   $r->print(<<ENDSTARTTABLE);
  167: <table border="2">
  168:     <tr><th>$colzero</th><th>Effect</th><th>Domain</th><th>Course</th>
  169: <th>Section</th><th>Role</th></tr>
  170: ENDSTARTTABLE
  171: # --------------------------------------------------------------------- Default
  172: # Fast forward to first rule
  173:   $token=$parser->get_token;
  174:   while ($token->[1] ne 'accessrule') { $token=$parser->get_token; }
  175: # print default
  176:   $r->print('<tr><td align="right">');
  177:   if ($constructmode) {
  178:      $r->print(&Apache::loncommon::select_form('','action_0',
  179:                                   ('' => '',
  180: 				   'insertbelow' => 'Insert rule below    ')));
  181:                                                 
  182:   } else {
  183:       $r->print('&nbsp;');
  184:   }
  185:   $r->print('</td><td>');
  186:   if ($constructmode) {
  187:       $r->print(&Apache::loncommon::select_form
  188:                                  ($token->[2]->{'effect'},'effect_0',
  189:                                    ('allow' => 'allow',
  190:                                     'deny'  => 'deny')));
  191:   } else {
  192:       $r->print($token->[2]->{'effect'});
  193:   }
  194:   $r->print('</td><td colspan="4">Default');
  195:   if (($token->[2]->{'realm'}) || ($token->[2]->{'role'})) {
  196:       $r->print(' - <font color="red">Error! No default set.</font>');
  197:   }
  198:   $r->print('</td></tr>');
  199: # Additional roles
  200:   while ($token=$parser->get_token) {
  201:       if (($token->[0] eq 'S') && ($token->[1] eq 'accessrule')) {
  202:           $rulecounter++;
  203: 	  $r->print('<tr><td align="right" rowspan="2">');
  204: # insert, delete, etc
  205: 	  $r->print($rulecounter.'.&nbsp;');
  206:           if ($constructmode) {
  207:              $r->print(&Apache::loncommon::select_form(
  208:                     '','action_'.$rulecounter,
  209:                     ('' => '', 
  210:                      'delete' => 'Delete this rule',
  211:                      'insertabove' => 'Insert rule above',
  212:                      'insertbelow' => 'Insert rule below    ',
  213:                      'moveup'      => 'Move rule up',
  214:                      'movedown'    => 'Move rule down')));
  215: 	  }
  216:           $r->print('</td><td rowspan="2">');
  217: # effect
  218:           if ($constructmode) {
  219:              $r->print(&Apache::loncommon::select_form
  220:                                  ($token->[2]->{'effect'},
  221:                                   'effect_'.$rulecounter,
  222:                                    ('allow' => 'allow',
  223:                                     'deny'  => 'deny')));
  224:           } else {
  225:              $r->print($token->[2]->{'effect'});
  226:           }
  227: 	  $r->print('</td><td>');
  228: # ---- realm
  229:           my $realm=$token->[2]->{'realm'};
  230:           $realm=~s/^\W//;
  231:           my ($rdom,$rcourse,$rsec)=split(/[\/\_]/,$realm);
  232: # realm domain
  233:           if ($constructmode) {
  234:               unless ($rdom) { $rdom=$ENV{'user.domain'}; }
  235:               $r->print(&Apache::loncommon::select_dom_form($rdom,
  236:                                                       'domain_'.$rulecounter));
  237:           } else {
  238:               $r->print($rdom);
  239:           }
  240:           $r->print('</td><td>');
  241: # realm course
  242:           if ($constructmode) {
  243:              $r->print('<input input type="text" size="25" name="course_'.
  244:                        $rulecounter.'" value="'.$rcourse.'" />');
  245:           } else {
  246:               $r->print($rcourse);
  247:           }
  248: 
  249:           $r->print('</td><td>');
  250: # realm section
  251:           if ($constructmode) {
  252:              $r->print('<input input type="text" size="5" name="section_'.
  253:                        $rulecounter.'" value="'.$rsec.'" />');
  254:           } else {
  255:               $r->print($rsec);
  256:           }
  257: 
  258:           $r->print('</td><td rowspan="2">');
  259: # role
  260:           if ($constructmode) {
  261: 	      my %hash=('' => '');
  262:               foreach ('au','cc','in','ta','st') { 
  263:                  $hash{$_}=&Apache::lonnet::plaintext($_); 
  264:               }
  265:               my $role=$token->[2]->{'role'};
  266:               unless ($role) { $role=''; }
  267:               $r->print(&Apache::loncommon::select_form(
  268:                 $role,'role_'.$rulecounter,%hash));
  269:           } else {
  270:               $r->print(&Apache::lonnet::plaintext($token->[2]->{'role'}));
  271:           }
  272: # course selection link
  273:           $r->print('</td></tr><tr><td colspan="3" align="right">');
  274:           if ($rcourse) {
  275: 	      my %descript=
  276:                  &Apache::lonnet::coursedescription($rdom.'_'.$rcourse);
  277:               $r->print($descript{'description'}.'&nbsp;&nbsp;&nbsp;');
  278:           }
  279:           $r->print(&Apache::loncommon::selectcourse_link('rules',
  280: 		    'course_'.$rulecounter,'domain_'.$rulecounter));
  281: # close row
  282:           $r->print('</td></tr>');
  283:      }                                       
  284:   }
  285:   $r->print('</table>');
  286: # ------------------------------------------------------------ End table output
  287:   if ($constructmode) { 
  288:      $r->print('<input type="submit" name="store" value="Store" /></form>'); 
  289:   }
  290:   $r->print('</body></html>');
  291:   return OK;  
  292: }
  293: 
  294: 
  295: 1;
  296: __END__
  297: 
  298: 
  299: 
  300: 

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