[Cpan-forum-commit] rev 81 - in trunk: . lib/CPAN lib/CPAN/Forum t templates www

svn at pti.co.il svn at pti.co.il
Sat Feb 5 00:45:31 IST 2005


Author: gabor
Date: 2005-02-05 00:45:31 +0200 (Sat, 05 Feb 2005)
New Revision: 81

Added:
   trunk/templates/admin.tmpl
Modified:
   trunk/MANIFEST
   trunk/lib/CPAN/Forum.pm
   trunk/lib/CPAN/Forum/Markup.pm
   trunk/lib/CPAN/Forum/UserInGroup.pm
   trunk/lib/CPAN/Forum/Usergroups.pm
   trunk/lib/CPAN/Forum/Users.pm
   trunk/t/010-markup.t
   trunk/templates/footer.tmpl
   trunk/templates/internal_error.tmpl
   trunk/templates/navigation.tmpl
   trunk/templates/search.tmpl
   trunk/www/style.css
Log:
improve search, accept both upper case and lower case markup, admin page, change from mail

Modified: trunk/MANIFEST
===================================================================
--- trunk/MANIFEST	2005-02-04 08:50:15 UTC (rev 80)
+++ trunk/MANIFEST	2005-02-04 22:45:31 UTC (rev 81)
@@ -59,6 +59,7 @@
 templates/module_search_form.tmpl
 templates/module_select_form.tmpl
 templates/message_in_thread.tmpl
+templates/admin.tmpl
 
 www/cgi/index.pl
 www/robots.txt

Modified: trunk/lib/CPAN/Forum/Markup.pm
===================================================================
--- trunk/lib/CPAN/Forum/Markup.pm	2005-02-04 08:50:15 UTC (rev 80)
+++ trunk/lib/CPAN/Forum/Markup.pm	2005-02-04 22:45:31 UTC (rev 81)
@@ -18,14 +18,30 @@
 	           | open_b text close_b              { join "", @item[1..$#item] }
 	           | open_i text close_i              { join "", @item[1..$#item] }
 	           | open_p text close_p              { join "", @item[1..$#item] }
-			   | br                               { "<br />" }
-	br         : m{<br( /)?>}
-	open_p     : m{<p>}
-	close_p    : m{</p>}
-	open_b     : m{<b>}
-	close_b    : m{</b>}
-	open_i     : m{<i>}
-	close_i    : m{</i>}
+			   | br                               { $item[1] }
+			   | open_a text close_a              { join "", @item[1..$#item] }
+	br         : m{<br( /)?>}i                    { "<br />" }
+	open_p     : m{<p>}i                          { "<p>"  }
+	close_p    : m{</p>}i                         { "</p>" }
+	open_b     : m{<b>}i                          { "<b>"  }
+	close_b    : m{</b>}i                         { "</b>" }
+	open_i     : m{<i>}i                          { "<i>"  }
+	close_i    : m{</i>}i                         { "</i>" }
+
+	open_a      : open_a_href urlx open_a_gt      { qq(<a href="$item[2]">) }
+	open_a_href : m{<a href=}i
+	urlx        : quote url quote                 {$item[2]}
+				| url                             {$item[1]}
+	url         : http
+	            | mailto
+	http        : m{http://[^">]+}i               { lc $item[1]  }
+	mailto      : m{mailto:[^">]+}i               { lc $item[1]  }   
+	open_a_gt   : m{>}     
+	quote       : m{"}
+
+	close_a    : m{</a>}i                         { "</a>" }
+
+
 	text       : m{[\r\t\n -;=?-~]+}              {$item[1] }
 
 	marked_code: open_code code close_code        { join("", @item[1..$#item]) }

Modified: trunk/lib/CPAN/Forum/UserInGroup.pm
===================================================================
--- trunk/lib/CPAN/Forum/UserInGroup.pm	2005-02-04 08:50:15 UTC (rev 80)
+++ trunk/lib/CPAN/Forum/UserInGroup.pm	2005-02-04 22:45:31 UTC (rev 81)
@@ -6,6 +6,9 @@
 __PACKAGE__->table('user_in_group');
 __PACKAGE__->columns(All => qw/uid gid/);
 
+#__PACKAGE__->has_many(users => "CPAN::Forum::Users");
+#__PACKAGE__->has_many(groups => "CPAN::Forum::Usergroups");
 
+
 1;
 

Modified: trunk/lib/CPAN/Forum/Usergroups.pm
===================================================================
--- trunk/lib/CPAN/Forum/Usergroups.pm	2005-02-04 08:50:15 UTC (rev 80)
+++ trunk/lib/CPAN/Forum/Usergroups.pm	2005-02-04 22:45:31 UTC (rev 81)
@@ -6,6 +6,11 @@
 __PACKAGE__->table('usergroups');
 __PACKAGE__->columns(All => qw/id name/);
 
+__PACKAGE__->set_sql(ugs => "SELECT __ESSENTIAL__ FROM __TABLE__, user_in_group
+                             WHERE 
+                               user_in_group.uid = ? AND
+                               user_in_group.gid=usergroups.id
+                            ");
 
 1;
 

Modified: trunk/lib/CPAN/Forum/Users.pm
===================================================================
--- trunk/lib/CPAN/Forum/Users.pm	2005-02-04 08:50:15 UTC (rev 80)
+++ trunk/lib/CPAN/Forum/Users.pm	2005-02-04 22:45:31 UTC (rev 81)
@@ -7,6 +7,7 @@
 __PACKAGE__->columns(All => qw/id username password email fname lname status
 							update_on_new_user/);
 __PACKAGE__->has_many(posts => "CPAN::Forum::Posts");
+#__PACKAGE__->has_many(usergroups => "CPAN::Forum::UserInGroup");
 
 
 __PACKAGE__->add_trigger(before_create => sub { 
@@ -24,5 +25,6 @@
 	return $pw;
 }
 
+
 1;
 

Modified: trunk/lib/CPAN/Forum.pm
===================================================================
--- trunk/lib/CPAN/Forum.pm	2005-02-04 08:50:15 UTC (rev 80)
+++ trunk/lib/CPAN/Forum.pm	2005-02-04 22:45:31 UTC (rev 81)
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 
-our $VERSION = "0.10_01";
+our $VERSION = "0.10_02";
 
 use base "CGI::Application";
 use CGI::Application::Plugin::Session;
@@ -181,6 +181,20 @@
 
 =head2 Changes
 
+v0.10_03
+  Search for users
+  Unite the serch methods
+  Accept both upper-case and lower-case HTML tags and turn them all to lower 
+    case tags when displaying
+  Accept <a href=> tags for http and mailto
+  Admin page
+  Admin can change "From" e-address
+
+  
+  Admin can change e-mail address of any user
+  Add paging
+ 
+
 v0.10_02
   <p>, <br> enabled
   Add link to Kobes Search
@@ -595,11 +609,12 @@
 					posts threads dist users 
 					search all 
 					help
-					find_groups
 					rss ); 
 my @restricted_modes = qw(
 			new_post process_post
 			mypan 
+			admin
+			admin_process
 			response_form 
 			module_search
 			selfconfig change_password update_subscription); 
@@ -613,6 +628,7 @@
 	threads dist users 
 	response_form 
 	faq 
+	admin
 	mypan selfconfig 
 	search all rss); 
 
@@ -667,7 +683,8 @@
 		
 	}
 
-	$self->log->debug("Current runmode:  $rm");
+	$self->log->debug("Current runmode:  $rm"); 
+	$self->log->debug("Current user:  " . ($self->session->param("username") || ""));
 
 	return if grep {$rm eq $_} @free_modes;
 	#return if not grep {$rm eq $_} @restricted_modes;
@@ -822,6 +839,7 @@
 	}
 	my $t = $self->load_tmpl("internal_error.tmpl");
 	$t->param($tag => 1) if $tag;
+	$t->param(generic => 1) if not $tag;
 	$t->output;
 }
 
@@ -840,6 +858,7 @@
 	$t->param("loggedin" => $self->session->param("loggedin") || "");
 	$t->param("username" => $self->session->param("username") || "anonymous");
 	$t->param("test_site_warning" => -e $self->param("ROOT") . "/config_test_site");
+	$t->param("admin" => $self->session->param('admin'));
 	return $t;
 }
 # config_fake_login  (not used currently)
@@ -885,12 +904,20 @@
 	}
 
 	my $session = $self->session;
+	$session->param(admin     => 0); # make sure it is clean
+
 	$session->param(loggedin  => 1);
 	$session->param(username  => $user->username);
 	$session->param(uid       => $user->id);
 	$session->param(fname     => $user->fname); # TODO
 	$session->param(lname     => $user->lname); # TODO
 	$session->param(email     => $user->email);
+	foreach my $g (CPAN::Forum::Usergroups->search_ugs($user->id)) {
+		$self->log->debug("UserGroups: " . $g->name);
+		if ($g->name eq "admin") {
+			$session->param(admin     => 1);
+		}
+	}
 
 	my $request = $session->param("request") || "";
 	$session->param("request" => "");
@@ -1795,65 +1822,86 @@
 	$t->output;
 }
 
-=head2 search
+sub search {
+	my ($self) = @_;
+	my $q      = $self->query;
+	my $name   = $q->param("name")    || '';
+	my $what   = $q->param("what")    || 'module';
 
-Search form and processor.
-
-=cut
-# not in use
-sub find_groups {
-	my $self  = shift;
-	my $q     = $self->query;
-	my $name  = $q->param("name")    || '';
-
+	# kill the taint checking (why do I use taint checking if I kill it then ?)
 	if ($name =~ /(.*)/) { $name    = $1; }
-	$name =~ s/::/-/g;
+	$name =~ s/::/-/g if $what eq "module";
 	
 	my $t = $self->load_tmpl("search.tmpl",
 		associate => $q,
 		loop_context_vars => 1,
 	);
 	my $it;
-	my @groups;
-	if ($name) {
-		my $it =  CPAN::Forum::Groups->search_like(name => $name . '%');
-		while (my $group  = $it->next) {
-			push @groups, {name => $group->name};
+	if ($name and $what) {
+		if ($what eq "module") {
+			my @things;
+			my $it =  CPAN::Forum::Groups->search_like(name => $name . '%');
+			while (my $group  = $it->next) {
+				push @things, {name => $group->name};
+			}
+			$t->param(groups => \@things);
+			$t->param($what => 1);
 		}
+		if ($what eq "user") {
+			my @things;
+			my $it =  CPAN::Forum::Users->search_like(username => '%' . lc($name) . '%');
+			while (my $user  = $it->next) {
+				push @things, {username => $user->username};
+			}
+			$t->param(users => \@things);
+			$t->param($what => 1);
+		}
+		my %search;
+		if ($what eq "subject") { %search = (subject => '%' . $name . '%'); }
+		if ($what eq "text")    { %search = (text    => '%' . $name . '%'); }
+		if (%search) {
+			my $it =  CPAN::Forum::Posts->search_like(%search);
+			my $cnt = CPAN::Forum::Posts->sql_count_like(%search)->select_val;
+			$t->param(messages => $self->build_listing($it,$cnt));
+			$t->param($what => 1);
+		}
 	}
-	$t->param(groups => \@groups);
-
 	$t->output;
 }
 
+sub admin_process {
+	my ($self) = @_;
+	my $q = $self->query;
+	if (not $self->session->param("admin")) {
+		return $self->internal_error("", "restricted_area");
+	}
 
-sub search {
-	my $self = shift;
+	if (my ($conf) = CPAN::Forum::Configure->search(field => 'from')) {
+		$self->log->debug("Old FROM field was " . $conf->value);
+		$conf->value($q->param('from'));
+		$self->log->debug("New FROM field set to be " . $q->param('from'));
+		$conf->update;
+	} else {
+		$self->log->fatal("Could not find from field !!");
+	}
 
-	my $q       = $self->query;
-	my $subject = $q->param("subject") || '' ;
-	my $text    = $q->param("text")    || '';
-	
-	my $t = $self->load_tmpl("search.tmpl",
-		associate => $q,
-		loop_context_vars => 1,
-	);
+	my $t = $self->load_tmpl("admin.tmpl");
+	$t->param(updated => 1);
+	$t->output;
+}
 
-	# kill the taint checking (why do I use taint checking if I kill it then ?)
-	if ($text    =~ /(.*)/) { $text    = $1; }
-	if ($subject =~ /(.*)/) { $subject = $1; }
 
-	my %search;
-
-	if ($text)    { $search{text}    = '%' . $text    . '%'; }
-	if ($subject) { $search{subject} = '%' . $subject . '%'; }
-
-	if (%search) {
-		my $it =  CPAN::Forum::Posts->search_like(%search);
-		my $cnt = CPAN::Forum::Posts->sql_count_like(%search)->select_val;
-		$t->param(messages => $self->build_listing($it,$cnt));
+sub admin {
+	my ($self) = @_;
+	if (not $self->session->param("admin")) {
+		return $self->internal_error("", "restricted_area");
 	}
-
+	my %data;
+	foreach my $c (CPAN::Forum::Configure->retrieve_all()) {
+		$data{$c->field} = $c->value;
+	}
+	my $t = $self->load_tmpl("admin.tmpl");
+	$t->param(%data);
 	$t->output;
 }
 

Modified: trunk/t/010-markup.t
===================================================================
--- trunk/t/010-markup.t	2005-02-04 08:50:15 UTC (rev 80)
+++ trunk/t/010-markup.t	2005-02-04 22:45:31 UTC (rev 81)
@@ -10,10 +10,10 @@
 use lib "blib/lib";
 use CPAN::Forum::Markup;
 
-my $long = "1234567890" x 6 . "qwertyuiop" x 4;
-my $long_new = "1234567890" x 6 . "\n" . "+" . "qwertyuiop" x 4;
-my $long2 = "1234567890" x 10 . "abcdef" x 20;
-my $long2_new = "1234567890" x 6 . "\n" . "+" . "1234567890" x 4 . "\n" . "+" . "abcdef" x 13 . "\n" . "+" . "abcdef" x 7;
+my $long = "x234567890" x 6 . "qwertyuiop" x 4;
+my $long_new = "x234567890" x 6 . "\n" . "+" . "qwertyuiop" x 4;
+my $long2 = "x234567890" x 10 . "abcdef" x 20;
+my $long2_new = "x234567890" x 6 . "\n" . "+" . "1234567890" x 4 . "\n" . "+" . "abcdef" x 13 . "\n" . "+" . "abcdef" x 7;
 is(CPAN::Forum::Markup::split_rows("some text", 60), "some text");
 #is(CPAN::Forum::Markup::split_rows($long, 61), $long_new);
 #is(CPAN::Forum::Markup::split_rows($long2, 61), $long2_new);
@@ -28,8 +28,8 @@
 	'apple'                    => $TEXT . 'apple' . $END,
 	'apple<code><</code>'      => $TEXT . 'apple' . $END . $CODE . '&lt;' . $END,
 	'apple<code><code></code>' => $TEXT . 'apple' . $END . $CODE . '&lt;code&gt;' . $END,
-	'1234567890' x 7           => $TEXT . '1234567890' x 7   . $END,
-	'1234567890' x 100         => $TEXT . '1234567890' x 100 . $END,
+	'x234567890' x 7           => $TEXT . 'x234567890' x 7   . $END,
+	'x234567890' x 100         => $TEXT . 'x234567890' x 100 . $END,
 	'Hello world'              => $TEXT . 'Hello world' . $END,
 	'<code>program</code>'     => $CODE . 'program' . $END,
 	'<code><STD></code>'       => $CODE . '&lt;STD&gt;' . $END,
@@ -47,12 +47,23 @@
 	'a<b>c</b><code>x</code>d<code>y</code>' => $TEXT . 'a<b>c</b>' . $END . $CODE . 'x' . $END . $TEXT . 'd' . $END . $CODE . 'y' . $END,
 	'a<i>c</i><code>x</code>d<code>y</code>' => $TEXT . 'a<i>c</i>' . $END . $CODE . 'x' . $END . $TEXT . 'd' . $END . $CODE . 'y' . $END,
 	'a<b>c</b>d<i>x</i>f'      => $TEXT . 'a<b>c</b>d<i>x</i>f' . $END,
+	'a<B>c</B>d<I>x</I>f'      => $TEXT . 'a<b>c</b>d<i>x</i>f' . $END,
 	'&lt;'                     => $TEXT . '&lt;' . $END,
 	'<p>text</p>'              => $TEXT . '<p>text</p>' . $END,
+	'<P>text</P>'              => $TEXT . '<p>text</p>' . $END,
+	'<P>text</p>'              => $TEXT . '<p>text</p>' . $END,
 	'<br />'                   => $TEXT . '<br />' . $END,
 	'<br />hello'              => $TEXT . '<br />hello' . $END,
 	'<br>hello'                => $TEXT . '<br />hello' . $END,
+	'<BR>hello'                => $TEXT . '<br />hello' . $END,
+	'<code><P></code>'         => $CODE . '&lt;P&gt;' . $END,
+	'<a href=http://bla>text</a>'   => $TEXT . '<a href="http://bla">text</a>' . $END,
+	'<A href=http://blb>text</a>'   => $TEXT . '<a href="http://blb">text</a>' . $END,
+	'<A HREF=http://blc>text</a>'   => $TEXT . '<a href="http://blc">text</a>' . $END,
+	'<A HREF="http://bld">text</a>' => $TEXT . '<a href="http://bld">text</a>' . $END,
+	'<A HREF=mailto:a at b.c>addr</a>' => $TEXT . '<a href="mailto:a at b.c">addr</a>' . $END,
 
+
 );
 
 my %fails = (
@@ -74,12 +85,14 @@
 	'a<i>c'                    => undef,
 	'apple<'                   => undef,
 	'<p>text'                  => undef,
+	'<a href=htt://bla>text</a>' => undef,
+	'<a href=javascript>text</a>' => undef,
 );
 
 
 foreach my $c (sort keys %cases) {
 	lives_ok {f($c)} 'Expected to live';
-	is(f($c), $cases{$c});
+	is(f($c), $cases{$c}, $c);
 }
 
 foreach my $c (sort keys %fails) {

Added: trunk/templates/admin.tmpl
===================================================================
--- trunk/templates/admin.tmpl	2005-02-04 08:50:15 UTC (rev 80)
+++ trunk/templates/admin.tmpl	2005-02-04 22:45:31 UTC (rev 81)
@@ -0,0 +1,25 @@
+<TMPL_INCLUDE NAME="head.tmpl">
+<p id="pageTitle">Admin interface</p>
+
+<TMPL_INCLUDE NAME="navigation.tmpl">
+
+
+<TMPL_IF updated>
+Data updated. <a href="/admin/">look it again</a>
+<TMPL_ELSE>
+
+<form method="POST" action="/admin/">
+<p>
+<input type="hidden" name="rm" value="admin_process" />
+</p>
+<table>
+<tr><td>From address:</td><td><input name="from" value="<TMPL_VAR from>" size="50"></td></tr>
+</table>
+<p>
+<input type="submit" value="Update" />
+</p>
+</form>
+
+</TMPL_IF>
+
+<TMPL_INCLUDE NAME="footer.tmpl">

Modified: trunk/templates/footer.tmpl
===================================================================
--- trunk/templates/footer.tmpl	2005-02-04 08:50:15 UTC (rev 80)
+++ trunk/templates/footer.tmpl	2005-02-04 22:45:31 UTC (rev 81)
@@ -1,7 +1,7 @@
 <TMPL_INCLUDE name="navigation.tmpl">
 
 <div class="footer">
-	Service launched on 1st of February 2005.<br />
+	Service launched on 2nd of February 2005.<br />
 	Comments, and other submissions on CPAN Forum are Copyright 2005, their respective owners.<br />
 	Site maintainer is not responsible for content.
 </div>

Modified: trunk/templates/internal_error.tmpl
===================================================================
--- trunk/templates/internal_error.tmpl	2005-02-04 08:50:15 UTC (rev 80)
+++ trunk/templates/internal_error.tmpl	2005-02-04 22:45:31 UTC (rev 81)
@@ -14,7 +14,13 @@
 If you really have time, you could also look at <a href="/about/#development">the source code</a> 
 and let us know where is the bug.
 </p>
-<TMPL_ELSE>
+</TMPL_IF>
+
+<TMPL_IF restricted_area>
+Restricted area. How did you get here ?
+</TMPL_IF>
+
+<TMPL_IF generic>
 <p>
 Something went wrong here. The webmaster will be informed and will try to take action. 
 </p>

Modified: trunk/templates/navigation.tmpl
===================================================================
--- trunk/templates/navigation.tmpl	2005-02-04 08:50:15 UTC (rev 80)
+++ trunk/templates/navigation.tmpl	2005-02-04 22:45:31 UTC (rev 81)
@@ -9,6 +9,9 @@
 		  <a href="/mypan/">mypan</a> | 
 		  <a href="/selfconfig/">selfconfig</a> | 
 		  <a href="/logout/">logout</a> | 
+		  <TMPL_IF admin>
+		  <a href="/admin/">admin</a> | 
+		  </TMPL_IF>
 		<TMPL_ELSE>
 		  <a href="/login/">login</a> |
 		  <a href="/register/">register</a> |

Modified: trunk/templates/search.tmpl
===================================================================
--- trunk/templates/search.tmpl	2005-02-04 08:50:15 UTC (rev 80)
+++ trunk/templates/search.tmpl	2005-02-04 22:45:31 UTC (rev 81)
@@ -5,9 +5,15 @@
 
 <form method="post" action="/search/">
 <p>
-<input type="hidden" name="rm" value="find_groups" />
-<input name="name" value="<TMPL_VAR name>" /><br />
-<input type="submit" value="Search Module names" />
+<input type="hidden" name="rm" value="search" />
+<select name="what">
+<option value="module"  <TMPL_IF module> SELECTED</TMPL_IF>>Module name</option>
+<option value="user"    <TMPL_IF user>   SELECTED</TMPL_IF>>User name</option>
+<option value="subject" <TMPL_IF subject>SELECTED</TMPL_IF>>Post by text in subject</option>
+<option value="text"    <TMPL_IF text>   SELECTED</TMPL_IF>>Post by text in body</option>
+</select>
+<input name="name" value="<TMPL_VAR name>" />
+<input type="submit" value="Search" />
 </p>
 </form>
 
@@ -15,22 +21,12 @@
    <a href="/dist/<TMPL_VAR name>"><TMPL_VAR name></a><br />
 </TMPL_LOOP>
 
-<hr />
+<TMPL_LOOP users>
+  <TMPL_VAR username><br />
+</TMPL_LOOP>
 
-<form method="post" action="/search/">
-<p>
-<input type="hidden" name="rm" value="search" />
-</p>
-<table>
-<tr><td>Subject:</td><td><input name="subject" value="<TMPL_VAR subject>" /></td></tr>
-<tr><td>Text:</td><td><input name="text" value="<TMPL_VAR text>" /></td></tr>
-</table>
-<p>
-<input type="submit" value="Search Posts" />
-</p>
-</form>
-
 <TMPL_INCLUDE NAME="listing.tmpl">
 
+
 <TMPL_INCLUDE NAME="footer.tmpl">
 

Modified: trunk/www/style.css
===================================================================
--- trunk/www/style.css	2005-02-04 08:50:15 UTC (rev 80)
+++ trunk/www/style.css	2005-02-04 22:45:31 UTC (rev 81)
@@ -97,7 +97,20 @@
 .even {
 	background: #aaaaaa;
 }
+.odd:hover {
+	background: yellow;
+}
+.even:hover {
+	background: yellow;
+}
 
+.odd TD:hover {
+	background: red;
+}
+.even TD:hover {
+	background: red;
+}
+
 .odd TD, .even TD {
 	padding: 0ex 0ex 0ex 1px;
 	vertical-align: baseline;



More information about the Cpan-forum-commit mailing list