# Selima Website Content Management System
# List.pm: The base list.

#  Copyright (c) 2004-2018 imacat.
#
#  Licensed under the Apache License, Version 2.0 (the "License");
#  you may not use this file except in compliance with the License.
#  You may obtain a copy of the License at
#
#      http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing, software
#  distributed under the License is distributed on an "AS IS" BASIS,
#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#  See the License for the specific language governing permissions and
#  limitations under the License.

# Author: imacat <imacat@mail.imacat.idv.tw>
# First written: 2004-09-09

package Selima::List;
use 5.008;
use utf8;
use strict;
use warnings;
BEGIN {
# Prototype declaration
sub urlcheck(\@);
}

use CGI qw();
use Encode qw(encode decode FB_CROAK);
use HTML::Strip qw();
use IPC::Open3 qw(open3);
use POSIX qw(floor);

use Selima::AddGet;
use Selima::Array;
use Selima::CommText;
use Selima::ChkFunc;
use Selima::DataVars qw($SESSION :db :env :l10n :libdir :lninfo :requri);
use Selima::DBI;
use Selima::ErrMsg;
use Selima::FormFunc;
use Selima::GetLang;
use Selima::ListPref;
use Selima::LogIn;
use Selima::HTTP;
use Selima::MarkAbbr;
use Selima::Query;
use Selima::ShortCut;
use Selima::Unicode;
use Selima::UserPref;

# Load these classes
use Selima::List::Users;
use Selima::List::Groups;
use Selima::List::UserMem;
use Selima::List::GroupMem;
use Selima::List::UserPref;
use Selima::List::ScptPriv;

use Selima::List::Guestbook;
use Selima::List::Guestbook::Public;
use Selima::List::Pages;
use Selima::List::LinkCat;
use Selima::List::Links;
use Selima::List::LinkCatz;

use Selima::List::Category;
use Selima::List::Categorz;
use Selima::List::ActLog;

use Selima::List::Accounting::Subjects;
use Selima::List::Accounting::Subjects::LastLv;
use Selima::List::Accounting::Transacts;
use Selima::List::Accounting::Records;
use Selima::List::Accounting::Reports;
use Selima::List::Accounting::Reports::Cash::Summary;
use Selima::List::Accounting::Reports::Cash;
use Selima::List::Accounting::Reports::Ledger;
use Selima::List::Accounting::Reports::Ledger::Summary;
use Selima::List::Accounting::Reports::Journal;
use Selima::List::Accounting::Reports::TriBlnc;
use Selima::List::Accounting::Reports::IncmStat;
use Selima::List::Accounting::Reports::BlncShet;
use Selima::List::Accounting::Reports::Search;

use vars qw(@URLCHECK);
@URLCHECK = (COMMON_LIBDIR . "/Selima/urlcheck");

# new: Initialize the handler
sub new : method {
    local ($_, %_);
    my ($self, $class, $FORM, $table);
    ($class, $FORM, $table) = @_;
    $class = ref $class if ref $class ne "";
    $self = bless {}, $class;
    
    $FORM = curform if !defined $FORM;
    $self->{"FORM"} = $FORM;
    $self->{"table"} = $table;
    
    $self->{"pageno"} = $FORM->param("pageno");
    $self->{"sortby"} = $FORM->param("sortby");
    $self->{"query"} = $FORM->param("query");
    $self->{"useview"} = $DBH->support(DBI_FEATHER_VIEW)
        if defined $DBH;
    $self->{"reverse"} = 0;
    $self->{"static"} = 0;
    $self->{"static_filepat"} = "%04d.html";
    $self->{"static_lastfile"} = "last.html";
    $self->{"limit"} = undef;
    
    # The default column labels
    
    # Parameters for the called forms
    $self->{"caller"} = $FORM->param("caller");
    $self->{"cformid"} = $FORM->param("cformid");
    $self->{"is_called_form"} = defined $self->{"caller"}
                                && defined $self->{"cformid"};
    if ($self->{"is_called_form"}) {
        $self->{"seltext"} = C_("Select");
        $self->{"selurl_tmpl"} = $self->{"caller"}
            . "?formid=" . $self->{"cformid"} . "&selsn=%d";
        $self->{"title"} = C_("Select A Data Record");
    } else {
        $self->{"seltext"} = C_("Edit");
        $self->{"selurl_tmpl"} = $REQUEST_FILE . "?form=cur&sn=%d";
        $self->{"title"} = C_("Manage Data");
    }
    
    $self->{"fetched"} = 0;
    $self->{"error"} = {};
    # The default number of rows per page -- when user preference system is not available
    $self->{"DEFAULT_LIST_SIZE"} = 10;
    $self->{"DEFAULT_LIST_COLS"} = [qw(sn)];
    # The default sort order -- for non-VIEW lists only
    $self->{"DEFAULT_SORTBY"} = undef;
    # The list brief size
    $self->{"DEFAULT_BRIEF_LEN"} = 30;
    # The query abstract span from the found phrase
    $self->{"QABS_SPAN"} = 30;
    # The maximum query abstract length
    $self->{"QABS_MAXLEN"} = 200;
    
    $self->{"total"} = undef;
    $self->{"lastpage"} = undef;
    $self->{"massdel"} = 0;
    $self->{"noselect"} = 0;
    $self->{"col_labels"} = {};
    
    # Default settings
    # Known columns that should not be displayed (has a special purpose)
    $self->{"COLS_NO_DISPLAY"} = [qw(_viewurl _sel _selurl _statord)];
    # Known columns that should never be searched against
    $self->{"COLS_NO_SEARCH"} = [qw(pic _urlcheck _viewurl _sel _selurl _statord)];
    # Known columns that should not be sorted with
    $self->{"COLS_NO_SORT_BY"} = [qw(_urlcheck _viewurl _sel _selurl _statord)];
    # Columns that should display its brief instead
    $self->{"COLS_BRIEF"} = [];
    
    # Intermediate parsing results when fetching a list
    $self->{"coldefs"} = [];
    $self->{"sortkeys"} = [];
    $self->{"query_phrases"} = [];
    $self->{"listcols"} = [];
    
    # The default column labels
    $self->col_labels(
        # Common labels shared by all list handlers
        "sn"        => C_("S/N"),
        "created"   => C_("Created"),
        "createdby" => C_("Created by"),
        "updated"   => C_("Updated"),
        "updatedby" => C_("Updated by"),
        # Other commonly-seen column labels
        "body"      => C_("Content"),
        "cat"       => C_("Category"),
        "date"      => C_("Date"),
        "disabled"  => C_("Disabled?"),
        "dsc"       => C_("Description"),
        "email"     => C_("E-mail"),
        "hid"       => C_("Hidden?"),
        "html"      => C_("HTML?"),
        "id"        => C_("ID."),
        "kw"        => C_("Keywords"),
        "name"      => C_("Name"),
        "ord"       => C_("Order"),
        "path"      => C_("Page path"),
        "pic"       => C_("Picture"),
        "picratio"  => C_("Pic. ratio"),
        "piccap"    => C_("Pic. caption"),
        "picpos"    => C_("Pic. position"),
        "title"     => C_("Title"),
        "title_en"  => C_("English title"),
        "url"       => C_("URL."),
        "_urlcheck" => C_("Status (slow)"),
    );
    
    return $self;
}

# fetch: Fetch the current list
sub fetch : method {
    local ($_, %_);
    my ($self, $cols, $table, $where, $orderby, $limit, $sth, $sql, $error);
    $self = $_[0];
    
    # Fetched before
    return $self->{"error"} if $self->{"fetched"};
    $self->{"fetched"} = 1;
    
    # Initialize the error status
    $self->{"error"} = undef;
    $self->{"total"} = undef;
    
    # See if we need to use views or not.
    #   Views make things much faster and easier, but some DBMS has no views.
    #   *MySQL has no views*
    if ($self->{"useview"}) {
        ($cols, $table, $where, $orderby, $limit) = $self->select_with_view;
    } else {
        ($cols, $table, $where, $orderby, $limit) = $self->select_without_view;
    }
    
    # The number of rows per page
    $_ = userpref("listsize", ref $self);
    $self->{"pagesize"} = defined $_? $_: $self->{"DEFAULT_LIST_SIZE"};
    # Paging not in use
    if (!defined $self->{"pagesize"}) {
        $self->{"select"} = sprintf "SELECT %s FROM %s%s%s%s;\n",
            $cols, $table, $where, $orderby, $limit;
        $sql = $self->{"select"};
        $sth = $DBH->prepare($sql);
        $sth->execute;
        
        # Fetch everything
        $self->{"current"} = [];
        push @{$self->{"current"}}, $_
            while defined($_ = $sth->fetchrow_hashref);
        undef $sth;
        
        $self->{"total"} = scalar(@{$self->{"current"}});
        $self->{"lastpage"} = 1;
        $self->{"startno"} = 0;
        $self->{"endno"} = $self->{"total"} - 1;
        # If endno is -1 (when total is 0), set to 0
        $self->{"endno"} = 0 if $self->{"endno"} < 0;
        
        # Done
        return $self->{"error"};
    }
    
    # Obtain the total number
    $self->{"select_total"} = sprintf "SELECT count(*) FROM %s%s%s;\n", $table, $where, $limit;
    $sql = $self->{"select_total"};
    $sth = $DBH->prepare($sql);
    $sth->execute;
    $self->{"total"} = ($sth->fetchrow_array)[0];
    undef $sth;
    $self->{"lastpage"} = floor(($self->{"total"} - 1) / $self->{"pagesize"}) + 1;
    # If last page is 0 (when total is 0), set to page 1
    $self->{"lastpage"} = 1 if $self->{"lastpage"} < 1;
    
    # Check the page number
    $error = $self->check_pageno;
    $self->{"error"} = $error if defined $error && !defined $self->{"error"};
    
    # Calculate the start and end record number
    $self->{"startno"} = ($self->{"pageno"} - 1) * $self->{"pagesize"};
    $self->{"endno"} = $self->{"pageno"} * $self->{"pagesize"} - 1;
    # If there is not enough remaining records, set to the last one
    $self->{"endno"} = $self->{"total"} - 1
        if $self->{"endno"} > $self->{"total"} - 1;
    # If the last record is -1 (when total is 0), set to 0
    $self->{"endno"} = 0 if $self->{"endno"} < 0;
    
    # Obtain everything in this page
    $self->{"current"} = [];
    if (!$self->{"reverse"}) {
        $self->{"select"} = sprintf "SELECT %s FROM %s%s%s LIMIT %d OFFSET %d;\n",
            $cols, $table, $where, $orderby,
            $self->{"endno"} - $self->{"startno"} + 1,
            $self->{"startno"};
    } else {
        $self->{"select"} = sprintf "SELECT %s FROM %s%s%s LIMIT %d OFFSET %d;\n",
            $cols, $table, $where, $orderby,
            $self->{"endno"} - $self->{"startno"} + 1,
            $self->{"total"} - $self->{"endno"} - 1;
    }
    # If not empty
    if ($self->{"total"} > 0) {
        $sql = $self->{"select"};
        $sth = $DBH->prepare($sql);
        $sth->execute;
        push @{$self->{"current"}}, $_
            while defined($_ = $sth->fetchrow_hashref);
        undef $sth;
    }
    
    # Set the columns to be displayed
    $self->check_listcols;
    # Done
    return $self->{"error"};
}

# page_param: Obtain page parameters
sub page_param : method {
    local ($_, %_);
    my ($self, $baseurl);
    $self = $_[0];
    # Fetch the current list if not fetched yet
    $self->fetch if !$self->{"fetched"};
    $_ = {};
    # The onload event handler
    $$_{"onload"} = $self->{"onload"} if exists $self->{"onload"};
    # No paging
    return if !defined $self->{"DEFAULT_LIST_SIZE"};
    # Do not show the list
    return if !defined $self->{"total"};
    # No record to be listed
    return if $self->{"total"} == 0;
    # Our base URL
    $baseurl = rem_get_arg $REQUEST_FILEQS, "pageno";
    # The first page -- only meaningful when there is more than one page
    if ($self->{"lastpage"} > 1) {
        if ($self->{"static"}) {
            $$_{"first"} = sprintf $self->{"static_filepat"}, 1;
        } elsif ($self->{"reverse"}) {
            $$_{"first"} = add_get_arg $baseurl, "pageno", 1, DUP_OK;
        } else {
            $$_{"first"} = $baseurl;
        }
    }
    # The previous page
    if ($self->{"pageno"} > 1) {
        if ($self->{"static"}) {
            $$_{"prev"} = sprintf $self->{"static_filepat"},
                $self->{"pageno"} - 1;
        } elsif ($self->{"reverse"} || $self->{"pageno"} -1 != 1) {
            $$_{"prev"} = add_get_arg $baseurl, "pageno", $self->{"pageno"} - 1, DUP_OK;
        } else {
            $$_{"prev"} = $baseurl;
        }
    }
    # The next page
    if ($self->{"pageno"} < $self->{"lastpage"}) {
        if ($self->{"static"}) {
            if (    defined $self->{"static_lastfile"}
                    && $self->{"pageno"} + 1 == $self->{"lastpage"}) {
                $$_{"next"} = $self->{"static_lastfile"};
            } else {
                $$_{"next"} = sprintf $self->{"static_filepat"},
                    $self->{"pageno"} + 1;
            }
        } elsif (!$self->{"reverse"} || $self->{"pageno"} + 1 != $self->{"lastpage"}) {
            $$_{"next"} = add_get_arg $baseurl, "pageno", $self->{"pageno"} + 1, DUP_OK;
        } else {
            $$_{"next"} = $baseurl;
        }
    }
    # The last page -- only meaningful when there is more than one page
    if ($self->{"lastpage"} > 1) {
        if ($self->{"static"}) {
            if (defined $self->{"static_lastfile"}) {
                $$_{"last"} = $self->{"static_lastfile"};
            } else {
                $$_{"last"} = sprintf $self->{"static_filepat"}, $self->{"lastpage"};
            }
        } elsif (!$self->{"reverse"}) {
            $$_{"last"} = add_get_arg $baseurl, "pageno", $self->{"lastpage"}, DUP_OK;
        } else {
            $$_{"last"} = $baseurl;
        }
    }
    return $_;
}

# html: Output the list
sub html : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # Fetch the current list if not fetched yet
    $self->fetch if !$self->{"fetched"};
    
    # Display the title
    $self->html_title;
    # Display the error message
    $self->html_errmsg;
    # Display a link to add a new item
    $self->html_newlink;
    # Display the switch for different lists
    $self->html_lists_switch;
    # Display the search box
    $self->html_search;
    # Display the data download link
    $self->html_data_download;
    # Display the list status message
    $self->html_liststat;
    # Display the page bar at the beginning
    $self->html_pagebar;
    # List the items
    $self->html_list;
    # Display the page bar at the END
    $self->html_pagebar;
    # Display a form to change the list preference
    $self->html_listprefform;
    
    return;
}

# set_listpref: Set the list preference
sub set_listpref : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    $_ = new Selima::ListPref($self->{"FORM"});
    $_->main;
}

#
# Methods belows are private.  Do not call them directly.
# Override them when needed.
#
# liststat_message: Return the current list statistics message
sub liststat_message : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    
    # No record to list
    if ($self->{"total"} == 0) {
        # Empty comes from a query
        if (defined $self->{"query"}) {
            return C_("Nothing found.  Please try another query.");
        # Empty database
        } else {
            return C_("The database is empty.");
        }
    # Fit in one page
    } elsif ($self->{"total"} <= $self->{"pagesize"}) {
        # Result comes from a query
        if (defined $self->{"query"}) {
            return C_("Your query found [*,_1,record].", $self->{"total"});
        # List result
        } else {
            return C_("[*,_1,record].", $self->{"total"});
        }
    # More than one page
    } else {
        # Result comes from a query
        if (defined $self->{"query"}) {
            return C_("Your query found [*,_1,record], listing [#,_2] to [#,_3].",
                $self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
        # List result
        } else {
            return C_("[*,_1,record], listing [#,_2] to [#,_3].",
                $self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
        }
    }
}

# pagebar_tags: The tags for the page bar
#   No arrows anymore.  No more ASCII-art, as per WCAG 1.0 checkpoint 1.1
sub pagebar_tags : method {
    local ($_, %_);
    return (
        first   => h_abbr(C_("First")),
        prev    => h_abbr(C_("Previous")),
        next    => h_abbr(C_("Next")),
        last    => h_abbr(C_("Last")),
    );
}

# colval: Output a list column value
sub colval : method {
    local ($_, %_);
    my ($self, $col, %row, $brflen, $alt);
    ($self, $col, %row) = @_;

    # Null/no value
    return h(t_notset()) if !defined $row{$col};
    
    # A brief should be displayed instead
    $brflen = $self->{"DEFAULT_BRIEF_LEN"};
    if (in_array($col, @{$self->{"COLS_BRIEF"}}) && length $row{$col} > $brflen) {
        # Strip the HTML tags
        $_ = $row{$col};
        if (exists $row{"html"} && $row{"html"}) {
            # HTML::Strip does not work with decode()d UTF-8 text
            $_ = encode("UTF-8", $_);
            $_ = (new HTML::Strip)->parse($_);
            $_ = decode("UTF-8", $_);
        }
        return h(substr $_, 0, $brflen) . "…";
    }
    
    # Always display "pic" column as a picture
    # To be done
    if ($col eq "pic") {
        #$alt = C_("Picture preview");
        #$picid = readpic($row{$col},
        #    array("max" => $self->{"PIC_THUMBNAIL_SIZE"}),
        #    $row["sn"], $self->{"table"});
        #$PICS =& pic_deposit;
        #$pic = $PICS[$picid];
        #return echopic_thumbnail($pic, $alt);
        return "";
    }
    
    # Always display "_imgsrc" column as image reference
    if ($col eq "_imgsrc") {
        return "<img src=\"" . h($row{$col}) . "\" alt=\""
            . h(C_("Picture unavailable")) . "\" />";
    }
    
    # Always display "_urlcheck" unencoded, since it is a result text
    return h($row{$col}) if $col eq "_urlcheck";
    
    # Ordinary columns
    return h($row{$col});
}

# check_pageno: Check the page number
sub check_pageno : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    
    # Save it elsewhere and replace with default value temporarily
    $_ = $self->{"pageno"};
    $self->{"pageno"} = !$self->{"reverse"}? 1: $self->{"lastpage"};
    # Page number not specified
    return if !defined $_;
    
    # It is too long, or contains any non-digit character
    return {"msg"=>N_("Page number ([_1]) invalid.  Please specify a valid page number."),
            "margs"=>[$_]}
        if length $_ > 9 || /\D/ || /^0+$/;
    $_ += 0;
    
    # Out of range
    return {"msg"=>N_("Page number ([#,_1]) out of range.  Please specify between 1 and [#,_2]."),
            "margs"=>[$_, $self->{"lastpage"}]}
        if defined $self->{"lastpage"} && $_ > $self->{"lastpage"};
    # Redirect to the page without page number, if it can be omitted
    if ($self->{"pageno"} == $_) {
        my ($method, $url);
        $method = $IS_MODPERL? ($IS_MP2?
            Apache2::RequestUtil->request->method: Apache->request->method):
            $ENV{"REQUEST_METHOD"};
        $url = rem_get_arg $REQUEST_FILEQS, "pageno";
        if ($method eq "POST") {
            http_303 $url;
        } else {
            http_307 $url;
        }
    }
    # OK
    $self->{"pageno"} = $_;
    return;
}

#
# Methods belows are private.  Do not call them directly.
# Do not override them, either.
#

# select_with_view: Obtain the SQL statement with views
#   This makes life easier *^_^*
sub select_with_view : method {
    local ($_, %_);
    my ($self, $cols, $table, $where, $orderby, $limit);
    $self = $_[0];
    
    # Obtain the view name
    if (!exists $self->{"view"}) {
        $self->{"view"} = $self->{"table"} . "_list";
        $self->{"view"} .= "_" . getlang LN_DATABASE if @ALL_LINGUAS > 1;
    }
    # Obtain the available columns
    $self->{"cols"} = [$DBH->cols($self->{"view"})];
    
    $cols = "*";
    $table = $DBH->quote_identifier($self->{"view"});
    # Obtain the SQL WHERE phase
    $where = $self->sql_filter();
    # Obtain the SQL ORDER BY phase
    $orderby = $self->sql_orderby();
    # Obtain the LIMIT phase
    $limit = defined $self->{"limit"}? " LIMIT " . $self->{"limit"}: "";
    
    return ($cols, $table, $where, $orderby, $limit);
}

# select_without_view: Obtain the SQL statement manually without views
#   *BAD BAD BAD~~ Stupid MySQL*  Keep it here for compatibility
#   Should be remove as long as MySQL is vanished
sub select_without_view : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    
    # To be done
    return $self->select_with_view;
}

# sql_filter: Get the SQL WHERE phase
sub sql_filter : method {
    local ($_, %_);
    my ($self, @cols, @conds);
    $self = $_[0];
    
    # No query, return empty string
    if (!defined $self->{"query"}) {
        return " WHERE " . $_
            if $self->can("pre_filter") && defined($_ = $self->pre_filter());
        return "";
    }
    
    # Regularize it
    $self->{"query"} =~ s/^\s*(.*?)\s*$/$1/;
    # Check if it is filled
    if ($self->{"query"} eq "") {
        $self->{"error"} = {"msg"=>N_("Please fill in your query.")};
        return " WHERE " . $_
            if $self->can("pre_filter") && defined($_ = $self->pre_filter());
        return "";
    }
    
    $self->{"query_phrases"} = [parse_query $self->{"query"}];
    # Bounce if nothing to query
    if (@{$self->{"query_phrases"}} == 0) {
        return " WHERE " . $_
            if $self->can("pre_filter") && defined($_ = $self->pre_filter());
        return "";
    }
    
    # Obtain the columns to query
    if ($self->{"useview"}) {
        %_ = map { $_ => 1 } @{$self->{"COLS_NO_SEARCH"}};
        @cols = grep !exists $_{$_}, @{$self->{"cols"}};
    # Use the column definition kept so far
    } else {
        @cols = map ${$_}{"def"},
            grep !in_array(${$_}{"alias"}, @{$self->{"COLS_NO_SEARCH"}}),
                @{$self->{"coldefs"}}
    }
    
    # Compose the query condition
    @conds = qw();
    # Obtain each phase
    foreach my $phrase (@{$self->{"query_phrases"}}) {
        my (@subconds, $lphrase);
        $lphrase = "'%" . $DBH->esclike($phrase) . "%'";
        @subconds = qw();
        foreach my $col (@cols) {
            push @subconds, "cast($col AS text) ILIKE $lphrase";
        }
        push @conds, join " OR ", @subconds;
    }
    # Append the the pre-defined filter
    push @conds, $_
        if $self->can("pre_filter") && defined($_ = $self->pre_filter());
    # Compose the WHERE statement
    return " WHERE " . (@conds == 1? $conds[0]: join " AND ", map "($_)", @conds);
}

# sql_orderby: Get the SQL ORDER BY phase
sub sql_orderby : method {
    local ($_, %_);
    my ($self, @phrases, $error);
    $self = $_[0];
    
    # Parse the "sortby" argument
    $self->parse_sortby($self->{"sortby"});
    # Check the sort keys, and empty them if invalid
    $error = $self->check_sortkeys;
    if (defined $error) {
        $self->{"error"} = $error if !defined $self->{"error"};
        $self->{"sortkeys"} = [];
    }
    # Apply DEFAULT_SORTBY if not in a view
    if (    @{$self->{"sortkeys"}} == 0
            && !$self->{"useview"}
            && defined $self->{"DEFAULT_SORTBY"}) {
        # Parse the DEFAULT_SORTBY argument
        $self->parse_sortby($self->{"DEFAULT_SORTBY"});
        # Check the sort keys, and empty them if invalid
        $error = $self->check_sortkeys;
        if (defined $error) {
            $self->{"error"} = $error if !defined $self->{"error"};
            $self->{"sortkeys"} = [];
        }
    }
    # Set the "sortby" attribute
    $self->compose_sortby;
    
    # Bounce if there is no sorting key
    return "" if @{$self->{"sortkeys"}} == 0;
    
    # Obtain the corresponding SQL phrase
    @_ = qw();
    @_ = map ${$_}{"sql"}, @{$self->{"sortkeys"}};
    $_ = " ORDER BY " . join ", ", @_;
    
    return $_;
}

# parse_sortby: Parse the "sortby" argument
#   $sortby argument should be specified as "key1,-key2,...",
#   where initial minus (-) before the key means decreasing.
sub parse_sortby : method {
    local ($_, %_);
    my ($self, $sortby);
    ($self, $sortby) = @_;
    
    $self->{"sortkeys"} = [];
    # Bounce for nothing
    return if !defined $sortby;
    $sortby =~ s/^\s*(.*?)\s*$/$1/;
    # Bounce if $sortby is empty
    return if $sortby eq "";
    
    # Split by comma
    foreach my $phrase (split /,/, $sortby) {
        # Compose the sort key
        $_{"key"} = $phrase;
        $_{"key"} =~ s/^\s*(.*?)\s*$/$1/;
        $_{"desc"} = 0;
        $_ = $_{"key"};
        $_{"sql"} = $DBH->quote_identifier(encode("UTF-8", $_, FB_CROAK));
        # Check the decreasing flag with the initial "-" sign
        if ($_{"key"} =~ s/^-//) {
            $_{"desc"} = 1;
            $_ = $_{"key"};
            $_{"sql"} = $DBH->quote_identifier(encode("UTF-8", $_, FB_CROAK))
                . " DESC";
        }
        # Add this sort key
        push @{$self->{"sortkeys"}}, {%_};
    }
    
    return;
}

# check_sortkeys: Check if the sorting keys are valid
sub check_sortkeys : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # Skip if nothing to check
    return if @{$self->{"sortkeys"}} == 0;;
    
    # Obtain the valid sorting keys
    if ($self->{"useview"}) {
        %_ = map { $_ => 1 } @{$self->{"COLS_NO_SORT_BY"}};
        %_ = map { $_ => 1 } grep !exists $_{$_}, @{$self->{"cols"}};
        # Check each candidate
        foreach (@{$self->{"sortkeys"}}) {
            return {"msg"=>N_("You cannot sort by \"[_1]\"."),
                    "margs"=>[${$_}{"key"}]}
                if !exists $_{${$_}{"key"}};
        }
    # Use the column definition kept so far
    } else {
        # Turn the column definition into an associative array
        %_ = map { ${$_}{"alias"} => ${$_}{"def"} } @{$self->{"coldefs"}};
        # Check each candidate
        foreach (@{$self->{"sortkeys"}}) {
            return {"msg"=>N_("You cannot sort by \"[_1]\"."),
                    "margs"=>[${$_}{"key"}]}
                if !exists $_{${$_}{"key"}};
            # Reset the SQL according to the column definition
            ${$_}{"sql"} = $_{${$_}{"key"}};
            ${$_}{"sql"} .= " DESC" if ${$_}{"desc"};
        }
    }
    
    # OK
    return;
}

# compose_sortby: Compose the "sortby" argument from sorting keys
sub compose_sortby : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    
    # Bounce if there is no sorting keys
    if (@{$self->{"sortkeys"}} == 0) {
        $self->{"sortby"} = "";
        return;
    }
    @_ = qw();
    foreach (@{$self->{"sortkeys"}}) {
        if (${$_}{"desc"}) {
            push @_, "-" . ${$_}{"key"};
        } else {
            push @_, ${$_}{"key"};
        }
    }
    $self->{"sortby"} = join ",", @_;
    return;
}
    
# col_labels: Set the column labels
sub col_labels : method {
    local ($_, %_);
    my ($self, %labels);
    ($self, %labels) = @_;
    %{$self->{"col_labels"}} = (%{$self->{"col_labels"}}, %labels);
    return;
}

# check_listcols: Set the columns to be displayed
sub check_listcols : method {
    local ($_, %_);
    my ($self, @listcols, @validcols);
    $self = $_[0];
    
    # The columns to be displayed
    $_ = userpref("listcols", ref($self));
    if (defined $_) {
        @listcols = split / /, encode("US-ASCII", $_, FB_CROAK);
    } else {
        @listcols = @{$self->{"DEFAULT_LIST_COLS"}};
    }
    # Obtain the columns to list
    # Remove columns not to be displayed
    %_ = map { $_ => 1 } @{$self->{"COLS_NO_DISPLAY"}};
    @_ = grep !exists $_{$_}, @{$self->{"cols"}};
    # Only take valid columns in the preferenced columns
    %_ = map { $_ => 1 } @_;
    $self->{"listcols"} = [grep exists $_{$_}, @listcols];
    return;
}

# query_abstract: Get the abstract regarding to the query phrase
#   It always work with the "body" column
sub query_abstract : method {
    local ($_, %_);
    my ($self, $current, $body, @queries, $query, $start, $end, @union);
    my ($len_andsoon, $len, $reached_maximum, $union, $needlen);
    ($self, $current) = @_;
    # The column
    $body = $$current{"body"};
    # Strip the HTML tags
    if (exists $$current{"html"} && $$current{"html"}) {
        # HTML::Strip does not work with decode()d UTF-8 text
        $body = encode("UTF-8", $body);
        $body = (new HTML::Strip)->parse($body);
        $body = decode("UTF-8", $body);
        $body = dh($body);
    }
    # Trim excess spaces
    $body =~ s/\s+/ /g;
    # Sort the query phrases by their lengths
    if (exists $self->{"query_zh_phrases"}) {
        @queries = sort { length $b <=> length $a } @{$self->{"query_zh_phrases"}};
    } else {
        @queries = sort { length $b <=> length $a } @{$self->{"query_phrases"}};
    }
    # Gather the abstract of each query phrase
    @_ = qw();
    foreach my $query (@queries) {
        my $base;
        $base = 0;
        # Gather each match
        while (substr($body, $base) =~ /^(.*?)\Q$query\E/i) {
            $_ = $base + length $1;
            $start = $_ - $self->{"QABS_SPAN"};
            $start = 0 if $start < 0;
            $end = $_ + length($query) + $self->{"QABS_SPAN"};
            $end = length $body if $end > length $body;
            push @_, {
                "start" => $start,
                "end"   => $end,
            };
            $base = $_ + length $query;
        }
    }
    # Sanity check
    return undef if @_ == 0;
    # Sort the ranges
    @_ = sort { $$a{"start"}<=>$$b{"start"} || $$a{"end"}<=>$$b{"end"} } @_;
    
    # Get the union of the ranges
    @union = qw();
    $_ = 0;
    $start = ${$_[0]}{"start"};
    $end = ${$_[0]}{"end"};
    while (1) {
        # Find the next segment that exceeds the current segment
        for ( ; $_ < @_ && ${$_[$_]}{"end"} <= $end; $_++) {};
        # Meet the last entry
        if ($_ == @_) {
            # Save the last segment
            push @union, {
                "start" => $start,
                "end"   => $end,
                "len"   => $end - $start,
                "text"  => substr($body, $start, $end - $start),
            };
            last;
        }
        # A new segment seperated from the current segment
        if (${$_[$_]}{"start"} > $end) {
            # Save the last segment
            push @union, {
                "start" => $start,
                "end"   => $end,
                "len"   => $end - $start,
                "text"  => substr($body, $start, $end - $start),
            };
            # Start a new segment
            $start = ${$_[$_]}{"start"};
            $end = ${$_[$_]}{"end"};
            next;
        }
        # Expend the current segment
        $end = ${$_[$_]}{"end"};
        next;
    }
    
    # Trim the union
    $len_andsoon = 1;
    $len = 0;
    $len += $len_andsoon if ${$union[0]}{"start"} != 0;
    $reached_maximum = 0;
    for ($_ = 0; $_ < @union; $_++) {
        $union = $union[$_];
        $needlen = $$union{"len"} + $len_andsoon;
        # Not even enough for an abstract section
        if ($len + $len_andsoon > $self->{"QABS_MAXLEN"}) {
            $reached_maximum = 1;
            # Discard the rest sections
            pop @union while @union > $_;
            last;
        
        # Reached the maximum
        } elsif ($len + $needlen > $self->{"QABS_MAXLEN"}) {
            $reached_maximum = 1;
            $$union{"len"} = $self->{"QABS_MAXLEN"} - $len - $len_andsoon;
            $$union{"end"} = $$union{"start"} + $$union{"len"};
            $$union{"text"} = substr $body, $$union{"start"}, $$union{"len"};
            # Discard the rest sections
            pop @union while @union > $_ + 1;
            last;
        }
        # Not reached the maximum yet
        $len += $$union{"len"} + $len_andsoon;
    }
    # Not reached the maximum yet - check the last section
    if (!$reached_maximum) {
        $union = $union[$#union];
        $needlen = $$union{"len"};
        $needlen += $len_andsoon if $$union{"end"} != length $body;
        # Not even enough for an abstract section
        if ($len + $len_andsoon > $self->{"QABS_MAXLEN"}) {
            # Forget it.  We can do nothing now.
            pop @union;
        
        # Reached the maximum
        } elsif ($len + $needlen > $self->{"QABS_MAXLEN"}) {
            $$union{"len"} = $self->{"QABS_MAXLEN"} - $len - $len_andsoon;
            $$union{"end"} = $$union{"start"} + $$union{"len"};
            $$union{"text"} = substr $body, $$union{"start"}, $$union{"len"};
        }
        # Not reached the maximum yet
    }
    
    # Mark the query phrases
    foreach $union (@union) {
        my @pieces;
        @pieces = (
            {   "text"      => $$union{"text"},
                "is_match"  => 0,
            }
        );
        # Mark each query phrase
        foreach my $query (@queries) {
            for ($_ = 0; $_ < @pieces; $_++) {
                my ($pos, $piece);
                $piece = $pieces[$_];
                # Skip matches of other query phrases
                next if $$piece{"is_match"};
                # Skip if not matched
                next unless $$piece{"text"} =~ /^(.*?)(\Q$query\E)(.*)$/i;
                @pieces = (
                    @pieces[0 ... $_ - 1],
                    {   "text"      => $1,
                        "is_match"  => 0,
                    },
                    {   "text"      => $2,
                        "is_match"  => 1,
                    },
                    {   "text"      => $3,
                        "is_match"  => 0,
                    },
                    @pieces[$_ + 1 ... $#pieces],
                );
                $_++;
            }
        }
        $$union{"marked"} = join "", map(($$_{"is_match"}?
            "<em>" . h($$_{"text"}) . "</em>": h($$_{"text"})), @pieces);
    }
    
    # Join these segments
    $_ = join "…", map $$_{"marked"}, @union;
    $_ = "…" . $_ if ${$union[0]}{"start"} != 0;
    $_ .= "…" if ${$union[$#union]}{"end"} != length $body;
    
    return $_;
}

# html_title: Display the title
# Make it a null function
sub html_title : method {}

# html_errmsg: Display the error message
sub html_errmsg : method {
    local ($_, %_);
    my ($self, $message);
    $self = $_[0];
    
    return if !defined $self->{"error"};
    $message = h(err2msg $self->{"error"});
    
    print << "EOT";
<p class="message">$message</p>

EOT
    return;
}

# html_newlink: Display a link to add a new item
sub html_newlink : method {
    local ($_, %_);
    my ($self, $prompt, $url);
    ($self, $prompt) = @_;
    
    # No new item creation if it is a called form
    return if $self->{"is_called_form"};
    return if !defined $prompt;
    # Start from the default language
    return if   $DBH->is_ml_table($self->{"table"})
                && getlang ne $DEFAULT_LANG;
    $url = $REQUEST_FILEQS;
    # Remove list parameters
    $url = rem_get_arg $url, "query", "sortby", "pageno", "form", "formid", "statid";
    $url = add_get_arg $url, "form", "new", DUP_OK;
    $url = h($url);
    $prompt = h($prompt);
    
    print << "EOT";
<p><a href="$url">$prompt</a></p>

EOT
    return;
}

# html_lists_switch: Display the switch for different lists
sub html_lists_switch : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # Bounce for nothing
    return unless   exists $self->{"lists_switch"}
                    && @{$self->{"lists_switch"}} > 0;
    print "<div>\n";
    print join " |\n",
        map "    <a href=\"" . h($$_{"url"}) . "\">" . h($$_{"title"}) . "</a>",
            @{$self->{"lists_switch"}};
    print "</div>\n\n";
    return;
}

# html_search: Display the search box
sub html_search : method {
    local ($_, %_);
    my ($self, $prompt, $label, $query, $request_file);
    ($self, $prompt) = @_;
    # No search box is displayed if no records yet
    if (    $self->{"fetched"}
            && defined $self->{"total"} && $self->{"total"} == 0
            && !defined $self->{"query"}) {
        return;
    }
    
    $request_file = h($REQUEST_FILE);
    $query = defined $self->{"query"}? h($self->{"query"}): "";
    $label = h(C_("Search"));
    
    print << "EOT";
<form action="$request_file" method="get" accept-charset="<!--selima:charset-->">
<div class="searchbox">
EOT
    # Embed the caller information
    if ($self->{"is_called_form"}) {
        my ($caller, $cformid);
        $caller = h($self->{"caller"});
        $cformid = h($self->{"cformid"});
        print << "EOT";
<input type="hidden" name="caller" value="$caller" />
<input type="hidden" name="cformid" value="$cformid" />
EOT
    }
    if (defined $prompt) {
        $_ = h($prompt);
        print << "EOT";
<label for="query">$_</label>
EOT
    }
    print << "EOT";
<input id="query" type="text" name="query" value="$query" /><input
    type="hidden" name="charset" value="<!--selima:charset-->" /><input
    type="submit" value="$label" />
</div>
</form>

EOT
    return;
}

# html_data_download: Display the data download link
sub html_data_download : method {
    local ($_, %_);
    # Normally empty
    return;
}

# html_liststat: Display the list statistics
sub html_liststat : method {
    local ($_, %_);
    my ($self, $message);
    $self = $_[0];
    # Do not show the list
    return if !defined $self->{"total"};
    return if !defined($message = $self->liststat_message());
    $message = h($message);
    
    print << "EOT";
<p>$message</p>

EOT
    return;
}

# html_pagebar: Display a page navigation bar
# We display a page bar for scrolling between previous and next 2 pages
sub html_pagebar : method {
    local ($_, %_);
    my ($self, $html, $startpage, $endpage, $baseurl, $url, $cell, %tags);
    $self = $_[0];
    
    # Do not show the list
    return if !defined $self->{"total"};
    # Fit in one page - paging is not needed
    return if $self->{"lastpage"} <= 1;
    # Cached before
    if (exists $self->{"html_pagebar"}) {
        print $self->{"html_pagebar"};
        return;
    }
    
    # Fewer than 5 pages
    if ($self->{"lastpage"} <= 5) {
        $startpage = 1;
        $endpage = $self->{"lastpage"};
    # Near the beginning
    } elsif ($self->{"pageno"} < 3) {
        $startpage = 1;
        $endpage = 5;
    # Near the end
    } elsif ($self->{"pageno"} > $self->{"lastpage"} - 2) {
        $startpage = $self->{"lastpage"} - 4;
        $endpage = $self->{"lastpage"};
    # Normal, at the middle
    } else {
        $startpage = $self->{"pageno"} - 2;
        $endpage = $self->{"pageno"} + 2;
    }
    
    
    # Start output
    $html = "";
    %tags = $self->pagebar_tags;
    # Static page -- Display the index
    if ($self->{"static"}) {
        $html .= "<div class=\"pagebar\">\n"
            . "    <span><a href=\".\">" . h(C_("Index")) . "</a></span> |\n";
    # Dynamic page -- Display a paging form
    } else {
        # Base url without the "pageno" argument
        $baseurl = rem_get_arg $REQUEST_FILEQS, "pageno", "statid";
        $_ = h($REQUEST_FILE);
        $html .= << "EOT";
<form action="$_" method="get" accept-charset="<!--selima:charset-->">
<div class="pagebar">
EOT
        if ($self->{"is_called_form"}) {
            my ($caller, $cformid);
            $caller = h($self->{"caller"});
            $cformid = h($self->{"cformid"});
            print << "EOT";
<input type="hidden" name="caller" value="$caller" />
<input type="hidden" name="cformid" value="$cformid" />
EOT
        }
        if (defined $self->{"query"}) {
            $_ = h($self->{"query"});
            print << "EOT";
<input type="hidden" name="query" value="$_" />
EOT
        }
        if (defined $self->{"sortby"} && $self->{"sortby"} ne "") {
            $_ = h($self->{"sortby"});
            print << "EOT";
<input type="hidden" name="sortby" value="$_" />
EOT
        }
    }
    # The first page
    $cell = $tags{"first"};
    if ($self->{"pageno"} != 1) {
        if ($self->{"static"}) {
            $url = sprintf $self->{"static_filepat"}, 1;
        } elsif ($self->{"reverse"}) {
            $url = add_get_arg $baseurl, "pageno", 1, DUP_OK;
        } else {
            $url = $baseurl;
        }
        $cell = "<a href=\"" . h($url) . "\">" . $cell . "</a>";
    }
    $html .= "    <span>$cell</span> |\n";
    # The previous page
    $cell = $tags{"prev"};
    if ($self->{"pageno"} != 1) {
        if ($self->{"static"}) {
            $url = sprintf $self->{"static_filepat"}, $self->{"pageno"} - 1;
        } elsif ($self->{"reverse"} || $self->{"pageno"} - 1 != 1) {
            $url = add_get_arg $baseurl, "pageno", $self->{"pageno"} - 1, DUP_OK;
        } else {
            $url = $baseurl;
        }
        $cell = "<a href=\"" . h($url) . "\">" . $cell . "</a>";
    }
    $html .= "    <span>$cell</span> |\n";
    
    # Pages before
    for ($_ = $startpage; $_ < $self->{"pageno"}; $_++) {
        $cell = h($_);
        if ($self->{"static"}) {
            $url = sprintf $self->{"static_filepat"}, $_;
        } elsif ($self->{"reverse"} || $_ != 1) {
            $url = add_get_arg $baseurl, "pageno", $_, DUP_OK;
        } else {
            $url = $baseurl;
        }
        $cell = "<a href=\"" . h($url) . "\">" . $cell . "</a>";
        $html .= "    <span>$cell</span> |\n";
    }
    # Current page
    $cell = h($self->{"pageno"});
    $html .= "    <span>$cell</span> |\n";
    # Pages after
    for ($_ = $self->{"pageno"} + 1; $_ <= $endpage; $_++) {
        $cell = h($_);
        if ($self->{"static"}) {
            if (    defined $self->{"static_lastfile"}
                    && $_ == $self->{"lastpage"}) {
                $url = $self->{"static_lastfile"};
            } else {
                $url = sprintf $self->{"static_filepat"}, $_;
            }
        } elsif (!$self->{"reverse"} || $_ != $self->{"lastpage"}) {
            $url = add_get_arg $baseurl, "pageno", $_, DUP_OK;
        } else {
            $url = $baseurl;
        }
        $cell = "<a href=\"" . h($url) . "\">" . $cell . "</a>";
        $html .= "    <span>$cell</span> |\n";
    }
    
    # The next page
    $cell = $tags{"next"};
    if ($self->{"pageno"} != $self->{"lastpage"}) {
        if ($self->{"static"}) {
            if (    defined $self->{"static_lastfile"}
                    && $self->{"pageno"} + 1 == $self->{"lastpage"}) {
                $url = $self->{"static_lastfile"};
            } else {
                $url = sprintf $self->{"static_filepat"},
                    $self->{"pageno"} + 1;
            }
        } elsif (!$self->{"reverse"} || $self->{"pageno"} + 1 != $self->{"lastpage"}) {
            $url = add_get_arg $baseurl, "pageno", $self->{"pageno"} + 1, DUP_OK;
        } else {
            $url = $baseurl;
        }
        $cell = "<a href=\"" . h($url) . "\">" . $cell . "</a>";
    }
    $html .= "    <span>$cell</span> |\n";
    # The last page
    $cell = $tags{"last"};
    if ($self->{"pageno"} != $self->{"lastpage"}) {
        if ($self->{"static"}) {
            if (defined $self->{"static_lastfile"}) {
                $url = $self->{"static_lastfile"};
            } else {
                $url = sprintf $self->{"static_filepat"}, $self->{"lastpage"};
            }
        } elsif (!$self->{"reverse"}) {
            $url = add_get_arg $baseurl, "pageno", $self->{"lastpage"}, DUP_OK;
        } else {
            $url = $baseurl;
        }
        $cell = "<a href=\"" . h($url) . "\">" . $cell . "</a>";
    }
    $html .= "    <span>$cell</span>";
    if ($self->{"static"}) {
        $html .= << "EOT";

</div>

EOT
    } else {
        my ($label, $input, $pageno);
        $label = h(C_("Page:"));
        $input = h(C_("View"));
        $pageno = h($self->{"pageno"});
        $html .= << "EOT";
 |
<label for="pageno">$label</label><input
    type="text" name="pageno" size="5" maxlength="5" value="$pageno" /><input
    type="hidden" name="charset" value="<!--selima:charset-->" /><input
    type="submit" value="$input" />
</div>
</form>

EOT
    }
    print $html;
    # Cache it
    $self->{"html_pagebar"} = $html;
    
    return;
}

# html_list: List the items
sub html_list : method {
    local ($_, %_);
    my ($self, $baseurl, $url, $need_view);
    $self = $_[0];
    # Do not show the list
    return if !defined $self->{"total"};
    # No record to be listed
    return if $self->{"total"} == 0;
    
    # Remove "sortby" from the URL first
    $baseurl = $REQUEST_FILEQS;
    $baseurl = rem_get_arg $baseurl, "formid", "statid", "sortby", "pageno";
    
    # Do we need a view link?
    $need_view =    in_array("_viewurl", @{$self->{"cols"}})
                    && !$self->{"is_called_form"};
    # Check the URL first
    urlcheck @{$self->{"current"}}
        if in_array("_urlcheck", @{$self->{"listcols"}});
    
    # Mass deletion -- surround it with a form
    if ($self->{"massdel"} && !$self->{"is_called_form"}) {
        my $label;
        $label = h(C_("Delete the selected items."));
        $url = h($REQUEST_FILE);
        print << "EOT";
<form action="$url" method="post" accept-charset="<!--selima:charset-->">
<div><input type="hidden" name="charset" value="<!--selima:charset-->" /><input
    type="hidden" name="form" value="_massdel" /><input
    type="submit" value="$label" /></div>
EOT
    }
    
    print << "EOT";
<table class="deflist">
EOT
    print "<colgroup><col />";
    print "<col />" if $self->{"massdel"} && !$self->{"is_called_form"};
    print "<col />" if $need_view;
    print "<col />" if !$self->{"noselect"};
    for ($_ = 0; $_ < @{$self->{"listcols"}}; $_++) {
        print "<col />";
    }
    print "</colgroup>\n";
    print << "EOT";
<thead>
<tr>
EOT
    print "    <th class=\"listno\" scope=\"col\">" . h_abbr(C_("No.")) . "</th>\n";
    print "    <th class=\"listdel\" scope=\"col\">" . h_abbr(C_("Delete")) . "</th>\n"
        if $self->{"massdel"} && !$self->{"is_called_form"};
    print "    <th scope=\"col\">" . h_abbr(C_("View")) . "</th>\n" if $need_view;
    print "    <th scope=\"col\">" . h_abbr($self->{"seltext"}) . "</th>\n" if !$self->{"noselect"};
    foreach my $col (@{$self->{"listcols"}}) {
        my ($label, $key);
        $label = h_abbr(exists ${$self->{"col_labels"}}{$col}? ${$self->{"col_labels"}}{$col}: $col);
        if (in_array($col, @{$self->{"COLS_NO_SORT_BY"}})) {
            print << "EOT";
    <th scope="col">$label</th>
EOT
        } else {
            $key = $col;
            $key = "-$key" if defined $self->{"sortby"} && $self->{"sortby"} eq $key;
            $url = h(add_get_arg($baseurl, "sortby", $key, DUP_OK));
            print << "EOT";
    <th scope="col"><a href="$url">$label</a></th>
EOT
        }
    }
    print << "EOT";
</tr>
</thead>
<tbody>
EOT
    
    # Print each record
    my ($no, $inc, $rowclass);
    if (!$self->{"reverse"}) {
        $no = $self->{"startno"} + 1;
        $inc = 1;
    } else {
        $no = $self->{"endno"} + 1;
        $inc = -1;
    }
    $rowclass = "";
    foreach my $current (@{$self->{"current"}}) {
        my ($issel, $selurl);
        $rowclass = h(($rowclass eq "oddrow")? "evenrow": "oddrow");
        # The URL. to handle the selection
        $issel = ((!in_array("_sel", @{$self->{"cols"}}) || $$current{"_sel"})
            && !$self->{"noselect"});
        if ($issel) {
            $selurl = exists $$current{"_selurl"}? $$current{"_selurl"}:
                sprintf $self->{"selurl_tmpl"}, h($$current{"sn"});
        }
        
        print << "EOT";
<tr class="$rowclass">
    <th class="listno" scope="row">$no</th>
EOT
        print "    <td class=\"listdel\"><input type=\"checkbox\" name=\""
                . h("delsn" . $$current{"sn"}) . "\" /></td>\n"
            if $self->{"massdel"} && !$self->{"is_called_form"};
        if ($need_view) {
            if (!defined $$current{"_viewurl"}) {
                print "    <td></td>\n"
            } else {
                print "    <td><a href=\"" . h($$current{"_viewurl"}) . "\">"
                    .  h(C_("View")) . "</a></td>\n";
            }
        }
        if (!$self->{"noselect"}) {
            print "    <td>";
            print "<a href=\"" . h($selurl) . "\">"
                    .  h($self->{"seltext"}) . "</a>"
                if $issel;
            print "</td>\n";
        }
        foreach my $col (@{$self->{"listcols"}}) {
            print "    <td>" . $self->colval($col, %$current) . "</td>\n";
        }
        print << "EOT";
</tr>
EOT
        $no += $inc;
    }
    print << "EOT";
</tbody>
</table>

EOT
    
    # Mass deletion -- surround it with a form
    if ($self->{"massdel"} && !$self->{"is_called_form"}) {
        my $label;
        $label = h(C_("Delete the selected items."));
        print << "EOT";
<div><input type="submit" value="$label" /></div>
</form>

EOT
    }
    
    return;
}

# html_listprefform: Display a form to change the list preference
sub html_listprefform : method {
    local ($_, %_);
    my ($self, $submit, $referer, @validcols, $request_file_h, $domain);
    my ($label, $pagesize);
    $self = $_[0];
    
    # Do not show the list
    return if !defined $self->{"total"};
    # No record to be listed
    return if $self->{"total"} == 0;
    # Return if users preferences are not available
    return if !use_users || !defined $SESSION;
    $submit = C_("Set");
    # The referer
    $referer = h(rem_get_arg $REQUEST_FULLURI, "statid");
    
    # Obtain the columns to list
    %_ = map { $_ => 1 } @{$self->{"COLS_NO_DISPLAY"}};
    @validcols = grep !exists $_{$_}, @{$self->{"cols"}};
    
    $request_file_h = h($REQUEST_FILE);
    # The domain -- my class name
    $domain = h(ref($self));
    
    print << "EOT";
<form action="$request_file_h" method="post" accept-charset="<!--selima:charset-->">
<div><input type="hidden" name="charset" value="<!--selima:charset-->" /><input
    type="hidden" name="form" value="listpref" /><input
    type="hidden" name="referer" value="$referer" /><input
    type="hidden" name="domain" value="$domain" />
EOT
    
    # The number of rows per page
    $label = h_abbr(C_("Rows per page:"));
    $pagesize = h($self->{"pagesize"});
    print << "EOT";
<label for="listsize">$label</label><input
    id="listsize" type="text" name="listsize" size="5" maxlength="5" value="$pagesize" />
EOT
    
    # The display columns
    print h_abbr(C_("Display columns:")) . "\n";
    %_ = map { $_ => 1 } @{$self->{"listcols"}};
    foreach my $col (@validcols) {
        my ($name, $label, $check);
        $label = h_abbr(exists ${$self->{"col_labels"}}{$col}? ${$self->{"col_labels"}}{$col}: $col);
        $name = h("listcols_" . $col);
        $check = exists $_{$col}? " checked=\"checked\"": "";
        print << "EOT";
<input id="$name" type="checkbox" name="$name"$check /><label for="$name">$label</label>
EOT
    }
    
    print << "EOT";
<input type="submit" name="confirm" value="$submit" /></div>
</form>

EOT
    
    return;
}


#######################
# Below are functions
#######################
# urlcheck: Proform URL checks
sub urlcheck(\@) {
    local ($_, %_);
    my ($current, @tocheck);
    my ($pid, $out, $err, $exitno, $CHILD_IN, $CHILD_OUT, $CHILD_ERR);
    $current = $_[0];
    
    @tocheck = qw();
    foreach (@$current) {
        if (!is_url_wellformed $$_{"_urlcheck"}) {
            $$_{"_urlcheck"} = C_("Malformed");
        } else {
            push @tocheck, $_;
        }
    }
    
    # Nothing to check further
    return if @tocheck == 0;
    
    # Duplicate the file handles and fork
    $pid = open3($CHILD_IN, $CHILD_OUT, $CHILD_ERR, @URLCHECK);
    # Get the result of the child
    if (defined $CHILD_IN) {
        print $CHILD_IN join("", map $$_{"_urlcheck"} . "\n", @tocheck)
                                        or http_500 join(" ", @URLCHECK) . ": $!";
        close $CHILD_IN                 or http_500 join(" ", @URLCHECK) . ": $!";
    }
    if (defined $CHILD_OUT) {
        $out = join "", <$CHILD_OUT>;
        close $CHILD_OUT                or http_500 join(" ", @URLCHECK) . ": $!";
    }
    if (defined $CHILD_ERR) {
        $err = join "", <$CHILD_ERR>;
        close $CHILD_ERR                or http_500 join(" ", @URLCHECK) . ": $!";
    }
    
    waitpid $pid, 0;
    $exitno = $? >> 8;
    #$coredump = $? & 128;
    http_500 join(" ", @URLCHECK) . ": $exitno $err" if $exitno != 0;
    
    # Save the result
    @_ = split /\n/, $out;
    for ($_ = 0; $_ < @tocheck; $_++) {
        ${$tocheck[$_]}{"_urlcheck"} = $_[$_]? C_("OK"): C_("Unreachable");
    }
    
    return;
}

no utf8;
return 1;