ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC.pm
(Generate patch)

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.168 by root, Wed Dec 26 20:46:39 2007 UTC vs.
Revision 1.193 by root, Fri Sep 5 15:24:10 2008 UTC

1=head1 NAME 1=head1 NAME
2 2
3dc - undocumented utility garbage for our deliantra client 3DC - undocumented utility garbage for our deliantra client
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use dc; 7 use DC;
8 8
9=head1 DESCRIPTION 9=head1 DESCRIPTION
10 10
11=over 4 11=over 4
12 12
13=cut 13=cut
14 14
15package Deliantra::Client; # work around CPAN breakage
16package App::Deliantra; # try to reserve namespace
15package dc; 17package DC;
16 18
17use Carp (); 19use Carp ();
18 20
21our $VERSION;
22
19BEGIN { 23BEGIN {
20 $VERSION = '0.9962'; 24 $VERSION = '0.9976';
21 25
22 use XSLoader; 26 use XSLoader;
23 XSLoader::load "Deliantra::Client", $VERSION; 27 XSLoader::load "Deliantra::Client", $VERSION;
24} 28}
25 29
26use utf8; 30use utf8;
31use strict qw(vars subs);
27 32
28use AnyEvent (); 33use AnyEvent ();
29use Pod::POM (); 34use Pod::POM ();
30use File::Path (); 35use File::Path ();
31use Storable (); # finally 36use Storable (); # finally
… …
37Returns an object that executes the given block as soon as it is destroyed. 42Returns an object that executes the given block as soon as it is destroyed.
38 43
39=cut 44=cut
40 45
41sub guard(&) { 46sub guard(&) {
42 bless \(my $cb = $_[0]), "dc::Guard" 47 bless \(my $cb = $_[0]), "DC::Guard"
43} 48}
44 49
45sub dc::Guard::DESTROY { 50sub DC::Guard::DESTROY {
46 ${$_[0]}->() 51 ${$_[0]}->()
47} 52}
48 53
49=item shorten $string[, $maxlength] 54=item shorten $string[, $maxlength]
50 55
… …
65 70
66 $_ 71 $_
67} 72}
68 73
69sub socketpipe() { 74sub socketpipe() {
70 socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC 75 socketpair my $fh1, my $fh2, &Socket::AF_UNIX, &Socket::SOCK_STREAM, &Socket::PF_UNSPEC
71 or die "cannot establish bidirectional pipe: $!\n"; 76 or die "cannot establish bidirectional pipe: $!\n";
72 77
73 ($fh1, $fh2) 78 ($fh1, $fh2)
74} 79}
75 80
76sub background(&;&) { 81sub background(&;&) {
77 my ($bg, $cb) = @_; 82 my ($bg, $cb) = @_;
78 83
79 my ($fh_r, $fh_w) = dc::socketpipe; 84 my ($fh_r, $fh_w) = DC::socketpipe;
80 85
81 my $pid = fork; 86 my $pid = fork;
82 87
83 if (defined $pid && !$pid) { 88 if (defined $pid && !$pid) {
84 local $SIG{__DIE__}; 89 local $SIG{__DIE__};
… …
94 99
95 if ($@) { 100 if ($@) {
96 my $msg = $@; 101 my $msg = $@;
97 $msg =~ s/\n+/\n/; 102 $msg =~ s/\n+/\n/;
98 warn "FATAL: $msg"; 103 warn "FATAL: $msg";
99 dc::_exit 1; 104 DC::_exit 1;
100 } 105 }
101 106
102 # win32 is fucked up, of course. exit will clean stuff up, 107 # win32 is fucked up, of course. exit will clean stuff up,
103 # which destroys our database etc. _exit will exit ALL 108 # which destroys our database etc. _exit will exit ALL
104 # forked processes, because of the dreaded fork emulation. 109 # forked processes, because of the dreaded fork emulation.
105 dc::_exit 0; 110 DC::_exit 0;
106 } 111 }
107 112
108 close $fh_w; 113 close $fh_w;
109 114
110 my $buffer; 115 my $buffer;
… …
122 utf8::decode $line; 127 utf8::decode $line;
123 if ($line =~ /^\x{e877}json_msg (.*)$/s) { 128 if ($line =~ /^\x{e877}json_msg (.*)$/s) {
124 $cb->(JSON::XS->new->allow_nonref->decode ($1)); 129 $cb->(JSON::XS->new->allow_nonref->decode ($1));
125 } else { 130 } else {
126 ::message ({ 131 ::message ({
127 markup => "background($pid): " . dc::asxml $line, 132 markup => "background($pid): " . DC::asxml $line,
128 }); 133 });
129 } 134 }
130 } 135 }
131 }); 136 });
132} 137}
… …
138 $msg =~ s/\n//g; 143 $msg =~ s/\n//g;
139 utf8::encode $msg; 144 utf8::encode $msg;
140 print $msg, "\n"; 145 print $msg, "\n";
141} 146}
142 147
143package dc; 148package DC;
149
150our $RC_THEME;
151our %THEME;
152our @RC_PATH;
153our $RC_BASE;
154
155for (grep !ref, @INC) {
156 $RC_BASE = "$_/Deliantra/Client/private/resources";
157 last if -d $RC_BASE;
158}
144 159
145sub find_rcfile($) { 160sub find_rcfile($) {
146 my $path; 161 my $path;
147 162
148 for (grep !ref, @INC) { 163 for (@RC_PATH, "") {
149 $path = "$_/Deliantra/Client/private/resources/$_[0]"; 164 $path = "$RC_BASE/$_/$_[0]";
150 return $path if -r $path; 165 return $path if -r $path;
151 } 166 }
152 167
153 die "FATAL: can't find required file $_[0]\n"; 168 die "FATAL: can't find required file \"$_[0]\" in \"$RC_BASE\"\n";
169}
170
171sub load_json($) {
172 my ($file) = @_;
173
174 open my $fh, $file
175 or return;
176
177 local $/;
178 JSON::XS->new->utf8->relaxed->decode (<$fh>)
179}
180
181sub set_theme($) {
182 return if $RC_THEME eq $_[0];
183 $RC_THEME = $_[0];
184
185 # kind of hacky, find the main theme file, then load all theme files and merge them
186
187 %THEME = ();
188 @RC_PATH = "theme-$RC_THEME";
189
190 my $theme = load_json find_rcfile "theme.json"
191 or die "FATAL: theme resource file not found";
192
193 @RC_PATH = @{ $theme->{path} } if $theme->{path};
194
195 for (@RC_PATH, "") {
196 my $theme = load_json "$RC_BASE/$_/theme.json"
197 or next;
198
199 %THEME = ( %$theme, %THEME );
200 }
154} 201}
155 202
156sub read_cfg { 203sub read_cfg {
157 my ($file) = @_; 204 my ($file) = @_;
158 205
159 open my $fh, $file 206 $::CFG = load_json $file;
160 or return;
161
162 local $/;
163 my $CFG = <$fh>;
164
165 $::CFG = decode_json $CFG;
166} 207}
167 208
168sub write_cfg { 209sub write_cfg {
169 my ($file) = @_; 210 my $file = "$Deliantra::VARDIR/client.cf";
170 211
171 $::CFG->{VERSION} = $::VERSION; 212 $::CFG->{VERSION} = $::VERSION;
172 213
173 open my $fh, ">:utf8", $file 214 open my $fh, ">:utf8", $file
174 or return; 215 or return;
175 print $fh encode_json $::CFG; 216 print $fh JSON::XS->new->utf8->pretty->encode ($::CFG);
176} 217}
177 218
178sub http_proxy { 219sub http_proxy {
179 my @proxy = win32_proxy_info; 220 my @proxy = win32_proxy_info;
180 221
… …
195} 236}
196 237
197sub lwp_useragent { 238sub lwp_useragent {
198 require LWP::UserAgent; 239 require LWP::UserAgent;
199 240
200 dc::set_proxy; 241 DC::set_proxy;
201 242
202 my $ua = LWP::UserAgent->new ( 243 my $ua = LWP::UserAgent->new (
203 agent => "cfplus $VERSION", 244 agent => "deliantra $VERSION",
204 keep_alive => 1, 245 keep_alive => 1,
205 env_proxy => 1, 246 env_proxy => 1,
206 timeout => 30, 247 timeout => 30,
207 ); 248 );
208} 249}
… …
223 $nb = (! ! $nb) + 0; 264 $nb = (! ! $nb) + 0;
224 ioctl $fh, 0x8004667e, \$nb; # FIONBIO 265 ioctl $fh, 0x8004667e, \$nb; # FIONBIO
225 } else { 266 } else {
226 fcntl $fh, &Fcntl::F_SETFL, $nb ? &Fcntl::O_NONBLOCK : 0; 267 fcntl $fh, &Fcntl::F_SETFL, $nb ? &Fcntl::O_NONBLOCK : 0;
227 } 268 }
228
229} 269}
230 270
231package dc::Layout; 271package DC::Layout;
232 272
233$dc::OpenGL::INIT_HOOK{"dc::Layout"} = sub { 273$DC::OpenGL::INIT_HOOK{"DC::Layout"} = sub {
234 glyph_cache_restore; 274 glyph_cache_restore;
235}; 275};
236 276
237$dc::OpenGL::SHUTDOWN_HOOK{"dc::Layout"} = sub { 277$DC::OpenGL::SHUTDOWN_HOOK{"DC::Layout"} = sub {
238 glyph_cache_backup; 278 glyph_cache_backup;
239}; 279};
240 280
2411; 2811;
242 282

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines