Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical

PerlMonks modules 2.0

by ZZamboni (Curate)
on Sep 05, 2000 at 10:35 UTC ( #31092=sourcecode: print w/ replies, xml ) Need Help??

Category: Chatterbox clients
Author/Contact Info Diego Zamboni (ZZamboni)
Description: The module formerly known as PerlMonksChat has gone through a major transformation. Because its functionality now includes much more than the chat part of PerlMonks, I have split it into several modules: PerlMonks (base module), PerlMonks::Chat (chat stuff), PerlMonks::Users (users and XP stuff) and PerlMonks::NewestNodes (a threaded interface to the Newest Nodes page).

The code is too large to post it here, so I'll point you to the web page instead.

There are a number of clients that use these modules. Check out my home node for the full list.


Code too large to include here. Please see:

Comment on PerlMonks modules 2.0
Re: PerlMonks modules 2.0
by wmono (Friar) on Feb 03, 2002 at 08:02 UTC

    It seems that these modules have stopped working, possibly due to the Perlmonks Server Move. I've patched it up hurridly, and it seems to work. Probably the Correct Solution is to change everything over to using the XML modules, but not only do I not have the time (or knowledge), but this isn't my code, so I'll stick to minimal patching. (Hope you don't mind this much, ZZamboni.)

    Update: tye has much better code on tye's scratchpad.

    diff -ru ./PerlMonks/ ./PerlMonks/ --- ./PerlMonks/ Fri Oct 27 15:47:21 2000 +++ ./PerlMonks/ Sat Feb 2 23:37:50 2002 @@ -58,7 +58,7 @@ # 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 @msgs=($c=~/message[^>]*\s+author="([^\"]+)"[^>]+>\s*(.*?)\s*< +\/message>/g); if (@msgs) { while (@msgs) { my ($author, $msg)=(shift(@msgs),shift(@msgs)); @@ -91,7 +91,8 @@ 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 @msgs=($c=~/message[^<]+message_id="(\d+)"[^>]+author="([^\" +]+)"[^>]+>\s*(.*?)\s*<\/message>/g) || + private_swap_order($c=~/message[^<]+author="([^\"]+)"[^>]+ +message_id="(\d+)"[^>]+>\s*(.*?)\s*<\/message>/g); while (@msgs) { my ($mid, $author, $msg)=(shift(@msgs),shift(@msgs),shift(@msg +s)); # Remove html tags @@ -276,6 +278,18 @@ my $substmode=shift; $self->getnewlines(undef,$substmode); return @{$self->{cache_msg}}; +} + + +sub private_swap_order { + my @out; + while (@_) { + my $one = shift; + my $two = shift; + my $three = shift; + push @out, ($two, $one, $three); + } + return @out; } 1; diff -ru ./PerlMonks/ ./PerlMonks/ --- ./PerlMonks/ Mon Sep 4 13:44:10 2000 +++ ./PerlMonks/ Sat Feb 2 23:39:42 2002 @@ -63,7 +63,8 @@ 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 %users=($c=~/user\s+username="([^\"]+)"\s+user_id="(\d+)"/g) + || + reverse($c=~/user\s+user_id="(\d+)"\s+username="([^\"]+)"/g +); $self->{cache_users}=\%users; $self->{cache_users_ts}=time(); }

      Actually, it isn't so much code...

      my $attr= qr/(\w+)="([^"]+)"/; my $attrs= /<message(\s+$attr)*>/; my %hash; while( $attrs =~ /$attr/g ) { $hash{$1}= $2; } $hash{user_id}...
      But {NULE} requested that I post it here.

              - tye (but my friends call me "Tye")
Re: PerlMonks modules 2.0
by elusion (Curate) on May 10, 2002 at 02:13 UTC
    Because of the somewhat buggy nature of these modules and the clients that use them, I feel this is a good place to advertise the not-very-well-known on-site framechat. It works well, and is definitely more reliable than the other clients.

    elusion :

Re: PerlMonks modules 2.0
by Joost (Canon) on Jul 31, 2002 at 12:09 UTC
    I've just patched these modules too (and in the process removed an ugly warning). It seems a bit smaller change than the patch above, so I'll just post it here.

    diff output:

    --- Sat Oct 28 00:47:21 2000 +++ /home/joost/opt/pmchat/PerlMonks/ Tue Jul 30 14:51:00 20 +02 @@ -58,7 +58,7 @@ # 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 @msgs=($c=~/<message[^>]+author="([^\"]+)"[^>]+>\s*(.*?)\s*<\/ +message>/g); if (@msgs) { while (@msgs) { my ($author, $msg)=(shift(@msgs),shift(@msgs)); @@ -161,7 +161,7 @@ # Add the new lines to the cache unshift @$cache, @newcache; # Trim the cache to the last 50 lines. - splice(@$cache, CACHE_LIMIT); + splice(@$cache, CACHE_LIMIT) if @$cache > CACHE_LIMIT; # Return the lines that were just added to the cache return reverse @newcache; } --- Mon Sep 4 22:44:10 2000 +++ /home/joost/opt/pmchat/PerlMonks/ Tue Jul 30 13:32:42 20 +02 @@ -63,7 +63,12 @@ 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 %users; + for ($c=~/<user[^>]+>/g) { + my ($name) = /username="([^\"]+)"/; + my ($id) = /user_id="(\d+)"/; + $users{$name}=$id; + } $self->{cache_users}=\%users; $self->{cache_users_ts}=time(); }
    Btw, as mentioned above these modules could really need some cleaning up. Any takers?
    -- Joost downtime n. The period during which a system is error-free and immune from user input.
      I would like to take over the maintenance of these modules. ZZamboni created a sourceforge project for them, where I donwloaded them and discovered that these don't work either.

      I /msg'd him to ask if he'd mind if I'd take over and put it on CPAN. But I haven't heard from him since. I use the modules for a client I'm writing myself. If I don't hear from him, I'll take the sources, apply the patches and put it on CPAN. Unless someone else objects with good reasons of course :)

      Jouke Visser, Perl 'Adept'
      Using Perl to help the disabled: pVoice and pStory
(ZZamboni: Keep PerlMonks modules alive?) Re: PerlMonks modules 2.0
by ZZamboni (Curate) on Aug 20, 2002 at 16:20 UTC

    Today I finally gathered the willpower to put everything related to the PerlMonks modules on the sourceforge project that I created for them a looong time ago. I have also moved the web page there.

    But now I have a more fundamental question. Regrettably, I have been essentially absent from PerlMonks for a long time, and it seems that a lot of things have changed, technically speaking. The modules in their current form no longer work, and I have tons of chatbox messages and patches that people have sent me about this (to all of them: thank you!). On the other hand, the on-site chat page mentioned above by elusion seems to work perfectly.

    So my question is: is it worth spending the effort to upgrade and clean up the PerlMonks modules to keep them current to the times, or should we just let them die? Are people still interested in using them? If this is the case, I will start working on fixing things. A few fundamental changes are necessary, including:

    • Using some XML-parsing module instead of the hand-coded cruft I got there now.
    • Using the new displaytype=xml nodes.
    • Anything else I have missed.
    Now that the CVS is available on sourceforge, it should be easier for people to submit patches. Certainly, if anyone shows enough interest, I'd be happy to give them access as developers to the CVS repository :-)

    Any thoughts?



      Personally, I'm not sure there's that big a need. Using LWP::UserAgent and XML::Simple I cooked up a chatterbox client in an hour. Now that we have tickers for just about anything you might want one for as well as displaytype=xml, I think what's rather needed is thourough, centralized documentation of these. Currently, information about the tickers is randomly scattered throughout the site and can only be found via judicious use of Google and Super Search. I'm currently working on collecting nodes with info about the tickers and want to write some overview documentation from them, to put on my homenode (or maybe I'll ask for some space on jcwren's server).

      That said, I did refactor some of my simple client's code into a tiny module..

      Makeshifts last the longest.

        What XML generators are currently available on PerlMonks? has basic documentation on the tickers. It isnt exhaustive but it is closes thing to the documentation you mention needing. (I'm guessing you probably know this already, but I felt the link belonged in this thread.)


          First they ignore you, then they laugh at you, then they fight you, then you win.
          -- Gandhi

      I tried to use the Shendal's Tk Chatterbox client (on WinXP), but between the client and your Chat modules something seemed to be broken. Am I right in thinking that CB went from using HTML to using XML, and did not follow?

      I'd like to help one way or another to bring back to life a Tk CB client. Please /msg me if you wish to discuss it.


      I am quite happily using a patched version of the modules together with the Perl/Tk chatterbox client, and I would like to see them continued (or at least I would like a replacement that is a bit cleaner).

      By the way: there is some other part you missed in your changes, and that converting the documentation to POD, including all the usual parts that we expect from perl module documentation: NAME SYNOPSIS DESCRIPTION etc etc.

      -- Joost downtime n. The period during which a system is error-free and immune from user input.
      I don't know if it's a good addition, but you might consider adding PerlMonks::StatsWhore into the bundle -- it's an amped up version of some of jcwren's stuff.


Re: PerlMonks modules 2.0
by Steve_p (Priest) on May 01, 2004 at 04:56 UTC

    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/ 2000-09-02 17:15:15.000000000 ++0000 +++ 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}};

Back to Code Catacombs

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (5)
As of 2014-09-18 11:07 GMT
Find Nodes?
    Voting Booth?

    How do you remember the number of days in each month?

    Results (111 votes), past polls