--- deliantra/Deliantra-Client/DC.pm 2006/09/29 00:56:05 1.121 +++ deliantra/Deliantra-Client/DC.pm 2006/12/03 16:48:24 1.130 @@ -17,21 +17,12 @@ use Carp (); BEGIN { - $VERSION = '0.52'; + $VERSION = '0.97'; use XSLoader; XSLoader::load "CFPlus", $VERSION; } -BEGIN { - $SIG{__DIE__} = sub { - return if CFPlus::in_destruct; - #CFPlus::fatal $_[0];#d# - CFPlus::error Carp::longmess $_[0];#d# - die;#d# - }; -} - use utf8; use AnyEvent (); @@ -40,6 +31,12 @@ 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. @@ -64,6 +61,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::; @@ -104,12 +175,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) = @_; @@ -140,6 +205,47 @@ print $fh to_json $::CFG; } +sub http_proxy { + my @proxy = win32_proxy_info; + + if (@proxy) { + "http://" . (@proxy < 2 ? "" : @proxy < 3 ? "$proxy[1]\@" : "$proxy[1]:$proxy[2]\@") . $proxy[0] + } elsif (exists $ENV{http_proxy}) { + $ENV{http_proxy} + } else { + () + } +} + +sub set_proxy { + my $proxy = http_proxy + or return; + + $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;