# The LearningOnline Network with CAPA
# Handler to show and edit custom distribution rights
#
# $Id: lonrights.pm,v 1.17 2005/04/07 06:56:27 albertel 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;
$r->print(
'LON-CAPA Custom Distribution Rights'.
&Apache::loncommon::coursebrowser_javascript().'');
$r->print(&Apache::loncommon::bodytag('Custom Distribution Rights'));
$r->rflush();
my $uri=$r->uri;
my $fn=&Apache::lonnet::filelocation('',$uri);
my $contents='';
my $constructmode=($uri=~/^\/\~/);
# ============================================================ Modify and store
if ($constructmode) {
if ($env{'form.store'}) {
my @newrules=();
undef @newrules;
# read rules from form
foreach (keys %env) {
if ($_=~/^form\.effect\_(\d+)$/) {
my $number=$1;
my %rulehash=();
foreach ('effect','domain','course','section','role') {
$rulehash{$_}=$env{'form.'.$_.'_'.$number};
}
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'}=~s/\W//g;
$rulehash{'course'}=~s/\W//g;
$rulehash{'section'}=~s/\W//g;
unless ($rulehash{'domain'}) {
$rulehash{'domain'}=$env{'user.domain'};
}
my $realm='';
if ($number) {
$realm=$rulehash{'domain'};
if ($rulehash{'course'}) {
$realm.='_'.$rulehash{'course'};
}
if ($rulehash{'section'}) {
$realm.='_'.$rulehash{'section'};
}
}
$newrules[$number]=$rulehash{'effect'}.':'.
$realm.':'.$rulehash{'role'};
}
}
# edit actions?
foreach (keys %env) {
if ($_=~/^form\.action\_(\d+)$/) {
my $number=$1;
if ($env{$_} eq 'delete') { $newrules[$number]=''; }
if (($env{$_} eq 'moveup') && ($number>1)) {
my $buffer=$newrules[$number];
$newrules[$number]=$newrules[$number-1];
$newrules[$number-1]=$buffer;
}
if (($env{$_} eq 'movedown') && ($number<$#newrules)) {
my $buffer=$newrules[$number];
$newrules[$number]=$newrules[$number+1];
$newrules[$number+1]=$buffer;
}
if ($env{$_} eq 'insertabove') {
for (my $i=$#newrules;$i>=$number;$i--) {
$newrules[$i+1]=$newrules[$i];
}
$newrules[$number]='deny';
}
if ($env{$_} eq 'insertbelow') {
for (my $i=$#newrules;$i>$number;$i--) {
$newrules[$i+1]=$newrules[$i];
}
$newrules[$number+1]='deny';
}
}
}
# store file
my $fh=Apache::File->new('>'.$fn);
foreach (my $i=0;$i<=$#newrules;$i++) {
if ($newrules[$i]) {
my ($effect,$realm,$role)=split(/\:/,$newrules[$i]);
print $fh
"\n";
}
}
$fh->close;
}
}
# ============================================================ Read and display
unless ($constructmode) {
# =========================================== This is not in construction space
$contents=&Apache::lonnet::getfile($fn);
if ($contents==-1) { $contents=''; }
} else {
# =============================================== This is in construction space
if (-e $fn) {
my $fh=Apache::File->new($fn);
$contents=join('',<$fh>);
$fh->close();
}
$r->print('');
}
$r->print('