Quick Fix for PerlMonks modules

[pope]

Greeting fellow monks,

I was about to ask something in chatterbox using Shendal's monkchat when I found it just didn't work. It didn't show the currently online users and showed no messages at all. "This must be because of recent changes of this site layout", I thought, then I grabbed the latest PerlMonks modules (version 2.2), install it, but the same problem was still there.

After "super searching", I only found the same problem (Does anybody else have this problem?) was reported but no response.

After looking into PerlMonks modules, I found a fundamental problem that the XML parsing is done using regex in a fragile way, that's why it is broken. Here is a quick fix to PerlMonks/Chat.pm and PerlMonks/Users.pm, which simply replaces that parsing part with XML::Simple's XMLin().

--- Chat.pm-old Tue Sep 24 17:45:12 2002
+++ Chat.pm Tue Sep 24 17:32:07 2002
@@ -11,6 +11,7 @@
 use strict;
 use vars qw(@ISA);
 use HTML::Entities;
+use XML::Simple;
 use PerlMonks;
 use PerlMonks::NewestNodes;
 
@@ -58,7 +59,15 @@
   # Get general chat messages
   if ($c=$self->getpage(CHAT_URL)) {
     $c=~s/[\r\n\t]//g;
-    my @msgs=($c=~/message\s+author="([^\"]+)"[^>]+>\s*(.*?)\s*<\/mes
+sage>/g);
+
+   # problematic
+    # my @msgs=($c=~/message\s+author="([^\"]+)"[^>]+>\s*(.*?)\s*<\/m
+essage>/g);
+
+   my $msgs = XMLin($c, forcearray => 1)->{message};
+
+   my @msgs = map { $_->{author} => $_->{content} }
+       sort { $a->{time} <=> $b->{time} } $msgs ? @$msgs : ();
+
     if (@msgs) {
       while (@msgs) {
    my ($author, $msg)=(shift(@msgs),shift(@msgs));

--- Users.pm-old    Tue Sep 24 17:45:18 2002
+++ Users.pm    Tue Sep 24 17:37:28 2002
@@ -14,6 +14,7 @@
 
 use strict;
 use vars qw(@ISA);
+use XML::Simple;
 use PerlMonks;
 
 @ISA=qw(PerlMonks);
@@ -63,7 +64,13 @@
   my $self=shift;
   if ( (time() - $self->{cache_users_ts}) > USERS_REFRESH) {
     if (my $c=$self->getpage(USERS_URL)) {
-      my %users=($c=~/user\s+username="([^\"]+)"\s+user_id="(\d+)"/g)
+;
+
+       # problematic
+       # my %users=($c=~/user\s+username="([^\"]+)"\s+user_id="(\d+)"
+/g);
+
+       my $users = XMLin($c, forcearray => 1)->{user};
+       my %users = map { $_->{username} => $_->{user_id} } $users ? @
+$users : ();
+
       $self->{cache_users}=\%users;
       $self->{cache_users_ts}=time();
     }