Return to loncourseauthor.pm CVS log

Up to [LON-CAPA] / loncom / interface

- "In course" authoring.
 - Display form items and "Create problem" button when location selected
   is "Course Resource" and no subdirectories exist currently.

    1: # The LearningOnline Network
    2: # Documents
    3: #
    4: # $Id: loncourseauthor.pm,v 1.2 2023/03/23 22:53:46 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:     } elsif (($env{'form.role'} eq 'course') && ($env{'form.path'} eq '') && (!$env{'form.nonempty'})) {
  143:         push(@dirs,'/');
  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;