--- deliantra/Deliantra-Client/DC.pm 2006/09/12 20:48:17 1.118 +++ deliantra/Deliantra-Client/DC.pm 2006/11/16 19:43:04 1.128 @@ -14,22 +14,38 @@ package CFPlus; +use Carp (); + BEGIN { - $VERSION = '0.5'; + $VERSION = '0.96'; 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 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. @@ -54,6 +70,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 +184,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,7 +214,64 @@ 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; + +sub db_table($) { + my ($table) = @_; + + $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge; + + new CFPlus::Database + -Env => $DB_ENV, + -Filename => $table, +# -Filename => "database", +# -Subname => $table, + -Property => DB_CHKSUM, + -Flags => DB_CREATE | DB_UPGRADE, + or die "unable to create/open database table $_[0]: $BerkeleyDB::Error" +} { use strict; @@ -149,21 +290,8 @@ -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"; -} - -sub db_table($) { - my ($table) = @_; - $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge; - - new CFPlus::Database - -Env => $DB_ENV, - -Filename => $table, -# -Filename => "database", -# -Subname => $table, - -Property => DB_CHKSUM, - -Flags => DB_CREATE | DB_UPGRADE, - or die "unable to create/open database table $_[0]: $BerkeleyDB::Error" + $DB_STATE = db_table "state"; } package CFPlus::Layout;