#!/usr/bin/perl
#------------------------------------------------------------------------------
#    mwForum - Web-based discussion forum
#    Copyright (c) 1999-2009 Markus Wichitill
#
#    This program 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 3 of the License, or
#    (at your option) any later version.
#
#    This program 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.
#------------------------------------------------------------------------------

use strict;
use warnings;
no warnings qw(uninitialized redefine);

# Imports
use MwfMain;

#------------------------------------------------------------------------------

# Init
my ($m, $cfg, $lng, $user, $userId) = MwfMain->new(@_);
$m->cacheUserStatus() if $userId;

# Check if access should be denied
$m->checkBan($userId);

# Check if search is enabled
$cfg->{forumSearch} == 1 || $cfg->{forumSearch} == 2 && $userId 
	|| $cfg->{googleSearch} || $cfg->{yahooSearch} || $user->{admin} 
	or $m->error('errNoAccess');

# Print header
$m->printHeader();

# Get CGI parameters
my $page = $m->paramInt('pg') || 1;
my $boardId = $m->paramStrId('board');  # Sanitize later
my $words = $m->paramStr('words', 1);
my $userName = $m->paramStr('user', 1);
my $searchUserId = $m->paramInt('uid');
my $minAge = $m->paramInt('min');
my $maxAge = $m->paramInt('max');
my $field = $m->paramStrId('field') || 'body';
my $sort = $m->paramStrId('sort') || 'time';
my $order = $m->paramStrId('order') || 'desc';
my $showBody = $m->paramDefined('words') ? $m->paramBool('body') : $cfg->{showSearchBody};
my $submitted = $m->paramDefined('words') || $searchUserId || $userName;

# Get userName if only userId was specified
$userName = $m->fetchArray("
	SELECT userName FROM users WHERE id = ?", $searchUserId)
	if $searchUserId;

# Enforce valid options
$field = 'body' if $field !~ /^(?:body|subject)\z/;
$sort = 'time' if $sort !~ /^(?:time|user)\z/;
$order = 'desc' if $order !~ /^(?:asc|desc)\z/;

# Hard age limit for performance reasons
$maxAge = $cfg->{searchMaxAge} 
	if $cfg->{searchMaxAge} && (!$maxAge || $maxAge > $cfg->{searchMaxAge});

# Split and treat keywords early to show user what we don't support anyway with indexed search
my @words = ();
my $wordsChanged = 0;
if ($cfg->{advSearch}) {
	# Make copy of original search string, but normalize its whitespace
	my $orgWords = $words;
	$orgWords =~ s/\s+/ /g;
	$orgWords =~ s/^\s//g;
	$orgWords =~ s/\s$//g;
	
	# Split and rejoin string, discarding stuff that can't be searched for
	$words =~ s![+*()<>~]+! !g;
	@words = $words =~ /-?"[^"]+"|-?[^\\\/\s\$\@\[\]+*(){}<>~^#%?|.&=,;:`"']+/g;
	@words = grep(length > 2, @words);
	my $stopwordRx = join('\z|^', defined($cfg->{stopWords}) ? @{$cfg->{stopWords}} : qw(able about above according accordingly across actually after afterwards again against ain't all allow allows almost alone along already also although always am among amongst an and another any anybody anyhow anyone anything anyway anyways anywhere apart appear appreciate appropriate are aren't around as aside ask asking associated at available away awfully be became because become becomes becoming been before beforehand behind being believe below beside besides best better between beyond both brief but by c'mon c's came can can't cannot cant cause causes certain certainly changes clearly co com come comes concerning consequently consider considering contain containing contains corresponding could couldn't course currently definitely described despite did didn't different do does doesn't doing don't done down downwards during each edu eg eight either else elsewhere enough entirely especially et etc even ever every everybody everyone everything everywhere ex exactly example except far few fifth first five followed following follows for former formerly forth four from further furthermore get gets getting given gives go goes going gone got gotten greetings had hadn't happens hardly has hasn't have haven't having he he's hello help hence her here here's hereafter hereby herein hereupon hers herself hi him himself his hither hopefully how howbeit however i'd i'll i'm i've ie if ignored immediate in inasmuch inc indeed indicate indicated indicates inner insofar instead into inward is isn't it it'd it'll it's its itself just keep keeps kept know knows known last lately later latter latterly least less lest let let's like liked likely little look looking looks ltd mainly many may maybe me mean meanwhile merely might more moreover most mostly much must my myself name namely nd near nearly necessary need needs neither never nevertheless new next nine no nobody non none noone nor normally not nothing novel now nowhere obviously of off often oh ok okay old on once one ones only onto or other others otherwise ought our ours ourselves out outside over overall own particular particularly per perhaps placed please plus possible presumably probably provides que quite qv rather rd re really reasonably regarding regardless regards relatively respectively right said same saw say saying says second secondly see seeing seem seemed seeming seems seen self selves sensible sent serious seriously seven several shall she should shouldn't since six so some somebody somehow someone something sometime sometimes somewhat somewhere soon sorry specified specify specifying still sub such sup sure t's take taken tell tends th than thank thanks thanx that that's thats the their theirs them themselves then thence there there's thereafter thereby therefore therein theres thereupon these they they'd they'll they're they've think third this thorough thoroughly those though three through throughout thru thus to together too took toward towards tried tries truly try trying twice two un under unfortunately unless unlikely until unto up upon us use used useful uses using usually value various very via viz vs want wants was wasn't way we we'd we'll we're we've welcome well went were weren't what what's whatever when whence whenever where where's whereafter whereas whereby wherein whereupon wherever whether which while whither who who's whoever whole whom whose why will willing wish with within without won't wonder would would wouldn't yes yet you you'd you'll you're you've your yours yourself yourselves zero));
	@words = grep(!/^$stopwordRx\z/io, @words);
	$words = join(" ", @words);
	
	# If string got changed (except for whitespace changes), show notice
	$wordsChanged = 1 if $orgWords ne $words;
}

# Preserve parameters in links
my @params = (words => $words, user => $userName, min => $minAge, max => $maxAge,
	board => $boardId, field => $field, sort => $sort, order => $order, body => $showBody);

# Escape search strings
my $wordsEsc = $m->escHtml($words);
my $userNameEsc = $m->escHtml($userName);

# Get visible boards
my $arcPfx = $m->{archive} ? 'arc_' : '';
my $boards = $m->fetchAllHash("
	SELECT boards.*, categories.title AS categTitle
	FROM ${arcPfx}boards AS boards
		INNER JOIN categories AS categories
			ON categories.id = boards.categoryId
	ORDER BY categories.pos, boards.pos");
@$boards = grep($m->boardVisible($_), @$boards);
@$boards or $m->error('errNoAccess');
my @boardIds = map($_->{id}, @$boards);

# Determine checkbox and listbox states
my %state = (
	$boardId => "selected='selected'",
	$field => "selected='selected'",
	$sort => "selected='selected'",
	$order => "selected='selected'",
	showBody => $showBody ? "checked='checked'" : undef,
);

# Search
my $posts = [];
my %attachments = ();
my @pageLinks = ();
if ($submitted && !($wordsChanged && !$words)) {
	# Limit to user(s)
	my $userStr = "";
	my $groupTitle = "";
	my @userIds = ();
	if ($searchUserId) {
		$userStr = "AND posts.userId = :searchUserId";
	}
	elsif ($userName) {
		if (substr($userName, 0, 1) eq '!') {
			# Limit to group members
			@userIds = $m->getMemberIds($userName);
			@userIds or $m->error('errGrpNotFnd');
			$userStr = "AND posts.userId IN (:userIds)";
		}
		else {
			# Limit to single user
			$searchUserId = $m->fetchArray("
				SELECT id FROM users WHERE userName = ?", $userName);
			$searchUserId or $m->error('errUsrNotFnd');
			$userStr = "AND posts.userId = :searchUserId";
		}
	}
	
	# Limit to category or board
	my $boardStr = "";
	my @categBoardIds = ();
	if ($boardId =~ /^bid([0-9]+)\z/) {
		$boardStr = "AND posts.boardId = :boardId";
		$boardId = $1;
	} 
	elsif ($boardId =~ /^cid([0-9]+)\z/) {
		my @categBoards = grep($_->{categoryId} == $1, @$boards);
		@categBoardIds = map($_->{id}, @categBoards);
		$boardStr = "AND posts.boardId IN (:categBoardIds)";
		$boardId = 0;
	}
	else { 
		$boardId = 0;
	}

	# Search subject
	my $fieldStr = "posts.body";
	my $subjectStr = "";
	my $topicJoinStr = "";
	if ($field eq 'subject') {
		$fieldStr = "topics.subject";
		$subjectStr = "AND posts.parentId = 0";
		$topicJoinStr = "INNER JOIN ${arcPfx}topics AS topics ON topics.id = posts.topicId"	
			if $words;
	}

	# Search words
	my $wordStr = "";
	my @wordValues = ();
	if ($cfg->{advSearch} && $words) {
		# Search with MySQL fulltext index
		for (@words) { 
			$_ = "$_*" if !/^"/;
			$_ = "+$_" if !/^-/;
		}
		$wordStr = "AND (MATCH $fieldStr AGAINST (:word0 IN BOOLEAN MODE))";
		push @wordValues, "word0" => join(" ", @words);
	}
	elsif ($words) {
		# Search with LIKE
		my $like = $m->{pgsql} ? 'ILIKE' : 'LIKE';
		my $wordsLike = $m->dbEscLike($words);
		my $percent = $m->{sqlite} && $cfg->{sqliteLike} ? "" : "%";
		@words = $wordsLike =~ /"[^"]+"|[^"\s]+/g;
		splice(@words, 10) if @words > 10;
		my @wordPreds = ();
		for (my $i = 0; $i < @words; $i++) {
			$words[$i] =~ s/"//g;
			$words[$i] = $m->escHtml($words[$i]);
			push @wordPreds, "$fieldStr $like :word$i";
			push @wordValues, "word$i" => "$percent$words[$i]$percent";
		}
		$wordStr = "AND (" . join(" AND ", @wordPreds) . ")";
	}

	# Limit to age
	my $minAgeStr = $minAge ? "AND posts.postTime < :now - :minAge * 86400" : "";
	my $maxAgeStr = $maxAge ? "AND posts.postTime > :now - :maxAge * 86400" : "";

	# Order
	my $sortStr = 'posts.postTime';
	if ($sort eq 'time') { $sortStr = 'posts.postTime' }
	elsif ($sort eq 'user') { $sortStr = 'posts.userNameBak' }
	my $orderStr = "ORDER BY $sortStr $order";
	$orderStr .= ", posts.postTime DESC" if $sort ne 'time';

	#	Install case-i LIKE function for SQLite
	$m->{dbh}->func('LIKE', 2, sub { my $a = shift(); my $b = shift();
		utf8::decode($a); utf8::decode($b); index(lc($a), lc($b)) > -1 }, 'create_function')
		if $m->{sqlite} && $cfg->{sqliteLike};

	# Get ids of posts matching criteria
	my $maxSrchResNum = $cfg->{maxSrchResNum} || 500;
	$posts = $m->fetchAllArray("
		SELECT posts.id
		FROM ${arcPfx}posts AS posts
			$topicJoinStr
		WHERE posts.boardId IN (:boardIds)
			$wordStr
			$subjectStr
			$userStr 
			$minAgeStr
			$maxAgeStr
			$boardStr 
		$orderStr
		LIMIT :maxSrchResNum",
		{ searchUserId => $searchUserId, groupTitle => $groupTitle, userIds => \@userIds,
			boardId => $boardId, categBoardIds => \@categBoardIds, now => $m->{now},
			minAge => $minAge, maxAge => $maxAge, boardIds => \@boardIds, 
			maxSrchResNum => $maxSrchResNum, @wordValues });

	# Page links
	my $postsPP = $showBody ? $user->{postsPP} : $user->{topicsPP};
	my $pageNum = int(@$posts / $postsPP) + (@$posts % $postsPP != 0);
	if ($pageNum > 1) {
		my $maxPageNum = $m->min($pageNum, 8);
		push @pageLinks, { url => $m->url('forum_search', pg => $_, @params), 
			txt => $_, dsb => $_ == $page }
			for 1 .. $maxPageNum;
		push @pageLinks, { txt => "..." }
			if $maxPageNum < $pageNum - 1;
		push @pageLinks, { url => $m->url('forum_search', pg => $pageNum, @params), 
			txt => $pageNum, dsb => $pageNum == $page }
			if $maxPageNum < $pageNum;
		push @pageLinks, { url => $m->url('forum_search', pg => $page - 1, @params), 
			txt => 'comPgPrev', dsb => $page == 1 };
		push @pageLinks, { url => $m->url('forum_search', pg => $page + 1, @params), 
			txt => 'comPgNext', dsb => $page == $pageNum };
	}

	# Get posts on page
	my @pagePostIds = @$posts[($page-1) * $postsPP .. $m->min($page * $postsPP, scalar @$posts) - 1];
	@pagePostIds = map($_->[0], @pagePostIds);
	$posts = $m->fetchAllHash("
		SELECT posts.id, posts.boardId, posts.topicId, posts.userId, posts.postTime, 
			posts.userNameBak, posts.body,
			topics.subject
		FROM ${arcPfx}posts AS posts
			INNER JOIN ${arcPfx}topics AS topics
				ON topics.id = posts.topicId
		WHERE posts.id IN (:pagePostIds)
		$orderStr",
		{ pagePostIds => \@pagePostIds });

	# Get attachments for posts on page
	if ($showBody) {
		my $attachments = $m->fetchAllHash("
			SELECT * FROM attachments WHERE postId IN (:pagePostIds)",
			{ pagePostIds => \@pagePostIds });
		for my $post (@$posts) {
			for my $attach (@$attachments) {
				push @{$post->{attachments}}, $attach	if $attach->{postId} == $post->{id};
			}
		}
	}
}

# Print page bar
my @navLinks = ({ url => $m->url('forum_show'), txt => 'comUp', ico => 'up' });
$m->printPageBar(mainTitle => $lng->{seaTitle}, navLinks => \@navLinks, pageLinks => \@pageLinks);

# Display age 0 as empty string
$minAge = $minAge ? $minAge : "";
$maxAge = $maxAge ? $maxAge : "";

# Show advanced search options?
my $showAdvOpt = $cfg->{showAdvOpt} || $minAge || $maxAge || $field ne 'body' 
	|| $sort ne 'time' || $order ne 'desc' || $showBody ? 'block' : 'none';
my $showAdvLnk = $showAdvOpt eq 'block' ? "style='display: none'" : "";

# Print forum search form
if ($cfg->{forumSearch} == 1 || $cfg->{forumSearch} == 2 && $userId || $user->{admin}) {
	print
		"<form action='forum_search$m->{ext}' method='get'>\n",
		"<div class='frm'>\n",
		"<div class='hcl'><span class='htt'>$lng->{seaTtl}</span></div>\n",
		"<div class='ccl'>\n",
		!$cfg->{forumSearch} ? "<p>Forum search is currently only enabled for admins.</p>" : "",
		"$lng->{seaWords}\n",
		"<input type='text' name='words' size='20' maxlength='100' value='$wordsEsc'/>\n",
		"$lng->{seaUser}\n",
		"<input type='text' name='user' size='15' maxlength='$cfg->{maxUserNameLen}' value='$userNameEsc'/>\n",
		"$lng->{seaBoard}\n",
		"<select name='board' size='1'>\n",
		"<option value='0'>$lng->{seaBoardAll}</option>\n";
	
	my $lastCategoryId = 0;
	for my $board (@$boards) {
		if ($lastCategoryId != $board->{categoryId}) {
			$lastCategoryId = $board->{categoryId};
			my $sel = $state{"cid$board->{categoryId}"};
			print "<option value='cid$board->{categoryId}' $sel>$board->{categTitle}</option>\n";
		}
		my $sel = $state{"bid$board->{id}"};
		print "<option value='bid$board->{id}' $sel>- $board->{title}</option>\n";
	}
	
	print
		"</select>\n",
		$m->submitButton('seaB', 'search'),
		"<script type='text/javascript'>$m->{cdataStart}\n",
		"	function showAdvOpt() { \n",
		"		document.getElementById(\"advLnk\").style.display = 'none'; \n",
		"		document.getElementById(\"advOpt\").style.display = ''; \n",
		"	}\n",
		"$m->{cdataEnd}</script>\n",
		"<a id='advLnk' href='javascript:showAdvOpt()' $showAdvLnk>$lng->{seaAdvOpt} &gt;&gt;</a>\n",
		"<div id='advOpt' style='display: $showAdvOpt; margin-top: 3px'>\n",
		"$lng->{seaMinAge}\n",
		"<input type='text' name='min' size='3' maxlength='4' value='$minAge'/>\n",
		"$lng->{seaMaxAge}\n",
		"<input type='text' name='max' size='3' maxlength='4' value='$maxAge'/>\n",
		"$lng->{seaField}\n",
		"<select name='field' size='1'>\n",
		"<option value='body' $state{body}>$lng->{seaFieldBody}</option>\n",
		"<option value='subject' $state{subject}>$lng->{seaFieldSubj}</option>\n",
		"</select>\n",
		"$lng->{seaSort}\n",
		"<select name='sort' size='1'>\n",
		"<option value='time' $state{time}>$lng->{seaSortTime}</option>\n",
		"<option value='user' $state{user}>$lng->{seaSortUser}</option>\n",
		"</select>\n",
		"$lng->{seaOrder}\n",
		"<select name='order' size='1'>\n",
		"<option value='desc' $state{desc}>$lng->{seaOrderDesc}</option>\n",
		"<option value='asc' $state{asc}>$lng->{seaOrderAsc}</option>\n",
		"</select>\n",
		"<label><input type='checkbox' name='body' value='1' $state{showBody}/>$lng->{seaShowBody}</label>\n",
		"</div>\n",
		$wordsChanged ? "<p>$lng->{seaWordsChng}</p>" : "",
		$m->{archive} ? "<input type='hidden' name='arc' value='1'/>\n" : "",
		$m->{sessionId} ? "<input type='hidden' name='sid' value='$m->{sessionId}'/>\n" : "",
		"</div>\n",
		"</div>\n",
		"</form>\n\n";
}

# Print Google search form
if ($cfg->{googleSearch}) {
	my ($site) = $cfg->{baseUrl} =~ m!https?://(.+)!;
	$site .= $m->{env}{scriptUrlPath};
	print
		"<form action='http://www.google.com/search' method='get'>\n",
		"<div class='frm'>\n",
		"<div class='hcl'><span class='htt'>$lng->{seaGglTtl}</span></div>\n",
		"<div class='ccl'>\n",
		"<p>$lng->{seaGglT}</p>\n",
		"<input type='text' name='q' size='30'/>\n",
		"<input type='submit' value='$lng->{seaB}'/>\n",
		"<input type='hidden' name='num' value='100'/>\n",
		"<input type='hidden' name='sitesearch' value='$site'/>\n",
		"</div>\n",
		"</div>\n",
		"</form>\n\n";
}

# Print Yahoo search form
if ($cfg->{yahooSearch}) {
	my ($site) = $cfg->{baseUrl} =~ m!https?://(.+)!;
	$site .= $m->{env}{scriptUrlPath};
	print
		"<form action='http://search.yahoo.com/search' method='get'>\n",
		"<div class='frm'>\n",
		"<div class='hcl'><span class='htt'>$lng->{seaYahTtl}</span></div>\n",
		"<div class='ccl'>\n",
		"<p>$lng->{seaYahT}</p>\n",
		"<input type='text' name='p' size='30'/>\n",
		"<input type='submit' value='$lng->{seaB}'/>\n",
		"<input type='hidden' name='n' value='100'/>\n",
		"<input type='hidden' name='vs' value='$site'/>\n",
		"</div>\n",
		"</div>\n",
		"</form>\n\n";
}

# Print results
if ($submitted && !($wordsChanged && !$words)) {
	# Print table header
	print
		"<table class='tbl'>\n",
		"<tr class='hrw'>\n",
		"<th>$lng->{serTopic}</th>\n",
		"<th class='shr'>$lng->{serPoster}</th>\n",
		"<th class='shr'>$lng->{serPosted}</th>\n",
		"</tr>\n";

	# Prepare strings for local highlighting and hl link parameters
	my $hilite = $cfg->{advSearch} ? $words : $wordsEsc;
	$hilite =~ s!&quot;!!g if !$cfg->{advSearch};

	# Highlighting of post bodies shown on this page
	my @hiliteWords = ();
	if ($showBody && $hilite) {
		# Split string and weed out stuff that could break entities
		my $hiliteRxEsc = $hilite;
		$hiliteRxEsc =~ s!([\\\$\[\](){}.*+?^|-])!\\$1!g;
		@hiliteWords = split(' ', $hiliteRxEsc);
		@hiliteWords = grep(length > 2 && !/^(?:amp|quot|quo|uot|160)\z/, @hiliteWords);
	}

	# Print found posts	
	for my $post (@$posts) {
		# Shortcuts
		my $postId = $post->{id};
		
		# Format output
		my $timeStr = $m->formatTime($post->{postTime}, $user->{timezone});
		my $userNameStr = $post->{userNameBak} || " - ";
		my $url = $m->url('user_info', uid => $post->{userId});
		$userNameStr = "<a href='$url'>$userNameStr</a>" if $post->{userId} > 0;
		$m->dbToDisplay({}, $post) if $showBody;
		$url = $m->url('topic_show', pid => $postId, hl => $hilite);

		# Highlight keywords
		if ($showBody && @hiliteWords) {
			my $body = ">$post->{body}<";
			$body =~ s|>(.*?)<|
				my $text = $1;
				eval { $text =~ s!($_)!<em>$1</em>!gi } for @hiliteWords;
				">$text<";
			|egs;
			$post->{body} = substr($body, 1, -1);
		}
	
		# Print post	
		print
			"<tr class='crw'>\n",
			"<td><a href='$url'>$post->{subject}</a></td>\n",
			"<td class='shr'>$userNameStr</td>\n",
			"<td class='shr'>$timeStr</td>\n",
			"</tr>\n";
			
		print
			"<tr class='crw'>\n",
			"<td colspan='3'>\n",
			$post->{body}, "\n",
			"</td>\n",
			"</tr>\n"
			if $showBody;
	}
	
	# If nothing found, display notification
	print "<tr class='crw'><td colspan='3'>$lng->{serNotFound}</td></tr>\n" if !@$posts;
	print "</table>\n\n";
}

# Log action and finish
my $stringId = $submitted && $cfg->{logSearchWords} && $words ? $m->logString($words) : 0;
$m->logAction($submitted ? 2 : 3, 'forum', 'search', $userId, $boardId, 0, 0, $stringId);
$m->printFooter();
$m->finish();
