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.

# The LearningOnline Network
# Documents
#
# $Id: loncourseauthor.pm,v 1.3 2023/03/27 18:41:04 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#

package Apache::loncourseauthor;

use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::loncommon;
use JSON::DWIW;
use LONCAPA qw(:DEFAULT :match);

sub handler {
    my $r = shift;
    &Apache::loncommon::content_type($r,'application/json');
    $r->send_http_header;
    my ($nonemptydir,$addtopdir,%dirhash,%filehash);
    if ($env{'request.course.id'}) {
        if (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
            my ($context,$recurse,$role,$is_home,$inc,$exc,$toppath,$relpath,
                $include,$exclude);
            if ($env{'form.role'}) {
                $role = $env{'form.role'};
                if ($env{'form.rec'}) {
                    $recurse = 1;
                }
                if ($env{'form.res'}) {
                    $context = 'res';
                } else {
                    $context = 'priv';
                }
                if ($env{'form.inc'}) {
                    $inc = $env{'form.inc'};
                    $inc =~ s/^\s+|\s+$//g;
                }
                if ($env{'form.exc'}) {
                    $exc = $env{'form.exc'};
                    $exc  =~ s/^\s+|\s+$//g;
                }
                if ($env{'form.nonempty'}) {
                    $nonemptydir = 1; 
                }
                if ($env{'form.addtop'}) {
                    $addtopdir = 1;
                } else {
                    $addtopdir = 0;
                }
                my $now = time;
                my @ids=&Apache::lonnet::current_machine_ids();
                if ($role eq 'author') {
                    if (exists($env{"user.role.au./$env{'user.domain'}/"})) {
                        my ($start,$end) = split(/\./,$env{"user.role.au./$env{'user.domain'}/"});
                        unless (($start && $start > $now) || ($end && $end < $now)) {
                            $toppath = "/$context/$env{'user.domain'}/$env{'user.name'}";
                            if (grep(/^\Q$env{'user.home'}\E$/,@ids)) {
                                $is_home = 1;
                            }
                        }
                    }
                } elsif ($role eq 'course') {
                    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    if (($cdom ne '') && ($cnum ne '')) {
                        $toppath = "/$context/$cdom/$cnum";
                        my $rolehome = &Apache::lonnet::homeserver($cnum,$cdom);
                        if (grep(/^\Q$rolehome\E$/,@ids)) {
                            $is_home = 1;
                        } 
                    }
                } elsif ($role =~ m{^(ca|aa)\./($match_domain)/($match_username)$}) {
                    my ($rolecode,$audom,$auname) = ($1,$2,$3);
                    if (exists($env{"user.role.$role"})) {
                        my ($start,$end) = split(/\./,$env{"user.role.$role"});
                        unless(($start && $start > $now) || ($end && $end < $now)) {
                            $toppath = "/$context/$audom/$auname";
                            my $rolehome = &Apache::lonnet::homeserver($auname,$audom);
                            if (grep(/^\Q$rolehome\E$/,@ids)) {
                                $is_home = 1;
                            }
                        }
                    }
                }
                if ($toppath ne '') {
                    if ($env{'form.path'}) {
                        $relpath = $env{'form.path'};
                    }
                    my @ids=&Apache::lonnet::current_machine_ids();
                    if (grep(/^\Q$env{'user.home'}\E$/,@ids)) {
                        $is_home = 1;
                    }
                    if ($inc) {
                        map { $include->{$_} = 1; } split(/\s*,\s*/,$inc);
                    }
                    if ($exc) {
                        map { $exclude->{$_} = 1; } split(/\s*,\s*/,$exc);
                    }
                    my $dirhashref = \%dirhash;
                    my $filehashref; 
                    if ($env{'form.files'}) {
                        $filehashref = \%filehash;
                    }
                    &Apache::lonnet::recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,
                                                 $addtopdir,$toppath,$relpath,$dirhashref,$filehashref);
                }
            }
        }
    }
    my @dirs = ();
    if (%dirhash) {
        if ($dirhash{'/'}) {
            push(@dirs,'/');
            delete($dirhash{'/'});
        }
        if ($nonemptydir) {
            foreach my $dir (sort { lc($a) cmp lc($b) } (keys(%dirhash))) {
                next unless (ref($filehash{$dir}) eq 'HASH');
                push(@dirs,$dir);
            }
        } else {
            push(@dirs,(sort { lc($a) cmp lc($b) } (keys(%dirhash))));
        }
    }
    my %files;
    if (%filehash) {
        foreach my $dir (keys(%filehash)) {
            if (ref($filehash{$dir}) eq 'HASH') {
                foreach my $key (keys(%{$filehash{$dir}})) {
                    if ($key =~ /\./) {
                        my $ext = (split(/\./,$key))[-1];
                        delete($filehash{$dir}{$key}) if ($ext eq 'rights');
                    }
                }
                my @names = sort { lc($a) cmp lc($b) } (keys(%{$filehash{$dir}}));
                $files{$dir} = \@names;
            }
        }
    }
    $r->print(JSON::DWIW->to_json({dirs => \@dirs,
                                   files => \%files}));
    return OK;
}

1;