#!/usr/bin/perl
# The LearningOnline Network
#
# $Id: lonrelrequtils.pm,v 1.1 2014/06/07 19:13:42 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/
#
#################################################

=pod

=head1 NAME

lonrelrequtils.pm

=head1 SYNOPSIS

Contains utilities used to determine the LON-CAPA version 
requirement in a course, based on course type, parameters,
responsetypes, and communication blocking events.

=head1 DESCRIPTION

lonrelrequtilities.pm includes a main subroutine:
get_release_req() which will return the current major
version and minor version requirement (if it exists).

=head1 SUBROUTINES

=over

=item &init_global_hashes()

Initializes package hashes containing version requirements for 
parameters, responsetypes, course types, anonsurvey 
parameter, and randomizetry parameter.

=item &get_release_req()

Returns current major version and minor version requirements for a course,
based on: coursetype, parameters in use, responsetypes in use in course
content, and communication blocking features in use in blocks with end dates
in the future, or in blocks triggered by activation of a timer in a timed quiz.

Inputs: 5

=over

=item $cnum - course "number"

=item $cdom - course domain

=item $crstype - course type: Community or Course

=item $readmap - boolean; if true, read course's top level map, and any
                 included maps recursively.

=item $globals_set - boolean: if false, call init_global_hashes

=back


=item &parameter_constraints()

Returns major version and minor version requirements for a course,
based on parameters in use in the course. (Parameters which have
version requirements are listed in /home/httpd/lonTabs/releaseslist.xml

Inputs: 2

=over

=item $cnum - course "number"

=item $cdom - course domain

=back


=item &coursetype_constraints()

Returns major version and minor version requirements for a course,
taking into account course type (Community or Course).

Inputs: 5

=over

=item $cnum - course "number"

=item $cdom - course domain

=item $crstype - course type: Community or Course

=item $reqdmajor - major version requirements based on constraints 
                   considered so far (parameters).

=item $reqdminor - minor version requirements based on constraints 
                   considered so far (parameters).
 
=back


=item &commblock_constraints()

Returns major version and minor version requirements for a course,
taking into account use of communication blocking (blocks for
printouts, specified folders/resources, and/or triggering of block
by a student starting a timed quiz.

Inputs: 4

=over

=item $cnum - course "number"

=item $cdom - course domain

=item $reqdmajor - major version requirements based on constraints 
                   considered so far (parameters and course type).

=item $reqdminor - minor version requirements based on constraints
                   considered so far (parameters and course type).

=back


=item &coursecontent_constraints()

Returns major version and minor version requirements for a course,
taking into responsetypes in use in published assessment items
imported into a course.

Inputs: 4

=over

=item $cnum - course "number"

=item $cdom - course domain

=item $reqdmajor - major version requirements based on constraints
                   considered so far (parameters, course type, blocks).

=item $reqdminor - minor version requirements based on constraints
                   considered so far (parameters, course type, blocks).

=back


=item &update_reqd_loncaparev()

Returns major version and minor version requirements for a course,
taking into account new constraint type.

Inputs: 4

=over

=item $major - major version requirements from new constraint type

=item $minor - minor version requirements from new constraint type

=item $reqdmajor - major version requirements from constraints
                   considered so far.

=item $reqdminor - minor version requirements from constraints
                   considered so far.

=back


=item &read_paramdata()

Returns a reference to a hash populated with parameter settings in a
course (set both generally, and for specific students).

Inputs: 2

=over

=item $cnum - course "number"

=item $cdom - course domain

=back


=item &modify_course_relreq()

Updates course's minimum version requirement (internal.releaserequired) in 
course's environment.db, and in user's current session, and in course's
record in nohist_courseids.db on course's home server.  This can include
deleting an existing version requirement, downgrading to an earlier version,
or updating to a newer version.

Note: if the current server's LON-CAPA version is older than the course's
current version requirement, and a downgrade to an earlier version is being
proposed, the change will NOT be made, because of the possibility that the
current server has not checked for an attribute only available with a more 
recent version of LON-CAPA.

Inputs: 9

=over

=item $newmajor - (optional) major version requirements

=item $newminor - (optional) minor version requirements

=item $cnum - course "number"

=item $cdom - course domain

=item $chome - lonHostID of course's home server

=item $crstype - course type: Community or Course

=item $cid - course ID

=item $readmap - boolean; if true, read course's top level map, and any
                 included maps recursively.

=item $getrelreq - boolean; if true, call &get_release_req() to 
      return the current major version and minor version requirements.
      (needed if optional args: $newmajor and $newminor are not passed).

=back

=back

=cut

#################################################

package Apache::lonrelrequtils;

use strict;
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonuserstate();
use Apache::loncoursedata();
use Apache::lonnavmaps();
use LONCAPA qw(:DEFAULT :match);

sub init_global_hashes {
    %Apache::lonrelrequtils::checkparms = ();
    %Apache::lonrelrequtils::checkresponsetypes = ();
    %Apache::lonrelrequtils::checkcrstypes = ();
    %Apache::lonrelrequtils::anonsurvey = ();
    %Apache::lonrelrequtils::randomizetry = ();

    foreach my $key (keys(%Apache::lonnet::needsrelease)) {
        my ($item,$name,$value) = split(/:/,$key);
        if ($item eq 'parameter') {
            if (ref($Apache::lonrelrequtils::checkparms{$name}) eq 'ARRAY') {
                unless(grep(/^\Q$name\E$/,@{$Apache::lonrelrequtils::checkparms{$name}})) {
                    push(@{$Apache::lonrelrequtils::checkparms{$name}},$value);
                }
            } else {
                push(@{$Apache::lonrelrequtils::checkparms{$name}},$value);
            }
        } elsif ($item eq 'resourcetag') {
            if ($name eq 'responsetype') {
                $Apache::lonrelrequtils::checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
            }
        } elsif ($item eq 'course') {
            if ($name eq 'crstype') {
                $Apache::lonrelrequtils::checkcrstypes{$value} = $Apache::lonnet::needsrelease{$key};
            }
        }
    }
    ($Apache::lonrelrequtils::anonsurvey{major},$Apache::lonrelrequtils::anonsurvey{minor}) =
        split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
    ($Apache::lonrelrequtils::randomizetry{major},$Apache::lonrelrequtils::randomizetry{minor}) =
        split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
    return;
}

sub get_release_req {
    my ($cnum,$cdom,$crstype,$readmap,$globals_set) = @_;
    if ($readmap) {
        &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
    }
    unless ($globals_set) {
        &init_global_hashes();
    }
    # check all parameters
    my ($reqdmajor,$reqdminor) = &parameter_constraints($cnum,$cdom);

    # check course type
    ($reqdmajor,$reqdminor) = &coursetype_constraints($cnum,$cdom,$crstype,$reqdmajor,
                                                      $reqdminor);
    # check communication blocks
    ($reqdmajor,$reqdminor) = &commblock_constraints($cnum,$cdom,$reqdmajor,$reqdminor);

    # check course contents
    ($reqdmajor,$reqdminor) = &coursecontent_constraints($cnum,$cdom,$reqdmajor,$reqdminor);
    return ($reqdmajor,$reqdminor);
}

sub parameter_constraints {
    my ($cnum,$cdom) = @_;
    my ($reqdmajor,$reqdminor);
    my $resourcedata=&read_paramdata($cnum,$cdom);
    if (ref($resourcedata) eq 'HASH') {
        foreach my $key (keys(%{$resourcedata})) {
            foreach my $item (keys(%Apache::lonrelrequtils::checkparms)) {
                if ($key =~ /(\Q$item\E)$/) {
                    if (ref($Apache::lonrelrequtils::checkparms{$item}) eq 'ARRAY') {
                        my $value = $resourcedata->{$key};
                        if ($item eq 'examcode') {
                            if (&Apache::lonnet::validCODE($value)) {
                                $value = 'valid';
                            } else {
                                $value = '';
                            }
                        }
                        if (grep(/^\Q$value\E$/,@{$Apache::lonrelrequtils::checkparms{$item}})) {
                            my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'parameter:'.$item.':'.$value});
                            ($reqdmajor,$reqdminor) =
                                &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
                        }
                    }
                }
            }
        }
    }
    return ($reqdmajor,$reqdminor);
}

sub coursetype_constraints {
    my ($cnum,$cdom,$crstype,$reqdmajor,$reqdminor) = @_;
    if (defined($Apache::lonrelrequtils::checkcrstypes{$crstype})) {
        my ($major,$minor) = split(/\./,$Apache::lonrelrequtils::checkcrstypes{$crstype});
        ($reqdmajor,$reqdminor) =
            &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
    }
    return ($reqdmajor,$reqdminor);
}

sub commblock_constraints {
    my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_;
    my %comm_blocks =  &Apache::lonnet::dump('comm_block',$cdom,$cnum);
    my $now = time;
    if (keys(%comm_blocks) > 0) {
        foreach my $block (keys(%comm_blocks)) {
            if ($block =~ /^firstaccess____(.+)$/) {
                my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course:commblock:timer'});
                ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
                last;
            } elsif ($block =~ /^(\d+)____(\d+)$/) {
                my ($start,$end) = ($1,$2);
                next if ($end < $now);
            }
            if (ref($comm_blocks{$block}) eq 'HASH') {
                if (ref($comm_blocks{$block}{'blocks'}) eq 'HASH') {
                    if (ref($comm_blocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
                        if (keys(%{$comm_blocks{$block}{'blocks'}{'docs'}}) > 0) {
                            my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course:commblock:docs'});
                            ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
                            last;
                        }
                    }
                    if ($comm_blocks{$block}{'blocks'}{'printout'} eq 'on') {
                        my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course:commblock:printout'});
                        ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
                        last;
                    }
                }
            }
        }
    }
    return ($reqdmajor,$reqdminor);
}

sub coursecontent_constraints {
    my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_;
    my $navmap = Apache::lonnavmaps::navmap->new();
    if (defined($navmap)) {
        my %anonsubmissions =  &Apache::lonnet::dump('nohist_anonsurveys',
                                                     $cdom,$cnum);
        my %randomizetrysubm = &Apache::lonnet::dump('nohist_randomizetry',
                                                     $cdom,$cnum);
        my %allresponses;
        my ($anonsurv_subm,$randbytry_subm);
        foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
            my %responses = $res->responseTypes();
            foreach my $key (keys(%responses)) {
                next unless(exists($Apache::lonrelrequtils::checkresponsetypes{$key}));
                $allresponses{$key} += $responses{$key};
            }
            my @parts = @{$res->parts()};
            my $symb = $res->symb();
            foreach my $part (@parts) {
                if (exists($anonsubmissions{$symb."\0".$part})) {
                    $anonsurv_subm = 1;
                }
                if (exists($randomizetrysubm{$symb."\0".$part})) {
                    $randbytry_subm = 1;
                }
            }
        }
        foreach my $key (keys(%allresponses)) {
            my ($major,$minor) = split(/\./,$Apache::lonrelrequtils::checkresponsetypes{$key});
            ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
        }
        if ($anonsurv_subm) {
            ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($Apache::lonrelrequtils::anonsurvey{major},
                                          $Apache::lonrelrequtils::anonsurvey{minor},$reqdmajor,$reqdminor);
        }
        if ($randbytry_subm) {
            ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($Apache::lonrelrequtils::randomizetry{major},
                                          $Apache::lonrelrequtils::randomizetry{minor},$reqdmajor,$reqdminor);
        }
    }
    return ($reqdmajor,$reqdminor);
}

sub update_reqd_loncaparev {
    my ($major,$minor,$reqdmajor,$reqdminor) = @_;
    if (($major ne '' && $major !~ /\D/) & ($minor ne '' && $minor !~ /\D/)) {
        if ($reqdmajor eq '' || $reqdminor eq '') {
            $reqdmajor = $major;
            $reqdminor = $minor;
        } elsif (($major > $reqdmajor) ||
            ($major == $reqdmajor && $minor > $reqdminor))  {
            $reqdmajor = $major;
            $reqdminor = $minor;
        }
    }
    return ($reqdmajor,$reqdminor);
}

sub read_paramdata {
    my ($cnum,$cdom)=@_;
    my $resourcedata=&Apache::lonnet::get_courseresdata($cnum,$cdom);
    my $classlist=&Apache::loncoursedata::get_classlist();
    foreach my $student (keys(%{$classlist})) {
        if ($student =~/^($LONCAPA::match_username)\:($LONCAPA::match_domain)$/) {
            my ($tuname,$tudom)=($1,$2);
            my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
            foreach my $userkey (keys(%{$useropt})) {
                if ($userkey=~/^\Q$cdom\E_\Q$cnum\E/) {
                    my $newkey=$userkey;
                    $newkey=~s/^(\Q$cdom\E_\Q$cnum\E\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                    $$resourcedata{$newkey}=$$useropt{$userkey};
                }
            }
        }
    }
    return $resourcedata;
}

sub modify_course_relreq {
    my ($newmajor,$newminor,$cnum,$cdom,$chome,$crstype,$cid,$readmap,$getrelreq) = @_;
    if ($cnum eq '' || $cdom eq '' || $chome eq '' || $crstype eq '' || $cid eq '') {
        $cid = $env{'request.course.id'};
        $cdom = $env{'course.'.$cid.'.domain'};
        $cnum = $env{'course.'.$cid.'.num'};
        $chome = $env{'course.'.$cid.'.home'};
        $crstype = $env{'course.'.$cid.'.type'};
        if ($crstype eq '') {
            $crstype = 'Course';
        }
    }
    if ($getrelreq) {
        ($newmajor,$newminor) = &get_release_req($cnum,$cdom,$crstype,$readmap);
    }
    my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
    my $needsupdate;
    if ($curr_reqd_hash{'internal.releaserequired'} eq '') {
        if (($newmajor ne '') && ($newminor ne '')) { 
            $needsupdate = 1;
        }
    } else {
        my ($currmajor,$currminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
        my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
        my $serverdom = $Apache::lonnet::perlvar{'lonDefDomain'};
        my $serverrev = &Apache::lonnet::get_server_loncaparev($serverdom,$lonhost);
        my ($servermajor,$serverminor) = split(/\./,$serverrev);     
        unless (($currmajor > $servermajor) || (($currmajor == $servermajor) && ($currminor > $serverminor))) {
            if (($currmajor != $newmajor) || ($currminor != $newminor)) {
                $needsupdate = 1;
            }
        }
    }
    if ($needsupdate) {
        my %crsinfo = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,undef,undef,'.');
        my $result;
        if (($newmajor eq '') && ($newminor eq '')) {
            $result = &Apache::lonnet::del('environment',['internal.releaserequired'],$cdom,$cnum);
            if ($result eq 'ok') {
                &Apache::lonnet::delenv('course.'.$cid.'.internal.releaserequired');
                $crsinfo{$cid}{'releaserequired'} = '';
            }
        } else {
            my %needshash = (
                              'internal.releaserequired' => $newmajor.'.'.$newminor,
                            );
            $result = &Apache::lonnet::put('environment',\%needshash,$cdom,$cnum);
            if ($result eq 'ok') {
                &Apache::lonnet::appenv({'course.'.$cid.'.internal.releaserequired' => $newmajor.'.'.$newminor});
                if (ref($crsinfo{$cid}) eq 'HASH') {
                    $crsinfo{$cid}{'releaserequired'} = $newmajor.'.'.$newminor
                }
            }
        }
        if ($result eq 'ok') {
            &Apache::lonnet::courseidput($cdom,\%crsinfo,$chome,'notime');
        }
    }
    return;
}

1;