--- deliantra/gde/GCE/Util.pm 2006/03/17 17:59:43 1.8 +++ deliantra/gde/GCE/Util.pm 2006/10/14 15:18:46 1.21 @@ -18,15 +18,65 @@ use Crossfire; use Crossfire::MapWidget; use File::Spec::Functions; - -our @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 map2abs); +use File::Basename; +use File::Path; +use HTTP::Request::Common; +use Cwd 'abs_path'; + +our @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 map2abs exit_paths pseudohtml2txt arch_is_connector); + +sub pseudohtml2txt { + my ($html) = @_; + + $html =~ s//\n/gsi; + $html =~ s/(.*?)<\/b>/_\1_/gsi; + $html =~ s/
  • /\n* /gi; + $html =~ s/<\/?\s*li>//gi; + $html =~ s/<\/?\s*ul>//gi; + $html =~ s/>/>/g; + $html =~ s/</splitpath ($map1path); + my ($v2, $d2, $f2) = File::Spec->splitpath ($map2path); + + my @di1 = File::Spec->splitdir ($d1); + my @di2 = File::Spec->splitdir ($d2); + + if ((defined $di1[1]) and (defined $di2[1]) and $di1[1] eq $di2[1]) { + my $m1 = File::Spec->abs2rel ($map1path, File::Spec->catdir (@di2)); + my $m2 = File::Spec->abs2rel ($map2path, File::Spec->catdir (@di1)); + return ($m1, $m2); + } else { + return ($map1path, $map2path); + } + } else { + return ('', ''); + } +} sub map2abs { my ($dest, $mape) = @_; + $mappath = abs_path $mappath; my $dir; if (File::Spec->file_name_is_absolute($dest)) { - $dir = catdir ($Crossfire::LIB, 'maps', $dest); + $dir = catdir ($::MAPDIR, $dest); } else { my ($v, $p, $f) = File::Spec->splitpath ($mape->{path}); $dir = File::Spec->rel2abs ($dest, File::Spec->catpath ($v, $p)); @@ -110,12 +160,41 @@ sub arch_is_floor { my ($a) = @_; - return $Crossfire::ARCH{$a->{_name}}->{is_floor}; + my $ar = Crossfire::arch_attr $a; + return ( + (substr $ar->{name}, 0, 5) eq 'Floor' + or (substr $ar->{name}, 0, 10) eq 'Shop Floor' + ) +} + +sub arch_is_connector { + my ($a) = @_; + my $ar = Crossfire::arch_attr $a; + my $has_connect_field = 0; + + TOP: for (@{$ar->{section}}) { + my $name = shift @$_; + my @r = @$_; + if ($name eq 'general') { + for (@r) { + my ($k, $s) = ($_->[0], $_->[1]); + if ($k eq 'connected' && $s->{name} eq 'connection') { + $has_connect_field = 1; + last TOP; + } + } + last TOP; + } + } + + return $has_connect_field; } sub arch_is_wall { my ($a) = @_; - return $Crossfire::ARCH{$a->{_name}}->{no_pass}; + my $ar = Crossfire::arch_attr $a; + return $ar->{name} eq 'Wall'; +#return $Crossfire::ARCH{$a->{_name}}->{no_pass}; } sub arch_is_monster { @@ -277,6 +356,34 @@ return \@outstack; } +sub upload { + my ($login, $password, $path, $rev, $mapdata) = @_; + require HTTP::Request::Common; + + my $res = $ua->post ( + $ENV{CFPLUS_UPLOAD}, + Content_Type => 'multipart/form-data', + Content => [ + path => $path, + mapdir => $::MAPDIR, + map => $mapdata, + revision => $rev, + cf_login => $login, #ENV{CFPLUS_LOGIN}, + cf_password => $password, #ENV{CFPLUS_PASSWORD}, + comment => "", + ] + ); + + if ($res->is_error) { + # fatal condition + warn $res->status_line; + } else { + # script replies are marked as {{..}} + my @msgs = $res->decoded_content =~ m/\{\{(.*?)\}\}/g; + warn map "$_\n", @msgs; + } +} + =head1 AUTHOR Marc Lehmann