ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cf.schmorp.de/Deliantra-Client/DC.pm
Revision: 1.217
Committed: Wed Nov 21 13:23:10 2012 UTC (11 years, 7 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.216: +21 -0 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 =head1 NAME
2
3 DC - undocumented utility garbage for our deliantra client
4
5 =head1 SYNOPSIS
6
7 use DC;
8
9 =head1 DESCRIPTION
10
11 =over 4
12
13 =cut
14
15 package DC;
16
17 use Carp ();
18
19 our $VERSION;
20
21 BEGIN {
22 $VERSION = '3.0';
23
24 use XSLoader;
25 XSLoader::load "Deliantra::Client", $VERSION;
26 }
27
28 use utf8;
29 use strict qw(vars subs);
30
31 use Socket ();
32 use AnyEvent ();
33 use AnyEvent::Util ();
34 use Pod::POM ();
35 use File::Path ();
36 use Storable (); # finally
37 use Fcntl ();
38 use JSON::XS qw(encode_json decode_json);
39 use Guard qw(guard);
40
41 # modules to support other DC::* packages
42 use List::Util ();
43 use IO::AIO ();
44 use Coro::AIO ();
45 use AnyEvent::AIO ();
46
47 use Deliantra::Util ();
48 use Deliantra::Protocol::Constants ();
49
50 =item shorten $string[, $maxlength]
51
52 =cut
53
54 sub shorten($;$) {
55 my ($str, $len) = @_;
56 substr $str, $len, (length $str), "..." if $len + 3 <= length $str;
57 $str
58 }
59
60 sub asxml($) {
61 local $_ = $_[0];
62
63 s/&/&amp;/g;
64 s/>/&gt;/g;
65 s/</&lt;/g;
66
67 $_
68 }
69
70 sub sanitise_cfxml($) {
71 local $_ = shift;
72
73 # we now weed out all tags we do not support
74 s{ <(?! /?i> | /?u> | /?b> | /?big | /?small | /?s | /?tt | fg\ | /fg>)
75 }{
76 "&lt;"
77 }gex;
78
79 # now all entities
80 s/&(?!amp;|lt;|gt;|apos;|quot;|#[0-9]+;|#x[0-9a-fA-F]+;)/&amp;/g;
81
82 # handle some elements
83 s/<fg name='([^']*)'>(.*?)<\/fg>/<span foreground='$1'>$2<\/span>/gs;
84 s/<fg name="([^"]*)">(.*?)<\/fg>/<span foreground="$1">$2<\/span>/gs;
85
86 s/\s+$//;
87
88 $_
89 }
90
91 sub background(&;&) {
92 my ($bg, $cb) = @_;
93
94 my ($fh_r, $fh_w) = AnyEvent::Util::portable_socketpair
95 or die "unable to create background socketpair: $!";
96
97 my $pid = fork;
98
99 if (defined $pid && !$pid) {
100 local $SIG{__DIE__};
101
102 open STDOUT, ">&", $fh_w;
103 open STDERR, ">&", $fh_w;
104 close $fh_r;
105 close $fh_w;
106
107 $| = 1;
108
109 eval { $bg->() };
110
111 if ($@) {
112 my $msg = $@;
113 $msg =~ s/\n+/\n/;
114 warn "FATAL: $msg";
115 DC::_exit 1;
116 }
117
118 # win32 is fucked up, of course. exit will clean stuff up,
119 # which destroys our database etc. _exit will exit ALL
120 # forked processes, because of the dreaded fork emulation.
121 DC::_exit 0;
122 }
123
124 close $fh_w;
125
126 my $buffer;
127
128 my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub {
129 unless (sysread $fh_r, $buffer, 4096, length $buffer) {
130 undef $w;
131 $cb->();
132 return;
133 }
134
135 while ($buffer =~ s/^(.*)\n//) {
136 my $line = $1;
137 $line =~ s/\s+$//;
138 utf8::decode $line;
139 if ($line =~ /^\x{e877}json_msg (.*)$/s) {
140 $cb->(JSON::XS->new->allow_nonref->decode ($1));
141 } else {
142 ::message ({
143 markup => "background($pid): " . DC::asxml $line,
144 });
145 }
146 }
147 });
148 }
149
150 sub background_msg {
151 my ($msg) = @_;
152
153 $msg = "\x{e877}json_msg " . JSON::XS->new->allow_nonref->encode ($msg);
154 $msg =~ s/\n//g;
155 utf8::encode $msg;
156 print $msg, "\n";
157 }
158
159 package DC;
160
161 our $RC_THEME;
162 our %THEME;
163 our @RC_PATH;
164 our $RC_BASE;
165
166 for (grep !ref, @INC) {
167 $RC_BASE = "$_/Deliantra/Client/private/resources";
168 last if -d $RC_BASE;
169 }
170
171 sub find_rcfile($) {
172 my $path;
173
174 for (@RC_PATH, "") {
175 $path = "$RC_BASE/$_/$_[0]";
176 return $path if -e $path;
177 }
178
179 die "FATAL: can't find required file \"$_[0]\" in \"$RC_BASE\"\n";
180 }
181
182 sub load_json($) {
183 my ($file) = @_;
184
185 open my $fh, $file
186 or return;
187
188 local $/;
189 eval { JSON::XS->new->utf8->relaxed->decode (<$fh>) }
190 }
191
192 sub set_theme($) {
193 return if $RC_THEME eq $_[0];
194 $RC_THEME = $_[0];
195
196 # kind of hacky, find the main theme file, then load all theme files and merge them
197
198 %THEME = ();
199 @RC_PATH = "theme-$RC_THEME";
200
201 my $theme = load_json find_rcfile "theme.json"
202 or die "FATAL: theme resource file not found";
203
204 @RC_PATH = @{ $theme->{path} } if $theme->{path};
205
206 for (@RC_PATH, "") {
207 my $theme = load_json "$RC_BASE/$_/theme.json"
208 or next;
209
210 %THEME = ( %$theme, %THEME );
211 }
212 }
213
214 sub read_cfg($) {
215 my ($file) = @_;
216
217 $::CFG = (load_json $file) || (load_json "$file.bak");
218 }
219
220 sub write_cfg($) {
221 my $file = "$Deliantra::VARDIR/client.cf";
222
223 $::CFG->{VERSION} = $::VERSION;
224 $::CFG->{layout} = DC::UI::get_layout ();
225
226 open my $fh, ">:utf8", "$file~"
227 or return;
228 print $fh JSON::XS->new->utf8->pretty->encode ($::CFG);
229 close $fh;
230
231 rename $file, "$file.bak";
232 rename "$file~", $file;
233 }
234
235 sub load_cfg() {
236 if (-e "$Deliantra::VARDIR/client.cf") {
237 DC::read_cfg "$Deliantra::VARDIR/client.cf";
238 } else {
239 $::CFG = { cfg_schema => 1, db_schema => 1 };
240 }
241 }
242
243 sub save_cfg() {
244 write_cfg "$Deliantra::VARDIR/client.cf";
245 }
246
247 sub upgrade_cfg() {
248 my %DEF_CFG = (
249 config_autosave => 1,
250 sdl_mode => undef,
251 fullscreen => 1,
252 fast => 0,
253 force_opengl11 => undef,
254 disable_alpha => 0,
255 smooth_movement => 1,
256 smooth_transitions => 1,
257 texture_compression => 1,
258 map_scale => 1,
259 fow_enable => 1,
260 fow_intensity => 0,
261 fow_texture => 0,
262 map_smoothing => 1,
263 gui_fontsize => 1,
264 log_fontsize => 0.7,
265 gauge_fontsize => 1,
266 gauge_size => 0.35,
267 stat_fontsize => 0.7,
268 mapsize => 100,
269 audio_enable => 1,
270 audio_hw_channels => 0,
271 audio_hw_frequency => 0,
272 audio_hw_chunksize => 0,
273 audio_mix_channels => 8,
274 effects_enable => 1,
275 effects_volume => 1,
276 bgm_enable => 1,
277 bgm_volume => 0.5,
278 output_rate => "",
279 pickup => Deliantra::Protocol::Constants::PICKUP_SPELLBOOK
280 | Deliantra::Protocol::Constants::PICKUP_SKILLSCROLL
281 | Deliantra::Protocol::Constants::PICKUP_VALUABLES,
282 inv_sort => "mtime",
283 default => "profile", # default profile
284 show_tips => 1,
285 logview_max_par => 1000,
286 shift_fire_stop => 0,
287 uitheme => "wood",
288 map_shift_x => -24, # arbitrary
289 map_shift_y => +24, # arbitrary
290 );
291
292 while (my ($k, $v) = each %DEF_CFG) {
293 $::CFG->{$k} = $v unless exists $::CFG->{$k};
294 }
295
296 if ($::CFG->{cfg_schema} < 1) {
297 for my $profile (values %{ $::CFG->{profile} }) {
298 $profile->{password} = unpack "H*", Deliantra::Util::hash_pw $profile->{password};
299 }
300 $::CFG->{cfg_schema} = 1;
301 }
302 }
303
304 sub http_proxy {
305 my @proxy = win32_proxy_info;
306
307 if (@proxy) {
308 "http://" . (@proxy < 2 ? "" : @proxy < 3 ? "$proxy[1]\@" : "$proxy[1]:$proxy[2]\@") . $proxy[0]
309 } elsif (exists $ENV{http_proxy}) {
310 $ENV{http_proxy}
311 } else {
312 ()
313 }
314 }
315
316 sub set_proxy {
317 my $proxy = http_proxy
318 or return;
319
320 $ENV{http_proxy} = $proxy;
321 }
322
323 sub lwp_useragent {
324 require LWP::UserAgent;
325
326 DC::set_proxy;
327
328 my $ua = LWP::UserAgent->new (
329 agent => "deliantra $VERSION",
330 keep_alive => 1,
331 env_proxy => 1,
332 timeout => 30,
333 );
334 }
335
336 sub lwp_check($) {
337 my ($res) = @_;
338
339 $res->is_error
340 and die $res->status_line;
341
342 $res
343 }
344
345 sub fh_nonblocking($$) {
346 my ($fh, $nb) = @_;
347
348 if ($^O eq "MSWin32") {
349 $nb = (! ! $nb) + 0;
350 ioctl $fh, 0x8004667e, \$nb; # FIONBIO
351 } else {
352 fcntl $fh, &Fcntl::F_SETFL, $nb ? &Fcntl::O_NONBLOCK : 0;
353 }
354 }
355
356 package DC::Layout;
357
358 $DC::OpenGL::INIT_HOOK{"DC::Layout"} = sub {
359 glyph_cache_restore;
360 };
361
362 $DC::OpenGL::SHUTDOWN_HOOK{"DC::Layout"} = sub {
363 glyph_cache_backup;
364 };
365
366 1;
367
368 =back
369
370 =head1 AUTHOR
371
372 Marc Lehmann <schmorp@schmorp.de>
373 http://home.schmorp.de/
374
375 =cut
376