811 lines
21 KiB
Perl
811 lines
21 KiB
Perl
######################################################################
|
|
#
|
|
# $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;
|
|
######################################################################
|