#!/usr/bin/perl
# The LearningOnline Network
#
# $Id: refresh_courseids_db.pl,v 1.4 2010/07/24 00:01:12 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

refresh_courseids_db.pl

=head1 SYNOPSIS

refresh_courseids_db.pl is run on a library server and gathers 
course information for each course for which the current server is
the home server.  Entries (excluding last access time) for each course 
in nohist_courseids.db are updated.   

=head1 DESCRIPTION

refresh_courseids_db.pl will update course information, apart 
from last access time, in nohist_courseids.db, using course data   
from each course's environment.db file.

=cut

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

use strict;
use lib '/home/httpd/lib/perl/';
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonuserstate;
use Apache::loncoursedata;
use Apache::lonnavmaps;
use LONCAPA qw(:DEFAULT :match);

exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library');

use vars qw( %needsrelease %checkparms %checkresponsetypes %checkcrstypes);

#  Make sure this process is running from user=www
my $wwwid=getpwnam('www');
if ($wwwid!=$<) {
    my $emailto="$Apache::lonnet::perlvar{'lonAdmEMail'},$Apache::lonnet::perlvar{'lonSysEMail'}";
    my $subj="LON: $Apache::lonnet::perlvar{'lonHostID'} User ID mismatch";
    system("echo 'User ID mismatch. refresh_courseids_db.pl must be run as user www.' |\
 mail -s '$subj' $emailto > /dev/null");
    exit 1;
}
#
# Let people know we are running
open(my $fh,'>>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/logs/refreshcourseids_db.log');
print $fh "==== refresh_courseids_db.pl Run ".localtime()."====\n";

my @domains = sort(&Apache::lonnet::current_machine_domains());

&parse_releases_xml();
$env{'allowed.bre'} = 'F';

foreach my $dom (@domains) {
    my %courseshash;
    my @ids=&Apache::lonnet::current_machine_ids();
    my %currhash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',1,\@ids,'.');
    my $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom;
    my %domdesign = &Apache::loncommon::get_domainconf($dom);
    my $autoassign = $domdesign{$dom.'.autoassign.co-owners'};
    &recurse_courses($dom,$dir,0,\%courseshash,\%currhash,$autoassign,$fh);
    foreach my $lonhost (keys(%courseshash)) {
        if (ref($courseshash{$lonhost}) eq 'HASH') {
            if (&Apache::lonnet::courseidput($dom,$courseshash{$lonhost},$lonhost,'notime') eq 'ok') {
                print $fh "nohist_courseids.db updated successfully for domain $dom on lonHostID $lonhost\n";
            } else {
                print $fh "Error occurred when updating nohist_courseids.db for domain $dom on lonHostID $lonhost\n";
            }
        }
    }
}

delete($env{'allowed.bre'});

## Finished!
print $fh "==== refresh_courseids.db completed ".localtime()." ====\n";
close($fh);

sub recurse_courses {
    my ($cdom,$dir,$depth,$courseshash,$currhash,$autoassign,$fh) = @_;
    next unless (ref($currhash) eq 'HASH');
    if (-d $dir) {
        opendir(DIR,$dir);
        my @contents = grep(!/^\./,readdir(DIR));
        closedir(DIR);
        $depth ++;
        foreach my $item (@contents) {
            if ($depth < 4) {
                &recurse_courses($cdom,$dir.'/'.$item,$depth,$courseshash,
                                 $currhash,$autoassign,$fh);
            } elsif ($item =~ /^$match_courseid$/) {
                my $cnum = $item;
                my $cid = $cdom.'_'.$cnum;
                unless (ref($currhash->{$cid}) eq 'HASH') {
                    my $is_course = 0;
                    if (-e "$dir/$cnum/passwd") {
                        if (open(my $pwfh,"<$dir/$cnum/passwd")) {
                            while (<$pwfh>) {
                                if (/^none:/) {
                                    $is_course = 1;
                                    last;
                                }
                            } 
                        }
                    }
                    next unless ($is_course);
                    my @stats = stat("$dir/$cnum/passwd");
                    print $fh "Course missing from nohist_courseids.db: $cid, created:".localtime($stats[9])."\n";
                }
                my %courseinfo=&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
                my %changes = ();
                my $crstype = $courseinfo{'type'};
                if ($crstype eq '') {
                    if ($cnum =~ /^$match_community$/) {
                        $crstype = 'Community';
                    } else {
                        $crstype = 'Course';
                    }
                    $changes{'type'} = $crstype;
                }
                my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
                my $owner = $courseinfo{'internal.courseowner'};
                my (%roleshash,$gotcc,$reqdmajor,$reqdminor);
                if ($owner eq '') {
                    %roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1);
                    $gotcc = 1;
                    if (keys(%roleshash) == 1) {
                        foreach my $key (keys(%roleshash)) {
                            if ($key =~ /^($match_username\:$match_domain)\:cc$/) {
                                $owner = $1;
                                $changes{'internal.courseowner'} = $owner;
                            }
                        }
                    }
                } elsif ($owner !~ /:/) {
                    if ($owner =~ /^$match_username$/) {
                        my $ownerhome=&Apache::lonnet::homeserver($owner,$cdom);
                        unless (($ownerhome eq '') || ($ownerhome eq 'no_host')) {
                            $owner .= ':'.$cdom;
                            $changes{'internal.courseowner'} = $owner;
                        }
                    }
                }
                my $created = $courseinfo{'internal.created'};
                my $creator = $courseinfo{'internal.creator'};
                my $creationcontext = $courseinfo{'internal.creationcontext'};
                my $inst_code = $courseinfo{'internal.coursecode'};
                $inst_code = '' if (!defined($inst_code));
                $owner = '' if (!defined($owner));
                if ($created eq '') {
                    if (ref($currhash->{$cid}) eq 'HASH') {
                        $created = $currhash->{$cid}{'created'};
                        $creator = $currhash->{$cid}{'creator'};
                        $creationcontext = $currhash->{$cid}{'context'};
                        unless ($created eq '') {
                            $changes{'internal.created'} = $created;
                        }
                        if ($creator =~ /^($LONCAPA::match_username):($LONCAPA::match_domain)$/) {
                             $changes{'internal.creator'} = $creator;
                        }
                        unless ($creationcontext eq '') {
                            $changes{'internal.creationcontext'} = $creationcontext;
                        }
                    }
                    if ($created eq '') {
                        if (-e "$dir/$cnum/passwd") {
                            my @stats = stat("$dir/$cnum/passwd");
                            $created = $stats[9];
                        }
                        my %lastaccess = 
                            &Apache::lonnet::courselastaccess($cdom,$cnum);
                        if ($lastaccess{$cid}) {
                            if ($created eq '') {
                                $created = $lastaccess{$cid};
                            } elsif ($lastaccess{$cid} < $created) {
                                $created = $lastaccess{$cid};
                            }
                        }
                        unless ($created eq '') {
                            $changes{'internal.created'} = $created;
                        }
                    }
                }
                
                $env{'request.course.id'} = $cdom.'_'.$cnum;
                $env{'request.role'} = 'cc./'.$cdom.'/'.$cnum;
                &Apache::lonuserstate::readmap($cdom.'/'.$cnum);

                # check all parameters
                ($reqdmajor,$reqdminor) = &parameter_constraints($cnum,$cdom);

                # check course type
                ($reqdmajor,$reqdminor) = &coursetype_constraints($cnum,$cdom,$crstype,
                                                                 $reqdmajor,
                                                                 $reqdminor);
                # check course contents
                ($reqdmajor,$reqdminor) = &coursecontent_constraints($cnum,$cdom,
                                                                     $reqdmajor,
                                                                     $reqdminor);
                delete($env{'request.course.id'});
                delete($env{'request.role'});

                unless ($chome eq 'no_host') {
                    $courseshash->{$chome}{$cid} = {
                        description => $courseinfo{'description'},
                        inst_code   => $inst_code,
                        owner       => $owner,
                        type        => $crstype,
                    };
                    if ($creator ne '') {
                        $courseshash->{$chome}{$cid}{'creator'} = $creator;
                    }
                    if ($created ne '') {
                        $courseshash->{$chome}{$cid}{'created'} = $created;
                    }
                    if ($creationcontext ne '') {
                        $courseshash->{$chome}{$cid}{'context'} = $creationcontext;
                    }
                    if (($inst_code ne '') && ($autoassign)) {
                        unless ($gotcc) {
                            %roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1);
                        }
                        my @currcoowners;
                        my @newcoowners;
                        if ($courseinfo{'internal.co-owners'} ne '') {
                            @currcoowners = split(',',$courseinfo{'internal.co-owners'});
                        }
                        foreach my $key (keys(%roleshash)) {
                            if ($key =~ /^($match_username\:$match_domain)\:cc$/) {
                                my $cc = $1;
                                unless ($cc eq $owner) {
                                    my ($result,$desc) = &Apache::lonnet::auto_validate_instcode($cnum,$cdom,$inst_code,$cc);
                                    if ($result eq 'valid') {
                                        if (@newcoowners > 0) {
                                            unless (grep(/^\Q$cc\E$/,@newcoowners)) { 
                                                push(@newcoowners,$cc);
                                            }
                                        } else {
                                            push(@newcoowners,$cc);
                                        }
                                    }
                                }
                            }
                        }
                        my @diffs = &Apache::loncommon::compare_arrays(\@currcoowners,\@newcoowners);
                        if (@diffs > 0) {
                            if (@newcoowners > 0) {
                                $changes{'internal.co-owners'} = join(',',@newcoowners);
                                $courseshash->{$chome}{$cid}{'co-owners'} = $changes{'internal.co-owners'};
                            } else {
                                if ($courseinfo{'internal.co-owners'} ne '') {
                                    if (&Apache::lonnet::del('environment',['internal.co-owners'],$cdom,$cnum) eq 'ok') {
                                        print $fh "Former co-owner(s): $courseinfo{'internal.co-owners'} for official course: $inst_code (".$cdom."_".$cnum.") no longer active CCs, co-ownership status deleted.\n";
                                    }
                                } else {
                                    print $fh "Error occurred when updating co-ownership in course's environment.db for ".$cdom."_".$cnum."\n";
                                }
                            }
                        } elsif (@currcoowners > 0) {
                            $courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'};
                        }
                    } elsif ($courseinfo{'internal.co-owners'} ne '') {
                        $courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'};
                    }
                    foreach my $item ('categories','cloners','hidefromcat') {
                        if ($courseinfo{$item} ne '') {
                            $courseshash->{$chome}{$cid}{$item} = $courseinfo{$item}; 
                        }
                    }
                    foreach my $item ('selfenroll_types','selfenroll_start_date','selfenroll_end_date') {
                        if ($courseinfo{'internal.'.$item} ne '') {
                            $courseshash->{$chome}{$cid}{$item} =
                                $courseinfo{'internal.'.$item};
                        }
                    }
                    if ($reqdmajor ne '' && $reqdminor ne '') {
                        $courseshash->{$chome}{$cid}{'releaserequired'} = $reqdmajor.'.'.$reqdminor;
                    }
                    if ($courseinfo{'internal.releaserequired'} ne $reqdmajor.'.'.$reqdminor) {
                        $changes{'internal.releaserequired'} = $reqdmajor.'.'.$reqdminor;
                    }
                    if (keys(%changes)) {
                        if (&Apache::lonnet::put('environment',\%changes,$cdom,$cnum) eq 'ok') {
                            print $fh "Course's environment.db for ".$cdom."_".$cnum." successfully updated with following entries: ";
                            foreach my $key (sort(keys(%changes))) {
                                print $fh "$key => $changes{$key} ";
                            }
                            print $fh "\n";
                        } else {
                            print $fh "Error occurred when updating course's environment.db for ".$cdom."_".$cnum."\n";
                        }
                    }
                }
            }
        }
    }
    return;
}

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(%checkparms)) {
                if ($key =~ /(\Q$item\E)$/) {
                    if (ref($checkparms{$item}) eq 'ARRAY') {
                        my $value = $resourcedata->{$key};
                        if (grep(/^\Q$value\E$/,@{$checkparms{$item}})) {
                            my ($major,$minor) = split(/\./,$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($checkcrstypes{$crstype})) {
        my ($major,$minor) = split(/\./,$checkcrstypes{$crstype});
        ($reqdmajor,$reqdminor) = 
            &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
    }
    return ($reqdmajor,$reqdminor);
}

sub coursecontent_constraints {
    my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_;
    my $navmap = Apache::lonnavmaps::navmap->new();
    if (defined($navmap)) {
        my %allresponses;
        foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
            my %responses = $res->responseTypes();
            foreach my $key (keys(%responses)) {
                next unless(exists($checkresponsetypes{$key}));
                $allresponses{$key} += $responses{$key};
            }
        }
        foreach my $key (keys(%allresponses)) {
            my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
            ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$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,$dom)=@_;
    my $resourcedata=&Apache::lonnet::get_courseresdata($cnum,$dom);
    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=~/^$env{'request.course.id'}/) {
                    my $newkey=$userkey;
                    $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                    $$resourcedata{$newkey}=$$useropt{$userkey};
                }
            }
         }
    }
    return $resourcedata;
}

sub parse_releases_xml {
    my $file = $Apache::lonnet::perlvar{'lonTabDir'}.'/releaseslist.xml';
    if (-e $file) { 
        my $parser = HTML::LCParser->new($file);
        while (my $token = $parser->get_token()) {
            if ($token->[0] eq 'S') {
                my $item = $token->[1];
                my $name = $token->[2]{'name'};
                my $value = $token->[2]{'value'};
                if ($item ne '' && $name ne '' && $value ne '') {
                    my $release = $parser->get_text();
                    $release =~ s/(^\s*|\s*$ )//gx;
                    $needsrelease{$item}{$name}{$value} = $release;
                    if ($item eq 'parameter') {
                       if (ref($checkparms{$name}) eq 'ARRAY') {
                           unless(grep(/^\Q$name\E$/,@{$checkparms{$name}})) {
                               push(@{$checkparms{$name}},$value);
                           }
                       } else {
                           push(@{$checkparms{$name}},$value);
                       }
                    } elsif ($item eq 'resourcetag') {
                        if ($name eq 'responsetype') {
                            $checkresponsetypes{$value} = $release;
                        }
                    } elsif ($item eq 'course') {
                        if ($name eq 'crstype') {
                            $checkcrstypes{$value} = $release;
                        }
                    }
                }
            }
        }
    }
    return;
}

<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>500 Internal Server Error</title>
</head><body>
<h1>Internal Server Error</h1>
<p>The server encountered an internal error or
misconfiguration and was unable to complete
your request.</p>
<p>Please contact the server administrator at 
 root@localhost to inform them of the time this error occurred,
 and the actions you performed just before this error.</p>
<p>More information about this error may be available
in the server error log.</p>
</body></html>
