Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Re: PerlMonks modules 2.0

by Steve_p (Priest)
on May 01, 2004 at 04:56 UTC ( #349574=note: print w/ replies, xml ) Need Help??


in reply to PerlMonks modules 2.0

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


Comment on Re: PerlMonks modules 2.0
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://349574]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (13)
As of 2015-07-01 17:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (12 votes), past polls