# The LearningOnline Network with CAPA
# Handler to show and edit custom distribution rights
#
# $Id: lonrights.pm,v 1.25 2009/05/25 14:31:00 bisitz 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::lonrights;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::loncommon();
use HTML::LCParser;
use Apache::File;
use Apache::lonlocal;
sub handler {
my $r=shift;
my $target = $env{'form.grade_target'};
if ($target eq 'meta') {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
$env{'request.uri'}=$r->uri;
my $file = &Apache::lonnet::filelocation("",$r->uri);
my $content=&Apache::lonnet::getfile($file);
my $result=&Apache::lonxml::xmlparse(undef,'meta',$content);
$r->print($result);
return OK;
}
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $js = &Apache::loncommon::coursebrowser_javascript().
&Apache::loncommon::studentbrowser_javascript();
$r->print(&Apache::loncommon::start_page('Custom Distribution Rights',$js));
$r->rflush();
my $uri=$r->uri;
my $fn=&Apache::lonnet::filelocation('',$uri);
my $contents='';
my $constructmode=($uri=~/^\/\~/);
# ============================================================ Modify and store
if ($constructmode && $env{'form.store'}) {
my @newrules;
# read rules from form
foreach my $key (keys(%env)) {
next if ($key!~/^form\.effect\_(\d+)$/);
my $number=$1;
my %rulehash;
foreach my $action ('effect','type','domain','course','section','role') {
$rulehash{$action}=$env{'form.'.$action.'_'.$number};
}
if ($rulehash{'type'} !~ /^(user|course)$/) {
$rulehash{'type'} = 'course';
}
if ($rulehash{'type'} eq 'user') {
$rulehash{'section'}='';
$rulehash{'role'}='';
}
if ($rulehash{'role'} eq 'au') {
$rulehash{'course'}='';
$rulehash{'section'}='';
}
if ($rulehash{'role'} eq 'cc') {
$rulehash{'section'}='';
}
unless (($rulehash{'effect'} eq 'deny') ||
($rulehash{'effect'} eq 'allow')) {
$rulehash{'effect'}='deny';
}
$rulehash{'domain'} =
&LONCAPA::clean_domain($rulehash{'domain'});
if ($rulehash{'type'} eq 'course') {
$rulehash{'course'} =
&LONCAPA::clean_courseid($rulehash{'course'});
} else {
$rulehash{'course'} =
&LONCAPA::clean_username($rulehash{'course'});
}
$rulehash{'section'}=~s/\W//g;
if (!$rulehash{'domain'}) {
$rulehash{'domain'}=$env{'user.domain'};
}
my $realm='';
my $separator = ($rulehash{'type'} eq 'course') ? '_' : '/';
if ($number) {
$realm=$rulehash{'domain'};
if ($rulehash{'course'}) {
$realm.=$separator.$rulehash{'course'};
}
if ($rulehash{'section'}) {
$realm.=$separator.$rulehash{'section'};
}
}
$newrules[$number]=$rulehash{'effect'}.':'.
$realm.':'.$rulehash{'role'}.':'.$rulehash{'type'};
}
# edit actions?
foreach my $key (keys(%env)) {
next if ($key!~/^form\.action\_(\d+)$/);
my $number=$1;
if ($env{$key} eq 'delete') { splice(@newrules,$number,1); }
if (($env{$key} eq 'moveup') && ($number>1)) {
@newrules[$number-1,$number] = @newrules[$number,$number-1];
}
if (($env{$key} eq 'movedown') && ($number<$#newrules)) {
@newrules[$number+1,$number] = @newrules[$number,$number+1];
}
if ($env{$key} eq 'insertabove') {
splice(@newrules,$number,0,'deny');
}
if ($env{$key} eq 'insertbelow') {
splice(@newrules,$number+1,0,'deny');
}
}
# store file
my $fh=Apache::File->new('>'.$fn);
foreach (my $i=0;$i<=$#newrules;$i++) {
if ($newrules[$i]) {
my ($effect,$realm,$role,$type)=split(/\:/,$newrules[$i]);
print $fh
"