#!/usr/bin/perl
# SeachNews 3.2
# If you experience any problems, or wish to use this script in
# a location other then in the folder with the Coranto core files,
# set the below to the absolute path to where the Coranto core
# files are located on your server. No trailing shash (/).
# Example (without the "#" sign infront):
# $coranto = '/absolute/path/to/coranto/core/files';
#######################################
## No need to modify anything below. ##
#######################################
eval {
main();
};
FatalError($@) if ($@);
sub main {
# Reads Coranto Configuration Info
my $path = "$coranto/" if ($coranto);
$JustLoadSubs++;
NeedFile("${path}cruser.pl");
NeedFile("${path}crcore.pl");
NeedFile("${path}crlib.pl");
if (-e "${path}coranto.cgi") { NeedFile("${path}coranto.cgi");}
elsif (-e "${path}coranto.pl") {NeedFile("${path}coranto.pl");}
else {
FatalError(qq~Could not open the file "${path}coranto.cgi" or "${path}coranto.pl" for reading. Make sure the file exists and the file permissions are correct.~);
}
if (($abspath eq "") && ($coranto ne "")) {$abspath = $coranto};
# read settings.
ReadConfigInfo();
NeedCFG();
$scripturl = GetScriptURL() unless $scripturl;
$CConfig{'neverSave'} = 1;
if ($CConfig{AddonsLoaded}) {
NeedFile("${path}craddon.pl");
&LoadAddons;
}
package main;
ReadProfileInfo();
my $searchnews_time0;
$ENV{'QUERY_STRING'} =~ s/\+/_/g;
if ($ENV{'QUERY_STRING'} =~ /(&?tmpl=(.+(\.tmpl)?))/i) {
$tmpl = $2;
$ENV{'QUERY_STRING'} =~ s/$1//i;
}
if ($ENV{'QUERY_STRING'} =~ /(&?style=(.+))/i) {
$style = $2;
$ENV{'QUERY_STRING'} =~ s/$1//i;
}
if (!$ENV{'QUERY_STRING'}) {
ReadSettings();
PrintHeader();
PrintForm();
} elsif ($ENV{'QUERY_STRING'} =~ /^dosearch/) {
$searchnews_time0 = times;
ReadSettings(1);
PrintHeader();
DoSearch();
} elsif ($ENV{'QUERY_STRING'} eq 'form') {
ReadSettings();
PrintHeader(1);
PrintForm(1);
} elsif ($ENV{'QUERY_STRING'} eq 'multiform') {
ReadSettings();
PrintHeader(1);
PrintForm(1);
} elsif ($ENV{'QUERY_STRING'} eq 'multi') {
ReadSettings();
PrintHeader();
PrintForm();
} else {
PrintHeader();
FatalError('The specified query is invalid.');
}
}
sub PrintForm {
$notemplate = shift;
$multi = ' size="5" multiple' if (($ENV{'QUERY_STRING'} eq 'multiform') or ($ENV{'QUERY_STRING'} eq 'multi'));
@users = split(/\|x\|/,$CConfig{'userdata'});
@categories = split(/\|x\|/,$CConfig{'NewsCategories'});
$categorycount++ foreach (@categories);
$form = qq~
~;
if ($notemplate) {
print $form;
} else {
PrintTemplate($form,'Search');
}
} #end sub PrintForm
sub AddSelectValues {
my @values = @_;
my $selected = shift @values;
my $elementtoadd = "";
if ($values[0] eq 'same') {
shift @values;
foreach $i (@values) {
$elementtoadd .= qq~~;
}
} else {
my $count = 1;
foreach $i (@values) {
$elementtoadd .= qq~~;
$count++;
}
}
return $elementtoadd;
} #end sub AddSelectValues
sub DoSearch {
my $searchnews_searchbetween=0;
($before,$after) = split(//,$CConfig{'SearchHighlight'});
@categories = split(/\|x\|/,$in{'category'});
foreach $i (@categories) {
$category{$i} = 1;
}
@fields = split(/\|x\|/,$in{'searchin'});
foreach $i (@fields) {
$field{$i} = 1;
}
if (($field{'(All)'}) || (!@fields)) {
@fields = @fieldDB;
%field;
foreach $i (@fieldDB) {
$field{$i} = 1;
}
}
@authors = split(/\|x\|/,$in{'author'});
foreach $i (@authors) {
$author{$i} = 1;
}
$matched = 0;
if (($in{'newsfrom'}) && ($in{'newsfrom'} ne '(All)')) {
$timelimit = time;
$timelimit -= $in{'newsfrom'} * 86400;
}
if (($in{'startday'}) && ($in{'startmonth'}) && ($in{'startyear'}) && ($in{'endday'}) && ($in{'endmonth'}) && ($in{'endyear'})) {
$searchnews_searchbetween=1;
}
if ($searchnews_searchbetween == 1) {
# filter news out of startday....endday
$searchnews_startday = $in{'startday'};
$searchnews_startmonth= $in{'startmonth'};
$searchnews_startyear= $in{'startyear'};
$searchnews_endday = $in{'endday'};
$searchnews_endmonth= $in{'endmonth'};
$searchnews_endyear= $in{'endyear'};
$searchnews_filterup= timelocal (01,00,00,$searchnews_endday,($searchnews_endmonth - 1), ($searchnews_endyear - 1900));
$searchnews_filterdown= timelocal (01,00,00,$searchnews_startday,($searchnews_startmonth - 1), ($searchnews_startyear - 1900));
} # filter news out of startday....endday
my $skipnumber = 0;
$hitcount = 0;
# Delete defaults
delete($in{'author'}) if ($author{'(All)'});
delete($in{'category'}) if ($category{'(All)'});
delete($in{'match'}) if ($in{'match'} eq 'keywords');
delete($in{'searchin'}) if ($in{'searchin'} eq '(All)');
delete($in{'author'}) if ($in{'author'} eq '(All)');
delete($in{'newsfrom'}) if ($in{'newsfrom'} eq '(All)');
delete($in{'resultnumber'}) if ($in{'resultnumber'} eq "(All)");
delete($in{'skipnumber'}) if ($in{'skipnumber'} eq '(None)');
delete($in{'sort'}) if ($in{'sort'} eq 'new');
delete($in{'sensitive'}) if (!$in{'sensitive'});
delete($in{'multipage'}) if ($in{'multipage'} eq 'on');
delete($in{'linkcompression'}) if ($in{'linkcompression'} == 15);
unless ($in{'match'} eq 'exact') {
@keywords;
@nonkeywords;
@mustkeywords;
$in{'searchquery'} =~ s/^\s+//; #remove leading spaces
$in{'searchquery'} =~ s/\s+$//; #remove trailing spaces
$in{'searchquery'} =~ tr/ //s; #remove multiple-spaces
while ($in{'searchquery'} =~ s/(\+"[^"]*")//) { #extract +"words that must match"
my $match = quotemeta($1);
$match =~ s/"//g;
$match =~ s/\\//g;
$match =~ s/\+//g;
push (@mustkeywords, $match);
}
$in{'searchquery'} =~ s/^\s+//; #remove leading spaces
$in{'searchquery'} =~ s/\s+$//; #remove trailing spaces
$in{'searchquery'} =~ tr/ //s; #remove multiple-spaces
$in{'searchquery'} =~ s/\+//s; #remove +
while ($in{'searchquery'} =~ s/(\-"[^"]*")//) { #extract -"stuff in quotes to not search"
my $match = $1;
$match =~ s/"//g;
$match =~ s/\-//g;
push (@nonkeywords, $match);
}
$in{'searchquery'} =~ s/^\s+//; #remove leading spaces
$in{'searchquery'} =~ s/\s+$//; #remove trailing spaces
$in{'searchquery'} =~ tr/ //s; #remove multiple-spaces
while ($in{'searchquery'} =~ s/("[^"]*")//) { #extract "words in quotes"
my $match = $1;
$match =~ s/"//g;
push (@keywords, $match);
$in{'searchquery'}.= " $match";
}
$in{'searchquery'} =~ s/^\s+//; #remove leading spaces
$in{'searchquery'} =~ s/\s+$//; #remove trailing spaces
$in{'searchquery'} =~ tr/ //s; #remove multiple-spaces
my @patterns = split(/\s+/, $in{'searchquery'});
my $r;
foreach $r (@patterns) {
if ($r =~ /^\+/) {
$r =~ s/\+//;
push (@mustkeywords, $r);
} elsif ($r =~ /^\-/) {
$r =~ s/\-//;
push (@nonkeywords, $r);
} else {
push (@keywords, $r);
}
}
} else {
@keywords = $in{'searchquery'};
}
# Order news items
%newsdatakeys = map{$_,(split(/``x/))[4]} @newsdata;
if ($in{'sort'} eq 'old') {
@newsdata = sort {$newsdatakeys{$a} <=> $newsdatakeys{$b}} @newsdata;
} elsif ($in{'sort'} eq 'alpha') {
@newsdata = sort { lc($a) cmp lc($b) } @newsdata;
} else {
@newsdata = sort {$newsdatakeys{$b} <=> $newsdatakeys{$a}} @newsdata;
}
local $maxcnt=0; local $maxcntmust=0;
local %matchcnt=(); local %matchcntmust=();
foreach $i (@newsdata) {
$matchcnt{$newsid}=0; $matchcntmust{$newsid}=0;
chop($i) if ($i =~ /\n$/);
$match = 0;
SplitDataFile($i);
if ($searchnews_searchbetween == 1) {
next unless (($newstime >= $searchnews_filterdown)&&($newstime <= $searchnews_filterup));
}
if ($timelimit) {
$currentlimit = $newstime - $timelimit;
next unless ($currentlimit > 0);
}
if ($in{'author'}) {
next unless ($author{$User});
}
if ($in{'category'}) {
next unless ($category{$Category});
}
my $matchcnttot=0;
my $nonmatch;
local %matchcntfield=();
foreach $j (@keywords) {
foreach $k (@fieldDB) {
my $r;
foreach $r (@nonkeywords) { # Check for cannot-find words
if ($in{'sensitive'}) {
$nonmatch = 1 if (($field{$k}) && ($$k =~ /$r/));
} else {
$nonmatch = 1 if (($field{$k}) && ($$k =~ /$r/i));
}
}#foreach r
unless ($nonmatch) {
if ($in{'sensitive'}) { # Check for standard words
if (($field{$k}) && ($$k =~ /$j/)) {
$wordcount=$$k =~ tr/$j/$j/;
$matchcnt{$newsid} +=$wordcount;
$match = 1; $matchcntfield{j}++;
}#if field
} else {
if (($field{$k}) && ($$k =~ /$j/i)) {
$wordcount=$$k =~ tr/$j/$j/;
$matchcnt{$newsid} +=$wordcount;
$match = 1; $matchcntfield{j}++;
}#if field
}#else
}#unless
}#foreach $k
#finished checking a first field.. now calculate relevance
if ($matchcntfield{j}>0){
if ($matchcnt{$newsid}>$maxcnt){
$maxcnt=$matchcnt{$newsid};
}
$temp2=$matchcnt{$newsid};$tmpmax=$maxcnt;
$matchcnttot++;
#print " id: $newsid -- cnttot: $matchcnttot -- matchnewsid: $temp2 -- maxtmp: $tmpmax +++ keywords: $#keywords";
}#if match
}# foreach $j
#now check must-be keywords
my $matchcnttotmust=0;
local %matchcntfieldmust=();
next if ($nonmatch);
if (@mustkeywords) { # Check for must-find words
foreach $j (@mustkeywords) {
foreach $k (@fieldDB) {
if ($in{'sensitive'}) {
if (($field{$k}) && ($$k =~ /$j/)){
$wordcount=$$k =~ tr/$j/$j/;
$matchcntmust{$newsid} +=$wordcount;
$match = 1;$matchcntfieldmust{$j}++;
}
else { next;}
} else {
if (($field{$k}) && ($$k =~ /$j/i)) {
$wordcount=$$k =~ tr/$j/$j/;
$matchcntmust{$newsid} +=$wordcount;
$match = 1;$matchcntfieldmust{$j}++;
}
else { next;}
}#else
}#foreach $k
#finished checking a first field.. now calculate relevance
if ($matchcntfieldmust{$j}>0){
if ($matchcntmust{$newsid}>$maxcntmust){
$maxcntmust=$matchcntmust{$newsid};
}
$matchcnttotmust++;
#print " id: $newsid -- cnttotmust: $matchcnttotmust -- +++ keywordsmust: $#mustkeywords --$mustkeywords[0]";
}
}#foreach $j
next unless ($matchcnttotmust > $#mustkeywords);
} # if (@mustkeywords
next unless ($match);
$hitcount++; $adv_link=&searchadv_findURL();
if ((!$in{'skipnumber'}) || ($in{'skipnumber'} <= $skipnumber)) {
if ((!$in{'resultnumber'}) || ($matched < $in{'resultnumber'})) {
$matched++;
$Date = GetTheDate($newstime);
ReadUserInfo();
InitUserFieldVars();
my @newsitem;
push(@newsitem, &{$CConfig{'SearchStyle'}}());
# Calculate search relevance
my $relevance = sprintf ("%5.2f",($matchcnttot + $matchcnttotmust) / ($#keywords + $#mustkeywords + 2) * 100);
$relevancerelative{$newsid} = (($matchcnttot+ $matchcnttotmust +$matchcnt{$newsid}+$matchcntmust{$newsid}) / ( $#keywords + $#mustkeywords+ 2 + $maxcnt+$maxcntmust))*100;
$relevanceaverage{$newsid} = (0.33*(($matchcnttot + $matchcnttotmust) / ($#keywords + $#mustkeywords + 2))+ 0.67* (($matchcnttot+ $matchcnttotmust +$matchcnt{$newsid}+$matchcntmust{$newsid}) / ( $#keywords + $#mustkeywords+ 2 + $maxcnt+$maxcntmust)))*100;
my $relevrelatid=sprintf ("%5.2f",$relevancerelative{$newsid});
my $relevaveid=sprintf ("%5.2f",$relevanceaverage{$newsid});
#$temp2=$matchcnt{$newsid};$temp3=$maxcnt{$newsid};
#print " $newsid ++ relevance: $relevance rel relat: $relevrelatid ;; rel relative: $relevaveid ---- \n\n matchid: $temp2 ;; max: $temp3--";
my $relevancecode = $CConfig{'SearchRelevance'};
$relevancecode =~ s//$relevance/g;
@newsitem[0] =~ s//$relevancecode/g;
@newsitem[0] =~ s//$relevrelatid%/g;
@newsitem[0] =~ s//$relevaveid%/g;
@newsitem[0] =~ s//$adv_link/g;
push(@result, @newsitem);
}
} else {
$skipnumber++;
}
}
$results = join('',@result);
unless ($matched) {
$results = qq~$CConfig{'SearchNews_NoNewsString'}~;
$searchnews_nomatch=1;
$matched = 'none';
}
## Create link-bar
#escape characters and make sure insearchquery is not null
$in{'searchquery'}||=join("\n",(@keywords,@mustkeywords));
$in{'searchquery'} =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
if (!($in{'multipage'}) && ($in{'resultnumber'})) {
my $oldskipnum = $in{'skipnumber'} - $in{'resultnumber'};
my $newskipnum = $in{'resultnumber'} + $in{'skipnumber'};
$in{'searchquery'} =~ s/\+/\%2B/g;
use POSIX qw(ceil floor);
$previouscode, $nextcode, $pagelinkscode, $currentpage;
## Create 'previous page' link
unless ($in{'skipnumber'} == '0') {
$previouscode .= qq~$CConfig{'Search-prevcodeon'}~;
} else {
$previouscode .= qq~$CConfig{'Search-prevcodeoff'}~;
}
## Create 'direct page' links
my $spacer;
my $totalpages = ceil($hitcount / $in{'resultnumber'});
my $compressionat = ($in{'linkcompression'} ? $in{'linkcompression'} : 15);
for ($i = 1; $i <= $totalpages; $i++) {
if ( (($compressionat eq '(None)') || ($totalpages < $compressionat)) ||
(
($i < 4) ||
($i > ($totalpages - 3)) ||
(
($i >= (($totalpages/2) - 1)) &&
($i <= ($totalpages/2 + 1))
)
)
) {
$pagelinkscode .= $CConfig{'Search-pagecodesep'} if $spacer;
$spacer = 1;
$currentpage = (ceil($in{'skipnumber'} / $in{'resultnumber'}) + 1);
if ($i != $currentpage) {
my $page = $CConfig{'Search-pagecodeon'};
$page =~ s//$i/g;
$pagelinkscode .= qq~$page~;
} else {
my $page = $CConfig{'Search-pagecodeoff'};
$page =~ s//$i/g;
$pagelinkscode .= qq~$page~;
}
}
# Add the ... joiners if the linkbar is being compressed
if ((($compressionat ne '(None)') && ($totalpages >= $compressionat)) && ($i == 4)) {
$pagelinkscode .= qq~ ...~;
}
if ((($compressionat ne '(None)') && ($totalpages >= $compressionat)) && ($i == (ceil(($hitcount / $in{'resultnumber'})/2)) + 1)) {
$pagelinkscode .= qq~ ...~;
}
}
## Create 'next page' link
unless ((!$in{'resultnumber'}) || ($newskipnum >= $hitcount)) {
$nextcode .= qq~$CConfig{'Search-nextcodeon'}~;
} else {
$nextcode .= qq~$CConfig{'Search-nextcodeoff'}~;
}
}
if ($in{'highlight'}) {
foreach $j (@keywords) {
# This solution is not bulletproof, but it's tidy.
if ($in{'sensitive'}) {
$results =~ s/($j)(?![^<]*>)/$before$1$after/g; # highlight keywords (not in )
} else {
$results =~ s/($j)(?![^<]*>)/$before$1$after/gi; # highlight keywords (not in )
}
}
}
#log keywords:
if ($CConfig{'SearchNewsLog'}==1) {
my @keyall=(@keywords, @mustkeywords);
&DoLog(@keyall);
}
PrintTemplate($results,"Search Results ($matched) - Total ($hitcount)");
} #end sub DoSearch
sub DoLog {
my @keywords = @_;
#print "keywords: @keywords+++++++";
my ($sn_fname_tot,$sn_fname_wee,$sn_fname_mon,$sn_fname_yea);
my ($SN_FHAND_TOT,$SN_FHAND_WEE,$SN_FHAND_MON,$SN_FHAND_YEA);
my (@sn_tot,@sn_wee,@sn_mon,@sn_yea);
local %tot=(); local %wee=(); local %mon=(); local %yea=();
#create logdir if necessary
if (!(-d $CConfig{'SearchNewsLogDir'})){
mkdir($CConfig{'SearchNewsLogDir'},0777);
}
$sn_fname_tot=$CConfig{'SearchNewsLogDir'}. "/"."SN_tot.txt";
$sn_fname_wee=$CConfig{'SearchNewsLogDir'}. "/"."SN_wee.txt";
$sn_fname_mon=$CConfig{'SearchNewsLogDir'}. "/"."SN_mon.txt";
$sn_fname_yea=$CConfig{'SearchNewsLogDir'}. "/"."SN_yea.txt";
$sn_fname_expwee=$CConfig{'SearchNewsLogDir'}. "/"."SN_expwee.txt";
$sn_fname_expmon=$CConfig{'SearchNewsLogDir'}. "/"."SN_expmon.txt";
$sn_fname_expyea=$CConfig{'SearchNewsLogDir'}. "/"."SN_expyea.txt";
#create expire files is necessary
my $timenow=time();
my ($sn_expwee,$sn_expmon,$sn_expyea);
if (! -e "$sn_fname_expwee") {my $expwee=$timenow+7*24*60*60;open ($SN_FHAND_WEE, ">$sn_fname_expwee");print $SN_FHAND_WEE "$expwee"; close ($SN_FHAND_WEE);}
if (! -e "$sn_fname_expmon") {my $expmon=$timenow+30*24*60*60;open ($SN_FHAND_MON, ">$sn_fname_expmon");print $SN_FHAND_MON "$expmon"; close ($SN_FHAND_MON);}
if (! -e "$sn_fname_expyea") {my $expyea=$timenow+365*24*60*60;open ($SN_FHAND_YEA, ">$sn_fname_expyea");print $SN_FHAND_YEA "$expyea"; close ($SN_FHAND_YEA);}
#read expire dates
$SN_FHAND_WEE = CRopen($sn_fname_expwee);$sn_expwee = <$SN_FHAND_WEE>;close $SN_FHAND_WEE;
$SN_FHAND_MON = CRopen($sn_fname_expmon);$sn_expmon = <$SN_FHAND_MON>;close $SN_FHAND_MON;
$SN_FHAND_YEA = CRopen($sn_fname_expyea);$sn_expyea = <$SN_FHAND_YEA>;close $SN_FHAND_YEA;
#print "\n time now: $timenow;; exp wee: $sn_expwee;;; exp mon: $sn_expmon;;; exp yea: $sn_expyea";
#(re)create hit files (+expire dates) if necessary
if (! -e "$sn_fname_tot") {open ($SN_FHAND_TOT , ">$sn_fname_tot"); close ($SN_FHAND_TOT);}
if ((! -e "$sn_fname_wee")||($timenow>$sn_expwee)) {open ($SN_FHAND_WEE, ">$sn_fname_wee"); close ($SN_FHAND_WEE);my $expwee=$timenow+7*24*60*60; open ($SN_FHAND_WEE, ">$sn_fname_expwee");print $SN_FHAND_WEE "$expwee"; close ($SN_FHAND_WEE);}
if ((! -e "$sn_fname_mon")||($timenow>$sn_expmon)) {open ($SN_FHAND_MON, ">$sn_fname_mon"); close ($SN_FHAND_MON);my $expmon=$timenow+30*24*60*60; open ($SN_FHAND_MON, ">$sn_fname_expmon");print $SN_FHAND_MON "$expmon"; close ($SN_FHAND_MON);}
if ((! -e "$sn_fname_yea")||($timenow>$sn_expyea)) {open ($SN_FHAND_YEA, ">$sn_fname_yea"); close ($SN_FHAND_YEA);my $expyea=$timenow+365*24*60*60; open ($SN_FHAND_YEA, ">$sn_fname_expyea");print $SN_FHAND_YEA "$expyea"; close ($SN_FHAND_YEA);}
#now find out the current searches
$SN_FHAND_TOT = CRopen($sn_fname_tot);@sn_tot = <$SN_FHAND_TOT>;close $SN_FHAND_TOT;
$SN_FHAND_WEE = CRopen($sn_fname_wee);@sn_wee = <$SN_FHAND_WEE>;close $SN_FHAND_WEE;
$SN_FHAND_MON = CRopen($sn_fname_mon);@sn_mon = <$SN_FHAND_MON>;close $SN_FHAND_MON;
$SN_FHAND_YEA = CRopen($sn_fname_yea);@sn_yea = <$SN_FHAND_YEA>;close $SN_FHAND_YEA;
#print "\nallwee: @all_wee;; snwee: @sn_wee\n\n";
#update the content of the hit-search files
$SN_FHAND_TOT = CRopen(">$sn_fname_tot");
$SN_FHAND_WEE = CRopen(">$sn_fname_wee");
$SN_FHAND_MON = CRopen(">$sn_fname_mon");
$SN_FHAND_YEA = CRopen(">$sn_fname_yea");
#find tot hits & update them
my ($tot_found,$wee_found,$mon_found,$yea_found)=0;
foreach $line(@sn_tot) {
chomp($line);
my ($sn_name, $sn_hits)= split(/\|\|/,$line);
if (grep (($_=~ m/^$sn_name$/gi), @keywords)) {
$sn_hits++; $tot{$sn_name}=$sn_hits;
$tot_found=1;
# print "\n found $sn_name in keytot-@keywords: \n now: $sn_name $sn_hits";
}
$tot{$sn_name}=$sn_hits;
}#foreach $_(@sn_tot)
if ($tot_found==0) {
foreach (@keywords) {$sn_name=$_;$sn_hits=1;$tot{$sn_name}=$sn_hits;}
}
#find weekly hits & update them
foreach $line(@sn_wee) {
chomp($line);
my ($sn_name, $sn_hits)= split(/\|\|/,$line);
if (grep (($_=~ m/^$sn_name$/gi), @keywords)) {
$sn_hits++;
# print "\nINSIDE grep n:$sn_name, h:$sn_hits";
$wee_found=1;
# print "\n found $sn_name in keytot-@keywords: \n now: $sn_name $sn_hits";
}
$wee{$sn_name}=$sn_hits;
}#foreach $_(@sn_wee)
if ($wee_found==0) {
foreach (@keywords) {$sn_name=$_;$sn_hits=1;$wee{$sn_name}=$sn_hits;}
}
#find montly hits & update them
foreach $line(@sn_mon) {
chomp($line);
my ($sn_name, $sn_hits)= split(/\|\|/,$line);
if (grep (($_=~ m/^$sn_name$/gi), @keywords)) {
$sn_hits++;
$mon_found=1;
# print "\n found $sn_name in keytot-@keywords: \n now: $sn_name $sn_hits";
}
$mon{$sn_name}=$sn_hits;
}#foreach $_(@sn_mon)
if ($mon_found==0) {
foreach (@keywords) {$sn_name=$_;$sn_hits=1;$mon{$sn_name}=$sn_hits;}
}
#find yearly hits & update them
foreach $line(@sn_yea) {
chomp($line);
my ($sn_name, $sn_hits)= split(/\|\|/,$line);
if (grep (($_=~ m/^$sn_name$/gi), @keywords)) {
$sn_hits++;
$yea_found=1;
# print "\n found $sn_name in keytot-@keywords: \n now: $sn_name $sn_hits";
}
$yea{$sn_name}=$sn_hits;
}#foreach $_(@sn_yea)
if ($yea_found==0) {
foreach (@keywords) {$sn_name=$_;$sn_hits=1;$yea{$sn_name}=$sn_hits;}
}
#sort the hashes (top score up) and write new values out
@keystot = sort{$tot{$b} <=> $tot{$a}} keys %tot;
foreach (@keystot) {print $SN_FHAND_TOT "$_||$tot{$_}\n"; };
@keyswee = sort{$wee{$b} <=> $wee{$a}} keys %wee;
foreach (@keyswee) {print $SN_FHAND_WEE "$_||$wee{$_}\n"; };
@keysmon = sort{$mon{$b} <=> $mon{$a}} keys %mon;
foreach (@keysmon) {print $SN_FHAND_MON "$_||$mon{$_}\n"; };
@keysyea = sort{$yea{$b} <=> $yea{$a}} keys %yea;
foreach (@keysyea) {print $SN_FHAND_YEA "$_||$yea{$_}\n"; };
#close the file handles
close $SN_FHAND_TOT;
close $SN_FHAND_WEE;
close $SN_FHAND_MON;
close $SN_FHAND_YEA;
} #end sub DoLog
#==========================================================
# Routines to find the URL of the current news (internally)
# code by cerberos76
#==========================================================
# routine added to find (internally) the news-URL
# necessary if you have multiple Maginot profiles
# method:
# a/ looks for Maginot Profiles
# (if more than one Maginot profile is found, will select the first in alphabetical order)
# b/ if there is no Maginot profile containing the news, it tries "standard" profile with a call to ViewnewsFixed
# c/ if it is not a standard profile will use an old viewnews call
sub searchadv_findURL {
my @maginotprofiles,@standardprofiles,@otherprofiles; my $ShowNews="";
my ($vnin, $vn);
my ($pcat, $prof);
my $unkownprofoff=0; #=0: display also "unknown" profiles (viewnews link), =1: not display them
my $urlscript = 'http://'.($ENV{'HTTP_HOST'}?$ENV{'HTTP_HOST'} : $ENV{'SERVER_NAME'}).($ENV{'SERVER_PORT'} != 80 && $ENV{'HTTP_HOST'} !~ /:/ ? ":$ENV{'SERVER_PORT'}" : ''). $ENV{'SCRIPT_NAME'};
$vnin="viewnews"; $urlscript =~ s/(\w+).(\w+)$/$vnin.$2/g;
$vn="$urlscript";
($CConfig{'AddonsLoaded'} =~ /cra_ncategory/i) ? ($EnableCategories=1) : ($EnableCategories=0);
if ($EnableCategories) {
#find the profiles for the category of the actual news
foreach $prof (keys %newsprofiles) {
unless ( $newsprofiles{$prof}->{enabled} ) { next; }
foreach $pcat (@{$newsprofiles{$prof}->{'cats'}}) {
if (($pcat eq $Category)||($pcat eq "AllCategories")){ #found a good profile ($pcat)!
if (($newsprofiles{$prof}->{'type'}) =~ /Maginot/ ){
push(@maginotprofiles,$prof);}
elsif (($newsprofiles{$prof}->{'type'}) =~ /Standard/ ){
push(@standardprofiles,$prof);}
else {push(@otherprofiles,$prof);}
}#if $pcat eq category
}#foreach pcat
}#foreach $prof
if (@maginotprofiles){
sort @maginotprofiles;
$prof=$maginotprofiles[0];
#============= Maginot
my $magurlnew=&searchadv_MaURL("$prof");
$ShowNews.="$magurlnew";
}#if maginot profile is not empty
elsif (@standardprofiles){
sort @standardprofiles;
$prof=$standardprofiles[0];
#Find the URLs for the given Standard profile
#============= Standard Profile, use ViewnewsFixed
#=== additions (for ViewNews Fixed 1.4+)
#find news (i.e. profile) template file and style
my $newstemplate= $newsprofiles{$prof}->{tmplfile};
my $newsstyle= $newsprofiles{$prof}->{style};
# fix the case in which 'Default' and 'Default Headlines' are both present
# in that event it selects the Default style
my @stdsty;
foreach (@standardprofiles) {
my $sty=$newsprofiles{$_}->{style};
push (@stdsty,$sty);
}
if (grep(/NewsStyle_DefaultHeadline/,@stdsty)&& grep(/NewsStyle_Default/,@stdsty)) {$newsstyle="NewsStyle_Default";}
#format those parameters for viewnews fixed
if (($newstemplate =~ /(none)/i)||($newstemplate eq "")) {
$newstemplate = "viewnews.tmpl";
}
$newstemplate =~ /^(.+)\.([^\.]+)$/;
my $fronttmpl = $1; my $exttmpl = $2;
$newsstyle =~ /^(NewsStyle)_([^\.]+)$/;
my $frontstylename = $1; my $stylename = $2;
if ($stylename =~ /Default$/i) {
$stylename = 'Default+News+Style';
} elsif ($stylename =~ /DefaultHeadline$/i) {
$stylename = 'Default+Headline+Style';
} else {
$stylename =~ s/ /+/g;
}
$ShowNews.="$vn?id=$newsid&style=$stylename&tmpl=$fronttmpl";
}#end elsif (i.e.if news is not maginot)
else { #============= Unknown profile
if ($unkownprofoff==0){
$ShowNews.="$vn?id=$newsid";
}#end if $unkownprofoff=0 (i.e. unkown profiles on)
}#end else
}#if enable categories
else { #no category addon...
$ShowNews.="$vn?id=$newsid&style=$stylename&tmpl=$fronttmpl";
}#else (no categories)
return $ShowNews;
}#sub rssadv_findURL
#==============================
# Maginot URL finder subroutine
# code by cerberos76
#==============================
sub searchadv_MaURL {
my $prof = shift;
#ReadConfigInfo();
if ( $newsprofiles{$prof}->{enabled} ) { #go on if enabled
if( $newsprofiles{$prof}->{'type'} eq 'Maginot Static' ) {
$PPStaticOpts{$prof} = {
staticfield => $newsprofiles{$prof}->{'ppstaticfield'} || 'newsid',
maxlength => $newsprofiles{$prof}->{'ppstaticmaxfnlength'} || 26,
filext => $newsprofiles{$prof}->{'ppstaticfilext'} || $CConfig{'ArcHtmlExt'},
dirurl => $newsprofiles{$prof}->{'ppstaticdirurl'} || ''
};#ppstatic
}#end if (i.e. Maginot static)
elsif( $newsprofiles{$prof}->{type} eq 'Maginot Static Split' ) {
my( @splitsubs, @splittmpl );
push( @splitsubs, $newsprofiles{$prof}->{style} );
push( @splittmpl, $newsprofiles{$prof}->{tmplfile} ) if( $newsprofiles{$prof}->{tmplfile} );
@_ = split( /;*\s*;\s*;*/, $newsprofiles{$prof}->{ppsplittmpl} );
foreach my $i (@_) {
push( @splittmpl, $i ) if( $i );
}
@_ = split( /;*\s*;\s*;*/, $newsprofiles{$prof}->{ppsplitsubs} );
foreach my $i (@_) {
$i =~ s/[^a-z0-9_]//g;
push( @splitsubs, qq~NewsStyle_$i~ ) if( $i );
}
$PPStaticOpts{$prof} = {
staticfield => $newsprofiles{$prof}->{'ppstaticfield'} || 'newsid',
maxlength => $newsprofiles{$prof}->{'ppstaticmaxfnlength'} || 26,
filext => $newsprofiles{$prof}->{'ppstaticfilext'} || $CConfig{'ArcHtmlExt'},
dirurl => $newsprofiles{$prof}->{'ppstaticdirurl'} || ''
};#end ppstatic
@{$PPStaticOpts{$prof}->{splittmpl}} = @splittmpl;
@{$PPStaticOpts{$prof}->{splitsubs}} = @splitsubs;
}#end elseif (i.e. maginot split)
my $f = ${$PPStaticOpts{$prof}->{'staticfield'}};
$f =~ s~[^A-Za-z0-9\-\.]~~g;
$f = substr( $f, 0, $PPStaticOpts{$prof}->{'maxlength'} ) . '.' . $PPStaticOpts{$prof}->{'filext'};
$f = qq~$PPStaticOpts{$prof}->{'dirurl'}/$f~;
#try to prevent user errors (when they use relative URL, instead of full URL in the "Static Page Directory URL")
if (($f !~ /http/)&& ($f !~ /$CConfig{'htmlfile_path'}/)&& ($iuserelativeurls==1)){ #relative path
my $urlmain = 'http://'.($ENV{'HTTP_HOST'}?$ENV{'HTTP_HOST'} : $ENV{'SERVER_NAME'}).($ENV{'SERVER_PORT'} != 80 && $ENV{'HTTP_HOST'} !~ /:/ ? ":$ENV{'SERVER_PORT'}" : '');
$f = qq~$urlmain/$f~;
}#end if relative path
return $f;
}#end if profile enabled
else { return "profile $prof is disabled";}
} #end maURL sub
#========================
# end finding the URLs
#========================
sub ReadSettings {
$full = shift;
$path = "$coranto/" if ($coranto);
$JustLoadSubs = 1;
if (-e "${path}coranto.cgi") { NeedFile("${path}coranto.cgi");}
elsif (-e "${path}coranto.pl") {NeedFile("${path}coranto.pl");}
else {
FatalError(qq~Could not open the file "${path}coranto.cgi" or "${path}coranto.pl" for reading. Make sure the file exists and the file permissions are correct.~);
}
if (($abspath eq "") && ($coranto ne "")) {$abspath = $coranto};
NeedFile("${path}crcore.pl");
NeedFile("${path}crlib.pl");
# for crcfg.dat check first if exist a new path in cruser...
NeedFile("${path}cruser.pl");
my $cfgfupa=$cfgpath; $cfgfupa ||= "$CConfig{'admin_path'}/crcfg.dat";
NeedFile("$cfgfupa");
ReadConfigInfo();
FatalError('The SearchNews addon is not enabled in Coranto.') unless ($CConfig{'AddonsLoaded'} =~ /cra_searchnews.pl/);
FatalError('The SearchNews settings have not been fully configured in Coranto.') unless (($CConfig{'SearchStyle'}) && ($CConfig{'SearchTemplate'}) && ($CConfig{'SearchHighlight'}));
$scripturl = GetScriptURL() unless ($scripturl);
$CConfig{'neverSave'} = 1;
if ($CConfig{'AddonsLoaded'} =~ /cra_crsql.pl/i) {
eval {
require DBI;
DBI->import;
};
FatalError('DBI could not be found. Therefore, you cannot use SearchNews with Coranto SQL.') if ($@);
$CConfig{'CorantoSQL_path'} = $CConfig{'htmlfile_path'} unless ($CConfig{'CorantoSQL_path'});
NeedFile("$CConfig{'CorantoSQL_path'}/crsql_sqlstuff.pl");
$csql = 1;
}
if ($full) {
if ($csql) {
$corantosql_dbh = CorantoSQL_connectdb();
$query = "SELECT * FROM $CConfig{'CorantoSQL_tblname'}";
$sth = $corantosql_dbh->prepare($query);
$sth->execute();
while ($corantosql_ref = $sth->fetchrow_hashref()) {
@csqldata = ();
GetSQLFields();
foreach $i (@fieldDB_internalorder) {
push(@csqldata,$$i);
}
push(@newsdata,join('``x',@csqldata));
}
} else {
$newsdatfile = CRopen($CConfig{'htmlfile_path'}. "\\".$CConfig{'NewsdatFile'});
@newsdata = <$newsdatfile>;
close $newsdat;
}
ReadForm();
ReadProfileInfo();
InitGTD($CConfig{'DateFormat'},'GetTheDate');
InitGTD($CConfig{'InternalDateFormat'},'GetTheDate_Internal');
if ($style) {
if ($style =~ /^default(\s|\+)?news(\s|\+)?style$/i) {
$style = 'Default';
} elsif ($style =~ /^default(\s|\+)?headline(\s|\+)?style$/i) {
$style = 'DefaultHeadline';
} else {
$style =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$style =~ s/( |\+)/_/g;
$style = lc($style);
$style =~ s/[^a-z0-9_]//g;
}
$style = "NewsStyle_$style";
$CConfig{'SearchStyle'} = $style;
}
}
}
sub PrintHeader {
$plain = shift;
print 'content-type:text/';
if ($plain) {
print 'plain';
} else {
print 'html';
}
print "\n\n";
$HeaderPrinted = 1;
}
sub FatalError {
$error = shift;
PrintHeader() unless ($HeaderPrinted);
print qq~Fatal Error
Fatal Error: $error
~;
exit;
}
sub PrintTemplate {
($content,$title) = @_;
$CConfig{'SearchTemplate'} = $tmpl if ($tmpl);
my $theresult = ProcessTMPL("$CConfig{'admin_path'}/$CConfig{'SearchTemplate'}",$content,$title,0,1);
## Search words
#escape characters and make sure insearchquery is not null
$in{'searchquery'}||=join("\n",(@keywords,@mustkeywords));
$in{'searchquery'} =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$theresult =~ s//$in{'searchquery'}/g;
$theresult =~ s//@keywords/g;
$theresult =~ s//@mustkeywords/g;
$theresult =~ s//@nonkeywords/g;
## General search details
my $totalpages = 1;
$totalpages = ceil($hitcount / $in{'resultnumber'}) if $in{'resultnumber'};
$theresult =~ s//$totalpages/g;
$currentpage = 1 unless $currentpage;
$theresult =~ s//$currentpage/g;
$theresult =~ s//$hitcount/g;
my $from = $in{'skipnumber'} + 1;
my $to = $in{'skipnumber'} + $in{'resultnumber'};
$to = $hitcount if ($to > $hitcount);
$theresult =~ s//$from/g;
$theresult =~ s//$to/g;
## Link-Bar elements
$theresult =~ s//$previouscode/g if ($hitcount >0);
$theresult =~ s//$pagelinkscode/g if ($hitcount >0);
$theresult =~ s//$nextcode/g if ($hitcount >0);
## Fake SSI EXEC
while ($theresult =~ /<\!--#exec\s*cgi="([^"]*)"\s*(linebreak)?\s*-->/i) {
my $perlpath = $^X;
my $cgiscript = $1;
my $keyword = $2;
my $a;
if (-e $perlpath) {
if (-e $cgiscript) {
$a = eval { `$perlpath $cgiscript` };
$a = "ERROR: $@" if $@;
} else {
$a = "ERROR: could not find $script";
}
} else {
$a = "ERROR: could not find $perlpath";
}
my $b = '';
$b = " " if ($keyword eq 'linebreak');
$a=~s/\n/$b/g;
$theresult =~ s//$a/i;
}
## Add error messages for unsupported SSI tags
#my $error = qq~ERROR: SearchNews supports file= for file inclusion. Read the documentation.~;
#$theresult =~ s/<\!--#include path\s*=\s*"(\S+?)"\s*-->/$error/gie;
#$theresult =~ s/<\!--#include virtual\s*=\s*"(\S+?)"\s*-->/$error/gie;
# v3.2 added support for "include virtual" and "include path"
while (($theresult =~ /<\!--#include\s*virtual="([^"]*)"\s*(linebreak)?\s*-->/i)|| ($theresult =~ /<\!--#include\s*path="([^"]*)"\s*(linebreak)?\s*-->/i)) {
my $inserttext = $1; my $keyword = $2;
if ($inserttext =~ /^\//g) { #relative path
my $abspath="$ENV{'SCRIPT_FILENAME'}";
my ($abspa1,$abspa2)=split(/\/cgi-bin/,$abspath);
$inserttext="$abspa1$inserttext";
}
$theresult =~ s/<\!--#include\s*virtual="([^"]*)"\s*(linebreak)?\s*-->/FakeSSI($inserttext)/gie;
$theresult =~ s/<\!--#include\s*path="([^"]*)"\s*(linebreak)?\s*-->/FakeSSI($inserttext)/gie;
}#end while
# let's add the log results
#, ,
#,
while (($theresult =~ //i)||($theresult =~ //i)||($theresult =~ //i)||($theresult =~ //i)) {
my ($sn_fname_tot,$sn_fname_wee,$sn_fname_mon,$sn_fname_yea);
my ($SN_FHAND_TOT,$SN_FHAND_WEE,$SN_FHAND_MON,$SN_FHAND_YEA);
my (@sn_tot,@sn_wee,@sn_mon,@sn_yea);
local %tot=(); local %wee=(); local %mon=(); local %yea=();
$sn_fname_tot=$CConfig{'SearchNewsLogDir'}. "\\"."SN_tot.txt";
$sn_fname_wee=$CConfig{'SearchNewsLogDir'}. "\\"."SN_wee.txt";
$sn_fname_mon=$CConfig{'SearchNewsLogDir'}. "\\"."SN_mon.txt";
$sn_fname_yea=$CConfig{'SearchNewsLogDir'}. "\\"."SN_yea.txt";
#now find out the current searches
$SN_FHAND_TOT = CRopen($sn_fname_tot);@sn_tot = <$SN_FHAND_TOT>;close $SN_FHAND_TOT;
$SN_FHAND_WEE = CRopen($sn_fname_wee);@sn_wee = <$SN_FHAND_WEE>;close $SN_FHAND_WEE;
$SN_FHAND_MON = CRopen($sn_fname_mon);@sn_mon = <$SN_FHAND_MON>;close $SN_FHAND_MON;
$SN_FHAND_YEA = CRopen($sn_fname_yea);@sn_yea = <$SN_FHAND_YEA>;close $SN_FHAND_YEA;
#print "\nallwee: @all_wee;; snwee: @sn_wee\n\n";
$disphits=10; $partition=" ";
my ($tot_found,$wee_found,$mon_found,$yea_found)=0;
my ($totstr,$weestr,$monstr,$yeastr)= ("
","
","
","
");
my $urlscript = 'http://'.($ENV{'HTTP_HOST'}?$ENV{'HTTP_HOST'} : $ENV{'SERVER_NAME'}).($ENV{'SERVER_PORT'} != 80 && $ENV{'HTTP_HOST'} !~ /:/ ? ":$ENV{'SERVER_PORT'}" : ''). $ENV{'SCRIPT_NAME'};
#format used for searches: newest-to-oldest
#find tot hits
for (my $i=0;$i<$disphits;$i++){
if ($sn_tot[$i] ne "") {
my ($sn_name, $sn_hits)= split(/\|\|/,$sn_tot[$i]);
my $sn_nameurl= qq~$sn_name~;
$totstr .= qq~
$sn_nameurl
$sn_hits
\n~;
}#if line not null
}#for i=0..disphits
$totstr .= "
";
$theresult =~ s//$totstr/g;
#find week hits
for (my $i=0;$i<$disphits;$i++){
if ($sn_wee[$i] ne "") {
my ($sn_name, $sn_hits)= split(/\|\|/,$sn_wee[$i]);
my $sn_nameurl= qq~$sn_name~;
$weestr .= qq~
$sn_nameurl
$sn_hits
\n~;
}#if line not null
}#for i=0..disphits
$weestr .= "
";
$theresult =~ s//$weestr/g;
#find month hits
for (my $i=0;$i<$disphits;$i++){
if ($sn_mon[$i] ne "") {
my ($sn_name, $sn_hits)= split(/\|\|/,$sn_mon[$i]);
my $sn_nameurl= qq~$sn_name~;
$monstr .= qq~
$sn_nameurl
$sn_hits
\n~;
}#if line not null
}#for i=0..disphits
$monstr .= "
";
$theresult =~ s//$monstr/g;
#find year hits
for (my $i=0;$i<$disphits;$i++){
if ($sn_yea[$i] ne "") {
my ($sn_name, $sn_hits)= split(/\|\|/,$sn_yea[$i]);
my $sn_nameurl= qq~$sn_name~;
$yeastr .= qq~
$sn_nameurl
$sn_hits
\n~;
}#if line not null
}#for i=0..disphits
$yeastr .= "
";
$theresult =~ s//$yeastr/g;
}#end top10
#now search is finished... so let's stop the clock
my $searchnews_time1 = times;
my $searchnews_timeneeded=$searchnews_time1-$searchnews_time0;
$theresult =~ s//$searchnews_timeneeded/g;
# Everything is finished so print it to the screen
print $theresult;
}
sub zcomment_get {
$commentcount = 0;
open ZCOMMENT,"$CConfig{'zcomment_location'}$newsid.txt";
while () {
$commentcount++ if (length($_) > 4);
}
close ZCOMMENT;
return $commentcount;
}
sub zcomment_num {
return zcomment_get();
}
# Gets our full URL. Needed for error messages.
sub GetScriptURL {
my $url = 'http://' . ($ENV{HTTP_HOST} ? $ENV{HTTP_HOST} : $ENV{SERVER_NAME}) .
($ENV{SERVER_PORT} != 80 && $ENV{HTTP_HOST} !~ /:/ ? ":$ENV{SERVER_PORT}" : '') .
$ENV{SCRIPT_NAME};
return $url;
}
sub CRdie {
print ((defined $HeaderPrinted ? '' : "Content-type: text/html\n\n") .
qq~
Error
$_[0]~);
exit;
}
sub AUTOLOAD {
my $sub = $AUTOLOAD;
$sub =~ s/.+\:\://;
if ($Subs{$sub}) {
eval $Subs{$sub};
if ($@) { die ("Subroutine $AUTOLOAD encountered a compile error during autoload: $@"); }
}
else {
die("Subroutine $AUTOLOAD was called, but does not exist. (It isn't already loaded, and it isn't in the cache.)");
}
delete $Subs{$sub};
goto &$AUTOLOAD;
}
my %LoadedFiles;
sub NeedFile {
my $file = shift;
unless (exists $LoadedFiles{$file}) {
eval { require $file; };
CRdie("Could not load file $file.") if $@;
$LoadedFiles{$file} = 1;
}
}
1;