ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf.pm
(Generate patch)

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.390 by root, Thu Oct 25 09:01:24 2007 UTC vs.
Revision 1.395 by root, Sat Nov 10 22:41:59 2007 UTC

162 162
163The raw value load value from the last tick. 163The raw value load value from the last tick.
164 164
165=item %cf::CFG 165=item %cf::CFG
166 166
167Configuration for the server, loaded from C</etc/crossfire/config>, or 167Configuration for the server, loaded from C</etc/deliantra-server/config>, or
168from wherever your confdir points to. 168from wherever your confdir points to.
169 169
170=item cf::wait_for_tick, cf::wait_for_tick_begin 170=item cf::wait_for_tick, cf::wait_for_tick_begin
171 171
172These are functions that inhibit the current coroutine one tick. cf::wait_for_tick_begin only 172These are functions that inhibit the current coroutine one tick. cf::wait_for_tick_begin only
406 406
407BEGIN { *async = \&Coro::async_pool } 407BEGIN { *async = \&Coro::async_pool }
408 408
409=item cf::sync_job { BLOCK } 409=item cf::sync_job { BLOCK }
410 410
411The design of Crossfire TRT requires that the main coroutine ($Coro::main) 411The design of Deliantra requires that the main coroutine ($Coro::main)
412is always able to handle events or runnable, as Crossfire TRT is only 412is always able to handle events or runnable, as Deliantra is only
413partly reentrant. Thus "blocking" it by e.g. waiting for I/O is not 413partly reentrant. Thus "blocking" it by e.g. waiting for I/O is not
414acceptable. 414acceptable.
415 415
416If it must be done, put the blocking parts into C<sync_job>. This will run 416If it must be done, put the blocking parts into C<sync_job>. This will run
417the given BLOCK in another coroutine while waiting for the result. The 417the given BLOCK in another coroutine while waiting for the result. The
662attach callbacks/event handlers (a collection of which is called an "attachment") 662attach callbacks/event handlers (a collection of which is called an "attachment")
663to it. All such attachable objects support the following methods. 663to it. All such attachable objects support the following methods.
664 664
665In the following description, CLASS can be any of C<global>, C<object> 665In the following description, CLASS can be any of C<global>, C<object>
666C<player>, C<client> or C<map> (i.e. the attachable objects in 666C<player>, C<client> or C<map> (i.e. the attachable objects in
667Crossfire TRT). 667Deliantra).
668 668
669=over 4 669=over 4
670 670
671=item $attachable->attach ($attachment, key => $value...) 671=item $attachable->attach ($attachment, key => $value...)
672 672
1548 1548
1549Expand crossfire pod fragments into protocol xml. 1549Expand crossfire pod fragments into protocol xml.
1550 1550
1551=cut 1551=cut
1552 1552
1553use re 'eval';
1554
1555my $group;
1556my $interior; $interior = qr{
1557 # match a pod interior sequence sans C<< >>
1558 (?:
1559 \ (.*?)\ (?{ $group = $^N })
1560 | < (??{$interior}) >
1561 )
1562}x;
1563
1553sub expand_cfpod { 1564sub expand_cfpod {
1554 ((my $self), (local $_)) = @_; 1565 my ($self, $pod) = @_;
1555 1566
1556 # escape & and < 1567 my $xml;
1557 s/&/&amp;/g;
1558 s/(?<![BIUGHT])</&lt;/g;
1559 1568
1560 # this is buggy, it needs to properly take care of nested <'s 1569 while () {
1570 if ($pod =~ /\G( (?: [^BCGHITU]+ | .(?!<) )+ )/xgcs) {
1571 $group = $1;
1561 1572
1562 1 while 1573 $group =~ s/&/&amp;/g;
1563 # replace B<>, I<>, U<> etc. 1574 $group =~ s/</&lt;/g;
1564 s/B<([^\>]*)>/<b>$1<\/b>/ 1575
1565 || s/I<([^\>]*)>/<i>$1<\/i>/ 1576 $xml .= $group;
1566 || s/U<([^\>]*)>/<u>$1<\/u>/ 1577 } elsif ($pod =~ m%\G
1567 || s/T<([^\>]*)>/<big><b>$1<\/b><\/big>/ 1578 ([BCGHITU])
1568 # replace G<male|female> tags 1579 <
1569 || s{G<([^>|]*)\|([^>]*)>}{ 1580 (?:
1570 $self->gender ? $2 : $1 1581 ([^<>]*) (?{ $group = $^N })
1571 }ge 1582 | < $interior >
1572 # replace H<hint text> 1583 )
1573 || s{H<([^\>]*)>} 1584 >
1585 %gcsx
1574 { 1586 ) {
1587 my ($code, $data) = ($1, $group);
1588
1589 if ($code eq "B") {
1590 $xml .= "<b>" . expand_cfpod ($self, $data) . "</b>";
1591 } elsif ($code eq "I") {
1592 $xml .= "<i>" . expand_cfpod ($self, $data) . "</i>";
1593 } elsif ($code eq "U") {
1594 $xml .= "<u>" . expand_cfpod ($self, $data) . "</u>";
1595 } elsif ($code eq "C") {
1596 $xml .= "<tt>" . expand_cfpod ($self, $data) . "</tt>";
1597 } elsif ($code eq "T") {
1598 $xml .= "<big><b>" . expand_cfpod ($self, $data) . "</b></big>";
1599 } elsif ($code eq "G") {
1600 my ($male, $female) = split /\|/, $data;
1601 $data = $self->gender ? $female : $male;
1602 $xml .= expand_cfpod ($self, $data);
1603 } elsif ($code eq "H") {
1575 ("<fg name=\"lightblue\">[$1 (Use hintmode to suppress hints)]</fg>", 1604 $xml .= ("<fg name=\"lightblue\">[" . expand_cfpod ($self, $data) . " (Use hintmode to suppress hints)]</fg>",
1576 "<fg name=\"lightblue\">[Hint suppressed, see hintmode]</fg>", 1605 "<fg name=\"lightblue\">[Hint suppressed, see hintmode]</fg>",
1577 "") 1606 "")
1578 [$self->{hintmode}] 1607 [$self->{hintmode}];
1608 } else {
1609 $xml .= "error processing '$code($data)' directive";
1579 }ge; 1610 }
1611 } else {
1612 if ($pod =~ /\G(.+)/) {
1613 warn "parse error while expanding $pod (at $1)";
1614 }
1615 last;
1616 }
1617 }
1580 1618
1619 for ($xml) {
1581 # create single paragraphs (very hackish) 1620 # create single paragraphs (very hackish)
1582 s/(?<=\S)\n(?=\w)/ /g; 1621 s/(?<=\S)\n(?=\w)/ /g;
1583 1622
1584 # compress some whitespace 1623 # compress some whitespace
1585 s/\s+\n/\n/g; # ws line-ends 1624 s/\s+\n/\n/g; # ws line-ends
1586 s/\n\n+/\n/g; # double lines 1625 s/\n\n+/\n/g; # double lines
1587 s/^\n+//; # beginning lines 1626 s/^\n+//; # beginning lines
1588 s/\n+$//; # ending lines 1627 s/\n+$//; # ending lines
1628 }
1589 1629
1590 $_ 1630 $xml
1591} 1631}
1632
1633no re 'eval';
1592 1634
1593sub hintmode { 1635sub hintmode {
1594 $_[0]{hintmode} = $_[1] if @_ > 1; 1636 $_[0]{hintmode} = $_[1] if @_ > 1;
1595 $_[0]{hintmode} 1637 $_[0]{hintmode}
1596} 1638}
2666the message, with C<log> being the default. If C<$color> is negative, suppress 2708the message, with C<log> being the default. If C<$color> is negative, suppress
2667the message unless the client supports the msg packet. 2709the message unless the client supports the msg packet.
2668 2710
2669=cut 2711=cut
2670 2712
2713# non-persistent channels (usually the info channel)
2671our %CHANNEL = ( 2714our %CHANNEL = (
2672 "c/identify" => { 2715 "c/identify" => {
2673 id => "infobox", 2716 id => "infobox",
2674 title => "Identify", 2717 title => "Identify",
2675 reply => undef, 2718 reply => undef,
2707 }, 2750 },
2708 "c/uptime" => { 2751 "c/uptime" => {
2709 id => "infobox", 2752 id => "infobox",
2710 title => "Uptime", 2753 title => "Uptime",
2711 reply => undef, 2754 reply => undef,
2712 tooltip => "How long the server has been running sicne last restart", 2755 tooltip => "How long the server has been running since last restart",
2713 }, 2756 },
2714 "c/mapinfo" => { 2757 "c/mapinfo" => {
2715 id => "infobox", 2758 id => "infobox",
2716 title => "Map Info", 2759 title => "Map Info",
2717 reply => undef, 2760 reply => undef,

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines