--- deliantra/Deliantra-Client/DC.pm	2006/09/12 20:48:17	1.118
+++ deliantra/Deliantra-Client/DC.pm	2006/12/06 00:15:12	1.133
@@ -14,8 +14,10 @@
 
 package CFPlus;
 
+use Carp ();
+
 BEGIN {
-   $VERSION = '0.5';
+   $VERSION = '0.97';
 
    use XSLoader;
    XSLoader::load "CFPlus", $VERSION;
@@ -23,13 +25,18 @@
 
 use utf8;
 
-use Carp ();
 use AnyEvent ();
 use BerkeleyDB;
 use Pod::POM ();
 use Scalar::Util ();
 use Storable (); # finally
 
+BEGIN {
+   use Crossfire::Protocol::Base ();
+   *to_json   = \&Crossfire::Protocol::Base::to_json;
+   *from_json = \&Crossfire::Protocol::Base::from_json;
+}
+
 =item guard { BLOCK }
 
 Returns an object that executes the given block as soon as it is destroyed.
@@ -44,6 +51,16 @@
    ${$_[0]}->()
 }
 
+=item shorten $string[, $maxlength]
+
+=cut
+
+sub shorten($;$) {
+   my ($str, $len) = @_;
+   substr $str, $len, (length $str), "..." if $len + 3 <= length $str;
+   $str
+}
+
 sub asxml($) {
    local $_ = $_[0];
 
@@ -54,6 +71,80 @@
    $_
 }
 
+sub socketpipe() {
+   socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC
+      or die "cannot establish bidiretcional pipe: $!\n";
+
+   ($fh1, $fh2)
+}
+
+sub background(&;&) {
+   my ($bg, $cb) = @_;
+
+   my ($fh_r, $fh_w) = CFPlus::socketpipe;
+
+   my $pid = fork;
+
+   if (defined $pid && !$pid) {
+      local $SIG{__DIE__};
+
+      open STDOUT, ">&", $fh_w;
+      open STDERR, ">&", $fh_w;
+      close $fh_r;
+      close $fh_w;
+
+      $| = 1;
+
+      eval { $bg->() };
+
+      if ($@) {
+         my $msg = $@;
+         $msg =~ s/\n+/\n/;
+         warn "FATAL: $msg";
+         CFPlus::_exit 1;
+      }
+
+      # win32 is fucked up, of course. exit will clean stuff up,
+      # which destroys our database etc. _exit will exit ALL
+      # forked processes, because of the dreaded fork emulation.
+      CFPlus::_exit 0;
+   }
+
+   close $fh_w;
+
+   my $buffer;
+
+   my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub {
+      unless (sysread $fh_r, $buffer, 4096, length $buffer) {
+         undef $w;
+         $cb->();
+         return;
+      }
+
+      while ($buffer =~ s/^(.*)\n//) {
+         my $line = $1;
+         $line =~ s/\s+$//;
+         utf8::decode $line;
+         if ($line =~ /^\x{e877}json_msg (.*)$/s) {
+            $cb->(from_json $1);
+         } else {
+            ::message ({
+               markup => "background($pid): " . CFPlus::asxml $line,
+            });
+         }
+      }
+   });
+}
+
+sub background_msg {
+   my ($msg) = @_;
+
+   $msg = "\x{e877}json_msg " . to_json $msg;
+   $msg =~ s/\n//g;
+   utf8::encode $msg;
+   print $msg, "\n";
+}
+
 package CFPlus::Database;
 
 our @ISA = BerkeleyDB::Btree::;
@@ -94,12 +185,6 @@
    die "FATAL: can't find required file $_[0]\n";
 }
 
-BEGIN {
-   use Crossfire::Protocol::Base ();
-   *to_json   = \&Crossfire::Protocol::Base::to_json;
-   *from_json = \&Crossfire::Protocol::Base::from_json;
-}
-
 sub read_cfg {
    my ($file) = @_;
 
@@ -130,27 +215,50 @@
    print $fh to_json $::CFG;
 }
 
-our $DB_ENV;
+sub http_proxy {
+   my @proxy = win32_proxy_info;
 
-{
-   use strict;
+   if (@proxy) {
+      "http://" . (@proxy < 2 ? "" : @proxy < 3 ? "$proxy[1]\@" : "$proxy[1]:$proxy[2]\@") . $proxy[0]
+   } elsif (exists $ENV{http_proxy}) {
+      $ENV{http_proxy}
+   } else {
+     ()
+   }
+}
 
-   mkdir "$Crossfire::VARDIR/cfplus", 0777;
-   my $recover = $BerkeleyDB::db_version >= 4.4 
-                 ? eval "DB_REGISTER | DB_RECOVER"
-                 : 0;
+sub set_proxy {
+   my $proxy = http_proxy
+      or return;
 
-   $DB_ENV = new BerkeleyDB::Env
-                    -Home => "$Crossfire::VARDIR/cfplus",
-                    -Cachesize => 1_000_000,
-                    -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
-#                 -ErrPrefix => "DATABASE",
-                    -Verbose => 1,
-                    -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover,
-                    -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
-                       or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
+   $ENV{http_proxy} = $proxy;
 }
 
+sub lwp_useragent {
+   require LWP::UserAgent;
+   
+   CFPlus::set_proxy;
+
+   my $ua = LWP::UserAgent->new (
+      agent      => "cfplus $VERSION",
+      keep_alive => 1,
+      env_proxy  => 1,
+      timeout    => 30,
+   );
+}
+
+sub lwp_check($) {
+   my ($res) = @_;
+
+   $res->is_error
+      and die $res->status_line;
+
+   $res
+}
+
+our $DB_ENV;
+our $DB_STATE;
+
 sub db_table($) {
    my ($table) = @_;
 
@@ -166,6 +274,29 @@
          or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
 }
 
+{
+   use strict;
+
+   my $HOME = "$Crossfire::VARDIR/cfplus-$BerkeleyDB::db_version";
+
+   mkdir $HOME, 0777;
+   my $recover = $BerkeleyDB::db_version >= 4.4 
+                 ? eval "DB_REGISTER | DB_RECOVER"
+                 : 0;
+
+   $DB_ENV = new BerkeleyDB::Env
+                    -Home => $HOME,
+                    -Cachesize => 1_000_000,
+                    -ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
+#                 -ErrPrefix => "DATABASE",
+                    -Verbose => 1,
+                    -Flags => DB_CREATE | DB_RECOVER | DB_INIT_MPOOL | DB_INIT_LOCK | DB_INIT_TXN | $recover,
+                    -SetFlags => DB_AUTO_COMMIT | DB_LOG_AUTOREMOVE,
+                       or die "unable to create/open database home $HOME: $BerkeleyDB::Error";
+
+   $DB_STATE = db_table "state";
+}
+
 package CFPlus::Layout;
 
 $CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {
@@ -272,6 +403,8 @@
             $move_prefix = "take";
          }
 
+         my $shortname = CFPlus::shorten $self->{name}, 14;
+
          my @menu_items = (
             ["examine", sub { $::CONN->send ("examine $self->{tag}") }],
             ["mark",    sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
@@ -316,6 +449,7 @@
                   ]
                )
             ),
+            ["bind <i>apply $shortname</i> to a key"   => sub { $::BIND_EDITOR->do_quick_binding (["apply $self->{name}"]) }],
          );
 
          CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);