--- deliantra/Deliantra-Client/DC.pm 2007/01/05 17:37:39 1.138 +++ deliantra/Deliantra-Client/DC.pm 2008/09/02 16:27:34 1.188 @@ -1,10 +1,10 @@ =head1 NAME -CFPlus - undocumented utility garbage for our crossfire client +DC - undocumented utility garbage for our deliantra client =head1 SYNOPSIS - use CFPlus; + use DC; =head1 DESCRIPTION @@ -12,30 +12,30 @@ =cut -package CFPlus; +package Deliantra::Client; # work around CPAN breakage +package App::Deliantra; # try to reserve namespace +package DC; use Carp (); +our $VERSION; + BEGIN { - $VERSION = '0.97'; + $VERSION = '0.9975'; use XSLoader; - XSLoader::load "CFPlus", $VERSION; + XSLoader::load "Deliantra::Client", $VERSION; } use utf8; +use strict qw(vars subs); use AnyEvent (); -use BerkeleyDB; use Pod::POM (); use File::Path (); use Storable (); # finally - -BEGIN { - use Crossfire::Protocol::Base (); - *to_json = \&Crossfire::Protocol::Base::to_json; - *from_json = \&Crossfire::Protocol::Base::from_json; -} +use Fcntl (); +use JSON::XS qw(encode_json decode_json); =item guard { BLOCK } @@ -44,10 +44,10 @@ =cut sub guard(&) { - bless \(my $cb = $_[0]), "CFPlus::Guard" + bless \(my $cb = $_[0]), "DC::Guard" } -sub CFPlus::Guard::DESTROY { +sub DC::Guard::DESTROY { ${$_[0]}->() } @@ -73,7 +73,7 @@ sub socketpipe() { socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC - or die "cannot establish bidiretcional pipe: $!\n"; + or die "cannot establish bidirectional pipe: $!\n"; ($fh1, $fh2) } @@ -81,7 +81,7 @@ sub background(&;&) { my ($bg, $cb) = @_; - my ($fh_r, $fh_w) = CFPlus::socketpipe; + my ($fh_r, $fh_w) = DC::socketpipe; my $pid = fork; @@ -101,13 +101,13 @@ my $msg = $@; $msg =~ s/\n+/\n/; warn "FATAL: $msg"; - CFPlus::_exit 1; + DC::_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; + DC::_exit 0; } close $fh_w; @@ -126,10 +126,10 @@ $line =~ s/\s+$//; utf8::decode $line; if ($line =~ /^\x{e877}json_msg (.*)$/s) { - $cb->(from_json $1); + $cb->(JSON::XS->new->allow_nonref->decode ($1)); } else { ::message ({ - markup => "background($pid): " . CFPlus::asxml $line, + markup => "background($pid): " . DC::asxml $line, }); } } @@ -139,50 +139,32 @@ sub background_msg { my ($msg) = @_; - $msg = "\x{e877}json_msg " . to_json $msg; + $msg = "\x{e877}json_msg " . JSON::XS->new->allow_nonref->encode ($msg); $msg =~ s/\n//g; utf8::encode $msg; print $msg, "\n"; } -package CFPlus::Database; +package DC; -our @ISA = BerkeleyDB::Btree::; +our $RC_THEME = "theme-metal"; +our $RC_BASE; -sub get($$) { - my $data; - - $_[0]->db_get ($_[1], $data) == 0 - ? $data - : () +for (grep !ref, @INC) { + $RC_BASE = "$_/Deliantra/Client/private/resources"; + last if -d $RC_BASE; } -my %DB_SYNC; - -sub put($$$) { - my ($db, $key, $data) = @_; - - my $hkey = $db + 0; - CFPlus::weaken $db; - $DB_SYNC{$hkey} ||= AnyEvent->timer (after => 30, cb => sub { - delete $DB_SYNC{$hkey}; - $db->db_sync if $db; - }); - - $db->db_put ($key => $data) -} - -package CFPlus; - sub find_rcfile($) { my $path; - for (grep !ref, @INC) { - $path = "$_/CFPlus/resources/$_[0]"; - return $path if -r $path; - } + $path = "$RC_BASE/$RC_THEME/$_[0]"; + return $path if -r $path; + + $path = "$RC_BASE/$_[0]"; + return $path if -r $path; - die "FATAL: can't find required file $_[0]\n"; + die "FATAL: can't find required file \"$_[0]\" in \"$RC_BASE\"\n"; } sub read_cfg { @@ -194,25 +176,17 @@ local $/; my $CFG = <$fh>; - if ($CFG =~ /^---/) { ## TODO compatibility cruft, remove - require YAML; - utf8::decode $CFG; - $::CFG = YAML::Load ($CFG); - } elsif ($CFG =~ /^\{/) { - $::CFG = from_json $CFG; - } else { - $::CFG = eval $CFG; ## todo comaptibility cruft - } + $::CFG = decode_json $CFG; } sub write_cfg { - my ($file) = @_; + my $file = "$Deliantra::VARDIR/client.cf"; $::CFG->{VERSION} = $::VERSION; open my $fh, ">:utf8", $file or return; - print $fh to_json $::CFG; + print $fh JSON::XS->new->utf8->pretty->encode ($::CFG); } sub http_proxy { @@ -237,10 +211,10 @@ sub lwp_useragent { require LWP::UserAgent; - CFPlus::set_proxy; + DC::set_proxy; my $ua = LWP::UserAgent->new ( - agent => "cfplus $VERSION", + agent => "deliantra $VERSION", keep_alive => 1, env_proxy => 1, timeout => 30, @@ -256,58 +230,25 @@ $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" -} - -our $DB_HOME = "$Crossfire::VARDIR/cfplus"; - -sub open_db { - use strict; +sub fh_nonblocking($$) { + my ($fh, $nb) = @_; - mkdir $DB_HOME, 0777; - my $recover = $BerkeleyDB::db_version >= 4.4 - ? eval "DB_REGISTER | DB_RECOVER" - : 0; - - $DB_ENV = new BerkeleyDB::Env - -Home => $DB_HOME, - -Cachesize => 8_000_000, - -ErrFile => "$DB_HOME/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 $DB_HOME: $BerkeleyDB::Error"; - - $DB_STATE = db_table "state"; - - 1 + if ($^O eq "MSWin32") { + $nb = (! ! $nb) + 0; + ioctl $fh, 0x8004667e, \$nb; # FIONBIO + } else { + fcntl $fh, &Fcntl::F_SETFL, $nb ? &Fcntl::O_NONBLOCK : 0; + } } -unless (eval { open_db }) { - File::Path::rmtree $DB_HOME; - open_db; -} +package DC::Layout; -package CFPlus::Layout; +$DC::OpenGL::INIT_HOOK{"DC::Layout"} = sub { + glyph_cache_restore; +}; -$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub { - reset_glyph_cache; +$DC::OpenGL::SHUTDOWN_HOOK{"DC::Layout"} = sub { + glyph_cache_backup; }; 1;