ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/gde/GCE/Util.pm
(Generate patch)

Comparing deliantra/gde/GCE/Util.pm (file contents):
Revision 1.7 by elmex, Fri Mar 17 01:18:01 2006 UTC vs.
Revision 1.24 by elmex, Fri Jan 5 17:04:17 2007 UTC

… …
15use Storable; 15use Storable;
16use List::Util qw(min max); 16use List::Util qw(min max);
17 17
18use Crossfire; 18use Crossfire;
19use Crossfire::MapWidget; 19use Crossfire::MapWidget;
20use File::Spec::Functions;
21use File::Basename;
22use File::Path;
23use HTTP::Request::Common;
24use Cwd 'abs_path';
25use strict;
20 26
21our @EXPORT = qw(insert_arch_stack_layer replace_arch_stack_layer new_arch_pb fill_pb_from_arch arch_is_floor stack_find_floor stack_find_wall stack_find arch_is_wall arch_is_monster add_table_widget quick_msg def arch_is_exit); 27our @EXPORT = qw(insert_arch_stack_layer replace_arch_stack_layer new_arch_pb
28 fill_pb_from_arch arch_is_floor stack_find_floor stack_find_wall
29 stack_find arch_is_wall arch_is_monster add_table_widget quick_msg
30 def arch_is_exit map2abs exit_paths pseudohtml2txt arch_is_connector);
31
32sub pseudohtml2txt {
33 my ($html) = @_;
34
35 $html =~ s/<br\s*?\/?>/\n/gsi;
36 $html =~ s/<b>(.*?)<\/b>/_\1_/gsi;
37 $html =~ s/<li>/\n* /gi;
38 $html =~ s/<\/?\s*li>//gi;
39 $html =~ s/<\/?\s*ul>//gi;
40 $html =~ s/&gt;/>/g;
41 $html =~ s/&lt;/</g;
42 $html
43}
44
45sub exit_paths {
46 my ($mappath, $map1path, $map2path) = @_;
47 $mappath = abs_path $mappath;
48 $map1path = abs_path $map1path;
49 $map2path = abs_path $map2path;
50
51 if ( (substr $map1path, 0, length $mappath) eq $mappath
52 and (substr $map2path, 0, length $mappath) eq $mappath) {
53 substr $map1path, 0, length $mappath, '';
54 substr $map2path, 0, length $mappath, '';
55
56 my ($v1, $d1, $f1) = File::Spec->splitpath ($map1path);
57 my ($v2, $d2, $f2) = File::Spec->splitpath ($map2path);
58
59 my @di1 = File::Spec->splitdir ($d1);
60 my @di2 = File::Spec->splitdir ($d2);
61
62 if ((defined $di1[1]) and (defined $di2[1]) and $di1[1] eq $di2[1]) {
63 my $m1 = File::Spec->abs2rel ($map1path, File::Spec->catdir (@di2));
64 my $m2 = File::Spec->abs2rel ($map2path, File::Spec->catdir (@di1));
65 return ($m1, $m2);
66 } else {
67 return ($map1path, $map2path);
68 }
69 } else {
70 return ('', '');
71 }
72}
73
74sub map2abs {
75 my ($dest, $mape) = @_;
76
77 #$dest = abs_path $dest;
78 my $dir;
79 if (File::Spec->file_name_is_absolute($dest)) {
80 $dir = catdir ($::MAPDIR, $dest);
81 } else {
82 my ($v, $p, $f) = File::Spec->splitpath ($mape->{path});
83 $dir = File::Spec->rel2abs ($dest, File::Spec->catpath ($v, $p));
84 }
85 return $dir;
86}
22 87
23sub def($$) { 88sub def($$) {
24 return defined ($_[0]) ? $_[0] : $_[1]; 89 return defined ($_[0]) ? $_[0] : $_[1];
25} 90}
26 91
… …
55 120
56sub fill_pb_from_arch { 121sub fill_pb_from_arch {
57 my ($pb, $a) = @_; 122 my ($pb, $a) = @_;
58 123
59 my $o = $Crossfire::ARCH{$a->{_name}}; 124 my $o = $Crossfire::ARCH{$a->{_name}};
60 my $face = $Crossfire::FACE{$a->{face} || $o->{face} || "blank.111"} 125 my $face = $Crossfire::FACE{$a->{face} || $o->{face} || "blank.111"};
126 unless ($face) {
127 $face = $Crossfire::FACE{"blank.x11"}
61 or warn "no gfx found for arch '$a->{_name}' at ($x|$y)\n"; 128 or warn "no gfx found for arch '$a->{_name}'\n";
129 }
62 130
63 $face or return; 131 $face or return;
64 132
65 $pb->fill (0x00000000); 133 $pb->fill (0x00000000);
66 $TILE->composite ($pb, 134 $TILE->composite ($pb,
… …
94 return $type eq '66' || $type eq '41'; 162 return $type eq '66' || $type eq '41';
95} 163}
96 164
97sub arch_is_floor { 165sub arch_is_floor {
98 my ($a) = @_; 166 my ($a) = @_;
99 return $Crossfire::ARCH{$a->{_name}}->{is_floor}; 167 my $ar = Crossfire::arch_attr $a;
168 return (
169 (substr $ar->{name}, 0, 5) eq 'Floor'
170 or (substr $ar->{name}, 0, 10) eq 'Shop Floor'
171 )
172}
173
174sub arch_is_connector {
175 my ($a) = @_;
176 my $ar = Crossfire::arch_attr $a;
177 my $has_connect_field = 0;
178
179 TOP: for (@{$ar->{section}}) {
180 my $name = shift @$_;
181 my @r = @$_;
182 if ($name eq 'general') {
183 for (@r) {
184 my ($k, $s) = ($_->[0], $_->[1]);
185 if ($k eq 'connected' && $s->{name} eq 'connection') {
186 $has_connect_field = 1;
187 last TOP;
188 }
189 }
190 last TOP;
191 }
192 }
193
194 return $has_connect_field;
100} 195}
101 196
102sub arch_is_wall { 197sub arch_is_wall {
103 my ($a) = @_; 198 my ($a) = @_;
199 my $ar = Crossfire::arch_attr $a;
200 return $ar->{name} eq 'Wall';
104 return $Crossfire::ARCH{$a->{_name}}->{no_pass}; 201#return $Crossfire::ARCH{$a->{_name}}->{no_pass};
105} 202}
106 203
107sub arch_is_monster { 204sub arch_is_monster {
108 my ($a) = @_; 205 my ($a) = @_;
109 my $arch = $Crossfire::ARCH{$a->{_name}}; 206 my $arch = $Crossfire::ARCH{$a->{_name}};
… …
261 } 358 }
262 359
263 return \@outstack; 360 return \@outstack;
264} 361}
265 362
363sub upload {
364 my ($login, $password, $srcrep, $path, $rev, $mapdata) = @_;
365 require LWP::UserAgent;
366 my $ua = LWP::UserAgent->new (
367 agent => "gcrossedit",
368 keep_alive => 1,
369 env_proxy => 1,
370 timeout => 30,
371 );
372 require HTTP::Request::Common;
373
374 my $res = $ua->post (
375 $ENV{CFPLUS_UPLOAD},
376 Content_Type => 'multipart/form-data',
377 Content => [
378 path => $path,
379 mapdir => $srcrep,
380 map => $mapdata,
381 revision => $rev,
382 cf_login => $login, #ENV{CFPLUS_LOGIN},
383 cf_password => $password, #ENV{CFPLUS_PASSWORD},
384 comment => "",
385 ]
386 );
387
388 if ($res->is_error) {
389 # fatal condition
390 warn $res->status_line;
391 } else {
392 # script replies are marked as {{..}}
393 my @msgs = $res->decoded_content =~ m/\{\{(.*?)\}\}/g;
394 warn map "$_\n", @msgs;
395 }
396}
397
266=head1 AUTHOR 398=head1 AUTHOR
267 399
268 Marc Lehmann <schmorp@schmorp.de> 400 Marc Lehmann <schmorp@schmorp.de>
269 http://home.schmorp.de/ 401 http://home.schmorp.de/
270 402

Diff Legend

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