227 lines
7.5 KiB
Perl
227 lines
7.5 KiB
Perl
# Selima Website Content Management System
|
|
# Public.pm: The base guestbook message 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-10-23
|
|
|
|
package Selima::List::Guestbook::Public;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(Selima::List);
|
|
|
|
use IO::NestedCapture qw(CAPTURE_STDOUT);
|
|
|
|
use Selima::A2HTML;
|
|
use Selima::DataVars qw($DBH :requri);
|
|
use Selima::Format;
|
|
use Selima::GetLang;
|
|
use Selima::MungAddr;
|
|
use Selima::ShortCut;
|
|
use Selima::Unicode;
|
|
|
|
# new: Initialize the handler
|
|
sub new : method {
|
|
local ($_, %_);
|
|
my ($self, $class);
|
|
($class, @_) = @_;
|
|
$_[1] = "guestbook" if !defined $_[1];
|
|
$self = $class->SUPER::new(@_);
|
|
$self->{"view"} = "guestbook_public";
|
|
# Entries should be displayed in a reversed order
|
|
$self->{"reverse"} = 1;
|
|
# Magical Traditional/Simplified Chinese conversion
|
|
$self->{"magic_zhconv"} = 0;
|
|
return $self;
|
|
}
|
|
|
|
# fetch: Fetch the current list
|
|
sub fetch : method {
|
|
local ($_, %_);
|
|
my ($self, $table, $sth, $sql, $error);
|
|
$self = $_[0];
|
|
|
|
# Fetched before
|
|
return $self->{"error"} if $self->{"fetched"};
|
|
$self->{"fetched"} = 1;
|
|
|
|
# Initialize the error status
|
|
$self->{"error"} = undef;
|
|
|
|
# The view name
|
|
$table = $DBH->quote_identifier($self->{"view"});
|
|
|
|
# Find the last page number
|
|
$sql = "SELECT pageno FROM $table ORDER BY pageno DESC LIMIT 1;\n";
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
# No records yet
|
|
if ($sth->rows != 1) {
|
|
$self->{"lastpage"} = 1;
|
|
} else {
|
|
$self->{"lastpage"} = ${$sth->fetch}[0];
|
|
}
|
|
# Check the page number
|
|
$error = $self->check_pageno;
|
|
$self->{"error"} = $error if defined $error && !defined $self->{"error"};
|
|
|
|
# Obtain the total number
|
|
$self->{"select_total"} = sprintf "SELECT count(*) FROM $table;\n";
|
|
$sql = $self->{"select_total"};
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
$self->{"total"} = ($sth->fetchrow_array)[0];
|
|
|
|
# Obtain everything in this page
|
|
$self->{"current"} = [];
|
|
# Always reverse
|
|
$self->{"select"} = "SELECT * FROM $table"
|
|
. " WHERE pageno=" . $self->{"pageno"} . ";\n";
|
|
$sql = $self->{"select"};
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
push @{$self->{"current"}}, $_
|
|
while defined($_ = $sth->fetchrow_hashref);
|
|
undef $sth;
|
|
|
|
# Done
|
|
return $self->{"error"};
|
|
}
|
|
|
|
# page_param: Obtain page parameters
|
|
sub page_param : method {
|
|
local ($_, %_);
|
|
my ($self, $args);
|
|
$self = $_[0];
|
|
# Run the parent method
|
|
$args = $self->SUPER::page_param;
|
|
# Add the page bar to the page parameters
|
|
if (defined $args && $self->{"lastpage"} > 1) {
|
|
my $FD;
|
|
# Obtain the page bar
|
|
IO::NestedCapture->start(CAPTURE_STDOUT);
|
|
binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1], ":utf8";
|
|
$self->html_pagebar;
|
|
IO::NestedCapture->stop(CAPTURE_STDOUT);
|
|
$FD = IO::NestedCapture->get_last_out;
|
|
$$args{"header_html_nav"} = join "", <$FD>;
|
|
$$args{"header_html_nav"} =~ s/\s+$//;
|
|
$$args{"footer_html_nav"} = $$args{"header_html_nav"};
|
|
}
|
|
return $args;
|
|
}
|
|
|
|
# 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 error message
|
|
$self->html_errmsg;
|
|
# List the items
|
|
$self->html_list;
|
|
|
|
return;
|
|
}
|
|
|
|
# html_list: List the items
|
|
sub html_list : method {
|
|
local ($_, %_);
|
|
my ($self, @htmls, $emailalt);
|
|
$self = $_[0];
|
|
# No record to be listed
|
|
return if $self->{"total"} == 0;
|
|
|
|
$emailalt = h(C_("E-mail"));
|
|
foreach my $current (@{$self->{"current"}}) {
|
|
my $h;
|
|
# Magical Traditional/Simplified Chinese conversion
|
|
if ($self->{"magic_zhconv"}) {
|
|
$_ = getlang;
|
|
if ( $_ eq "zh-tw" &&
|
|
!(defined $$current{"lang"}
|
|
&& $$current{"lang"} eq "zh-tw")) {
|
|
foreach my $col (qw(name identity location email url message)) {
|
|
$$current{$col} = all_to_trad($$current{$col})
|
|
if defined $$current{$col};
|
|
}
|
|
} elsif ( $_ eq "zh-cn" &&
|
|
!(defined $$current{"lang"}
|
|
&& $$current{"lang"} eq "zh-cn")) {
|
|
foreach my $col (qw(name identity location email url message)) {
|
|
$$current{$col} = all_to_simp($$current{$col})
|
|
if defined $$current{$col};
|
|
}
|
|
}
|
|
}
|
|
$h = "";
|
|
$h .= "<div id=\"msg" . h($$current{"sn"}) . "\" class=\"entry\">\n";
|
|
$h .= "<div>\n" . a2html($$current{"message"}) . "\n</div>\n\n";
|
|
# <form ...>...</form> cannot live inside of <address>...</address>
|
|
$h .= "<form action=\"/cgi-bin/mailto.cgi\" method=\"post\">\n"
|
|
if defined $$current{"email"} && $$current{"email"} =~ /\@/;
|
|
$h .= "<address>\n";
|
|
$h .= "<cite>" . h($$current{"name"}) . "</cite><br />\n"
|
|
if defined $$current{"name"};
|
|
if (getlang eq "en") {
|
|
$h .= myfmttime($$current{"date"}) . "<br />\n";
|
|
} else {
|
|
$h .= "<span xml:lang=\"en\">" . myfmttime($$current{"date"}) . "</span><br />\n";
|
|
}
|
|
$h .= h($$current{"identity"}) . "<br />\n"
|
|
if defined $$current{"identity"};
|
|
$h .= h($$current{"location"}) . "<br />\n"
|
|
if defined $$current{"location"};
|
|
if (defined $$current{"email"}) {
|
|
if ($$current{"email"} =~ /\@/) {
|
|
$h .= "<samp>" . mung_email_span(h($$current{"email"})) . "</samp>"
|
|
. "<input\n type=\"hidden\" name=\"email\" value=\""
|
|
. h(mung_address_at($$current{"email"})) . "\" />"
|
|
. "<input\n type=\"image\" src=\"/images/email\" alt=\"$emailalt\" /><br />\n";
|
|
} else {
|
|
$h .= "<samp>" . mung_email_span(h($$current{"email"})) . "</samp><br />\n";
|
|
}
|
|
}
|
|
if (defined $$current{"url"}) {
|
|
if ($$current{"url"} =~ /^(?:http|https|ftp|gopher|telnet):\/\//) {
|
|
$h .= "<samp><a href=\"" . h($$current{"url"}) . "\">"
|
|
. h($$current{"url"}) . "</a></samp><br />\n";
|
|
} else {
|
|
$h .= h($$current{"url"}) . "<br />\n";
|
|
}
|
|
}
|
|
$h .= C_("~[<a href=\"[_1]\">Edit</a>~]",
|
|
h("/magicat/cgi-bin/guestbook.cgi?form=cur&sn=" . $$current{"sn"})) . "\n"
|
|
if $ENV{"REMOTE_ADDR"} =~ /^10\./;
|
|
$h .= "</address>\n";
|
|
$h .= "</form>\n" if defined $$current{"email"} && $$current{"email"} =~ /\@/;
|
|
$h .= "</div>\n\n";
|
|
push @htmls, $h;
|
|
}
|
|
|
|
$_ = h(C_("The message entry seperator"));
|
|
print "<hr />\n\n<div class=\"entries\">\n\n"
|
|
. join("<hr title=\"$_\" />\n\n", @htmls) . "</div>\n\n";
|
|
|
|
return;
|
|
}
|
|
|
|
return 1;
|