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}};