File:  [LON-CAPA] / loncom / publisher / lonrights.pm
Revision 1.6: download - view: text, annotated - select for diffs
Thu Mar 20 21:47:57 2003 UTC (21 years, 2 months ago) by www
Branches: MAIN
CVS tags: HEAD
Editing commands - need more testing

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

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