[Cpan-forum-commit] rev 358 - in trunk/lib/CPAN: . Forum Forum/RM
svn at pti.co.il
svn at pti.co.il
Sun May 11 23:27:00 EEST 2008
Author: semuelf
Date: 2008-05-11 23:27:00 +0300 (Sun, 11 May 2008)
New Revision: 358
Modified:
trunk/lib/CPAN/Forum.pm
trunk/lib/CPAN/Forum/Handler.pm
trunk/lib/CPAN/Forum/RM/Admin.pm
trunk/lib/CPAN/Forum/RM/Author.pm
trunk/lib/CPAN/Forum/RM/Dist.pm
trunk/lib/CPAN/Forum/RM/Login.pm
trunk/lib/CPAN/Forum/RM/Notify.pm
trunk/lib/CPAN/Forum/RM/Subscriptions.pm
trunk/lib/CPAN/Forum/RM/Tags.pm
trunk/lib/CPAN/Forum/RM/Users.pm
Log:
progress for mod-perl
Modified: trunk/lib/CPAN/Forum/Handler.pm
===================================================================
--- trunk/lib/CPAN/Forum/Handler.pm 2008-04-06 19:42:04 UTC (rev 357)
+++ trunk/lib/CPAN/Forum/Handler.pm 2008-05-11 20:27:00 UTC (rev 358)
@@ -22,7 +22,7 @@
PARAMS => {
ROOT => $ENV{CPANFORUM_ROOT},
DB_CONNECT => "dbi:SQLite:$ENV{CPANFORUM_ROOT}/db/forum.db",
- REQUEST => ($ENV{SCRIPT_NAME} || '') . ($ENV{PATH_INFO} || ''),
+ #REQUEST => ($ENV{SCRIPT_NAME} || '') . ($ENV{PATH_INFO} || ''),
},
);
$app->run();
Modified: trunk/lib/CPAN/Forum/RM/Admin.pm
===================================================================
--- trunk/lib/CPAN/Forum/RM/Admin.pm 2008-04-06 19:42:04 UTC (rev 357)
+++ trunk/lib/CPAN/Forum/RM/Admin.pm 2008-05-11 20:27:00 UTC (rev 358)
@@ -33,7 +33,7 @@
}
my $q = $self->query;
if (not $username) {
- $username = ${$self->param("path_parameters")}[0] || '';
+ $username = ${$self->query->param("path_parameters")}[0] || '';
}
$self->log->debug("admin_edit_user username: '$username'");
Modified: trunk/lib/CPAN/Forum/RM/Author.pm
===================================================================
--- trunk/lib/CPAN/Forum/RM/Author.pm 2008-04-06 19:42:04 UTC (rev 357)
+++ trunk/lib/CPAN/Forum/RM/Author.pm 2008-05-11 20:27:00 UTC (rev 358)
@@ -14,7 +14,7 @@
my ($self) = @_;
my $q = $self->query;
- my $pauseid = ${$self->param("path_parameters")}[0] || '';
+ my $pauseid = ${$self->query->param("path_parameters")}[0] || '';
$self->log->debug("show posts to modules of PAUSEID: '$pauseid'");
my $t = $self->load_tmpl("authors.tmpl",
Modified: trunk/lib/CPAN/Forum/RM/Dist.pm
===================================================================
--- trunk/lib/CPAN/Forum/RM/Dist.pm 2008-04-06 19:42:04 UTC (rev 357)
+++ trunk/lib/CPAN/Forum/RM/Dist.pm 2008-05-11 20:27:00 UTC (rev 358)
@@ -15,7 +15,7 @@
my ($self) = @_;
my $q = $self->query;
- my $group_name = ${$self->param("path_parameters")}[0] || '';
+ my $group_name = ${$self->query->param("path_parameters")}[0] || '';
if ($group_name =~ /^([\w-]+)$/) {
$group_name = $1;
} else {
Modified: trunk/lib/CPAN/Forum/RM/Login.pm
===================================================================
--- trunk/lib/CPAN/Forum/RM/Login.pm 2008-04-06 19:42:04 UTC (rev 357)
+++ trunk/lib/CPAN/Forum/RM/Login.pm 2008-05-11 20:27:00 UTC (rev 358)
@@ -69,7 +69,7 @@
eval {
if ($request eq 'new_post') {
my $request_group = $session->param("request_group") || '';
- $self->param("path_parameters" => [$request_group]);
+ $self->query->param("path_parameters" => [$request_group]);
}
$response = $self->$request();
};
Modified: trunk/lib/CPAN/Forum/RM/Notify.pm
===================================================================
--- trunk/lib/CPAN/Forum/RM/Notify.pm 2008-04-06 19:42:04 UTC (rev 357)
+++ trunk/lib/CPAN/Forum/RM/Notify.pm 2008-05-11 20:27:00 UTC (rev 358)
@@ -115,7 +115,7 @@
my $url = "http://$ENV{HTTP_HOST}";
my $call = "_generate_$type";
- my @params = @{$self->param("path_parameters")};
+ my @params = @{$self->query->param("path_parameters")};
my $content;
if ($params[0] eq 'tags') {
$content = 'tags';
@@ -208,7 +208,7 @@
sub get_feed {
my ($self, $limit) = @_;
- my @params = @{$self->param("path_parameters")};
+ my @params = @{$self->query->param("path_parameters")};
return [] if not @params;
Modified: trunk/lib/CPAN/Forum/RM/Subscriptions.pm
===================================================================
--- trunk/lib/CPAN/Forum/RM/Subscriptions.pm 2008-04-06 19:42:04 UTC (rev 357)
+++ trunk/lib/CPAN/Forum/RM/Subscriptions.pm 2008-05-11 20:27:00 UTC (rev 358)
@@ -42,7 +42,7 @@
);
}
- my @params = @{$self->param("path_parameters")};
+ my @params = @{$self->query->param("path_parameters")};
my ($gids, $subscriptions);
if (@params == 2 and $params[0] eq "dist") {
my $group_name = $params[1];
Modified: trunk/lib/CPAN/Forum/RM/Tags.pm
===================================================================
--- trunk/lib/CPAN/Forum/RM/Tags.pm 2008-04-06 19:42:04 UTC (rev 357)
+++ trunk/lib/CPAN/Forum/RM/Tags.pm 2008-05-11 20:27:00 UTC (rev 358)
@@ -5,12 +5,12 @@
sub tags {
my ($self) = @_;
- my $path = ${$self->param("path_parameters")}[0] || '';
- my $value = ${$self->param("path_parameters")}[1] || '';
+ my $path = ${$self->query->param("path_parameters")}[0] || '';
+ my $value = ${$self->query->param("path_parameters")}[1] || '';
# support tag tcp/ip but not a/b/c
- if (${$self->param("path_parameters")}[2]) {
- $value .= "/" . ${$self->param("path_parameters")}[2];
+ if (${$self->query->param("path_parameters")}[2]) {
+ $value .= "/" . ${$self->query->param("path_parameters")}[2];
}
$self->log->debug("tags path='$path' value='$value'");
Modified: trunk/lib/CPAN/Forum/RM/Users.pm
===================================================================
--- trunk/lib/CPAN/Forum/RM/Users.pm 2008-04-06 19:42:04 UTC (rev 357)
+++ trunk/lib/CPAN/Forum/RM/Users.pm 2008-05-11 20:27:00 UTC (rev 358)
@@ -14,7 +14,7 @@
my $q = $self->query;
my $username="";
- $username = ${$self->param("path_parameters")}[0];
+ $username = ${$self->query->param("path_parameters")}[0];
if (not $username) {
return $self->internal_error("No username");
Modified: trunk/lib/CPAN/Forum.pm
===================================================================
--- trunk/lib/CPAN/Forum.pm 2008-04-06 19:42:04 UTC (rev 357)
+++ trunk/lib/CPAN/Forum.pm 2008-05-11 20:27:00 UTC (rev 358)
@@ -28,15 +28,6 @@
"ERR open_code_without_closing" => "open <code> tag without closing tag",
);
-our $logger;
-$SIG{__WARN__} = sub {
- if ($logger) {
- $logger->warning($_[0]);
- } else {
- print STDERR $_[0];
- }
-};
-
=head1 NAME
CPAN::Forum - Web forum application to discuss CPAN modules
@@ -447,10 +438,7 @@
);
$self->log->debug("--- START ---");
- $CPAN::Forum::logger = $self->log;
-
- $self->log->debug("Cookie received: " . ($self->query->cookie($cookiename) || "") );
CGI::Session->name($cookiename);
$self->session_config(
#CGI_SESSION_OPTIONS => [ "driver:File", $self->query, {Directory => "/tmp"}],
@@ -462,24 +450,38 @@
SEND_COOKIE => 0,
);
- $self->log->debug("sid: " . ($self->session->id() || ""));
- $self->header_props(
- -charset => "utf-8",
- );
}
+# overriding the run method, to momentarily install warnings handler
+# can we use other way then a global $logger? -shmuel
+our $logger;
+sub run {
+ my ($self) = @_;
+ local $logger = sub { $self->log->warning($_[0]) };
+ local $SIG{__WARN__} = $logger;
+ $self->SUPER::run();
+ #$SIG{__WARN__} = sub {
+ # if ($logger) {
+ # $logger->warning($_[0]);
+ # } else {
+ # print STDERR $_[0];
+ # }
+ #};
+}
+
sub _logger {
my ($self, %h) = @_;
my ($package, $filename, $line, $sub) = caller(6);
my $root = $self->param("ROOT");
+ my $q = $self->query;
$filename =~ s/^$root//;
return sprintf "[%s] - %s - [%s] [%s] [%s] [%s(%s)] %s\n",
POSIX::strftime("%Y-%m-%d %H:%M:%S", localtime),
$h{level},
($ENV{REMOTE_ADDR} || ''),
($ENV{HTTP_REFERER} || ''),
- ($self->param('REQUEST')),
+ $q->script_name . $q->path_info, #($self->param('REQUEST')),
$filename, $line,
$h{message};
# keys of the hash: level, message, name
@@ -587,6 +589,7 @@
$self->start_mode("home");
$self->run_modes([@free_modes, @restricted_modes]);
$self->run_modes(AUTOLOAD => "autoload");
+ $self->error_mode('error');
}
=head2 cgiapp_prerun
@@ -599,7 +602,9 @@
sub cgiapp_prerun {
my $self = shift;
- $self->error_mode('error');
+ $self->header_props(
+ -charset => "utf-8",
+ );
my $status = $self->status();
$self->log->debug("Status: $status");
@@ -614,6 +619,7 @@
$self->log->debug("Current runmode: $rm");
$self->log->debug("Current user: " . ($self->session->param("username") || ""));
$self->log->debug("Current sid: " . ($self->session->id() || ""));
+ $self->log->debug("Cookie received: " . ($self->query->cookie($cookiename) || "") );
if (any {$rm eq $_} @free_modes) {
$self->log->debug('Free mode');
@@ -625,7 +631,7 @@
$self->log->debug("Showing login");
$self->session->param(request => $rm);
if ($rm eq 'new_post') {
- my $group = ${$self->param("path_parameters")}[0];
+ my $group = ${$self->query->param("path_parameters")}[0];
$self->session->param(request_group => $group);
}
$self->prerun_mode('login');
@@ -637,7 +643,7 @@
sub _set_run_mode {
my ($self) = @_;
- $self->param(path_parameters => []);
+ $self->query->param(path_parameters => []);
my $rm = $self->get_current_runmode();
return $rm if $rm and $rm ne 'home'; # alredy has run-mode
@@ -646,7 +652,7 @@
my $q = $self->query;
# override rm based on REQUEST
- my $request = $self->param('REQUEST');
+ my $request = $q->script_name . $q->path_info; # $self->param('REQUEST');
if ($request =~ m{^/
([^/]+) # first word till after the first /
(?:/(.*))? # the rest, after the (optional) second /
@@ -655,7 +661,7 @@
my $params = $2 || "";
if (any {$newrm eq $_} @urls) {
my @params = split /\//, $params;
- $self->param(path_parameters => @params ? \@params : []);
+ $self->query->param(path_parameters => @params ? \@params : []);
$rm = $newrm;
} elsif ($request eq "/cgi/index.pl") {
# this should be ok here
@@ -1030,7 +1036,7 @@
my $new_group_id = "";
if ($rm eq "new_post") {
- $new_group = ${$self->param("path_parameters")}[0] || "";
+ $new_group = ${$self->query->param("path_parameters")}[0] || "";
$new_group_id = $q->param('new_group') if $q->param('new_group');
$self->log->debug("A: new_group: '$new_group' and id: '$new_group_id'");
@@ -1100,7 +1106,7 @@
my $id = $q->param("id"); # there was an id
if ($rm eq "response_form" or $rm eq "posts") {
- $id = ${$self->param("path_parameters")}[0] if ${$self->param("path_parameters")}[0];
+ $id = ${$self->query->param("path_parameters")}[0] if ${$self->query->param("path_parameters")}[0];
}
$id ||= $q->param("new_parent");
if ($id) { # Show post
@@ -1343,7 +1349,7 @@
);
my $id = $q->param("id");
- $id = ${$self->param("path_parameters")}[0] if ${$self->param("path_parameters")}[0];
+ $id = ${$self->query->param("path_parameters")}[0] if ${$self->query->param("path_parameters")}[0];
my $posts = CPAN::Forum::DB::Posts->posts_in_thread($id); # SQL
if (not @$posts) {
@@ -1535,9 +1541,10 @@
$_[0]->load_tmpl("site_is_closed.tmpl")->output;
}
-sub teardown {
- my ($self) = @_;
- $self->log->debug("teardown called");
+sub cgiapp_postrun {
+ my $self = shift;
+ my $output_ref = shift;
+
my $rm = $self->get_current_runmode();
if (not $self->session->param('loggedin') and $rm ne "login") {
$self->log->debug("not logged in, deleting session");
@@ -1555,6 +1562,11 @@
}
}
+sub teardown {
+ my ($self) = @_;
+ $self->log->debug("teardown called");
+}
+
sub _my_sendmail {
my ($self, %args) = @_;
#$self->log->debug(Data::Dumper->Dump([\%args], ['_my_sendmail']));
@@ -1621,8 +1633,8 @@
sub m {
my ($self) = @_;
- my $path = ${$self->param("path_parameters")}[0] || '';
- my $value = ${$self->param("path_parameters")}[1] || '';
+ my $path = ${$self->query->param("path_parameters")}[0] || '';
+ my $value = ${$self->query->param("path_parameters")}[1] || '';
my $tags = '';
More information about the Cpan-forum-commit
mailing list