--- deliantra/Deliantra-Client/DC.pm 2006/10/18 12:53:45 1.125 +++ deliantra/Deliantra-Client/DC.pm 2008/08/19 17:38:29 1.186 @@ -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,33 +12,27 @@ =cut -package CFPlus; +package Deliantra::Client; # work around CPAN breakage +package App::Deliantra; # try to reserve namespace +package DC; use Carp (); BEGIN { - $VERSION = '0.53'; + $VERSION = '0.9975'; 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# - }; + XSLoader::load "Deliantra::Client", $VERSION; } use utf8; use AnyEvent (); -use BerkeleyDB; use Pod::POM (); -use Scalar::Util (); +use File::Path (); use Storable (); # finally +use Fcntl (); +use JSON::XS qw(encode_json decode_json); =item guard { BLOCK } @@ -47,13 +41,23 @@ =cut sub guard(&) { - bless \(my $cb = $_[0]), "CFPlus::Guard" + bless \(my $cb = $_[0]), "DC::Guard" } -sub CFPlus::Guard::DESTROY { +sub DC::Guard::DESTROY { ${$_[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]; @@ -66,15 +70,15 @@ 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) } -sub background(&) { - my ($cb) = @_; +sub background(&;&) { + my ($bg, $cb) = @_; - my ($fh_r, $fh_w) = CFPlus::socketpipe; + my ($fh_r, $fh_w) = DC::socketpipe; my $pid = fork; @@ -88,88 +92,69 @@ $| = 1; - eval { $cb->() }; + eval { $bg->() }; if ($@) { 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; my $buffer; - Event->io (fd => $fh_r, poll => 'r', cb => sub { + my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub { unless (sysread $fh_r, $buffer, 4096, length $buffer) { - $_[0]->w->cancel; - $buffer .= "done\n"; + undef $w; + $cb->(); + return; } while ($buffer =~ s/^(.*)\n//) { my $line = $1; $line =~ s/\s+$//; utf8::decode $line; - ::message ({ - markup => "editor($pid): " . CFPlus::asxml $line, - }); + if ($line =~ /^\x{e877}json_msg (.*)$/s) { + $cb->(JSON::XS->new->allow_nonref->decode ($1)); + } else { + ::message ({ + markup => "background($pid): " . DC::asxml $line, + }); + } } }); } -package CFPlus::Database; - -our @ISA = BerkeleyDB::Btree::; - -sub get($$) { - my $data; - - $_[0]->db_get ($_[1], $data) == 0 - ? $data - : () -} - -my %DB_SYNC; - -sub put($$$) { - my ($db, $key, $data) = @_; - - my $hkey = $db + 0; - Scalar::Util::weaken $db; - $DB_SYNC{$hkey} ||= AnyEvent->timer (after => 5, cb => sub { - delete $DB_SYNC{$hkey}; - $db->db_sync if $db; - }); +sub background_msg { + my ($msg) = @_; - $db->db_put ($key => $data) + $msg = "\x{e877}json_msg " . JSON::XS->new->allow_nonref->encode ($msg); + $msg =~ s/\n//g; + utf8::encode $msg; + print $msg, "\n"; } -package CFPlus; +package DC; sub find_rcfile($) { my $path; for (grep !ref, @INC) { - $path = "$_/CFPlus/resources/$_[0]"; + $path = "$_/Deliantra/Client/private/resources/$_[0]"; return $path if -r $path; } 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) = @_; @@ -179,25 +164,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 { @@ -219,261 +196,48 @@ $ENV{http_proxy} = $proxy; } -our $DB_ENV; -our $DB_STATE; - -sub db_table($) { - my ($table) = @_; - - $table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge; +sub lwp_useragent { + require LWP::UserAgent; + + DC::set_proxy; - 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" + my $ua = LWP::UserAgent->new ( + agent => "deliantra $VERSION", + keep_alive => 1, + env_proxy => 1, + timeout => 30, + ); } -{ - use strict; - - mkdir "$Crossfire::VARDIR/cfplus", 0777; - my $recover = $BerkeleyDB::db_version >= 4.4 - ? eval "DB_REGISTER | DB_RECOVER" - : 0; +sub lwp_check($) { + my ($res) = @_; - $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"; + $res->is_error + and die $res->status_line; - $DB_STATE = db_table "state"; + $res } -package CFPlus::Layout; - -$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub { - reset_glyph_cache; -}; - -package CFPlus::Item; - -use strict; -use Crossfire::Protocol::Constants; - -my $last_enter_count = 1; +sub fh_nonblocking($$) { + my ($fh, $nb) = @_; -sub desc_string { - my ($self) = @_; - - my $desc = - $self->{nrof} < 2 - ? $self->{name} - : "$self->{nrof} × $self->{name_pl}"; - - $self->{flags} & F_OPEN - and $desc .= " (open)"; - $self->{flags} & F_APPLIED - and $desc .= " (applied)"; - $self->{flags} & F_UNPAID - and $desc .= " (unpaid)"; - $self->{flags} & F_MAGIC - and $desc .= " (magic)"; - $self->{flags} & F_CURSED - and $desc .= " (cursed)"; - $self->{flags} & F_DAMNED - and $desc .= " (damned)"; - $self->{flags} & F_LOCKED - and $desc .= " *"; - - $desc -} - -sub weight_string { - my ($self) = @_; - - my $weight = ($self->{nrof} || 1) * $self->{weight}; - - $weight < 0 ? "?" : $weight * 0.001 -} - -sub do_n_dialog { - my ($cb) = @_; - - my $w = new CFPlus::UI::Toplevel - on_delete => sub { $_[0]->destroy; 1 }, - has_close_button => 1, - ; - - $w->add (my $vb = new CFPlus::UI::VBox x => "center", y => "center"); - $vb->add (new CFPlus::UI::Label text => "Enter item count:"); - $vb->add (my $entry = new CFPlus::UI::Entry - text => $last_enter_count, - on_activate => sub { - my ($entry) = @_; - $last_enter_count = $entry->get_text; - $cb->($last_enter_count); - $w->hide; - $w->destroy; - - 0 - }, - on_escape => sub { $w->destroy; 1 }, - ); - $entry->grab_focus; - $w->show; + if ($^O eq "MSWin32") { + $nb = (! ! $nb) + 0; + ioctl $fh, 0x8004667e, \$nb; # FIONBIO + } else { + fcntl $fh, &Fcntl::F_SETFL, $nb ? &Fcntl::O_NONBLOCK : 0; + } } -sub update_widgets { - my ($self) = @_; - - # necessary to avoid cyclic references - Scalar::Util::weaken $self; - - my $button_cb = sub { - my (undef, $ev, $x, $y) = @_; - - my $targ = $::CONN->{player}{tag}; +package DC::Layout; - if ($self->{container} == $::CONN->{player}{tag}) { - $targ = $::CONN->{open_container}; - } - - if (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 1) { - $::CONN->send ("move $targ $self->{tag} 0") - if $targ || !($self->{flags} & F_LOCKED); - } elsif (($ev->{mod} & CFPlus::KMOD_SHIFT) && $ev->{button} == 2) { - $self->{flags} & F_LOCKED - ? $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) - : $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) - } elsif ($ev->{button} == 1) { - $::CONN->send ("examine $self->{tag}"); - } elsif ($ev->{button} == 2) { - $::CONN->send ("apply $self->{tag}"); - } elsif ($ev->{button} == 3) { - my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop'; - if ($self->{container} == $::CONN->{open_container}) { - $move_prefix = "take"; - } - - my @menu_items = ( - ["examine", sub { $::CONN->send ("examine $self->{tag}") }], - ["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }], - ["ignite/thaw", # first try of an easier use of flint&steel - sub { - $::CONN->send ("mark ". pack "N", $self->{tag}); - $::CONN->send ("command apply flint and steel"); - } - ], - ["inscribe", # first try of an easier use of flint&steel - sub { - &::open_string_query ("Text to inscribe", sub { - my ($entry, $txt) = @_; - $::CONN->send ("mark ". pack "N", $self->{tag}); - $::CONN->send ("command use_skill inscription $txt"); - }); - } - ], - ["rename", # first try of an easier use of flint&steel - sub { - &::open_string_query ("Rename item to:", sub { - my ($entry, $txt) = @_; - $::CONN->send ("mark ". pack "N", $self->{tag}); - $::CONN->send ("command rename to <$txt>"); - }, $self->{name}, - "If you input no name or erase the current custom name, the custom name will be unset"); - } - ], - ["apply", sub { $::CONN->send ("apply $self->{tag}") }], - ( - $self->{flags} & F_LOCKED - ? ( - ["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) }], - ) - : ( - ["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) }], - ["$move_prefix all", sub { $::CONN->send ("move $targ $self->{tag} 0") }], - ["$move_prefix <n>", - sub { - do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") }) - } - ] - ) - ), - ); - - CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev); - } - - 1 - }; +$DC::OpenGL::INIT_HOOK{"DC::Layout"} = sub { + glyph_cache_restore; +}; - my $tooltip_std = "" - . "Left click - examine item\n" - . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n" - . "Middle click - apply\n" - . "Shift-Middle click - lock/unlock\n" - . "Right click - further options" - . "\n"; - - my $bg = $self->{flags} & F_CURSED ? [1 , 0 , 0, 0.5] - : $self->{flags} & F_MAGIC ? [0.2, 0.2, 1, 0.5] - : undef; - - $self->{face_widget} ||= new CFPlus::UI::Face - can_events => 1, - can_hover => 1, - anim => $self->{anim}, - animspeed => $self->{animspeed}, # TODO# must be set at creation time - on_button_down => $button_cb, - ; - $self->{face_widget}{bg} = $bg; - $self->{face_widget}{face} = $self->{face}; - $self->{face_widget}{anim} = $self->{anim}; - $self->{face_widget}{animspeed} = $self->{animspeed}; - $self->{face_widget}->set_tooltip ( - "Face/Animation.\n" - . "Item uses face #$self->{face}. " - . ($self->{animspeed} ? "Item uses animation #$self->{anim} at " . (1 / $self->{animspeed}) . "fps. " : "Item is not animated. ") - . "\n\n$tooltip_std" - ); - - $self->{desc_widget} ||= new CFPlus::UI::Label - can_events => 1, - can_hover => 1, - ellipsise => 2, - align => -1, - on_button_down => $button_cb, - ; - my $desc = CFPlus::Item::desc_string $self; - $self->{desc_widget}{bg} = $bg; - $self->{desc_widget}->set_text ($desc); - $self->{desc_widget}->set_tooltip ("$desc.\n$tooltip_std"); - - $self->{weight_widget} ||= new CFPlus::UI::Label - can_events => 1, - can_hover => 1, - ellipsise => 0, - align => 0, - on_button_down => $button_cb, - ; - $self->{weight_widget}{bg} = $bg; - $self->{weight_widget}->set_text (CFPlus::Item::weight_string $self); - $self->{weight_widget}->set_tooltip ( - "Weight.\n" - . ($self->{weight} >= 0 ? "One item weighs $self->{weight}g. " : "You have no idea how much this weighs. ") - . ($self->{nrof} ? "You have $self->{nrof} of it. " : "Item cannot stack with others of it's kind. ") - . "\n\n$tooltip_std" - ); -} +$DC::OpenGL::SHUTDOWN_HOOK{"DC::Layout"} = sub { + glyph_cache_backup; +}; 1;