Re: PerlMonks modules 2.0

[Steve_p]

I'm guessing this hasn't been working for a while. This helps to show why you shouldn't parse XML with regular expressions. The main change is that I'm using XML::Simple to parse the XML. These is another small bug fix with splice that causes some annoyance warnings.

--- PerlMonksChat/PerlMonksChat.pm      2000-09-02 17:15:15.000000000 
++0000
+++ PerlMonksChat.pm    2004-05-01 04:55:08.000000000 +0000
@@ -14,6 +14,7 @@
 use HTML::Entities;
 use HTTP::Cookies;
 use URI::Escape;
+use XML::Simple;

 #####################################################################
+#
 # Configuration section
@@ -157,10 +158,19 @@
   # 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);
+    my $chatter = XMLin($c);
+    my @msgs;
+    if($chatter->{message} && ref $chatter->{message} eq 'HASH') {
+        @msgs = ($chatter->{message});
+    } elsif($chatter->{message} && ref $chatter->{message} eq 'ARRAY'
+) {
+        @msgs = @{$chatter->{message}};
+    }
+
     if (@msgs) {
       while (@msgs) {
-       my ($author, $msg)=(shift(@msgs),shift(@msgs));
+        my $line = shift @msgs;
+       my $author = $line->{author};
+       my $msg = $line->{content};
         # Remove html tags
        $msg =~ s/<[^>]+?>//g;
        # Decode html entities
@@ -188,9 +198,18 @@
   if ($self->{cookie_jar}) {
     if ($c=$self->getpage(PRIVATE_URL)) {
       $c=~s/[\r\n\t]//g;
-      my @msgs=($c=~/message\s+message_id="(\d+)"\s+author="([^\"]+)"
+[^>]+>\s*(.*?)\s*<\/message>/g);
+      my $chatter = XMLin($c);
+      my @msgs;
+      if ($chatter->{message} && ref $chatter->{message} eq 'HASH') {
+          @msgs = ($chatter->{message});
+      } elsif($chatter->{message} && ref $chatter->{message} eq 'ARRA
+Y') {
+          @msgs = @{$chatter->{message}};
+      }
       while (@msgs) {
-       my ($mid, $author, $msg)=(shift(@msgs),shift(@msgs),shift(@msg
+s));
+        my $line = shift @msgs;
+       my $mid = $line->{message_id};
+       my $author = $line->{author};
+       my $msg = $line->{content};
         # Remove html tags
        $msg =~ s/<[^>]+?>//g;
        # Decode html entities
@@ -220,7 +239,10 @@
   # Add the new lines to the cache
   unshift @$cache, @newcache;
   # Trim the cache to the last 50 lines.
-  splice(@$cache, CACHE_LIMIT);
+  if (scalar @$cache >= CACHE_LIMIT) {
+      splice(@$cache, CACHE_LIMIT);
+  }
+
   # Return the lines that were just added to the cache
   return reverse @newcache;
 }
@@ -344,7 +366,18 @@
   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)
+;
+      my $chatter = XMLin($c);
+      my @users;
+      if($chatter->{user} && ref $chatter->{user} eq 'HASH') {
+          @users = ($chatter->{user});
+      } elsif($chatter->{user} && ref $chatter->{user} eq 'ARRAY') {
+          @users = @{$chatter->{user}};
+      }
+      my %users = ();
+      foreach my $user (@users) {
+          $users{$user->{username}} = $user->{user_id};
+         #=($c=~/user\s+username="([^\"]+)"\s+user_id="(\d+)"/g);
+      }
       $self->{cache_users}=\%users;
       $self->{cache_users_ts}=time();
     }
@@ -359,14 +392,11 @@
   my $self=shift;
   my $user;
   if (my $c=$self->getpage(XP_URL)) {
-    if ($c=~/foruser="([^\"]+)"/) {
-      $user=$1;
-    }
-    if ($c=~/<XP\s+([^>]+)>/) {
-      my %xp=($1=~/(\w+)="([^\"]+)"/g);
+      my $xpinfo = XMLin($c);
+      $user = $xpinfo->{INFO}->{foruser};
+      my %xp = %{$xpinfo->{XP}} if defined $xpinfo->{XP};
       $self->{cache_xp}=\%xp;
       $self->{cache_xp_ts}=time();
-    }
   }
   $self->{cache_xp}->{user}=$user if $user;
   return %{$self->{cache_xp}};