###################################################################

# Copyright (c) 2004 Alan W. Mahoney. All rights reserved.
# This program is free software.  You may modify and/or
# distribute it under the same terms as Perl itself.
# This copyright notice must remain attached to the file.
#

# Fnord7's The Kingdom of Loathing (www.kingdomofloathing.com) chat bot
#
# eP2 indicates bulk contributions from ePeterso2 (he's contributed in so
# many small ways it's impossible to list them all)

package KoLBot;

use warnings;
use strict;

use POSIX qw( floor );

use KoLBot::KMail;
use Time::Local;
use HTTP::Cookies::Netscape;

use Carp;

use Digest::MD5 qw(md5_hex);
use Digest::HMAC_MD5 qw(hmac_md5_hex);

BEGIN
{
  use Exporter ();
  our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $ID);

  $VERSION     = 0.5;
  $ID          = '$Id: KoLBot.pm 174 2006-11-22 13:59:03Z alan $';

  @ISA         = qw(Exporter);
  @EXPORT      = qw( koltime kmailtime next_rollover);
  %EXPORT_TAGS = ( );

  @EXPORT_OK   = qw();
}

our @EXPORT_OK;
our ($VERSION,$ID);

use LWP;
use LWP::UserAgent;

use KoLBot::ChatMessage;

##########################################
## element access
##########################################

for my $field (qw( config
		   ua
		   time
		   lasttime
		   items
		   recipes
		   url
		   url_i
		   drunk
		   hash
		   )) {
  no strict "refs";
  *$field = sub {
    my $self = shift;
    $self->{$field} = shift if @_;
    return $self->{$field};
  }
}

##########################################
## Constructor:
##########################################

# Needs to be called with a full config hashref.  See examples.

sub new {
  my $invocant = shift;
  my $class = ref($invocant) || $invocant;
  my $bot = { url_i => 0,
	      drunk => 0,
	      @_ };

  exists($bot->{config}) or die "KoLBot NEEDS a config passed";
  $bot->{config}->{agent} ||= "KoLBot.pm/$VERSION";
#  $bot->{config}->{cookie_file} ||= 'cookies.txt';# GAH
  ref($bot->{config}->{site}) eq 'ARRAY' 
    or $bot->{config}->{site} = [$bot->{config}->{site}];
  $bot->{config}->{timeout} ||= 30;
  $bot->{config}->{timeout_login} ||= 180;
  $bot->{url} = $bot->{config}->{site}->[0];

  $bot->{ua} = LWP::UserAgent->new(agent => $bot->{config}->{agent});
  $bot->{ua}->timeout($bot->{config}->{timeout});

  push @{ $bot->{ua}->requests_redirectable }, 'POST';

  my $cookie_jar;
  if(exists($bot->{config}->{cookie_file})) {
    $cookie_jar = HTTP::Cookies::Netscape->new(
			       file => $bot->{config}->{cookie_file},
					       ignore_discard => 1);
    $cookie_jar->load();
  } else {
    $cookie_jar = {};
  }
 
  $bot->{ua}->cookie_jar($cookie_jar);
  if(exists($bot->{config}->{headers})) {
    $bot->{ua}->default_header(@{$bot->{config}->{headers}});
  }

  bless $bot, $class;
}

##########################################
## The rest
##########################################

sub login {
  my $bot = shift;
  my %params = @_;

  if($bot->{config}->{login_old}) {
    return $bot->login_old(%params);
  }

  return $bot->login_secure(%params);
}

# combines old get_pwd and login scripts.  Attempts to be robust.
sub login_old {
  my $bot = shift;
  my %params = @_;

GET_PWD:
{
  # check whether we are logged in
  print "login: getting lchat " . $bot->url . "\n";
  $bot->ua->timeout($bot->config->{timeout});
  my $url = $bot->url . 'lchat.php';
  my $response = $bot->ua->get($url);

  unless($response->is_success) {
    print "login: lchat HTTP error " . $response->status_line . "\n";
    sleep ($bot->{config}->{timeout})
      unless $response->status_line =~ /^500/; # 500 is timeout.
    redo GET_PWD;
  }

  if($response->content =~ /pwd=([a-f0-9]+)\&/) {
    $bot->{hash} = $1;
    $bot->fix_cookies();    
    return;
  }

  unless ($response->content =~ m{<b><font size=\+2>The Kingdom of Loathing</font></b>}) {
    print "login: lchat content error, " . $response->content . "\n";
    sleep ($bot->{config}->{timeout_login});
    redo GET_PWD;
  }

  # We're not logged into the server in our URL.  Try logging in,
  # there might be a redirect coming.

  # NEVER LOG IN WITHOUT GETTING "not logged in" first.
  # otherwise we might have to end up waiting 15 minutes.

  my $name = $bot->config->{user};
  $name .= '/q'
    if $bot->config->{login_quiet};

  $url = $bot->url . 'login.php';
  print "login: login " . $bot->{url} . " " . $name . "\n";
  $bot->ua->timeout($bot->config->{timeout_login});
  $response = $bot->ua->post($url,
			     [ loggingin => 'Yup.',
			       loginname => $name,
			       password  => $bot->config->{password},
			       ],
			     );
  $bot->ua->timeout($bot->config->{timeout});

  unless($response->is_success) {
    print "login: login HTTP error " . $response->status_line . "\n";
    sleep ($bot->{config}->{timeout_login})
      unless $response->status_line =~ /^500/; # 500 is timeout.
    redo GET_PWD;
  }

  if($response->content =~ /<frame name=charpane src="charpane.php">/) {
    # we're logged in: get pwd.
    redo GET_PWD;
  }

  if($response->content =~ m|<b>Nightly Maintenance...</b>|) {
    print "login: Nightly maintenance.  Waiting.\n";
    sleep($bot->{config}->{timeout_login});
    redo GET_PWD;
  }

  # OUCH
  if($response->content =~ m|Please wait fifteen minutes and try again.|) {
    print "login: Darn 15 minute rule\n";
    sleep(15*60 + 10);
    redo GET_PWD;
  }

  if($response->content =~ m|Redirecting to (www\d?)\.|) {
    die "Would redirect to $1, but can't."
      if exists($bot->{config}->{block_login_redirect});
    print "login: Redirecting to $1\n";
    $bot->{url} ='http://' . $1 . '.kingdomofloathing.com/';
    redo GET_PWD;
  }

  if($response->content =~ m|Please wait a minute|) {
    print "login: One minute wait before logging in again\n";
    sleep(61);
    redo GET_PWD;
  }

  print "login: login content unknown ", $response->content,"\n";
  sleep($bot->{config}->{timeout_login});
  redo GET_PWD;}
}

# secured login
sub login_secure {
  my $bot = shift;
  my %params = @_;


  my $redirect;
GET_PWD:
{
  # check whether we are logged in
  print "login: getting charpane " . $bot->url . "\n";
  my $resp;
  eval {
    $resp = $bot->charpane();
  };

  unless ($@ =~ /^NOTLOGGEDIN/) {
    if($@ ne '') {
      print "login: charpane error: " . $@ . "\n";

      sleep ($bot->{config}->{timeout})
	unless $@ =~ /500/;
      redo GET_PWD; # 500 is timeout
    }

    if(lc($resp->{name}) eq lc($bot->config->{user})) {
      $bot->{hash} = $resp->{pwd};
      return;
    }
  
    die $resp->{name} . " is already logged in on " . $bot->{url}
      . " with cookie file " . $bot->config->{cookie_file};
  }

  # We're not logged into the server in our URL.  Try logging in,
  # there might be a redirect coming.

  # NEVER LOG IN WITHOUT GETTING "not logged in" first.
  # otherwise we might have to end up waiting 15 minutes.

  print "Get a challenge, login.php\n";
  my $url = $bot->url . 'login.php';
  $bot->ua->timeout($bot->config->{timeout_login});
  my $response = $bot->ua->get($url);
  $bot->ua->timeout($bot->config->{timeout});

  unless($response->is_success) {
    print "login: challenge HTTP error " . $response->status_line . "\n";
    sleep ($bot->{config}->{timeout_login})
      unless $response->status_line =~ /^500/; # 500 is timeout.
    redo GET_PWD;
  }

  if($response->content =~ m|<b>Nightly Maintenance...</b>|) {
    print "login: Nightly maintenance.  Waiting.\n";
    $bot->{rollover} = 1;
    sleep($bot->{config}->{timeout_login});
    redo GET_PWD;
  }

  redo GET_PWD 
    unless $response->content =~ m|<input type=hidden name=challenge value="([0-9a-f]+)">|; # Get challenge

  # compute a response
  
  my $challenge = $1;
#   my $rsp = hmac_md5_hex($challenge,md5_hex($bot->config->{password}));
  my $rsp = md5_hex(md5_hex($bot->config->{password}) . ':' . $challenge);

  print "C, r: ",$challenge," ",$rsp,"\n";

  # login

  my $name = $bot->config->{user};
  $name .= '/q'
    if $bot->config->{login_quiet};

  $url = $bot->url . 'login.php';
  print "login: login " . $bot->{url} . " " . $name . "\n";
  $bot->ua->timeout($bot->config->{timeout_login});
  if(defined($redirect)) {
    print "GETTING\n";
    $response = $bot->ua->get($redirect);
    undef $redirect;
  } else {
    print "POSTING\n";

    my @args = (loggingin => 'Yup.',
		secure    => 1,
		loginname => $name,
		challenge => $challenge,
		response  => $rsp,
		password  => '',
		);

    # we want to see and follow the redirects ourself.
    @{$bot->{ua}->requests_redirectable} = ('GET','HEAD');
    $response = $bot->ua->post($url,\@args);
    push @{ $bot->{ua}->requests_redirectable }, 'POST';
  }

  $bot->ua->timeout($bot->config->{timeout});
  # fix redirects so we don't forget

  unless($response->is_success) {
    if($response->status_line =~ /^302/) { # Found, there's a redirect.
      $redirect = $response->headers->{location};
      unless($redirect =~ m|(www\d?)\.|) {
	if($redirect eq 'main.html') { # We did log in
	  undef $redirect;
	  redo GET_PWD;
	}
	print "login_secure: All kinds of bad things.  We got a redirect, but where?\n";
	print "  location header is $redirect .\n";
	undef $redirect;
	sleep (180);
	redo GET_PWD;		# Hope it fixes itself
      }

      $bot->{url} ='http://' . $1 . '.kingdomofloathing.com/';
      print "login: Redirecting to $1\n";
      die "no redirect" if $bot->config->{no_redirect};
      redo GET_PWD;
    }

    print "login: login HTTP error " . $response->status_line . "\n";
    sleep ($bot->{config}->{timeout_login})
      unless $response->status_line =~ /^500/; # 500 is timeout.
    redo GET_PWD;
  }

  if($response->content =~ /<frame name=charpane src="charpane.php">/) {
    # we're logged in: get pwd.
    redo GET_PWD;
  }

  if($response->content =~ m|<b>Nightly Maintenance...</b>|) {
    print "login: Nightly maintenance.  Waiting.\n";
    $bot->{rollover} = 1;
    sleep($bot->{config}->{timeout_login});
    redo GET_PWD;
  }

  # OUCH
  if($response->content =~ m|You may try again in 15 minutes\.|
     ||
     $response->content =~ m|Please wait fifteen minutes and try again\.|) {
    print "login: Darn 15 minute rule\n";
    sleep(15*60 + 10);
    redo GET_PWD;
  }

#   if($response->content =~ m|Redirecting to (www\d?)\.|) {
#     die "Would redirect to $1, but can't."
#       if exists($bot->{config}->{block_login_redirect});
#     print "login: Redirecting to $1\n";
#     $bot->{url} ='http://' . $1 . '.kingdomofloathing.com/';
#     redo GET_PWD;
#   }

  if($response->content =~ m|Please wait a minute|) {
    print "login: One minute wait before logging in again\n";
    sleep(61);
    redo GET_PWD;
  }

  if($response->content =~ m|<b>Login failed.\s+Bad password.</b>|) {
    print "login: bad password, waiting 15 minutes to keep IP safe\n";
    sleep (15*60+10);
    redo GET_PWD;
  }

  if($response->content =~ m|<center><b><font size=\+2>The Kingdom of Loathing</font></b><br>|) {
    print "login: got main page? Grr.\n";
    redo GET_PWD;
  }

  print "login: login content unknown ", $response->content,"\n";
  sleep($bot->{config}->{timeout_login});
  redo GET_PWD;}
}

sub fix_cookies {
  my $bot = shift;

  my $s = $bot->ua->cookie_jar->as_string();
#  my @ss = split(/\n/,$s);
  my @ss = split(/^/,$s);
  for(@ss) {
    next unless /PHPSESSID=(.*?);.*(www\d?|dev).(kingdomofloathing|loathing2).com/i;
    my $key = 'PHPSESSID';
    my $val = $1;
    my $path = '/';
    my $domain = $2.'.'.$3.'.com';
    my $version = 0;
    my $path_spec = 1;
    my $maxage = 147368433;
    my ($port,$secure,$discard);
    $bot->ua->cookie_jar->set_cookie($version,$key,$val,$path,$domain,$port,
				     $path_spec,$secure,$maxage,$discard);
  }

  $bot->ua->cookie_jar->save();
}

sub rotate {
  my $bot = shift;

  my $t = shift @{$bot->config->{site}};
  push @{$bot->config->{site}},$t;
  $bot->{url} = $bot->config->{site}->[0];
}

sub get_pwd {
  my $bot = shift;

  my $resp = $bot->charpane();

  $bot->{hash} = $resp->{pwd};
}


sub netscape_cookie {
  my $bot = shift;

  # now, set the cookies to not be deleted, so we can use them with mozilla.
  my $s = $bot->ua->cookie_jar->as_string();
  my @ss = split(/^/,$s);
  for(@ss) {
    next unless /PHPSESSID=(.*?);.*(www\d?|dev).(kingdomofloathing|loathing2).com/;
    next unless  'http://' . $2.'.'.$3.'.com/' eq $bot->url;
    my $key = 'PHPSESSID';
    my $val = $1;
    my $domain = $2.'.'.$3.'.com';
    my $exptime = 1242859979;
    return "$domain\tFALSE\t/\tFALSE\t$exptime\tPHPSESSID\t$val";
  }
  return undef;
}

sub logout {
  my $bot = shift;

  my $url = $bot->url . 'logout.php';
  my $response = $bot->ua->head($url);

  $response->is_success or die "HTTP "
    . $response->status_line;
}

sub check_response {
  my $bot = shift;
  my $response = shift;
  my $from = shift || '';

  $response->is_success or die "HTTP " . $response->status_line;

  # Matches on the login page, but not ours
  if($response->content =~ m|<title>The Kingdom of Loathing</title>|) {
    die 'ROLLOVER' if $response->content =~ m|<b>Nightly Maintenance...</b>|;
    die 'NOTLOGGEDIN';
  }

  # not really
  die 'DBSERVERDOWN Too many'
    if $response->content =~ m|mysql_connect\(\): Too many connections|;
}

#
# this works best with reading, or as a big wraparound
#
sub ensure {
  my $bot = shift;
  my $fcn = shift;

  while(1) {
    my @rv1 = eval {
      &$fcn;
    };

    return @rv1 unless $@ ne '';

    warn "ensure: exception $@\n";

    redo if($@ =~ /^HTTP/);

    if($@ =~/^NOTLOGGEDIN|^ROLLOVER/) {
      $bot->login();
      redo;
    }
    
    sleep ($bot->{config}->{timeout} || 180);
    # Might be a local problem, possibly DB.
    &{$bot->{local_reset}}($bot,$@) if exists($bot->{local_reset});
    redo;
  }
}

########################################################################
# Chat interfaces
########################################################################

sub enter_chat {
  my $bot = shift;

  my $url = $bot->url . 'lchat.php';
  my $response = $bot->ua->head($url);

  $response->is_success or die "HTTP "
    . $response->status_line;
}

## AWM: this will rollover far too often, {time} isn't well set without
## Chatbot.pm
sub get_chat {
  my $bot = shift;

  my $messages = [];

  $bot->{time} ||= 0;
  if($bot->{time} < $bot->{lasttime}) {
    &{$bot->{rollover_fcn}}($bot) if exists($bot->{rollover_fcn});
    $bot->{time} = 0;
  }

  $bot->{lasttime} = $bot->{time};

KLUDGE:

  my $url = $bot->url . 'newchatmessages.php?lasttime='
    . ($bot->lasttime || 0);
  my $response = $bot->ua->get($url);

  $response->is_success or die "HTTP "
    . $response->status_line;

  my $content = $response->content;

    goto KLUDGE
      if ($content =~/Could not open game database/);

  if ($content eq '') {
    die "NOTLOGGEDIN";
  }

  $bot->check_response($response,'get_chat');

  $content =~ s/class=nounder//g;
  $content =~ s/\s+/ /g;

  # first fix for red ban messages---keep all code on one line
  $content =~ s/<br><\/b><\/font>/<br>/g;
  # with orange ones need this too
  $content =~ s/<br><\/font>/<br>/g;
  $content =~ s/<br \/>//g;
  $content =~ s/&quot;/\"/g;
# move these to after pattern matching to isolate HTML
#  $content =~ s/&lt;/</g;
#  $content =~ s/&gt;/>/g;
#  $content =~ s/\&amp;/\&/g;

  my @lines = split /<br>/i,$content;

  my $l = pop @lines;


  unless ($l =~ /<!--lastseen:(\d+)-->/) {

    print " content = " . $content . "\n";
#    . "\n\$l = $l\n";
    die " Should be a timestamp here!"
  }

  $bot->{time} = $1;

  while (@lines) {
    $_ = shift (@lines);
    my $message = new KoLBot::ChatMessage(
					  channel => '',
					  message => '',
					  type    => 'none',
					  user    => '',
					  user_id => 0,
					  );

    # pname and a_user are a little loose, but I don't think that
    # devious user names could fool them.

    # This is really messy.  What do pros do here?
    my $a = '<a.*?>';
    my $b = '<b>';
    my $i = '<i>';
    my $e_b = '<\/b>';
    my $e_a = '<\/a>';
    my $e_f = '<\/font>';
    my $e_i = '<\/i>';
    my $pname = '\w[\w\ \d_]{0,28}\w';
    my $f_color = '<font color="?(\w+)"?>';
    my $f_green = '<font color="?green"?>';
    my $f_blue = '<font color="?blue"?>';
    my $f_red = '<font color="?red"?>';
    my $f_black = '<font color="?black"?>';
    my $f_blueviolet = '<font color="?blueviolet"?>';
    my $f_orange = '<font color="?orange"?>';
    my $f_none = '<font color=\"none\">';
    my $f = '<font.*?>';
    my $channel = '\[(\w+)\]';
    my $a_user_a = '<a target=mainpane href=\"?\'?showplayer.php\?who=(-?\d+)\"?\'?[^>]*>';
    my $a_user_a1 = '<a href=\"?\'?showplayer.php\?who=(-?\d+)\"?\'?[^>]*>';
    my $a_read = '<a target=mainpane href=\"messages.php\">';
    my $a_read1 = '<a href=\'messages.php\'  target=mainpane>';


    my $a_offer = '<a target=mainpane\ href=\"makeoffer.php\">';
    my $private = '\ \(private\):';
    my $a_bet = '<a target=mainpane\ href=\'?\"?bet.php\'?\"?>';
#    my $a_bet_nounder = "<a href='bet.php' target=mainpane class=nounder>";
    my $a_clan_hall = '<a target=mainpane\ href=\"clan_hall.php\">';
    my $mwarn = 'Mod Warning';
    my $mannounce = 'Mod Announcement';
    my $smsg = 'System Message';
    my $msfm   = 'New message received from ';
    my $smbuff = '(.*) has been conjured around you by ';
    my $atbuff = 'has played a song \((.*)\) for you\.';
    my $ttbuff = 'has (imbued|fortified|given) you (with|the) (.*)\.';
    my $bet_to_hagnks = "(, which was delivered to Hagnk's)?";
 
    ## Convert clan buff name to stat name
    my %clanbuff2stat = (
			 'Enraged'               => 'Muscle',
			 'Ancestral Disapproval' => 'Mysticality',
			 'Whitened Teeth'        => 'Moxie',
			 );
    ## Convert substat name to stat name
    my %substat2stat = (
			'Beefiness'         => 'Muscle',
			'Fortitude'         => 'Muscle',
			'Muscleboundedness' => 'Muscle',
			'Strengthliness'    => 'Muscle',
			'Strongness'        => 'Muscle',
			
			'Enchantedness'     => 'Mysticality',
			'Magicalness'       => 'Mysticality',
			'Wizardliness'      => 'Mysticality',
			'Mysteriousness'    => 'Mysticality',
			
			'Smarm'             => 'Moxie',
			'Chutzpah'          => 'Moxie',
			'Sarcasm'           => 'Moxie',
			'Roguishness'       => 'Moxie',
			'Cheek'             => 'Moxie',
			);

    if (/$f_green$channel$e_f/) {
      $message->{channel} = $1;
      s/$f_green$channel$e_f//;
    }

    if (/who=(\d+)\'>$f_green$b($pname)$e_b$e_f$e_a\ logged\ on.$e_f$/) {
      $message->{user_id} = $1;
      $message->{user} = $2;
      $message->{type} = 'logon';
      $message->{message} = '';
    } elsif (/^($f$e_f)? ?$b$a_user_a$f_black($pname)$e_f$e_b$e_a:\ (.*)/s) {
      $message->{user_id} = $2;
      $message->{user} = $3;
      $message->{type} = 'normal';
      $message->{message} = $4;
      $message->{channel} ||= $bot->config->{channel};
    } elsif (/^($f$e_f)? ?$f$e_f$b$a_user_a($pname)$e_b$e_a:\ (.*)/s) {
      $message->{user_id} = $2;
      $message->{user} = $3;
      $message->{type} = 'normal';
      $message->{message} = $4;
      $message->{channel} ||= $bot->config->{channel};
    } elsif (/^($f$e_f)? ?$b$i$a_user_a$f_color($pname)$e_b$e_f$e_a(\ (.*)$e_i)?/s) {
      $message->{color} = $3;
      $message->{user_id} = $2;
      $message->{user} = $4;
      $message->{type} = 'emote';
      $message->{message} = $6;
      $message->{channel} ||= $bot->config->{channel};
    } elsif (/^ ?$a_user_a$f_blue$b($pname)$private$e_b$e_a\ (.*)$e_f$/s) {
      $message->{user_id} = $1;
      $message->{user} = $2;
      $message->{type} = 'private';
      $message->{message} = $3;
    } elsif (/^ ?$b$a_user_a$f_color($pname)$e_f$e_b$e_a:\ (.*)/s) {
      # Normal message from Mr Skullhead/Jick
      $message->{user_id} = $1;
      $message->{color} = $2;
      $message->{user} = $3;
      $message->{type} = 'normal';
      $message->{message} = $4;
      $message->{channel} ||= $bot->config->{channel};
    } elsif (/^ ?$f_red ?$b$a_user_a$f_red$mwarn$e_f$e_b$e_a:\ +($pname)\ has been banned from the chat \((.*)\)/) {
      $message->{user_id} = $1;	# Who banned, number
      $message->{type} = 'ban';
      $message->{message} = "$2 ($3)"; # Who was banned, how long
      $message->{channel} ||= $bot->config->{channel},
    } elsif (/^ ?$f_red ?$b$a_user_a$f_red$mwarn$e_f$e_b$e_a:(.*)/) {
      $message->{user_id} = $1;	# Who banned, number
      $message->{type} = 'modwarning';
      $message->{message} = $2; # message
      $message->{channel} ||= $bot->config->{channel};
    } elsif (/^ ?$f_green ?$b$a_user_a$f_green$mannounce$e_f$e_b$e_a:(.*)/) {
      $message->{user_id} = $1;	# Who banned, number
      $message->{type} = 'modannounce';
      $message->{message} = $2; # message
      $message->{channel} ||= $bot->config->{channel};
    } elsif (/^ ?$f_red$b$b$a_user_a$f_red$smsg$e_f$e_b$e_a:\ (.*)/s) {
      $message->{user_id} = $1; # ID , not name
      $message->{type} = 'sysmessage';
      $message->{message} = $2;
      $message->{channel} ||= $bot->config->{channel};
    } elsif (/^ ?$a_read$f_green$msfm$a_user_a$f_green($pname)$e_f$e_a\./) {
      $message->{user_id} = $1;
      $message->{user} = $2;
      $message->{type} = 'kmail';
      $message->{message} = '';
    } elsif (/^ ?$f_green$smbuff$a_user_a$b$f_green($pname)$e_f$e_b$e_a$e_f/) {
      $message->{message} = $1;
      $message->{user_id} = $2;
      $message->{user} = $3;
      $message->{message} =~ s/&ntilde;/n/;
      $message->{type} = 'buff';
    } elsif (/^ ?$f_green$a_user_a$b$f_green($pname)$e_f$e_b$e_a $atbuff$e_f/) {
      $message->{user_id} = $1;
      $message->{user}    = $2;
      $message->{message} = $3;
      $message->{type} = 'buff';
    } elsif (/^ ?$f_green$a_user_a$b$f_green($pname)$e_f$e_b$e_a $ttbuff$e_f/) {
      $message->{user_id} = $1;
      $message->{user}    = $2;
      $message->{message} = $5;
      $message->{type} = 'buff';
    } elsif (/^ ?$a_offer$f_green($pname) has cancelled a trade offer to you.$e_f$e_a/) {
      $message->{message} = "";
      $message->{type} = 'offer_cancelled';
      $message->{user} = $1;
    } elsif (/^ ?$a_offer$f_green($pname) has offered to sell you (\d+) of item (.+) for (\d+) Meat.$e_f$e_a/) {
      $message->{message} = "$2\@$3 for $4 ";
      $message->{type} = 'offer';
      $message->{user} = $1;
    } elsif (/^ ?$a_offer$f_green($pname) has proposed a trade offer to you.$e_f$e_a/) {
      $message->{message} = "$2\@$3 for $4 ";
      $message->{type} = 'offer';
      $message->{user} = $1;
    } elsif (/^ ?$f_green$a_user_a$f_green$b($pname)$e_b$e_f$e_a logged off\.$e_f/) {
      $message->{message} = "";
      $message->{user_id} = $1;
      $message->{user} = $2;
      $message->{type} = 'logged_off';
    } elsif (/^ ?$f_green$a_user_a$b$f_green($pname)$e_f$e_b$e_a has bestowed the Smile of Mr\. A\. on you\.$e_f/) {
#      $message->{user_id} = $1;
      $message->{user} = $2;
      $message->{type} = 'mister_a';
      $message->{message} = "The Smile of Mister A";
    } elsif (/^ ?${f_green}$a_user_a$a_bet$b$f_green(.*)$e_f$e_b$e_a took your (.*) Meat bet, and you won, earning you (.*) Meat$bet_to_hagnks\./) {
      $message->{user} = $2;
      $message->{user_id} = $1;
      $message->{type} = 'betwon';
      $message->{message} = join (" ", $3, $4, $5 ? 'hagnk' : 'inv');
    } elsif (/^ ?${f_green}$a_user_a$a_bet$b$f_green(.*)$e_f$e_b$e_a took your (.*) Meat bet, and you ${f_red}lost\.$e_f Better luck next time\.$e_a$e_f/) {
      $message->{user} = $2;
      $message->{user_id} = $1;
      $message->{type} = 'betlost';
      $message->{message} = $3;
    } elsif (/^ ?${f_green}You gained (\d+) adventures\' worth of an effect \((.*)\) from a clan purchase\.$e_f$/) {
      $message->{type} = 'clanbuff';
      $message->{user} = '';
      $message->{user_id} = -1;
      $message->{message} = "$1 $2";
    } elsif (/^ ?$a_clan_hall${f_green}A new announcement has been posted in your Clan Hall\.$e_f$e_a$/) {
      $message->{type} = 'clanannounce';
      $message->{user} = '';
      $message->{user_id} = -1;
      $message->{message} = 'A new announcement has been posted in your Clan Hall.';
    } elsif (/^ ?${f_green}You gained (\d+) (.*) from a clan purchase\.$e_f$/) {
      $message->{type} = 'clanstat';
      $message->{user} = '';
      $message->{user_id} = -1;
      $message->{message} = "$1 $2";
    } elsif (/^ ?${f_green}You have been granted leadership of your clan\.$e_f$/) {
      $message->{type} = 'clanleader';
      $message->{user} = '';
      $message->{user_id} = -1;
      $message->{message} = "";
    } elsif (/^ ?${f_green}(.*) has used a WANG on you<!--refresh-->$e_f$/) {
      $message->{type} = 'wanged';
      $message->{user} = $1;
      $message->{message} = "";
    } elsif (/^$a$f_green$a_user_a1$f_green($pname)$e_f$e_a $a${f_green}has busted out your (.*?) window pane with a brick.$e_f$e_a$e_f$e_a$/) {
      $message->{type} = 'brick';
      $message->{user_id} = $1;
      $message->{user}    = $2;
      $message->{message} = "";

#     my $a_user_a = '<a target=mainpane href=\"?\'?showplayer.php\?who=(-?\d+)\"?\'?>';
#    my $a_user_a1 = '<a href=\"?\'?showplayer.php\?who=(-?\d+)\"?\'? target=mainpane[^>]*>';

    } elsif (/^$f_green$a_user_a1$f_green($pname)$e_f$e_a.*toilet paper/i) {
      $message->{type} = 'toilet_paper';
      $message->{user_id} = $1;
      $message->{user}    = $2;
      $message->{message} = "";
    } elsif (/^$f_green$a_user_a1($pname)$e_a has hit you in the face with a cream pie/i) {
      $message->{type} = 'cream_pie';
      $message->{user_id} = $1;
      $message->{user}    = $2;
      $message->{message} = "";
    } elsif (@{$messages} && /<i>.*<\/i>$/ ) {
      ## If there is a previous message in the queue
      ## And this appears to be gothy, tack on
      $messages->[-1]->{message} .= "<br>" . $_;
      next;
    } elsif (@{$messages} && /^\&nbsp;/) {
      ## If there is a previous message in the queue
      ## And this appears to be gothy, tack on
      $messages->[-1]->{message} .= "<br>" . $_;
      next;
    } elsif (@{$messages} && $messages->[-1]->{channel} eq 'haiku'
	     && /^[^<]*<a.*?><font color=blue>\[link\]$e_f$e_a[^<]+$/) {
      ## If there is a previous haiku channel in the queue
      ## And this appears to be no message, tack on
      $messages->[-1]->{message} .= "<br>" . $_;
      next;
    } elsif (@{$messages} && $messages->[-1]->{channel} eq 'haiku'
	     && !/</) {
      ## If there is a previous haiku channel in the queue
      ## And this appears to be no message, tack on
      $messages->[-1]->{message} .= "<br>" . $_;
      next;
    } elsif (@{$messages} && $messages->[-1]->{channel} eq 'haiku'
	     && $messages->[-1]->{type} eq 'emote'
	     && m|</i>$|) {
      ## If there is a previous haiku channel in the queue
      ## And this appears to be no message, tack on
      s|</i>$||;
      $messages->[-1]->{message} .= "<br>" . $_;
      next;
    } elsif (@{$messages} && $messages->[-1]->{user_id} == 7007) {
      ## Toot Oriole can speak in haiku anywhere
      $messages->[-1]->{message} .= "<br>" . $_;
      next;
    } else {
      warn "Couldn't find the goods in this line!\n"
	. "channel = " . $message->{channel} . "\n($_)\n";
      @$messages and warn "Last message = " . $messages->[-1] . "\n";
      next;
    }
    if(!defined($message->{message})) {
      warn "AWM DEBUG, !defined {message}";
      print $_,"\n";
    } else {
      $message->{message} =~ s/&lt;/</g;
      $message->{message} =~ s/&gt;/>/g;
      $message->{message} =~ s/\&amp;/\&/g;
    }
    push @$messages, $message;
  }
  return $messages;
}

sub scan_chat {
  my $bot = shift;

  while (1) {
    my $time = time();

    $bot->scan_hook_pre();		# Allows overriding in derived classes

    my $messages = $bot->get_chat();

    $bot->scan_hook_mid();		# Allows overriding in derived classes

    for(@$messages) {
      &{$bot->config->{process_message}}($bot,$_);
    }

    $bot->scan_hook_post();		# Allows overriding in derived classes

    my $del = $time - time() + ($bot->config->{delay} || 60);

    print "  del = $del\n" if ($del < 0);
    sleep($del) if ($del > 0);
  }
}

sub scan_hook_pre { };
sub scan_hook_mid { };

sub scan_hook_post {
  my $bot = shift;

  defined($bot->config->{heartbeat})
    and &{$bot->config->{heartbeat}}($bot);
}

sub send_message_raw {
  my $bot = shift;
  my $msg = shift;
  my $ret = shift || 0;

  my $url = $bot->url . 'submitnewchat.php?pwd='
    . $bot->hash
    . '&graf=' . $msg;

  if ($ret) {
    my $response = $bot->ua->get($url);
    $response->is_success 
      or die "HTTP " . $response->status_line;
    $bot->check_response($response);

    return $response->content;
  } else {
    my $response = $bot->ua->head($url);
    $response->is_success 
      or die "HTTP " . $response->status_line;
    return;
  }
}

sub send_message {
  my $bot = shift;
  my $msg = shift;
  my $ret = shift || 0;

  # I hate checking type
#  $msg->isa('KoLBot::ChatMessage') or die "Not a ChatMessage!";

  defined ($msg->type) or die "send_message with no type!";

  # There should be an escape function around somewhere.
  # FIRST do % signs so they aren't redone.
  $msg->{message} =~ s/%/%25/g;

  $msg->{message} =~ s/#/%23/g;
  # $ 24
  $msg->{message} =~ s/&/%26/g;
  $msg->{message} =~ s/\+/%2B/g;

  if ($msg->type eq 'emote') {
    $bot->send_message_raw('/' . $msg->{channel}. ' /em ' . $msg->message,
			   $ret);
  } elsif ($msg->type eq 'normal') {
    # AWM talk like a Pirate day.
    my $message = $msg->message;
#    filter_text(\$message);
    $bot->send_message_raw(
       '/' . $msg->channel . ' ' . $message,
			   $ret);
  } elsif ($msg->type eq 'private') {
    my $user = $msg->user;

    # AWM talk like a Pirate day.
    my $message = $msg->message;
#    filter_text(\$message);

    $user =~ s/\ /_/g;
    # AWM Should make this a parameter :)
    if(!int(rand(5)) && $bot->{drunk}) {
      if(int(rand(2))) {
	$bot->send_message_raw('/msg '.$user.' '.$message . ' -tic-',
			       $ret);
      } else {
	$bot->send_message_raw('/msg '.$user.' '.$message . ' -toc-',
			       $ret);
      }
    } else {
      $bot->send_message_raw('/msg '.$user.' '.$message,$ret);
    }
  } else {
    die "unknown type: " . $msg->type;
  }
}

sub curse {
  my $bot = shift;
  my %params = (whichitem => 1649, # Default brick
		@_);

  my $url = $bot->url . 'curse.php';

  my $args =
      [ action          => 'use',
	pwd             => $bot->hash,
	whichitem       => $params{whichitem},
	targetplayer    => $params{user},
	message         => $params{message},
	];

  $bot->ua->max_size(0) unless($params{check_response});
  my $response = $bot->ua->post($url,$args);
  delete($bot->ua->{max_size});

  $response->is_success or die "HTTP " . $response->status_line;

  return 1 unless($params{check_response});

  $bot->check_response($response);

  return;
}

sub chat_who {
  my $bot = shift;
  my $channel = shift;

  my $content = $bot->send_message_raw("/who $channel",1);

  # clean up

  my @content = split(/, /,$content);
  my %whos = ();
  for(@content) {
    /<a target=mainpane href=\"showplayer.php\?who=(\d+)\"><font color=(.*?)>(.*?)<\/font><\/a>/ or warn "No match $_";
    my ($id,$color,$name) = ($1,$2,$3);
    $whos{$name} = { id => $id,
			color => $color,
			name => $name };
  }
  
  return %whos;
}

########################################################################
# KMail interfaces
########################################################################


# If check_response is chosen, the return code means something
# returns 1 on success: item known sent
# returns 0 on failure: item known unsent, {error} set to reason.
# Otherwise dies, with some clue as to why, either 
#   HTTP 
#   NOTLOGGEDIN
#   Or don't know.
sub send_kmail {
  my $bot = shift;
  my $kmail = shift;
  my $savecopy = shift || 0;
  my $check_response = shift || 0;

  $bot->{error} = undef;

  # I hate checking type
  ref($kmail) =~ /KoLBot::KMail/ or die "Not a Kmail!, " . ref($kmail);

  my $url = $bot->url . 'sendmessage.php';

  my $args =
      [ action          => 'send',
	pwd             => $bot->hash,
	towho           => $kmail->user,
	contact         => 0,
	message         => $kmail->message || '',
	sendmeat        => $kmail->meat || 0,
	];

  croak 'Items passed to send_kmail must now be array of items'
    if(ref($kmail->items) ne 'ARRAY');
  my $i = 0;
  for(@{$kmail->items}) {
    push @$args, 'howmany'.(($i)+1) ,$_->number;
    push @$args, 'whichitem'.(($i)+1) ,$_->id;
    $i++;
  }

  push @{$args},(savecopy => 'on') if($savecopy);

  $bot->ua->max_size(0) unless($check_response);
  my $response = $bot->ua->post($url,$args);
  delete($bot->ua->{max_size});

  $response->is_success or die "HTTP " . $response->status_line;

  return 1 unless($check_response);

  $bot->check_response($response);

  $response->content =~ m|<center>Message sent.</center>|i
    and return 1;

  $response->content =~
    /send less than one of something./
    and $bot->{error}="send_kmail: less than one",return 0;

  $response->content =~
    /items cannot be transferred/
    and $bot->{error}="send_kmail: untransferrable item",return 0;

  $response->content =~
    /That player cannot receive Meat or items from other players./
    and $bot->{error}="send_kmail: ronin",return 0;

  $response->content =~
    /You don\'t have enough of one of the items you\'re trying to send./
    and $bot->{error}="send_kmail: don't have that many",return 0;

  $response->content =~
    /You don\'t have that much meat./
    and $bot->{error}="send_kmail: not enough meat" , return 0;

  $response->content =~
    /<td>Invalid PlayerID.<\/td>/
    and $bot->{error}="send_kmail: Invalid PlayerID. = " . $kmail->user , 
      return 0;

  $response->content =~
    /player\'s ignore list./
    and $bot->{error}="send_kmail: Ignored." , return 0;

  $response->content =~
    /<br>You twiddle your thumbs.<p>/
    and $bot->{error}="send_kmail: In combat." , return 0;

  $response->content =~ /action=choice.php/
    and $bot->{error}="send_kmail: Choice adventure." , return 0;

  $response->content =~ m|img src="http://images\.kingdomofloathing\.com/otherimages/main/maintop\.gif" width=350 height=50|i
    and $bot->{error}="send_kmail: Main page" , return 0;

  # don't know what might happen, lets take a look
  die "unknown response content, sendmessage.php\n",$response->content,"\n";
}

sub town_sendgift {
  my $bot = shift;
  my %params = ( whichpackage => 1,
		 items => [],
		 fromwhere => 0,
		 meat => 0,
		 do_it => 1,
		 @_ );

  if(exists($params{item_id})) {
    die "KoLBot::town_sendgift now reqires an array of Items";
  }

  my $url = $bot->url . 'town_sendgift.php';

  # just get types of packages sendable
  unless($params{do_it}) {
    my $response = $bot->ua->get($url);

    $response->is_success or die "HTTP " . $response->status_line;
    $bot->check_response($response);
    my $content = $response->content;
    my $allowed_types = {};
    while($content =~ /<input type=radio name=whichpackage value=(\d+)/g) {
      $allowed_types->{$1} = 1;
    }
    return $allowed_types;
  }

  if(!exists($params{note}) && exists($params{message})) {
    $params{note} = $params{message};
  }
  if(!exists($params{insidenote})) {
    $params{insidenote} = $params{note};
  }

  my $args =
     [ towho           => $params{user},
	contact         => 0,
	note            => $params{note},
	insidenote      => $params{insidenote},
	whichpackage    => $params{whichpackage},
       fromwhere        => $params{fromwhere},
	pwd             => $bot->hash,
	action          => 'Yep.',
	sendmeat        => $params{meat},
       ];

  for(@{$params{items}}) {
    push @$args, 'howmany'.(($_)+1) ,$_->number;
    push @$args, 'whichitem'.(($_)+1) ,$_->id;
  }

  $bot->ua->max_size(0) unless($params{check_response});
  my $response = $bot->ua->post($url,$args);
  delete($bot->ua->{max_size});

  $response->is_success or die "HTTP " . $response->status_line;

  return 1 unless($params{check_response});

  $bot->check_response($response);

  $response->content =~ m|<td>Package sent.</td>|i
    and return 1;

  $response->content =~ m|Invalid package|
    and return (0,'invalid package');

  return (0,$response->content);
}

# offload into KMail, or per KINGDOM config file
# our $kmail_offset = -5*60*60;  # winter
our $kmail_offset = -7*60*60;
# these UTC
our $rollover_hour = 3;
our $rollover_minute = 30;

sub read_kmail {
  my $bot = shift;
  my $params = { page_limit => 100,
		 box        => 'Inbox',
		 min_id     => 0,
		 dont_die   => 0,
		 no_items   => 0,
		 @_ };

  if($params->{box} !~ /^(Inbox|Outbox|Saved)$/i) {
    die "Bad box type passed to read_kmail";
  }
  my $min_id = $params->{min_id};

  my %kmail = ();

  # Check if there are more pages
  my $page = 1;
  my $page_limit = $params->{page_limit};

  while($page <= $page_limit) {

    $bot->ua->timeout($bot->config->{timeout});
    my $url = $bot->url . 'messages.php?box='
      . $params->{box} .'&begin='
      . $page;
    my $response = $bot->ua->get($url);

    $response->is_success
      or die 'HTTP ' . $response->status_line;

    $bot->check_response($response);

    die 'unknown response in read_kmail, ',$response->content
      unless $response->content =~ /cellspacing=0 cellpadding=0><tr><td style="color: white;" align=center bgcolor=(blue|green)><b>Messages:/;

    my $content = $response->content;

    last 
      unless ($content =~ m|(<tr><td valign=top>.*?</blockquote></td></tr>)|s);

    while($content =~ m|(<tr><td valign=top>.*?</blockquote></td></tr>)|gs) {
      my $rawmsg = $1;

      my $mail = {};

      $rawmsg =~ m{<input type=checkbox name="sel(\d+)">} 
        or die "no sel part in message";

      $mail->{id} = $1;

      my $from_b = '<td class=small><b>(?:From|To)</b> <a href="showplayer.php\?who=(\d+)">(.*?)</a> \(#\d+\)';
      $rawmsg =~ m{$from_b} or die "no from part in message";

      $mail->{user_id} = $1;
      $mail->{user} = $2;

      my $day = '(?:Friday|Saturday|Sunday|Monday|Tuesday|Wednesday|Thursday)';
      my $month = '(July|August|September|October|November|December|January|February|March|April|May|June)';

      # each is made up of
      my $date = '<br><b>Date:</b> ' . $day . ', ' .  $month . ' (\d\d), (\d\d\d\d), (\d\d):(\d\d)(AM|PM)</b><br>';

      $rawmsg =~ m{$date} or die "Can't find date in message.";

      my $months = {'January' => 1,'February' => 2, 'March' => 3, 'April' => 4,
		    'May' => 5, 'June' => 6, 'July' => 7,'August' => 8,
		    'September' => 9,'October'=>10, 'November' => 11,
		    'December' => 12};
      !exists($months->{$1}) and die "no month ",$1;
      my $mth = $months->{$1} - 1;

      my $mtime;
      $mtime = timegm(0,$5,($4+(($6 eq 'PM')?12:0))%24,$2,$mth,$3-1900)
	  - $kmail_offset;

      $mail->{time} = $mtime;

      $rawmsg =~ m{<blockquote>(.*?)</blockquote></td></tr>}s
	or die "no bulk";
 
      my $bulk = $1;

      # get rid of HTML in messages
      # line breaks
      $bulk =~ s{<br />\n}{\n}g;
      # inlined profile links
      $bulk =~ s{<a class=nounder style='color: blue' href='showplayer.php\?who=\d+' target=mainpane>(.*?)</a>}{$1}g;
      # normal URLs
      $bulk =~ s{<a target=blank_ href="[^\"]*"><font color=blue>\[link\]</font></a>}{}g;

      if($bulk =~ m|<span class=small>\(\* interjection denoting surprise\)</span>|) {
	$mail->{brick} = 1;
	$bulk =~ s|<center><img src='http://images.kingdomofloathing.com/adventureimages/\w+\.gif'></center>|\n|;
	$bulk =~ s|<p><center><div style='display: table; border: 2px inset; padding: 10px;'>|\n|;
	$bulk =~ s|</div></center><p><span class=small>|\n|;
      }
      # valentines
      if($bulk =~ m{<center><table><tr><td><img src="http://images\.kingdomofloathing\.com/adventureimages/(\w+)\.gif" width=100 height=100></td><td valign=center>(.*?)</td></tr></table></center>}) {
	my $repl = "$1.gif $2";
	$repl =~ s/<br>/\n/g;
	$bulk =~ s{<center><table><tr><td><img src="http://images\.kingdomofloathing\.com/adventureimages/(\w+)\.gif" width=100 height=100></td><td valign=center>(.*?)</td></tr></table></center>}{$repl};
      }

      $bulk =~ m{^([^<]*)};
      $mail->{message} = html_to_text($1);

      # separate first and second parts
      my ($outer,$inner);
      if($bulk =~ /^(.*)<p>Inside Note:<p>(.*)$/m) {
	$outer=$1;
	$inner=$2;
	$inner =~ m{^([^<]*)};
	$mail->{insidenote} = html_to_text($1);
      } else {
	$outer = $bulk;
	undef $mail->{insidenote};
      }

      my ($meat_o,$items_o) = $bot->parse_attachments($outer);
      my ($meat_i,$items_i);
      if(defined($inner)) {
	($meat_i,$items_i) = $bot->parse_attachments($inner);
      }

#       # backwards compatibility
#       my (@item_id,@item_name,@item_num);
#       my (@i_item_id,@i_item_name,@i_item_num);

#       for(@$items_o) {
# 	push @item_id,$_->{id};
# 	push @item_name,$_->{name};
# 	push @item_num,$_->{number};
#       }

#       for(@$items_i) {
# 	push @i_item_id,$_->{id};
# 	push @i_item_name,$_->{name};
# 	push @i_item_num,$_->{number};
#       }

      $kmail{$mail->{id}} = 
	new KoLBot::KMail(rawmsg     => $rawmsg,
			  id         => $mail->{id},
			  time       => $mail->{time},
			  user       => $mail->{user},
			  user_id    => $mail->{user_id},
			  message    => $mail->{message},
			  meat       => $meat_o,
			  items      => $items_o,

			  insidenote => $mail->{insidenote},
			  i_meat     => $meat_i,
			  i_items    => $items_i,

# 			  item_id    => [@item_id],
# 			  item_name  => [@item_name],
# 			  number     => [@item_num],

# 			  i_item_id  => [@i_item_id],
# 			  i_item_name => [@i_item_name],
# 			  i_number    => [@i_item_num],
			  );
      # AWM DEBUG
#      print $kmail{$mail->{id}};
#      die;
    }

    $page++;
  }
  return sort {$a->{id} <=> $b->{id}} values %kmail;
}

sub html_to_text {
  my $text = shift;

  $text =~ s/&lt;/</g;
  $text =~ s/&gt;/>/g;
  $text =~ s/&quot;/\"/g;
  $text =~ s/&amp;/&/g;

  return $text;
};

sub parse_attachments {
  my $bot = shift;
  my $text = shift;

  my $meat = 0;
  my $items = [];

  if($text =~ m{<td valign=center>You gain ([\d,]+) Meat.</td>}) {
    $meat = $1;
    $meat =~ s/,//g;
    # remove meat to ease further processing
    $text =~ s|<center><table><tr><td><img src="http://images.kingdomofloathing.com/itemimages/meat.gif" height=30 width=30 alt="Meat"></td><td valign=center>You gain [\d,]+ Meat.</td>.*$||;
  }

  while($text =~ m{<tr>(.*?)</tr>}g) {
    my $line = $1;
    push @$items, $bot->item_from_acquire($line);
  }

  return ($meat,$items);
}

sub item_from_acquire {
  my $bot = shift;
  my $text = shift;

# login: getting lchat http://www3.kingdomofloathing.com/
# ensure: exception no description: <td><img src="http://images.kingdomofloathing.com/itemimages/daquiri.gif" width=30 height=30 onClick='window.open("desc_item.php?whichitem=609859151","","height=200,width=300")'></td><td valign=center>You acquire <b>3 calles de miel</b></td> at /home/alan/usr/src/kolbot/KoLBot.pm line 1461.

  $text =~ m{descitem\((\d+)\)} or die "no description: $text";
  my $desc = $1;

  my ($name,$number);
  if($text =~ m{You acquire an item: <b>(.*?)</b>}) {
    $name = $1;
    $number = 1;
  }
  
  if($text =~ m{You acquire <b>([\d,]+) (.*?)</b>}) {
    $number = $1;
    $name = $2;
    $number =~ s/,//g;
  }

  die "No item found $text"
    unless defined($name);

  my $item = {desc => $desc, name => $name, number => $number};

  if(defined($bot->{items}) && $bot->{items}->isa("KoLBot::Items")) {
    $item = 
      $bot->items->get_item(%$item)
      or die 'FATAL: didn\'t find item in database ' . $desc . ', '.$name;
    $item->{number} = $number;
  }
  $item->{id} ||= 0;

  return $item;
}

sub saving_kmail {
  my $bot = shift;
  my $box = shift;
  my @kmail = @_;

  my $url = $bot->url . 'messages.php';

  my $args = 
      [ the_action          => 'save',
	pwd             => $bot->hash,
	box             => $box,
	];

  for(@kmail) {
    push @$args, 'sel'.$_->{id},'on';
  }

  $bot->ua->max_size(0);
  my $response = $bot->ua->post($url,
				$args,
				     );
  delete($bot->ua->{max_size});

  $response->is_success or die 'HTTP ' . $response->status_line;
}

sub delete_kmail {
  my $bot = shift;
  my $box = shift;
  my @kmail = @_;

  my $url = $bot->url . 'messages.php';

  my $args = 
      [ the_action          => 'delete',
	pwd             => $bot->hash,
	box             => $box,
	];

  for(@kmail) {
    push @$args, 'sel'.$_->{id},'on';
  }

  $bot->ua->max_size(0);
  my $response = $bot->ua->post($url,
				$args,
				     );
  delete($bot->ua->{max_size});

  $response->is_success or die 'HTTP ' . $response->status_line;
}

# Obsolete, takes only one mail.
sub del_kmail {
  my $bot = shift;
  my $kmail = shift;

  my $url = $bot->url . 'messages.php';
  $bot->ua->max_size(0);
  my $response = $bot->ua->post($url,
      [ the_action          => 'delete',
	pwd             => $bot->hash,
	box             => 'Inbox', # For now
	'sel'.$kmail->{id} => 'on',
	]
				     );
  delete($bot->ua->{max_size});

  $response->is_success or die 'HTTP ' . $response->status_line;
}

# Obsolete, takes only one mail.
sub save_kmail {
  my $bot = shift;
  my $kmail = shift;

  my $url = $bot->url . 'messages.php';
  $bot->ua->max_size(0);
  my $response = $bot->ua->post($url,
      [ the_action          => 'save',
	pwd             => $bot->hash,
	box             => 'Inbox', # For now
	'sel'.$kmail->{id} => 'on',
	]
				     );
  delete($bot->ua->{max_size});

  $response->is_success or die 'HTTP ' . $response->status_line;
}

sub open_gift {
  my $bot = shift;
  my $params = { item_id    => 1167,
		 @_ };

  if($params->{item_id} < 1167 || $params->{item_id} > 1177
     && $params->{item_id} != 1460 ) {
    die "I don't think that is a giftbox in open_gift";
  }

  $bot->ua->timeout($bot->config->{timeout});
  my $url = $bot->url . 'inv_use.php?pwd=' . $bot->{hash}
  . '&which=3&whichitem=' . $params->{item_id};
  my $response = $bot->ua->get($url);

  $response->is_success
    or die 'HTTP ' . $response->status_line;

  $bot->check_response($response);

  $_ = $response->content;

  m|<blockquote>You don't have the item you're trying to use.</blockquote>|
    and return(undef,'None of that item to open.');

  s/&nbsp;/ /g;

  my $pname = '\w[\w\ ]{0,28}\w';

# <center><table width=95%  cellspacing=0 cellpadding=0><tr><td style="color: white;" align=center bgcolor=blue><b>Results:</b></td></tr><tr><td style="padding: 5px; border: 1px solid blue;"><center><table><tr><td><center><img src="http://images.kingdomofloathing.com/itemimages/plainbrown.gif" width=30 height=30><br></center><blockquote>You look around to make sure nobody's watching you, and tear open the package.<p>From: <b></b>.<center><p><table><tr><td style='border: 1px solid black; padding: 10px'>A gift from The Feier.!</td></tr></table></center><p><center><table><tr><td><img src="http://images.kingdomofloathing.com/itemimages/juice.gif" class=hand onClick='descitem(270292632)'></td><td valign=center class=effect>You acquire an item: <b>bloody beer</b></td></tr></table></center></blockquote></td></tr></table></center>

  my $user;

  if(m|<blockquote>.*?<p>From: <b>($pname)</b>.(.*?)<table width=95%  cellspacing=0 cellpadding=0><tr><td style="color: white;" align=center bgcolor=blue><b>Inventory:|) {
    $user = $1;
    $_ = $2;
  } elsif (m|<blockquote>.*?<p>From: <b></b>.(.*?)<table width=95%  cellspacing=0 cellpadding=0><tr><td style="color: white;" align=center bgcolor=blue><b>Inventory:|) {
    $user = '';
    $_ = $1;
  } else {
    print("ERROR open_gift: Not really a gift box?\n$_"), die;
  }

  my $content = '';
  my $meat = 0;
  m|<center><p><table><tr><td style='border: 1px solid black; padding: 10px'>(.*?)</td></tr></table></center>|
    and $content = $1;
  m|<center><table><tr><td><img src="http://images.kingdomofloathing.com/itemimages/meat.gif" height=30 width=30 alt="Meat"></td><td valign=center>You gain ([\d,]+) Meat.</td></tr></table>|
    and $meat = $1, $meat =~ s/,//g;
    
  # AWM replace and test
  # my ($meat,$items) = $bot->parse_attachments($_);

  my @item_name = ();
  my @item_id = ();
  my @item_desc = ();
  my @i_num = ();

  my $done = 0;

  s/<\/?td.*?>//g;
  s/<\/td.*?>//g;
  s/<\/?center>//g;
  s/<\/?table>//g;

  while(1) {
    if(/<img[^>]*?descitem\((\d+)\)[^>]*?>You acquire <b>([\d,]+) ([^<]*?)<\/b>/) {
      push @item_desc, $1;
      push @item_name, $3;
      my $num = $2;
      $num =~ s/,//g;
      push @i_num, $num;
      s/<img[^>]*?descitem\((\d+)\)[^>]*?>You acquire <b>([\d,]+) ([^<]*?)<\/b>//;

    } elsif(/<img[^>]*?descitem\((\d+)\)[^>]*?>You acquire an item: <b>([^<]*?)<\/b>/) {
      push @item_desc, $1;
      push @item_name, $2;
      push @i_num, 1;
      s/<img[^>]*?descitem\((\d+)\)[^>]*?>You acquire an item: <b>([^<]*?)<\/b>//;

    } else {
      /acquire/i and print "ERROR open_gift Missed items in $_\n";

      last;
    }
  }

  $content =~ s/<br>/\n/g;
  $content =~ s/&lt;/</g;
  $content =~ s/&gt;/>/g;
  $content =~ s/&amp;/&/g;
  $content =~ s/&quot;/\"/g;
  
  my @items;

  if($params->{no_items}) {
    @item_id = ();
    @item_name = ();
    @i_num = ();
  } else {
    for(0..$#i_num) {
      my $item = 
	$bot->items->get_item(desc => $item_desc[$_],
			      name => $item_name[$_],
			      number => $i_num[$_])
#	  || 
#	  $bot->find_item(desc => $item_desc[$_],
#			  name => $item_name[$_])
	|| 
	die 'FATAL: didn\'t find '.$item_desc[$_].','.$item_name[$_];

      push @items,$item;
    }
  }

  return new KoLBot::KMail(time      => 0,
			   user      => $user,
			   message   => $content,
			   id        => 0,
			   user_id   => 0,
			   meat      => $meat,
			   items     => [@items],
			   );
}

##########################################
## Clan interface
##########################################

sub clan_buff {
  my $bot = shift;
  my $parms = { @_ };

  my $content;
  my $url = $bot->url . 'clan_stash.php';

  my $response = $bot->ua->post($url,
				[ 
				  action  => 'buyround',
				  pwd     => $bot->{hash},
				  members => $parms->{members},
				  # 1 small, 2 med, 3 expensive
				  size => $parms->{size},
				  #next is 1 musc, 2 myst, 3 mox
				  # temp 4-5-6
				  whichgift => $parms->{whichgift},
				  ]
				);
  $bot->check_response($response);

  return unless($parms->{check_response});

  $content = $response->content;
}

# good actions are 'addgoodies'
# 'takegoodies'

sub clan_stash {
  my $bot = shift;
  my $parms = { @_ };

  my $content;
  my $url = $bot->url . 'clan_stash.php';

  if($parms->{action}) {
    # code from tomek
    my $response;
    if($parms->{action} eq "addgoodies") {
      $response = $bot->ua->post($url,
	    [ 
	      action => $parms->{action},
	      qty1 => $parms->{quantity},
	      item1 => $parms->{whichitem},
	      pwd    => $bot->{hash},
	      ]);
    } else {
      $response = $bot->ua->post($url,
	 [ 
	      action => $parms->{action},
	      quantity => $parms->{quantity},
	      whichitem => $parms->{whichitem},
	      pwd    => $bot->{hash},
	      ]);
    }

    $bot->check_response($response);

    return unless($parms->{check_response});

    $content = $response->content;
  } else {
    my $response = $bot->ua->get($url);

    $response->is_success or die 'HTTP ' . $response->status_line;

    $bot->check_response($response);

    $content = $response->content;
  }

  my ($inv,$stash) = ([],[]);
  # get rid of head and tail, keep only the juicy fillings

  if($content =~ m|<tbody id='additems'>(.*?)</tbody>|) {
    my $acont = $1;
     
    while($acont =~ m|<option value="(\d+)">(.*?) \(([\d,]+)\)</option>|g) {
      my $id = $1;
      my $name = $2;
      my $number = $3;
      $number =~ s/,//g;

      push @$inv,new KoLBot::Item(id=>$id,name=> $name,number=>$number);
    }
  }

  if($content =~ m|<form name=takegoodies action=clan_stash.php method=post>(.*?)</form>|) {
    my $acont = $1;

    while($acont =~ m|<option value="?(\d+)"? descid=(\d+)>(.*?)( \(([\d,]+)\))?</option>|g) {
      my $id = $1;
      my $descid = $2;
      my $name = $3;
      my $number = $5 || 1;
      $number =~ s/,//g;
      push @$stash,new KoLBot::Item(id=>$id,name=> $name,number=>$number,
				    desc => $descid);
    }
  } 

  return ($stash,$inv);
}

sub clan_applications {
  my $bot = shift;
  my $parms = { @_ };

  my $content;
  my $url = $bot->url . 'clan_applications.php';

  if($parms->{id}) {
    my $value = $parms->{accept}?1 : $parms->{decline} ? 2 : return undef;
    my $response = $bot->ua->post($url,
				  [ 
			    action => 'process',
			    pwd       => $bot->hash,
			    'request' . $parms->{id} => $value,
				    ]
				  );
    $bot->check_response($response);

    return unless($parms->{check_response});

    $content = $response->content;
  } else {
    my $response = $bot->ua->get($url);

    $response->is_success or die 'HTTP ' . $response->status_line;

    $bot->check_response($response);

    $content = $response->content;
  }

  $content =~ s/<td>//g;
  $content =~ s/<\/td>//g;

  my $applicants = [];
  # get rid of head and tail, keep only the juicy fillings

  unless($content =~ m|Reject</u></b></tr><tr><a href=\"showplayer.php\?who=(.*)</tr><tr><td colspan=3|) {
    return $applicants;
  }

  my $middle = $1;

  my @apps = split m{<a href=\"showplayer.php\?who=},$middle;

  for (@apps) {
    m{^(\d+)\">(.*?)</a>}
    or die "Not an app: $_";

    my $id = $1;
    my $name = $2;
    
    push @$applicants,{id => $id, name => $name};

  }

  return $applicants;
}

sub clan_members {
  my $bot = shift;
  my $parms = { action => 'modify',
		@_ };

  my $content;
  my $url = $bot->url . 'clan_members.php';

  if($parms->{id}) {
    my $args = [ 
		 pwd       => $bot->hash,
		 action    => $parms->{action},
		 ];
    if($parms->{rank}) {
      push @$args, 'level' . $parms->{id} => $parms->{rank};
    }
    if($parms->{title}) {
      push @$args, 'title' . $parms->{id} => $parms->{title};
    }
    if($parms->{boot}) {
      push @$args, 'boot' . $parms->{id} => 1;
    }

    my $response = $bot->ua->post($url,$args);

    $bot->check_response($response);

    return;
  }

  my $page = '';

  my $members = [];
 PAGE: {
   my $response = $bot->ua->get($url . $page);

   $response->is_success or die 'HTTP ' . $response->status_line;

   $bot->check_response($response);

   $content = $response->content;

   $content =~ s/<td>//g;
   $content =~ s/<\/td>//g;

   # get rid of head and tail, keep only the juicy fillings

   unless($content =~ m|(<a class=nounder href.*)<tr><td colspan=4|) {
     return $members;
   }

   my $middle = $1;

   my @mems = split m{</tr><tr>},$middle;

   for (@mems) {
#    print $_,"\n";
     m{who=(\d+)\">(.*?)</a>} or die "Not a member: $_";


     my $m = {};
     $m->{id} = $1 if $1;
     $m->{name} = $2 if $2;

     if(m{<option value=(\d+) selected>(.*?)</option>}) {
       $m->{rank} = $1;
       $m->{rank_name} = $2;
     }
     if(m{title\d+ size=20 maxlength=30 value=\"(.*?)\">}) {
       $m->{title} = $1;
     }

     push @$members,$m;
   }
   if($content =~ /clan_members.php(\?begin=\d+)\">next 20/) {
     $page = $1;
     redo PAGE;
   }
 }
  return $members;
}

sub clan_admin {
  my $bot = shift;
  my $parms = { @_ };

  if($parms->{action} eq 'transfer') {
    my $content;
    my $url = $bot->url . 'clan_admin.php';

    my $args = [ 
		 pwd       => $bot->hash,
		 action    => 'changeleader',
		 newleader => $parms->{id},
		 confirm   => 'on',
		 ];

    my $response = $bot->ua->post($url,$args);

    $bot->check_response($response);

    return;
  }
}

sub clan_war {
  my $bot = shift;
  my $parms = { @_ };

  $bot->ua->timeout($bot->config->{timeout});
  my $url = $bot->url . 'clan_war.php';

  delete($bot->ua->{max_size});
  my $response;
  if($parms->{goodies}) {
    my $p = [ 
	      action => 'Yep',
	      goodies=> $parms->{goodies},
	      oatmeal => 0,
	      cinderblocks => 0,
	      grunts => 0,
	      flyers => 0,
	      recliners => 0,
	      archers => 0,
	      ];
    $response = $bot->ua->post($url,$p);
  } else {
    $response = $bot->ua->get($url);
  }

  $bot->check_response($response);

  my $resp = {};

  my $content = $response->content;

  $content =~ s/&nbsp;/ /g;
  $content =~ s/ width=\d+//g;
  $content =~ s/ height=\d+//g;
  $content =~ s/(\d),(\d)/$1$2/g;
  $content =~ s/<td.*?>/<td>/g;
  $content =~ s/<font.*?>/<font>/g;
  $content =~ s/\s+/ /g;


  $content =~ m{Bags of Goodies:</td><td><b>(\d+)}i
    and $resp->{goodies} = $1;

  return $resp;
}

sub clan_board {
  my $bot = shift;
  my $parms = { @_ };

  $bot->ua->timeout($bot->config->{timeout});
  my $url = $bot->url . 'clan_board.php';

  delete($bot->ua->{max_size});
  my $response;
  if($parms->{delete}) {
    $url .= '?action=delete&msgid=' . $parms->{msgid};
  }
  $response = $bot->ua->get($url);
  $bot->check_response($response);

  my $content = $response->content;

  if($parms->{delete}) {
#    print "AWM DEBUG, ",$url,"\n";
#    print $content,"\n";
#    die;
  }

  my $pname = '\w[\w\ ]{0,28}\w';

  my @messages = ();
  while ($content =~ m|<font size=2><p><b>Date: (.*?)<br>From: <a href="showplayer.php\?who=(\d+)">($pname)</a> \(\#(\d+)\)</b><p><blockquote>(.*?)</blockquote><p><center><a href="sendmessage.php\?toid=(\d+)">reply \(private message\)</a>(&nbsp;&nbsp;<a href="clan_board.php\?action=delete&msgid=(\d+)">delete</a>)?</font></center>|g) {
    push @messages,{dstr => $1,user_id => $2,user => $3,text => $5,
		     msgid =>$8};
#    my $dstr = $1;
#    my $pid = $2;
#    my $pname = $3;
#    my $text = $5;
#    my $msgid = $7;
    # Our clan was attacked by The Knights of the Realm. They were able to loot 1 Bags of Goodies.
# Our clan was attacked by disco banits. They were unable to loot any Goodies.
  }
  return @messages;
}

sub clan_whitelist {
  my $bot = shift;
  my %params = (level => 0,
		title => '',
		@_);

  my $url = $bot->url . 'clan_whitelist.php';

  my $response;
  if($params{action} eq 'add') {
    my $p = [ 
	      action => $params{action},
	      addwho => $params{user},
	      level  => $params{level},
	      title  => $params{title},
	      ];
    $response = $bot->ua->post($url,$p);
  } else {
    die "clan_whitelist only adds";
  }

  $response->is_success or die 'HTTP ' . $response->status_line;
  return;
}


########################################################################
# PVP
########################################################################

sub pvp {
  my $bot = shift;
  my $parms = { @_ };

  my $content;
  my $url = $bot->url . 'pvp.php';

  if($parms->{id}) {
    my $p = [ 
	      action => 'Yep',
	      pwd    => $bot->hash,
	      who    => $parms->{id},
	      # 1,2,3 std
	      stance => $parms->{stance},
	      # dignity, meat, lootbooze, lootfood, lootwhatever
	      attacktype => $parms->{attacktype},
	      winmessage => $parms->{winmessage},
	      losemessage => $parms->{losemessage},
	      ];
    my $response = $bot->ua->post($url,$p);

    $bot->check_response($response);

    return unless($parms->{check_response});

    $content = $response->content;


    if($content =~ /failed to yield/i) {
      print "AWM DEBUG FAILED TO YIELD\n";
    }

    if($content =~ /No attacking\./) {
      return (1,'hippy');
    }
    if($content =~ /ranked too highly/) {
      return (1,'too high');
    }

    $content =~ /<center><table><tr>(.*?)<\/tr><\/table><table width/
      or return(1,"can\'t match $content");

    $content = $1;
    
    $content =~ s/<b>/ /g;
    $content =~ s/<\/b>/ /g;
    $content =~ s/<td.*?>/ /g;
    $content =~ s/<\/td>/ /g;
    $content =~ s/<\/table>/ /g;
    $content =~ s/<center>/ /g;
    $content =~ s/<\/center>/ /g;
    $content =~ s/<font.*?>/ /g;
    $content =~ s/<\/font>/ /g;
    $content =~ s/\s+/ /g;
    
    my $r;
    my @lines=split(/<p>/,$content);
    for(@lines) {
      /^\s*$/ and next;

      /Attacking (.*) \.\.\./
	and $r .= "attacking $1\n",next;
      /call (.*) out/
	and $r .= "attacking $1\n",next;

      /by his house/i
	and $r .= "house\n",next;
      /pretty flowers/i
	and $r .= "flowers\n",next;
      /scarecrow/i
	and $r .= "scarecrow\n",next;
      /wire fence/i
	and $r .= "barbed-wire fence\n",next;
      /white picket/i
	and $r .= "white picket fence\n",next;
      /feng shui/i
	and $r .= "feng shui\n",next;

      /spell bounces right back at you/
	and $r .= "buffed myst: loss\n",next;
      /magical gambit is successful/
	and $r .= "buffed myst: win\n",next;
      /opponent feel like a loser/
	and $r .= "buffed moxie: win\n",next;
      /one-ups you with a well-timed joke/
	and $r .= "buffed moxie: loss\n",next;
      /ignores your taunts.*punches you/
	and $r .= "buffed moxie: loss\n",next;
      /spell, which also burns/
	and $r .= "buffed moxie: loss\n",next;

      /raw Mysticality.*You lose the round/i
	and $r .= "raw magic: loss\n",next;
      /raw Moxie vs\. raw Moxie. You lose/
	and $r .= "raw moxie: loss\n",next;
      /raw Moxie vs\. raw Moxie\. You win/
	and $r .= "raw moxie: win\n",next;

      /armwrestling match. You struggle and groan/
	and $r .= "buffed muscle: loss\n",next;
      /armwrestling.*\bwin\b/
	and $r .= "buffed muscle: win\n",next;
      /beat the band, and deftly win/
	and $r .= "buffed moxie: win\n",next;

      /Mysticality outmatches yours/
	and $r .= "buffed myst: loss\n",next;
      /mad magical skills/
	and $r .= "buffed myst: win\n",next;

      /drunk more White Canadians/
	and $r .= "canadian: loss\n",next;
      /way more balanced than your opponent/
	and $r .= "diet: win\n",next;
      /eat significantly more pie/
	and $r .= "eating: win\n",next;
      /your opponent is able to consume more pie than you/
	and $r .= "eating: loss\n",next;
      /weighs (more )?than your opponent/
	and $r .= "familiar: win\n",next;
      /your familiar. Your familiar doesn\'t have/
	and $r .= "familiar: loss\n",next;
      /far more stylish than your opponent/
	and $r .= "fashion: win\n",next;
      /deem that your style is outmoded/
	and $r .= "fashion: loss\n",next;
      /more flowers than you/
	and $r .= "flowers: loss\n",next;
      /Your headache knows no bounds/
	and $r .= "hangover: win\n",next;
      /significantly hunger over than you/
	and $r .= "hangover: loss\n",next;
      /more blood than your opponent/
	and $r .= "HP: win\n",next;
      /you easily outburp him/
	and $r .= "MP: win\n",next;
      /less threatened by him/
	and $r .= "popularity: loss\n",next;
      /fewer active effects on you/
	and $r .= "purity: win\n",next;
      /purity.*opponent has fewer active/
	and $r .= "purity contest: loss\n",next;
      /staggering array of tattoos/
	and $r .= "tattoo: win\n",next;
      /your stack is higher/
	and $r .= "trophy: win\n",next;
      /taken fewer vacations than your opponent/
	and $r .= "work ethic: win\n",next;
      /ethic contest. Your opponent has taken fewer/
	and $r .= "work ethic: loss\n",next;


      /ve won the fight!/
	and $r .= "You win.\n",next;
      /You lost the fight!/
	and $r .= "You lose.\n",next;
      /decreased by (\d+) points/
	and $r .= "PvP: -$1\n",next;
      /increased by (\d+) points/
	and $r .= "PvP: +$1\n",next;

      if(/You (lost|steal) some dignity/) {
	for my $l (split /<tr>/,$_) {
	  $l =~ /You (lost|steal) some dignity/
	    and next;
	  $l =~ /You gain (\d+) (Beef|Stren|Strong|Muscle|Fortit)/
	    and $r .= "Muscle: +$1\n",next;
	  $l =~ /You gain (\d+) (Enchant|Magic|Myst|Wizard)/
	    and $r .= "Myst: +$1\n",next;
	  $l =~ /You gain (\d+) (Smarm|Rogui|Chutz|Cheek|Sarcasm)/
	    and $r .= "Moxie: +$1\n",next;
	  $l =~ /You lose (\d+) (Beef|Stren|Strong|Muscle|Fortit)/
	    and $r .= "Muscle: -$1\n",next;
	  $l =~ /You lose (\d+) (Enchant|Magic|Myst|Wizard)/
	    and $r .= "Myst: -$1\n",next;
	  $l =~ /You lose (\d+) (Smarm|Rogui|Chutz|Cheek|Sarcasm)/
	    and $r .= "Moxie: -$1\n",next;
	  $l =~ /^\s*$/
	    and next;

	  $r .= "AWM: Unknown part: $l\n";
	}
	next;
      }

      $r .= "AWM: Unknown line: $_\n";
    }
    return(0,$r);
  }
}

##########################################
## Utility
##########################################


# only sets, doens't read
sub account_profile {
  my $bot = shift;
  my $parms = { @_ };

  my $url = $bot->url . 'account_profile.php';

  $bot->ua->max_size(0);
  my $response = $bot->ua->post($url,
      [ action          => 'updating',
	pwd             => $bot->hash,
	age             => $parms->{age},
	gender          => $parms->{gender},
	location        => $parms->{location},
	website         => $parms->{website},
	quote           => $parms->{quote},
	]
				     );
  delete($bot->ua->{max_size});
}

# only sets, doens't read
sub account_avatar {
  my $bot = shift;
  my $parms = { @_ };

  my $url = $bot->url . 'account_avatar.php';

  $bot->ua->max_size(0);
  my $response = $bot->ua->post($url,
      [ action          => 'Yep',
	pwd             => $bot->hash,
	whichavatar     => $parms->{whichavatar},
	]
				     );
  delete($bot->ua->{max_size});
}

sub account_contactlist {
  my $bot = shift;

  my $url = $bot->url . 'account_contactlist.php';

  my $response = $bot->ua->get($url);
  $bot->check_response($response);

  my $contact = [];
  my $ignore = [];
  my $content = $response->content;

  unless($content =~ m{<td style="color: white;" align=center bgcolor=blue><b>Contact List</b></td>(.*)<td style="color: white;" align=center bgcolor=blue><b>Ignore List</b></td>(.*)}s) {
    print $content;
    die;
  }
  my $part1 = $1;
  my $part2 = $2;

  while ($part1 =~ m|<tr><td><input type=checkbox name=pids\[\] value=(\d+)></td><td><a href="showplayer.php\?who=(\d+)" class=nounder><b>([\w ]+)</b></a></td></tr>|g){
    push @$contact,{user    => $3,
		    user_id => $1,};
  }
  while ($part2 =~ m|<tr><td><input type=checkbox name=pids\[\] value=(\d+)></td><td><a href='showplayer.php\?who=(\d+)' class=nounder><b>([\w ]+)</b></a></td></tr>|g){
    push @$ignore,{user    => $3,
		   user_id => $1,};
  }

  return $contact,$ignore;
}

sub add_contact {
  my $bot = shift;
  my $parms = { @_ };

  my $url = $bot->url . 'account_contactlist.php';

  $bot->ua->max_size(0);
  my $response = $bot->ua->post($url,
      [ action          => 'add',
	pwd             => $bot->hash,
	who             => $parms->{user},
	]
				     );
  delete($bot->ua->{max_size});
  $response->is_success or die "HTTP " . $response->status_line;
}

sub remove_contact {
  my $bot = shift;
  my $parms = { @_ };

  if(!defined($parms->{user_id})) {
    warn "No user id!";
    return;
  }

  my $url = $bot->url . 'account_contactlist.php';
  my $args = [ pwd       => $bot->hash,
	       'pids[]'  => $parms->{user_id},
	       action    => 'remove',
	       which     => 'contact',
	       ];

  my $response = $bot->ua->post($url,$args);

  $response->is_success or die "HTTP " . $response->status_line;
}

sub add_ignore {
  my $bot = shift;
  my $parms = { @_ };

  my $url = $bot->url . 'account_contactlist.php';

  $bot->ua->max_size(0);
  my $response = $bot->ua->post($url,
      [ action          => 'add',
	ignore          => 'yes',
	pwd             => $bot->hash,
	who             => $parms->{user},
	]
				);
  delete($bot->ua->{max_size});
  $response->is_success or die "HTTP " . $response->status_line;
}

sub remove_ignore {
  my $bot = shift;
  my $parms = { @_ };

  if(!defined($parms->{user_id})) {
    warn "No user id!";
    return;
  }

  my $url = $bot->url . 'account_contactlist.php';
  my $args = [ pwd       => $bot->hash,
	       'pids[]'  => $parms->{user_id},
	       action    => 'remove',
	       which     => 'ignore',
	       ];

  my $response = $bot->ua->post($url,$args);

  $response->is_success or die "HTTP " . $response->status_line;
}

#
#
#

sub rename_familiar {
  my $bot = shift;
  my $params = { @_ };

  my $check_response = $params->{check_response} || 0;

  my $url = $bot->url . 'familiar.php';

  $bot->ua->max_size(0) unless $check_response;
  my $response = $bot->ua->post($url,
      [ action          => 'rename',
	pwd             => $bot->hash,
	newname         => $params->{newname},
	]
				     );
  delete($bot->ua->{max_size});
  $response->is_success or die "HTTP " . $response->status_line;

  return 0 unless $check_response;

  $bot->check_response($response);

  # AWM: check more here

}

sub take_familiar {
  my $bot = shift;
  my $params = { @_ };

  my $check_response = $params->{check_response} || 0;

  my $url = $bot->url . 'familiar.php';

  $bot->ua->max_size(0) unless $check_response;
  my $response = $bot->ua->post($url,
      [ pwd             => $bot->hash,
	action          => 'newfam',
	newfam          => $params->{newfam},
	]
				);
  delete($bot->ua->{max_size});

  $response->is_success or die "HTTP " . $response->status_line;

  return 0 unless $check_response;

  $bot->check_response($response);

  # AWM more processing here
}

sub get_users_from_skills {
  my $bot = shift;

  my $url = $bot->url . 'skills.php';

  my $response = $bot->ua->get($url);
  $response->is_success 
    or die "HTTP " . $response->status_line;
  $bot->check_response($response);

  $response->content =~ /---Online Players---<\/options>(.*?)<\/select>/;
  my $content = $1;
  my @lines=split(/<\/option>/,$content);
  my $ids = [];
  my $names = [];
  for(@lines) {
    /value=(\d+)>(.*)/;
    push @$ids,$1;
    push @$names,$2;
  }
  return ($ids,$names);
}

# 3 is smile of Mr. A.

sub use_skill {
  my $bot = shift;
  my $params = { check_return => 0,
		 castings => 1,
		 @_ };
  my $check_return = $params->{check_return};

  my $url = $bot->url . 'skills.php';

  $bot->ua->max_size(0) unless $check_return;
  my $args = 
      [ pwd             => $bot->hash,
	action          => 'Skillz',
	whichskill      => $params->{skill},];
  if(exists($params->{tplayer})) {
    push @$args, specificplayer  => $params->{tplayer},
                 bufftimes       => $params->{castings};
  } else {
    push @$args, quantity => $params->{castings};
  }

  my $response = $bot->ua->post($url,$args);
  delete($bot->ua->{max_size});

  # For some applications, it might be desirable to look at the
  # response for other failure messages.


#  die $response->content unless($response->content =~ /aucesphere/);

  # Succeeded is 206 Partial Content
#  $response->is_success and return 0;
#  die "HTTP " . $response->status_line;
  $response->is_success or die "HTTP " . $response->status_line;

  return $bot->parse_response($response->content);
}

#
# Do recipe is an overall function that can do lots of stuff
#

sub do_recipe {
  my $bot = shift;
  my $r = shift;
  my $check_response = shift || 0;

  my ($rv,$text,@prods) 
    = $bot->do_general($r->reagents,$r->action,$check_response);

  return ($rv,$text,@prods) unless ($rv);

  my $error = 0;
  my @cprods = @prods;
 LOOPI:
  for my $i (0..$#{$r->products}) {
    for my $j (0..$#cprods) {
      if($r->products->[$i] == $cprods[$j]) {
	splice @cprods,$i,1;
	next LOOPI;
      }
    }
    $error = 1;
    last LOOPI;
  }
  if($error or @cprods) {
    warn "recipe on file doesn't match items received, prods = (",
     join(',',@prods),")";
    $bot->{error} = "recipe on file doesn't match items received";
    return (1,$text,@prods);
  }
  return (1,$text,@prods);
}

# item stuff

sub inv_equip_save_custom {
  my $bot = shift;
  my $name = shift;

  my $url = $bot->url . 'inv_equip.php?which=2';
  my $args = [action => 'customoutfit',
	      outfitname => $name,
	      pwd  => $bot->{hash},
	      ];
  my $response = $bot->ua->post($url,$args);

  $response->is_success or die "HTTP " . $response->status_line;

  $response->content =~ /<option value=(-\d+)>Custom: $name<\/option>/
    and return $1;

  return 0;
}

sub inv_equip_outfit {
  my $bot = shift;
  my $outfit_id = shift;

  my $url = $bot->url . 'inv_equip.php';
  my $args = [action => 'outfit',
	      whichoutfit => $outfit_id,
	      which => 2,
	      pwd  => $bot->{hash},
	      ];
  my $response = $bot->ua->post($url,$args);

  $response->is_success or die "HTTP " . $response->status_line;
}

sub equip {
  my $bot = shift;
  my $item_id = shift;

  my $url = $bot->url
    . 'inv_equip.php?'
    . 'pwd=' . $bot->{hash} 
  . '&which=2&action=equip&whichitem=' . $item_id;
  my $response = $bot->ua->get($url);

  $response->is_success or die "HTTP " . $response->status_line;

  return $bot->parse_response($response->content);
}

sub unequip {
  my $bot = shift;
  my $type = shift;

  $type =~ /^(hat|weapon|pants|acc1|acc2|acc3|familiarequip)$/ 
    or die "Unequip: unknown type";

  my $url = $bot->url
    . 'inv_equip.php?which=2&action=unequip&type=' . $type
    . '&pwd=' . $bot->{hash};
  my $response = $bot->ua->head($url);
  $response->is_success or die "HTTP " . $response->status_line;
}

sub unequipall {
  my $bot = shift;

  my $url = $bot->url
    . 'inv_equip.php?&pwd=' . $bot->{hash} . '&action=unequipall';
  my $response = $bot->ua->head($url);
  $response->is_success or die "HTTP " . $response->status_line;
}

sub inventory_makestuff {
  my $bot = shift;
  my %params = @_;

  my $url = $bot->url . 'inventory.php';
  my $args = [quantity => $params{quantity} || 1,
	      action => 'makestuff',
	      pwd  => $bot->{hash},
	      whichitem => $params{whichitem},
	      ];
  my $response = $bot->ua->post($url,$args);
  $response->is_success or die "HTTP " . $response->status_line;
  return parse_response($response->content);
}

# AWM: get rid of this
# migrated to use new generic format, which sucks!
sub use {
  my $bot = shift;
  my $item = shift;
  my $check_response = shift || 0;

  return $bot->do_general([$item],'use',$check_response);
}

sub multiuse {
  my $bot = shift;
  my $item = shift;
  my $quant = shift;
  my $check_response = shift || 0;

  my $url = $bot->url . 'multiuse.php';
  $bot->ua->max_size(0) unless($check_response);
  my $args =
      [ action          => 'useitem',
	whichitem       => $item,
	pwd             => $bot->hash,
	quantity        => $quant,
	];
  my $response = $bot->ua->post($url,$args);
  delete($bot->ua->{max_size});

  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);

  return 0 unless $check_response;

  return $bot->parse_response($response->content);
}


# general use an inventory item.
# returns (error code, descriptive text, obtained items)
sub do_general {
  my $bot = shift;
  my $reagents = shift;
  my $action = shift;
  my $check_response = shift || 0;

  my $item_name='([01-9a-z \-\'()]|&trade;|&ntilde;)+';
#  my $item_name='([a-z ]|&trade;|&ntilde;)+';

  if($action eq 'use') {
    my $url = $bot->url . 'inv_use.php?'
      . 'pwd=' . $bot->{hash}
      . '&which=3&whichitem=' . $reagents->[0];
    my $response;

    if(!$check_response) {
      $response = $bot->ua->head($url);
      $response->is_success or die "HTTP " . $response->status_line;
      return 1;
    }

    $response = $bot->ua->get($url);

    $response->is_success or die "HTTP " . $response->status_line;

    $bot->check_response($response);

    return 0 unless $check_response;

    return $bot->parse_response($response->content);

    # AWM: not used!

    # Are there any products?  Don't need to be.

    unless($response->content =~
   m{<td.*?><b>Results:</b></td></tr><tr>.*?<blockquote>(.*?)</blockquote>}
	   ) {
      return 1;
    }

    my $content = $1;
    if($content !~ /<center>/) {
      return (1,$content);
    }

    if($content =~ /You\s+gain\s+([\d,]+)\s+(Mana|Muscularity|Mojo)\s+Points?/i) {
      my $mp = $1;
      $mp =~ s/,//g;
      return (0,"mana ($mp)");
    }

    if($content =~ /You acquire an effect: <b>(.*?)<\/b><br>\(duration: ([\d,]+) Adventures\)/) {
      my $d = $2;
      $d =~ s/,//g;
      return (0,$1 . " (" . $d . ")");
    }

    $content =~ m{^(.*)<center><table><tr>(.*)</tr></table></center>};
    my $text = $1;
    $content = $2;

    my $pic = '<img.*?whichitem=(\d+).*?>';

    my @prods = ();
    
    my @content = split(m{</tr></table></center><center><table><tr>},$content);
    for(@content) {
      next if($_ =~ /^\s*$/);
      if($_ =~
   m{<td>$pic</td><td.*?>You acquire an item: <b>($item_name)</b></td>}i) {
#	 m{<td>$pic} ){

	my $result_desc = $1;
	my $result_name = $2;

	my $ri =  $bot->items->get_item(desc => $result_desc,
					name => $result_name,
					number => 1);

	push @prods,$ri->id;
	next;
      }
      warn "couldn't match fragment $_";
    }
    return (1,$text,@prods);
  }
  die "didn't recognize command";
}

sub eat_item {
  my $bot = shift;
  my $item_no = shift;
  my $check_response = shift || 0;

  my $url = $bot->url . 'inv_eat.php?'
    . 'pwd=' . $bot->{hash} . '&'
    . 'which=1&whichitem=' . $item_no;

  my $response;
  if($check_response) {
    $response = $bot->ua->get($url);
  } else {
    $response = $bot->ua->head($url);
  }

  # Again, it might be useful to check for other failures

  $response->is_success or die "HTTP " . $response->status_line;

  return 0 unless $check_response;

  return $bot->parse_response($response->content);

#  return (0,$text,$results);
}

sub drink_item {
  my $bot = shift;
  my $item_no = shift;
  my $check_response = shift;

  my $url = $bot->url 
    . 'inv_booze.php?'
    . 'pwd=' . $bot->{hash}
    . '&which=1&whichitem=' . $item_no;

  my $response;
  if($check_response) {
    delete($bot->ua->{max_size});
    $response = $bot->ua->get($url);
  } else {
    $response = $bot->ua->head($url);
  }

  # Again, it might be useful to check for other failures

  $response->is_success or die "HTTP " . $response->status_line;

  return 0 unless $check_response;

  return $bot->parse_response($response->content);
}

sub starchart {
  my $bot = shift;
  my %params = @_;

  my $url = $bot->url . 'starchart.php';
  my $args =
      [ action          => 'makesomething',
	pwd             => $bot->hash,
	numstars        => $params{numstars},
	numlines        => $params{numlines},
	];
  my $response = $bot->ua->post($url,$args);

  $response->is_success or die "HTTP " . $response->status_line;

  return $bot->parse_response($response->content);
}

# AWM: only dense meat stacks
# OBSOLETE
sub create_item {
  my $bot = shift;
  my $item_no = shift;
  my $verify = shift || 0;

  my $url;
  if($item_no == 258) {
    $url = $bot->url . 'inventory.php?'
      . 'which=3&action=densestack';
  } elsif ($item_no == 25) {
    $url = $bot->url . 'inventory.php?'
      . 'which=3&action=1000paste';
  } else {
    die "Don't know how to make item $item_no\n";
  }
  my $response;

  if(!$verify) {
    $response = $bot->ua->head($url);
    $response->is_success or die "HTTP " . $response->status_line;
    return 0;
  }

  $response = $bot->ua->get($url);

  $response->is_success or die "HTTP " . $response->status_line;

  if($item_no == 258) {
    $response->content =~ /You acquire an item: <b>dense meat stack/
      and return 0;
  } elsif ($item_no == 25) {
    $response->content =~ /You\s+acquire\s+some\s+items:\s+<b>meat\s+paste\s+\(1000\)/i
      and return 0;
  }

  $bot->check_response($response);

  die "unrecognized response,: ",$response->content;
}

sub cook {
  my $bot = shift;
  my $params = {quantity => 1,
		check_response => 0,
		@_};

  my $url = $bot->url . 'cook.php';
  $bot->ua->max_size(0) unless($params->{check_response});
  my $args =
      [ action          => 'combine',
	pwd             => $bot->hash,
	item1           => $params->{item1},
	item2           => $params->{item2},
	quantity        => $params->{quantity},
	];
  ($params->{makemax}) and push @$args,('makemax' => 'on');
  my $response = $bot->ua->post($url,$args);
  delete($bot->ua->{max_size});

  # Again, it might be useful to check for other failures

  $response->is_success or die "HTTP " . $response->status_line;

  return unless $params->{check_response};

  $bot->check_response($response);

  return $bot->parse_response($response->content); 
}

sub cocktail {
  my $bot = shift;
  my $params = {quantity => 1,
		check_response => 0,
		@_};

  my $url = $bot->url . 'cocktail.php';
  $bot->ua->max_size(0) unless($params->{check_response});
  my $args =
      [ action          => 'combine',
	pwd             => $bot->hash,
	item1           => $params->{item1},
	item2           => $params->{item2},
	quantity        => $params->{quantity},
	];
  ($params->{makemax}) and push @$args,('makemax' => 'on');
  my $response = $bot->ua->post($url,$args);
  delete($bot->ua->{max_size});

  # Again, it might be useful to check for other failures

  $response->is_success or die "HTTP " . $response->status_line;

  return unless $params->{check_response};

  $bot->check_response($response);

  return $bot->parse_response($response->content); 
}

sub combine {
  my $bot = shift;
  my $params = {quantity => 1,
		check_response => 0,
		@_};

  unless(exists($params->{item1})) {
    $params->{check_response} = 1;
  }

  my $url = $bot->url . 'combine.php';
  my $args =
      [ action          => 'combine',
	pwd             => $bot->hash,
	item1           => $params->{item1},
	item2           => $params->{item2},
	quantity        => $params->{quantity},
	];
  ($params->{makemax}) and push @$args,('makemax' => 'on');
  my $response;
  if(exists($params->{item1})) {
    $bot->ua->max_size(0) unless($params->{check_response});
    $response = $bot->ua->post($url,$args);
    delete($bot->ua->{max_size});
  } else {
    if($params->{check_response}) {
      $response = $bot->ua->get($url,$args);
    } else {
      # Why would you do this?  You can't now.
      $response = $bot->ua->head($url,$args);
    }
  }

  # Again, it might be useful to check for other failures

  $response->is_success or die "HTTP " . $response->status_line;

  return unless $params->{check_response};

  $bot->check_response($response);

  my ($rv,$txt,$prods) = $bot->parse_response($response->content);

  # parse items
  my $inv = {};

  my $content = $response->content;
  # No meat paste
  $content =~ /<option value=0>-select an item-<\/option>/
    or return($rv,$txt,$prods);
  $content =~ s/<option value=0>-select an item-<\/option>//g;
  while($content =~ m{<option value=(\d+)>(.+?) \((\d+)\)</option>}g) {
    next if $1 == 0;
    $inv->{$1} = $3;
  }

  return ($rv,$txt,$prods,$inv);
}

sub combine_for_inventory {
  my $bot = shift;

  my $url = $bot->url . 'combine.php';
  my $response = $bot->ua->get($url);

  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);

  # parse items
  my $inv = {};

  my $content = $response->content;
  # No meat paste
  $content =~ /<option value=0>-select an item-<\/option>/
    or return;			# UNDEF means no meat paste
  $content =~ s/<option value=0>-select an item-<\/option>//g;
  while($content =~ m{<option value=(\d+)>(.+?) \((\d+)\)</option>}g) {
    next if $1 == 0;
    $inv->{$1} = {id => $1,
		  name => $2,
		  number => $3};
  }

  return ($inv);
}

sub uneffect {
  my $bot = shift;
  my $effect = shift;

  my $url = $bot->url . 'uneffect.php';
  my $args =
      [
       pwd => $bot->hash,
       using => 'Yep.',
       whicheffect => $effect,
	];
  my $response = $bot->ua->post($url,$args);
  $response->is_success or die "HTTP " . $response->status_line;
  $bot->check_response($response);

  return $bot->parse_response($response->content); 
}
  

sub parse_response {
  my $bot = shift;
  my $content = shift;

  my $text = '';
  my $prods = {};

  confess "no content" unless($content);
    
  $content =~ s/<table><tr><td style='border: 1px solid black;'><font color=green>.*?<\/table>//g; # dev code
  $content =~ s/\s+/ /ig;
  $content =~ s/<center>//ig;
  $content =~ s/<\/center>//ig;
  $content =~ s/<td.*?>//ig;
  $content =~ s/<\/td>//ig;
  $content =~ s/<\/table>/\t/ig;
  $content =~ s/<table.*?>/\t/ig;
  $content =~ s/<br>/\t/gi;
  $content =~ s/<p>/\t/gi;
  $content =~ s/<tr>/\t/ig;
  $content =~ s/<\/tr>/\t/g;
  $content =~ s/<tr>/\t/g;

  $content =~ s/&quot;/\"/g;

  if($content =~ m|<b>The Kingdom of Loathing</b>|) {
    # got main.php
    return (0,"main",{});
  }

  my $mode;
  if($content =~ m{<b>Results:</b>(.*?)<b>Inventory:</b>}) {
    $mode = 'inventory';
    $content = $1;
  } elsif ($content =~ m{<b>Results:</b>(.*?)<b>Make Cocktails:</b>}) {
    $mode = 'cocktails';
    $content = $1;
  } elsif ($content =~ m{<b>Results:</b>(.*?)<b>Cook Stuff:</b>}) {
    $mode = 'cook';
    $content = $1;
  } elsif ($content =~ m{<b>Results:</b>(.*?)<b>Combine Items:</b>}) {
    $mode = 'combine';
    $content = $1;
  } elsif ($content =~ m{<b>Results:</b>(.*?)<b>Use Multiple Items</b>}) {
    $mode = 'use_multiple';
    $content = $1;
  } elsif ($content =~ m{<b>Results:</b>(.*?)<b>Star Chart</b>}) {
    $mode = 'star_chart';
    $content = $1;
  } elsif ($content =~ m{<b>Results:</b>(.*?)<b>Doc Galaktik\'s Medicine Show</b>}) {
    $mode = 'npc_store';
    $content = $1;
  } elsif ($content =~ m{<b>Results:</b>(.*?)<b>The Untinker</b>}) {
    $mode = 'npc_store';
    $content = $1;
  } elsif ($content =~ m{<b>Market Results:</b>(.*?)<b>The Demon Market</b>}) {
    $mode = 'npc_store';
    $content = $1;
  } elsif ($content =~ m{<b>Market Results:</b>(.*?)<b>Gouda\'s Grimoire and Grocery</b>}) {
    $mode = 'npc_store';
    $content = $1;
  } elsif ($content =~ m{<b>Market Results:</b>(.*?)<b>The Meatsmith\'s Shop</b>}) {
    $mode = 'npc_store';
    $content = $1;
  } elsif ($content =~ m{<b>Market Results:</b>(.*?)<b>The Knob Goblin Laboratory</b>}) {
    $mode = 'npc_store';
    $content = $1;
  } elsif ($content =~ m{<b>Market Results:</b>(.*?)<b>White Citadel</b>}) {
    $mode = 'npc_store';
    $content = $1;
  } elsif ($content =~ m{<b>Results:</b>(.*?)<b>The Entrance Cavern \(2\)</b>}) {
    $mode = 'ec2';
    $content = $1;
  } elsif ($content =~ m{<b>Results:</b>(.*?)<b>Use Skills:</b>}) {
    $mode = 'skills';
    $content = $1;
  } elsif ($content =~ m{<b>Results:</b>(.*?)<b>The Hermit</b>}) {
    $mode = 'hermit';
    $content = $1;
  } elsif ($content =~ /<b>Results:<\/b>(.*?)<b>Adventure Again:<\/b>/) {
    $mode = 'results';
    $content = $1;
    # $mode = 'results';
  } elsif ($content =~ /<b>Results:<\/b>(.*?)<b>The Cellar of the Typical Tavern<\/b>/) {
    $mode = 'adv_results';
    $content = $1;
    $prods->{adventure_again} = 'rats';
  } elsif ($content =~ /<b>Results:<\/b>(.*?)<b>Results:<\/b>.*Innabox the Smith/i) {
    $mode = 'innabox';
    $content = $1;
  } elsif ($content =~ /<b>Results:<\/b>(.*?)<b>Results:<\/b>.*The Plunger/) {
    $mode = 'plunger';
    $content = $1;
  } elsif ($content =~ /<b>Results:<\/b>(.*?)$/) {
    return (1,"can't tell type of results, $content");
    # $mode = 'results';
  } elsif ($content =~ m{<b>Combat!</b>(.*?)<form name}) {
    $mode = 'combat';		# The form is an attack button.
    $content = $1;
  } elsif ($content =~ m{<b>Combat!</b>(.*?)<a href="adventure.php\?snarfblat=(\d+)">Adventure Again}) {
    $mode = 'combat';
    $content = $1;
    $prods->{adventure_again} = $2;
  } elsif ($content =~ m{<b>Combat!</b>(.*?)<a href="(\w+).php">(Go back|Return)}) {
    $mode = 'combat';
    $content = $1;
    $prods->{return_to} = $2;
#   } elsif ($content =~ m{<b>Combat!</b>(.*?)<a href="rats.php"}) {
#     $mode = 'combat';
#     $content = $1;
#     $prods->{adventure_again} = 'rats';
#   } elsif ($content =~ m{<b>Combat!</b>(.*?)<a href="cyrpt.php">}) {
#     # appears when killing cyrpt mini-boss
#     $prods->{area_undefiled} = 1;
#     $mode = 'combat';
#     $content = $1;
#   } elsif ($content =~ m{<b>Combat!</b>(.*?)<a href="bathole.php">}) {
#     $mode = 'combat';
#     $content = $1;
#     $prods->{adventure_again} = 34;
#   } elsif ($content =~ m{<b>Combat!</b>(.*?)<a href="knob.php">}) {
#     $mode = 'combat';
#     $content = $1;
#     $prods->{adventure_again} = 'king';
  } elsif ($content =~ m{<b>Adventure Results:</b>(.*?)<form name}) {
    $mode = 'adv_results';
    $content = $1;
  } elsif ($content =~ m{<b>Adventure Results:</b>(.*)<a href="adventure.php\?snarfblat=(\d+)">Adventure Again}) {
    $mode = 'adv_results';
    $content = $1;
    $prods->{adventure_again} = $2;
  } elsif ($content =~ m{<b>Adventure Results:</b>(.*)<a href="(\w+).php">Adventure Again}) {
    $mode = 'adv_results';
    $content = $1;
    $prods->{adventure_again} = $2;
  } elsif ($content =~ m{<b>Adventure Results:</b>(.*)<a href='(\w+).php'>Return}) {
    $mode = 'adv_results';
    $content = $1;
    $prods->{return_to} = $2;
#   } elsif ($content =~ m{<b>Adventure Results:</b>(.*)<a href='sewer.php'>}) {
#     $mode = 'adv_results';
#     $content = $1;
#     $prods->{adventure_again} = 'sewer';
#   } elsif ($content =~ m{<b>Adventure Results:</b>(.*)<a href='woods.php'>}) {
#     $mode = 'adv_results';
#     $content = $1;
#     $prods->{adventure_again} = 'woods';
  } elsif ($content =~ m{<b>Adventure Results:</b>(.*)}) {
    $mode = 'adv_results';
    $content = $1;
  } elsif ($content =~ m{<body>\s*<b>(.*?)</b>(.*choiceform.*)}) {
    $prods->{encounter} = $1;
    $content = $2;
    $mode = 'adv_choice';
  } else {
    return (1,"can't tell what happened, $content");
  }

  if($content =~ /That doesn\'t make any sense. Please select an item before you hit that button./) {
    return (1,"No sense (items attack)");
  }
  if($content =~ /You can\'t afford that much medicine, my friend!/) {
    return(1,"Not enough meat.");
  }
  if($content =~ /You don\'t have enough of one of the/) {
    return(1,"Not enough items.");
  }
  if($content =~ /You don\'t have that many of that item/) {
    return(1,"Not enough items.");
  }
  if($content =~ /You don\'t have the item you\'re trying to use/) {
    return(1,"Not enough items.");
  }
  if($content =~ /You don\'t have enough one of the/) {
    return(1,"Not enough items.");
  }
  if($content =~ /You don\'t have that many adv/) {
    return(1,"Not enough adventures.");
  }
  if($content =~ /Those (two )?items don\'t combine/) {
    return(1,"Nothing interesting.");
  }
  if($content =~ /You don\'t have that skill/) {
    return(1,"You don't have that skill.");
  }
  if($content =~ /No such skill./) {
    return(1,"No such skill.");
  }
  if($content =~ /You don\'t have enough (Muscularity|Mana|Mojo) Points to use that skill./) {
    return(1,"Not enough MP.");
  }
  $content =~ /You\'re too full/i
    and return(1,"Too full.");
  $content =~ /You can\'t afford that many of that item/i
    and return(1,"You can't afford that item.");
  $content =~ /You can\'t afford that item/i
    and return(1,"You can't afford that item.");
  $content =~ /is bad for your spleen/i
    and return(1,"Bad spleen.");
  $content =~ /This part of the cyrpt is already/i
    and return(1,"already undefiled");
  $content =~ /You shouldn\'t be here/i
    and return(1,"Should not be here");
  $content =~ /more than 30 rounds,/i
    and return(1,"More than 30 rounds");
  if($content =~ /You must have at least (\d+) base (Moxie|Muscle|Mysticality) to equip/i) {
    return(1,"Stat fail $1 $2");
  }
  if($content =~ /You already have too many songs stuck in your head/) {
    return(1,"Too many songs.");
  }
  if($content =~ /You\'re not healthy enough to play this game\. Come back when you\'re a little better rested/i) {
    return(1,"Need HP for skeleton key");
  }
  if($content =~ /You don\'t have the item you\'re trying to equip\./) {
    return(1,"Don't have item being equipped.");
  }

  my $epic = '<img.*?adventureimages.*?\.gif.*?>';
  my $ipic = '<img.*?descitem\((\d+)\).*?>';
  my $item_name='([01-9a-z \-\'()\.]|&trade;|&ntilde;)+';
  my $pl_item_name='([01-9a-z \-\'\.]|&trade;|&ntilde;)+';

  $content =~ s/\t(\(duration: (\d+) Adventures\))/$1/g;

  my @content = split(m{\t},$content);
 
  my $f = 0;
  my $open = 0;
  for(@content) {
    next if(/^\s*$/);
#    next if(/^<font color=green>.*<\/font>$/); # Dev code

    $f++;

    if(/Ah, here\'s the problem. Somebody evidently left the rat faucet on down here\./i) {
      $prods->{encounter} = 'faucet';
      next;
    }

    if(m{${ipic}You acquire an item: <b>($item_name)</b>}i) {

      my $result_desc = $1;
      my $result_name = $2;

      my $ri =  $bot->items->get_item(desc => $result_desc,
				      name => $result_name,
				      number => 1);
      if(!defined($ri)) {
	print "UNDEFINED, $result_desc, $result_name\n";
	next;
      }

      $prods->{$ri->id} += 1;
      next;
    }

    if(m{${ipic}You acquire some items: <b>($pl_item_name) \(([\d,]+)\)</b>}i) {

      my $result_desc = $1;
      my $result_name = $2;
      my $number = $4;
      $number =~ s/,//g;

      my $ri =  $bot->items->get_item(desc => $result_desc,
				      name => $result_name,
				      number => $number);

      $prods->{$ri->id} += $number;
      next;
    }

    if(m{${ipic}You acquire <b>([\d,]+) ($item_name)</b>}i) {

      my $result_desc = $1;
      my $result_name = $3;
      my $number = $2;
      $number =~ s/,//g;

      my $ri =  $bot->items->get_item(desc => $result_desc,
				      name => $result_name,
				      number => $number);

      die "Couldn't get item $result_desc $result_name" unless defined($ri);
      $prods->{$ri->id} += $number;
      next;
    }

    $mode eq 'combat' 
      and $f == 1
      and m{${epic}You\'re fighting <span id='monname'>(.*)</span>}i
      and $prods->{encounter} = $1, next;

    $mode eq 'adv_results' 
      and !exists($prods->{encounter})
      and m{<b>(.*)</b>}i
      and $prods->{encounter} = $1,next;

    $mode eq 'adv_results' 
      and m|^\s*$epic\s*$|i
      and next;

    $mode eq 'combat' 
      and m{<blockquote>(.*)</blockquote>}
      and $prods->{desc} = $1,next;

    $mode eq 'adv_results' 
      and m{<blockquote>(.*)</blockquote>}
      and $prods->{desc} = $1,next;

    $mode eq 'combat' 
      and m{<blockquote>(.*)}
      and $prods->{desc} = $1,$open = 1,next;

    $mode eq 'adv_results' 
      and m{<blockquote>(.*)}
      and $prods->{desc} = $1,$open = 1,next;

    $mode eq 'use_multiple'
      and m{<blockquote>(.*)}
      and $prods->{desc} = $1,$open = 1,next;

    $mode eq 'combat' 
      and $open == 1
      and m{(.*)</blockquote>}
      and $prods->{desc} .= " " . $1,$open = 0,next;

    $mode eq 'adv_results' 
      and $open == 1
      and m{(.*)</blockquote>}
      and $prods->{desc} .= " " . $1,$open = 0,next;

    $mode eq 'combat' 
      and $open == 1
      and $prods->{desc} .= " " . $_,next;

    $mode eq 'adv_results'
      and $open == 1
      and $prods->{desc} .= " " . $_,next;


    ## Combat section
    if($mode eq 'combat') {
      /You twiddle your thumbs./i
	and $prods->{twiddle} = 1,next;

      /You conjure a saucy salve and quickly apply it to your wounds\./
	and $prods->{skill} = $_,next;

      /You call forth a (.*?), which strikes your opponent for (\d+) damage./
	and $prods->{damage_spell} = $2,next;

# 120 (<b>+12</b>) (<font color=green><b>+2</b></font>) points worth of confusion

      if(/(\d+).*(damage|notches|points).*(bam|barf|biff|bonk|kapow|kerblam|pow|smack|socko|splat|squeak|whack|wham|whammo|zap|zot)/i) {
	$prods->{damage} = $1;
	m{\(<b>\+(\d+)</b>\)}i
	  and $prods->{damage_bonus_offhand} = $1;
	m{<font color=red>CRITICAL HIT!</font>}i
	  and $prods->{critical_hit} = 1;
	while(m{<font color=(\w+)><b>\+(\d+)</b></font>}ig) {
	  $1 eq 'red' and $prods->{damage_bonus_hot} = $2,next;
	  $1 eq 'blue' and $prods->{damage_bonus_cold} = $2,next;
	  $1 eq 'gray' and $prods->{damage_bonus_spooky} = $2,next;
	  $1 eq 'green' and $prods->{damage_bonus_stench} = $2,next;
	  $1 eq 'blueviolet' and $prods->{damage_bonus_sleaze} = $2,next;
	  print "UNKNOWN DAMAGE COLOR, $1\n";
	  $prods->{damage_bonus_other} += $2;
	}
	next;
      }

      /You work up a Thrust-Smack\./
	and $prods->{thrust_smack} = 1,next;
      /You work up a Lunging Thrust-Smack\./i
	and $prods->{lunging_thrust_smack} = 1,next;

#      m{hits your opponent for (\d+) damage}i
#	and $prods->{damage} = $1, next;

      m{You failed to hit}i
	and $prods->{damage} = 0, next;

      m{<b>FUMBLE!</b>.*doing (\d+) damage}i
	and $prods->{fumble_damage} = $1,next;

      m{(They) get the jump on you\.}i
	and $prods->{monster_init} = 1, next;
      m{(He|It|She) gets the jump on you\.}i
	and $prods->{monster_init} = 1, next;
      m{(You) get the jump on}i
	and $prods->{monster_init} = -1, next;

      m{(s?he|it).*?you.*?<b><font color=red>( Eek!| Ouch!| Ugh!| Oof!| Ow!| Ooh!| Argh!){1,}</font></b>}i
	and next;

      if(m{<img src="http://images.kingdomofloathing.com/itemimages/hp.gif" height=30 width=30>You lose (\d+) hit points?\.}i) {
	$prods->{in_damage} = $1;
	m{(cold|hot|sleaze|spelling|shadow|spooky|stench) damage}i
	  and $prods->{in_damage_type} = $1;
	next;
      }
      m/You lose (\d+) (Mana|Muscularity|Mojo) Points/
	and $prods->{mp_loss} = $1,next;

      m{You win the fight!<!--WINWINWIN-->}i
	and $prods->{win} = 1, next;

      # familiar stuff
      m{Starlight shines through your opponent, doing (\d+) damage, and pours into your body.}
        and $prods->{damage_familiar} = $1,next;
      m{shouts "Yarrrr!" and battens your opponent\'s hatches for him. Violently. For (\d+) damage.} 
        and $prods->{damage_familiar} = $1,next;

      m{kicks your opponent in the shin \(or shin-analogue\) with her clear plastic high-heels, for <font color=blueviolet><b>(\d+)</b></font> damage}i
        and $prods->{damage_familiar} = $1,next;

      m{bleeps, "MEDICAL SYSTEMS ACTIVATED," and fires a dart into your neck. You suddenly feel much better.}
        and $prods->{fam_heal} = $1,next;

      m{but you tell him}i
	and $prods->{monster_miss} = 1,next;
      m{but misses\.}i
	and $prods->{monster_miss} = 1,next;
      m{He.*loses a contact lens}i
	and $prods->{monster_miss} = 1,next;
      m{(He|she|it) tries.*\bbut\b}i
	and $prods->{monster_miss} = 1,next;
      m{They try.*\bbut\b}i
	and $prods->{monster_miss} = 1,next;
      m{no bullets}i
	and $prods->{monster_miss} = 1,next;
      m{you distractedly step}i
	and $prods->{monster_miss} = 1,next;
      m{shrug it off}i
	and $prods->{monster_miss} = 1,next;
      m{dodge with panache}i
	and $prods->{monster_miss} = 1,next;

      m{You use the spices.} and next;

      m{You shake some spices into your opponent\'s eyes, doing (\d+) damage\. (It|He|She) winces\.}i
	and $prods->{damage_useitem} += $1,next;
      
      /hose down your opponent for <font color=red><b>(\d+)<\/b><\/font> damage\./
	and $prods->{damage_useitem} += $1,next;

      /suffering (\d+) points of spelling damage/
	and $prods->{damage_useitem} += $1,next;

      m{Your opponent takes (\d+) damage from your Saucesphere\.}i
	and $prods->{damage_sphere} += $1,next;
      /Your Jaba&ntilde;ero Saucesphere does (\d+) damage to your opponent, and infuses you with renewed energy./
	and $prods->{damage_sphere} += $1,next;
      m{You lose. You slink}i
	and $prods->{win} = -1, next;
    }


    if($mode eq 'skills') {
      /A cocoon of cannelloni envelops you/
	and $prods->{desc} = $_,next;
      /You contemplate the Cosmic Sauce/
	and $prods->{desc} = $_,next;
      /You make with the empathy for yourself/
	and $prods->{desc} = $_,next;
      /You muster up some tenacity for yourself/
	and $prods->{desc} = $_,next;
      /You summon a Leash of Linguini./
	and $prods->{desc} = $_,next;
      /You envelop your body in Springy Fusilli/
	and $prods->{desc} = $_,next;
      /You play (The Polka of Plenty|The Moxious Madrigal|Fat Leon\'s Phat Loot Lyric|Jackasses\' Symphony of Destruction|Aloysius\' Antiphon of Aptitude), with yourself as your audience/i
	and $prods->{desc} = $_,next;
      /You conjure an Elemental Saucesphere around yourself/
	and $prods->{desc} = $_,next;
      /You conjure a Jaba&ntilde;ero Saucesphere around yourself/ 
	and $prods->{desc} = $_,next;
      /You practice the accordion. Moxiousness wells up within you\./
	and $prods->{desc} = $_,next;
      /You relax\. You chill\. You become\.\.\. smooth\./
	and $prods->{desc} = $_,next;
    }

    if($mode eq 'use_multiple' || $mode eq 'inventory') {
      /ou use the hair spray to stiffen your coiffure/
	and $prods->{desc} = $_,next;
    }

  if(m{<img class=hand src="http://images.kingdomofloathing.com/itemimages/(\w+)\.gif" onClick=\'eff\((\d+)\);\'.*?>You acquire an effect: <b>([\w\s\-\';\&]+)</b>\(duration: (\d+) Adventures\)}i) {
      
      $prods->{effects} ||= {};
      $prods->{effects}->{lc($3)} = {
	image => $1,
	id    => $2,
	name  => $3,
	turns => $4,
      };
      next;
    }

    /You gain (\d+) (Mana|Mojo|Muscularity) points?/i
      and $prods->{mp} ||= 0, $prods->{mp} += $1, next;

    /You gain (\d+) Hit points?/i
      and $prods->{hp} ||= 0, $prods->{hp} += $1, next;
    /You lose (\d+) Hit points?/i
      and $prods->{hp} ||= 0, $prods->{hp} -= $1, next;

    if(m{You gain (\d+) meat}i) {
      $prods->{meat} += $1;
      $prods->{meat_count}++;
      next;
    }

    if(/You\s+gain\s+([\d,]+)\s+adventures?/i) {
      my $a = $1;
      $a =~ s/,//g;
      $text .= "($a)";
      $prods->{adventures} = $a;
      next;
    }

    /Smoke begins to pour/
      and $text .= 'Box destroyed.',next;

    /<blockquote>You place the chef-in-the-box at your campsite. He makes himself at home\.<\/blockquote>/
      and $prods->{citb} = 1;

    /You gain (\d+) (Beef|Stren|Strong|Muscle|Fortit)/i
      and $prods->{muscle} += $1, next;
    /You gain (\d+) (Enchant|Magic|Myst|Wizard)/i
      and $prods->{myst} += $1,next;
    /You gain (\d+) (Smarm|Rogui|Chutz|Cheek|Sarcasm)/i
      and $prods->{moxie} += $1, next;
    /You lose (\d+) (Beef|Stren|Strong|Muscle|Fortit)/i
      and $prods->{muscle} -= $1, next;
    /You lose (\d+) (Enchant|Magic|Myst|Wizard)/i
      and $prods->{myst} -= $1, next;
    /You lose (\d+) (Smarm|Rogui|Chutz|Cheek|Sarcasm)/i
      and $prods->{moxie} -= $1, next;

    /<b>You gain a Level!<\/b>/
      and $prods->{level_gain} = 1,next;
    /You gain a (Mysticality|Muscle|Moxie) point/i
      and $prods->{lc($1) . '_point'} = 1,next;
    /does a little fairy dance\./i
      and $prods->{fam_item}++,next;
    /disappears for a moment/i
      and $prods->{fam_meat}++,next;
    /smiles approvingly\./i
      and $prods->{fam_stat}++,next;
    /smiles unsettlingly\./i
      and $prods->{fam_stat}++,next;

    /You\s+gain\s+([\d,]+)\s+drunk/i
      and $prods->{drunk} = $1, next;

    /You cook up a delicious new item\./
      and next;
    /The meat paste fuses your items together\./
      and next;
    /You hear an unhealthy-sounding clicking noise coming from inside your chef-in-the-box\./
      and next;

    /^\s*<\/blockquote>\s*$/i and next;
    /You mix up a refreshing cocktail/i and next;
#    m|^<img src="http://images.(kingdomofloathing|loathing2).com/itemimages/\w+.gif" width=30 height=30>$| and next;
    m|^<img src="http://images.kingdomofloathing.com/itemimages/\w+.gif" width=30 height=30>$| and next;
    /^<blockquote>You drink the/ and next;
    /^<blockquote>You take the shot of schnapps. Shnappy!/ and next;
    /^<blockquote>You read the scroll of drastic healing/ and next;

    if($mode eq 'adv_choice') {
      m{^<img src=".*?adventureimages/(\w+)\.gif" width=100 height=100>}
        and $prods->{image} = $1,next;

      while(m{<form name=choiceform action=choice\.php method=post><input type=hidden name=pwd value='[\da-f]+'><input type=hidden name=whichchoice value=(\d+)><input type=hidden name=option value=(\d+)><input class=button type=submit value="(.*?)"></form>}g) {
	if(exists($prods->{choice_value}) && $prods->{choice_value} != $1) {
	  die "choice adventure multiple values";
	}
	$prods->{choice_value} = $1;
	exists($prods->{'choice_' . $2}) and die "same option multiple times";
	$prods->{'choice_' . $2} = $3;
      }
      /^<\/body><\/html>$/ and next;
      
      $prods->{desc} ||= '';
      s{<form name=choiceform action=choice\.php method=post><input type=hidden name=pwd value='[\da-f]+'><input type=hidden name=whichchoice value=(\d+)><input type=hidden name=option value=(\d+)><input class=button type=submit value="(.*?)"></form>}{}g;
      $prods->{desc} .= $_;
      next;
    }

    warn "couldn't match fragment $mode $f $_";
  }

  $prods->{mode} = $mode;
  return (0,$text,$prods);
}

sub use_campground_skill {
  my $bot = shift;
  my $skill = shift;

  my $url = $bot->url . 'campground.php';
  $bot->ua->max_size(0);
  my $args =
      [
	action          => 'skill'.$skill,
	];
  my $response = $bot->ua->post($url,$args);
  delete($bot->ua->{max_size});

  # Again, it might be useful to check for other failures

  $response->is_success or die "HTTP " . $response->status_line;
}


#
# returns a reference to an array of items with a number field added
#

sub get_inventory {
  my $bot = shift;
  my $page = shift;
  my $equip = shift;
  my $no_get_item = shift;

  $bot->ua->timeout($bot->config->{timeout});

  my $url = $bot->url . 'inventory.php?which=' . $page;
  my $response = $bot->ua->get($url);

  $response->is_success
    or die 'HTTP ' . $response->status_line;

  $bot->check_response($response);

  die 'unknown response in get_inventory, ',$response->content
    unless $response->content =~ m|<b>Inventory:</b>|;

  # get rid of head and tail, keep only the juicy filling

  my $content = $response->content;

  $content =~
    m|<center>Though your sack is large, it contains no food or beverages|
    and return ( $equip ? ([],{}) : []);
  $content =~
    m|<center>Though your sack is large, it contains no equipment|
    and return ( $equip ? ([],{}) : []);

  $content =~
    m|<Table width=100%>(.*)</table></div>|
    or die $content;

  $content = $1;

#  $content =~ s/&quot;/\"/g;

  my $items = [];
  if($content =~ m{http://images.kingdomofloathing.com/itemimages/}) {
    while($content =~ m{onClick='descitem\((\d+)\);'></td><td valign=top><b>(.*?)</b> ( \((\d+)\))?}g) {
      my $desc = $1;
      my $name = $2;
      my $number = $4 || 1;
      if($no_get_item) {
	push @$items, {desc => $desc,
		       name => $name,};
      } else {
	my $i = $bot->items->get_item(desc => $desc,
				      name => $name,
				      number => $number);
	warn "no $desc $name" unless $i;
	push @$items,new KoLBot::Item(desc => $desc, name => $name,
				      id => $i->{id},
				      number => $number);
      }
    }
  } else {
    # works for inventory images off (top two patterns)
    while($content =~ m{<td valign=top>(.*?)</td>}g) {
      my $itemp = $1;
      if($itemp =~ m{<b><a onClick='javascript:descitem\((\d+)\);'>(.*?)</a></b> \((\d+)\)}) {
	my $desc = $1;
	my $name = $2;
	my $number = $3;
	if($no_get_item) {
	  push @$items, {desc => $desc,
			 name => $name,};
	} else {
	  my $i = $bot->items->get_item(desc => $desc,
					name => $name,
					number => $number);
	  warn "no $desc $name" unless $i;
	  push @$items,new KoLBot::Item(desc => $desc, name => $name,
					id => $i->{id},
					number => $number);
	}
      } elsif ($itemp =~ m{<b><a onClick='javascript:descitem\((\d+)\);'>(.*?)</a></b>}) {
	my $desc = $1;
	my $name = $2;
	my $number = 1;
	if($no_get_item) {
	  push @$items, {desc => $desc,
			 name => $name,};
	} else {
	  my $i = $bot->items->get_item(desc => $desc,
					name => $name,
					number => $number);
	  warn "no $desc $name" unless $i;
	  push @$items,new KoLBot::Item(desc => $desc, name => $name,
					id => $i->{id},
					number => $number);
	}
      } else {
	die "Not an item: $itemp";
      }
    }
  }
  my $equipped = {};
  $content = $response->content;
  if($page == 2) {
    while($content =~ m{<img .*? onClick='descitem\((\d+)\)';></td><td><b>(.*?)</b>.*?<a href="inv_equip.php\?pwd=[01-9a-f]+\&which=2\&action=unequip\&type=(.*?)">}g) {
      if($no_get_item) {
	$equipped->{$3} =  {desc => $1,
			    name => $2,
			    number => 1};
      } else {
	$equipped->{$3} =  $bot->items->get_item(desc => $1,
						 name => $2,
						 number => 1);
      }
    }
  }

  if($equip) {
    return ($items,$equipped);
  } else {
  EQ:
    for (keys %$equipped) {
      for my $i (@$items) {
	if($i->{desc} == $equipped->{$_}->{desc}) {
	  $i->{number} += $equipped->{$_}->{number};
	  next EQ;
	}
      }
      push @$items,$equipped->{$_};
    }
    return $items;
  }
  # uh....
  return $items;
}

# we expect that the item is in our inventory, but not in the bot's
# items.
# BROKEN, AWM
sub find_item {
  my $bot = shift;
  my $args = { @_ };

  my $item_name = $args->{name};
  my ($cinv,$inv) = $bot->get_closet();
  # empty the closet
  for(@$cinv) {
    my $url = $bot->url . 'closet.php?action=take&howmany=all&whichitem='
      . $_->id;
    my $response = $bot->ua->head($url);

    $response->is_success
      or die 'HTTP ' . $response->status_line;
  }
  ($cinv,$inv) = $bot->get_closet();
  if(@$cinv) {
    die "FATAL: that should have emptied the closet.";
  }

  # Ok, our closet is empty, so put in the items we don't know about
  for(@$inv) {
    if(lc($_->name) eq lc($args->{name})) {
      my $url = $bot->url . 'closet.php';

      $bot->ua->max_size(0);
      my $response = $bot->ua->post($url,
	    [ action    => 'put',
	      whichitem => $_->id,
	      pwd       => $bot->hash,
	      howmany   => 'one',]);
      delete($bot->ua->{max_size});
      $response->is_success
	or die 'HTTP ' . $response->status_line;
    }
  }
  ($cinv,$inv) = $bot->get_closet();

  my @nitems = ();
  for(@$cinv) {
    print "MISSING ITEM ADDED, ",$_,"\n";
    $bot->items->add($_);
    push @nitems,$_;

    my $url = $bot->url . 'closet.php?action=take&howmany=all&whichitem='
      . $_->id;
    my $response = $bot->ua->head($url);

    $response->is_success
      or die 'HTTP ' . $response->status_line;
  }

  ($cinv,$inv) = $bot->get_closet();
  if(@$cinv) {
    die "FATAL: that should have emptied the closet.";
  }

  if(@nitems==0) {
    print "No matches\n";
    return undef;
  }

  if(@nitems==1) {
    return $nitems[0];
  }

  my $item = undef;
  for(@nitems) {
    if($_->desc == $args->{desc}) {
      if($item) {
	print "Two or more descr matches\n";
	return undef;
      }
      $item = $_;
    }
  }

  if($item) {
    return $item;
  }
    

  print "No descr matches\n";
  return undef;
}

#
# Returns two references to hashes.  The first is the number of items in 
# the closet and the second is the items in the inventory according 
# to the closet page
#

sub closet {
  my $bot = shift;
  my $params = {@_};

  $bot->ua->timeout($bot->config->{timeout});
  my $url = $bot->url . 'closet.php';
  my $response = $bot->ua->get($url);

  $response->is_success
    or die 'HTTP ' . $response->status_line;

  $bot->check_response($response);

  unless($response->content =~ m|<b>Your Colossal Closet</b>|) {
    $response->content =~ /You twiddle your thumbs./i
      and die "IN_COMBAT";
    die 'unknown KoLBot::closet, ',$response->content;
  }

  # clean up
  my $content = $response->content;
  $content =~ s/\s+/ /g;

  my $meat = 0;
  $content =~ 
      m|<b>Your closet contains ([\d,]+) meat.</b>|
      and $meat = $1;
  $meat =~ s/,//g;

  my $closet = {};
  my $inv = {};

  # closet items
  if ($content =~ 
      m|<b>Take: <input type=text size=2 name=howmany1> </b> <select name="whichitem1"> <option value=0>-select an item-</option><option (.*?)</option></select>|) {

    my $closet_s = $1;
    my @closet_s = split m{</option><option },$closet_s;

    for (@closet_s) {
      m{value='(\d+)' descid='(\d+)'>(.*) \(([\d,]+)\)}
        or die "Not an item: $_";

      my $id = $1;
      my $name = $2;
      my $number = $3;
      $number =~ s/,//g;

      $closet->{$id} = $number;
    }
  }

  # inventory items
  if ($content =~ 
      m|<b>Put: <input type=text size=2 name=howmany1> </b> <select name="whichitem1"> <option value=0>-select an item-</option><option (.*?)</option></select>|) {
    my $closet_s = $1;
    my @closet_s = split m{</option><option },$closet_s;

    for (@closet_s) {
      m{value='(\d+)' descid='(\d+)'>(.*) \(([\d,]+)\)}
        or die "Not an item: $_";

      my $id = $1;
      my $desc = $2;
      my $name = $3;
      my $number = $4;
      $number =~ s/,//g;

      $inv->{$id} = $number;
    }
  }

  return ($closet,$inv);
}

sub closet_take {
  my $bot = shift;
  my $params = {@_};

  $bot->ua->timeout($bot->config->{timeout});

  my $url = $bot->url . 'closet.php';
  my $args = [action=>'take',pwd=>$bot->hash];
  my $i = 1;
  for $i (1..@{$params->{item_id}}) {
    push @$args,"whichitem".$i,$params->{item_id}->[$i-1];
    push @$args,"howmany".$i,$params->{number}->[$i-1];
  }

  my $response = $bot->ua->post($url,$args);

  $response->is_success
    or die 'HTTP ' . $response->status_line;

  $bot->check_response($response);

  # AWM
}

sub closet_put {
  my $bot = shift;
  my $params = {@_};

  $bot->ua->timeout($bot->config->{timeout});

  my $url = $bot->url . 'closet.php';
  my $args = [action=>'put',pwd=>$bot->hash];
  my $i = 1;
  for $i (1..@{$params->{item_id}}) {
    push @$args,"whichitem".$i,$params->{item_id}->[$i-1];
    push @$args,"howmany".$i,$params->{number}->[$i-1];
  }

  my $response = $bot->ua->post($url,$args);

  $response->is_success
    or die 'HTTP ' . $response->status_line;

  $bot->check_response($response);

  return $response->content;
}

#
# Collection routines
#

sub managecollection {
  my $bot = shift;
  my $params = {@_};

  $bot->ua->timeout($bot->config->{timeout});
  my $url = $bot->url . 'managecollection.php';

  my $args = [];
  if($params->{action}) {
    $args = [action=>$params->{action},pwd=>$bot->hash];
    my $i = 1;
    for $i (1..@{$params->{item_id}}) {
      push @$args,"whichitem".$i,$params->{item_id}->[$i-1];
      push @$args,"howmany".$i,$params->{number}->[$i-1];
    }
  }
  my $response = $bot->ua->post($url,$args);

  $response->is_success
    or die 'HTTP ' . $response->status_line;

  $bot->check_response($response);

  die 'unknown managecollection',$response->content
    unless $response->content =~ m|<b>Your Display Case</b>|;

  # clean up
  my $content = $response->content;
  $content =~ s/\s+/ /g;

  my $collect = {};
  my $inv = {};

  # closet items
  if ($content =~ 
      m|<b>Take: <input type=text size=2 name=howmany1> </b> <select name="whichitem1"> <option value=0>-select an item-</option><option (.*?)</option></select>|) {

    my $closet_s = $1;
    my @closet_s = split m{</option><option },$closet_s;

    for (@closet_s) {
      m{value='(\d+)'>(.*) \(([\d,]+)\)}
        or die "Not an item: $_";

      my $id = $1;
      my $name = $2;
      my $number = $3;
      $number =~ s/,//g;

      $collect->{$id} = $number;
    }
  }

  # inventory items
  if ($content =~ 
      m|<b>Put: <input type=text size=2 name=howmany1> </b> <select name="whichitem1"> <option value=0>-select an item-</option><option (.*?)</option></select>|) {
    my $closet_s = $1;
    my @closet_s = split m{</option><option },$closet_s;

    for (@closet_s) {
      m{value='(\d+)'>(.*) \(([\d,]+)\)}
        or die "Not an item: $_";

      my $id = $1;
      my $name = $2;
      my $number = $3;
      $number =~ s/,//g;

      $inv->{$id} = $number;
    }
  }

  return ($collect,$inv);
}

# parameters
# action: hoboflex,bigbook,tanningbed
# numturns

sub gym {
  my $bot = shift;
  my $params = {$_};


  my $url = $bot->url . 'clan_hall.php';
  $bot->ua->max_size(0);
  my $args =
      [
       action    => $params->{action},
       numturns  => $params->{turns},
	];
  my $response = $bot->ua->post($url,$args);
  delete($bot->ua->{max_size});

  # Again, it might be useful to check for other failures

  $response->is_success or die "HTTP " . $response->status_line;
}


# AWM: prints successful adventure even when password is wrong.
sub shore {
  my $bot = shift;
  my $parms = { @_ };
  
  warn "Need an trip number",return unless exists($parms->{whichtrip});

  my $url = $bot->url . 'shore.php';
  my $args = [
	      pwd       => $bot->hash,
	      whichtrip => $parms->{whichtrip},
	      ];

  delete($bot->ua->{max_size});
  my $response = $bot->ua->post($url,$args);

  $bot->check_response($response);

  return unless exists($parms->{check_response});

  return parse_response($response->content);

#   if($response->content =~ /You don\'t have enough adventures left\./i) {
#     return 1;
#   }

#   if($response->content =~ /Shore without a car\./i) {
#     print "You have no car!\n";
#     return 1;
#   }

#   if($response->content =~ /Vacation Results:/) {
#     return 0;
#   }
#   print "AWM DEBUG, through", $response->content;
}

# Action = boris, jarlsberg, sneakypete
sub shrines {
  my $bot = shift;
  my $parms = {@_};

  my $url = $bot->url . 'shrines.php';
  my $args =
    [
     pwd    => $bot->hash,
     action => $parms->{action},
     howmuch => $parms->{howmuch},
     ];

  my $response = $bot->ua->post($url,$args);

  $bot->check_response($response);

  # AWM CONSOLIDATE
  # no money
#   if($response->content =~ //i) {
#     return 1;
#   }

  # no key
#   if($response->content =~ /Shore without a car\./i) {
#     print "You have no car!\n";
#     return 1;
#   }

  # already done
#   if($response->content =~ /Vacation Results:/) {
#     return 0;
#   }

  # good response
  if($response->content =~ /You gain (\d+\s+\w+)/i) {
    return (0,$1);
  }

  if($response->content =~ /You may not offer any more/i) {
    return (1,'nomore');
  }

  if($response->content =~ /You don't have that key/i) {
    return (1,'nokey');
  }

  if($response->content =~ /You don't have that much Meat/i) {
    return (1,'nomeat');
  }

  print "AWM, through", $response->content;

}

sub adventure {
  my $bot = shift;
  my $params = { @_ };
  
  warn "Need an adventure number",return unless exists($params->{adv});

  $bot->ua->timeout($bot->config->{timeout});
  my $url = $bot->url . 'adventure.php?snarfblat=' . $params->{adv};
  delete($bot->ua->{max_size});
  my $response = $bot->ua->get($url);

  $bot->check_response($response);

  # Attack page
  if($response->content =~ /value=\"Attack with your .*?\"/) {
    my ($rv,$txt,$results) = $bot->parse_response($response->content);
    $results->{in_combat} = 1;
    # AWM: parse attack options
    my $options = {};
    return ($rv,$txt,$results,$options);
  }
  # AWM: need choice adventures

  return $bot->parse_response($response->content);
}

sub king {
  my $bot = shift;
  
  my $url = $bot->url . 'knob.php';
  my $response = $bot->ua->post($url,
				[ pwd => $bot->{hash},
				  king => 'Yep.', ] );
  $bot->check_response($response);

  # Attack page
  if($response->content =~ /value=\"Attack with your .*?\"/) {
    my ($rv,$txt,$results) = $bot->parse_response($response->content);
    $results->{in_combat} = 1;
    # AWM: parse attack options
    my $options = {};
    return ($rv,$txt,$results,$options);
  }

  return $bot->parse_response($response->content);
}

sub dragon {
  my $bot = shift;
  
  my $url = $bot->url . 'cyrpt.php';
  my $response = $bot->ua->post($url,
				[ pwd => $bot->{hash},
				  action => 'Yep.', ] );
  $bot->check_response($response);

  # Attack page
  if($response->content =~ /value=\"Attack with your .*?\"/) {
    my ($rv,$txt,$results) = $bot->parse_response($response->content);
    $results->{in_combat} = 1;
    # AWM: parse attack options
    my $options = {};
    return ($rv,$txt,$results,$options);
  }

  return $bot->parse_response($response->content);
}

sub rats {
  my $bot = shift;
  my $params = { @_ };
  
  my $response;
  if(exists($params->{faucetoff})) {
    my $url = $bot->url . 'rats.php';
    my $args = [
		action => 'faucetoff',];
    $response = $bot->ua->post($url,$args);
  } else {
    die "Need a location",return unless exists($params->{where});
    my $url = $bot->url . 'rats.php?where=' . $params->{where};

    $bot->ua->timeout($bot->config->{timeout});
    delete($bot->ua->{max_size});
    $response = $bot->ua->get($url);
  }

  $bot->check_response($response);

  # Attack page
  if($response->content =~ /value=\"Attack with your .*?\"/) {
    my ($rv,$txt,$results) = $bot->parse_response($response->content);
    $results->{in_combat} = 1;
    # AWM: parse attack options
    my $options = {};
    return ($rv,$txt,$results,$options);
  }

  return $bot->parse_response($response->content);
}

sub fight {
  my $bot = shift;
  my $params = { action => 'attack',
		 @_ };

  my $url = $bot->url . 'fight.php';
  my $args = [action => $params->{action},
	      button => 'submit'];

  if($params->{action} =~ /useitem/i) {
    push @$args,'whichitem',$params->{whichitem}->[0];
    if(@{$params->{whichitem}} > 1) {
      push @$args,'whichitem2',$params->{whichitem}->[1];
    } else {
      push @$args,'whichitem2',0;
    }
  }

  
  if($params->{action} =~ /skill/i) {
    push @$args,'whichskill',$params->{whichskill};
  }

  my $response = $bot->ua->post($url,$args);

  $response->is_success or die "HTTP " . $response->status_line;
  $bot->check_response($response);

  if($response->content =~ /value=\"Attack with your.*?\"/i) {
    my ($rv,$txt,$results) = $bot->parse_response($response->content);
    $results->{in_combat} = 1;
    # AWM: parse attack options
    my $options = {};
    return ($rv,$txt,$results,$options);
  }

  return $bot->parse_response($response->content);
}

sub choice {
  my $bot = shift;
  my %params = @_;

  my $url = $bot->url . 'choice.php';

  my $args = [pwd => $bot->{hash},
	      whichchoice => $params{choice},
	      option => $params{option},
	      button => 'submit'];

  my $response = $bot->ua->post($url,$args);

  $bot->check_response($response);
  return $bot->parse_response($response->content);
}


sub campground {
  my $bot = shift;
  my $params = { @_ };

  my $url;
  if(exists($params->{action})) {
    $url = $bot->url . 'campground.php?action=' . $params->{action};
  } else {
    $url = $bot->url . 'campground.php';
  }
  delete($bot->ua->{max_size});
  my $response = $bot->ua->get($url);
  $bot->check_response($response);

  my $stuff = {};

  for(qw(rest4 fengshui pagoda closet
	 beanbag toaster trophycase certificate
	 arches
	 bartender chef terrarrium locker
	 maid scarecrow golem hippystone
	 )) {
    $stuff->{$_} = ($response->content =~ /$_\.gif/i);
  }

  # AWM: response from action	    
  # AWM bouquet barbedwire picket
  return $stuff;
}

  # No clear way to get class.  This should go somewhere we can make use of
  # it for /whois data as well.
   my %title2class = (
		      ## Seal Clubbers
		      'Lemming Trampler' => 'Seal Clubber',
		      'Tern Slapper' => 'Seal Clubber',
		      'Puffin Intimidator' => 'Seal Clubber',
		      'Ermine Thumper' => 'Seal Clubber',
		      'Penguin Frightener' => 'Seal Clubber',
		      'Malamute Basher' => 'Seal Clubber',
		      'Narwhal Pummeler' => 'Seal Clubber',
		      'Otter Crusher' => 'Seal Clubber',
		      'Caribou Smacker' => 'Seal Clubber',
		      'Moose Harasser' => 'Seal Clubber',
		      'Reindeer Threatener' => 'Seal Clubber',
		      'Ox Wrestler' => 'Seal Clubber',
		      'Walrus Bludgeoner' => 'Seal Clubber',
		      'Whale Boxer' => 'Seal Clubber',
		      'Seal Clubber' => 'Seal Clubber',
		      
		      ## Turtle Tamers
		      'Toad Coach' => 'Turtle Tamer',
		      'Skink Trainer' => 'Turtle Tamer',
		      'Frog Director' => 'Turtle Tamer',
		      'Gecko Supervisor' => 'Turtle Tamer',
		      'Newt Herder' => 'Turtle Tamer',
		      'Frog Boss' => 'Turtle Tamer',
		      'Iguana Driver' => 'Turtle Tamer',
		      'Salamander Subduer' => 'Turtle Tamer',
		      'Bullfrog Overseer' => 'Turtle Tamer',
		      'Rattlesnake Chief' => 'Turtle Tamer',
		      'Crocodile Lord' => 'Turtle Tamer',
		      'Cobra Commander' => 'Turtle Tamer',
		      'Aligator Subjugator' => 'Turtle Tamer',
		      'Asp Master' => 'Turtle Tamer',
		      'Turtle Tamer' => 'Turtle Tamer',
		      
		      ## Pastamancers
		      'Dough Acolyte' => 'Pastamancer',
		      'Yeast Scholar' => 'Pastamancer',
		      'Noodle Neophyte' => 'Pastamancer',
		      'Starch Savant' => 'Pastamancer',
		      'Carbohydrate Cognoscenti' => 'Pastamancer',
		      'Spaghetti Sage' => 'Pastamancer',
		      'Macaroni Magician' => 'Pastamancer',
		      'Vermicelli Enchanter' => 'Pastamancer',
		      'Linguini Thaumaturge' => 'Pastamancer',
		      'Ravioli Sorcerer' => 'Pastamancer',
		      'Manicotti Magus' => 'Pastamancer',
		      'Spaghetti Spellbinder' => 'Pastamancer',
		      'Cannelloni Conjurer' => 'Pastamancer',
		      'Angel-Hair Archmage' => 'Pastamancer',
		      'Pastamancer' => 'Pastamancer',
		      
		      ## Saucerors
		      'Allspice Acolyte' => 'Sauceror',
		      'Cilantro Seer' => 'Sauceror',
		      'Parsley Enchanter' => 'Sauceror',
		      'Sage Sage' => 'Sauceror',
		      'Rosemary Diviner' => 'Sauceror',
		      'Thyme Wizard' => 'Sauceror',
		      'Tarragon Thaumaturge' => 'Sauceror',
		      'Oreganoccultist' => 'Sauceror',
		      'Basillusionist' => 'Sauceror',
		      'Coriander Conjurer' => 'Sauceror',
		      'Bay Leaf Brujo' => 'Sauceror',
		      'Sesame Soothsayer' => 'Sauceror',
		      'Marinara Mage' => 'Sauceror',
		      'Alfredo Archmage' => 'Sauceror',
		      'Sauceror' => 'Sauceror',
		      
		      # Accordion Thieves
		      'Polka Criminal' => 'Accordion Thief',
		      'Mariachi Larcenist' => 'Accordion Thief',
		      'Zydeco Rogue' => 'Accordion Thief',
		      'Chord Horker' => 'Accordion Thief',
		      'Chromatic Crook' => 'Accordion Thief',
		      'Squeezebox Scoundrel' => 'Accordion Thief',
		      'Concertina Con Artist' => 'Accordion Thief',
		      'Button Box Burglar' => 'Accordion Thief',
		      'Hurdy-Gurdy Hooligan' => 'Accordion Thief',
		      'Sub-Sub-Apprentice Accordion Thief' => 'Accordion Thief',
		      'Sub-Apprentice Accordion Thief' => 'Accordion Thief',
		      'Pseudo-Apprentice Accordion Thief' => 'Accordion Thief',
		      'Hemi-Apprentice Accordion Thief' => 'Accordion Thief',
		      'Apprentice Accordion Thief' => 'Accordion Thief',
		      'Accordion Thief' => 'Accordion Thief',
		      
		      ## Disco Bandits
		      'Funk Footpad' => 'Disco Bandit',
		      'Rhythm Rogue' => 'Disco Bandit',
		      'Chill Crook' => 'Disco Bandit',
		      'Jiggy Grifter' => 'Disco Bandit',
		      'Beat Snatcher' => 'Disco Bandit',
		      'Sample Swindler' => 'Disco Bandit',
		      'Move Buster' => 'Disco Bandit',
		      'Jam Horker' => 'Disco Bandit',
		      'Groove Filcher' => 'Disco Bandit',
		      'Vibe Robber' => 'Disco Bandit',
		      'Boogie Brigand' => 'Disco Bandit',
		      'Flow Purloiner' => 'Disco Bandit',
		      'Jive Pillager' => 'Disco Bandit',
		      'Rhymer and Stealer' => 'Disco Bandit',
		      'Disco Bandit' => 'Disco Bandit',


		      # Accordion Thieves
		      'polka criminal' => 'Accordion Thief',
		      'mariachi larcenist' => 'Accordion Thief',
		      'zydeco rogue' => 'Accordion Thief',
		      'chord horker' => 'Accordion Thief',
		      'chromatic crook' => 'Accordion Thief',
		      'squeezebox scoundrel' => 'Accordion Thief',
		      'concertina con artist' => 'Accordion Thief',
		      'button box burglar' => 'Accordion Thief',
		      'hurdy-gurdy hooligan' => 'Accordion Thief',
		      'sub-sub-apprentice accordion thief' => 'Accordion Thief',
		      'sub-apprentice accordion thief' => 'Accordion Thief',
		      'pseudo-Apprentice accordion thief' => 'Accordion Thief',
		      'hemi-Apprentice accordion thief' => 'Accordion Thief',
		      'apprentice accordion thief' => 'Accordion Thief',
		      'accordion thief' => 'Accordion Thief',

		      # Disco Bandits
		      'funk footpad' => 'Disco Bandit',
		      'rhythm rogue' => 'Disco Bandit',
		      'chill crook' => 'Disco Bandit',
		      'jiggy grifter' => 'Disco Bandit',
		      'beat snatcher' => 'Disco Bandit',
		      'sample swindler' => 'Disco Bandit',
		      'move buster' => 'Disco Bandit',
		      'jam horker' => 'Disco Bandit',
		      'groove filcher' => 'Disco Bandit',
		      'vibe robber' => 'Disco Bandit',
		      'boogie brigand' => 'Disco Bandit',
		      'flow purloiner' => 'Disco Bandit',
		      'jive pillager' => 'Disco Bandit',
		      'rhymer and stealer' => 'Disco Bandit',
		      'disco bandit' => 'Disco Bandit',
		      );

sub charpane {
  my $bot = shift;
  my $parms = { @_ };

  $bot->ua->timeout($bot->config->{timeout});
  my $url = $bot->url . 'charpane.php';
  delete($bot->ua->{max_size});
  my $response = $bot->ua->get($url);

  $bot->check_response($response);

  my $resp = {};

  my $content = $response->content;

  $content =~ s/&nbsp;/ /g;
  $content =~ s/ width=\d+//g;
  $content =~ s/ height=\d+//g;
  $content =~ s/(\d),(\d)/$1$2/g;
  $content =~ s/<td.*?>/<td>/g;
  $content =~ s/<font.*?>/<font>/g;

  if($content =~ /var pwdhash = \"(.+?)\";/) {
     $resp->{pwd} = $1;
   }

  if($content =~ m|<a target=mainpane href="charsheet.php"><b>(.*?)</b></a>|) {
    $resp->{name} = $1;
  }

  if($content =~ m{Level (\d+)<br>(.*?)<(t|/td)}) {
    $resp->{level} = $1;
    die "Don't know title $2"
      unless exists($title2class{$2});
    $resp->{class} = $title2class{$2};
  } else {
    die "No level/class info";
  }


  $content =~ m|Muscle:</td><td><b>(\d+)</b>|
    and $resp->{base_muscle} = $1,$resp->{muscle} = $1 ;
  $content =~ m|Mysticality:</td><td><b>(\d+)</b>|
    and $resp->{base_myst} = $1, $resp->{myst} = $1;
  $content =~ m|Moxie:</td><td><b>(\d+)</b>|
    and $resp->{base_moxie} = $1, $resp->{moxie} = $1;
  $content =~ m|Muscle:</td><td><b><font>(\d+)</font> \((\d+)\)</b>|
    and $resp->{muscle} = $1, $resp->{base_muscle} = $2;
  $content =~ m|Mysticality:</td><td><b><font>(\d+)</font> \((\d+)\)</b>|
    and $resp->{myst} = $1, $resp->{base_myst} = $2;
  $content =~ m|Moxie:</td><td><b><font>(\d+)</font> \((\d+)\)</b>|
    and $resp->{moxie} = $1, $resp->{base_moxie} = $2;

  if($content =~ m{<td>(Inebriety|Drunk|Drunkenness|Tipsiness|Temulency):</td><td><b>(\d+)</b>}i) {
    $resp->{drunk} = $2;
  } else {
    $resp->{drunk} = 0;
  }

  $content =~ m{you are falling-down drunk}i
    and $resp->{falling_down} = 1;

  $content =~ m{/hp.gif\".*?><br><span class=(black|red)>(\d+).*?(\d+)</span>}i
    and $resp->{hp} = $2,  $resp->{max_hp} = $3; 

  $content =~ m|HP:</td><td><b><font>(\d+)/(\d+)</font></b>|i
    and $resp->{hp} = $1, $resp->{max_hp} = $2;

  exists($resp->{hp}) or die "Problem getting hp, $content";

  $content =~ m|/mp.gif\".*?><br><span class=black>(\d+).*?(\d+)</span>|
    and $resp->{mp} = $1,  $resp->{max_mp} = $2; 

  $content =~ m|MP:</td><td><b>(\d+)/(\d+)</b>|i
    and $resp->{mp} = $1, $resp->{max_mp} = $2;

  exists($resp->{mp}) or die "Problem getting mp";

  $content =~ m|meat.gif\".*?><br><span class=black>([\d,]+)</span>|
    and ($resp->{meat} = $1) =~ s/,//g;

  $content =~ m|Meat:</td><td><b>([\d,]+)</b>|i
    and ($resp->{meat} = $1) =~ s/,//g;

  exists($resp->{meat}) or die "Problem getting meat";

  $content =~ m|hourglass.gif\".*?><br><span class=black>(\d+)</span>|
    and $resp->{adventures} = $1; 

  $content =~ m|Adv</a>:</td><td><b>(\d+)</b>|
    and $resp->{adventures} = $1; 

  exists($resp->{adventures}) or die "Problem getting adventures";

  $content =~ m|<font><b>Hardcore</b></font>|
    and $resp->{hardcore} = 1;

  $content =~ m|canadia.php\?place=machine\">Mind Control</a>: <b>(\d+)</b>|
    and $resp->{mcd} = $1;

  # do effects
  $resp->{effects} = {};
  while($content =~ m{<img src="http://images.kingdomofloathing.com/itemimages/(\w+)\.gif" class=hand onClick='eff\("(\d+)"\);'.*?></td><td><font>([\w\s\-\'\&;]+) \((\d+)\)</font>}g) {
    $resp->{effects}->{lc($3)} = {
      image => $1,
      id    => $2,
      name  => $3,
      turns => $4,
    };
  }

  $content =~ m{<img src="http://images.kingdomofloathing.com/itemimages/familiar(\d+).gif".*?border=0></a></td><td><a target=mainpane href="familiar.php"><b><font>(.*?)</a></b>, the\s+(\d+)-pound (.*?)</font>}
  and $resp->{familiar} = {id => $1,
			   name => $2,
			   weight => $3,
			   type => $4};

  # deprecated
  $content =~ m|beatenup|i
    and $resp->{beaten_up} = 1;

  return $resp;
}

sub charsheet {
  my $bot = shift;
  my $parms = { @_ };

  my $url = $bot->url . 'charsheet.php';
  my $response = $bot->ua->get($url);

  $bot->check_response($response);

  my $resp = {};

  my $content = $response->content;

  $content =~ s/&nbsp;/ /g;
  $content =~ s/ width=\d+//g;
  $content =~ s/ height=\d+//g;
  $content =~ s/(\d),(\d)/$1$2/g;
  $content =~ s/<\/?td.*?>//g;
  $content =~ s/<\/?table.*?>//g;
  $content =~ s/<\/?font.*?>//g;
  $content =~ s/<\/?tr>//g;
  $content =~ s/<\/?b>//g;
  $content =~ s/<font.*?>/<font>/g;

  $content =~ m|Muscle:(\d+)\s*\((\d+)/(\d+)\)|
    and $resp->{mus_sub} = $1*$1+$2;
  $content =~ m|Mysticality:(\d+)\s*\((\d+)/(\d+)\)|
    and $resp->{mys_sub} = $1*$1+$2;
  $content =~ m|Moxie:(\d+)\s*\((\d+)/(\d+)\)|
    and $resp->{mox_sub} = $1*$1+$2;

  $content =~ m|Muscle:(\d+)\s+\(base:\s+(\d+)\)\((\d+)/(\d+)\)|
    and $resp->{mus_sub} = $2*$2+$3;
  $content =~ m|Mysticality:(\d+)\s+\(base:\s+(\d+)\)\((\d+)/(\d+)\)|
    and $resp->{mys_sub} = $2*$2+$3;
  $content =~ m|Moxie:(\d+)\s+\(base:\s+(\d+)\)\((\d+)/(\d+)\)|
    and $resp->{mox_sub} = $2*$2+$3;

  $resp->{skills} = {};
  while($content =~ m{<a onClick='javascript:skill\((\d+)\)'>(.*?)</a>}gi) {
    $resp->{skills}->{$1} = {id => $1,
			     name => $2,
			     extra => ''}; # Later for P, HP
  }

  return $resp;
}

sub showplayer {
  my $bot = shift;
  my $parms = { @_ };

  warn "Need a player number",return unless exists($parms->{who});

  $bot->ua->timeout($bot->config->{timeout});
  my $url = $bot->url . 'showplayer.php?who=' . $parms->{who};
  delete($bot->ua->{max_size});
  my $response = $bot->ua->get($url);

  $bot->check_response($response);

  my $resp = {};
  # Parse response

  if($response->content =~ /Sorry, this player could not be found./) {
    $resp->{sorry} = 1;
  }

  my $pname = '\w[\w\ \d_]{0,28}\w';
  $response->content =~ /<b>($pname)<\/b>/
    and $resp->{name} = $1;

  $response->content =~ /otherimages\/(\w+)\.gif\"/
    and $resp->{image} = $1;
  if($response->content =~ /otherimages\/customavatars\/(\d+).gif\"/) {
    $resp->{image} = 'yourself';
  }

  if($response->content =~ /\(\#(\d+)\)<br>Level ([\d,]+)<br>([\w -]+)(<br><b>\(Hardcore\)<\/b>)?<\/td>/) {
    $resp->{id} = $1;
    $resp->{level} = $2;
    $resp->{level} =~ s/,//g;
    $resp->{title} = $3;
    $resp->{class} = $title2class{$3};
    $resp->{hardcore} = $4 ? 1 : 0;
  }

  if($response->content =~ /\(\#(\d+)\)<br>Level ([\d,]+)<br>([\w -]+)<\/td>/) {
    $resp->{id} = $1;
    $resp->{level} = $2;
    $resp->{level} =~ s/,//g;
    $resp->{title} = $3;
  }

  $response->content =~ /otherimages\/sigils\/(\w+).gif\"/
    and $resp->{sigil} = $1;

  if($response->content =~ /<b>Meat:<\/b><\/td><td>([\d,]+)<\/td>/) {
    $resp->{meat} = $1;
    $resp->{meat} =~ s/,//g;
  }

  if($response->content =~ /<b>Turns Played( \(total\))?:<\/b><\/td><td>([\d,]+)<\/td>/) {
    $resp->{turns} = $2;
    $resp->{turns} =~ s/,//g;
  }

  if($response->content =~ /<b>Turns Played \(this run\):<\/b><\/td><td>([\d,]+)<\/td>/) {
    $resp->{turnsrun} = $1;
    $resp->{turnsrun} =~ s/,//g;
  }
  
  if($response->content =~ /Ascensions<\/a>:<\/b><\/td><td>([\d,]+)<\/td>/) {
    $resp->{ascensions} = $1;
    $resp->{ascensions} =~ s/,//g;
  }

  $response->content =~ /<b>Account Created:<\/b><\/td><td>(\w+\s+\d\d,\s+\d\d\d\d)<\/td>/
    and $resp->{created} = $1;

  $response->content =~ /<b>Last Login:<\/b><\/td><td>(\w+\s+\d\d,\s+\d\d\d\d)<\/td>/
    and $resp->{lastlogin} = $1;

  $response->content =~ /<b>Sign:<\/b><\/td><td>The (Mongoose|Wallaby|Vole|Platypus|Opossum|Marmot|Wombat|Blender|Packrat)<\/td>/
    and $resp->{sign} = $1;

  if($response->content =~ /<center>PvP:<\/center>/i) {
    $resp->{pvp} = 1;
    if($response->content =~ /<b>Ranking:<\/b><\/td><td>([\d,]+)<\/td>/i) {
      $resp->{ranking} = $1;
      $resp->{ranking} =~ s/,//g;
    }
    if($response->content =~ /<b>Fights won:<\/b><\/td><td>([\d,]+)<\/td>/i) {
      $resp->{fightswon} = $1;
      $resp->{fightswon} =~ s/,//g;
    }
    if($response->content =~ /<b>Fights Lost:<\/b><\/td><td>([\d,]+)<\/td>/i) {
      $resp->{fightslost} = $1;
     $resp->{fightslost} =~ s/,//g;
    }
  }
  
  $resp->{gender} = 'None';
  $response->content =~ m|<b>Gender:</b></td><td>(.*?)</td>|
    and $resp->{gender} = $1;

  if($response->content =~ m|Clan: <b><a class=nounder href="showclan.php\?whichclan=(\d+)">(.*?)</a>|) {
    $resp->{clan_id} = $1;
    $resp->{clan} = $2;
  }
  $response->content =~ m|<td colspan=2>Store: <b>|
    and $resp->{store} = 1;
  $response->content =~ m|<b>Display Case</b>|
    and $resp->{case} = 1;

  return $resp;
}

#
# Helper functions
#

#
# What day is it?
# This is fucking confusing.  Midnight by message stamps is not
# the same as when the moons roll over.
#
# To use the same serial form (UNIX epoch), I'll use separate
# routines for converting
#

# This gives "KoL Time" from unix epoch
sub koltime {
  my $secs = shift;

  my $day_per_month = 8;
  my $mnth   = $day_per_month*24*60*60;
  my $yr     = $mnth * 12;
  my $yoff   = 6;
  my $moff   = -782-788;
  my $doff   = -4;
  my $hoff   = -4;		# Used to be -5
  my $off = $yoff * $yr + $moff * $mnth + $doff * 24*60*60 + $hoff*60*60;

  $secs += $off;

  my $year   = floor($secs/$yr);
  my $month  = (floor($secs           /$mnth))%12 + 1;
  my $day    = floor($secs%$mnth     /(24*60*60)) + 1;
  my $hour   = floor($secs%(24*60*60)/(60*60));
  my $minute = floor($secs%(60*60)   /(60));
  my $second = floor($secs%(60));

  # is it significantly after rollover, but before the next "day"?
  # if so, advance day/month in a really inefficient way
  if($hour == 23 && $minute > 40) {
    $day++;
    if($day == 9) {
      $day = 1;
      $month++;
      if($month == 13) {
	$month = 1;
	$year++;
      }
    }
  }
  
  return ($second, $minute, $hour,$day,$month,$year);
}

# returns epoch time of next rollover
sub next_rollover {
  my $secs = shift;

#  my ($sec,$min,$hour,$mday,$mon,$year) = gmtime($secs);
#  my ($second, $minute, $hour,$day,$month) = koltime($secs);

  return ($rollover_hour * 3600 + $rollover_minute * 60 - $secs)%(24*3600);
#   my $h = ($rollover_hour-$hour - ($rollover_minute < $min))%24;
#   my $m = ($rollover_minute - $min)%60;

#   print "AD $h $m\n";

#   $secs = 60*$m + 3600 * $h - $sec;

#   return $secs;
}
  

# This gives "Message Time", should be offloaded to KMail
sub kmailtime {
  my $secs = shift;

  return gmtime($secs + $kmail_offset);
}

my @substitutions = (['\bis\b','be'],
                  ['\b(([Ii]t)|([Tt]here))\'s\b','$1 be'],
                  ['\. ','. ','. ','. Avast, '],
                  ['^','','',
                   'Shiver me timbers. ','Yar. ',
                   'Avast, me hearties. '],
                  ['$','','',
                   ' Yo ho ho and a bottle of rum.', ' Aarr!'],
                  ['\bYes\b','Aye'], ['\byes\b','aye'],
                  ['\bbeer\b','grog'],
                  ['\bHello\b','Ahoy'],['\bhello\b','ahoy'],
                  ['\bfriend'],['shipmate'],
                  ['\bmy\b','me']);

sub filter_text {
  my ($text_ref) = shift;
  foreach my $s (@substitutions) {
    $$text_ref =~ s/$s->[0]/'"' . $s->[1+int(rand ($#{$s}))] . '"'/eeg;
  }
}

sub storage {
  my $bot = shift;
  my $params = { action => '',	# take,takemeat,
		 amt => 0,
		 @_ };

  my $response;

  my $url = $bot->url . 'storage.php';
  my $args =[
	     pwd       => $bot->{hash},
	     ];

  if($params->{action} eq 'takemeat') {
    push @$args, action    => $params->{action},
                 amt       => $params->{amt};
    $response = $bot->ua->post($url,$args);
  } elsif ($params->{action} eq 'take') {
    push @$args, action    => $params->{action};
    for(0..$#{$params->{number}}) {
      push @$args, 'howmany'.(($_)+1) ,$params->{number}->[$_];
      push @$args, 'whichitem'.(($_)+1) ,$params->{item_id}->[$_];
    }
    $response = $bot->ua->post($url,$args);
  } elsif ($params->{action} eq '') {
    $response = $bot->ua->get($url);
  } else {
    die "bad action passed to storage.";
  }

  $response->is_success
    or die 'HTTP ' . $response->status_line;

  $bot->check_response($response);

  # Parse the response
  $response->content =~ 
  m{<option value=0>-select an item-</option><option (.*?)</option></select>}i;
  my $content1 = $1;
  my @i1 = split m{</option><option },$content1;
  my $items = [];
  
  for (@i1) {
    m{value='(\d+)'>(.*?) \((\d+)\)}
      or die "Not an item: $_";

    my $id = $1;
    my $name = $2;
    my $number = $3;

    push @$items,new KoLBot::Item(desc => 0, name => $name, id => $id,
				  number => $number);
  }

  $response->content =~ 
#    m{<select name="whichitemtoview">.*?<option (.*)</option>.*?</select>}i
    m{<select name="whichitemtoview">[\s\n]*?<option (.*)</option>[\s\n]*?</select>}mi
    or die;
  $content1 = $1;
  @i1 = split m{</option><option },$content1;
  my $i = 0;

  for (@i1) {
    m{value='(\d+)'>(.*?) \((\d+)\)}
      or die "Not an item: $_";

    my $desc = $1;
    my $name = $2;
    my $number = $3;

    if ($items->[$i]->name ne $name) {
      print "name mismatch, ",$items->[$i]->id," ",$items->[$i]->{name}," ",
      $name,"\n";
      die;
    }
    if ($items->[$i]->{number} ne $number) {
      print "number mismatch, ",$items->[$i]->id," ",$items->[$i]->{number},
      " ",$number,"\n";
      die;
    }
    $items->[$i]->{desc} = $desc;
    $i++;
  }

  return $items;
}

#
# Store stuff
#

sub managestore {
  my $bot = shift;
  my %params = ( @_ );

  my $response;

  # AWM add additems
  if($params{action} eq 'additem') {
    my $url = $bot->url . 'managestore.php';
    my $args =
      [
       action    => $params{action},   # additem
       pwd       => $bot->{hash},
       ];
    my $i = 1;
    for(@{$params{items}}) {
      push @$args,('qty'.$i),$_->{number};
      push @$args,('item'.$i),$_->{id};
      push @$args,('price'.$i),$_->{price};
      push @$args,('limit'.$i),$_->{limit};
    }
    $response = $bot->ua->post($url,$args);
  } elsif ($params{action} eq 'take'
	   ||
	   $params{action} eq 'takeall'
	   ) {
    my $url = $bot->url . 'managestore.php?action=' . $params{action}
    . '&whichitem=' . $params{whichitem};
    $response = $bot->ua->get($url);
  } else {
    die "bad action passed to managestore.";
  }

  $response->is_success
    or die 'HTTP ' . $response->status_line;

  $bot->check_response($response);

  return $response->content;
  # AWM check returns
}

sub store_log {
  my $bot = shift;

  # makes an array of hashes

  my $url = $bot->url . 'storelog.php';
  my $response = $bot->ua->get($url);
  my $ret = [];

  $bot->check_response($response);

  my $content = $response->content;
  while ($content =~ m|(\d\d)/(\d\d)/(\d\d) (\d\d):(\d\d):(\d\d) <a class=nounder href="showplayer\.php\?who=(\d+)"><b>(.*?)</b></a> bought (\d+) \((.*?)\) for (\d+) Meat.|g) {
    # make a time, convert to UTC
    # As of Feb 11, 2006, the offset was 7 hours, meaning a good sync on the
    # DB server (and little variation between servers)
    # times don't respect your time zone setting
    my $time = timegm($6,$5,$4,$1,$2-1,100+$3) + 7*3600;

    my $ri =  $bot->items->get_item(name => $10,
				    number => 1);

    push @$ret,{time    => $time,
		user_id => $7,
		user    => $8,
		number  => $9,
		item    => $ri,
		price   => $11};
  }

  return $ret;
}

#
# Mallish stuff
#

sub search_mall {
  my $bot = shift;
  my $params = {@_};

  my $url = $bot->url . 'searchmall.php';
  my $args =
      [
       whichitem => $params->{whichitem},
       cheaponly => $params->{cheaponly},
       shownum   => $params->{shownum},
	];

# other type
#       whichstore   => $params->{whichstore},

  my $response = $bot->ua->post($url,$args);

  # Again, it might be useful to check for other failures

  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);

  die "SEARCH_DOWN" 
    if $response->content =~ /Mall searching is temporarily disabled\./i;

  die 'unknown search_mall, ',$response->content
    unless $response->content =~ m|<b>Search the Mall:</b>|;

  my $content = $response->content;
  $content =~ s/\n//g;
  $content =~ s/<td.*?>/<td>/g;

  # get rid of head and tail, keep only the juicy filling
  ( $content =~ 
      m|Price:</b></td></tr><tr><td><b>(.*?)&nbsp;Meat</td></tr>(</tbody>)?</table>|i )
#    or die 'unknown search_mall, ',$response->content;
    or return [];

  my $results = $1;
  $results =~ s/&nbsp;/ /g;

  my @lines = split m{ Meat</td></tR><tr><td><b>}i,$results;
  $results = [];

#  seal-clubbing club</b> (5) (1&nbsp;/&nbsp;day)</td><td><a  href="mallstore.php?whichstore=135934">You know you want it!</a></td><td>10 
  for (@lines) {
#    m|^(.*?)</b> \(([\d,]+)\)( \(([\d,]+) / day\))?</td><td><a\s+href="mallstore.php\?whichstore=(\d+).*?">(.*?)</a></td><td>([\d,]+)\s*$|
    m|^(.*?)</b> \(([\d,]+)\)( \(([\d,]+) / day\))?</td><td><a\s+(style='color: gray;'\s+)?href="mallstore.php\?whichstore=(\d+).*?">(.*?)</a></td><td>([\d,]+)\s*$|
      or die "Not a line: $_";

    my $r = { name => $1,
	      number => $2,
	      limit => $4 || 0,
	      grayed => defined($5),
	      store => $6,
	      price => $8};

      $r->{price} =~ s/,//g;
      $r->{number} =~ s/,//g;
      $r->{limit} =~ s/,//g;

    push @$results, $r;
    }

  return $results;
}

sub mallstore {
  my $bot = shift;
  my $params = {quantity => 1,
		@_};

  my $url = $bot->url . 'mallstore.php';
  my $args =
      [
       whichstore => $params->{whichstore},
       buying    => 'Yep.',
       whichitem => $params->{whichitem},
       quantity  => $params->{quantity},
       pwd       => $bot->{hash},
	];

  my $response = $bot->ua->post($url,$args);

  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);

  return $response->content;
}

#
# Misc
#

sub trickortreat {
  my $bot = shift;
  my $params = {quantity => 1,
		@_};

  my $url = $bot->url . 'trickortreat.php';
  my $args =
      [
       action => 'Yep.',
	];

  my $response = $bot->ua->post($url,$args);

  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);

  return $bot->parse_response($response->content);
}

#
# Utility
#

sub id_from_name {
  my $bot = shift;
  my $name = shift;

  my ($sql,$dbi,$rv);
  my $USER_TABLE = $bot->config->{db_conf}->{table_pre} . "users";

  $name =~ s/^\s+//;
  $name =~ s/\s+$//;

  # already a number.  Yes there is one exception, but....
  if($name =~ /^\d+$/) {
    my $id = $name;
    $sql = qq{
      SELECT name FROM $USER_TABLE
	WHERE user_id = ?
      };
    $dbi = $bot->dbh->prepare($sql);
    $rv = $dbi->execute(
			$name,
			);
    if($rv > 0) {
      my $row = $dbi->fetchrow_hashref();
      my $nameret = $row->{name};
      return ($id,$nameret);
    }

    # No entries.  Try a /whois
    my $ret = $bot->send_message_raw('/whois ' . $name,1);
    if($ret =~ /green>(.*?) \(\#(\d+)\)/) {
      my $nameret = $1;
      my $id = $2;

      $sql = qq{
	INSERT INTO $USER_TABLE (user_id,name,bans)
	  VALUES (?,?,0)
	};
      $dbi = $bot->dbh->prepare($sql);
      $rv = $dbi->execute($id,$nameret);
      return ($id,$nameret);
    }
    print "AWM: User ID not found $id\n";
    return;
  }

  $sql = qq{
    SELECT name,user_id FROM $USER_TABLE
      WHERE LOWER(name) = LOWER(?)
    };
  $dbi = $bot->dbh->prepare($sql);
  $rv = $dbi->execute(
		      $name,
		      );
  print "AWM Multiple ids for name $name\n" if $rv > 1;

  if($rv > 0) {
    my $row = $dbi->fetchrow_hashref();
    return $row->{user_id},$row->{name};
  }

  my $name1 = $name;
  $name1 =~ s/(\w{20}) /$1/;

  if(!($name1 eq $name)) {
    $rv = $dbi->execute($name1);

    print "AWM Multiple ids for name $name1\n" if $rv > 1;

    if($rv > 0) {
      my $row = $dbi->fetchrow_hashref();
      return ($row->{user_id},$row->{name});
    }
  }

  # No entries.  Try a /whois
  my $ret = $bot->send_message_raw('/whois ' . $name,1);
  if($ret =~ /green>(.*?) \(\#(\d+)\)/) {
    my $nameret = $1;
    my $id = $2;

    $sql = qq{
      INSERT INTO $USER_TABLE (user_id,name,bans)
	VALUES (?,?,0)
      };
    $dbi = $bot->dbh->prepare($sql);
    $rv = $dbi->execute($id,$nameret);
    return ($id,$nameret);
  }

  if(!($name eq $name1)) {
    my $ret = $bot->send_message_raw('/whois ' . $name1,1);
    if($ret =~ /green>(.*?) \(\#(\d+)\)/) {
      my $nameret = $1;
      my $id = $2;

      $sql = qq{
	INSERT INTO $USER_TABLE (user_id,name,bans)
	  VALUES (?,?,0)
	};
      $dbi = $bot->{dbh}->prepare($sql);
      $rv = $dbi->execute($id,$nameret);
      return ($id,$nameret);
    }
  }

  print "AWM: name not found, $name\n";
  return;
}

##############################################################################
# Stuff.  I should clean this up.
##############################################################################

sub questlog {
  my $bot = shift;

  my $url = $bot->url . 'questlog.php?which=1';
  my $response = $bot->ua->get($url);

  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);

  my $ret = {};

  my $content = $response->content;
  while($content =~ m|<b>(.*?)</b>|gi) {
    $1 =~ /your quest log/i and next;
    $1 =~ /council quests/i and next;
    $1 =~ /guild quests/i and next;
    $1 =~ /miscellaneous quests/i and next;
  
    $1 =~ /looking for a larva/i and $ret->{mosquito} = 1,next;
    $1 =~ /smell a rat/i and $ret->{rat} = 1,next;
    $1 =~ /smell a bat/i and $ret->{bat} = 1,next;
    $1 =~ /wouldn\'t be king/i and $ret->{king} = 1,next;
    $1 =~ /trial by friar/i and $ret->{friars} = 1,next;
    $1 =~ /Cyrptic Emanations/i and $ret->{cyrpt} = 1,next;
    $1 =~ /trapper\'s keeper/i and $ret->{trapz0r} = 1,next;
    $1 =~ /quest, lol/i and $ret->{baron} = 1,next;
    $1 =~ /is mainly garbage/i and $ret->{garbage} = 1,next;

    $1 =~ /my other car is made of meat/i and $ret->{meatcar} = 1,next;

    $1 =~ /go to white citadel/i and $ret->{citadel} = 1,next;
    $1 =~ /what\'s up, doc/i and $ret->{galaktik} = 1,next;
    $1 =~ /driven crazy/i and $ret->{untinker} = 1,next;
    die "Can't tell quest $1";
  }

  if($ret->{trapz0r}) {
    my $url = $bot->url . 'trapper.php';
    my $response = $bot->ua->get($url);

    $response->is_success or die "HTTP " . $response->status_line;

    $bot->check_response($response);
    $content = $response->content;
    $content =~ /I reckon 3 chunks of (chrome|linoleum|asbestos) ore/i
      and $ret->{trapz0r_ore} = $1;
    $content =~ /me back 6 chunks of goat cheese/i
      and $ret->{trapz0r_goat} = $1;
  }

  return $ret;
}

sub hermit {
  my $bot = shift;
  my %params = @_;

  my $url = $bot->url . 'hermit.php';

  my $args =
      [
       pwd => $bot->{hash},
       whichitem => $params{item},
       quantity => $params{quantity},
       action => 'trade',
       ];

  my $response = $bot->ua->post($url,$args);

  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);
  return $bot->parse_response($response->content);
}

sub sewer {
  my $bot = shift;

  my $url = $bot->url . 'sewer.php';
  my $response = $bot->ua->get($url);

  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);
  return $bot->parse_response($response->content);
}

## AWM: untinkerall (checkbox);
sub untinker {
  my $bot = shift;
  my %params = @_;

  my $url = $bot->url . 'town_right.php';
  
  my $args =
      [
       pwd => $bot->{hash},
       whichitem => $params{item},
       action => 'untinker',
       ];

  my $response = $bot->ua->post($url,$args);
  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);
  return $bot->parse_response($response->content);
}

sub bounty_hunter {
  my $bot = shift;

  my $url = $bot->url . 'town_wrong.php?place=bountyhunter';
  my $response = $bot->ua->get($url);
  my @ret;

  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);
  my $content = $response->content;
  while ($content =~ m|onClick=\'descitem\((\d+)\)\'></td><td><b>(.*?)</b></td>|g) {
    my $i =  $bot->items->get_item(desc => $1,name => $2,number => 1);
    $i ||= {name => $2,desc => $1};
    push @ret,$i;
  }
  return @ret;
}

sub knoll {
  my $bot = shift;
  my %params = (action => 'smith',
		@_);

  my $url = $bot->url . 'knoll.php';
  my $args =
      [
       pwd => $bot->{hash},
       action => $params{action},
       item1 => $params{item1},
       item2 => $params{item2},
       quantity => $params{quantity},
       ];

  my $response = $bot->ua->post($url,$args);

  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);

  return $bot->parse_response($response->content);
}

sub galaktik {
  my $bot = shift;
  my $params = {@_};

  my $url = $bot->url . 'galaktik.php';
  my $args =
      [
       pwd => $bot->{hash},
       whichitem => $params->{whichitem},
       howmany => $params->{howmany},
       action => 'buyitem',
       ];

  my $response = $bot->ua->post($url,$args);

  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);

  return $bot->parse_response($response->content);
}

sub store {
  my $bot = shift;
  my $params = {@_};

  my $url = $bot->url . 'store.php';
  my $args =
      [
       phash => $bot->{hash},
       whichstore => $params->{whichstore}, # 'm' is demon market
       buying => 'Yep.',
       whichitem => $params->{whichitem},
       howmany => $params->{howmany},
       ];

  my $response = $bot->ua->post($url,$args);

  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);

  return $bot->parse_response($response->content);
}

sub ascensionhistory {
  my $bot = shift;
  my $params = {@_};

  my $url = $bot->url . 'ascensionhistory.php?back=other&who='
    . $params->{id};

  my $response = $bot->ua->get($url);

  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);

  my $content = $response->content;

  $content =~ s/\&nbsp;/ /g;
  $content =~ s/\s+/ /g;
  $content =~ s/ ?<td.*?>/<td>/g;
  $content =~ s/ ?<\/td>/<\/td>/g;
  $content =~ s/(\d),(\d)/$1$2/g;
  $content =~ s/<img[^<]*?alt="([^\"<]*?)"[^<]*?>/ $1 /g;
  $content =~ s/<img[^<]*?spacer.gif[^<]*?>/ Normal /g;
  $content =~ s/\s+/ /g;

  my $ret = [];

#  print "AWM DEBUG $content\n";

  while($content =~ m{<td>(\d+)</td><td>(\d+)/(\d+)/(\d+)</td><td>(\d+)</td><td> (Sauceror|Turtle Tamer|Pastamancer|Disco Bandit|Accordion Thief|Seal Clubber) </td><td>(.*?)</td><td>(\d+)</td><td>(\d+)</td><td>(.*?)</td><td> (.*?) </td></tr>}g) {

    my %class_sub = ('Seal Clubber' => 'SC',
		     'Turtle Tamer' => 'TT',
		     'Pastamancer'  => 'P',
		     'Sauceror'     => 'S',
		     'Disco Bandit' => 'DB',
		     'Accordion Thief' => 'AT');

    my $e = {number => $1,
	     date   => "$2/$3/$4",
	     level  => $5,
	     class  => $class_sub{$6},
	     sign   => $7,
	     turns  => $8,
	     days   => $9,
	     familiar => $10,
	     details => $11,};
				 
    $e->{details} =~ /Boozetefarian|Oxygenarian|Teetotaler/
      or $e->{details} .= ' No Path';

    push @$ret,$e;
  }
#   while($content =~ m{<td>(\d+)</td><td>(\d+)/(\d+)/(\d+)</td><td>(\d+)</td><td>(SC|TT|P|S|DB|AT)</td><td>([^<]*)</td><td>(\d+)</td><td>(\d+)</td><td>([^<]*)</td></tr>}g) {
#     my $turns = $8;
#     $turns =~ s/,//g;
#     push @$ret,{ number => $1,
# 		date   => "$2/$3/$4",
# 		level  => $5,
# 		class  => $6,
# 		sign   => $7,
# 		turns  => $turns,
# 		days   => $9,
# 		details => $10,};
#   }


  return $ret;
}

sub raffle {
  my $bot = shift;

  my $url = $bot->url . 'raffle.php';

  my $response = $bot->ua->get($url);

  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);

  my $results = {};

  $response->content =~  m{First prize:</td><td><img class=hand onclick='descitem\((\d+)\);' alt='\w+?' style='vertical-align: middle' src='http://images.kingdomofloathing.com/itemimages/\w+?\.gif'> <b>(.*?)</b>}
  and $results->{first} = $2;
  $response->content =~  m{Second prize:</td><td><img class=hand onclick='descitem\((\d+)\);' style='vertical-align: middle' src='http://images.kingdomofloathing.com/itemimages/\w+?\.gif'> <b>(.*?)</b>}
  and $results->{second} = $2;

  return (0,'',$results);
}

sub arena {
  my $bot = shift;

  my $url = $bot->url . 'arena.php';

  my $response = $bot->ua->get($url);

  $response->is_success or die "HTTP " . $response->status_line;

  $bot->check_response($response);

  my $results = {familiars => []};

  my $content = $response->content;
  while($content =~ m{<input.*?value=(\d+)></td><td valign=center><img src="http://images.kingdomofloathing.com/itemimages/familiar(\d+).gif" width=30 height=30></td><td class=small><b>(.*?)</b> the (.*?)<br>(\d+) lbs., [\d,]+ wins, [\d,]+ losses.</td>}g) {
    push @{$results->{familiars}},{ id => $1,
				    name => $3,
				    type => $4,
				    weight => $5};
  }
  return (0,'',$results);
}    
    
  
# eP2
# Return the collection for a given player by player ID
sub displaycollection {
  my $bot    = shift;
  my $params = {@_};
  my $args   = [
		who => $params->{who},
		];
  
  # Make the call
  $bot->ua->timeout($bot->config->{timeout});
  my $url = $bot->url . 'displaycollection.php';
  my $response = $bot->ua->post($url,$args);
  
  # Get the response
  $response->is_success or die 'HTTP ' . $response->status_line;
  
  # See if we're cool
  $bot->check_response($response);
  
  # Create a data structure to return
  my $displaycase = {
    user        => '',
    user_id     => '',
    description => '',
    shelves     => [],
  };
  
  # Save the content
  my $content = $response->content;
  my @content = split (/<tr>/i, $content);
  
  # Placeholder for new shelf data
  my $shelf = '';
  
  # Parse the content
  while ($content = shift (@content)) {
  # Is this display case empty?
    if ($content =~ m!<p><center><b>This display case is currently empty.</b></center><p><center>!m) {
      last;

    } elsif ($content =~ m!^<td style="color: white;" align=center bgcolor=blue><b>Display Case \(<a style='color: white; text-decoration: none;' href="showplayer.php\?who=(\d+)">(.*)</a>\)</b></td></tr>!m) {
    # Can we snag the player name out of here, to prevent another DB hit?
      $displaycase->{user_id} = $1;
      $displaycase->{user}    = $2;
    } elsif ($content =~ m!^<td valign=center><img src="http://images.kingdomofloathing.com/otherimages/museum/displaycase.gif" width=100 height=100></td><td valign=center>(.*)</td></tr></table>!m) {

      # Is this the case description?
      $displaycase->{description} = $1;
    } elsif ($content =~ m!^<td style="color: white;" align=center bgcolor=blue><b>(.*)</b></td></tr>!m) {
      # Is this a new shelf?
      # Save the previous shelf if we were working on one already
      if ($shelf ne '') {
	push (@{$displaycase->{shelves}}, $shelf);
      }

      # Create a new shelf
      $shelf = { title => $1, item => {} };
    } elsif ($content =~ m!^<td width=30 height=30><img src="http://images\.kingdomofloathing\.com/itemimages/(.*)\.gif" class=hand onClick='descitem\((\d+)\)'></td><td valign=center><b>(.*?)</b>( \(([\d,]+)\))?!) {
      # Is this an item on a shelf?
      # Remember the matches
      my $item_desc = $2;
      my $quantity  = $5 ? $5 : 1;
  
      # Remove commas from quantity
      $quantity =~ s/,//g;
  
      # Store the record
      $shelf->{item}->{ $item_desc } = $quantity;
    }
  }

  # If we have a shelf left open, push it
  push (@{$displaycase->{shelves}}, $shelf) if $shelf ne '';

  # Return the display case structure
  return $displaycase;
}

# eP2
# Searches for a player, returns a hash which maps player name into player ID
#
# Input params it can take, which are identical to the Search Player dialog box
#    searchstring  => substring of name
#    searchlevel   => level player
#    searchranking => maximum ranking
#    pvponly       => If set, limit to PvP players only
#    hardcoreonly  => If set, limit to hardcore players only

sub search_player {
  my $bot    = shift;
  my $args = [
	      searching => 'Yep',
	      @_
	      ];
  
  # Get the response to the query
  my $url = $bot->url . 'searchplayer.php';
  my $response = $bot->ua->post ($url, $args);
  
  # Search through the results, looking for players
  my $player = '';
  my $player_list = {};
  
  foreach $player (split (/showplayer\.php/, $response->content)) {
    # Look for player strings
    if ($player =~ /^\?who=(\d+)(\'|\")>(.*?)<\/a>/) {
      # Add the player to the response list
      $player_list->{$3} = $1;
    }
  }
  
  # Return the result
  return ($player_list);
}

# eP2
sub item_image_url {
  my $bot = shift;
  my $args = [
	      @_
	      ];
  
  my $url = $bot->url . 'desc_item.php';
  my $response = $bot->ua->post ($url, $args);
  my $content = $response->content;
  
  if($content =~ m!(http://images.kingdomofloathing.com/itemimages/.*\.gif)!) {
    return $1;
  } else {
    return '';
  }
}

# eP2
sub get_item_description {
  my $bot = shift;
  my $args = [
	      @_
	      ];
  
  # Get the description
  my $url = $bot->url . 'desc_item.php';
  my $response = $bot->ua->post ($url, $args);
  my $content = $response->content;

  # Placeholder for the return value
  my $item = '';
  
  # First, see if we have a valid item at all
  if ($content !~ /No description data exists for this item\./) {
    # Remove newlines
    $content =~ s/\s+/ /g;
    
    # Create a new hash ref for the item fields
    $item = {};
    
    # Save the entire content of this thing
    $item->{description} = $1 if $content =~ /<blockquote>(.*)<\/blockquote>/;
    
    # Get the image filename
    $item->{image_filename} = $1 if $content =~ /images\.kingdomofloathing\.com\/itemimages\/(.*?\.gif)/;
    
    # Get the name
    $item->{name} = $1 if $content =~ /<b>(.*?)<\/b><p><\/center><blockquote>/;
    
    # Is there a type for this thing?
    if ($content =~ /<br>Type: <b>(.*?)<\/b></) {
      # Hold onto this type
      my $type = $1;
      
      # If it's a weapon, pick it apart further
      if ($type =~ /^(ranged )?weapon \((\d+)-handed (.*)\)$/) {
	$item->{type}          = 'weapon';
	$item->{ranged_weapon} = $1 ? 1 : 0;
	$item->{weapon_hands}  = $2;
	$item->{weapon_type}   = $3;

      } elsif ($type =~ /^off-hand item (\((.*)\))?/) {
	# If it's an off-hand item, pick it apart further
	$item->{type} = "off-hand item";
	$item->{off_hand_type} = $2;
      } else {
	# Otherwise, just keep it the same type as defined
	$item->{type} = $type;
      }

      # Do other things with type
      $item->{usable} = ($type eq 'usable'      || $type eq 'combat / usable item') ? 1 : 0;
      $item->{combat} = ($type eq 'combat item' || $type eq 'combat / usable item') ? 1 : 0;
    }

    # Is there some power associated with this item?
    $item->{power} = $1 if $content =~ /<br>Power: <b>(\d+)<\/b></;

    # Is this item part of an outfit?
    $item->{outfit} = $1 if $content =~ /<br>Outfit: <b>(.*?)<\/b>/;

# Are there equipping requirements?
    $item->{muscle_required}      = $1 if $content =~ /<br>Muscle Required: <b>(\d+)<\/b></;
    $item->{mysticality_required} = $1 if $content =~ /<br>Mysticality Required: <b>(\d+)<\/b></;
    $item->{moxie_required}       = $1 if $content =~ /<br>Moxie Required: <b>(\d+)<\/b></;

# Can we combine this in some special way?
    $item->{meatsmithing_component}      = $content =~ /<br>\(Meatsmithing component\)</      ? 1 : 0;
    $item->{cooking_ingredient}          = $content =~ /<br>\(Cooking ingredient\)</          ? 1 : 0;
    $item->{cocktailcrafting_ingredient} = $content =~ /<br>\(Cocktailcrafting ingredient\)</ ? 1 : 0;
    $item->{jewelrymaking_component}     = $content =~ /<br>\(Jewelrymaking component\)</     ? 1 : 0;
    $item->{gift_item}                   = $content =~ /<br><b>Gift Item<\/b>/                ? 1 : 0;

# Can we trade it or junk it?
    $item->{tradeable}   = $content =~ /<br>Cannot be traded\.</  ? 0 : 1;
    $item->{discardable} = $content =~ /<br>Cannot be discarded</ ? 0 : 1;
    $item->{quest_item}  = $content =~ />Quest Item</             ? 1 : 0;

    $item->{enchantment} = $1 if
      $content =~ /<center>Enchantment:<br><b><font color=blue>(.*)<br>/;

# Can we sell it?
    $item->{selling_price} = $1 if $content =~ /Selling Price: <b>(\d+) Meat\.</;
  }

  return $item;
}
  
##############################################################################
# Derived functions
##############################################################################


sub make_scrumptious_reagent {
  my $bot = shift;
  my $number = shift || 1;

  return $bot->use_skill(skill => 4006,
			 castings=>$number,
			 check_response => 1);
}

sub make_dry_noodles {
  my $bot = shift;
  my $number = shift || 1;

  return $bot->use_skill(skill => 3006,
			 castings=>$number);
}


END {} ;

1;

