Return to loncourseauthor.pm CVS log

Up to [LON-CAPA] / loncom / interface

- "In course" authoring.
  Improved handling of case where no suitable resources authored in course
  exist when (a) using "Import from Course Resources" in Course Editor, and
  (b) using Choose File >  "Use a course file" to select published file as src
  in img tag in colorful editor.

    1: # The LearningOnline Network
    2: # Documents
    3: #
    4: # $Id: loncourseauthor.pm,v 1.3 2023/03/27 18:41:04 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,$addtopdir,%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:                 if ($env{'form.addtop'}) {
   69:                     $addtopdir = 1;
   70:                 } else {
   71:                     $addtopdir = 0;
   72:                 }
   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:                     }
   95:                 } elsif ($role =~ m{^(ca|aa)\./($match_domain)/($match_username)$}) {
   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,
  128:                                                  $addtopdir,$toppath,$relpath,$dirhashref,$filehashref);
  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;