Deliantra/Deliantra/Protocol.pm

=head1 NAME

Crossfire::Protocol - client protocol module

=head1 SYNOPSIS

   use base Crossfire::Protocol; # you have to subclass

=head1 DESCRIPTION

Base class to implement a corssfire client.

=over 4

=cut

package Crossfire::Protocol;

our $VERSION = '0.1';

use strict;

use AnyEvent;
use IO::Socket::INET;

=item new Crossfire::Protocol host => ..., port => ...

=cut

sub new {
   my $class = shift;
   my $self = bless {
      mapw => 13,
      maph => 13,
      @_
   }, $class;

   $self->{fh} = new IO::Socket::INET PeerHost => $self->{host}, PeerPort => $self->{port}
      or die "$self->{host}:$self->{port}: $!";
   $self->{fh}->blocking (0); # stupid nonblock default

   my $buf;

   $self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub {
      if (sysread $self->{fh}, $buf, 16384, length $buf) {
         for (;;) {
            last unless 2 <= length $buf;
            my $len = unpack "n", $buf;
            last unless $len + 2 <= length $buf;

            substr $buf, 0, 2, "";
            $self->feed (substr $buf, 0, $len, "");
         }
      } else {
         delete $self->{w};
         close $self->{fh};
      }
   });

   $self->{setup_req} = {
      sound             => 1,
      exp64             => 1,
      map1acmd          => 1,
      itemcmd           => 2,
      darkness          => 1,
      facecache         => 1,
      newmapcmd         => 1,
      extendedTextInfos => 1,
   };

   $self->send ("version 1023 1027 perlclient");
   $self->send_setup;

   $self
}

sub feed {
   my ($self, $data) = @_;

   $data =~ s/^(\S+)(?:\s|$)//
      or return;

   my $command = "feed_$1";

   $self->$command ($data);
}

sub feed_version {
   my ($self, $version) = @_;
}

sub feed_setup {
   my ($self, $data) = @_;

   $data =~ s/^ +//;

   $self->{setup} = { split / +/, $data };

   my ($mapw, $maph) = split /x/, $self->{setup}{mapsize};

   if ($mapw != $self->{mapw} || $maph != $self->{maph}) {
      ($self->{mapw}, $self->{maph}) = ($mapw, $maph);
      $self->send_setup;
   } else {
      $self->send ("addme");
   }

   $self->feed_newmap;
}

sub feed_addme_success {
   my ($self, $data) = @_;
}

sub feed_addme_failure {
   my ($self, $data) = @_;
   # maybe should notify user
}

=item $conn->play_sound ($x, $y, $soundnum, $type) [OVERWRITE]

=cut

sub sound_play { }

sub feed_sound {
   my ($self, $data) = @_;

   $self->sound_play (unpack "CCnC", $data);
}

=item $conn->query ($flags, $prompt) [OVERWRITE]

=cut

sub query { die "query is abstract" }

sub feed_query {
   my ($self, $data) = @_;

   my ($flags, $prompt) = split /\s+/, $data, 2;

   if ($flags == 0 && $prompt =~ /^What is your name\?\s+:$/ && length $self->{user}) {
      $self->send ("reply $self->{user}");
   } elsif ($flags == 4 && $prompt =~ /^What is your password\?\s+:$/ && length $self->{pass}) {
      $self->send ("reply $self->{pass}");
   } elsif ($flags == 4 && $prompt =~ /^Please type your password again\.\s+:$/ && length $self->{pass}) {
      $self->send ("reply $self->{pass}");
   } else {
      $self->query ($flags, $prompt);
   }
}

=item $conn->player_update ($player) [OVERWRITE]

tag, weight, face, name

=cut

sub player_update { }

sub feed_player {
   my ($self, $data) = @_;

   my ($tag, $weight, $face, $name) = unpack "NNN C/a", $data;

   $self->player_update ($self->{player} = {
      tag    => $tag,
      weight => $weight,
      face   => $face,
      name   => $name,
   });
}

=item $conn->stats_update ($stats) [OVERWRITE]

=cut

sub stats_update { }

sub feed_stats {
   my ($self, $data) = @_;

   while (length $data) {
      my $stat = unpack "C", substr $data, 0, 1, "";
      my $value;

      if ($stat == 26 || $stat == 29 || $stat == 30 || $stat == 31 || $stat == 11) {
         $value = unpack "N", substr $data, 0, 4, "";
      } elsif ($stat == 17 || $stat == 19) {
         $value = (1 / 100000) * unpack "N", substr $data, 0, 4, "";
      } elsif ($stat == 20 || $stat == 21) {
         my $len = unpack "C", substr $data, 0, 1, "";
         $value = substr $data, 0, $len, "";
      } elsif ($stat == 28) {
         my ($lo, $hi) = unpack "NN", substr $data, 0, 8, "";
         $value = $hi * 2**32 + $lo;
      } elsif ($stat >= 118 && $stat <= 129) {
         my ($level, $lo, $hi) = unpack "CNN", substr $data, 0, 9, "";
         $value = [$level, $hi * 2**32 + $lo];
      } else {
         $value = unpack "n", substr $data, 0, 2, "";
      }

      $self->{stat}{$stat} = $value;
   }

   $self->stats_update ($self->{stat});
}

sub feed_face1 {
   my ($self, $data) = @_;

   my ($num, $chksum, $name) = unpack "nNa*", $data;

   my $face = $self->{face}[$num] = { name => $name, chksum => $chksum };

   if (my $data = $self->face_find ($face)) {
      $face->{image} = $data;
      $self->face_update ($face);
   } else {
      $self->send ("askface $num");
   }
}

=item $conn->anim_update ($num) [OVERWRITE]

=cut

sub anim_update { }

sub feed_anim {
   my ($self, $data) = @_;

   my ($num, @faces) = unpack "n*", $data;

   $self->{anim}[$num] = \@faces;

   $self->anim_update ($num);
}

sub feed_drawinfo {
   my ($self, $data) = @_;
#   warn "<$data>\n";
}

sub feed_delinv {
   my ($self, $data) = @_;
}

sub feed_item2 {
   my ($self, $data) = @_;
}

sub feed_map1a {
   my ($self, $data) = @_;

   my $map = $self->{map} ||= [];

   my @dirty;
   my ($coord, $x, $y, $darkness, $fa, $fb, $fc, $cell);

   while (length $data) {
      $coord = unpack "n", substr $data, 0, 2, "";

      $x = (($coord >> 10) & 63) + $self->{mapx};
      $y = (($coord >>  4) & 63) + $self->{mapy};

      $cell = $map->[$x][$y] ||= [];

      if ($coord & 15) {
         $cell->[0] = $coord & 8
                    ? unpack "C", substr $data, 0, 1, ""
                    : 255;

         $cell->[1] = unpack "n", substr $data, 0, 2, ""
            if $coord & 4;
         $cell->[2] = unpack "n", substr $data, 0, 2, ""
            if $coord & 2;
         $cell->[3] = unpack "n", substr $data, 0, 2, ""
            if $coord & 1;
      } else {
         $cell->[0] = -1;
         $cell->[2] = undef;
         $cell->[3] = undef;
      }

      push @dirty, [$x, $y];
   }

   $self->map_update (\@dirty);
}

sub feed_map_scroll {
   my ($self, $data) = @_;

   my ($dx, $dy) = split / /, $data;

   my $map = $self->{map} ||= [];
   
   my ($mx, $my, $mw, $mh) = @$self{qw(mapx mapy mapw maph)};

   # TODO: optimise this a lot, or maybe just do it on c-level
   # set flag to -1 for spaces we scroll out
   {
      my @darkness;

      if ($dx > 0) {
         push @darkness, [$mx, $my, $dx - 1, $mh];
      } elsif ($dx < 0) {
         push @darkness, [$mx + $mw + $dx + 1, $my, 1 - $dx, $mh];
      }

      if ($dy > 0) {
         push @darkness, [$mx, $my, $mw, $dy - 1];
      } elsif ($dy < 0) {
         push @darkness, [$mx, $my + $mh + $dy + 1, $mw, 1 - $dy];
      }

      for (@darkness) {
         my ($x0, $y0, $w, $h) = @$_;
         warn "xxx $x0 $y0 $w $h\n";#d#
         for my $x ($x0 .. $x0 + $w) {
            for my $y ($y0 .. $y0 + $h) {

               my $cell = $map->[$x][$y]
                  or next;

               $cell->[0] = -1; $cell->[2] = 0; $cell->[3] = 0;
            }
         }
      }
   }

   # now scroll

   $self->{mapx} += $dx;
   $self->{mapy} += $dy;

   # shift in new space if moving to "negative indices"
   if ($self->{mapy} < 0) {
      unshift @$_, ([]) x -$self->{mapy} for @$map;
      $self->{mapy} = 0;
   }

   if ($self->{mapx} < 0) {
      unshift @$map, ([]) x -$self->{mapx};
      $self->{mapx} = 0;
   }

   $self->map_scroll ($dx, $dy);
}

sub feed_newmap {
   my ($self) = @_;

   $self->{map}  = [];
   $self->{mapx} = 0;
   $self->{mapy} = 0;

   $self->map_clear;
}

sub feed_image {
   my ($self, $data) = @_;

   my ($num, $len, $data) = unpack "NNa*", $data;

   $self->{face}[$num]{image} = $data;
   $self->face_update ($self->{face}[$num]);

   my @dirty;

   for my $x (0..$self->{mapw} - 1) {
      for my $y (0..$self->{maph} - 1) {
         push @dirty, [$x, $y]
            if grep $_ == $num, @{$self->{map}[$x][$y] || []};
      }
   }

   $self->map_update (\@dirty);
}

=item $conn->map_clear [OVERWRITE]

Called whenever the map is to be erased completely.

=cut

sub map_clear  { }

=item $conn->map_update ([ [x,y], [x,y], ...]) [OVERWRITE]

Called with a list of x|y coordinate pairs (as arrayrefs) for cells that
have been updated and need refreshing.

=cut

sub map_update { }

=item $conn->map_scroll ($dx, $dy) [OVERWRITE]

Called whenever the map has been scrolled.

=cut

sub map_scroll { }

=item $conn->face_update ($face) [OVERWRITE]

Called with the face number of face structure whenever a face image has
changed.

=cut

sub face_update { }

=item $conn->face_find ($face) [OVERWRITE]

Find and return the png image for the given face, or the empty list if no
face could be found, in which case it will be requested from the server.

=cut

sub face_find { }

=item $conn->send ($data)

Send a single packet/line to the server.

=cut

sub send {
   my ($self, $data) = @_;

   $data = pack "na*", length $data, $data;

   syswrite $self->{fh}, $data;
}

sub send_setup {
   my ($self) = @_;

   my $setup = join " ", setup => %{$self->{setup_req}},
                  mapsize => "$self->{mapw}x$self->{maph}";
   warn "SET<$setup>\n";#d#
   $self->send ($setup);
}

=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

 Robin Redeker <elmex@ta-sa.org>
 http://www.ta-sa.org/

=cut

1
Revision:	1.12
Committed:	Sat Apr 8 20:32:56 2006 UTC (18 years, 2 months ago) by root
Branch:	MAIN
Changes since 1.11:	+0 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Crossfire::Protocol - client protocol module
4
5			=head1 SYNOPSIS
6
7			use base Crossfire::Protocol; # you have to subclass
8
9			=head1 DESCRIPTION
10
11			Base class to implement a corssfire client.
12
13			=over 4
14
15			=cut
16
17			package Crossfire::Protocol;
18
19			our $VERSION = '0.1';
20
21			use strict;
22
23			use AnyEvent;
24			use IO::Socket::INET;
25
26	root	1.10	=item new Crossfire::Protocol host => ..., port => ...
27	root	1.1
28			=cut
29
30			sub new {
31			my $class = shift;
32	root	1.10	my $self = bless {
33			mapw => 13,
34			maph => 13,
35			@_
36			}, $class;
37	root	1.1
38			$self->{fh} = new IO::Socket::INET PeerHost => $self->{host}, PeerPort => $self->{port}
39			or die "$self->{host}:$self->{port}: $!";
40			$self->{fh}->blocking (0); # stupid nonblock default
41
42			my $buf;
43
44			$self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub {
45			if (sysread $self->{fh}, $buf, 16384, length $buf) {
46	root	1.8	for (;;) {
47			last unless 2 <= length $buf;
48	root	1.1	my $len = unpack "n", $buf;
49	root	1.8	last unless $len + 2 <= length $buf;
50
51			substr $buf, 0, 2, "";
52			$self->feed (substr $buf, 0, $len, "");
53	root	1.1	}
54			} else {
55			delete $self->{w};
56			close $self->{fh};
57			}
58			});
59
60	root	1.11	$self->{setup_req} = {
61			sound => 1,
62			exp64 => 1,
63			map1acmd => 1,
64			itemcmd => 2,
65			darkness => 1,
66			facecache => 1,
67			newmapcmd => 1,
68			extendedTextInfos => 1,
69			};
70
71	root	1.1	$self->send ("version 1023 1027 perlclient");
72	root	1.11	$self->send_setup;
73	root	1.1
74			$self
75			}
76
77			sub feed {
78			my ($self, $data) = @_;
79
80	root	1.11	$data =~ s/^(\S+)(?:\s\|$)//
81	root	1.1	or return;
82
83			my $command = "feed_$1";
84
85			$self->$command ($data);
86			}
87
88			sub feed_version {
89			my ($self, $version) = @_;
90			}
91
92			sub feed_setup {
93			my ($self, $data) = @_;
94
95			$data =~ s/^ +//;
96
97			$self->{setup} = { split / +/, $data };
98
99	root	1.10	my ($mapw, $maph) = split /x/, $self->{setup}{mapsize};
100
101			if ($mapw != $self->{mapw} \|\| $maph != $self->{maph}) {
102			($self->{mapw}, $self->{maph}) = ($mapw, $maph);
103	root	1.11	$self->send_setup;
104			} else {
105			$self->send ("addme");
106	root	1.10	}
107	root	1.1
108			$self->feed_newmap;
109			}
110
111	root	1.11	sub feed_addme_success {
112			my ($self, $data) = @_;
113			}
114
115			sub feed_addme_failure {
116			my ($self, $data) = @_;
117			# maybe should notify user
118			}
119
120			=item $conn->play_sound ($x, $y, $soundnum, $type) [OVERWRITE]
121
122			=cut
123
124			sub sound_play { }
125
126			sub feed_sound {
127			my ($self, $data) = @_;
128
129			$self->sound_play (unpack "CCnC", $data);
130			}
131
132	root	1.6	=item $conn->query ($flags, $prompt) [OVERWRITE]
133
134			=cut
135
136			sub query { die "query is abstract" }
137
138	root	1.1	sub feed_query {
139			my ($self, $data) = @_;
140	root	1.6
141			my ($flags, $prompt) = split /\s+/, $data, 2;
142
143			if ($flags == 0 && $prompt =~ /^What is your name\?\s+:$/ && length $self->{user}) {
144			$self->send ("reply $self->{user}");
145			} elsif ($flags == 4 && $prompt =~ /^What is your password\?\s+:$/ && length $self->{pass}) {
146			$self->send ("reply $self->{pass}");
147			} elsif ($flags == 4 && $prompt =~ /^Please type your password again\.\s+:$/ && length $self->{pass}) {
148			$self->send ("reply $self->{pass}");
149			} else {
150			$self->query ($flags, $prompt);
151			}
152	root	1.1	}
153
154	root	1.6	=item $conn->player_update ($player) [OVERWRITE]
155
156			tag, weight, face, name
157
158			=cut
159
160			sub player_update { }
161
162			sub feed_player {
163			my ($self, $data) = @_;
164
165			my ($tag, $weight, $face, $name) = unpack "NNN C/a", $data;
166
167			$self->player_update ($self->{player} = {
168			tag => $tag,
169			weight => $weight,
170			face => $face,
171			name => $name,
172			});
173			}
174
175			=item $conn->stats_update ($stats) [OVERWRITE]
176
177			=cut
178
179			sub stats_update { }
180
181	root	1.1	sub feed_stats {
182			my ($self, $data) = @_;
183	root	1.6
184			while (length $data) {
185			my $stat = unpack "C", substr $data, 0, 1, "";
186			my $value;
187
188			if ($stat == 26 \|\| $stat == 29 \|\| $stat == 30 \|\| $stat == 31 \|\| $stat == 11) {
189			$value = unpack "N", substr $data, 0, 4, "";
190			} elsif ($stat == 17 \|\| $stat == 19) {
191			$value = (1 / 100000) * unpack "N", substr $data, 0, 4, "";
192			} elsif ($stat == 20 \|\| $stat == 21) {
193			my $len = unpack "C", substr $data, 0, 1, "";
194			$value = substr $data, 0, $len, "";
195			} elsif ($stat == 28) {
196			my ($lo, $hi) = unpack "NN", substr $data, 0, 8, "";
197			$value = $hi * 2**32 + $lo;
198			} elsif ($stat >= 118 && $stat <= 129) {
199			my ($level, $lo, $hi) = unpack "CNN", substr $data, 0, 9, "";
200			$value = [$level, $hi * 2**32 + $lo];
201			} else {
202			$value = unpack "n", substr $data, 0, 2, "";
203			}
204
205			$self->{stat}{$stat} = $value;
206			}
207
208			$self->stats_update ($self->{stat});
209	root	1.1	}
210
211			sub feed_face1 {
212			my ($self, $data) = @_;
213
214			my ($num, $chksum, $name) = unpack "nNa*", $data;
215
216	root	1.5	my $face = $self->{face}[$num] = { name => $name, chksum => $chksum };
217	root	1.3
218	root	1.5	if (my $data = $self->face_find ($face)) {
219			$face->{image} = $data;
220			$self->face_update ($face);
221	root	1.3	} else {
222			$self->send ("askface $num");
223			}
224	root	1.1	}
225
226	root	1.6	=item $conn->anim_update ($num) [OVERWRITE]
227
228			=cut
229
230			sub anim_update { }
231
232			sub feed_anim {
233			my ($self, $data) = @_;
234
235			my ($num, @faces) = unpack "n*", $data;
236
237			$self->{anim}[$num] = \@faces;
238
239			$self->anim_update ($num);
240			}
241
242	root	1.1	sub feed_drawinfo {
243			my ($self, $data) = @_;
244			# warn "<$data>\n";
245			}
246
247			sub feed_delinv {
248			my ($self, $data) = @_;
249			}
250
251			sub feed_item2 {
252			my ($self, $data) = @_;
253			}
254
255			sub feed_map1a {
256			my ($self, $data) = @_;
257
258			my $map = $self->{map} \|\|= [];
259
260			my @dirty;
261			my ($coord, $x, $y, $darkness, $fa, $fb, $fc, $cell);
262
263			while (length $data) {
264			$coord = unpack "n", substr $data, 0, 2, "";
265
266	root	1.10	$x = (($coord >> 10) & 63) + $self->{mapx};
267			$y = (($coord >> 4) & 63) + $self->{mapy};
268	root	1.1
269			$cell = $map->[$x][$y] \|\|= [];
270
271	root	1.10	if ($coord & 15) {
272			$cell->[0] = $coord & 8
273			? unpack "C", substr $data, 0, 1, ""
274			: 255;
275
276			$cell->[1] = unpack "n", substr $data, 0, 2, ""
277			if $coord & 4;
278			$cell->[2] = unpack "n", substr $data, 0, 2, ""
279			if $coord & 2;
280			$cell->[3] = unpack "n", substr $data, 0, 2, ""
281			if $coord & 1;
282			} else {
283			$cell->[0] = -1;
284			$cell->[2] = undef;
285			$cell->[3] = undef;
286			}
287	root	1.1
288			push @dirty, [$x, $y];
289			}
290
291			$self->map_update (\@dirty);
292			}
293
294			sub feed_map_scroll {
295			my ($self, $data) = @_;
296
297			my ($dx, $dy) = split / /, $data;
298
299			my $map = $self->{map} \|\|= [];
300	root	1.11
301			my ($mx, $my, $mw, $mh) = @$self{qw(mapx mapy mapw maph)};
302
303			# TODO: optimise this a lot, or maybe just do it on c-level
304			# set flag to -1 for spaces we scroll out
305			{
306			my @darkness;
307
308			if ($dx > 0) {
309			push @darkness, [$mx, $my, $dx - 1, $mh];
310			} elsif ($dx < 0) {
311			push @darkness, [$mx + $mw + $dx + 1, $my, 1 - $dx, $mh];
312			}
313
314			if ($dy > 0) {
315			push @darkness, [$mx, $my, $mw, $dy - 1];
316			} elsif ($dy < 0) {
317			push @darkness, [$mx, $my + $mh + $dy + 1, $mw, 1 - $dy];
318			}
319
320			for (@darkness) {
321			my ($x0, $y0, $w, $h) = @$_;
322			warn "xxx $x0 $y0 $w $h\n";#d#
323			for my $x ($x0 .. $x0 + $w) {
324			for my $y ($y0 .. $y0 + $h) {
325
326			my $cell = $map->[$x][$y]
327			or next;
328
329			$cell->[0] = -1; $cell->[2] = 0; $cell->[3] = 0;
330			}
331			}
332			}
333			}
334
335			# now scroll
336	root	1.1
337			$self->{mapx} += $dx;
338			$self->{mapy} += $dy;
339
340	root	1.11	# shift in new space if moving to "negative indices"
341	root	1.10	if ($self->{mapy} < 0) {
342			unshift @$_, ([]) x -$self->{mapy} for @$map;
343			$self->{mapy} = 0;
344	root	1.1	}
345
346	root	1.10	if ($self->{mapx} < 0) {
347			unshift @$map, ([]) x -$self->{mapx};
348			$self->{mapx} = 0;
349	root	1.1	}
350
351			$self->map_scroll ($dx, $dy);
352			}
353
354			sub feed_newmap {
355			my ($self) = @_;
356
357			$self->{map} = [];
358			$self->{mapx} = 0;
359			$self->{mapy} = 0;
360
361			$self->map_clear;
362			}
363
364			sub feed_image {
365			my ($self, $data) = @_;
366
367	root	1.3	my ($num, $len, $data) = unpack "NNa*", $data;
368	root	1.1
369	root	1.3	$self->{face}[$num]{image} = $data;
370	root	1.5	$self->face_update ($self->{face}[$num]);
371	root	1.1
372	root	1.3	my @dirty;
373	root	1.2
374			for my $x (0..$self->{mapw} - 1) {
375			for my $y (0..$self->{maph} - 1) {
376			push @dirty, [$x, $y]
377			if grep $_ == $num, @{$self->{map}[$x][$y] \|\| []};
378			}
379			}
380	root	1.6
381	root	1.2	$self->map_update (\@dirty);
382	root	1.1	}
383
384			=item $conn->map_clear [OVERWRITE]
385
386			Called whenever the map is to be erased completely.
387
388			=cut
389
390			sub map_clear { }
391
392			=item $conn->map_update ([ [x,y], [x,y], ...]) [OVERWRITE]
393
394			Called with a list of x\|y coordinate pairs (as arrayrefs) for cells that
395			have been updated and need refreshing.
396
397			=cut
398
399			sub map_update { }
400
401			=item $conn->map_scroll ($dx, $dy) [OVERWRITE]
402
403			Called whenever the map has been scrolled.
404
405			=cut
406
407			sub map_scroll { }
408
409	root	1.5	=item $conn->face_update ($face) [OVERWRITE]
410	root	1.1
411			Called with the face number of face structure whenever a face image has
412			changed.
413
414			=cut
415
416			sub face_update { }
417
418	root	1.5	=item $conn->face_find ($face) [OVERWRITE]
419	root	1.3
420			Find and return the png image for the given face, or the empty list if no
421			face could be found, in which case it will be requested from the server.
422
423			=cut
424
425			sub face_find { }
426
427	root	1.1	=item $conn->send ($data)
428
429			Send a single packet/line to the server.
430
431			=cut
432
433			sub send {
434			my ($self, $data) = @_;
435
436			$data = pack "na*", length $data, $data;
437
438			syswrite $self->{fh}, $data;
439			}
440
441	root	1.11	sub send_setup {
442			my ($self) = @_;
443
444			my $setup = join " ", setup => %{$self->{setup_req}},
445			mapsize => "$self->{mapw}x$self->{maph}";
446			warn "SET<$setup>\n";#d#
447			$self->send ($setup);
448			}
449
450	root	1.1	=back
451
452			=head1 AUTHOR
453
454			Marc Lehmann <schmorp@schmorp.de>
455			http://home.schmorp.de/
456
457			Robin Redeker <elmex@ta-sa.org>
458			http://www.ta-sa.org/
459
460			=cut
461
462			1