![[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|
Return to loncourseauthor.pm CVS log | Up to [LON-CAPA] / loncom / interface |
1.1 raeburn 1: # The LearningOnline Network
2: # Documents
3: #
1.3 ! raeburn 4: # $Id: loncourseauthor.pm,v 1.2 2023/03/23 22:53:46 raeburn Exp $
1.1 raeburn 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;
1.3 ! raeburn 42: my ($nonemptydir,$addtopdir,%dirhash,%filehash);
1.1 raeburn 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: }
1.3 ! raeburn 68: if ($env{'form.addtop'}) {
! 69: $addtopdir = 1;
! 70: } else {
! 71: $addtopdir = 0;
! 72: }
1.1 raeburn 73: my $now = time;
74: my @ids=&Apache::lonnet::current_machine_ids();
75: if ($role eq 'author') {
76: if (exists($env{"user.role.au./$env{'user.domain'}/"})) {
77: my ($start,$end) = split(/\./,$env{"user.role.au./$env{'user.domain'}/"});
78: unless (($start && $start > $now) || ($end && $end < $now)) {
79: $toppath = "/$context/$env{'user.domain'}/$env{'user.name'}";
80: if (grep(/^\Q$env{'user.home'}\E$/,@ids)) {
81: $is_home = 1;
82: }
83: }
84: }
85: } elsif ($role eq 'course') {
86: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
87: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
88: if (($cdom ne '') && ($cnum ne '')) {
89: $toppath = "/$context/$cdom/$cnum";
90: my $rolehome = &Apache::lonnet::homeserver($cnum,$cdom);
91: if (grep(/^\Q$rolehome\E$/,@ids)) {
92: $is_home = 1;
93: }
94: }
1.2 raeburn 95: } elsif ($role =~ m{^(ca|aa)\./($match_domain)/($match_username)$}) {
1.1 raeburn 96: my ($rolecode,$audom,$auname) = ($1,$2,$3);
97: if (exists($env{"user.role.$role"})) {
98: my ($start,$end) = split(/\./,$env{"user.role.$role"});
99: unless(($start && $start > $now) || ($end && $end < $now)) {
100: $toppath = "/$context/$audom/$auname";
101: my $rolehome = &Apache::lonnet::homeserver($auname,$audom);
102: if (grep(/^\Q$rolehome\E$/,@ids)) {
103: $is_home = 1;
104: }
105: }
106: }
107: }
108: if ($toppath ne '') {
109: if ($env{'form.path'}) {
110: $relpath = $env{'form.path'};
111: }
112: my @ids=&Apache::lonnet::current_machine_ids();
113: if (grep(/^\Q$env{'user.home'}\E$/,@ids)) {
114: $is_home = 1;
115: }
116: if ($inc) {
117: map { $include->{$_} = 1; } split(/\s*,\s*/,$inc);
118: }
119: if ($exc) {
120: map { $exclude->{$_} = 1; } split(/\s*,\s*/,$exc);
121: }
122: my $dirhashref = \%dirhash;
123: my $filehashref;
124: if ($env{'form.files'}) {
125: $filehashref = \%filehash;
126: }
127: &Apache::lonnet::recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,
1.3 ! raeburn 128: $addtopdir,$toppath,$relpath,$dirhashref,$filehashref);
1.1 raeburn 129: }
130: }
131: }
132: }
133: my @dirs = ();
134: if (%dirhash) {
135: if ($dirhash{'/'}) {
136: push(@dirs,'/');
137: delete($dirhash{'/'});
138: }
139: if ($nonemptydir) {
140: foreach my $dir (sort { lc($a) cmp lc($b) } (keys(%dirhash))) {
141: next unless (ref($filehash{$dir}) eq 'HASH');
142: push(@dirs,$dir);
143: }
144: } else {
145: push(@dirs,(sort { lc($a) cmp lc($b) } (keys(%dirhash))));
146: }
147: }
148: my %files;
149: if (%filehash) {
150: foreach my $dir (keys(%filehash)) {
151: if (ref($filehash{$dir}) eq 'HASH') {
152: foreach my $key (keys(%{$filehash{$dir}})) {
153: if ($key =~ /\./) {
154: my $ext = (split(/\./,$key))[-1];
155: delete($filehash{$dir}{$key}) if ($ext eq 'rights');
156: }
157: }
158: my @names = sort { lc($a) cmp lc($b) } (keys(%{$filehash{$dir}}));
159: $files{$dir} = \@names;
160: }
161: }
162: }
163: $r->print(JSON::DWIW->to_json({dirs => \@dirs,
164: files => \%files}));
165: return OK;
166: }
167:
168: 1;