Annotation of loncom/interface/lonsearchcourse.pm, revision 1.15

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Search Course
                      3: #
1.15    ! raeburn     4: # $Id: lonsearchcourse.pm,v 1.14 2024/04/16 21:09:14 raeburn Exp $
1.1       www         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: ###############################################################################
                     30: 
                     31: package Apache::lonsearchcourse;
                     32: 
                     33: use strict;
                     34: use Apache::Constants qw(:common :http);
                     35: use Apache::lonnet;
                     36: use GDBM_File;
                     37: use Apache::loncommon();
                     38: use Apache::lonmeta;
                     39: use Apache::lonhtmlcommon;
                     40: use Apache::lonlocal;
                     41: use LONCAPA::lonmetadata();
                     42: use HTML::Entities();
                     43: use Apache::lonnavmaps;
1.4       raeburn    44: use Apache::lonnavdisplay();
1.1       www        45: use Apache::lonindexer();
                     46: use LONCAPA;
                     47: 
                     48: # Variables For course search
                     49: my %alreadyseen;
                     50: my %hash;
                     51: my $totalfound;
                     52: 
                     53: 
                     54: sub menu {
                     55:     my $scrout='';
                     56:     if ($env{'request.course.id'}) {
1.3       www        57:         my %lt=&Apache::lonlocal::texthash(
                     58:          'srch' => 'Search',
                     59:          'note' => 'Search terms',
                     60:          'options' => 'Options',
1.1       www        61:          'use' => 'use related words',
                     62:          'full' =>'fulltext search (time consuming)',
                     63:          'disc' => 'search discussion postings (resources and discussion boards)',
                     64:                                            );
                     65:         $scrout.=(<<ENDCOURSESEARCH);
                     66: <form name="loncapa_search" method="post" action="/adm/searchcourse">
                     67: <input type="hidden" name="phase" value="results" />
                     68: ENDCOURSESEARCH
1.3       www        69:        $scrout.=&Apache::lonhtmlcommon::start_pick_box().
1.15    ! raeburn    70:                 &Apache::lonhtmlcommon::row_title('<label for="courseexp">'.
        !            71:                                                   $lt{'note'}.'</label>').
1.3       www        72:                 &Apache::lonhtmlcommon::textbox('courseexp',
1.15    ! raeburn    73:                                   $env{'form.courseexp'},40,'id="courseexp"').
1.3       www        74:                 &Apache::lonhtmlcommon::row_closure().
                     75:                 &Apache::lonhtmlcommon::row_title($lt{'options'}).
                     76:                 '<label>'.&Apache::lonhtmlcommon::checkbox('crsfulltext',$env{'form.crsfulltext'}).$lt{'full'}."</label><br />\n".
                     77:                 '<label>'.&Apache::lonhtmlcommon::checkbox('crsrelated',$env{'form.crsrelated'}).$lt{'use'}."</label><br />\n".
                     78:                 '<label>'.&Apache::lonhtmlcommon::checkbox('crsdiscuss',$env{'form.crsdiscuss'}).$lt{'disc'}."</label><br />\n".
                     79:                 &Apache::lonhtmlcommon::end_pick_box();
1.1       www        80:         $scrout.=(<<ENDENDCOURSE);
                     81: <p>
                     82: <input type="submit" name="coursesubmit" value='$lt{'srch'}' />
                     83: </p>
                     84: </form>
                     85: ENDENDCOURSE
                     86:     }
                     87:     return $scrout;
                     88: }
                     89: 
                     90: sub make_symb {
                     91:     my ($id)=@_;
                     92:     my ($mapid,$resid)=split(/\./,$id);
                     93:     my $map=$hash{'map_id_'.$mapid};
                     94:     my $res=$hash{'src_'.$id};
                     95:     my $symb=&Apache::lonnet::encode_symb($map,$resid,$res);
                     96:     return $symb;
                     97: }
                     98: 
                     99: sub related_version {
                    100:     my ($word) = @_;
                    101:     return (undef) if (lc($word) =~ /\b(or|and|not)\b/);
                    102:     my @Words = &Apache::loncommon::get_related_words($word);
                    103:     # Only use 4 related words
                    104:     @Words = ($#Words>4? @Words[0..4] : @Words);
                    105:     my $result = join " OR ", ($word,@Words);
                    106:     return $result,sort(@Words);
                    107: }
                    108: 
                    109: sub course_search {
                    110:     my $r=shift;
                    111:     my $pretty_search_string = '<b>'.$env{'form.courseexp'}.'</b>';
                    112:     my $search_string = $env{'form.courseexp'};
                    113:     my @New_Words;
                    114:     undef(%alreadyseen);
                    115:     if ($env{'form.crsrelated'}) {
                    116:         ($search_string,@New_Words) = &related_version($env{'form.courseexp'});
                    117:         if (@New_Words) {
                    118:             $pretty_search_string .= ' '.&mt("with related words").": <b>@New_Words</b>.";
                    119:         } else {
                    120:             $pretty_search_string .= ' '.&mt('with no related words').".";
                    121:         }
                    122:     }
                    123:     my $fulltext=$env{'form.crsfulltext'};
                    124:     my $discuss=$env{'form.crsdiscuss'};
                    125:     my @allwords=($search_string,@New_Words);
                    126:     $totalfound=0;
1.11      raeburn   127:     my $target = 'cat';
                    128:     if ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
                    129:         (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
                    130:         $target = '_self';
                    131:     }
1.1       www       132: 
                    133:     $r->print(
                    134:               '<hr /><center><font size="+2" face="arial">'.
                    135:               $pretty_search_string.'</font></center>'.
                    136:               '<hr /><b>'.&mt('Course content').':</b><br />');
                    137:     $r->rflush();
                    138: # ======================================================= Go through the course
                    139:     my $c=$r->connection;
                    140:     if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.".db",
                    141:             &GDBM_READER(),0640)) {
1.12      raeburn   142:         foreach my $key (sort(keys(%hash))) {
                    143:             last if ($c->aborted());
                    144:             if ($key =~ /^src\_(.+)$/) {
1.9       raeburn   145:                 my $rid = $1;
                    146:                 unless ($env{'request.role.adv'}) {
                    147:                     next if ($hash{'randomout_'.$rid} || $hash{'deeplinkout_'.$rid});
                    148:                     if (!$env{'request.deeplink.login'} && $hash{'deeplinkonly_'.$rid}) {
                    149:                         my ($value) = map { &unescape($_); } split(/:/,$hash{'deeplinkonly_'.$rid});
                    150:                         my ($state,$others,$listed) = split(/,/,$value);
                    151:                         next if (($state eq 'only') &&
                    152:                                  (($listed eq 'absent') || ($listed eq 'grades')));
                    153:                     }
1.1       www       154:                 }
1.14      raeburn   155:                 my $symb=&make_symb($rid);
                    156:                 &checkonthis($r,$rid,$hash{$key},0,&Apache::lonnet::gettitle($symb),
1.11      raeburn   157:                              $fulltext,$symb,$target,@allwords);
1.1       www       158:             }
                    159:         }
                    160:         untie(%hash);
                    161:     }
                    162:     unless ($totalfound) {
                    163:         $r->print('<p class="LC_info">'.&mt('No matches found in resources.').'</p>');
                    164:     }
                    165: 
                    166: # Check discussions if requested
                    167:     if ($discuss) {
                    168:         my $totaldiscussions = 0;
                    169:         $r->print('<br /><br /><b>'.&mt('Discussion postings').':</b><br />');
                    170:         my $navmap = Apache::lonnavmaps::navmap->new();
                    171:         if (defined($navmap)) {
                    172:             my @allres=$navmap->retrieveResources();
                    173:             my %discussiontime = &Apache::lonnet::dump('discussiontimes',
                    174:                                    $env{'course.'.$env{'request.course.id'}.'.domain'},
                    175:                                    $env{'course.'.$env{'request.course.id'}.'.num'});
                    176:             foreach my $resource (@allres) {
                    177:                 my $result = '';
                    178:                 my $applies = 0;
                    179:                 my $symb = $resource->symb();
                    180:                 my $ressymb = $symb;
                    181:                 if ($symb =~ m#(___adm/$LONCAPA::domain_re/$LONCAPA::username_re)/(\d+)/bulletinboard$#) {
                    182:                     $ressymb = 'bulletin___'.$2.$1.'/'.$2.'/bulletinboard';
                    183:                     unless ($ressymb =~ m#bulletin___\d+___adm/wrapper#) {
                    184:                         $ressymb=~s#(bulletin___\d+___)#$1adm/wrapper/#;
                    185:                     }
                    186:                 }
                    187:                 if (defined($discussiontime{$ressymb})) {
                    188:                     my %contrib = &Apache::lonnet::restore($ressymb,$env{'request.course.id'},
                    189:                          $env{'course.'.$env{'request.course.id'}.'.domain'},
                    190:                          $env{'course.'.$env{'request.course.id'}.'.num'});
                    191:                     if ($contrib{'version'}) {
                    192:                         for (my $id=1;$id<=$contrib{'version'};$id++) {
                    193:                             unless (($contrib{'hidden'}=~/\.$id\./) || ($contrib{'deleted'}=~/\.$id\./)) {
                    194:                                 if ($contrib{$id.':subject'}) {
                    195:                                     $result .= $contrib{$id.':subject'};
                    196:                                 }
                    197:                                 if ($contrib{$id.':message'}) {
                    198:                                     $result .= $contrib{$id.':message'};
                    199:                                 }
                    200:                                 if ($contrib{$id,':attachmenturl'}) {
                    201:                                     if ($contrib{$id,':attachmenturl'} =~ m-/([^/]+)$-) {
                    202:                                         $result .= $1;
                    203:                                     }
                    204:                                 }
                    205:                                 $applies = &checkwords($result,$applies,@allwords);
                    206:                             }
                    207:                         }
                    208:                     }
                    209:                 }
                    210: # Does this discussion apply?
                    211:                 if ($applies) {
                    212:                     my ($map,$ind,$url)=&Apache::lonnet::decode_symb($ressymb);
                    213:                     my $disctype = &mt('resource');
                    214:                     if ($url =~ m#/bulletinboard$#) {
                    215:                         if ($url =~m#^adm/wrapper/adm/.*/bulletinboard$#) {
                    216:                             $url =~s#^adm/wrapper##;
                    217:                         }
                    218:                         $disctype = &mt('discussion board');
                    219:                     } else {
                    220:                         $url = '/res/'.$url;
                    221:                     }
                    222:                     if ($url =~ /\?/) {
                    223:                         $url .= '&amp;symb=';
                    224:                     } else {
                    225:                         $url .= '?symb=';
                    226:                     }
                    227:                     $url .= &escape($resource->symb());
                    228:                     my $title = $resource->compTitle();
1.11      raeburn   229:                     $r->print('<br /><a href="'.$url.'" target="'.$target.'">'.
1.1       www       230:                          ($title?$title:$url).'</a>&nbsp;&nbsp;-&nbsp;'.
                    231:                          $disctype.'<br />');
                    232:                     $totaldiscussions++;
                    233:                 } else {
                    234:                     $r->print(' .');
                    235:                 }
                    236:             }
                    237:             unless ($totaldiscussions) {
                    238:                 $r->print('<p class="LC_info">'.&mt('No matches found in postings.').'</p>');
                    239:             }
                    240:         } else {
                    241:             $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>');
                    242:         }
                    243:     }
                    244: }
                    245: 
                    246: # =============================== This pulls up a resource and its dependencies
                    247: 
                    248: sub checkonthis {
1.11      raeburn   249:     my ($r,$id,$url,$level,$title,$fulltext,$symb,$target,@allwords)=@_;
1.1       www       250:     $alreadyseen{$id}=1;
                    251:     if (&Apache::loncommon::connection_aborted($r)) { return; }
                    252:     $r->rflush();
                    253: 
                    254:     my $result=$title.' ';
                    255:     if ($env{'request.role.adv'} || !$hash{'encrypted_'.$id}) {
                    256:         $result.=&Apache::lonnet::metadata($url,'title').' '.
                    257:             &Apache::lonnet::metadata($url,'subject').' '.
                    258:             &Apache::lonnet::metadata($url,'abstract').' '.
                    259:             &Apache::lonnet::metadata($url,'keywords');
                    260:     }
                    261:     my ($extension)=($url=~/\.(\w+)$/);
                    262:     if (&Apache::loncommon::fileembstyle($extension) eq 'ssi' &&
                    263:         ($url) && ($fulltext)) {
                    264:         $result.=&Apache::lonnet::ssi_body($url.'?symb='.&escape($symb));
                    265:     }
                    266:     $result=~s/\s+/ /gs;
                    267:     my $applies = 0;
                    268:     $applies = &checkwords($result,$applies,@allwords);
                    269: # Does this resource apply?
                    270:     if ($applies) {
                    271:        $r->print('<br />');
                    272:        for (my $i=0;$i<=$level*5;$i++) {
                    273:            $r->print('&nbsp;');
                    274:        }
                    275:        my $href=$url;
                    276:        if ($hash{'encrypted_'.$id} && !$env{'request.role.adv'}) {
1.8       raeburn   277:            $href=&Apache::lonenc::encrypted($href);
1.10      raeburn   278:            if ($url =~ /\.sequence$/) {
1.8       raeburn   279:                $href .= '?navmap=1';
                    280:            } else {
                    281:                $href .= '?symb='.&Apache::lonenc::encrypted($symb);
                    282:            }
1.1       www       283:        } else {
1.8       raeburn   284:            if ($href =~ /\.sequence$/) {
                    285:                $href .= '?navmap=1';
                    286:            } else {
                    287:                $href .= '?symb='.&escape($symb);
                    288:            }
1.1       www       289:        }
1.11      raeburn   290:        $r->print('<a href="'.$href.'" target="'.$target.'">'.($title?$title:$url).
1.1       www       291:                  '</a><br />');
                    292:        $totalfound++;
                    293:     } elsif ($fulltext) {
                    294:        $r->print(' .');
                    295:     }
                    296:     $r->rflush();
                    297: # Check also the dependencies of this one
                    298:     my $dependencies=
                    299:                 &Apache::lonnet::metadata($url,'dependencies');
1.13      raeburn   300:     foreach my $item (split(/\,/,$dependencies)) {
                    301:        if (($item =~ /^\/res\//) && (!$alreadyseen{$id})) {
                    302:           &checkonthis($r,$id,$item,$level+1,'',$fulltext,undef,$target,@allwords);
1.1       www       303:        }
                    304:     }
                    305: }
                    306: 
                    307: sub checkwords {
                    308:     my ($result,$applies,@allwords) = @_;
1.12      raeburn   309:     foreach my $word (@allwords) {
                    310:         if ($word =~ /\w/) {
                    311:             if ($result =~ /$word/si) {
1.1       www       312:                 $applies++;
                    313:             }
                    314:         }
                    315:     }
                    316:     return $applies;
                    317: }
                    318: 
                    319: sub untiehash {
                    320:     if (tied(%hash)) {
                    321:         untie(%hash);
                    322:     }
                    323: }
                    324: 
                    325: sub handler {
                    326:     my $r = shift;
                    327:     &Apache::loncommon::content_type($r,'text/html');
                    328:     $r->send_http_header;
                    329:     if ($r->header_only) { return OK; }
                    330: 
                    331:     my $crstype = &Apache::loncommon::course_type();
                    332:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['phase']);
1.2       www       333:     $r->print(&Apache::loncommon::start_page("$crstype Search"));
1.1       www       334:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.5       raeburn   335:     if ($env{'request.course.id'} eq '') {
                    336:         $r->print(&Apache::lonhtmlcommon::breadcrumbs("$crstype Search"));
                    337:         $r->print(&Apache::loncommon::end_page());
                    338:         my $requrl = $r->uri;
                    339:         $env{'user.error.msg'} = "$requrl:bre:0:0:Course not initialized";
                    340:         $env{'user.reinit'} = 1;
                    341:         return HTTP_NOT_ACCEPTABLE;
                    342:     }
1.2       www       343:     &Apache::lonhtmlcommon::add_breadcrumb(
                    344:             {   href => '/adm/searchcourse',
                    345:                 text => "$crstype Search"});
                    346:     if ($env{'form.phase'} eq 'results') {
                    347:        &Apache::lonhtmlcommon::add_breadcrumb(
                    348:             {   href => '/adm/searchcourse?phase=results',
                    349:                 text => 'Search Results'});
                    350:     }
1.1       www       351:     $r->print(&Apache::lonhtmlcommon::breadcrumbs("$crstype Search"));
1.4       raeburn   352:     &Apache::lonnavdisplay::startContentScreen($r,'coursesearch');
1.6       raeburn   353:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    354:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.7       raeburn   355:     my $clientip = &Apache::lonnet::get_requestor_ip($r);
1.6       raeburn   356:     my ($blocked,$blocktext) =
1.7       raeburn   357:         &Apache::loncommon::blocking_status('search',$clientip,$cnum,$cdom);
1.6       raeburn   358:     if ($blocked) {
                    359:         my $checkrole = "cm./$cdom/$cnum";
                    360:         if ($env{'request.course.sec'} ne '') {
                    361:             $checkrole .= "/$env{'request.course.sec'}";
                    362:         }
                    363:         if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                    364:             ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                    365:             undef($blocked);
                    366:         }
                    367:     }
                    368:     if ($blocked) {
                    369:         $r->print($blocktext);
                    370:     } elsif ($env{'form.phase'} eq 'results') {
                    371:         &course_search($r);
1.1       www       372:     } else {
1.6       raeburn   373:         $r->print(&menu());
1.1       www       374:     }
1.4       raeburn   375:     &Apache::lonnavdisplay::endContentScreen($r);
1.1       www       376:     $r->print(&Apache::loncommon::end_page());
                    377:     return OK;
                    378: }
                    379: 
                    380: 1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>