[Cpan-forum-commit] rev 187 - in trunk: . lib/CPAN t/mech templates
svn at pti.co.il
svn at pti.co.il
Tue Aug 29 15:15:23 IDT 2006
Author: gabor
Date: 2006-08-29 15:15:18 +0300 (Tue, 29 Aug 2006)
New Revision: 187
Modified:
trunk/
trunk/Build.PL
trunk/TODO
trunk/lib/CPAN/Forum.pm
trunk/t/mech/100-auth.t
trunk/templates/internal_error.tmpl
trunk/templates/notes.tmpl
Log:
Add more test to mypan and its processing
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 8c4c90e1-83eb-0310-96eb-e7cb62807872:/local/cpan-forum:11038
+ 8c4c90e1-83eb-0310-96eb-e7cb62807872:/local/cpan-forum:11039
Modified: trunk/Build.PL
===================================================================
--- trunk/Build.PL 2006-08-29 12:15:09 UTC (rev 186)
+++ trunk/Build.PL 2006-08-29 12:15:18 UTC (rev 187)
@@ -26,7 +26,6 @@
# 'HTML::Lint' => 1.26,
# 'Test::HTML::Lint' => 1.26,
'WWW::Mechanize' => 0,
-# 'Storable' => 0,
'DBI' => 0,
'DBD::SQLite' => 0.31,
'Class::DBI' => 0, # It was complaining: ERROR: Version v3.0.14 of Class::DBI is installed, but we need version >= 0.96
@@ -45,6 +44,7 @@
'CPAN::DistnameInfo' => 0,
},
build_requires => {
+ 'Storable' => 0,
'Test::More' => 0.47,
'Test::WWW::Mechanize::CGI' => 0,
},
Modified: trunk/TODO
===================================================================
--- trunk/TODO 2006-08-29 12:15:09 UTC (rev 186)
+++ trunk/TODO 2006-08-29 12:15:18 UTC (rev 187)
@@ -5,6 +5,9 @@
notified. Test both the interface to manage this and the the actually
retreival of addresses to be notified.
+ We might want to add another way of subscripton: to subscribe to a specific
+ thread even if the user has not posted.
+
One-time notification of module author when the first post arrives to one of
her modules.
Modified: trunk/lib/CPAN/Forum.pm
===================================================================
--- trunk/lib/CPAN/Forum.pm 2006-08-29 12:15:09 UTC (rev 186)
+++ trunk/lib/CPAN/Forum.pm 2006-08-29 12:15:18 UTC (rev 187)
@@ -8,9 +8,9 @@
use CGI::Application::Plugin::Session;
use CGI::Application::Plugin::LogDispatch;
use Data::Dumper qw(Dumper);
-use Fcntl qw(:flock);
+#use Fcntl qw(:flock);
use POSIX qw(strftime);
-use Carp qw(cluck carp);
+#use Carp qw(cluck carp);
use Mail::Sendmail qw(sendmail);
use CGI ();
use List::MoreUtils qw(any);
@@ -744,6 +744,8 @@
Maybe this one should also receive the error message and print it to the log file.
+See C<notes()> for simple notes.
+
=cut
sub internal_error {
@@ -757,6 +759,19 @@
$t->output;
}
+=head2 notes
+
+Print short notification messages to the user.
+
+=cut
+sub notes {
+ my ($self, $msg) = @_;
+ my $t = $self->load_tmpl("notes.tmpl");
+ $t->param($msg => 1);
+ $t->output;
+}
+
+
=head2 load_tmpl
Semi standard CGI::Application method to replace the way we load the templates.
@@ -1251,7 +1266,7 @@
if (not @$errors or $$errors[0] eq "preview") {
my %preview;
$preview{subject} = _subject_escape($q->param("new_subject")) || "";
- $preview{text} = _text_escape($q->param("new_text")) || "";
+ $preview{text} = $self->_text_escape($q->param("new_text")) || "";
$preview{parentid} = $q->param("new_parent") || "";
# $preview{thread_id} = $q->param("new_text") || "";
$preview{postername} = $self->session->param("username");
@@ -1372,7 +1387,6 @@
};
if ($@) {
#push @errors, "subject_too_long" if $@ =~ /subject_too_long/;
- #warn $CPAN::Forum::Post::lasterror if $@ =~ /text_format/;
if (not @errors) {
return $self->internal_error(
"PATH_INFO: '$ENV{PATH_INFO}'\nUNKNOWN_ERROR: $@",
@@ -1400,7 +1414,7 @@
date => _post_date($post->date),
parentid => $post->parent,
responses => \@responses,
- text => _text_escape($post->text),
+ text => $self->_text_escape($post->text),
);
$post{id} = $post->id;
@@ -1414,16 +1428,16 @@
return CGI::escapeHTML($subject);
}
-# this is not correct, the Internal error should be raised all the way up, not as the
+# TODO: this is not correct, the Internal error should be raised all the way up, not as the
# text field...
sub _text_escape {
- my ($text) = @_;
+ my ($self, $text) = @_;
return "" if not $text;
my $markup = CPAN::Forum::Markup->new();
my $html = $markup->posting_process($text);
if (not defined $html) {
- warn "Error displaying already accepted text: '$text'";
+ $self->log->warning("Error displaying already accepted text: '$text'");
return "Internal Error";
}
return $html;
@@ -1502,7 +1516,6 @@
$t->param(rating => $rating);
$t->param(roundrating => $roundrating);
$t->param(review_count => $review_count);
- #warn "$rating $roundrating $review_count\n";
}
}
@@ -1688,8 +1701,27 @@
=head2 mypan
-Planned to be the manager for the notify subscription, currently not in use.
+Manage the notify subscription.
+Creates checkboxes, the names of the checkboxes start with
+the subscription mode:
+
+ allposts_ - every post
+ starters_ - every time a new thread is started
+ followups_ - every time there is a post where the user has already posted
+
+The names are the followed wit one of the following:
+
+ _all - all the modules
+ _NNN - Where NNN is the id number of an author
+ NNN - where NNN is the id number of a group (distribution)
+
+The gids field contains the comma separated list of all the postfixes.
+
+(Yes the difference between the two types of id is the extra _ only.)
+
+C<update_subscription> will process the submitted form.
+
=cut
sub mypan {
@@ -1710,13 +1742,9 @@
$fullname .= $user->fname if $user->fname;
$fullname .= " " if $fullname;
$fullname .= $user->lname if $user->lname;
- #$fullname = $username if not $fullname;
-
$t->param(fullname => $fullname);
-# $t->param(all_post => $user->all_post);
-# $t->param(all_start => $user->all_start);
- $t->param(title => "Information about $username");
+ $t->param(title => "Information about $username");
my @params = @{$self->param("path_parameters")};
my @subscriptions;
@@ -1765,7 +1793,6 @@
my $it = CPAN::Forum::Subscriptions_pauseid->search(uid => $user->id);
while (my $s = $it->next) {
- #warn $s->allposts;
$gids .= ($gids ? ",_" : "_") . $s->pauseid->id;
push @subscriptions, {
gid => "_" . $s->pauseid->id,
@@ -1778,7 +1805,6 @@
$it = CPAN::Forum::Subscriptions->search(uid => $user->id);
while (my $s = $it->next) {
- #warn $s->allposts;
$gids .= ($gids ? "," : "") . $s->gid->id;
push @subscriptions, {
gid => $s->gid,
@@ -1789,7 +1815,6 @@
};
}
}
- #warn Dumper \@subscriptions;
$t->param(subscriptions => \@subscriptions);
$t->param(gids => $gids);
@@ -1797,11 +1822,15 @@
$t->output;
}
+=head2 update_subscription
+
+Process the submitted form created by C<mypan()>
+
+=cut
sub update_subscription {
my $self = shift;
my $q = $self->query;
- #warn $q->param("gids");
my @gids = split /,/, $q->param("gids");
if (not @gids) {
return $self->internal_error();
@@ -1810,8 +1839,6 @@
my $username = $self->session->param("username");
my ($user) = CPAN::Forum::Users->search(username => $username);
-
- #warn Dumper $q->Vars;
foreach my $gid (@gids) {
if ($gid eq "_all") {
my ($s) = CPAN::Forum::Subscriptions_all->search(uid => $user->id);
@@ -1831,7 +1858,7 @@
});
}
$self->_update_subs($s, $gid);
- } else {
+ } elsif ($gid =~ /^(\d+)$/) {
my ($s) = CPAN::Forum::Subscriptions->search(gid => $gid, uid => $user->id);
if (not $s) {
$s = CPAN::Forum::Subscriptions->create({
@@ -1840,49 +1867,71 @@
});
}
$self->_update_subs($s, $gid);
+ } else {
+ $self->log->error("Invalid gid: '$gid' provided in the gids entry of mypan");
+ # shall we show an error page here?
}
}
+ # if there is not name, no need for further processing
+ if (not $q->param("name")) {
+ return $self->notes("mypanok");
+ }
+
# TODO: error messages in case not all the values were filled in correctly
- if ($q->param("name") and $q->param("type")) {
- if ($q->param("type") eq "pauseid") {
- my $pauseid = uc $q->param("name");
- my ($pid) = CPAN::Forum::Authors->search(pauseid => $pauseid);
- if ($pid) {
- my $s = CPAN::Forum::Subscriptions_pauseid->find_or_create({
- uid => $user->id,
- pauseid => $pid->id,
- });
- $self->_update_subs($s, "_new");
- } else {
- return $self->notes("no_such_pauseid");
- }
+ # process new entry
+ if (not $q->param("type")) {
+ return $self->note("no_subs_type");
+ }
+
+ # TODO: if there is a subscription to the given distro or PAUSEID
+ # we should not let the user overwrite it using the new entry box
+ if ($q->param("type") eq "pauseid") {
+ my $pauseid = uc $q->param("name");
+ my ($author) = CPAN::Forum::Authors->search(pauseid => $pauseid);
+ if ($author) {
+ my $s = CPAN::Forum::Subscriptions_pauseid->find_or_create({
+ uid => $user->id,
+ pauseid => $author->id,
+ });
+ $self->_update_subs($s, "_new");
+ } else {
+ return $self->notes("no_such_pauseid");
}
- if ($q->param("type") eq "distro") {
- my $name = $q->param("name");
- $name =~ s/::/-/g;
- my ($grp) = CPAN::Forum::Groups->search(name => $name);
- if ($grp) {
- my $s = CPAN::Forum::Subscriptions->find_or_create({
- uid => $user->id,
- gid => $grp->id,
- });
- $self->_update_subs($s, "_new");
- } else {
- return $self->notes("no_such_group");
- }
+ }
+ elsif ($q->param("type") eq "distro") {
+ my $name = $q->param("name");
+ $name =~ s/::/-/g;
+ my ($grp) = CPAN::Forum::Groups->search(name => $name);
+ if ($grp) {
+ my $s = CPAN::Forum::Subscriptions->find_or_create({
+ uid => $user->id,
+ gid => $grp->id,
+ });
+ $self->_update_subs($s, "_new");
+ } else {
+ return $self->notes("no_such_group");
}
}
+ else {
+ return $self->internal_error("", "invalid_subs_type");
+ }
- $self->notes("mypanok");
+ return $self->notes("mypanok");
}
+=head2 _update_subs
+Given a subscription obkect (1 out of 3 possible classes)
+and a gid (_all, _NNN or NNN) fetches the relevan checkboxes
+(See C<mypan()> for details) and update the subscription object.
+
+=cut
sub _update_subs {
my ($self, $s, $gid) = @_;
my $q = $self->query;
- my $on=0;
+ my $on = 0;
foreach my $type (qw(allposts starters followups)) {
if (defined $q->param($type ."_$gid") and $q->param($type . "_$gid") eq "on") {
$s->set($type, 1);
@@ -1891,19 +1940,16 @@
$s->set($type, 0);
}
}
- $s->update;
- $s->delete if not $on; # remove the whole line if there are no subscriptions at all.
+ if ($on) {
+ return $s->update;
+ }
+ else {
+ return $s->delete; # remove the whole line if there are no subscriptions at all.
+ }
}
-sub notes {
- my ($self, $msg) = @_;
- my $t = $self->load_tmpl("notes.tmpl");
- $t->param($msg => 1);
- $t->output;
-}
-
sub module_search {
my ($self) = @_;
@@ -2267,13 +2313,11 @@
my $email = $s->uid->email;
$self->log->debug("Sending to $email ?");
$mail->{To} = $email;
- #warn "Sending ? to $email\n";
$self->log->debug("Processing uid: " . $s->uid->username) if $ids;
next if $ids and not $ids->{$s->uid->username};
$self->log->debug("Sending to $email id was found");
next if $_[2]->{$email}++;
$self->log->debug("Sending to $email first time sending");
- #warn "Yes, Sending to $email\n";
$self->_my_sendmail(%$mail);
$self->log->debug("Sent to $email");
}
@@ -2292,7 +2336,7 @@
open my $fh, ">", $STATUS_FILE;
if (not $fh) {
- warn "Could not open status file '$STATUS_FILE' $!\n";
+ $self->log->warning("Could not open status file '$STATUS_FILE' $!");
return;
}
print $fh $value;
Modified: trunk/t/mech/100-auth.t
===================================================================
--- trunk/t/mech/100-auth.t 2006-08-29 12:15:09 UTC (rev 186)
+++ trunk/t/mech/100-auth.t 2006-08-29 12:15:18 UTC (rev 187)
@@ -3,6 +3,8 @@
use strict;
use warnings;
+use Storable qw(dclone);
+
use Test::More;
my $tests;
plan tests => $tests;
@@ -172,6 +174,7 @@
BEGIN { $tests += 4 + @input_fields*2 }
}
+# set the flags of all modules
foreach my $i (0..2) {
my $input = $w_user->current_form->find_input( $input_fields[$i][0] );
$input->check;
@@ -187,10 +190,87 @@
BEGIN { $tests += 3*(4 + @input_fields*2) }
}
+# reset the flags of all modules
+foreach my $i (0..2) {
+ my $input = $w_user->current_form->find_input( $input_fields[$i][0] );
+ $input->value(undef);
+ $w_user->submit_form();
+ $w_user->content_like(qr{Your subscriptions were successfully updated.});
+ $w_user->content_like(qr{You can look at them here:});
+ $w_user->follow_link_ok({ text => 'subscription information' });
+ my ($form) = $w_user->forms;
+ $input_fields[$i][3] = undef;
+ check_form($form, \@input_fields);
+ # TODO: check it in the database as well....
+ BEGIN { $tests += 3*(4 + @input_fields*2) }
+}
+my $input_ref;
+{
+ $w_user->current_form->find_input('name')->value( 'Acme-Bleach' );
+ $w_user->current_form->find_input('type')->value( 'Distribution' );
+ $w_user->current_form->find_input('allposts__new')->check;
+ $w_user->submit_form();
+ $w_user->content_like(qr{Your subscriptions were successfully updated.});
+ $w_user->content_like(qr{You can look at them here:});
+ $w_user->follow_link_ok({ text => 'subscription information' });
+ my ($form) = $w_user->forms;
+ $input_ref = dclone(\@input_fields);
+ # 3 is the id number of Acme-Bleach
+ push @$input_ref,
+ ['allposts_3', 'checkbox', 'HTML::Form::ListInput', 'on'],
+ ['starters_3', 'checkbox', 'HTML::Form::ListInput', undef],
+ ['followups_3', 'checkbox', 'HTML::Form::ListInput', undef];
+ $input_ref->[8][3] = '_all,3';
+ check_form($form, $input_ref);
+ # TODO: check it in the database as well....
+
+ BEGIN { $tests += (4 + (@input_fields+3)*2) }
+}
+
+my $input_ref2;
+{
+ $w_user->current_form->find_input('name')->value( 'MARKSTOS' );
+ $w_user->current_form->find_input('type')->value( 'PAUSEID' );
+ $w_user->current_form->find_input('starters__new')->check;
+ $w_user->submit_form();
+ $w_user->content_like(qr{Your subscriptions were successfully updated.});
+ $w_user->content_like(qr{You can look at them here:});
+ $w_user->follow_link_ok({ text => 'subscription information' });
+ my ($form) = $w_user->forms;
+ my $input_ref2 = dclone($input_ref);
+ # 2 is the id number of MARKSTOS
+ push @$input_ref2,
+ ['allposts__2', 'checkbox', 'HTML::Form::ListInput', undef],
+ ['starters__2', 'checkbox', 'HTML::Form::ListInput', 'on'],
+ ['followups__2', 'checkbox', 'HTML::Form::ListInput', undef];
+ $input_ref2->[8][3] = '_all,_2,3';
+ check_form($form, $input_ref2);
+ # TODO: check it in the database as well....
+
+ BEGIN { $tests += (4 + (@input_fields+3)*2) }
+}
+
+
+=pod
+sqlite> select * from groups;
+1|ABI||3|0.01|1||
+2|CGI-Application-ValidateRM||3|1.12|2||
+3|Acme-Bleach||3|1.12|3||
+4|CGI-Application||3|3.22|2||
+5|CGI-Application-Session||3|0.03|4||
+sqlite> select * from authors;
+1|MALAY
+2|MARKSTOS
+3|DCONWAY
+4|CEESHEK
+=cut
+
+
+
sub check_form {
- my ($form, $input_fields_ref) = @_;
+ my ($form, $input_fields_ref, $diag) = @_;
foreach my $i (@$input_fields_ref) {
my ($name, $type, $obj, $value) = @$i;
my $input = $form->find_input( $name, $type);
@@ -204,7 +284,9 @@
}
my @inputs = $form->inputs;
is(@inputs, scalar @$input_fields_ref);
- #foreach my $i (@inputs) { diag $i->name; }
+ if ($diag) {
+ foreach my $i (@inputs) { diag $i->name; }
+ }
}
Modified: trunk/templates/internal_error.tmpl
===================================================================
--- trunk/templates/internal_error.tmpl 2006-08-29 12:15:09 UTC (rev 186)
+++ trunk/templates/internal_error.tmpl 2006-08-29 12:15:18 UTC (rev 187)
@@ -30,6 +30,11 @@
</p>
</TMPL_IF>
+<TMPL_IF invalid_subs_type>
+<p>
+The selected subscription type is invalid. How could it happen?
+</p>
+</TMPL_IF>
<TMPL_IF generic>
<p>
Modified: trunk/templates/notes.tmpl
===================================================================
--- trunk/templates/notes.tmpl 2006-08-29 12:15:09 UTC (rev 186)
+++ trunk/templates/notes.tmpl 2006-08-29 12:15:18 UTC (rev 187)
@@ -24,6 +24,12 @@
</p>
</TMPL_IF>
+<TMPL_IF no_subs_type>
+<p>
+You have to select if the given thing is a distribution or a PAUSEID.
+</p>
+</TMPL_IF>
+
<TMPL_INCLUDE NAME="footer.tmpl">
More information about the Cpan-forum-commit
mailing list