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.192 by root, Wed Sep 3 10:36:25 2008 UTC vs.
Revision 1.217 by root, Wed Nov 21 13:23:10 2012 UTC

… …
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
17package DC; 15package DC;
18 16
19use Carp (); 17use Carp ();
20 18
21our $VERSION; 19our $VERSION;
22 20
23BEGIN { 21BEGIN {
24 $VERSION = '0.9975'; 22 $VERSION = '3.0';
25 23
26 use XSLoader; 24 use XSLoader;
27 XSLoader::load "Deliantra::Client", $VERSION; 25 XSLoader::load "Deliantra::Client", $VERSION;
28} 26}
29 27
30use utf8; 28use utf8;
31use strict qw(vars subs); 29use strict qw(vars subs);
32 30
31use Socket ();
33use AnyEvent (); 32use AnyEvent ();
33use AnyEvent::Util ();
34use Pod::POM (); 34use Pod::POM ();
35use File::Path (); 35use File::Path ();
36use Storable (); # finally 36use Storable (); # finally
37use Fcntl (); 37use Fcntl ();
38use JSON::XS qw(encode_json decode_json); 38use JSON::XS qw(encode_json decode_json);
39use Guard qw(guard);
39 40
40=item guard { BLOCK } 41# modules to support other DC::* packages
42use List::Util ();
43use IO::AIO ();
44use Coro::AIO ();
45use AnyEvent::AIO ();
41 46
42Returns an object that executes the given block as soon as it is destroyed. 47use Deliantra::Util ();
43 48use Deliantra::Protocol::Constants ();
44=cut
45
46sub guard(&) {
47 bless \(my $cb = $_[0]), "DC::Guard"
48}
49
50sub DC::Guard::DESTROY {
51 ${$_[0]}->()
52}
53 49
54=item shorten $string[, $maxlength] 50=item shorten $string[, $maxlength]
55 51
56=cut 52=cut
57 53
… …
69 s/</&lt;/g; 65 s/</&lt;/g;
70 66
71 $_ 67 $_
72} 68}
73 69
74sub socketpipe() { 70sub sanitise_cfxml($) {
75 socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC 71 local $_ = shift;
76 or die "cannot establish bidirectional pipe: $!\n";
77 72
78 ($fh1, $fh2) 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 $_
79} 89}
80 90
81sub background(&;&) { 91sub background(&;&) {
82 my ($bg, $cb) = @_; 92 my ($bg, $cb) = @_;
83 93
84 my ($fh_r, $fh_w) = DC::socketpipe; 94 my ($fh_r, $fh_w) = AnyEvent::Util::portable_socketpair
95 or die "unable to create background socketpair: $!";
85 96
86 my $pid = fork; 97 my $pid = fork;
87 98
88 if (defined $pid && !$pid) { 99 if (defined $pid && !$pid) {
89 local $SIG{__DIE__}; 100 local $SIG{__DIE__};
… …
160sub find_rcfile($) { 171sub find_rcfile($) {
161 my $path; 172 my $path;
162 173
163 for (@RC_PATH, "") { 174 for (@RC_PATH, "") {
164 $path = "$RC_BASE/$_/$_[0]"; 175 $path = "$RC_BASE/$_/$_[0]";
165 return $path if -r $path; 176 return $path if -e $path;
166 } 177 }
167 178
168 die "FATAL: can't find required file \"$_[0]\" in \"$RC_BASE\"\n"; 179 die "FATAL: can't find required file \"$_[0]\" in \"$RC_BASE\"\n";
169} 180}
170 181
… …
173 184
174 open my $fh, $file 185 open my $fh, $file
175 or return; 186 or return;
176 187
177 local $/; 188 local $/;
178 JSON::XS->new->utf8->relaxed->decode (<$fh>) 189 eval { JSON::XS->new->utf8->relaxed->decode (<$fh>) }
179} 190}
180 191
181sub set_theme($) { 192sub set_theme($) {
182 return if $RC_THEME eq $_[0]; 193 return if $RC_THEME eq $_[0];
183 $RC_THEME = $_[0]; 194 $RC_THEME = $_[0];
… …
198 209
199 %THEME = ( %$theme, %THEME ); 210 %THEME = ( %$theme, %THEME );
200 } 211 }
201} 212}
202 213
203sub read_cfg { 214sub read_cfg($) {
204 my ($file) = @_; 215 my ($file) = @_;
205 216
206 $::CFG = load_json $file; 217 $::CFG = (load_json $file) || (load_json "$file.bak");
207} 218}
208 219
209sub write_cfg { 220sub write_cfg($) {
210 my $file = "$Deliantra::VARDIR/client.cf"; 221 my $file = "$Deliantra::VARDIR/client.cf";
211 222
212 $::CFG->{VERSION} = $::VERSION; 223 $::CFG->{VERSION} = $::VERSION;
224 $::CFG->{layout} = DC::UI::get_layout ();
213 225
214 open my $fh, ">:utf8", $file 226 open my $fh, ">:utf8", "$file~"
215 or return; 227 or return;
216 print $fh JSON::XS->new->utf8->pretty->encode ($::CFG); 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
235sub 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
243sub save_cfg() {
244 write_cfg "$Deliantra::VARDIR/client.cf";
245}
246
247sub 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 }
217} 302}
218 303
219sub http_proxy { 304sub http_proxy {
220 my @proxy = win32_proxy_info; 305 my @proxy = win32_proxy_info;
221 306

Diff Legend

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