File:  [LON-CAPA] / loncom / publisher / lonrights.pm
Revision 1.5: download - view: text, annotated - select for diffs
Thu Mar 20 20:58:40 2003 UTC (21 years, 2 months ago) by www
Branches: MAIN
CVS tags: HEAD
Can now store, but not yet do "insert", etc

    1: # The LearningOnline Network with CAPA
    2: # Handler to show and edit custom distribution rights
    3: #
    4: # $Id: lonrights.pm,v 1.5 2003/03/20 20:58:40 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: 
  103: # store file
  104:           my $fh=Apache::File->new('>'.$fn);
  105:           foreach (my $i=0;$i<=$#newrules;$i++) {
  106:               if ($newrules[$i]) {
  107: 	         my ($effect,$realm,$role)=split(/\:/,$newrules[$i]);
  108:                  print $fh
  109: 	       "<accessrule effect='$effect' realm='$realm' role='$role' />\n";
  110: 	     }
  111:           }
  112:           $fh->close;
  113:       }
  114:   }
  115: # ============================================================ Read and display
  116:   unless ($constructmode) { 
  117: # =========================================== This is not in construction space
  118:       $contents=&Apache::lonnet::getfile($fn);
  119:       if ($contents==-1) { $contents=''; }
  120:   } else {
  121: # =============================================== This is in construction space
  122:       if (-e $fn) {
  123: 	  my $fh=Apache::File->new($fn);
  124:           $contents=join('',<$fh>);
  125:           $fh->close();
  126:       }
  127:       $r->print('<form method="post">');
  128:   }
  129:   unless ($contents=~/\<accessrule/s) {
  130:       $contents='<accessrule effect="deny" />';
  131:   }
  132:   my $parser=HTML::LCParser->new(\$contents);
  133:   my $token;
  134:   my $rulecounter=0;
  135:   my $colzero=($constructmode?'Edit action':'Rule');
  136: # ---------------------------------------------------------- Start table output
  137:   $r->print(<<ENDSTARTTABLE);
  138: <table border="2">
  139:     <tr><th>$colzero</th><th>Effect</th><th>Domain</th><th>Course</th>
  140: <th>Section</th><th>Role</th></tr>
  141: ENDSTARTTABLE
  142: # --------------------------------------------------------------------- Default
  143: # Fast forward to first rule
  144:   $token=$parser->get_token;
  145:   while ($token->[1] ne 'accessrule') { $token=$parser->get_token; }
  146: # print default
  147:   $r->print('<tr><td>&nbsp;</td><td>');
  148:   if ($constructmode) {
  149:       $r->print(&Apache::loncommon::select_form
  150:                                  ($token->[2]->{'effect'},'effect_0',
  151:                                    ('allow' => 'allow',
  152:                                     'deny'  => 'deny')));
  153:   } else {
  154:       $r->print($token->[2]->{'effect'});
  155:   }
  156:   $r->print('</td><td colspan="4">Default');
  157:   if (($token->[2]->{'realm'}) || ($token->[2]->{'role'})) {
  158:       $r->print(' - <font color="red">Error! No default set.</font>');
  159:   }
  160:   $r->print('</td></tr>');
  161: # Additional roles
  162:   while ($token=$parser->get_token) {
  163:       if (($token->[0] eq 'S') && ($token->[1] eq 'accessrule')) {
  164:           $rulecounter++;
  165: 	  $r->print('<tr><td>');
  166: # insert, delete, etc
  167: 	  $r->print($rulecounter.'.&nbsp;');
  168:           if ($constructmode) {
  169:              $r->print(&Apache::loncommon::select_form(
  170:                     '','action_'.$rulecounter,
  171:                     ('' => '', 
  172:                      'delete' => 'Delete this rule',
  173:                      'insertabove' => 'Insert rule above',
  174:                      'insertbelow' => 'Insert rule below',
  175:                      'moveup'      => 'Move rule up',
  176:                      'movedown'    => 'Move rule down')));
  177: 	  }
  178:           $r->print('</td><td>');
  179: # effect
  180:           if ($constructmode) {
  181:              $r->print(&Apache::loncommon::select_form
  182:                                  ($token->[2]->{'effect'},
  183:                                   'effect_'.$rulecounter,
  184:                                    ('allow' => 'allow',
  185:                                     'deny'  => 'deny')));
  186:           } else {
  187:              $r->print($token->[2]->{'effect'});
  188:           }
  189: 	  $r->print('</td><td>');
  190: # ---- realm
  191:           my $realm=$token->[2]->{'realm'};
  192:           $realm=~s/^\W//;
  193:           my ($rdom,$rcourse,$rsec)=split(/[\/\_]/,$realm);
  194: # realm role
  195:           if ($constructmode) {
  196:               $r->print(&Apache::loncommon::select_dom_form($rdom,
  197:                                                       'domain_'.$rulecounter));
  198:           } else {
  199:               $r->print($rdom);
  200:           }
  201:           $r->print('</td><td>');
  202: # realm course
  203:           if ($constructmode) {
  204:              $r->print('<input input type="text" size="25" name="course_'.
  205:                        $rulecounter.'" value="'.$rcourse.'" />');
  206:           } else {
  207:               $r->print($rcourse);
  208:           }
  209: 
  210:           $r->print('</td><td>');
  211: # realm section
  212:           if ($constructmode) {
  213:              $r->print('<input input type="text" size="5" name="section_'.
  214:                        $rulecounter.'" value="'.$rsec.'" />');
  215:           } else {
  216:               $r->print($rsec);
  217:           }
  218: 
  219:           $r->print('</td><td>');
  220: # role
  221:           if ($constructmode) {
  222: 	      my %hash=('' => '');
  223:               foreach ('au','cc','in','ta','st') { 
  224:                  $hash{$_}=&Apache::lonnet::plaintext($_); 
  225:               }
  226:               my $role=$token->[2]->{'role'};
  227:               unless ($role) { $role=''; }
  228:               $r->print(&Apache::loncommon::select_form(
  229:                 $role,'role_'.$rulecounter,%hash));
  230:           } else {
  231:               $r->print(&Apache::lonnet::plaintext($token->[2]->{'role'}));
  232:           }
  233: # close row
  234:           $r->print('</td></tr>');
  235:      }                                       
  236:   }
  237:   $r->print('</table>');
  238: # ------------------------------------------------------------ End table output
  239:   if ($constructmode) { 
  240:      $r->print('<input type="submit" name="store" value="Store" /></form>'); 
  241:   }
  242:   $r->print('</body></html>');
  243:   return OK;  
  244: }
  245: 
  246: 
  247: 1;
  248: __END__
  249: 
  250: 
  251: 
  252: 

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