![[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.2 ! raeburn 4: # $Id: loncourseauthor.pm,v 1.1 2022/12/31 14:08:59 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;
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: }
1.2 ! raeburn 90: } elsif ($role =~ m{^(ca|aa)\./($match_domain)/($match_username)$}) {
1.1 raeburn 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: }
1.2 ! raeburn 142: } elsif (($env{'form.role'} eq 'course') && ($env{'form.path'} eq '') && (!$env{'form.nonempty'})) {
! 143: push(@dirs,'/');
1.1 raeburn 144: }
145: my %files;
146: if (%filehash) {
147: foreach my $dir (keys(%filehash)) {
148: if (ref($filehash{$dir}) eq 'HASH') {
149: foreach my $key (keys(%{$filehash{$dir}})) {
150: if ($key =~ /\./) {
151: my $ext = (split(/\./,$key))[-1];
152: delete($filehash{$dir}{$key}) if ($ext eq 'rights');
153: }
154: }
155: my @names = sort { lc($a) cmp lc($b) } (keys(%{$filehash{$dir}}));
156: $files{$dir} = \@names;
157: }
158: }
159: }
160: $r->print(JSON::DWIW->to_json({dirs => \@dirs,
161: files => \%files}));
162: return OK;
163: }
164:
165: 1;