Annotation of loncom/interface/loncourseauthor.pm, revision 1.1
1.1 ! raeburn 1: # The LearningOnline Network
! 2: # Documents
! 3: #
! 4: # $Id: loncourseauthor.pm,v 1.1 2022/12/31 08:10:00 raeburn 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: package Apache::loncourseauthor;
! 30:
! 31: use strict;
! 32: use Apache::Constants qw(:common :http);
! 33: use Apache::lonnet;
! 34: use Apache::loncommon;
! 35: use JSON::DWIW;
! 36: use LONCAPA qw(:DEFAULT :match);
! 37:
! 38: sub handler {
! 39: my $r = shift;
! 40: &Apache::loncommon::content_type($r,'application/json');
! 41: $r->send_http_header;
! 42: my ($nonemptydir,%dirhash,%filehash);
! 43: if ($env{'request.course.id'}) {
! 44: if (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
! 45: my ($context,$recurse,$role,$is_home,$inc,$exc,$toppath,$relpath,
! 46: $include,$exclude);
! 47: if ($env{'form.role'}) {
! 48: $role = $env{'form.role'};
! 49: if ($env{'form.rec'}) {
! 50: $recurse = 1;
! 51: }
! 52: if ($env{'form.res'}) {
! 53: $context = 'res';
! 54: } else {
! 55: $context = 'priv';
! 56: }
! 57: if ($env{'form.inc'}) {
! 58: $inc = $env{'form.inc'};
! 59: $inc =~ s/^\s+|\s+$//g;
! 60: }
! 61: if ($env{'form.exc'}) {
! 62: $exc = $env{'form.exc'};
! 63: $exc =~ s/^\s+|\s+$//g;
! 64: }
! 65: if ($env{'form.nonempty'}) {
! 66: $nonemptydir = 1;
! 67: }
! 68: my $now = time;
! 69: my @ids=&Apache::lonnet::current_machine_ids();
! 70: if ($role eq 'author') {
! 71: if (exists($env{"user.role.au./$env{'user.domain'}/"})) {
! 72: my ($start,$end) = split(/\./,$env{"user.role.au./$env{'user.domain'}/"});
! 73: unless (($start && $start > $now) || ($end && $end < $now)) {
! 74: $toppath = "/$context/$env{'user.domain'}/$env{'user.name'}";
! 75: if (grep(/^\Q$env{'user.home'}\E$/,@ids)) {
! 76: $is_home = 1;
! 77: }
! 78: }
! 79: }
! 80: } elsif ($role eq 'course') {
! 81: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
! 82: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
! 83: if (($cdom ne '') && ($cnum ne '')) {
! 84: $toppath = "/$context/$cdom/$cnum";
! 85: my $rolehome = &Apache::lonnet::homeserver($cnum,$cdom);
! 86: if (grep(/^\Q$rolehome\E$/,@ids)) {
! 87: $is_home = 1;
! 88: }
! 89: }
! 90: } elsif ($role =~ m{^(ca|aa)\./($match_domain)/($match_username)$}) {
! 91: my ($rolecode,$audom,$auname) = ($1,$2,$3);
! 92: if (exists($env{"user.role.$role"})) {
! 93: my ($start,$end) = split(/\./,$env{"user.role.$role"});
! 94: unless(($start && $start > $now) || ($end && $end < $now)) {
! 95: $toppath = "/$context/$audom/$auname";
! 96: my $rolehome = &Apache::lonnet::homeserver($auname,$audom);
! 97: if (grep(/^\Q$rolehome\E$/,@ids)) {
! 98: $is_home = 1;
! 99: }
! 100: }
! 101: }
! 102: }
! 103: if ($toppath ne '') {
! 104: if ($env{'form.path'}) {
! 105: $relpath = $env{'form.path'};
! 106: }
! 107: my @ids=&Apache::lonnet::current_machine_ids();
! 108: if (grep(/^\Q$env{'user.home'}\E$/,@ids)) {
! 109: $is_home = 1;
! 110: }
! 111: if ($inc) {
! 112: map { $include->{$_} = 1; } split(/\s*,\s*/,$inc);
! 113: }
! 114: if ($exc) {
! 115: map { $exclude->{$_} = 1; } split(/\s*,\s*/,$exc);
! 116: }
! 117: my $dirhashref = \%dirhash;
! 118: my $filehashref;
! 119: if ($env{'form.files'}) {
! 120: $filehashref = \%filehash;
! 121: }
! 122: &Apache::lonnet::recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,
! 123: $toppath,$relpath,$dirhashref,$filehashref);
! 124: }
! 125: }
! 126: }
! 127: }
! 128: my @dirs = ();
! 129: if (%dirhash) {
! 130: if ($dirhash{'/'}) {
! 131: push(@dirs,'/');
! 132: delete($dirhash{'/'});
! 133: }
! 134: if ($nonemptydir) {
! 135: foreach my $dir (sort { lc($a) cmp lc($b) } (keys(%dirhash))) {
! 136: next unless (ref($filehash{$dir}) eq 'HASH');
! 137: push(@dirs,$dir);
! 138: }
! 139: } else {
! 140: push(@dirs,(sort { lc($a) cmp lc($b) } (keys(%dirhash))));
! 141: }
! 142: }
! 143: my %files;
! 144: if (%filehash) {
! 145: foreach my $dir (keys(%filehash)) {
! 146: if (ref($filehash{$dir}) eq 'HASH') {
! 147: foreach my $key (keys(%{$filehash{$dir}})) {
! 148: if ($key =~ /\./) {
! 149: my $ext = (split(/\./,$key))[-1];
! 150: delete($filehash{$dir}{$key}) if ($ext eq 'rights');
! 151: }
! 152: }
! 153: my @names = sort { lc($a) cmp lc($b) } (keys(%{$filehash{$dir}}));
! 154: $files{$dir} = \@names;
! 155: }
! 156: }
! 157: }
! 158: $r->print(JSON::DWIW->to_json({dirs => \@dirs,
! 159: files => \%files}));
! 160: return OK;
! 161: }
! 162:
! 163: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to loncourseauthor.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface