sort.pl: new module to sort search results

This commit is contained in:
Alex Schroeder
2016-08-02 10:58:37 +02:00
parent 4d262f254f
commit fe217ea2d5
3 changed files with 130 additions and 1 deletions

79
modules/sort.pl Normal file
View File

@@ -0,0 +1,79 @@
# Copyright (C) 2016 Alex Schroeder <alex@gnu.org>
#
# 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.
#
# You should have received a copy of the GNU General Public License along with
# this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use v5.10;
=head1 Sort Extension
This extension allows you to sort search results based on last update date and
based on creation date (if you have installed creationdate.pl).
=cut
AddModuleDescription('sort.pl', 'Sort Extension');
our ($q, @InitVariables, %Action, %Page, $OpenPageName);
my %SortUpdate;
my %SortCreation;
*OldSortSearchMenu = \&SearchMenu;
*SearchMenu = \&NewSortSearchMenu;
sub NewSortSearchMenu {
my $html = OldSortSearchMenu(@_);
my $string = UrlEncode(shift);
$html .= ' ' . ScriptLink("search=$string;sort=update",
T('Sort by last update'));
$html .= ' ' . ScriptLink("search=$string;sort=creation",
T('Sort by creation date'))
if defined(&CreationDateOpenPage);
return $html;
}
*OldSortSearchTitleAndBody = \&SearchTitleAndBody;
*SearchTitleAndBody = \&NewSortSearchTitleAndBody;
sub NewSortSearchTitleAndBody {
my ($regex, $func, @args) = @_;
%SortUpdate = ();
%SortCreation = ();
my @found = OldSortSearchTitleAndBody($regex);
my $sort = GetParam('sort');
if ($sort eq 'update') {
# last updated means first
@found = sort { $SortUpdate{$b} cmp $SortUpdate{$a} } @found;
} elsif ($sort eq 'creation') {
# first created means first
@found = sort { $SortCreation{$a} cmp $SortCreation{$b} } @found;
}
for my $id (@found) {
$func->($id, @args) if $func;
}
return @found;
}
# Taking advantage of the fact that OpenPage is called for every page, we use it
# to build our hashes.
*OldSortOpenPage = \&OpenPage;
*OpenPage = \&NewSortOpenPage;
sub NewSortOpenPage {
my $value = OldSortOpenPage(@_);
$SortUpdate{$OpenPageName} = $Page{ts};
$SortCreation{$OpenPageName} = $Page{created};
return $value; # I don't think anybody uses this?
}

49
t/sort.t Normal file
View File

@@ -0,0 +1,49 @@
# Copyright (C) 2016 Alex Schroeder <alex@gnu.org>
#
# 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.
#
# You should have received a copy of the GNU General Public License along with
# this program. If not, see <http://www.gnu.org/licenses/>.
require 't/test.pl';
package OddMuse;
use Test::More tests => 6;
add_module('sort.pl');
$page = get_page('search=first');
test_page($page, 'Sort by last update');
test_page_negative($page, 'Sort by creation date');
add_module('creationdate.pl');
$page = get_page('search=first');
test_page($page, 'Sort by creation date');
# by name: A B C
# by creation: C B A (oldest first)
# by update: B A C (last update first)
update_page('C', 'the first one by creation date');
sleep 2;
update_page('B', 'this page will get updated later');
sleep 2;
update_page('A', 'the first one by name');
sleep 2;
update_page('B', 'the first one by update date');
sleep 2;
update_page('D', 'this page is not searched for');
test_page(join(', ', grep(/^title: /, split(/\n/, get_page('search=first raw=1')))),
'title: A, title: B, title: C');
test_page(join(', ', grep(/^title: /, split(/\n/, get_page('search=first sort=update raw=1')))),
'title: B, title: A, title: C');
test_page(join(', ', grep(/^title: /, split(/\n/, get_page('search=first sort=creation raw=1')))),
'title: C, title: B, title: A');

View File

@@ -3455,6 +3455,7 @@ sub PageIsUploadedFile {
while (defined($_ = <$FILE>) and $_ !~ /^text: /) {
} # read lines until we get to the text key
close $FILE;
return unless length($_) > 6;
return TextIsFile(substr($_, 6)); # pass "#FILE image/png\n" to the test
}
}
@@ -4065,7 +4066,7 @@ sub WriteRecentVisitors {
WriteStringToFile($VisitorFile, $data);
}
sub TextIsFile { $_[0] =~ /^#FILE (\S+) ?(\S+)?\n/ }
sub TextIsFile { $_[0] =~ /^#FILE (\S+) ?(\S+)?\n/; }
sub AddModuleDescription { # cannot use $q here because this is module init time
my ($filename, $page, $dir, $tag) = @_;