#!/usr/bin/perl

use warnings;
use strict;
use vars qw{
              $dbh          $nap          $daemon
              %children     $mynick       $maintainer
              $debug        $epoch
            };
use lib qw{ lib . };

use Carp qw{ cluck croak carp };
use Data::Dumper;

use DBI;

use MP3::Napster;
use constant MSG_SERVER_NOSUCH => 404;
use constant MSG_SERVER_PUBLIC => 403;
use constant MSG_CLIENT_EMOTE => 824;
use constant MSG_CLIENT_PRIVMSG => 205;

  $daemon = 1;
  $debug = 0;
  $epoch = time();

  $daemon and daemonize();
  database_initialize();
  napster_initialize();
  admin_initialize();
  callbacks_initialize();
  $nap -> run();

END {
  $dbh -> disconnect();
  $nap -> disconnect();
  exit 0;
}

sub daemonize {
  #exit if fork();
  fork and exit;
}

sub database_initialize {
  my $DBD = "Pg";
  my $dbname = "botdb";
  my $dbhost = "localhost";
  my $dbuser = "alex";
  my $dbpass = "";
  my @dbi_params = (
    "dbi:".$DBD.":dbname=".$dbname.";host=".$dbhost,
    $dbuser,
    $dbpass,
  );
  $dbh = DBI -> connect(@dbi_params)
    or croak "".DBI -> errstr."\n"; # this is kind of sucky, blame perl.
  1;
}

sub napster_initialize {
  my $config_sth = $dbh -> prepare(qq{
    select username, password, server, port, channel from config
  });
  $config_sth -> execute();

  my ($username, $password, $server, $port, $channel) =
    map { @{ $_ } } @{ $config_sth -> fetchall_arrayref() };

  $mynick = $username;

  $nap = MP3::Napster -> new( -server => qq{$server:$port} );
  $nap -> login($username, $password)
    or croak "could not log in to server $server [". $nap -> error() ."]\n";

  $nap -> join_channel($channel);

  my $package = __PACKAGE__;
  %children =
    map { $_ => { } }
      grep { defined $_ and $_ }
        map { $_ =~ s/${package}::([A-Z_]+)/$1/ && $_ }
          keys %constant::declared;

  $children{MSG_SERVER_PUBLIC} -> { load_sub -> () } = \&load_sub;
  $children{MSG_SERVER_PUBLIC} -> { unload_sub -> () } = \&unload_sub;
  1;
}

sub admin_initialize {
  # this does not work in darwin.
  $0 =~ s/.*/petunia -d/;

  # set up some maintainers
  my $maintainer_sth = $dbh -> prepare(qq{
    select maintainer from config
  });
  $maintainer_sth -> execute();
  my (@maintainers) =
    grep { defined $_ }
      map { @{ $_ } } @{ $maintainer_sth -> fetchall_arrayref() };
  $maintainer = join "|", @maintainers;
  $maintainer = qr{$maintainer};
  undef $maintainer_sth;

  1;
}

sub callbacks_initialize {
  carp "callbacks\n";
  $nap -> callback (MSG_SERVER_NOSUCH, sub { server_error_messages($_[0], [@_[1..$#_]]) });
  $nap -> callback (MSG_SERVER_PUBLIC, sub { public_messages($_[0], [@_[1..$#_]]) });
  $nap -> callback (MSG_CLIENT_EMOTE, sub { emote_messages($_[0], [@_[1..$#_]]) });
  $nap -> callback (MSG_CLIENT_PRIVMSG, sub { private_messages($_[0], [@_[1..$#_]]) });
}

sub server_error_messages {
  1;
}

sub public_messages {
  my $nap_object = shift;
  my @args = @{ shift() };
  my ($ec, $message) = @args;
  return unless my ($channel, $nick, $packet) = $message =~ /^(\S+) (\S+) (.*)/;
  return unless $nick !~ /^$mynick$/;
  if (!$daemon and $debug) {
    print "[ $ec ] [ $channel/$nick ] [ $packet ]\n";
  }
  foreach my $child (keys %{ $children{MSG_SERVER_PUBLIC} }) {
    $children{MSG_SERVER_PUBLIC} -> {$child} -> ($channel, $nick, $packet);
  }
}

sub emote_messages {
  1;
}

sub private_message {
  1;
}

# this is pretty cool. put a sub in that was in the database.
sub load_sub {
  my ($thischan, $thisuser, $thismsg) = (@_);
  return "load_sub" if @_ == 0;
  return unless $thismsg =~ /^:load /;
  my ($sub_to_load) = $thismsg =~ /^:load (\S+)/;
  print "\t-> loading $sub_to_load\n";
  my $selector = $dbh -> prepare(qq{
    select code from subs where name = ?
  });
  $selector -> execute($sub_to_load);
  my ($sub) = map { @{ $_ } } @{ $selector -> fetchall_arrayref() };
  if (!$sub) {
    print "\t-> could not find $sub_to_load\n";
  }
  else {
    eval $sub;
    {
      # yes, this is necessary.
      no strict qw{ refs };
      $children{MSG_SERVER_PUBLIC} -> { &{$sub_to_load}() } = \&{$sub_to_load};
    }
    if ($@) {
      $nap -> public_message("$sub_to_load had some problems:");
      $nap -> public_message($@);
      return 0;
    }
    else {
      # it was probably good
      $nap -> public_message("$sub_to_load loaded without errors.");
    }
  }
}

sub unload_sub {
  my ($thischan, $thisuser, $thismsg) = (@_);
  return "unload_sub" if @_ == 0;
  return unless $thismsg =~ /^:unload /;
  my ($sub_to_unload) = $thismsg =~ /^:unload (\S+)/;

  # check if its extant and if its readonly and if its loaded.
  my $checker_sth = $dbh -> prepare(qq{
    select name, readonly from subs where name = ?
  });
  $checker_sth -> execute($sub_to_unload);
  my (@attrib) = map { @{ $_ } } @{ $checker_sth -> fetchall_arrayref() };
  my ($name, $ro) = @attrib;

  if ($ro) {
    # this is a readonly sub, and we do not let the user remove it.
    $nap -> public_message( "sorry, $sub_to_unload is read-only." );
    return 0;
  }

  elsif (not defined $children{MSG_SERVER_PUBLIC} -> {$sub_to_unload}) {
    # the sub is not extant in the hash
    $nap -> public_message( "sorry, $sub_to_unload is not loaded." );
    return 0;
  }

  else {
    # it is extant and rw
    delete $children{MSG_SERVER_PUBLIC} -> {$sub_to_unload};
    $nap -> public_message( "$sub_to_unload removed." );
    return 1;
  }
  return 0;
}