Return to lonsearchcourse.pm CVS log

Up to [LON-CAPA] / loncom / interface

- Bug 6955 IP-based blocking. Pass user'sIP address as third arg to
  loncommon::blockcheck() and second to loncommon::blocking_status().

# The LearningOnline Network with CAPA
# Search Course
#
# $Id: lonsearchcourse.pm,v 1.7 2021/11/30 15:55:37 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::lonsearchcourse;

use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use GDBM_File;
use Apache::loncommon();
use Apache::lonmeta;
use Apache::lonhtmlcommon;
use Apache::lonlocal;
use LONCAPA::lonmetadata();
use HTML::Entities();
use Apache::lonnavmaps;
use Apache::lonnavdisplay();
use Apache::lonindexer();
use LONCAPA;

# Variables For course search
my %alreadyseen;
my %hash;
my $totalfound;


sub menu {
    my $scrout='';
    if ($env{'request.course.id'}) {
        my %lt=&Apache::lonlocal::texthash(
         'srch' => 'Search',
         'note' => 'Search terms',
         'options' => 'Options',
         'use' => 'use related words',
         'full' =>'fulltext search (time consuming)',
         'disc' => 'search discussion postings (resources and discussion boards)',
                                           );
        $scrout.=(<<ENDCOURSESEARCH);
<form name="loncapa_search" method="post" action="/adm/searchcourse">
<input type="hidden" name="phase" value="results" />
ENDCOURSESEARCH
       $scrout.=&Apache::lonhtmlcommon::start_pick_box().
                &Apache::lonhtmlcommon::row_title($lt{'note'}).
                &Apache::lonhtmlcommon::textbox('courseexp',
                                  $env{'form.courseexp'},40).
                &Apache::lonhtmlcommon::row_closure().
                &Apache::lonhtmlcommon::row_title($lt{'options'}).
                '<label>'.&Apache::lonhtmlcommon::checkbox('crsfulltext',$env{'form.crsfulltext'}).$lt{'full'}."</label><br />\n".
                '<label>'.&Apache::lonhtmlcommon::checkbox('crsrelated',$env{'form.crsrelated'}).$lt{'use'}."</label><br />\n".
                '<label>'.&Apache::lonhtmlcommon::checkbox('crsdiscuss',$env{'form.crsdiscuss'}).$lt{'disc'}."</label><br />\n".
                &Apache::lonhtmlcommon::end_pick_box();
        $scrout.=(<<ENDENDCOURSE);
<p>
<input type="submit" name="coursesubmit" value='$lt{'srch'}' />
</p>
</form>
ENDENDCOURSE
    }
    return $scrout;
}

sub make_symb {
    my ($id)=@_;
    my ($mapid,$resid)=split(/\./,$id);
    my $map=$hash{'map_id_'.$mapid};
    my $res=$hash{'src_'.$id};
    my $symb=&Apache::lonnet::encode_symb($map,$resid,$res);
    return $symb;
}

sub related_version {
    my ($word) = @_;
    return (undef) if (lc($word) =~ /\b(or|and|not)\b/);
    my @Words = &Apache::loncommon::get_related_words($word);
    # Only use 4 related words
    @Words = ($#Words>4? @Words[0..4] : @Words);
    my $result = join " OR ", ($word,@Words);
    return $result,sort(@Words);
}

sub course_search {
    my $r=shift;
    my $pretty_search_string = '<b>'.$env{'form.courseexp'}.'</b>';
    my $search_string = $env{'form.courseexp'};
    my @New_Words;
    undef(%alreadyseen);
    if ($env{'form.crsrelated'}) {
        ($search_string,@New_Words) = &related_version($env{'form.courseexp'});
        if (@New_Words) {
            $pretty_search_string .= ' '.&mt("with related words").": <b>@New_Words</b>.";
        } else {
            $pretty_search_string .= ' '.&mt('with no related words').".";
        }
    }
    my $fulltext=$env{'form.crsfulltext'};
    my $discuss=$env{'form.crsdiscuss'};
    my @allwords=($search_string,@New_Words);
    $totalfound=0;

    $r->print(
              '<hr /><center><font size="+2" face="arial">'.
              $pretty_search_string.'</font></center>'.
              '<hr /><b>'.&mt('Course content').':</b><br />');
    $r->rflush();
# ======================================================= Go through the course
    my $c=$r->connection;
    if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.".db",
            &GDBM_READER(),0640)) {
        foreach (sort(keys(%hash))) {
            if ($c->aborted()) { last; }
            if (($_=~/^src\_(.+)$/)) {
                if ($hash{'randomout_'.$1} & !$env{'request.role.adv'}) {
                    next;
                }
                my $symb=&make_symb($1);
                &checkonthis($r,$1,$hash{$_},0,&Apache::lonnet::gettitle($symb),
                             $fulltext,$symb,@allwords);
            }
        }
        untie(%hash);
    }
    unless ($totalfound) {
        $r->print('<p class="LC_info">'.&mt('No matches found in resources.').'</p>');
    }

# Check discussions if requested
    if ($discuss) {
        my $totaldiscussions = 0;
        $r->print('<br /><br /><b>'.&mt('Discussion postings').':</b><br />');
        my $navmap = Apache::lonnavmaps::navmap->new();
        if (defined($navmap)) {
            my @allres=$navmap->retrieveResources();
            my %discussiontime = &Apache::lonnet::dump('discussiontimes',
                                   $env{'course.'.$env{'request.course.id'}.'.domain'},
                                   $env{'course.'.$env{'request.course.id'}.'.num'});
            foreach my $resource (@allres) {
                my $result = '';
                my $applies = 0;
                my $symb = $resource->symb();
                my $ressymb = $symb;
                if ($symb =~ m#(___adm/$LONCAPA::domain_re/$LONCAPA::username_re)/(\d+)/bulletinboard$#) {
                    $ressymb = 'bulletin___'.$2.$1.'/'.$2.'/bulletinboard';
                    unless ($ressymb =~ m#bulletin___\d+___adm/wrapper#) {
                        $ressymb=~s#(bulletin___\d+___)#$1adm/wrapper/#;
                    }
                }
                if (defined($discussiontime{$ressymb})) {
                    my %contrib = &Apache::lonnet::restore($ressymb,$env{'request.course.id'},
                         $env{'course.'.$env{'request.course.id'}.'.domain'},
                         $env{'course.'.$env{'request.course.id'}.'.num'});
                    if ($contrib{'version'}) {
                        for (my $id=1;$id<=$contrib{'version'};$id++) {
                            unless (($contrib{'hidden'}=~/\.$id\./) || ($contrib{'deleted'}=~/\.$id\./)) {
                                if ($contrib{$id.':subject'}) {
                                    $result .= $contrib{$id.':subject'};
                                }
                                if ($contrib{$id.':message'}) {
                                    $result .= $contrib{$id.':message'};
                                }
                                if ($contrib{$id,':attachmenturl'}) {
                                    if ($contrib{$id,':attachmenturl'} =~ m-/([^/]+)$-) {
                                        $result .= $1;
                                    }
                                }
                                $applies = &checkwords($result,$applies,@allwords);
                            }
                        }
                    }
                }
# Does this discussion apply?
                if ($applies) {
                    my ($map,$ind,$url)=&Apache::lonnet::decode_symb($ressymb);
                    my $disctype = &mt('resource');
                    if ($url =~ m#/bulletinboard$#) {
                        if ($url =~m#^adm/wrapper/adm/.*/bulletinboard$#) {
                            $url =~s#^adm/wrapper##;
                        }
                        $disctype = &mt('discussion board');
                    } else {
                        $url = '/res/'.$url;
                    }
                    if ($url =~ /\?/) {
                        $url .= '&amp;symb=';
                    } else {
                        $url .= '?symb=';
                    }
                    $url .= &escape($resource->symb());
                    my $title = $resource->compTitle();
                    $r->print('<br /><a href="'.$url.'" target="cat">'.
                         ($title?$title:$url).'</a>&nbsp;&nbsp;-&nbsp;'.
                         $disctype.'<br />');
                    $totaldiscussions++;
                } else {
                    $r->print(' .');
                }
            }
            unless ($totaldiscussions) {
                $r->print('<p class="LC_info">'.&mt('No matches found in postings.').'</p>');
            }
        } else {
            $r->print('<div class="LC_error">'.&mt('An error occurred retrieving information about resources in the course.').'<br />'.&mt('It is recommended that you [_1]re-initialize the course[_2] and then try your search again.','<a href="/adm/roles">','</a>').'</div>');
        }
    }
}

# =============================== This pulls up a resource and its dependencies

sub checkonthis {
    my ($r,$id,$url,$level,$title,$fulltext,$symb,@allwords)=@_;
    $alreadyseen{$id}=1;
    if (&Apache::loncommon::connection_aborted($r)) { return; }
    $r->rflush();

    my $result=$title.' ';
    if ($env{'request.role.adv'} || !$hash{'encrypted_'.$id}) {
        $result.=&Apache::lonnet::metadata($url,'title').' '.
            &Apache::lonnet::metadata($url,'subject').' '.
            &Apache::lonnet::metadata($url,'abstract').' '.
            &Apache::lonnet::metadata($url,'keywords');
    }
    my ($extension)=($url=~/\.(\w+)$/);
    if (&Apache::loncommon::fileembstyle($extension) eq 'ssi' &&
        ($url) && ($fulltext)) {
        $result.=&Apache::lonnet::ssi_body($url.'?symb='.&escape($symb));
    }
    $result=~s/\s+/ /gs;
    my $applies = 0;
    $applies = &checkwords($result,$applies,@allwords);
# Does this resource apply?
    if ($applies) {
       $r->print('<br />');
       for (my $i=0;$i<=$level*5;$i++) {
           $r->print('&nbsp;');
       }
       my $href=$url;
       if ($hash{'encrypted_'.$id} && !$env{'request.role.adv'}) {
           $href=&Apache::lonenc::encrypted($href)
               .'?symb='.&Apache::lonenc::encrypted($symb);
       } else {
           $href.='?symb='.&escape($symb);
       }
       $r->print('<a href="'.$href.'" target="cat">'.($title?$title:$url).
                 '</a><br />');
       $totalfound++;
    } elsif ($fulltext) {
       $r->print(' .');
    }
    $r->rflush();
# Check also the dependencies of this one
    my $dependencies=
                &Apache::lonnet::metadata($url,'dependencies');
    foreach (split(/\,/,$dependencies)) {
       if (($_=~/^\/res\//) && (!$alreadyseen{$id})) {
          &checkonthis($r,$id,$_,$level+1,'',$fulltext,undef,@allwords);
       }
    }
}

sub checkwords {
    my ($result,$applies,@allwords) = @_;
    foreach (@allwords) {
        if ($_=~/\w/) {
            if ($result=~/$_/si) {
                $applies++;
            }
        }
    }
    return $applies;
}

sub untiehash {
    if (tied(%hash)) {
        untie(%hash);
    }
}

sub handler {
    my $r = shift;
    &Apache::loncommon::content_type($r,'text/html');
    $r->send_http_header;
    if ($r->header_only) { return OK; }

    my $crstype = &Apache::loncommon::course_type();
    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['phase']);
    $r->print(&Apache::loncommon::start_page("$crstype Search"));
    &Apache::lonhtmlcommon::clear_breadcrumbs();
    if ($env{'request.course.id'} eq '') {
        $r->print(&Apache::lonhtmlcommon::breadcrumbs("$crstype Search"));
        $r->print(&Apache::loncommon::end_page());
        my $requrl = $r->uri;
        $env{'user.error.msg'} = "$requrl:bre:0:0:Course not initialized";
        $env{'user.reinit'} = 1;
        return HTTP_NOT_ACCEPTABLE;
    }
    &Apache::lonhtmlcommon::add_breadcrumb(
            {   href => '/adm/searchcourse',
                text => "$crstype Search"});
    if ($env{'form.phase'} eq 'results') {
       &Apache::lonhtmlcommon::add_breadcrumb(
            {   href => '/adm/searchcourse?phase=results',
                text => 'Search Results'});
    }
    $r->print(&Apache::lonhtmlcommon::breadcrumbs("$crstype Search"));
    &Apache::lonnavdisplay::startContentScreen($r,'coursesearch');
    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
    my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
    my $clientip = &Apache::lonnet::get_requestor_ip($r);
    my ($blocked,$blocktext) =
        &Apache::loncommon::blocking_status('search',$clientip,$cnum,$cdom);
    if ($blocked) {
        my $checkrole = "cm./$cdom/$cnum";
        if ($env{'request.course.sec'} ne '') {
            $checkrole .= "/$env{'request.course.sec'}";
        }
        if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
            ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
            undef($blocked);
        }
    }
    if ($blocked) {
        $r->print($blocktext);
    } elsif ($env{'form.phase'} eq 'results') {
        &course_search($r);
    } else {
        $r->print(&menu());
    }
    &Apache::lonnavdisplay::endContentScreen($r);
    $r->print(&Apache::loncommon::end_page());
    return OK;
}

1;