infobot patch for karma

[Anno Siegel <anno4000@lublin.zrz.tu-berlin.de>]

The attached patch changes infobot's karma behavior in case
the string after "karma [for]" isn't found in %plusplus.

If the string is surrounded by /.../ or m/.../ this is stripped.
The remaining string is then quotemeta'd and used as a regular
expression against the keys in %plusplus.  The hits are summed
up and reported.

The idea is to enable people to query the combined karma of variants
of their nick.  Example:

karma /siv/
siv and |siv| have karma of 24

Notes:

This is currently implemented in myRoutines.pl, but shouldn't
be hard to transfer to Question.pl.

It makes use of the new-ish qr operator to compile regular
expressions.  If this is undesirable, the line

        my $pat = qr/\Q$in/;

can be replaced by

        my $pat = quotemeta $in; #untested

at a performace penalty.

Anno
diff -rc infobot-0.44.3/src/myRoutines.pl infobot-0.44.3.patch/src/myRoutines.pl
*** infobot-0.44.3/src/myRoutines.pl	Tue Oct 26 18:37:47 1999
--- infobot-0.44.3.patch/src/myRoutines.pl	Fri Dec 10 13:40:17 1999
***************
*** 8,14 ****
  
  sub myRoutines {
      # called after it decides if it's been addressed.
!     # you have access tothe global variables here, 
      # which is bad, but anyway.
  
      # you can return 'NOREPLY' if you want to stop
--- 8,14 ----
  
  sub myRoutines {
      # called after it decides if it's been addressed.
!     # you have access to the global variables here, 
      # which is bad, but anyway.
  
      # you can return 'NOREPLY' if you want to stop
***************
*** 55,63 ****
  	return $reply;
      }
  
      return '';	# do nothing and let the other routines have a go
      # Extras.pl is called next; look there for more complex examples.
  }
  
! 1;
  
--- 55,114 ----
  	return $reply;
      }
  
+     if ($param{'plusplus'}) {
+         my $in2 = $message;
+ 
+         if ($in2 =~ s/^(karma|score)\s+(for\s+)?//) {
+             return &do_karma( $in2);
+         }
+     }
+ 
+ 
      return '';	# do nothing and let the other routines have a go
      # Extras.pl is called next; look there for more complex examples.
  }
  
! sub do_karma {
!     my $in = shift;
!     $in = lc($in);
!     $in =~ s/\s+/ /g;
!     if ($in eq "me") {
!         $in = lc($who);
!     }
!     my ($karma, @hits) = 0;
!     if (defined($plusplus{$in}) ) {
!         $karma = $plusplus{$in};
!         push @hits, $in;
!     } else {
!         $in = $1 if $in =~ m{^m?/(.*)/\s*$};
!         my $pat = qr/\Q$in/;
!         foreach ( keys %plusplus ) {
!             if ( m/$pat/ ) {
!                 $karma += $plusplus{$_};
!                 push @hits, $_;
!             }
!         }
!     }
!     if ( @hits ) {
!         @hits = sort @hits;
!         if ( $karma ) {
!             $karma = "karma of $karma";
!         } else {
!             $karma = "neutral karma";
!         }
!         if ( @hits > 3 ) {
!             my $rest = @hits - 3;
!             return join(', ', @hits[0..2]) .
!                 " and $rest more have $karma";
!         } elsif ( @hits > 1 ) {
!             return join(', ', @hits[0..$#hits-1]) . 
!                 " and $hits[ -1] have $karma";
!         } else {
!             return "@hits has $karma";
!         }
!     } else {
!         return "$in has no karma";
!     }
! }
  
+ 1;