Date: Tuesday February 4, 2003 @ 11:13
Author: matt
Update of /home/cvs/AxKit-XSP-Comments/lib/AxKit/XSP
In directory ted.sergeant.org:/home/matt/Perl/AxKit-XSP-Comments/lib/AxKit/XSP
Modified Files:
Comments.pm
Log Message:
Initial main commit
Log:
PR:
Index: Comments.pm
===================================================================
RCS file: /home/cvs/AxKit-XSP-Comments/lib/AxKit/XSP/Comments.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -b -u -r1.1 -r1.2
--- Comments.pm 2003/01/05 22:32:36 1.1
+++ Comments.pm 2003/02/04 11:13:40 1.2
@@ -1,10 +1,600 @@
-# $Id: Comments.pm,v 1.1 2003/01/05 22:32:36 matt Exp $
+# $Id: Comments.pm,v 1.2 2003/02/04 11:13:40 matt Exp $
package AxKit::XSP::Comments;
use strict;
-use vars qw($VERSION @ISA @EXPORT_TAGLIB);
-$VERSION = '0.01';
+use Apache::AxKit::Language::XSP::TaglibHelper;
+use vars qw($VERSION $NS @ISA @EXPORT_TAGLIB);
+
+$VERSION = '0.05';
+
+# The namespace associated with this taglib.
+$NS = 'http://axkit.org/NS/xsp/comments/1';
+# Using TaglibHelper:
+@ISA = qw(Apache::AxKit::Language::XSP::TaglibHelper);
+
+@EXPORT_TAGLIB = (
+ 'new_user($db,$username,$email,$server):as_xml=1',
+ 'change_password($db,$cookie,$oldpassword,$newpassword1,$newpassword2):as_xml=1',
+ 'lost_password($db,$username,$server):as_xml=1',
+ 'forgot_user($db,$email,$server):as_xml=1',
+ 'user_login($db,$username,$password,$ip):as_xml=1',
+ 'getusername($db,$cookie):as_xml=1',
+ 'preview($db,$cookie,$uri,$subject,$text,$texttype,$parent_id):as_xml=1',
+ 'create($db,$cookie,$uri,$subject,$text,$texttype,$parent_id):as_xml=1',
+ 'display_comment($db,$uri,$id):as_xml=1',
+);
+
+use DBI;
+use Digest::MD5 qw(md5_hex);
+use Email::Valid;
+use Mail::Sendmail;
+use Crypt::GeneratePassword;
+use Time::Piece;
+use XML::SAX::Writer;
+use Pod::SAX;
+use XML::LibXML::SAX::Parser;
+use Text::WikiFormat::SAX;
+
+sub _mkdb {
+ my ($dbpath) = @_;
+ my $db = DBI->connect(
+ 'DBI:SQLite:dbname='. $dbpath,
+ '', '', { AutoCommit => 0, RaiseError => 1 }
+ );
+
+ eval {
+ $db->do('select * from User, Comment, Formatter where 1 = 2');
+ };
+ if ($@) {
+ create_db($db);
+ }
+
+ return $db;
+}
+
+sub _get_password {
+ my ($db, $user_id) = @_;
+ my $sth = $db->prepare("SELECT password FROM User WHERE User.id = ?");
+ $sth->execute($user_id);
+ my $row = $sth->fetch || die "No such user id: $user_id";
+ $sth->finish;
+ return $row->[0];
+}
+
+sub encookie {
+ my ($db, $user_id) = @_;
+ my $password = _get_password($db, $user_id);
+ return "$user_id:" . md5_hex("$user_id:$password");
+}
+
+sub decookie {
+ my ($db, $cookie) = @_;
+ my ($user_id, $md5) = split(':', $cookie, 2);
+ my $password = _get_password($db, $user_id);
+ die "MD5 does not match this user id" unless $md5 eq
+md5_hex("$user_id:$password");
+ return $user_id;
+}
+
+sub new_user ($$$$) {
+ my ($db, $username, $email, $server) = @_;
+
+ if ($username !~ /^[A-Za-z][A-Za-z0-9_\.-]*$/) {
+ return "<error>Invalid username</error>";
+ }
+
+ if (!Email::Valid->address($email)) {
+ return "<error>Invalid email address</error>";
+ }
+
+ my $password = Crypt::GeneratePassword::word(5, 9)
+ || die "Cannot generate a new password";
+
+ $db = _mkdb($db);
+
+ # Check if they exist. Slight race condition, but the index mitigates that.
+ if ($db->selectrow_arrayref("SELECT COUNT(*) FROM User WHERE name = ?", {},
+$username)->[0]) {
+ return "<error>The username already exists. Please choose another, or request
+the password be sent to you below.</error><lostpassword/>";
+ }
+ if ($db->selectrow_arrayref("SELECT COUNT(*) FROM User WHERE email = ?", {},
+$email)->[0]) {
+ return "<error>The email address already exists in the database. Please
+choose another or use the forgot username form below.</error><forgotuser/>";
+ }
+
+ my $sth = $db->prepare(
+ "INSERT INTO User (name, email, password, lastlogin) VALUES (?,?,?,?)"
+ );
+
+ eval {
+ $sth->execute($username, $email, $password, 0);
+ };
+ if ($@) {
+ $db->rollback;
+ return "<error>Username or email address already exists in the
+database.</error>";
+ }
+
+ # Send the users password via email.
+ my $rc = sendmail(
+ To => $email,
+ From => "Do Not Reply <donotreply\@$server>",
+ Subject => "Your Password for http://$server/";,
+ Message =>
+ "Your new password for http://$server/ is:\n\n" .
+ " $password\n\n" .
+ "Please go there and login and change your password.",
+ );
+
+ if (!$rc) {
+ $db->rollback;
+ die "Sending email failed: $Mail::Sendmail::error\n";
+ }
+
+ $db->commit;
+
+ return "<output>User created successfully and".
+ " password emailed.</output>\n".
+ "<showlogin/>";
+}
+
+sub change_password ($$$$$) {
+ my ($db, $cookie, $oldpassword, $newpassword1, $newpassword2) = @_;
+
+ $db = _mkdb($db);
+
+ my $user_id = eval { decookie($db, $cookie) };
+ if ($@) { return "<notloggedin/>" }
+
+ my $cmppass = _get_password($db, $user_id);
+ if ($cmppass ne $oldpassword) {
+ return "<error>Old password does not match the stored
+password.</error><changepassword/>";
+ }
+
+ if ($newpassword1 ne $newpassword2) {
+ return "<error>New passwords differ</error><changepassword/>";
+ }
+
+ if (length($newpassword1) < 4) {
+ return "<error>Password is too short</error><changepassword/>";
+ }
+
+ # Everything is OK. Do the update.
+ $db->do("UPDATE User SET password = ? WHERE id = ?", {}, $newpassword1, $user_id);
+ $db->commit;
+
+ return "<output>Password successfully updated. Please login again to make this
+change take effect.</output>";
+}
+
+sub lost_password ($$$) {
+ my ($db, $username, $server) = @_;
+
+ $db = _mkdb($db);
+
+ my ($password, $email) = $db->selectrow_array(
+ "SELECT password, email FROM User WHERE name = ?", {}, $username
+ );
+
+ if (!$password) {
+ return "<error>No such user</error>";
+ }
+
+ # Send the users password via email.
+ my $rc = sendmail(
+ To => $email,
+ From => "Do Not Reply <donotreply\@$server>",
+ Subject => "Your Password for http://$server/";,
+ Message =>
+ "Your password for http://$server/ is:\n\n" .
+ " $password\n\n" .
+ "Please go there and login.",
+ );
+
+ if (!$rc) {
+ die "Sending email failed: $Mail::Sendmail::error\n";
+ }
+
+ return "<output>Password has been sent</output>";
+}
+
+sub forgot_user ($$$) {
+ my ($db, $email, $server) = @_;
+
+ $db = _mkdb($db);
+
+ my ($username) = $db->selectrow_array(
+ "SELECT name FROM User WHERE email = ?", {}, $email
+ );
+
+ if (!$username) {
+ return "<error>No user with that email address</error>";
+ }
+
+ # Send the users password via email.
+ my $rc = sendmail(
+ To => $email,
+ From => "Do Not Reply <donotreply\@$server>",
+ Subject => "Your Username at http://$server/";,
+ Message =>
+ "Your username for http://$server/ is:\n\n" .
+ " $username\n\n" .
+ "Please go there and login.",
+ );
+
+ if (!$rc) {
+ die "Sending email failed: $Mail::Sendmail::error\n";
+ }
+
+ return "<output>Username has been sent</output>";
+}
+
+sub user_login ($$$$) {
+ my ($db, $username, $password, $ip) = @_;
+
+ $db = _mkdb($db);
+
+ my ($user_id) = $db->selectrow_array(
+ "SELECT id FROM User WHERE name = ? AND password = ?",
+ {}, $username, $password,
+ );
+
+ return unless $user_id;
+
+ # get the cookie text
+ my $cookie = encookie($db, $user_id);
+
+ # update lastlogin in database
+ $db->do("UPDATE User SET lastlogin = ? WHERE id = ?",
+ {}, time, $user_id,
+ );
+ $db->commit;
+
+ return $cookie;
+}
+
+sub xgetusername {
+ my ($db, $cookie) = @_;
+
+ $db = _mkdb($db);
+
+ my $username;
+ eval {
+ my $user_id = decookie($db, $cookie);
+ ($username) = $db->selectrow_array("SELECT name FROM User WHERE id = ?", {},
+$user_id);
+ };
+ return $username;
+}
+
+sub getusername ($$) {
+ my ($db, $cookie) = @_;
+ my $username = xgetusername($db, $cookie);
+ return xml_escape($username) || '<notloggedin/>';
+}
+
+sub save_comment ($$$$$$$$) {
+ my ($db, $cookie, $uri, $subject,
+ $text, $formatterid, $ip, $parent_id) = @_;
+
+ if ($uri !~ /^\//) {
+ return "<error>Comments must be attached to a valid URL</error>";
+ }
+
+ $db = _mkdb($db);
+
+ my $user_id = eval { decookie($db, $cookie) };
+ if ($@) { return '<notloggedin/>' }
+
+ undef $parent_id unless $parent_id; # make sure it's not empty string
+
+ my $sth = $db->prepare(<<'EOT');
+ INSERT INTO Comment ( parent_id, user_id, subject, data,
+ url, formatter_id, timestamp, ipaddr )
+ VALUES ( ?, ?, ?, ?, ?, ?, ?, ? )
+EOT
+ $sth->trace(2);
+ $sth->execute($parent_id, $user_id, $subject, $text,
+ $uri, $formatterid, time, $ip);
+ $db->commit;
+}
+
+sub preview ($$$$$$$) {
+ my ($db, $cookie, $uri, $subject, $text, $texttype, $parent_id) = @_;
+
+ if ($uri !~ /^\//) {
+ return "<error>Comments must be attached to a valid URL</error>";
+ }
+
+ my $username = xgetusername($db, $cookie);
+ if (!$username) {
+ return "<error><notloggedin/></error>";
+ }
+
+ $db = _mkdb($db);
+
+ my $sth = $db->prepare(<<'EOT');
+ SELECT Formatter.module
+ FROM Formatter
+ WHERE Formatter.id = ?
+EOT
+ $sth->execute($texttype);
+
+ my $saxtext = '';
+ my $handler = XML::SAX::Writer->new(Output => \$saxtext);
+ while ( my $row = $sth->fetch ) {
+ # create the parser
+ my $parser = $row->[0]->new(Handler => $handler);
+ eval {
+ $parser->parse_string($text);
+ };
+ if ($@) {
+ $saxtext = '<pod>
+ <para>
+ Error parsing the page: ' . xml_escape($@) . '
+ </para>
+</pod>
+ ';
+
+ }
+ last;
+ }
+ if (!$saxtext) {
+ $saxtext = '<pod>
+ <para>
+ Eek.
+ </para>
+</pod>
+ ';
+ }
+
+ $saxtext =~ s/^<\?xml\s.*?\?>//s;
+
+ my $output = "<preview><subject>";
+ $output .= xml_escape($subject);
+ $output .= "</subject><username>";
+ $output .= xml_escape($username);
+ $output .= "</username><timestamp>";
+ $output .= xml_escape(gmtime()->strftime('%H:%M %a %e %b, %Y'));
+ $output .= "</timestamp><text>$saxtext</text></preview>";
+ # Now add edit stuff
+ $output .= _create($db, $uri, $subject, $text, $texttype, $parent_id);
+
+ return $output;
+}
+
+sub _create {
+ my ($db, $uri, $subject, $text, $texttype, $parent_id) = @_;
+
+ my $output = '';
+
+ $output .= '<editcomment><uri>';
+ $output .= xml_escape($uri);
+ $output .= '</uri><parent_id>';
+ $output .= xml_escape($parent_id);
+ $output .= '</parent_id><subject>';
+ $output .= xml_escape($subject);
+ $output .= '</subject><text>';
+ $output .= xml_escape($text);
+ $output .= '</text><texttypes>';
+
+ my $sth = $db->prepare('SELECT Formatter.id, Formatter.name FROM Formatter');
+ $sth->execute();
+ while (my $row = $sth->fetch) {
+ $output .= '<texttype id="'. xml_escape($row->[0]) .
+ ($texttype == $row->[0] ? '" selected="selected">' : '">') .
+ xml_escape($row->[1]) . '</texttype>';
+ }
+ $sth->finish;
+
+ $output .= '</texttypes></editcomment>';
+ return $output;
+}
+
+sub create ($$$$$$$) {
+ my ($db, $cookie, $uri, $subject, $text, $formatterid, $parent_id) = @_;
+
+ if ($uri !~ /^\//) {
+ return "<error>Comments must be attached to a valid URL</error>";
+ }
+
+ my $username = xgetusername($db, $cookie);
+ if (!$username) {
+ return "<error><notloggedin/></error>";
+ }
+
+ $db = _mkdb($db);
+
+ return _create($db, $uri, $subject, $text, $formatterid, $parent_id);
+}
+
+sub display_comment ($$$) {
+ my ($db, $uri, $id) = @_;
+
+ if ($uri !~ /^\//) {
+ return "<error>Comments must be attached to a valid URL</error>";
+ }
+
+ $db = _mkdb($db);
+
+ if ($id) {
+ return display_one_comment($db, $id);
+ }
+ else {
+ return display_all_comments($db, $uri);
+ }
+}
+
+sub thread_comment {
+ my ($db, $row) = @_;
+
+ my $output = '';
+ $output .= '<comment display="summary"><id>';
+ $output .= xml_escape($row->[0]);
+ $output .= '</id><subject>';
+ $output .= xml_escape($row->[1]);
+ $output .= '</subject><username>';
+ $output .= xml_escape($row->[2]);
+ $output .= '</username><timestamp>';
+ $output .= xml_escape(gmtime($row->[3])->strftime('%H:%M %a %e %b, %Y'));
+ $output .= '</timestamp>';
+ $output .= child_comments($db, $row->[0]);
+ $output .= '</comment>';
+ return $output;
+}
+
+sub child_comments {
+ my ($db, $id) = @_;
+ my $sth = $db->prepare(
+ 'SELECT Comment.id, Comment.subject, User.name, Comment.timestamp
+ FROM Comment, User
+ WHERE Comment.user_id = User.id
+ AND Comment.parent_id = ?
+ ');
+ $sth->execute($id);
+
+ my $output = '';
+ while (my $row = $sth->fetch) {
+ $output .= thread_comment($db, $row);
+ }
+ return $output;
+}
+
+sub display_one_comment {
+ my ($db, $id) = @_;
+
+ my $output = '<comment display="full">';
+
+ my $sth = $db->prepare(
+ 'SELECT Comment.id, Comment.subject, User.name, Comment.timestamp,
+Comment.data, Formatter.module
+ FROM Comment, User, Formatter
+ WHERE Comment.user_id = User.id
+ AND Comment.formatter_id = Formatter.id
+ AND Comment.id = ?
+ ');
+ $sth->execute($id);
+ my $dataxml = '';
+ my $handler = XML::SAX::Writer->new(Output => \$dataxml);
+
+ while (my $row = $sth->fetch) {
+ $output .= '<<subject>';
+ $output .= xml_escape($row->[1]);
+ $output .= '</subject><username>';
+ $output .= xml_escape($row->[2]);
+ $output .= '</username><timestamp>';
+ $output .= xml_escape(gmtime($row->[3])->strftime('%H:%M %a %e %b, %Y'));
+ $output .= '</timestamp><text>';
+
+ # create the parser
+ my $parser = $row->[5]->new(Handler => $handler);
+ eval {
+ $parser->parse_string($row->[4]);
+ };
+ if ($@) {
+ $dataxml = '<pod>
+ <para>
+ Error parsing the page: ' . xml_escape($@) . '
+ </para>
+ </pod>
+ ';
+ }
+ $output .= $dataxml;
+ $output .= '</text><comments>';
+ $output .= child_comments($db, $row->[0]);
+ $output .= '</comments>';
+ last;
+ }
+
+ $output .= '</comment>';
+ return $output;
+}
+
+sub display_all_comments {
+ my ($db, $uri) = @_;
+
+ my $output = '<comments>';
+
+ # Get top level comments
+ my $sth = $db->prepare(
+ 'SELECT Comment.id, Comment.subject, User.name, Comment.timestamp
+ FROM Comment, User
+ WHERE Comment.user_id = User.id
+ AND Comment.parent_id IS NULL
+ AND Comment.url = ?
+ ');
+ $sth->execute($uri);
+
+ while (my $row = $sth->fetch) {
+ $output .= thread_comment($db, $row);
+ }
+
+ $output .= '</comments>';
+ return $output;
+}
+
+sub xml_escape {
+ my $text = shift;
+ $text =~ s/&/&/g;
+ $text =~ s/</</g;
+ $text =~ s/]]>/]]>/g;
+ return $text;
+}
+
+sub create_db {
+ my ($db) = @_;
+
+ # TODO: Make smarter based on $VERSION
+
+ $db->do(q{
+ CREATE TABLE User
+ (
+ id integer not null primary key,
+ name varchar not null,
+ email varchar not null,
+ password varchar not null,
+ lastlogin integer not null
+ )
+ });
+ $db->do(q{
+ create unique index User_name on User ( name )
+ });
+ $db->do(q{
+ create unique index User_email on User ( email )
+ });
+ $db->do(q{
+ CREATE TABLE Comment
+ (
+ id integer not null primary key,
+ parent_id integer,
+ user_id integer not null,
+ subject varchar not null,
+ data varchar not null,
+ url varchar not null,
+ formatter_id integer not null,
+ timestamp integer not null,
+ ipaddr varchar not null
+ )
+ });
+ $db->do(q{
+ create index Comment_url on Comment ( url, parent_id )
+ });
+
+ $db->do(q{
+ create table Formatter ( id INTEGER PRIMARY KEY, module NOT NULL,
+name NOT NULL)
+ });
+ $db->do(q{
+ insert into Formatter (module, name) values ('Pod::SAX', 'pod -
+plain old documentation')
+ });
+ $db->do(q{
+ insert into Formatter (module, name) values
+('Text::WikiFormat::SAX', 'wiki text')
+ });
+ $db->do(q{
+ insert into Formatter (module, name) values
+('XML::LibXML::SAX::Parser',
+ 'xml (sdocbook)')
+ });
+ $db->do(q{
+ create table DBVersion (version)
+ });
+ $db->do(qq{
+ insert into DBVersion (version) values ('$VERSION')
+ });
+ $db->commit;
+}
1;
__END__
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
