1620 lines
51 KiB
Perl
1620 lines
51 KiB
Perl
# 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;
|