Initial checkin.
Signed-off-by: Thomas Hochstein <thh@thh.name>
This commit is contained in:
commit
30132626b8
68 changed files with 5497 additions and 0 deletions
811
MOD/Displaylib.pm
Normal file
811
MOD/Displaylib.pm
Normal file
|
|
@ -0,0 +1,811 @@
|
|||
######################################################################
|
||||
#
|
||||
# $Id: Displaylib.pm 305 2011-12-26 19:51:53Z root $
|
||||
#
|
||||
# Copyright 2007-2009 Roman Racine
|
||||
# Copyright 2009-2011 Alexander Bartolich
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
######################################################################
|
||||
package MOD::Displaylib;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp qw( confess );
|
||||
|
||||
use Mail::Mailer();
|
||||
use News::Article();
|
||||
use News::Article::Response();
|
||||
use MIME::QuotedPrint();
|
||||
use MIME::Base64();
|
||||
use Encode();
|
||||
use CGI();
|
||||
use CGI::Pretty();
|
||||
|
||||
use MOD::DBIUtilsPublic;
|
||||
use MOD::Utils;
|
||||
|
||||
use constant VERSION => 0.09;
|
||||
|
||||
use constant MENU_MESSAGES => [
|
||||
[ 'pending', 'Pending' ],
|
||||
[ 'spam', 'Spam' ],
|
||||
[ 'moderated', 'Approved' ],
|
||||
[ 'posted', 'Posted' ],
|
||||
[ 'rejected', 'Rejected' ],
|
||||
[ 'deleted', 'Deleted' ],
|
||||
[ 'errors', 'Error Messages' ],
|
||||
];
|
||||
use constant MENU_CONFIGURATION => undef;
|
||||
|
||||
use constant MENU_MAIN => [
|
||||
[ 'pending', 'Messages', MENU_MESSAGES ],
|
||||
[ 'config', 'Configuration', MENU_CONFIGURATION ],
|
||||
];
|
||||
|
||||
######################################################################
|
||||
sub new($$$)
|
||||
######################################################################
|
||||
{
|
||||
my ($class, $configref, $privileged) = @_;
|
||||
my $self = {};
|
||||
|
||||
$self->{'db'} = MOD::DBIUtilsPublic->new($configref);
|
||||
my $q = $self->{'q'} = CGI->new();
|
||||
|
||||
my $self_url = $q->self_url;
|
||||
$self_url =~ s/\?+.+$//;
|
||||
$self->{'self_url'} = $self_url;
|
||||
|
||||
$self->{'config'} = $configref;
|
||||
$self->{'privileged'} = $privileged;
|
||||
|
||||
my $lang = MOD::Utils::get_translator_language(
|
||||
$configref->{'html_language'},
|
||||
$configref->{'http_negotiate_language'}
|
||||
);
|
||||
$self->{'trans_lang'} = $lang;
|
||||
$self->{'trans'} = MOD::Utils::get_translator($lang);
|
||||
|
||||
if ($privileged)
|
||||
{
|
||||
my $authentication = $configref->{'http_authentication_method'};
|
||||
die "No 'http_authentication_method' in configuration file." unless($authentication);
|
||||
|
||||
if ($q->auth_type() && $q->auth_type() eq $authentication)
|
||||
{
|
||||
$self->{'user_name'} = $q->remote_user();
|
||||
}
|
||||
elsif ($authentication eq 'None')
|
||||
{
|
||||
$self->{'user_name'} = $q->remote_host();
|
||||
}
|
||||
die 'Not authorized' unless($self->{'user_name'});
|
||||
}
|
||||
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub display_start($;$$$@)
|
||||
######################################################################
|
||||
{
|
||||
my $self = shift;
|
||||
my %args = @_;
|
||||
|
||||
my $trans = $self->{'trans'} || confess 'No translator';
|
||||
my $title = $args{'-title'} || confess 'No -title';
|
||||
$title = $trans->($title);
|
||||
|
||||
my $group = $self->{'config'}->{'moderated_group'};
|
||||
my @title;
|
||||
push @title, '[*]' if ( $args{'-mark'} );
|
||||
push @title, $group if ($group);
|
||||
push @title, $title if ($title);
|
||||
|
||||
my $q = $self->{'q'};
|
||||
my @head = ($q->meta({
|
||||
-http_equiv => 'expires',
|
||||
-content => '0'
|
||||
}));
|
||||
|
||||
my $refresh = $args{'-refresh'};
|
||||
if ($refresh)
|
||||
{
|
||||
push @head, $q->meta({
|
||||
-http_equiv => 'Refresh',
|
||||
-content => $refresh
|
||||
});
|
||||
}
|
||||
|
||||
my @param = (
|
||||
-title => join(' ', @title),
|
||||
-head => \@head
|
||||
);
|
||||
|
||||
my $css = $self->{'config'}->{'html_stylesheet_href'};
|
||||
if ($css)
|
||||
{ push @param, -style => { -src => $css }; }
|
||||
|
||||
print
|
||||
$q->header,
|
||||
$q->start_html( @param );
|
||||
$self->print_menu_items() if ($self->{'privileged'});
|
||||
|
||||
print '<div class="huhuContents">';
|
||||
print $q->h1($title);
|
||||
my $subtitle = $args{'-subtitle'};
|
||||
if ($subtitle)
|
||||
{
|
||||
printf '<div class="huhuSubtitle">%s</div>', $trans->($subtitle);
|
||||
}
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub display_end($)
|
||||
######################################################################
|
||||
{
|
||||
my ($self) = @_;
|
||||
|
||||
my $group = $self->{'config'}->{'moderated_group'};
|
||||
my $user = $self->{'user_name'};
|
||||
|
||||
my @a;
|
||||
push @a, $group if ($group);
|
||||
push @a, $self->{'trans_lang'};
|
||||
push @a, $user if ($user);
|
||||
push @a, 'huhu version ' . VERSION;
|
||||
|
||||
print
|
||||
'<div class="huhuVersion">',
|
||||
join(' · ', @a),
|
||||
'.</div>',
|
||||
'</div><!-- class="huhuContents" -->',
|
||||
$self->{'q'}->end_html;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub display_die_msg($$$)
|
||||
######################################################################
|
||||
{
|
||||
my ($self, $title, $msg) = @_;
|
||||
my $trans = $self->{'trans'} || confess 'No translator';
|
||||
|
||||
$self->display_start(-title => 'Error');
|
||||
print '<div class="huhuError">',
|
||||
$trans->($msg ? $msg : $title),
|
||||
'</div>';
|
||||
$self->display_end();
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub display_table($@)
|
||||
######################################################################
|
||||
{
|
||||
my $self = shift || confess 'No $self';
|
||||
my %args = @_;
|
||||
|
||||
my $status = $args{'-status'} || confess 'No -status';
|
||||
my $start = $args{'-start'}; # can be 0
|
||||
my $no_of_elements = $args{'-no_of_elements'} || confess 'No -no_of_elements';
|
||||
my $overviewref = $args{'-overviewref'} || confess 'No -overviewref';
|
||||
my $decisionref = $args{'-decisionref'} || confess 'No -decisionref';
|
||||
my $cmd = $args{'-cmd'};
|
||||
|
||||
my @hidden_columns = ( 'flag', 'id' );
|
||||
{
|
||||
my $extra_hidden_columns = $args{'-hiddencolumns'};
|
||||
if ($extra_hidden_columns) {
|
||||
push @hidden_columns, @$extra_hidden_columns;
|
||||
}
|
||||
}
|
||||
my @columns = ( @hidden_columns, @$overviewref );
|
||||
|
||||
my $db = $self->{'db'} || confess 'No "db" in $self';
|
||||
|
||||
my $dataref;
|
||||
if ($status eq 'errors' and $self->{'privileged'}) {
|
||||
$dataref = $db->display_errors($status,$start,$no_of_elements,\@columns);
|
||||
} else {
|
||||
$dataref = $db->displayrange($status,$start,$no_of_elements,\@columns);
|
||||
}
|
||||
|
||||
my $trans = $self->{'trans'} || confess 'No translator';
|
||||
my $sqlnames = $dataref->{'NAME'} || confess 'No "NAME" in $dataref';
|
||||
my @names = map { CGI::escapeHTML($trans->( $_ )) } (
|
||||
@$sqlnames[1 + $#hidden_columns .. $#$sqlnames],
|
||||
'Available Actions'
|
||||
);
|
||||
|
||||
my $ref = $dataref->fetchrow_arrayref();
|
||||
my $q = $self->{'q'} || confess 'No "q" in $self';
|
||||
|
||||
$self->display_start(
|
||||
-title => $args{'-title'},
|
||||
-subtitle => $args{'-subtitle'},
|
||||
-mark => $ref && $self->{'privileged'},
|
||||
-refresh => '300; ' . $q->url() . '?' . $cmd
|
||||
);
|
||||
|
||||
print '<table class="huhuPostList">';
|
||||
print $q->Tr($q->th({-align=>'left'},\@names));
|
||||
|
||||
my $css = $self->{'config'}->{'html_stylesheet_href'};
|
||||
my $flagattr = ($css) ? ' class="huhuFlag"' : ' bgcolor="#ffcccc"';
|
||||
|
||||
my $row_nr = 0;
|
||||
if ($ref) {
|
||||
do {
|
||||
$row_nr++;
|
||||
my @dataline = @{$ref};
|
||||
my $flag = $dataline[0];
|
||||
my $rowattr = ($flag and $self->{'privileged'})
|
||||
? $flagattr
|
||||
: ($row_nr % 2)
|
||||
? ' class="huhuOdd"'
|
||||
: ' class="huhuEven"';
|
||||
|
||||
my $id = $dataline[1];
|
||||
print "<tr$rowattr>";
|
||||
for my $i(1 + $#hidden_columns .. $#dataline) {
|
||||
my $data = $dataline[$i];
|
||||
$data = CGI::escapeHTML(substr($self->decode_line($data),0,40));
|
||||
$data =~ s/\@/#/g if (!defined($self->{'user_name'}));
|
||||
print $q->td($data);
|
||||
}
|
||||
print'<td>';
|
||||
$self->display_decisionbuttons($decisionref, $ref, \@hidden_columns);
|
||||
print '</td></tr>',"\n";
|
||||
} while ($ref = $dataref->fetchrow_arrayref);
|
||||
}
|
||||
|
||||
if ($row_nr == 0)
|
||||
{
|
||||
printf '<tr><td class="huhuNoRows" colspan="%d">', 1 + $#names;
|
||||
print $trans->('No matching records available.');
|
||||
print '</td></tr>';
|
||||
}
|
||||
|
||||
print "</table>\n";
|
||||
$self->nextpage($cmd, $start, $args{'-display_per_page'});
|
||||
|
||||
$self->display_end();
|
||||
return;
|
||||
}
|
||||
|
||||
sub display_reason {
|
||||
my ($self,$id,$decisionref,$title) = @_;
|
||||
my $dataref = $self->{'db'}->get_reason($id);
|
||||
my $reason;
|
||||
eval {
|
||||
($reason) = @{$dataref->fetchrow_arrayref};
|
||||
}; if ($@) {
|
||||
$self->display_die_msg('No reason stored in database!');
|
||||
return;
|
||||
}
|
||||
|
||||
$self->display_start(-title => $title);
|
||||
|
||||
print
|
||||
'<div class="huhuReason">',
|
||||
'<pre width="100">', CGI::escapeHTML($reason), '</pre>',
|
||||
'</div>';
|
||||
$self->display_decisionbuttons($decisionref, [ $id ]);
|
||||
print $self->{'q'}->end_html;
|
||||
return;
|
||||
}
|
||||
|
||||
sub display_navigation_back() {
|
||||
my ($self) = @_;
|
||||
my $q = $self->{'q'} || confess 'No q';
|
||||
my $trans = $self->{'trans'} || confess 'No translator';
|
||||
print
|
||||
'<div class="huhuNavigation">',
|
||||
'<span>',
|
||||
$q->a({ href => $q->referer() }, $trans->('Back')),
|
||||
'</span>',
|
||||
'</div>';
|
||||
}
|
||||
|
||||
sub display_article_info($$$)
|
||||
{
|
||||
my ( $self, $sqlnames, $row ) = @_;
|
||||
|
||||
$sqlnames || confess 'No "NAME" in $dataref';
|
||||
$row || confess 'No $row';
|
||||
$#$row == $#$sqlnames || confess '$#$row != $#$sqlnames';
|
||||
|
||||
my @a;
|
||||
for(my $i = 1; $i <= $#$row; $i++)
|
||||
{
|
||||
my $value = $row->[$i];
|
||||
if ($value)
|
||||
{
|
||||
push @a,
|
||||
CGI::escapeHTML($sqlnames->[$i]) .
|
||||
': ' .
|
||||
CGI::escapeHTML($value);
|
||||
}
|
||||
}
|
||||
if (@a)
|
||||
{
|
||||
print
|
||||
'<div class="huhuArticleInfo">',
|
||||
join(' · ', @a),
|
||||
'</div>';
|
||||
}
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub display_article($@)
|
||||
######################################################################
|
||||
{
|
||||
my $self = shift || confess 'No $self';
|
||||
my %args = @_;
|
||||
|
||||
my $status = $args{'-status'};
|
||||
my $id = $args{'-id'};
|
||||
my $headerref = $args{'-headerref'};
|
||||
my $decisionref = $args{'-decisionref'};
|
||||
my $fullheader = $args{'-fullheader'};
|
||||
|
||||
if ($status eq 'errors') {
|
||||
$status = undef;
|
||||
}
|
||||
|
||||
my $dataref = $self->{'db'}->display_single($status,$id);
|
||||
my $row = $dataref->fetchrow_arrayref;
|
||||
if (!$row || $#$row < 1) {
|
||||
$self->display_die_msg('_ALREADY_HANDLED' . " (status=$status, id=$id)");
|
||||
return;
|
||||
}
|
||||
|
||||
my $article = $self->decode_article(News::Article->new(\$row->[0]));
|
||||
|
||||
$self->display_start(-title => 'Selected Article');
|
||||
$self->display_article_info($dataref->{'NAME'}, $row);
|
||||
my $q = $self->{'q'} || confess 'No "q" in $self';
|
||||
|
||||
print '<table class="huhuArticle">';
|
||||
if ($fullheader) {
|
||||
my $header = join "\n",$article->headers();
|
||||
print $q->Tr($q->td({-colspan=>2},'<pre width="100">' . CGI::escapeHTML($header) .'</pre>'));
|
||||
} else {
|
||||
for my $headerline (@{$headerref}) {
|
||||
print
|
||||
'<tr class="huhuArticleHeader">',
|
||||
'<th>', CGI::escapeHTML($headerline), '</th>',
|
||||
'<td>', CGI::escapeHTML($article->header($headerline)), '</td>',
|
||||
'</tr>';
|
||||
}
|
||||
}
|
||||
my @ngs = split ',', $article->header('Newsgroups');
|
||||
if ($self->{'user_name'} && @ngs > 2)
|
||||
{
|
||||
my $trans = $self->{'trans'} || confess 'No translator';
|
||||
print $q->Tr($q->td(
|
||||
{-colspan=>2,-bgcolor=>'#ffcccc'},
|
||||
$trans->( '_CROSSPOSTED' )
|
||||
));
|
||||
}
|
||||
|
||||
print $q->Tr($q->td({-colspan=>2},
|
||||
'<pre width="100">' . CGI::escapeHTML(join ("\n",$article->body())) . '</pre>')),
|
||||
'</table><table class="huhuDecisionButtons"><tr><td>';
|
||||
$self->display_decisionbuttons($decisionref, [ $id ]);
|
||||
print "</td></tr>\n</table>";
|
||||
|
||||
$self->display_navigation_back();
|
||||
print $q->end_html;
|
||||
return;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub display_errormessage($$$)
|
||||
######################################################################
|
||||
{
|
||||
my ($self, $id, $title) = @_;
|
||||
my $dataref = $self->{'db'}->get_errormessage($id);
|
||||
my $input;
|
||||
eval {
|
||||
($input) = @{$dataref->fetchrow_arrayref};
|
||||
}; if ($@) {
|
||||
$self->display_die_msg('_ERROR_GONE');
|
||||
return;
|
||||
}
|
||||
|
||||
$self->display_start(-title => $title);
|
||||
my $q = $self->{'q'};
|
||||
|
||||
print '<div class="huhuErrorMessage"><pre>',
|
||||
CGI::escapeHTML($input),
|
||||
'</pre></div>';
|
||||
$self->display_navigation_back();
|
||||
print $q->end_html;
|
||||
return;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub generate_answer($$$$)
|
||||
######################################################################
|
||||
{
|
||||
my ($self, $id, $behaviour, $title) = @_;
|
||||
my $db = $self->{'db'} || confess 'No "db" in $self';
|
||||
my $trans = $self->{'trans'} || confess 'No translator';
|
||||
my $q = $self->{'q'} || confess 'No q';
|
||||
|
||||
# first of all move the article out of the pending queue
|
||||
$db->set_status_by_moderator('deleted', $id, $self->{'user_name'});
|
||||
|
||||
my $dataref = $db->get_working_by_id($id);
|
||||
my ($input,$addr);
|
||||
eval {
|
||||
($input,$addr) = @{$dataref->fetchrow_arrayref};
|
||||
}; if ($@) {
|
||||
$self->display_die_msg('_ALREADY_HANDLED');
|
||||
return;
|
||||
}
|
||||
my $article = $self->decode_article(News::Article->new(\$input));
|
||||
|
||||
my $attribution = sprintf(
|
||||
$trans->('%s wrote:'),
|
||||
$article->header('From')
|
||||
);
|
||||
|
||||
my $response = News::Article->response(
|
||||
$article,
|
||||
{
|
||||
'From' => $self->{'config'}->{'mailfrom'},
|
||||
},
|
||||
'respstring' => sub { return $attribution; }
|
||||
);
|
||||
|
||||
my $body = join ("\n",$response->body());
|
||||
$self->display_start(-title => $title);
|
||||
|
||||
if ($behaviour eq 'answer')
|
||||
{
|
||||
print
|
||||
$q->start_form,
|
||||
$q->hidden(-name => 'id', -value => $id),
|
||||
$q->table
|
||||
(
|
||||
$q->Tr([
|
||||
$q->td(['From', $self->{'config'}->{'mailfrom'}]),
|
||||
$q->td(['To', CGI::escapeHTML($addr)]),
|
||||
$q->td(['Subject', CGI::escapeHTML($response->header('Subject'))]),
|
||||
$q->td(
|
||||
{ -colspan => 2},
|
||||
$q->textarea({
|
||||
-name =>'antwort',
|
||||
-cols => 80,
|
||||
-rows => 40,
|
||||
-default => $body,
|
||||
-wrap => 'hard'
|
||||
})
|
||||
),
|
||||
$q->td(
|
||||
{ -colspan => 2 },
|
||||
$q->submit(
|
||||
-name => 'action.Send Mail',
|
||||
-value => $trans->('Send Mail')
|
||||
),
|
||||
$q->submit(
|
||||
-name => 'action.Put back in queue',
|
||||
-value => $trans->('Put back in queue')
|
||||
)
|
||||
)
|
||||
])
|
||||
),
|
||||
$q->end_form;
|
||||
}
|
||||
else
|
||||
{
|
||||
print
|
||||
$trans->('_EXPLAIN_REASON'),
|
||||
$q->start_form,
|
||||
$q->hidden({ -name => 'id', -value => $id }),
|
||||
$q->textarea({
|
||||
-name => 'antwort',
|
||||
-cols => 80,
|
||||
-rows => 40,
|
||||
-default => $body,
|
||||
-wrap => 'hard'
|
||||
}),
|
||||
'<br/>',
|
||||
$q->submit(
|
||||
-name => 'action.Delete and save reason',
|
||||
-value => $trans->('Delete and save reason')
|
||||
),
|
||||
$q->submit(
|
||||
-name => 'action.Put back in queue',
|
||||
-value => $trans->('Put back in queue')
|
||||
),
|
||||
$q->end_form;
|
||||
}
|
||||
print $q->end_html;
|
||||
return;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub delete_posting
|
||||
######################################################################
|
||||
{
|
||||
my ($self,$id) = @_;
|
||||
my $antwort = $self->{'q'}->param('antwort');
|
||||
$antwort =~ s/\>/>/sg;
|
||||
$antwort =~ s/\</</sg;
|
||||
$antwort =~ s/\&/&/sg;
|
||||
$self->{'db'}->set_rejected('deleted', $id, $self->{'user_name'}, $antwort);
|
||||
return;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub send_mail($$)
|
||||
######################################################################
|
||||
{
|
||||
my ($self,$id) = @_;
|
||||
my $antwort = $self->{'q'}->param('antwort');
|
||||
$antwort =~ s/\>/>/sg;
|
||||
$antwort =~ s/\</</sg;
|
||||
$antwort =~ s/\&/&/sg;
|
||||
|
||||
my $trans = $self->{'trans'} || confess 'No translator';
|
||||
|
||||
my $dataref = $self->{'db'}->get_working_by_id($id);
|
||||
my ($input,$addr);
|
||||
eval {
|
||||
($input,$addr) = @{$dataref->fetchrow_arrayref};
|
||||
}; if ($@) {
|
||||
$self->display_die_msg('_ALREADY_HANDLED');
|
||||
return 0;
|
||||
}
|
||||
|
||||
my $article = News::Article->new(\$input);
|
||||
my $original_subject = $article->header('Subject');
|
||||
if (!$original_subject)
|
||||
{ $original_subject = $trans->('No subject'); }
|
||||
|
||||
$article = $self->decode_article($article);
|
||||
if ($addr =~ /(,|\n)/s or $addr =~ /invalid>$/) {
|
||||
$self->display_die_msg('_ERROR_INVALID_ADDRESS');
|
||||
return 0;
|
||||
}
|
||||
my $mailer = new Mail::Mailer;
|
||||
|
||||
my $subject_prefix = $trans->('Your post regarding');
|
||||
$original_subject =~ s/(AW|Re):\s*$subject_prefix\s*/Re:/i;
|
||||
|
||||
$mailer->open({
|
||||
'From' => $self->{'config'}->{'mailfrom'},
|
||||
'Subject' => $subject_prefix . ' ' . $original_subject,
|
||||
'To' => $addr,
|
||||
'Content-Type' => "text/plain;\n charset=\"". $self->{'config'}->{'html_content_type'}. '"',
|
||||
'Content-Transfer-Encoding' => '8bit'
|
||||
});
|
||||
print $mailer $antwort;
|
||||
$mailer->close();
|
||||
$self->{'db'}->set_rejected('rejected', $id, $self->{'user_name'}, $antwort);
|
||||
return 1;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub display_decisionbuttons
|
||||
######################################################################
|
||||
{
|
||||
my ($self, $decisionref, $hidden_values, $hidden_names) = @_;
|
||||
|
||||
$hidden_names = [ 'id' ] unless($hidden_names);
|
||||
|
||||
my $q = $self->{'q'} || confess 'No "q" in $self';
|
||||
my $trans = $self->{'trans'} || confess 'No translator';
|
||||
|
||||
print $q->start_form;
|
||||
for(my $i = 0; $i <= $#$hidden_names; $i++)
|
||||
{
|
||||
printf
|
||||
'<input type="hidden" name="%s" value="%s"/>',
|
||||
$hidden_names->[$i], $hidden_values->[$i];
|
||||
}
|
||||
for my $decision (@{$decisionref})
|
||||
{
|
||||
print $q->submit(
|
||||
-name => 'action.' . $decision,
|
||||
-label => CGI::escapeHTML($trans->($decision))
|
||||
);
|
||||
}
|
||||
print $q->end_form;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub nextpage {
|
||||
my ($self, $cmd, $start, $display_per_page) = @_;
|
||||
|
||||
my $q = $self->{'q'} || confess 'No "q" in $self';
|
||||
$cmd || confess 'No $cmd';
|
||||
my $trans = $self->{'trans'} || confess 'No translator';
|
||||
|
||||
if (!defined($display_per_page) || $display_per_page !~ /^\d+$/)
|
||||
{
|
||||
$display_per_page = $self->{'config'}->{'display_per_page'};
|
||||
}
|
||||
$start = 0 if ($start !~ /^\d+$/);
|
||||
|
||||
my $before = $start - $display_per_page;
|
||||
my $next = $start + $display_per_page;
|
||||
$before = 0 if ($before < 0);
|
||||
my $self_url = $self->{'self_url'} || confess;
|
||||
|
||||
print '<div class="huhuNavigation"><span>',
|
||||
$q->a(
|
||||
{ href => $self_url . '?'. $cmd . ',' . $before },
|
||||
$trans->('Previous page')
|
||||
),
|
||||
'</span><span>',
|
||||
$q->a(
|
||||
{ href => $self_url . '?'. $cmd . ',' . $next },
|
||||
$trans->('Next page')
|
||||
),
|
||||
'</span></div>';
|
||||
return;
|
||||
}
|
||||
|
||||
######################################################################
|
||||
sub print_menu_items($$$)
|
||||
######################################################################
|
||||
{
|
||||
my $self = shift || confess;
|
||||
my $r_items = shift || MENU_MAIN;
|
||||
my $level = shift || 0;
|
||||
|
||||
my $self_url = $self->{'self_url'} || confess;
|
||||
my $trans = $self->{'trans'} || confess 'No translator';
|
||||
|
||||
printf '<ul class="huhuMainMenu%d">', $level;
|
||||
for my $r_definition(@$r_items)
|
||||
{
|
||||
my $submenu = $r_definition->[2];
|
||||
printf
|
||||
'<li><span><a href="%s">%s</a></span>',
|
||||
$self_url . '?' . $r_definition->[0],
|
||||
$trans->( $r_definition->[1] );
|
||||
if ($submenu)
|
||||
{
|
||||
$self->print_menu_items($submenu, $level + 1);
|
||||
}
|
||||
print '</li>';
|
||||
}
|
||||
print '</ul>';
|
||||
}
|
||||
|
||||
sub set_status_by_moderator {
|
||||
my ($self, $newstatus, $id) = @_;
|
||||
$self->{'db'}->set_status_by_moderator($newstatus, $id, $self->{'user_name'});
|
||||
return;
|
||||
}
|
||||
|
||||
sub post {
|
||||
my ($self,$id) = @_;
|
||||
$self->{'db'}->set_status_posted($id, $self->{'user_name'});
|
||||
return;
|
||||
}
|
||||
|
||||
sub decode_article {
|
||||
my ($self, $article) = @_;
|
||||
|
||||
$self || confess 'No $self';
|
||||
$article || confess 'No $article';
|
||||
|
||||
for my $headerline (qw(Subject From Reply-To)) {
|
||||
$article->set_headers($headerline,$self->decode_line($article->header($headerline)));
|
||||
}
|
||||
|
||||
my $body = join "\n",$article->body();
|
||||
|
||||
if (defined($article->header('Content-Transfer-Encoding')) and
|
||||
$article->header('Content-Transfer-Encoding') eq 'quoted-printable') {
|
||||
$body = MIME::QuotedPrint::decode($body);
|
||||
}
|
||||
my $encoding;
|
||||
if (defined($article->header('Content-Type')) and
|
||||
$article->header('Content-Type') =~ m|^text/plain;.+charset=[\s"]*([\w-]+)[\s"]?|si) {
|
||||
$encoding = $1;
|
||||
} else {
|
||||
$encoding = 'iso-8859-1';
|
||||
}
|
||||
eval {
|
||||
if (Encode::find_encoding($encoding)->perlio_ok) {
|
||||
Encode::from_to($body,$encoding,$self->{'config'}->{'html_content_type'});
|
||||
}
|
||||
};
|
||||
$article->set_body(($body));
|
||||
return $article;
|
||||
}
|
||||
|
||||
sub decode_line {
|
||||
my ($self,$line) = @_;
|
||||
if (!$self->{'privileged'}) {
|
||||
$line =~ s/\@/#/g;
|
||||
}
|
||||
my $newline;
|
||||
while ($line =~ s/^(.*?)=\?([^?]+)\?(.)\?([^?]*)\?=(?:\r?\n +)?//s) {
|
||||
my ($before,$charset,$encoding,$content) = ($1,$2,lc($3),$4);
|
||||
$newline .= $before;
|
||||
if ($encoding eq 'q') {
|
||||
$content =~ s/_/ /g;
|
||||
$content = MIME::QuotedPrint::decode($content);
|
||||
chomp $content;
|
||||
} elsif ($encoding eq 'b') {
|
||||
$content = MIME::Base64::decode($content);
|
||||
}
|
||||
eval {
|
||||
if (Encode::find_encoding($charset)->perlio_ok) {
|
||||
Encode::from_to($content,$charset,$self->{'config'}->{'html_content_type'});
|
||||
}
|
||||
};
|
||||
$newline .= $content;
|
||||
}
|
||||
$newline .= $line;
|
||||
return $newline;
|
||||
}
|
||||
|
||||
sub set_flag {
|
||||
my ($self,$id) = @_;
|
||||
$self->{'db'}->invert_flag($id);
|
||||
return;
|
||||
}
|
||||
|
||||
use constant SHOW_CONFIG => (
|
||||
'approve_string',
|
||||
'check_duplicates_age',
|
||||
'display_per_page',
|
||||
'followup_to',
|
||||
'html_content_type',
|
||||
'http_authentication_method',
|
||||
'http_negotiate_language',
|
||||
'mailfrom',
|
||||
'moderated_group',
|
||||
'mysql_host',
|
||||
'mysql_port',
|
||||
'mysql_username',
|
||||
);
|
||||
|
||||
######################################################################
|
||||
sub display_config($)
|
||||
######################################################################
|
||||
{
|
||||
my $self = shift || confess;
|
||||
|
||||
my $q = $self->{'q'} || confess 'No "q" in $self';
|
||||
my $trans = $self->{'trans'} || confess 'No "trans" in $self';
|
||||
my $config = $self->{'config'} || confess 'No "config" in $self';
|
||||
|
||||
$self->display_start(
|
||||
-title => $trans->('Configuration'),
|
||||
# -subtitle => $args{'-subtitle'},
|
||||
-mark => 0,
|
||||
# -refresh => '300; ' . $q->url() . '?' . $cmd
|
||||
);
|
||||
|
||||
print '<table class="huhuPostList">';
|
||||
print $q->Tr($q->th({-align=>'left'}, [ 'Key', 'Value' ]));
|
||||
|
||||
my @key = SHOW_CONFIG;
|
||||
for my $key(@key)
|
||||
{
|
||||
printf "<tr><td>%s</td><td>%s</td></tr>", $key, $config->{$key};
|
||||
}
|
||||
print "</table>";
|
||||
|
||||
$self->display_end();
|
||||
}
|
||||
|
||||
######################################################################
|
||||
1;
|
||||
######################################################################
|
||||
Loading…
Add table
Add a link
Reference in a new issue