├── share
    ├── cs
    │   ├── startup.cml
    │   ├── reg_new_room.cml
    │   ├── join_room.cml
    │   ├── ok_enter.cml
    │   ├── alert_dgl.cml
    │   ├── error_enter.cml
    │   ├── confirm_dgl.cml
    │   ├── confirm_password_dgl.cml
    │   ├── gg_cup_thanks_dgl.cml
    │   ├── new_room_dgl.cml
    │   ├── user_details.cml
    │   ├── enter.cml
    │   ├── room_info_dgl.cml
    │   ├── started_room_info.cml
    │   └── started_room_info
    │   │   └── statcols.cml
    └── ac
    │   ├── ok_enter.cml
    │   ├── reg_new_room.cml
    │   ├── join_room.cml
    │   ├── alert_dgl.cml
    │   ├── error_enter.cml
    │   ├── confirm_dgl.cml
    │   ├── confirm_password_dgl.cml
    │   ├── enter.cml
    │   ├── new_room_dgl.cml
    │   └── startup.cml
├── Changes
├── etc
    └── simple-cossacks-server.conf
├── lib
    ├── SimpleCossacksServer
    │   ├── Template
    │   │   └── Plugin
    │   │   │   ├── CMDFilter.pm
    │   │   │   └── CMLStringArgFilter.pm
    │   ├── ConnectionController.pm
    │   ├── Handler.pm
    │   ├── Connection.pm
    │   ├── CommandController.pm
    │   └── CommandController
    │   │   └── Open.pm
    └── SimpleCossacksServer.pm
├── MANIFEST
├── Makefile.PL
├── script
    ├── simple-cossacks-server
    └── cossacks-proxy
├── t
    └── 001_SimpleCossacksServer.t
└── README


/share/cs/startup.cml:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/rloger/SimpleCossacksServer/HEAD/share/cs/startup.cml


--------------------------------------------------------------------------------
/Changes:
--------------------------------------------------------------------------------
1 | Revision history for Perl extension SimpleCossacksServer.
2 | 
3 | 0.01  Sat Jul  6 23:00:21 2013
4 | 	- original version; created by h2xs 1.23 with options
5 | 		-X -n SimpleCossacksServer
6 | 
7 | 


--------------------------------------------------------------------------------
/share/ac/ok_enter.cml:
--------------------------------------------------------------------------------
1 | //#exec(LW_cfile&Cookie\5C%GV_LCN_PROF&123\00)
2 | #exec(LW_key&keykey)
3 | #exec(LW_gvar&%PROF&<? id ?>&%NAME&n/a&%NICK&<? P.NICK ?>&%MAIL&n/a&%PASS&n/a&%GMID&-&%CHAT&<? server.config.chat_server ?>)


--------------------------------------------------------------------------------
/share/ac/reg_new_room.cml:
--------------------------------------------------------------------------------
1 | <?~ USE CMDFilter ~?>
2 | <NGDLG>
3 | #exec(LW_gvar&%CG_GAMEID&<? id | cmd ?>&%CG_MAXPL&<? max_pl | cmd ?>&%CG_GAMENAME&<? name | cmd ?>&%COMMAND&CGAME\00)
4 | #exec(LW_file&Internet/Cash/cancel.cml\00)
5 | <NGDLG>


--------------------------------------------------------------------------------
/share/cs/reg_new_room.cml:
--------------------------------------------------------------------------------
1 | <?~ USE CMDFilter ~?>
2 | <NGDLG>
3 | #exec(LW_gvar&%CG_GAMEID&<? id | cmd ?>&%CG_MAXPL&<? max_pl | cmd ?>&%CG_GAMENAME&<? name | cmd ?>&%COMMAND&CGAME\00)
4 | #exec(LW_file&Internet/Cash/cancel.cml\00)
5 | <NGDLG>


--------------------------------------------------------------------------------
/share/ac/join_room.cml:
--------------------------------------------------------------------------------
1 | <?~ USE CMDFilter ~?>
2 | <NGDLG>
3 | #exec(LW_gvar&%CG_GAMEID&<? id | cmd ?>&%CG_MAXPL&<? max_pl | cmd ?>&%CG_GAMENAME&<? name | cmd ?>&%COMMAND&JGAME&%CG_IP&<? ip | cmd ?>\00)
4 | #exec(LW_file&Internet/Cash/cancel.cml\00)
5 | <NGDLG>
6 | 


--------------------------------------------------------------------------------
/share/cs/join_room.cml:
--------------------------------------------------------------------------------
1 | <?~ USE CMDFilter ~?>
2 | <NGDLG>
3 | #exec(LW_gvar&%CG_GAMEID&<? id | cmd ?>&%CG_MAXPL&<? max_pl | cmd ?>&%CG_GAMENAME&<? name | cmd ?>&%COMMAND&JGAME&%CG_IP&<? ip | cmd ?>\00)
4 | #exec(LW_file&Internet/Cash/cancel.cml\00)
5 | <NGDLG>
6 | 


--------------------------------------------------------------------------------
/share/cs/ok_enter.cml:
--------------------------------------------------------------------------------
1 | //#exec(LW_cfile&Cookie\5C%GV_LCN_PROF&123\00)
2 | <? IF window_size == 'large' ~?>
3 | #large
4 | <? END ~?>
5 | #exec(LW_key&key)
6 | #exec(LW_gvar&%PROF&<? id ?>&%NAME&n/a&%NICK&<? nick ?>&%MAIL&n/a&%PASS&n/a&%GMID&-&%CHAT&<? server.config.chat_server ?>)
7 | 


--------------------------------------------------------------------------------
/share/ac/alert_dgl.cml:
--------------------------------------------------------------------------------
 1 | <NGDLG>
 2 | #exec(LW_lockbox&%LB)
 3 | #ebox[%B](x:200,y:80,w:450,h:185)
 4 | #pan[%MPN](%B[x:0,y:10,w:100%-10,h:100%],8)
 5 | #font(B1F18,WF,WF)
 6 | #ctxt[%TIT](%B[x:0,y:5,w:100%,h:30],{},"<? header ?>")
 7 | #font(YF,YF,YF)
 8 | #ctxt[%L_NAME](%B[x:0,y:48,w:100%,h:100],{},"<? text ?>")
 9 | #font(B1F18,B1F18,B1F18)
10 | #sbtn[%B_RGST](%B[x:170,y:100%+15,w:100,h:24],{LW_file&Internet/Cash/cancel.cml},"Close")
11 | <NGDLG>


--------------------------------------------------------------------------------
/share/cs/alert_dgl.cml:
--------------------------------------------------------------------------------
 1 | <NGDLG>
 2 | #exec(LW_lockbox&%LBX)
 3 | #exec(LW_enb&0&%RMLST)
 4 | #ebox[%B](x:120,y:30,w:500,h:180)
 5 | #pan[%MPN](%B[x:0,y:0,w:100%,h:100%],8)
 6 | #font(WF,WF,WF)
 7 | #ctxt[%TIT](%B[x:0,y:6,w:100%,h:30],{},"<? header ?>")
 8 | #font(YF,YF,YF)
 9 | #ctxt[%L_NAME](%B[x:0,y:48,w:100%,h:100],{},"<? text ?>")
10 | #font(YF,WF,RF)
11 | #sbtn[%B_RGST](%B[xc:50%,y:188,w:160,h:24],{LW_file&Internet/Cash/cancel.cml},"Close")
12 | <NGDLG>


--------------------------------------------------------------------------------
/share/cs/error_enter.cml:
--------------------------------------------------------------------------------
 1 | #ebox[%BOX](x:100,y:140,w:350,h:100)
 2 | #pan[%MPN](%BOX[x:0,y:0,w:100%,h:100%],8)
 3 | 
 4 | #font(WF,WF,WF)
 5 | #ctxt[%TIT](%BOX[x:0,y:6,w:100%,h:30],{},"ERROR!")
 6 | #font(YF,YF,YF)
 7 | #ctxt[%L_NAME](%BOX[x:0,y:52,w:100%,h:100],{},"<? error_text ?>")
 8 | 
 9 | #font(YF,WF,RF)
10 | #sbtn[%B_RGST](%BOX[x:0,y:100%+8,w:160,h:24],{GW|login&},"Try")
11 | #sbtn[%B_RGST](%BOX[x:185,y:100%+8,w:160,h:24],{LW_key&#CANCEL|LW_lockall},"Cancel")


--------------------------------------------------------------------------------
/share/ac/error_enter.cml:
--------------------------------------------------------------------------------
 1 | <NGDLG>
 2 | #ebox[%BOX](xc:50%,yc:50%,w:400,h:100)
 3 | #pan[%MPN](%BOX[x:0,y:0,w:100%,h:100%],8)
 4 | 
 5 | #font(BF,BF,BF)
 6 | #ctxt[%TIT](%BOX[x:0,y:0-5,w:100%,h:30],{},"ERROR!")
 7 | #font(YF,YF,YF)
 8 | #ctxt[%L_NAME](%BOX[x:0,y:40,w:100%,h:100],{},"<? error_text ?>")
 9 | 
10 | #font(YF,WF,RF)
11 | #sbtn[%B_RGST](%BOX[x:10,y:100%,w:160,h:24],{LW_file&Internet/Cash/cancel.cml},"Try")
12 | #sbtn[%B_RGST](%BOX[x:225,y:100%,w:160,h:24],{LW_key&#CANCEL},"Cancel")
13 | <NGDLG>


--------------------------------------------------------------------------------
/etc/simple-cossacks-server.conf:
--------------------------------------------------------------------------------
 1 | host          = localhost
 2 | port          = 34001
 3 | templates     = ./share
 4 | access_log    = ./access_log
 5 | error_log     = ./error_log
 6 | table_timeout = 5000
 7 | gettbl_log_interval = 2
 8 | chat_server   = osiris.2gw.net
 9 | show_started_rooms = 1
10 | # lcn_host        = www.newlcn.com
11 | # lcn_server_name = newlcn.com
12 | # lcn_key         = KEY
13 | # wcl_host        = wcl.com.ua
14 | # wcl_key         = KEY
15 | # lcn_ranking     = var/ranking.json
16 | 


--------------------------------------------------------------------------------
/share/ac/confirm_dgl.cml:
--------------------------------------------------------------------------------
 1 | <NGDLG>
 2 | #exec(LW_lockbox&%LB)
 3 | #ebox[%B](x:200,y:80,w:450,h:185)
 4 | #pan[%MPN](%B[x:0,y:10,w:100%-10,h:100%],8)
 5 | #font(B1F18,WF,WF)
 6 | #ctxt[%TIT](%B[x:0,y:5,w:100%,h:30],{},"<? header ?>")
 7 | #font(YF,YF,YF)
 8 | #ctxt[%L_NAME](%B[x:0,y:48,w:100%,h:100],{},"<? text ?>")
 9 | #font(B1F18,B1F18,B1F18)
10 | #sbtn[%B_RGST](%B[x:60,y:100%+15,w:100,h:24],{<? command ?>},"<? ok_text ?>")
11 | #sbtn[%B_RGST](%B[x:275,y:100%+15,w:100,h:24],{LW_file&Internet/Cash/cancel.cml},"Cancel")
12 | <NGDLG>


--------------------------------------------------------------------------------
/lib/SimpleCossacksServer/Template/Plugin/CMDFilter.pm:
--------------------------------------------------------------------------------
 1 | package SimpleCossacksServer::Template::Plugin::CMDFilter;
 2 | use Template::Plugin::Filter;
 3 | use base 'Template::Plugin::Filter';
 4 | 
 5 | sub init {
 6 |     my $self = shift;
 7 |     $self->{ _DYNAMIC } = 1;
 8 |     # first arg can specify filter name
 9 |     $self->install_filter($self->{ _ARGS }->[0] || 'cmd');
10 |     return $self;
11 | }
12 | 
13 | sub filter {
14 |     my ($self, $text) = @_;
15 |     $text =~ s/([&|\\}~,)])/sprintf "\\%02X", ord $1/ge;
16 |     return $text;
17 | }
18 | 
19 | 1;
20 | 


--------------------------------------------------------------------------------
/lib/SimpleCossacksServer/ConnectionController.pm:
--------------------------------------------------------------------------------
 1 | package SimpleCossacksServer::ConnectionController;
 2 | use Mouse;
 3 | extends 'GSC::Server::ConnectionController';
 4 | 
 5 | sub _connect {
 6 |   my($self, $h) = @_;
 7 |   $h->log->info($h->connection->log_message . ' #connect');
 8 | }
 9 | 
10 | sub _close {
11 |   my($self, $h) = @_;
12 |   if(my $id = $h->connection->data->{id}) {
13 |     $h->server->leave_room($id);
14 |     delete $h->server->data->{players}{$id};
15 |   }
16 |   $h->log->info($h->connection->log_message . ' #disconnect');
17 | }
18 |   
19 | __PACKAGE__->meta->make_immutable();
20 | 


--------------------------------------------------------------------------------
/lib/SimpleCossacksServer/Template/Plugin/CMLStringArgFilter.pm:
--------------------------------------------------------------------------------
 1 | package SimpleCossacksServer::Template::Plugin::CMLStringArgFilter;
 2 | use Template::Plugin::Filter;
 3 | use base 'Template::Plugin::Filter';
 4 | 
 5 | sub init {
 6 |     my $self = shift;
 7 |     $self->{ _DYNAMIC } = 1;
 8 |     # first arg can specify filter name
 9 |     $self->install_filter($self->{ _ARGS }->[0] || 'arg');
10 |     return $self;
11 | }
12 | 
13 | sub filter {
14 |     my ($self, $text) = @_;
15 |     $text =~ s/"/'/g;
16 |     $text =~ s/~//g;
17 |     $text = '"' . $text . '"';
18 |     return $text;
19 | }
20 | 
21 | 1;
22 | 


--------------------------------------------------------------------------------
/share/cs/confirm_dgl.cml:
--------------------------------------------------------------------------------
 1 | <NGDLG>
 2 | <?~ SET height = height ? height : 180 ?>
 3 | #exec(LW_lockbox&%LBX)
 4 | #exec(LW_enb&0&%RMLST)
 5 | #ebox[%B](x:120,y:30,w:500,h:<? height ?>)
 6 | #pan[%MPN](%B[x:0,y:0,w:100%,h:100%],8)
 7 | #font(WF,WF,WF)
 8 | #ctxt[%TIT](%B[x:0,y:6,w:100%,h:30],{},"<? header ?>")
 9 | #font(YF,YF,YF)
10 | #ctxt[%L_NAME](%B[x:0,y:48,w:100%,h:100],{},"<? text ?>")
11 | #font(YF,WF,RF)
12 | #sbtn[%B_RGST](%B[x:50,y:<? height + 8 ?>,w:160,h:24],{<? command ?>},"<? ok_text ?>")
13 | #sbtn[%B_RGST](%B[x:290,y:<? height + 8 ?>,w:160,h:24],{LW_file&Internet/Cash/cancel.cml},"Cancel")
14 | <NGDLG>
15 | 


--------------------------------------------------------------------------------
/lib/SimpleCossacksServer/Handler.pm:
--------------------------------------------------------------------------------
 1 | package SimpleCossacksServer::Handler;
 2 | use Mouse;
 3 | extends 'GSC::Server::Handler';
 4 | 
 5 | sub is_american_conquest {
 6 |   my($self) = @_;
 7 |   return $self->req->ver ~~ [3, 8, 10] ? 1 : "";
 8 | }
 9 | 
10 | sub view {
11 |   my($self, $file, $vars) = @_;
12 |   my $output;
13 |   my %vars = %$vars if $vars;
14 |   $vars{h} = $self;
15 |   $vars{server} = $self->server;
16 |   my $dir = $self->is_american_conquest ? "ac" : "cs";
17 |   $self->server->template_engine->process("$dir/$file", \%vars, \$output)
18 |     or $self->log->error( $self->server->template_engine->error()->as_string ), $output = '';
19 |   return $output;
20 | }
21 | 
22 | sub show {
23 |   my($self, $file, $vars) = @_;
24 |   $self->push_command( LW_show => $self->view($file, $vars) );
25 | }
26 | 
27 | __PACKAGE__->meta->make_immutable();
28 | 


--------------------------------------------------------------------------------
/share/ac/confirm_password_dgl.cml:
--------------------------------------------------------------------------------
 1 | <NGDLG>
 2 | #exec(LW_lockbox&%LB)
 3 | #ebox[%B](x:200,y:80,w:450,h:185)
 4 | #pan[%MPN](%B[x:0,y:10,w:100%-10,h:100%],8)
 5 | #font(B1F18,WF,WF)
 6 | #ctxt[%TIT](%B[x:0,y:5,w:100%,h:30],{},"password")
 7 | #font(YF,YF,YF)
 8 | #ctxt[%L_NAME](%B[x:0,y:48,w:100%,h:100],{},"Password is required to join this game!")
 9 | #pan[%P_NICK](%B[x:20,y:75,w:100%-40,h:24],13)
10 | #edit[%E_NAME](%B[x:20,y:75,w:100%-40,h:24],{%VE_PASSWD})
11 | #ctxt[%L_NAME](%B[x:0,y:115,w:100%,h:100],{},"Press OK button to use the entered password
12 | Press Cancle button to exit")
13 | #font(B1F18,B1F18,B1F18)
14 | #sbtn[%B_RGST](%B[x:60,y:100%+15,w:100,h:24],{GW|open&join_game.dcml&ASTATE=<%ASTATE>^VE_RID=<? id | cmd ?>^VE_PASSWD=<%VE_PASSWD>|LW_file&Internet/Cash/cancel.cml},"OK")
15 | #sbtn[%B_RGST](%B[x:275,y:100%+15,w:100,h:24],{LW_file&Internet/Cash/cancel.cml},"Cancel")
16 | <NGDLG>
17 | 


--------------------------------------------------------------------------------
/share/cs/confirm_password_dgl.cml:
--------------------------------------------------------------------------------
 1 | <?~ USE CMDFilter ~?>
 2 | <NGDLG>
 3 | #exec(LW_lockbox&%LBX)
 4 | #exec(LW_enb&0&%RMLST)
 5 | #ebox[%B](x:120,y:30,w:500,h:180)
 6 | #pan[%MPN](%B[x:0,y:0,w:100%,h:100%],8)
 7 | #font(WF,WF,WF)
 8 | #ctxt[%TIT](%B[x:0,y:6,w:100%,h:30],{},"Password")
 9 | #font(YF,YF,YF)
10 | #ctxt[%L_NAME](%B[x:0,y:48,w:100%,h:100],{},"Password is required to join this game!")
11 | #pan[%P_NICK](%B[x:20,y:75,w:100%-40,h:24],2)
12 | #edit[%E_NAME](%B[x:20,y:75,w:100%-40,h:24],{%VE_PASSWD})
13 | #ctxt[%L_NAME](%B[x:0,y:115,w:100%,h:100],{},"Press OK button to use the entered password
14 | Press Cancle button to exit")
15 | #font(YF,WF,RF)
16 | #sbtn[%B_RGST](%B[x:290,y:188,w:160,h:24],{LW_file&Internet/Cash/cancel.cml},"Cancel")
17 | #sbtn[%B_RGST](%B[x:50,y:188,w:160,h:24],{GW|open&join_game.dcml&ASTATE=<%ASTATE>^VE_RID=<? id | cmd ?>^VE_PASSWD=<%VE_PASSWD>|LW_file&Internet/Cash/cancel.cml},"OK")
18 | <NGDLG>
19 | 


--------------------------------------------------------------------------------
/share/ac/enter.cml:
--------------------------------------------------------------------------------
 1 | #font(BRF,BBF,BBF)
 2 | #ebox[%EBG](x:0,y:0,w:1024,h:768)
 3 | #font(B1F40,B1F40,B1F40)
 4 | #ctxt[%TI](%EBG[x:0,y:18,w:100%,h:30],{},{LCN Game Server})
 5 | 
 6 | #ebox[%LBX](x:430,y:180,w:500,h:220)
 7 | #pan[%MPN](%LBX[x:0,y:0,w:100%,h:100%],0)
 8 | 
 9 | 
10 | #font(BF,BF,BF)
11 | #ctxt[%TIT](%LBX[x:0,y:-1+190,w:100%,h:30],{},"cossacks-server.net")
12 | 
13 | #font(WF,WF,WF)
14 | #txt(%LBX[x:10,y:167,w:100%,h:24],{},"Your nick:")
15 | #font(YF,YF,WF)
16 | //#exec(LW_cfile&\00&Cookies/%GV_VE_NICK)
17 | #pan[%P_NICK](%LBX[x:100,x1:100%-10,y:165,h:24],4)
18 | #edit(%LBX[x:100,x1:100%-10,y:163,h:24],{%GV_LCN_NICK})
19 | 
20 | #font(YF,WF,RF)
21 | 
22 | #btn[%B_RGST](%LBX[x:70,y:210,w:160,h:24],{GW|open&try_enter.dcml&NICK=<%GV_LCN_NICK>|LW_lockall},"Enter")
23 | #btn[%B_RGST](%LBX[x:310,y:210,w:160,h:24],{LW_key&#CANCEL},"Cancel")
24 | 
25 | <NGDLG>
26 | <NGDLG>
27 | 
28 | #block(cancel.cml,CAN)<NGDLG>
29 | <NGDLG>
30 | #end(CAN)
31 | 
32 | #block(l_games_btn.cml,l_g):GW|open&games_btn.dcml\00
33 | #end(l_g)


--------------------------------------------------------------------------------
/MANIFEST:
--------------------------------------------------------------------------------
 1 | Changes
 2 | MANIFEST
 3 | README
 4 | etc/simple-cossacks-server.conf
 5 | script/simple-cossacks-server
 6 | t/SimpleCossacksServer.t
 7 | lib/SimpleCossacksServer.pm
 8 | lib/SimpleCossacksServer/ConnectionController.pm
 9 | lib/SimpleCossacksServer/CommandController.pm
10 | lib/SimpleCossacksServer/CommandController/Open.pm
11 | lib/SimpleCossacksServer/Template/Plugin/CMDFilter.pm
12 | lib/SimpleCossacksServer/Connection.pm
13 | lib/SimpleCossacksServer/Handler.pm
14 | share/ac/alert_dgl.cml
15 | share/ac/test.cml
16 | share/ac/new_room_dgl.cml
17 | share/ac/ok_enter.cml
18 | share/ac/confirm_dgl.cml
19 | share/ac/reg_new_room.cml
20 | share/ac/enter.cml
21 | share/ac/startup.cml
22 | share/ac/error_enter.cml
23 | share/cs/alert_dgl.cml
24 | share/cs/test.cml
25 | share/cs/new_room_dgl.cml
26 | share/cs/ok_enter.cml
27 | share/cs/confirm_dgl.cml
28 | share/cs/reg_new_room.cml
29 | share/cs/confirm_password_dgl.cml
30 | share/cs/login.cml
31 | share/cs/enter.cml
32 | share/cs/startup.cml
33 | share/cs/error_enter.cml
34 | 


--------------------------------------------------------------------------------
/lib/SimpleCossacksServer/Connection.pm:
--------------------------------------------------------------------------------
 1 | package SimpleCossacksServer::Connection;
 2 | use Mouse;
 3 | use Scalar::Util;
 4 | extends 'GSC::Server::Connection';
 5 | my $MAXID = 1;
 6 | has id => (is => 'ro', default => sub { $MAXID++ });
 7 | has ctime => (is => 'ro', default => sub { time });
 8 | 
 9 | sub log_message {
10 |   my($self) = @_;
11 |   my $message = $self->id . " " . $self->ip . " ";
12 |   my $cd = $self->data;
13 |   if($cd->{id} || $cd->{nick}) {
14 |     $message .= "$cd->{nick}:";
15 |     $message .= $cd->{id} if $cd->{id};
16 |   } else {
17 |     $message .= "."
18 |   }
19 |   return $message;
20 | }
21 | 
22 | my %CONNECTION_BY_PID;
23 | sub connection_by_pid {
24 |   my($class, $pid, $connection) = @_;
25 |   if(@_ > 2) {
26 |     $CONNECTION_BY_PID{$pid} = $connection;
27 |     Scalar::Util::weaken($CONNECTION_BY_PID{$pid});
28 |     return $CONNECTION_BY_PID{$pid};
29 |   } else {
30 |     return $CONNECTION_BY_PID{$pid};
31 |   }
32 | }
33 | 
34 | sub DEMOLISH {
35 |   my($self) = @_;
36 |   delete $CONNECTION_BY_PID{$self->data->{id}} if $self->data->{id};
37 | }
38 | 
39 | __PACKAGE__->meta->make_immutable();
40 | 


--------------------------------------------------------------------------------
/Makefile.PL:
--------------------------------------------------------------------------------
 1 | use ExtUtils::MakeMaker;
 2 | # See lib/ExtUtils/MakeMaker.pm for details of how to influence
 3 | # the contents of the Makefile that is written.
 4 | WriteMakefile(
 5 |     NAME              => 'SimpleCossacksServer',
 6 |     VERSION_FROM      => 'lib/SimpleCossacksServer.pm', # finds $VERSION
 7 |     PREREQ_PM         => {
 8 |         'GSC::Server' => 0,
 9 |         'Template' => 0,
10 |         'Template::Plugin::POSIX' => 0,
11 |         'Config::Simple' => 0,
12 |         'POSIX' => 0,
13 |         'String::Escape' => 0,
14 |         'Getopt::Compact' => 0,
15 |         'Net::EmptyPort' => 0, # for tests
16 |         'Getopt::Long::Descriptive' => 0.097,
17 |         'AnyEvent::HTTP' => 0,
18 |         'LWP' => 0,
19 |         'JSON' => 0,
20 |         'Scalar::Util' => 0,
21 |         'URI' => 0,
22 |     },
23 |     ($] >= 5.005 ?     ## Add these new keywords supported since 5.005
24 |       (ABSTRACT_FROM  => 'lib/SimpleCossacksServer.pm', # retrieve abstract from module
25 |        AUTHOR         => '[-RUS-]AlliGator') : ()),
26 |     EXE_FILES         => ['script/simple-cossacks-server', 'script/cossacks-proxy'],
27 | );
28 | 


--------------------------------------------------------------------------------
/script/simple-cossacks-server:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/perl
 2 | use strict;
 3 | use warnings;
 4 | no warnings 'once';
 5 | #use SimpleCossacksServer;
 6 | use POSIX;
 7 | use Getopt::Compact;
 8 | 
 9 | my $go = Getopt::Compact->new(
10 |   name => 'simple-cossacks-server',
11 |   struct => [
12 |     [['config', 'c'], 'Config file. Default is /etc/simple-cossacks-server', '=s'],
13 |     [['port', 'p'], 'Override config port. Default is in config or 34001', '=i'],
14 |     [['log', 'l'], 'STDERR log level. 0-9 or none|fatal|alert|critical|error|warn|notice|info|debug|trace', '=s'],
15 |   ]
16 | );
17 | 
18 | my %opts = %{$go->opts};
19 | 
20 | my %args = (
21 |   config_file => $opts{config} // '/etc/simple-cossacks-server.conf'
22 | );
23 | $args{port} = $opts{port} if defined $opts{port};
24 | $args{log_level} = $opts{log} if defined $opts{log};
25 | 
26 | require SimpleCossacksServer;
27 | our $server = SimpleCossacksServer->new(%args);
28 | 
29 | $Coro::State::WARNHOOK = sub { $server->log->warn(shift) };
30 | $SIG{HUP} = sub { Coro::async(sub{$server->reload}) };
31 | 
32 | $server->start->join;
33 | 
34 | =head1 NAME
35 | 
36 | simple-cossacks-server - simple game server for cossacks and american conquests based on GSC protocol
37 | 


--------------------------------------------------------------------------------
/share/cs/gg_cup_thanks_dgl.cml:
--------------------------------------------------------------------------------
 1 | <?~ USE POSIX ~?>
 2 | <?~ USE CMLStringArgFilter ~?>
 3 | <?~ USE CMDFilter ~?>
 4 | <NGDLG>
 5 | #exec(LW_lockbox&%LBX)
 6 | #exec(LW_enb&0&%RMLST)
 7 | <? SET rows = 17 ~?>
 8 | #ebox[%B](x:215,y:10,w:320,h:<? supporters.size <= 9 ? 280 : (supporters.size > rows) ? (55 + (rows + 1) * 25) : (55 + supporters.size * 25) ?>)
 9 | #pan[%MPN](%B[x:0,y:0,w:100%,h:100%],8)
10 | #font(WF,WF,WF)
11 | #ctxt[%TIT](%B[x:0,y:6,w:100%,h:30],{},"Thanks for")
12 | 
13 | <? SET height = 25 ~?>
14 | <? yoffset = 43 ~?>
15 | <? FOREACH supporter IN supporters ~?>
16 | <? IF loop.index == rows ~?>
17 | #font(YF,YF,YF)
18 | #txt(%B[x:20,y:<? yoffset + 3 ?>,w:100%,h:25],{},"and more...")
19 | <? LAST ~?>
20 | <? ELSE ~?>
21 | #font(YF,YF,YF)
22 | #txt(%B[x:20,y:<? yoffset + 3 ?>,w:100%,h:25],{},<? supporter.nick ?>)
23 | #font(WF,WF,WF)
24 | #rtxt(%B[x:100%-204,y:<? yoffset + 3 ?>,w:100,h:25],{},<? POSIX.floor(supporter.amount) _ ' RUB ' | arg ?>)
25 | #btn(%B[x:230,y:<? yoffset ?>,w:72,h:25],{GW|url&<? supporter.url | cmd ?>},"profile")
26 | <? END ~?>
27 | <? yoffset = yoffset + height ~?>
28 | <? END ~?>
29 | 
30 | #font(YF,WF,RF)
31 | #sbtn[%B_RGST](%B[xc:50%,y:100%+8,w:160,h:24],{LW_file&Internet/Cash/cancel.cml},"Ok")
32 | <NGDLG>
33 | 


--------------------------------------------------------------------------------
/t/001_SimpleCossacksServer.t:
--------------------------------------------------------------------------------
 1 | # Before `make install' is performed this script should be runnable with
 2 | # `make test'. After `make install' it should work as `perl SimpleCossacksServer.t'
 3 | 
 4 | #########################
 5 | 
 6 | # change 'tests => 1' to 'tests => last_test_to_print';
 7 | 
 8 | use strict;
 9 | use warnings;
10 | use Test::More tests => 4;
11 | use Net::EmptyPort;
12 | use Coro::Socket;
13 | use GSC::Streamer;
14 | 
15 | BEGIN { use_ok('SimpleCossacksServer') };
16 | 
17 | my $port = Net::EmptyPort::empty_port();
18 | 
19 | my $server = new_ok(SimpleCossacksServer => [
20 |   config_file => './etc/simple-cossacks-server.conf',
21 |   port => $port,
22 | ]);
23 | 
24 | ok(eval { $server->start() }, "start server");
25 | 
26 | my $socket = Coro::Socket->new(
27 |   PeerAddr => $server->host,
28 |   PeerPort => $server->port,
29 |   Proto => 'tcp',
30 |   Timeout => 5,
31 | );
32 | 
33 | my $streamer = GSC::Streamer->new(1, 0, 2);
34 | 
35 | my $req = $streamer->new_stream( echo => ['hello', 'world', 'win', 'key'] );
36 | $socket->write($req->bin);
37 | my $res = GSC::Stream->from_read($socket);
38 | my $rs = [ map {[$_->name => $_->args]} $res->cmdset->all ];
39 | is_deeply($rs, [['LW_echo', 'hello', 'world', 'win']], 'echo request');
40 | 
41 | done_testing();
42 | 


--------------------------------------------------------------------------------
/README:
--------------------------------------------------------------------------------
 1 | SimpleCossacksServer version 0.01
 2 | =================================
 3 | 
 4 | The README is used to introduce the module and provide instructions on
 5 | how to install the module, any machine dependencies it may have (for
 6 | example C compilers and installed libraries) and any other information
 7 | that should be provided before the module is installed.
 8 | 
 9 | A README file is required for CPAN modules since CPAN extracts the
10 | README file from a module distribution so that people browsing the
11 | archive can use it get an idea of the modules uses. It is usually a
12 | good idea to provide version information here so that people can
13 | decide whether fixes for the module are worth downloading.
14 | 
15 | INSTALLATION
16 | 
17 | To install this module type the following:
18 | 
19 |    perl Makefile.PL
20 |    make
21 |    make test
22 |    make install
23 | 
24 | DEPENDENCIES
25 | 
26 | This module requires these other modules and libraries:
27 | 
28 |   blah blah blah
29 | 
30 | COPYRIGHT AND LICENCE
31 | 
32 | Put the correct copyright and licence information here.
33 | 
34 | Copyright (C) 2013 by [-RUS-]AlliGator
35 | 
36 | This library is free software; you can redistribute it and/or modify
37 | it under the same terms as Perl itself, either Perl version 5.14.4 or,
38 | at your option, any later version of Perl 5 you may have available.
39 | 
40 | 
41 | 


--------------------------------------------------------------------------------
/share/cs/new_room_dgl.cml:
--------------------------------------------------------------------------------
 1 | <NGDLG>
 2 | //#exec(LW_visbox&0&%LBX)
 3 | #exec(LW_lockbox&%LBX)
 4 | #exec(LW_enb&0&%RMLST)
 5 | #font(WF,WF,YF)
 6 | 
 7 | #ebox[%L](x:180,y:20,w:100%-380,h:165)
 8 | #ebox[%E](x:180,y:14,w:100%-380,h:30)
 9 | #pan[%MPN](%L[x:0,y:0,w:100%,h:100%],8)
10 | #ctxt[%TIT](%E[x:0,y:12,w:100%,h:10],{},"Create new game")
11 | 
12 | #font(WF,YF,WF)
13 | #txt[%L_NAME](%L[x:20,y:44,w:100,h:24],{},"Game Title")
14 | #pan[%P_NAME](%L[x:130,y:42,w:100%-150,h:24],2)
15 | #font(YF,WF,WF)
16 | #edit[%E_NAME](%L[x:130,y:40,w:100%-150,h:24],{%GV_VE_TITLE})
17 | 
18 | #font(WF,YF,WF)
19 | #txt[%L_PASS](%L[x:20,y:70,w:100,h:24],{},"Password")
20 | #pan[%P_PASS](%L[x:130,y:68,w:100%-150,h:24],2)
21 | #font(YF,WF,WF)
22 | #edit[%E_PASS](%L[x:130,y:66,w:100%-150,h:24],{%GV_VE_PASSWD})
23 | 
24 | #font(WF,YF,WF)
25 | #txt[%L_MAXPL](%L[x:20,y:97,w:100,h:24],{},"Max Players")
26 | #font(YF,WF,WF)
27 | #cbb[%E_MAXPL](%L[x:130,y:95,w:100%-150,h:24],{%GV_VE_MAX_PL},2,3,4,5,6,7,5)
28 | 
29 | #font(WF,YF,WF)
30 | #txt[%L_LEVEL](%L[x:20,y:123,w:100,h:24],{},"Level")
31 | #font(YF,WF,WF)
32 | #cbb[%E_LEVEL](%L[x:130,y:121,w:100%-150,h:24],{%GV_VE_LEVEL},--,Easy,Normal,Hard,0)
33 | 
34 | #font(SYF,SWF,SWF)
35 | #txt(%L[x:20,y:146,w:100%,h:24],{},"NOTE: You shall have a PUBLIC ip address to create server")
36 | 
37 | #font(YF,WF,YF)
38 | 
39 | #sbtn[%B_RGST](%L[x:43,y:100%+5,w:100,h:24],{GW|open&reg_new_room.dcml&ASTATE=<%ASTATE>^VE_TITLE=<%GV_VE_TITLE>^VE_MAX_PL=<%GV_VE_MAX_PL>^VE_PASSWD=<%GV_VE_PASSWD>^VE_LEVEL=<%GV_VE_LEVEL>|LW_lockall},"Create")
40 | #sbtn[%B_RGST](%L[x:230,y:100%+5,w:100,h:24],{LW_file&Internet/Cash/cancel.cml},"Cancel")
41 | <NGDLG>
42 | 


--------------------------------------------------------------------------------
/share/ac/new_room_dgl.cml:
--------------------------------------------------------------------------------
 1 | <NGDLG>
 2 | //#exec(LW_visbox&0&%LBX)
 3 | #exec(LW_lockbox&%LBX)
 4 | #exec(LW_enb&0&%RMLST)
 5 | 
 6 | #font(B1F18,B1F18,B1F18)
 7 | #ebox[%L](x:200,y:80,w:450,h:185)
 8 | #pan[%MPN](%L[x:0,y:10,w:100%-10,h:100%],8)
 9 | #ctxt[%TIT](%L[x:0,y:5,w:100%,h:10],{},"Create new game")
10 | 
11 | #font(Y1F18,Y1F18,Y1F18)
12 | #txt[%L_NAME](%L[x:20,y:44,w:150,h:24],{},"Game Title")
13 | #pan[%P_NAME](%L[x:200,y:42,w:100%-220,h:24],13)
14 | #font(WF18,WF18,WF18)
15 | #edit[%E_NAME](%L[x:200,y:40,w:100%-220,h:24],{%GV_VE_TITLE})
16 | 
17 | #font(Y1F18,Y1F18,Y1F18)
18 | #txt[%L_PASS](%L[x:20,y:70,w:150,h:24],{},"Password")
19 | #pan[%P_PASS](%L[x:200,y:68,w:100%-220,h:24],13)
20 | #font(WF18,WF18,WF18)
21 | #edit[%E_PASS](%L[x:200,y:66,w:100%-220,h:24],{%GV_VE_PASSWD})
22 | 
23 | #font(Y1F18,Y1F18,Y1F18)
24 | #txt[%L_MAXPL](%L[x:20,y:97,w:150,h:24],{},"Max Players")
25 | #font(WF18,WF18,WF18)
26 | #cbb[%E_MAXPL](%L[x:200,y:95,w:100%-220,h:24],{%GV_VE_MAX_PL},2,3,4,5,6,7,5)
27 | 
28 | #font(Y1F18,Y1F18,Y1F18)
29 | #txt[%L_TYPE](%L[x:20,y:123,w:150,h:24],{},"Type")
30 | #font(WF18,WF18,WF18)
31 | #cbb[%E_TYPE](%L[x:200,y:121,w:100%-220,h:24],{%GV_VE_TYPE},Ordinal,Battle,0)
32 | 
33 | #font(Y1F18,Y1F18,Y1F18)
34 | #txt[%L_LEVEL](%L[x:20,y:149,w:150,h:24],{},"Level")
35 | #font(WF18,WF18,WF18)
36 | #cbb[%E_LEVEL](%L[x:200,y:147,w:100%-220,h:24],{%GV_VE_LEVEL},--,Easy,Normal,Hard,0)
37 | 
38 | #font(B1F18,B1F18,B1F18)
39 | 
40 | #sbtn[%B_RGST](%L[x:60,y:100%+15,w:100,h:24],{GW|open&reg_new_room.dcml&VE_NICK=<%GV_LCN_NICK>^VE_TITLE=<%GV_VE_TITLE>^VE_MAX_PL=<%GV_VE_MAX_PL>^VE_PASSWD=<%GV_VE_PASSWD>^VE_TYPE=<%GV_VE_TYPE>^VE_LEVEL=<%GV_VE_LEVEL>^ASTATE=<%ASTATE>|LW_lockall},"Create")
41 | #sbtn[%B_RGST](%L[x:275,y:100%+15,w:100,h:24],{LW_file&Internet/Cash/cancel.cml},"Cancel")
42 | <NGDLG>
43 | 


--------------------------------------------------------------------------------
/share/ac/startup.cml:
--------------------------------------------------------------------------------
 1 | #lockresize
 2 | #small
 3 | #ebox[%LBX](x:0,y:0,w:100%,h:100%)
 4 | #font(B1F40,B1F40,B1F40)
 5 | #ctxt[%TIT](%LBX[x:0+90,y:0-128,w:100%,h:30],{},LCN Game Server)
 6 | #font(B1F18,B1F18,B1F18)
 7 | #ctxt[%TIT](%LBX[x:0-10,y:0-38,w:100%,h:30],{},Games)
 8 | 
 9 | #def_tbl(0,0,0,0,21,25,26,0,0,0,0,0,0,0)
10 | #def_box(Internet/pix/i_bor%d,0,1,2,3,6,7,4,5,1,1,1,1)
11 | #def_sbox(Internet/pix/i_bor%d,0,1,2,3,6,7,4,5,1,1,1,1,0,0,0)
12 | 
13 | //#pan[%MPN](%LBX[x:0,y:0,w:100%,h:100%],0)
14 | 
15 | #font(YF16,YF16,YF16)
16 | #pan[%MPN](%LBX[x:0,y:0,w:100%,h:100%-40],13)
17 | #DBTBL[%RMLST](%LBX[x:1,y:1,w:100%-2,h:100%-40],{ROOMS_V<? h.req.ver ?>}{%RL_C},"<? server.config.table_timeout ?>",TBL_SF,8,0,
18 | 0,"RID",NON,NON,NON,%RL_ID,
19 | 41,"Game Title",STR,STR,STR,%RL_TITLE,
20 | 15,"Host",STR,STR,STR,%RL_HOST,
21 | 15,"Type",ENUM:Simple|Battlefield,FIXED:Any|Simple|Battlefield,STR,%RL_TYPE,
22 | 12,"Level",STR,FIXED:Any|Easy|Normal|Hard,STR,%RL_LEVL,
23 | 8,"Players",STR,INT:Any|>1|>2|>3|>4|>5|>6,STR,%RL_PLRS,
24 | 0,"V",NON,NON,NON,%RL_VERS,
25 | 9,"Ping",PING,PING:Any|<100|<200|<300|<400|<500|<600,PING,%RL_IPADR)
26 | 
27 | // #DBTBL[%RMLST](%LBX[x:1,y:1,w:100%-2,h:100%-40],{RMLST_V4}{%RL_C},20000,TBL_SF,9,0,
28 | // 0,"RID",NON,NON,NON,%RL_ID,
29 | // 0,"PWD",NON,NON,NON,%RL_PWD,
30 | // 39,"Game Title",STR,STR,STR,%RL_TITLE,
31 | // 15,"Host",STR,STR,STR,%RL_HOST,
32 | // 15,"Type",STR,STR,STR,%RL_TYPE,
33 | // 14,"Level",STR,STR,STR,%RL_LEVL,
34 | // 8,"Players",STR,STR,STR,%RL_PLRS,
35 | // 0,"V",NON,NON,NON,%RL_VERS,
36 | // 9,"Ping",PING,PING:Any|<100|<200|<300|<400|<500|<600,PING,%RL_IPADR)
37 | 
38 | //#pan[%PNA](%LBX[x:0,y:100%-38,w:100%-4,h:35],1)
39 | 
40 | #font(YF,WF,BF)
41 | #btn[%B_C](%LBX[x:10,y:100%-30,w:85,h:28],{GW|open&new_room_dgl.dcml&ASTATE=<%ASTATE>|LW_lockall},"Create")
42 | #btn[%B_J](%LBX[x:134,y:100%-30,w:85,h:28],{GW|open&join_game.dcml&ASTATE=<%ASTATE>^VE_RID=<%RL_ID>|LW_lockall},"Join")
43 | #font(SYF,SWF,SBF)
44 | #rtxt(%LBX[x:300,x1:100%,y:100%-25,h:28],{},"last start at <? server.data.start_at ?>")
45 | <NGDLG>
46 | <NGDLG>
47 | 
48 | #block(cancel.cml,CAN)<NGDLG>
49 | <NGDLG>
50 | #end(CAN)
51 | 


--------------------------------------------------------------------------------
/share/cs/user_details.cml:
--------------------------------------------------------------------------------
 1 | <NGDLG>
 2 | <? USE CMLStringArgFilter ?>
 3 | <? USE CMDFilter ?>
 4 | <? USE date ?>
 5 | #exec(LW_lockbox&%LBX)
 6 | #exec(LW_enb&0&%RMLST)
 7 | #ebox[%B](x:210,y:40,w:360,h:<? 110 + (player.account ? 20 : 0) + (room ? 50 : 0) ?>)
 8 | #pan[%MPN](%B[x:0,y:0,w:100%,h:100%],8)
 9 | #font(WF,WF,WF)
10 | #ctxt[%TIT](%B[x:0,y:6,w:100%,h:30],{},"Player Info")
11 | <? IF h.connection.data.dev ?>
12 | #rtxt(%B[x:280,y:6,w:70,h:30],{},<? "#" _ player.id | arg ?>)
13 | <? END ?>
14 | 
15 | #font(WF,WF,WF)
16 | #txt[%L_NAME](%B[x:20,y:48,w:100%,h:100],{},"Nick")
17 | #font(YF,YF,YF)
18 | #txt[%L_NAME](%B[x:105,y:48,w:100%,h:100],{},"<? player.nick ?>")
19 | 
20 | #font(WF,YF,WF)
21 | #txt[%L_CTIME](%B[x:20,y:%L_NAME+6,w:100%,h:100],{},"Connected at")
22 | #font(YF,WF,WF)
23 | #txt[%T_CTIME](%B[x:105,y:%L_NAME+6,w:100%,h:100],{},<? date.format(player.connected_at, format => '%Y-%m-%d %H:%M:%S UTC', gmt => 1) _ " (" _ connection_time _ " ago)" | arg ?>)
24 | 
25 | <? IF player.account ?>
26 | #font(WF,WF,WF)
27 | #txt[%L_ACCOUNT](%B[x:20,y:%L_CTIME+6,w:100%,h:100],{},"Logon with")
28 | #font(WF,WF,WF)
29 | #apan[%P_ACCOUNT](%B[x:105,y:%L_CTIME+3,w:33,h:20],{<? IF player.account.profile ?>GW|url&<? player.account.profile | cmd ?>&from=user_details<? END ?>},<? player.account.profile ? 14 : 4 ?>)
30 | #txt[%T_ACCOUNT](%B[x:109,y:%L_CTIME+6,w:33,h:100],{},"<? player.account.type ?>")
31 | <? IF player.account.type == 'LCN' && h.server.data.lcn_place_by_id.${player.account.id} ?>
32 | #font(YF,YF,YF)
33 | #txt(%B[x:145,y:%L_CTIME+6,w:100,h:100],{},"Place:")
34 | #font(WF,WF,WF)
35 | #txt(%B[x:181,y:%L_CTIME+6,w:100,h:100],{},<? h.server.data.lcn_place_by_id.${player.account.id} | arg ?>)
36 | <? END ?>
37 | <? END ?>
38 | 
39 | <? IF room ?>
40 | #font(WF,WF,WF)
41 | #txt[%L_ROOM](%B[x:20,y:%<? player.account ? "L_ACCOUNT" : "L_CTIME" ?>+6,w:100%,h:100],{},"Room")
42 | #font(YF,WF,WF)
43 | #txt[%T_ROOM](%B[x:105,y:%<? player.account ? "L_ACCOUNT" : "L_CTIME" ?>+6,w:100%-120,h:24],{},<? room.title | arg ?>)
44 | #btn(%B[x:105,y:%T_ROOM,w:44,h:28],{GW|open&join_game.dcml&ASTATE=<%ASTATE>^VE_RID=<? room.id ?>^BACKTO=user_details},"join")
45 | #btn(%B[x:105+44+2,y:%T_ROOM,w:44,h:28],{GW|open&room_info_dgl.dcml&ASTATE=<%ASTATE>^VE_RID=<? room.id ?>^BACKTO=user_details},"info")
46 | <? END ?>
47 | 
48 | #font(YF,WF,RF)
49 | #sbtn[%B_RGST](%B[xc:50%,y:100%+8,w:160,h:24],{LW_file&Internet/Cash/cancel.cml},"Close")
50 | <NGDLG>
51 | 


--------------------------------------------------------------------------------
/share/cs/enter.cml:
--------------------------------------------------------------------------------
 1 | #ebox[%BOX](x:100,y:140,w:350,h:<? logged_in ? 80 : !type ? 100 : error ? 158 : 145 ?>)
 2 | #pan[%MPN](%BOX[x:0,y:0,w:100%,h:100%],8)
 3 | 
 4 | #font(WF,WF,WF)
 5 | #ctxt[%TIT](%BOX[x:0,y:6,w:100%,h:30],{},"cossacks-server.net")
 6 | 
 7 | <? IF logged_in ?>
 8 |   #font(WF,WF,WF)
 9 |   #txt(%BOX[x:10,y:47,w:100%,h:24],{},"<? nick ?>")
10 |   #btn(%BOX[x:100%-90,y:45,w:80,h:28],{GW|open&try_enter.dcml&RESET=1},"logout")
11 | <? ELSE ?>
12 |   <? IF !type ?>
13 |   #font(WF,WF,WF)
14 |   #txt(%BOX[x:10,y:52,w:100%,h:24],{},"Your nick:")
15 |   #font(YF,YF,WF)
16 |   #pan[%P_NICK](%BOX[x:100,x1:100%-10,y:50,h:24],4)
17 |   #edit(%BOX[x:100,x1:100%-10,y:48,h:24],{%GV_LCN_NICK})
18 |   <? ELSE ?>
19 |   #font(YF,WF,BF)
20 |   #txt(%BOX[x:10,y:39,w:100%,h:24],{},"Logon with")
21 |   #font(WF,WF,BF)
22 |   #apan(%BOX[x:81-3,y:38,w:<? type == 'LCN' ? 73 : 68 ?>,h:20],{GW|url&<? type == 'LCN' ? 'http://www.newlcn.com/lang_redir.php' : 'http://wcl.com.ua/' ?>&from=enter},14)
23 |   #txt(%BOX[x:81,y:39,w:100%,h:24],{},"<? type == 'LCN' ? 'newlcn.com' : 'wcl.com.ua' ?>")
24 |   #font(YF,WF,BF)
25 |   #txt(%BOX[x:<? type == 'LCN' ? 153 : 148 ?>,y:39,w:100%,h:24],{},"account:")
26 |   
27 |   #font(WF,WF,WF)
28 |   #txt(%BOX[x:10,y:62,w:100%,h:24],{},"Login")
29 |   #font(YF,YF,WF)
30 |   #pan[%P_NICK](%BOX[x:100,x1:100%-10,y:60,h:24],4)
31 |   #edit(%BOX[x:100,x1:100%-10,y:58,h:24],{%GV_LCN_NICK})
32 |   
33 |   #font(WF,WF,WF)
34 |   #txt(%BOX[x:10,y:93,w:100%,h:24],{},"Password")
35 |   #font(YF,YF,WF)
36 |   #pan[%P_NICK](%BOX[x:100,x1:100%-10,y:89,h:24],4)
37 |   #edit(%BOX[x:100,x1:100%-10,y:87,h:24],{%PASSWORD})
38 |   
39 |   <? IF error ?>
40 |   #font(SYF,SWF,SWF)
41 |   #txt(%BOX[x:10,y:116,w:100%,h:24],{},"error: <? error ?>")
42 |   <? END ?>
43 |   <? END ?>
44 |   
45 |   <? IF !type ?>
46 |   #font(SYF,SYF,SWF)
47 |   //#txt(%BOX[x:100%-135,w:80,y:100%-23+2,h:24],{},"logon with:")
48 |   //#apan(%BOX[x:100%-73,w:29,y:100%-23,h:18],{GW|open&enter.dcml&TYPE=LCN},1)
49 |   //#txt(%BOX[x:100%-69,w:30,y:100%-23+2,h:24],{},"LCN")
50 |   //#apan(%BOX[x:100%-40,w:29,y:100%-23,h:18],{GW|open&enter.dcml&TYPE=WCL},1)
51 |   //#txt(%BOX[x:100%-37,w:30,y:100%-23+2,h:24],{},"WCL")
52 |   <? ELSE ?>
53 |   #font(SYF,SYF,SWF)
54 |   #apan(%BOX[x:5,w:108,y:100%-23,h:18],{GW|open&enter.dcml},1)
55 |   #txt(%BOX[x:8,w:100,y:100%-23+2,h:24],{},"< anonymus logon")
56 |   
57 |   #txt(%BOX[x:100%-102,w:80,y:100%-23+2,h:24],{},"login with:")
58 |   #apan(%BOX[x:100%-40,w:29,y:100%-23,h:18],{GW|open&enter.dcml&TYPE=<? type == 'LCN' ? 'WCL' : 'LCN' ?>},1)
59 |   #txt(%BOX[x:100%-37,w:30,y:100%-23+2,h:24],{},"<? type == 'LCN' ? 'WCL' : 'LCN' ?>")
60 |   <? END ?>
61 | <? END ?>
62 | 
63 | //#font(WF,WF,WF)
64 | //#chk(%BOX[x:10,x1:100%,y:%P_NICK+10,h:10],{},"remember",1,0,0)
65 | 
66 | #font(YF,WF,RF)
67 | 
68 | #exec(LW_gvar&%HEIGHT&Internet/Cash/height.dat)
69 | #sbtn[%B_RGST](%BOX[x:0,y:100%+8,w:160,h:24],{GW|go&try_enter&NICK=<%GV_LCN_NICK>&TYPE=<? type ?>&PASSWORD=<%PASSWORD>&LOGGED_IN=<? logged_in ?>&HEIGHT:=&<@%HEIGHT>|LW_lockall},"Enter")
70 | #sbtn[%B_RGST](%BOX[x:185,y:100%+8,w:160,h:24],{LW_key&#CANCEL|LW_lockall},"Cancel")
71 | 


--------------------------------------------------------------------------------
/share/cs/room_info_dgl.cml:
--------------------------------------------------------------------------------
 1 | <NGDLG>
 2 | <? USE CMLStringArgFilter ?>
 3 | <? USE date ?>
 4 | //#exec(LW_visbox&0&%LBX)
 5 | #exec(LW_lockbox&%LBX)
 6 | #exec(LW_enb&0&%RMLST)
 7 | #font(WF,WF,YF)
 8 | 
 9 | #ebox[%L](x:180,y:30,w:100%-380,h:260)
10 | #ebox[%E](x:180,y:24,w:100%-380,h:30)
11 | #pan[%MPN](%L[x:0,y:0,w:100%,h:100%],8)
12 | #ctxt[%TIT](%E[x:0,y:12,w:100%,h:10],{},"Game info")
13 | <? IF h.connection.data.dev ?>
14 | #rtxt(%E[x:320,y:12,w:50,h:10],{},<? "#" _ room.id | arg ?>)
15 | <? END ?>
16 | 
17 | #font(WF,YF,WF)
18 | #txt[%L_NAME](%L[x:20,y:44,w:100,h:24],{},"Game title")
19 | #font(YF,WF,WF)
20 | #txt[%T_NAME](%L[x:100,y:44,w:100%-120,h:24],{},<? room.title | arg ?>)
21 | 
22 | #font(WF,YF,WF)
23 | #txt[%L_HOST](%L[x:20,y:%T_NAME+6,w:100,h:24],{},"Host")
24 | #font(YF,WF,WF)
25 | #txt[%T_HOST](%L[x:100,y:%T_NAME+6,w:100%-120,h:24],{},<? room.players.${room.host_id}.nick | arg ?>)
26 | 
27 | //#font(WF,YF,WF)
28 | //#txt[%L_PING](%L[x:20,y:%T_HOST+6,w:100,h:24],{},"Ping")
29 | //#font(YF,WF,WF)
30 | //#ping[%T_PING](%L[x:100,y:%T_HOST+6,w:100%-120,h:24],<? room.host_addr_int | arg ?>)
31 | 
32 | #font(WF,YF,WF)
33 | #txt[%L_PLAYERS](%L[x:20,y:%T_HOST+6,w:100,h:24],{},"Players")
34 | #font(YF,BF,BF)
35 | #txt[%T_PLAYERS](%L[x:100,y:%T_HOST+6,w:100%-120,h:24],{},<? FILTER arg ~?>
36 | <?~ IF !room.started ~?><?~ (room.start_players_count || room.players_count)_ "/" _ room.max_players ~?><? END ?>
37 | <?~ FOREACH player_id IN room.players_time.nsort ~?>
38 | <?~ IF room.players.$player_id.exited ~?>
39 |   <?~ SET has_exited_players = 1 ~?>
40 | <?~ ELSE ~?>
41 |   <?~ IF !continue_players; SET continue_players = 1 ?> <? ELSE ?>, <? END ~?>
42 |   <?~ room.players.$player_id.nick ~?>
43 | <?~ END ~?>
44 | <?~ END ~?>
45 | <?~ IF room.ai ?> + AI<? END ~?>
46 | <?~ END ~?>
47 | )
48 | 
49 | <? IF has_exited_players ~?>
50 | #font(WF,YF,WF)
51 | #txt[%L_EXPLAYERS](%L[x:20,y:%T_PLAYERS+6,w:100,h:24],{},"Exited")
52 | #font(YF,BF,BF)
53 | #txt[%T_EXPLAYERS](%L[x:100,y:%T_PLAYERS+6,w:100%-120,h:24],{},<? FILTER arg ~?>
54 | <?~ FOREACH player_id IN room.players_time.nsort ~?>
55 | <?~ IF room.players.$player_id.exited ~?>
56 |   <?~ IF !continue_explayers; SET continue_explayers = 1 ?> <? ELSE ?>, <? END ~?>
57 |   <?~ room.players.$player_id.nick ~?>
58 | <?~ END ~?>
59 | <?~ END ~?>
60 | <?~ END ~?>
61 | )
62 | <? END ~?>
63 | 
64 | #font(WF,YF,WF)
65 | #txt[%L_LEVEL](%L[x:20,y:%T_<? IF has_exited_players ?>EX<? END ?>PLAYERS+6,w:100,h:24],{},"Level")
66 | #font(YF,WF,WF)
67 | #txt[%T_LEVEL](%L[x:100,y:%T_<? IF has_exited_players ?>EX<? END ?>PLAYERS+6,w:100%-120,h:24],{},<? 
68 |   room.level == 3 ? "Hard" :
69 |   room.level == 2 ? "Normal" :
70 |   room.level == 1 ? "Easy" :
71 |   "For all"
72 |   | arg 
73 | ?>)
74 | 
75 | #font(WF,YF,WF)
76 | #txt[%L_CTIME](%L[x:20,y:%T_LEVEL+6,w:100,h:24],{},"<? room.started ? "Started at" : "Created at" ?>")
77 | #font(YF,WF,WF)
78 | #txt[%T_CTIME](%L[x:100,y:%T_LEVEL+6,w:100%-120,h:24],{},<? date.format(room.ctime, format => '%Y-%m-%d %H:%M:%S UTC', gmt => 1) _ " (" _ room_time _ ( room.started ? "" : " ago") _ ")" | arg ?>)
79 | 
80 | <? IF room.passwd != '' ?>
81 | GW|#font(WF,YF,WF)
82 | #txt[%L_PASSWD](%L[x:20,y:%T_CTIME+6,w:100,h:24],{},"Password")
83 | #font(YF,WF,WF)
84 | #txt[%T_PASSWD](%L[x:100,y:%T_CTIME+6,w:100%-120,h:24],{},"yes")
85 | <? END ?>
86 | 
87 | #font(YF,WF,YF)
88 | 
89 | <? IF room.started ?>
90 | #sbtn[%B_RGST](%L[x:135,y:100%+5,w:100,h:24],{<? IF backto ?>GW|<? backto ?><? ELSE ?>LW_file&Internet/Cash/cancel.cml<? END ?>},"Cancel")
91 | <? ELSE ?>
92 | #sbtn[%B_RGST](%L[x:43,y:100%+5,w:100,h:24],{GW|open&join_game.dcml&ASTATE=<%ASTATE>^VE_RID=<? room.id | cmd ?>},"Join")
93 | #sbtn[%B_RGST](%L[x:230,y:100%+5,w:100,h:24],{<? IF backto ?>GW|<? backto ?><? ELSE ?>LW_file&Internet/Cash/cancel.cml<? END ?>},"Cancel")
94 | <? END ?>
95 | <NGDLG>
96 | 


--------------------------------------------------------------------------------
/script/cossacks-proxy:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/perl
  2 | use strict;
  3 | use warnings;
  4 | use AnyEvent::Socket;
  5 | use AnyEvent::Log;
  6 | use Getopt::Long::Descriptive v0.097;
  7 | use GSC::Stream;
  8 | 
  9 | # Прокси для безболезненного перезда сервера с одного ip на другой, на время смены DNS
 10 | # ToDo: разобрастя с разрывом и штатным закрытием соединения
 11 | 
 12 | my ($opt, $usage) = describe_options(
 13 |   'cossacks-proxy %o',
 14 |   ['from|f=s', 'Listen ip:port', { required => 1,  }],
 15 |   ['to|t=s', 'Connect to host:port', { required => 1 }],
 16 |   ['max-request-size|s', 'Max request size'],
 17 |   ['log-level|l=s', 'Log level', { default => 'info' }],
 18 |   ['help|h', 'Print help message', { shortcircuit => 1 }],
 19 | );
 20 | 
 21 | if($opt->help) {
 22 |   print $usage . "        \$CSPKEY       Key for connect to cossacks server\n";
 23 |   exit;
 24 | }
 25 | 
 26 | my($from_host, $from_port) = $opt->from =~ /^(\d+\.\d+\.\d+\.\d+):(\d+)$/ or $usage->die({
 27 |   pre_text => "Value \"" . $opt->from() . "\" invalid for option from (ip:port expected)\n"
 28 | });
 29 | 
 30 | my($to_host, $to_port) = $opt->to =~ /(.+):(\d+)$/ or $usage->die({
 31 |   pre_text => "Value \"" . $opt->from() . "\" invalid for option from (host:port expected)\n"
 32 | });
 33 | 
 34 | unless(exists $ENV{CSPKEY}) {
 35 |   die "CSPKEY env variable is unset\n";
 36 | }
 37 | my $key = $ENV{CSPKEY};
 38 | 
 39 | if($opt->log_level) {
 40 |   my @avalible = qw/fatal alert crit error warn note info debug trace/;
 41 |   grep {$opt->log_level eq $_} @avalible or $usage->die({
 42 |     pre_text => "Value \"" . $opt->log_level() . "\" invalid for option from (" . join(", ", @avalible[0..$#avalible-1]). " or $avalible[-1] expected)\n"
 43 |   });
 44 | }
 45 | 
 46 | $AnyEvent::Log::FILTER->level($opt->log_level);
 47 | my $debug = 1 if $opt->log_level eq 'debug';
 48 | my $buf_max_size = 4096;
 49 | 
 50 | tcp_server $from_host, $from_port, sub {
 51 |   my($client_fh, $ip, $port) = @_;
 52 |   AE::log info => "$ip:$port connected";
 53 | 
 54 |   tcp_connect $to_host, $to_port, sub {
 55 |     my($connection_fh) = @_ or do {
 56 |       AE::log error => "can't connect to server $to_host:$to_port: $!";
 57 |       return;
 58 |     };
 59 | 
 60 |     AE::log debug => "$ip:$port proxy connected to server" if $debug;
 61 | 
 62 |     my $up_proxy_cb;
 63 |     my $raw = GSC::Stream->new(1, 0, 0, proxy => [$ip, $port, $key, '', ''])->bin;
 64 | 
 65 |     my $w; $w = AE::io $connection_fh, 1, sub {
 66 |       my $r = syswrite $connection_fh, $raw, length($raw);
 67 |       substr($raw, 0, $r) = '' if $r;
 68 |       if(defined $r) {
 69 |         AE::log debug => "write \"proxy\" command $r" if $debug;
 70 |         if(length $raw == 0) {
 71 |           undef $w;
 72 |           $up_proxy_cb->();
 73 |         }
 74 |       } else {
 75 |         AE::log error => "$ip:$port write server connection error: $!";
 76 |         undef $w;
 77 |         close $client_fh;
 78 |       }
 79 |     };
 80 | 
 81 |     $up_proxy_cb = sub {
 82 |       my($wclr, $wcnw, $wcnr, $wclw);
 83 |       my $client_buf = '';
 84 |       my $finish_client_sending;
 85 |       my($client_read_cb, $connection_write_cb);
 86 | 
 87 |       $client_read_cb = sub {
 88 |         my $r = sysread $client_fh, $client_buf, $buf_max_size;
 89 |         undef $wclr;
 90 |         if($r) {
 91 |           AE::log debug => "r $ip:$port client > proxy $r" if $debug;
 92 |           $wcnw = AE::io $connection_fh, 1, $connection_write_cb;  
 93 |         } else {
 94 |           $finish_client_sending = 1;
 95 |           if(defined $r) {
 96 |             AE::log info => "$ip:$port disconnected";
 97 |           } else {
 98 |             AE::log error => "$ip:$port read client connection error: $!";
 99 |           }
100 |           close $connection_fh;
101 |           undef $wcnr;
102 |         }
103 |       };
104 | 
105 |       $connection_write_cb = sub {
106 |         my $r = syswrite $connection_fh, $client_buf, length($client_buf);
107 |         substr($client_buf, 0, $r) = '' if $r;
108 |         if(defined $r) {
109 |           AE::log debug => "w $ip:$port proxy > server $r" if $debug && defined $r;
110 |           if(length $client_buf == 0) {
111 |             undef $wcnw;
112 |             if(!$finish_client_sending) {
113 |               $wclr = AE::io $client_fh, 0, $client_read_cb;
114 |             } else {
115 |               close $connection_fh;
116 |             }
117 |           }
118 |         } else {
119 |           AE::log error => "$ip:$port write server connection error: $!";
120 |           undef $wcnw;
121 |           close $client_fh;
122 |         }
123 |       };
124 | 
125 |       $wclr = AE::io $client_fh, 0, $client_read_cb;
126 | 
127 |       my $connection_buf = '';
128 |       my $finish_connection_sending;
129 |       my($connection_read_cb, $client_write_cb);
130 | 
131 |       $connection_read_cb = sub {
132 |         my $r = sysread $connection_fh, $connection_buf, $buf_max_size;
133 |         undef $wcnr;
134 |         if($r) {
135 |           AE::log debug => "r $ip:$port proxy < server $r" if $debug;
136 |           $wclw = AE::io $client_fh, 1, $client_write_cb;  
137 |         } else {
138 |           $finish_connection_sending = 1;
139 |           if(defined $r) {
140 |             AE::log info => "$ip:$port server close connection";
141 |           } else {
142 |             AE::log error => "$ip:$port read server connection error: $!";
143 |           }
144 |           close $client_fh;
145 |           undef $wclr;
146 |         }
147 |       };
148 | 
149 |       $client_write_cb = sub {
150 |         my $r = syswrite $client_fh, $connection_buf, length($connection_buf);
151 |         substr($connection_buf, 0, $r) = '' if $r;
152 |         if(defined $r) {
153 |           AE::log debug => "w $ip:$port client < proxy $r" if $debug && defined $r;
154 |           if(length $connection_buf == 0) {
155 |             undef $wclw;
156 |             if(!$finish_connection_sending) {
157 |               $wcnr = AE::io $connection_fh, 0, $connection_read_cb;
158 |             } else {
159 |               close $client_fh;
160 |             }
161 |           }
162 |         } else {
163 |           AE::log error => "$ip:$port write client connection error: $!";
164 |           undef $wclw;
165 |           close $connection_fh;
166 |         }
167 |       };
168 | 
169 |       $wcnr = AE::io $connection_fh, 0, $connection_read_cb;
170 |     }
171 |   };
172 | 
173 | }, sub {
174 |   AE::log notice => "listen $from_host:$from_port";
175 | };
176 | 
177 | AE::cv->recv();
178 | 


--------------------------------------------------------------------------------
/share/cs/started_room_info.cml:
--------------------------------------------------------------------------------
  1 | <? USE date ~?>
  2 | <? USE Math ~?>
  3 | <? USE CMLStringArgFilter ~?>
  4 | #resize(LW_cfile&<#WinH#>&height.dat|LW_show&<\52ESIZE>
  5 | #exec(GW\7Copen\26resize\26height=<#WinH#>\29
  6 | <\52ESIZE>)
  7 | 
  8 | <? IF h.connection.data.dev ?>
  9 | #ebox[%EBX](x:+0,y:+0,w:100%,h:100%)
 10 | #font(YF,YF,YF)
 11 | #txt(%EBX[x:38,y:130,w:100,h:20],{},"#<? room.id ?>")
 12 | <? END ?>
 13 | 
 14 | #sbox[%LBX](x:0,y:0,w:100%,h:100%)
 15 | #font(BYF,BYF,BYF)
 16 | #txt(%LBX[x:6,y:3,w:100%,h:40],{},<? room.title | arg ?>)
 17 | #font(YF,YF,YF)
 18 | #apan(%LBX[x:667,y:4,w:70,h:28],{GW|go&startup},12)
 19 | #ctxt(%LBX[x:667,y:9,w:70,h:28],{},"< games")
 20 | 
 21 | <? offsety = 32 ?>
 22 | #font(YF,YF,YF)
 23 | #txt(%LBX[x:6,y:<? offsety + 9 ?>,w:100%,h:40],{},"time: <? room_time ?> [<? room.time / 25 | format("%.0f") ?>t]")
 24 | #pan(%LBX[x:158,y:<? offsety + 10 ?>,w:1,h:15],2)
 25 | #txt(%LBX[x:168,y:<? offsety + 9 ?>,w:100,h:40],{},"level: <? room.level == 3 ? "hard" : room.level == 2 ? "normal" : room.level == 1 ? "easy" : "for all" ?>")
 26 | 
 27 | <? SET offsetx = 0 ~?>
 28 | <? SET offsety = 0 ~?>
 29 | <? SET table.width.smallcol = 36 ~?>
 30 | 
 31 | <? SET table.top = 81 ~?>
 32 | <? SET table.left = 6 ~?>
 33 | <? SET table.width.nick = 138 ~?>
 34 | <? SET table.width.nation = 78 ~?>
 35 | <? SET table.width.score = 45 ~?>
 36 | <? SET table.width.population = 42 ~?>
 37 | <? SET table.width.smallcol = page == 1 ? (res ? 43 : 49) : ( page == 2 ? (res ? 57 : 66) : 51 ) ~?>
 38 | <? SET table.width.largecol = page == 1 ? 54 : 61 ~?>
 39 | <? SET table.row_height = 22 ~?>
 40 | 
 41 | <? SET offsety = table.top ~?>
 42 | #font(SYF,SYF,SYF)
 43 | <? offsetx = table.left ~?>
 44 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.nick - 1 + 22 * 2  ?>],0)
 45 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.nick - 1 + 22 * 2  ?>],{},"player")
 46 | <? offsetx = offsetx + table.width.nick - 1 + 21 * 2 ~?>
 47 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.nation ?>],0)
 48 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.nation ?>],{},"nation")
 49 | <? offsetx = offsetx + table.width.nation - 1 ~?>
 50 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.score ?>],0)
 51 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.score ?>],{},"score")
 52 | <? offsetx = offsetx + table.width.score - 1 ~?>
 53 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.population ?>],0)
 54 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.population ?>],{},"popul")
 55 | <? offsetx = offsetx + table.width.population - 1 ~?>
 56 | 
 57 | <? SET count = 0 ?>
 58 | <?~ FOREACH player IN room.started_players ~?>
 59 | <? offsetx = table.left ~?>
 60 | #font(YF,YF,YF)
 61 | #pan(%LBX[x:<? offsetx ?>,y:<? offsety ?>,w:<? table.width.nick ?>,h:<? table.row_height ?>],5)
 62 | <? IF player.exited ?>#font(RF,RF,RF)<? END ?>
 63 | #txt(%LBX[x:<? offsetx + 3 ?>,y:<? offsety + 3 ?>,w:<? table.width.nick - 2 ?>,h:<? table.row_height ?>],{},<? player.nick | arg ?>)
 64 | #font(YF,YF,YF)
 65 | <? offsetx = offsetx + table.width.nick - 1 ~?>
 66 | #pan(%LBX[x:<? offsetx ?>,y:<? offsety ?>,w:22,h:<? table.row_height ?>],0)
 67 | #pix(%LBX[x:<? offsetx + 2 ?>,y:<? offsety + 2 ?>,w:18,h:18],{},Internet/pix/squares,<? player.color ?>,<? player.color ?>,<? player.color ?>,<? player.color ?>)
 68 | <? offsetx = offsetx + 22 - 1 ~?>
 69 | #pan(%LBX[x:<? offsetx ?>,y:<? offsety ?>,w:22,h:<? table.row_height ?>],0)
 70 | #ctxt(%LBX[x:<? offsetx + 2 ?>,y:<? offsety + 3 ?>,w:18,h:<? table.row_height ?>],{},<? player.theam || 'x' ?>)
 71 | <? offsetx = offsetx + 22 - 1 ~?>
 72 | #font(SYF,SYF,SYF)
 73 | #pan(%LBX[x:<? offsetx ?>,y:<? offsety ?>,w:<? table.width.nation ?>,h:<? table.row_height ?>],5)
 74 | #txt(%LBX[x:<? offsetx + 6 ?>,y:<? offsety + 3 ?>,w:<? table.width.nation ?>,h:<? table.row_height ?>],{},"<? nations.${player.nation} ?>")
 75 | <? offsetx = offsetx + table.width.nation - 1 ~?>
 76 | #pan(%LBX[x:<? offsetx ?>,y:<? offsety ?>,w:<? table.width.score ?>,h:<? table.row_height ?>],5)
 77 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.score ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.real_scores ?><? player.stat.real_scores ?><? ELSE ?>-<? END ?>")
 78 | <? offsetx = offsetx + table.width.score - 1 ~?>
 79 | #pan(%LBX[x:<? offsetx ?>,y:<? offsety ?>,w:<? table.width.population ?>,h:<? table.row_height ?>],5)
 80 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.population ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.population ?><? player.stat.population ?><? ELSE ?>-<? END ?>")
 81 | <? offsetx = offsetx + table.width.population - 1 ~?>
 82 | <? offsety = offsety + table.row_height - (loop.first ? 1 : 0) ~?>
 83 | <?~ END ~?>
 84 | 
 85 | <? INCLUDE cs/started_room_info/statcols.cml ~?>
 86 | 
 87 | #font(SWF,SWF,SWF)
 88 | #txt(%LBX[x:6,y:<? offsety + 1 ?>,w:100%,h:40],{},"+")
 89 | #font(SYF,SYF,SYF)
 90 | #txt(%LBX[x:18,y:<? offsety + 1 ?>,w:100%,h:40],{}," - speed of resource maining")
 91 | #font(SWF,SWF,SWF)
 92 | #txt(%LBX[x:177,y:<? offsety + 2 ?>,w:100%,h:40],{},"*")
 93 | #font(SYF,SYF,SYF)
 94 | #txt(%LBX[x:187,y:<? offsety + 1?>,w:100%,h:40],{}," - total resouce mained")
 95 | #font(SWF,SWF,SWF)
 96 | //#txt(%LBX[x:316,y:<? offsety + 1 ?>,w:100%,h:40],{},"()")
 97 | //#font(SYF,SYF,SYF)
 98 | //#txt(%LBX[x:326,y:<? offsety + 1 ?>,w:100%,h:40],{}," - random nation")
 99 | //#font(SRF,SWF,SWF)
100 | //#rtxt(%LBX[x:422,y:<? offsety + 3 ?>,w:318,h:20],{},"unsynchronization: VoinVerta1, VoinVetra2, VoinVetra3")
101 | //#font(SWF,SWF,SWF)
102 | //#rtxt(%LBX[x:420,y:<? offsety + 1 ?>,w:318,h:20],{},"unsynchronization: VoinVerta1, VoinVetra2, VoinVetra3")
103 | <? # 
104 | #font(YF,YF,YF)
105 | #chk(%LBX[x:622,y:<? offsety + 2 ?>,w:20,h:20],{%WATCH}{},"watch changes",1,0,0)
106 | -?>
107 | 
108 | <? offsetx = 613 ?>
109 | <? SET line_height = 18 ?>
110 | <? offsety = offsety + 26 ~?> <? # 22 ?>
111 | #font(YF,YF,YF)
112 | #pan(%LBX[x:4,y:<? offsety ?>,w:100%-8,h:2],2)
113 | <? offsety = offsety + 8 ?>
114 | #txt(%LBX[x:6,y:<? offsety ?>,w:100%,h:20],{},<? "Map: " _ room.map | arg ?>)
115 | 
116 | //<? offsety = offsety + 20 ?>
117 | //<? offsety2 = offsety ~?>
118 | //#txt(%LBX[x:20,y:<? offsety ?>,w:100%,h:20],{},"size: x1")
119 | //#txt(%LBX[x:170,y:<? offsety ?>,w:100%,h:20],{},"start options: army of peasents")
120 | //<? offsety = offsety + line_height ?>
121 | //#txt(%LBX[x:20,y:<? offsety ?>,w:100%,h:20],{},"landscape: land")
122 | //#txt(%LBX[x:170,y:<? offsety ?>,w:100%,h:20],{},"ballon: immediate")
123 | //<? offsety = offsety + line_height ?>
124 | //#txt(%LBX[x:20,y:<? offsety ?>,w:100%,h:20],{},"resources: millions")
125 | //#txt(%LBX[x:170,y:<? offsety ?>,w:100%,h:20],{},"cannons: no")
126 | //<? offsety = offsety + line_height ?>
127 | //#txt(%LBX[x:20,y:<? offsety ?>,w:100%,h:20],{},"minerals: rich")
128 | //#txt(%LBX[x:170,y:<? offsety ?>,w:100%,h:20],{},"peace time: no")
129 | //<? offsety = offsety + line_height ?>
130 | //#txt(%LBX[x:170,y:<? offsety ?>,w:100%,h:20],{},"18th centry: immediate")
131 | //<? offsety = offsety + line_height ?>
132 | //#txt(%LBX[x:170,y:<? offsety ?>,w:100%,h:20],{},"capture: default")
133 | //<? offsety = offsety + line_height ?>
134 | //#txt(%LBX[x:170,y:<? offsety ?>,w:100%,h:20],{},"autosave: 2 min")
135 | //<? offsety = offsety + line_height ?>
136 | 
137 | //#pix(%LBX[x:400,y:<? offsety2 - 2 ?>,w:5,h:5],{},Internet/pix/squares,1,1,1,1)
138 | //#txt(%LBX[x:422,y:<? offsety2 ?>,w:100%,h:20],{},"Bavaria")
139 | //<? offsety2 = offsety2 + line_height ?>
140 | //#pix(%LBX[x:400,y:<? offsety2 - 2 ?>,w:18,h:18],{},Internet/pix/squares,0,0,0,0)
141 | //#txt(%LBX[x:422,y:<? offsety2 ?>,w:100%,h:20],{},"Denmark")
142 | //<? offsety2 = offsety2 + line_height ?>
143 | //#pix(%LBX[x:400,y:<? offsety2 - 2 ?>,w:18,h:18],{},Internet/pix/squares,2,2,2,2)
144 | //#txt(%LBX[x:422,y:<? offsety2 ?>,w:100%,h:20],{},"Ukraine")
145 | //<? offsety2 = offsety2 + line_height ?>
146 | //#pix(%LBX[x:400,y:<? offsety2 - 2 ?>,w:18,h:18],{},Internet/pix/squares,3,3,3,3)
147 | //#txt(%LBX[x:422,y:<? offsety2 ?>,w:100%,h:20],{},"Russia")
148 | //<? offsety2 = offsety2 + line_height ?>
149 | //#pix(%LBX[x:400,y:<? offsety2 - 2 ?>,w:18,h:18],{},Internet/pix/squares,4,4,4,4)
150 | //#txt(%LBX[x:422,y:<? offsety2 ?>,w:100%,h:20],{},"Russia")
151 | //<? offsety2 = offsety2 + line_height ?>
152 | //#pix(%LBX[x:400,y:<? offsety2 - 2 ?>,w:18,h:18],{},Internet/pix/squares,5,5,5,5)
153 | //#txt(%LBX[x:422,y:<? offsety2 ?>,w:100%,h:20],{},"Russia")
154 | //<? offsety2 = offsety2 + line_height ?>
155 | //#cpix(%LBX[x:400,y:<? offsety2 - 2 ?>,w:18,h:18],{},Internet/pix/squares,6,6,6,6)
156 | //#txt(%LBX[x:422,y:<? offsety2 ?>,w:100%,h:20],{},"Russia")
157 | //<? offsety2 = offsety2 + line_height ?>
158 | 
159 | <NGDLG>
160 | <NGDLG>
161 | 


--------------------------------------------------------------------------------
/lib/SimpleCossacksServer.pm:
--------------------------------------------------------------------------------
  1 | package SimpleCossacksServer;
  2 | our $VERSION = '0.01';
  3 | use Mouse;
  4 | use SimpleCossacksServer::CommandController;
  5 | use SimpleCossacksServer::ConnectionController;
  6 | use SimpleCossacksServer::Handler;
  7 | use SimpleCossacksServer::Connection;
  8 | use feature 'state';
  9 | use Template;
 10 | use Config::Simple;
 11 | use POSIX();
 12 | use JSON();
 13 | use AnyEvent::HTTP();
 14 | use AnyEvent::IO;
 15 | extends 'GSC::Server';
 16 | has template_engine => (is => 'rw');
 17 | has config_file => (is => 'ro');
 18 | has connection_controller => (is => 'ro', default => sub { SimpleCossacksServer::ConnectionController->new() });
 19 | has log_level => (is => 'rw');
 20 | has config => (is => 'rw', builder => '_build_config');
 21 | has host => (is => 'ro', default => sub { shift->config->{host} // 'localhost' });
 22 | has port => (is => 'ro', default => sub { shift->config->{port} // 34001 });
 23 | has log_access_ctx => (is => 'rw', builder => '_build_log_access_ctx');
 24 | has log_error_ctx => (is => 'rw', builder => '_build_log_error_ctx');
 25 | has _export_rooms_timer => (is => 'rw');
 26 | 
 27 | sub command_controller { 'SimpleCossacksServer::CommandController' }
 28 | sub handler_class { 'SimpleCossacksServer::Handler' }
 29 | sub connection_class { 'SimpleCossacksServer::Connection' }
 30 | 
 31 | sub init {
 32 |   my($self) = @_;
 33 | 
 34 |   $self->data->{last_player_id} = 0;
 35 |   $self->data->{dbtbl} = {};
 36 |   $self->data->{rooms_by_ctlsum} = {};
 37 |   $self->data->{rooms_by_player} = {};
 38 |   $self->template_engine( Template->new(
 39 |     INCLUDE_PATH => $self->config->{templates},
 40 |     CACHE_SIZE   => 64,
 41 |     START_TAG    => '<\?',
 42 |     END_TAG      => '\?>',
 43 |     PLUGINS => {
 44 |         CMDFilter => 'SimpleCossacksServer::Template::Plugin::CMDFilter',
 45 |         CMLStringArgFilter => 'SimpleCossacksServer::Template::Plugin::CMLStringArgFilter',
 46 |     },
 47 |   ) );
 48 | 
 49 |   # AnyEvent::Log
 50 |   $AnyEvent::Log::LOG->log_cb(sub { print STDERR shift; 0 });
 51 | 
 52 |   $self->load_lcn_ranking();
 53 | }
 54 | 
 55 | sub _build_log_error_ctx {
 56 |   my($self) = @_;
 57 |   if($self->config->{error_log}) {
 58 |     my $errorCtx = AnyEvent::Log::Ctx->new(
 59 |       level => "warn",
 60 |       log_to_file => $self->config->{error_log},
 61 |     );
 62 |     $AnyEvent::Log::COLLECT->attach($errorCtx);
 63 |     return $errorCtx;
 64 |   } else {
 65 |     return undef;
 66 |   }
 67 | }
 68 | 
 69 | sub _build_log_access_ctx {
 70 |   my($self) = @_;
 71 |   my $ctx = AnyEvent::Log::ctx($self->meta->name);
 72 |   if($self->config->{access_log}) {
 73 |     my $infoCtx = AnyEvent::Log::Ctx->new(
 74 |       levels => "info",
 75 |       log_to_file => $self->config->{access_log},
 76 |     );
 77 |     $infoCtx->fmt_cb(sub {
 78 |       my($time, $ctx, $level, $message) = @_;
 79 |       return "[" . POSIX::strftime("%Y-%m-%d/%H:%M:%S", localtime $time) . sprintf(".%03d", ($time - int $time)*1000 ) . "] " . $message . "\n";
 80 |     });
 81 |     $ctx->attach($infoCtx);
 82 |     return $infoCtx;
 83 |   } else {
 84 |     return undef;
 85 |   }
 86 | }
 87 | 
 88 | sub start {
 89 |   my $self = shift;
 90 |   local $ENV{TZ} = 'UTC';
 91 |   $self->data->{start_at} = POSIX::strftime "%Y-%m-%d %H:%M %Z", localtime time;
 92 |   if($self->config->{export_rooms_time} && $self->config->{export_rooms_file}) {
 93 |     my $w = AE::timer $self->config->{export_rooms_time}, $self->config->{export_rooms_time}, sub {$self->export_rooms() };
 94 |     $self->_export_rooms_timer($w);
 95 |   }
 96 |   $self->SUPER::start(@_);
 97 | }
 98 | 
 99 | sub reload {
100 |   my $self = shift;
101 |   $self->log->notice('reset server');
102 | 
103 |   $self->reload_config;
104 |   if($self->data->{start_at} && $self->config->{export_rooms_time} && $self->config->{export_rooms_file}) {
105 |     my $w = AE::timer $self->config->{export_rooms_time}, $self->config->{export_rooms_time}, sub { $self->export_rooms() };
106 |     $self->_export_rooms_timer($w);
107 |   }
108 | 
109 |   if($self->config->{access_log}) {
110 |     if($self->log_access_ctx) {
111 |       $self->log_access_ctx->log_to_file( $self->config->{access_log} );
112 |     } else {
113 |       $self->log_access_ctx( $self->_build_log_access_ctx );
114 |     }
115 |   } else {
116 |     if($self->log_access_ctx) {
117 |       AnyEvent::Log::ctx($self->meta->name)->detach($self->log_access_ctx);
118 |       $self->log_access_ctx(undef);
119 |     }
120 |   }
121 | 
122 |   if($self->config->{error_log}) {
123 |     if($self->log_error_ctx) {
124 |       $self->log_error_ctx->log_to_file( $self->config->{error_log} );
125 |     } else {
126 |       $self->log_error_ctx( $self->_build_log_error_ctx );
127 |     }
128 |   } else {
129 |     if($self->log_error_ctx) {
130 |       $AnyEvent::Log::COLLECT->detach($self->log_error_ctx);
131 |       $self->log_error_ctx(undef);
132 |     }
133 |   }
134 | }
135 | 
136 | sub _build_config {
137 |   my($self) = @_;
138 |   my $config = {};
139 |   my $cfg = Config::Simple->new($self->config_file) or die Config::Simple->error();
140 |   $config = $cfg->vars();
141 |   for my $key (keys %$config) {
142 |     $config->{$1} = delete $config->{$key} if $key =~ /^default\.(.*)/;
143 |   }
144 |   $config->{table_timeout} //= 10000;
145 |   return $config;
146 | }
147 | 
148 | sub reload_config {
149 |   my($self) = @_;
150 |   my $config = {};
151 |   my $cfg = Config::Simple->new($self->config_file) or $self->log->error( Config::Simple->error() );
152 |   $config = $cfg->vars();
153 |   for my $key (keys %$config) {
154 |     $config->{$1} = delete $config->{$key} if $key =~ /^default\.(.*)/;
155 |   }
156 |   @$config{'port', 'host'} = @{$self->config}{'host', 'port'};
157 |   $config->{table_timeout} //= 10000;
158 |   $self->config($config);
159 | }
160 | 
161 | sub _room_control_sum {
162 |   my($self, $row) = @_;
163 |   $row = join "", @$row if ref($row) eq 'ARRAY';
164 |   my $V1 = 1;
165 |   my $V2 = 0;
166 |   for(my $i = 0; $i < (length($row) + 5552 - 1); $i += 5552) {
167 |     for(my $j = $i; $j < ($i + 5552) and $j < length($row); $j++) {
168 |       my $c = ord(substr($row, $j, 1));
169 |       $V1 += $c;
170 |       $V2 += $V1;
171 |     }
172 |     $V1 %= 0xFFF1;
173 |     $V2 %= 0xFFF1;
174 |   }
175 |   my $r = ($V2 << 0x10) | $V1;
176 |   return $r;
177 | }
178 | 
179 | sub leave_room {
180 |   my($self, $player_id) = @_;
181 |   my $room = $self->data->{rooms_by_player}{$player_id} or return;
182 |   
183 |   delete $self->data->{rooms_by_player}{ $player_id };
184 |   $room->{players_count}--;
185 |   if(!$room->{started}) {
186 |     delete $room->{players}{ $player_id };
187 |     delete $room->{players_time}{ $player_id };
188 |     $room->{row}[-4] = $room->{players_count} . "/" . $room->{max_players};
189 |   } else {
190 |     $room->{players}{ $player_id }{exited} = time;
191 |   }
192 |   my $in_ctrl_sum = delete $self->data->{rooms_by_ctlsum}->{ $room->{ctlsum} };
193 |   $room->{ctlsum} = $self->_room_control_sum($room->{row});
194 | 
195 |   if($room->{started} ? $room->{players_count} <= 0 : $room->{host_id} == $player_id) {
196 |     delete $self->data->{rooms_by_id}{ $room->{id} };
197 |     my $rooms_list = $self->data->{dbtbl}{ "ROOMS_V" . $room->{ver} };
198 |     for(my $i = 0; $i < @$rooms_list; $i++) {
199 |       if($rooms_list->[$i]{id} == $room->{id}) {
200 |         splice @$rooms_list, $i, 1;
201 |         last;
202 |       } 
203 |     }
204 |   } else {
205 |     $self->data->{rooms_by_ctlsum}->{ $room->{ctlsum} } = $room if $in_ctrl_sum;
206 |   }
207 |   return $room;
208 | }
209 | 
210 | sub start_room {
211 |   my($self, $player_id, $params) = @_;
212 |   my $room = $self->data->{rooms_by_player}{$player_id} or return;
213 |   
214 |   if($room->{host_id} == $player_id) {
215 |     delete $self->data->{rooms_by_ctlsum}{ $room->{ctlsum} };
216 |     %$room = (%$room, %$params) if $params;
217 |     $room->{row}[1] = "\x{7F}0018";
218 |     substr($room->{row}[-1], 0, 1) = '1';
219 |     $room->{started} = time;
220 |     $room->{start_players_count} = $room->{players_count};
221 |     $room->{ctlsum} = $self->_room_control_sum($room->{row});
222 |     $self->data->{rooms_by_ctlsum}->{ $room->{ctlsum} } = $room;
223 |   }
224 |   return $room;
225 | }
226 | 
227 | sub post_account_action {
228 |   my($self, $h, $action, $data, $time) = @_;
229 |   $h->log->error('no $action') and return unless $action;
230 |   if(my $account_data = $h->connection->data->{account}) {
231 |     my $host = $h->server->config->{lc($account_data->{type}) . "_host"};
232 |     my %params;
233 |     $params{time} = $time // time; 
234 |     $params{action} = $action;
235 |     $params{data} = $data if defined $data;
236 |     $params{key} = $h->server->config->{lc($account_data->{type}) . "_key"};
237 |     $params{account_id} = $account_data->{id};
238 |     my $body = '';
239 |     my $i;
240 |     for my $name (keys %params) {
241 |       $body .= ($i ? "&" : "" ) . "$name=" . ( ref($params{$name}) ? JSON::to_json($params{$name}) : $params{$name} );
242 |       $i++
243 |     }
244 |     my $url = "http://$host/api/server.php";
245 |     AnyEvent::HTTP::http_post $url, $body,
246 |       headers => {
247 |         "Content-Type" => "application/x-www-form-urlencoded",
248 |         "Content-Length" => length($body),
249 |         "UserAgent" => "cossacks-server.net bot",
250 |         "X-Client-IP" => $h->connection->ip,
251 |       },
252 |       sub {
253 |         my($data, $headers) = @_;
254 |         unless($headers->{Status} >= 200 && $headers->{Status} < 300) {
255 |           $h->log->warn("bad response from $url : " . $headers->{Status} . " " . $headers->{Reason});
256 |         } 
257 |       }
258 |     ;
259 |   }
260 | }
261 | 
262 | sub export_rooms {
263 |   my($self) = @_;
264 |   my $rooms = $self->data->{dbtbl}{ROOMS_V2} || [];
265 |   my $rms = [];
266 |   $self->log->debug("exporting " . scalar(@$rooms) . " rooms");
267 |   for my $room (@$rooms) {
268 |     my $r = {};
269 |     state $copy = [qw<id title ctime level max_players host_id>];
270 |     @{$r}{@$copy} = @{$room}{@$copy};
271 |     $r->{password} = JSON::true if $room->{password} ne '';
272 |     if($room->{started}) {
273 |       $r->{started_at} = $room->{started}+0;
274 |       $r->{ai} = $room->{ai} ? JSON::true : JSON::false;
275 |       $r->{map} = $room->{map};
276 |       $r->{time} = $room->{time}+0;
277 |     }
278 |     $r->{players} = [];
279 |     my $players = $room->{started_players} // [sort { $room->{players_time}{$a->{id}} <=> $room->{players_time}{$b->{id}} } values %{$room->{players}}];
280 |     for my $player (@$players) {
281 |       my $p = {};
282 |       state $copy = [qw<id nick connected_at>];
283 |       @{$p}{@$copy} = @{$player}{@$copy};
284 |       $p->{joined_at} = $room->{players_time}{$p->{id}};
285 |       for(qw<color nation theam>) {
286 |         $p->{$_} = $player->{$_}+0 if exists $player->{$_};
287 |       }
288 |       $p->{exited_at} = $player->{exited}+0 if exists $player->{exited};
289 |       $p->{$_} = $p->{$_}+0 for qw<id connected_at>;
290 |       push @{$r->{players}}, $p;
291 |     }
292 |     $r->{$_} = $r->{$_}+0 for qw<id ctime level max_players host_id>;
293 |     push @$rms, $r;
294 |   }
295 |   my $json = JSON::to_json({ rooms => $rms });
296 |   aio_open $self->config->{export_rooms_file}, Fcntl::O_CREAT|Fcntl::O_TRUNC|Fcntl::O_WRONLY, 0644, sub {
297 |     my($fh) = @_;
298 |     unless($fh) {
299 |       $self->log->warn("can't open file export_rooms_file $self->config->{export_rooms_file} for write: $!");
300 |       return;
301 |     }
302 |     aio_write $fh, $json, sub {
303 |       my($length) = @_;
304 |       if(!defined $length) {
305 |         $self->log->warn("can't write data to export_rooms_file $self->config->{export_rooms_file}: $!");
306 |       } elsif($length < length($json)) {
307 |         $self->log->warn("not full write to export_rooms_file, $length written, " . length($json) . " expected");
308 |       }
309 |     };
310 |   };
311 | }
312 | 
313 | sub load_lcn_ranking {
314 |   my($self) = @_;
315 |   my $ranking_file = $self->config->{lcn_ranking} or return;
316 |   my $mtime = (stat $ranking_file)[9] // 0;
317 |   if(!$self->data->{lcn_ranking_mtime} || $self->data->{lcn_ranking_mtime} != $mtime) {
318 |     my $cv = AE::cv;
319 |     aio_load $ranking_file, $cv;
320 |     my $data = $cv->recv();
321 |     unless(defined $data) {
322 |       $self->log->error("can't load LCN ranking file $ranking_file: $!");
323 |       return;
324 |     }
325 |     my $rating = eval { JSON::from_json($data) };
326 |     unless($rating) {
327 |       $self->log->error("can't parse json file $ranking_file: $@");
328 |       return;
329 |     };
330 |     my $places = {};
331 |     for my $row (@{$rating->{ranking}{total}}) {
332 |       $places->{$row->{id}} = $row->{place};
333 |     }
334 |     $self->data->{lcn_place_by_id} = $places;
335 |     $self->data->{lcn_ranking} = $rating;
336 |     $self->data->{lcn_ranking_mtime} = $mtime;
337 |   }
338 |   return $self->data->{lcn_ranking};
339 | }
340 | 
341 | sub load_gg_cup {
342 |   my($self) = @_;
343 |   my $gg_cup_file = $self->config->{gg_cup_file} or return;
344 |   my $mtime = (stat $gg_cup_file)[9] // 0;
345 |   if(!$self->data->{gg_cup_mtime} || $self->data->{gg_cup_mtime} != $mtime) {
346 |     my $cv = AE::cv;
347 |     aio_load $gg_cup_file, $cv;
348 |     my $data = $cv->recv();
349 |     unless(defined $data) {
350 |       $self->log->error("can't load GG Cup file $gg_cup_file: $!");
351 |       return $self->data->{gg_cup} = { wo_info => 1 };
352 |     }
353 |     unless($data) {
354 |       return $self->data->{gg_cup} = { wo_info => 1 };
355 |     }
356 |     my $gg_cup = eval { JSON::from_json($data) };
357 |     unless($gg_cup) {
358 |       $self->log->error("can't parse json file $gg_cup_file: $@");
359 |       return $self->data->{gg_cup} = { wo_info => 1 };
360 |     }
361 |     $self->data->{gg_cup} = $gg_cup;
362 |   }
363 |   return $self->data->{gg_cup};
364 | }
365 | 
366 | __PACKAGE__->meta->make_immutable();
367 | 
368 | =head1 NAME
369 | 
370 | SimpleCossacksServer - простой сервер для игры в Казаки и ЗА
371 | 


--------------------------------------------------------------------------------
/share/cs/started_room_info/statcols.cml:
--------------------------------------------------------------------------------
  1 | <INFOTBL>
  2 | <? SET table.top = 81 ~?>
  3 | <? SET table.left = 6 ~?>
  4 | <? SET table.width.nick = 138 ~?>
  5 | <? SET table.width.nation = 78 ~?>
  6 | <? SET table.width.score = 45 ~?>
  7 | <? SET table.width.population = 42 ~?>
  8 | <? SET table.width.smallcol = page == 1 ? (res ? 43 : 49) : ( page == 2 ? (res ? 57 : 66) : 51 ) ~?>
  9 | <? SET table.width.largecol = page == 1 ? 54 : 61 ~?>
 10 | <? SET table.row_height = 22 ~?>
 11 | 
 12 | <? left_offset = table.left
 13 |   + table.width.nick - 1 + 21 * 2
 14 |   + table.width.nation - 1
 15 |   + table.width.score - 1
 16 |   + table.width.population - 1
 17 | ~?>
 18 | <? offsetx = left_offset ~?>
 19 | 
 20 | <? IF page == 1 ?>
 21 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 22 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"+wood")
 23 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 24 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 25 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"+food")
 26 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 27 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 28 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"+stone")
 29 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 30 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 31 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"+gold")
 32 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 33 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 34 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"+iron")
 35 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 36 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 37 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"+coal")
 38 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 39 | <? IF res ?>
 40 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 41 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"+res")
 42 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 43 | <? END ?>
 44 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 45 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"+popul")
 46 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 47 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.largecol ?>],0)
 48 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.largecol ?>],{},"*casuality")
 49 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 50 | <? ELSIF page == 2 ?>
 51 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 52 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"*wood")
 53 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 54 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 55 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"*food")
 56 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 57 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 58 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"*stone")
 59 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 60 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 61 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"*gold")
 62 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 63 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 64 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"*iron")
 65 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 66 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 67 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"*coal")
 68 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 69 | <? IF res ~?>
 70 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 71 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"*res")
 72 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 73 | <? END ~?>
 74 | <? ELSIF page == 3 ~?>
 75 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 76 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"+units")
 77 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 78 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 79 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"+peasants")
 80 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 81 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.smallcol ?>],0)
 82 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.smallcol ?>],{},"+popul")
 83 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
 84 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.largecol ?>],0)
 85 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.largecol ?>],{},"*units")
 86 | <? offsetx = offsetx + table.width.largecol - 1 ~?>
 87 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.largecol ?>],0)
 88 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.largecol ?>],{},"*peasants")
 89 | <? offsetx = offsetx + table.width.largecol - 1 ~?>
 90 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.largecol ?>],0)
 91 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.largecol ?>],{},"*popul")
 92 | <? offsetx = offsetx + table.width.largecol - 1 ~?>
 93 | #pan(%LBX[x:<? offsetx ?>,y:<? table.top - 19 ?>,h:20,w:<? table.width.largecol ?>],0)
 94 | #ctxt(%LBX[x:<? offsetx ?>,y:<? table.top - 16 ?>,h:20,w:<? table.width.largecol ?>],{},"*casuality")
 95 | <? offsetx = offsetx + table.width.largecol - 1 ~?>
 96 | <? END ~?>
 97 | 
 98 | <? offsety = table.top ~?>
 99 | <?~ FOREACH player IN room.started_players ~?>
100 | <? offsetx = left_offset ~?>
101 | <? IF page == 1 ?>
102 | #pan(%LBX[x:<? offsetx ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
103 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.change_wood ?><? player.stat.change_wood | format("%.1f") ?><? ELSE ?>-<? END ?>")
104 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
105 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
106 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.change_food ?><? player.stat.change_food | format("%.1f") ?><? ELSE ?>-<? END ?>")
107 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
108 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
109 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.change_stone ?><? player.stat.change_stone | format("%.1f") ?><? ELSE ?>-<? END ?>")
110 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
111 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
112 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.change_gold ?><? player.stat.change_gold | format("%.1f") ?><? ELSE ?>-<? END ?>")
113 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
114 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
115 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.change_iron ?><? player.stat.change_iron | format("%.1f") ?><? ELSE ?>-<? END ?>")
116 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
117 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
118 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.change_coal ?><? player.stat.change_coal | format("%.1f") ?><? ELSE ?>-<? END ?>")
119 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
120 | <? IF res ~?>
121 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
122 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.change_coal ?><? player.stat.change_coal | format("%.0f") ?><? ELSE ?>-<? END ?>")
123 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
124 | <? END ~?>
125 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
126 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:22],{},"<? IF !player.zombie || player.stat.change_population2 ?><? player.stat.change_population2 | format("%.1f") ?><? ELSE ?>-<? END ?>")
127 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
128 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.largecol ?>,h:<? table.row_height ?>],5)
129 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.largecol ?>,h:22],{},"<? IF !player.zombie || player.stat.casuality ?><? player.stat.casuality >= 0 ? player.stat.casuality : 0 ?><? ELSE ?>-<? END ?>")
130 | <? offsetx = offsetx + table.width.largecol - 1 ~?>
131 | <? ELSIF page == 2 ?>
132 | #pan(%LBX[x:<? offsetx ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
133 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.wood ?><? player.stat.wood ?><? ELSE ?>-<? END ?>")
134 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
135 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
136 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.food ?><? player.stat.food ?><? ELSE ?>-<? END ?>")
137 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
138 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
139 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.stone ?><? player.stat.stone ?><? ELSE ?>-<? END ?>")
140 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
141 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
142 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.gold ?><? player.stat.gold ?><? ELSE ?>-<? END ?>")
143 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
144 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
145 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.iron ?><? player.stat.iron ?><? ELSE ?>-<? END ?>")
146 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
147 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
148 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.coal ?><? player.stat.coal ?><? ELSE ?>-<? END ?>")
149 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
150 | <? IF res ?>
151 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
152 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.coal ?><? player.stat.coal ?><? ELSE ?>-<? END ?>")
153 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
154 | <? END ?>
155 | <? ELSIF page == 3 ?>
156 | #pan(%LBX[x:<? offsetx ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
157 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.change_units ?><? player.stat.change_units | format("%.1f") ?><? ELSE ?>-<? END ?>")
158 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
159 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
160 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.change_peasants ?><? player.stat.change_peasants | format("%.1f") ?><? ELSE ?>-<? END ?>")
161 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
162 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],5)
163 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.smallcol ?>,h:<? table.row_height ?>],{},"<? IF !player.zombie || player.stat.change_population2 ?><? player.stat.change_population2 | format("%.1f") ?><? ELSE ?>-<? END ?>")
164 | <? offsetx = offsetx + table.width.smallcol - 1 ~?>
165 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.largecol ?>,h:<? table.row_height ?>],5)
166 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.largecol ?>,h:22],{},"<? IF !player.zombie || player.stat.units ?><? player.stat.units ?><? ELSE ?>-<? END ?>")
167 | <? offsetx = offsetx + table.width.largecol - 1 ~?>
168 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.largecol ?>,h:<? table.row_height ?>],5)
169 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.largecol ?>,h:22],{},"<? IF !player.zombie || player.stat.peasants ?><? player.stat.peasants ?><? ELSE ?>-<? END ?>")
170 | <? offsetx = offsetx + table.width.largecol - 1 ~?>
171 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.largecol ?>,h:<? table.row_height ?>],5)
172 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.largecol ?>,h:22],{},"<? IF !player.zombie || player.stat.population2 ?><? player.stat.population2 ?><? ELSE ?>-<? END ?>")
173 | <? offsetx = offsetx + table.width.largecol - 1 ~?>
174 | #pan(%LBX[x:<? offsetx  ?>,y:<? offsety ?>,w:<? table.width.largecol ?>,h:<? table.row_height ?>],5)
175 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 3 ?>,w:<? table.width.largecol ?>,h:22],{},"<? IF !player.zombie || player.stat.casuality ?><? player.stat.casuality >=0 ? player.stat.casuality : 0 ?><? ELSE ?>-<? END ?>")
176 | <? offsetx = offsetx + table.width.largecol - 1 ~?>
177 | <? END ~?>
178 | <? offsety = offsety + table.row_height - (loop.first ? 1 : 0) ~?>
179 | <? END ~?>
180 | 
181 | <? offsety = 32 ?>
182 | <? offsetx = 613 ?>
183 | #font(YF,YF,YF)
184 | //#txt(%LBX[x:338,y:<? offsety + 9 ?>,w:100%,h:40],{},"show resources in terms of:")
185 | //#cbb(%LBX[x:508,y:<? offsety + 5 ?>,w:100,h:24],{%GV_LCN_INFR}{LW_show&:GW\7Cgo\26room_info_dgl\26VE_RID=<? room.id ?>\26part=statcols\26res=<%GV_LCN_INFR>\26page=<? page ?>},--,gold,iron/coal,wood/stone,food,0)
186 | #apan(%LBX[x:<? offsetx ?>,y:<? offsety + 5 ?>,w:40,h:22],{<? IF page != 1 ?>GW|go&room_info_dgl&VE_RID=<? room.id ?>&part=statcols&res=<%GV_LCN_INFR>&page=1<? END ?>},<? page == 1 ? 5 : 2 ?>)
187 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 8 ?>,w:40,h:22],{},"1")
188 | <? offsetx = offsetx + 42 ?>
189 | #apan(%LBX[x:<? offsetx ?>,y:<? offsety + 5 ?>,w:40,h:22],{<? IF page != 2 ?>GW|go&room_info_dgl&VE_RID=<? room.id ?>&part=statcols&res=<%GV_LCN_INFR>&page=2<? END ?>},<? page == 2 ? 5 : 2 ?>)
190 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 8 ?>,w:40,h:22],{},"2")
191 | <? offsetx = offsetx + 42 ?>
192 | #apan(%LBX[x:<? offsetx ?>,y:<? offsety + 5 ?>,w:40,h:22],{<? IF page != 3 ?>GW|go&room_info_dgl&VE_RID=<? room.id ?>&part=statcols&res=<%GV_LCN_INFR>&page=3<? END ?>},<? page == 3 ? 5 : 2 ?>)
193 | #ctxt(%LBX[x:<? offsetx ?>,y:<? offsety + 8 ?>,w:40,h:22],{},"3")
194 | <INFOTBL>
195 | 


--------------------------------------------------------------------------------
/lib/SimpleCossacksServer/CommandController.pm:
--------------------------------------------------------------------------------
  1 | package SimpleCossacksServer::CommandController;
  2 | use Mouse;
  3 | BEGIN { extends 'GSC::Server::CommandController' }
  4 | use SimpleCossacksServer::CommandController::Open;
  5 | use String::Escape();
  6 | use JSON();
  7 | use Time::HiRes();
  8 | use feature 'state';
  9 | 
 10 | sub proxy : Command {
 11 |   my($self, $h, $ip, $port, $key) = @_;
 12 |   my $valid_key = $h->server->config->{proxy_key};
 13 |   if(!$valid_key) {
 14 |     $h->log->error("reject connection from from proxy " . $h->connection->ip . ": proxy connection disabled");
 15 |     $h->log->info($h->connection->log_message . " #reject connection from from proxy: proxy connection disabled");
 16 |     $h->close(); return;
 17 |   }
 18 |   if($key ne $valid_key) {
 19 |     $h->log->error("reject connection from from proxy " . $h->connection->ip . ": invalid key $key");
 20 |     $h->log->info($h->connection->log_message . " #reject connection from from proxy: invalid key $key");
 21 |     $h->close(); return;
 22 |   }
 23 |   if(!$ip || $ip !~ /^\d+\.\d+\.\d+\.\d+$/) {
 24 |     $h->log->error("reject connection from from proxy " . $h->connection->ip . ": pass invalid ip $ip");
 25 |     $h->log->info($h->connection->log_message . " #reject connection from from proxy: pass invalid ip $ip");
 26 |     $h->close(); return;
 27 |   }
 28 |   if(!$port || $port !~ /^\d+$/ || !($port > 0 && $port < 0xFFFF)) {
 29 |     $h->log->error("reject connection from from proxy " . $h->connection->ip . ": pass invalid port $port");
 30 |     $h->log->info($h->connection->log_message . " #reject connection from from proxy: pass invalid port $port");
 31 |     $h->close(); return;
 32 |   }
 33 |   my $proxy_ip = $h->connection->ip;
 34 |   $h->connection->ip($ip);
 35 |   $h->connection->int_ip(unpack 'L', Socket::inet_aton $ip);
 36 |   $h->connection->port($port);
 37 |   $h->log->info($h->connection->log_message . " #connect from proxy $proxy_ip");
 38 | }
 39 | 
 40 | sub login : Command {
 41 |   my($self, $h, $lgdta) = @_;
 42 |   $h->push_command( LW_show => ':GW|open&enter.dcml');
 43 | }
 44 | 
 45 | sub open : Command {
 46 |   my($self, $h, $url, $params) = @_;
 47 |   s/\s+//, s/\0$// for $url;
 48 |   my %P;
 49 |   if($params) {
 50 |     $params =~ s/\0//;
 51 |     %P = ( $params =~ m{\G(\w+)=(.*?)(?:\^(?=\w+=)|$)}gs );
 52 |   }
 53 |   my $method = ( $url =~ s/\.dcml//r );
 54 |   if(SimpleCossacksServer::CommandController::Open->public($method)) {
 55 |     SimpleCossacksServer::CommandController::Open->$method($h, \%P);
 56 |   } else {
 57 |     $h->log->warn("open $url" . ($params ? " $params" : "") .  " not found");
 58 |     SimpleCossacksServer::CommandController::Open->_default($h, \%P);
 59 |   }
 60 | }
 61 | 
 62 | sub go : Command {
 63 |   my($self, $h, $method, @params) = @_;
 64 |   my %result_params;
 65 |   while(@params) {
 66 |     my $param = shift @params;
 67 |     if($param =~ s/^(\w+)=//) {
 68 |       $result_params{$1} = $param;
 69 |     } elsif($param =~ /^(\w+):=$/) {
 70 |       $result_params{$1} = shift @params;
 71 |     }
 72 |   }
 73 |   if(SimpleCossacksServer::CommandController::Open->public($method)) {
 74 |     SimpleCossacksServer::CommandController::Open->$method($h, \%result_params);
 75 |   } else {
 76 |     $h->log->warn("go $method" . (join " ", @params) .  " not found");
 77 |     SimpleCossacksServer::CommandController::Open->_default($h, \%result_params);
 78 |   }
 79 | }
 80 | 
 81 | sub echo : Command {
 82 |   my($self, $h, @args) = @_;
 83 |   $h->push_command( LW_echo => @args );
 84 | }
 85 | 
 86 | sub GETTBL : Command {
 87 |   my($self, $h, $name, $num, $rows_pack) = @_;
 88 |   s/\0$// for $name, $num;
 89 |   my @rows_ctl_sum = unpack 'L*', $rows_pack;
 90 |   my %rows_ctl_sum = map { $_ => 1 } @rows_ctl_sum;
 91 |   my(@dtbl, @tbl);
 92 |   my $rooms = $h->server->data->{dbtbl}{$name};
 93 |   my $rooms_by_ctlsum = $h->server->data->{rooms_by_ctlsum};
 94 |   my $hide_started = !$h->connection->data->{dev} && !$h->server->config->{show_started_rooms};
 95 |   for my $sum (@rows_ctl_sum) {
 96 |     push @dtbl, $sum if !$rooms_by_ctlsum->{$sum} || $hide_started && $rooms_by_ctlsum->{$sum}->{started};
 97 |   }
 98 |   $rooms = [grep {!$_->{started}} @$rooms] if $hide_started;
 99 |   for my $room (@$rooms) {
100 |     unless($rows_ctl_sum{ $room->{ctlsum} }) {
101 |       push @tbl, $room->{row};
102 |     }
103 |   }
104 |   $h->push_command( LW_dtbl => map{"$_\0"} $name, pack 'L*', @dtbl);
105 |   $h->push_command( LW_tbl => map{"$_\0"} $name, scalar(@tbl), map {@$_} @tbl );
106 | }
107 | 
108 | sub alive : Command {
109 |   my($self, $h) = @_;
110 |   my $id = $h->connection->data->{id} or return;
111 |   $h->server->data->{alive_timers}{ $id } = AnyEvent->timer( after => 150, cb => sub {
112 |     $self->not_alive($h, $id);
113 |   } );
114 | }
115 | 
116 | sub stats : Command {
117 |   my($self, $h, $rawstat, $room_id) = @_;
118 |   state $intervals = {
119 |     wood        => 60 * 25,
120 |     stone       => 60 * 25,
121 |     food        => 120 * 25,
122 |     peasants    => 600, # 16 ticks
123 |     units       => 1000, # 80 ticks
124 |     population2 => 1000,
125 |   };
126 |   state $coefs = {
127 |     wood        => 25 / 2,
128 |     stone       => 25 / 2,
129 |     food        => 25 / 2,
130 |     peasants    => 200,
131 |     units       => 50,
132 |     population2 => 50,
133 |   };
134 |   $self->alive($h);
135 |   $room_id =~ s/\0//;
136 |   my $room = $h->server->data->{rooms_by_id}{$room_id} or return;
137 |   my $user_id = $h->connection->data->{id};
138 |   my $player = $room->{players}{$user_id} or return;
139 |   my $stat = {};
140 |   @$stat{qw<time pc player_id status scores population wood gold stone food iron coal peasants units>}
141 |     = unpack "LCLC SSLLLLLLSS", $rawstat;
142 |   return unless $user_id == $stat->{player_id};
143 |   $room->{time} = $stat->{time} if !$room->{time} || $room->{time} < $stat->{time};
144 |   $player->{time} ||= 0;
145 |   $player->{stat_cycle} ||= { peasants => 0, units => 0, scores => 0 };
146 |   if($player->{time} > $stat->{time}) {
147 |     $h->log->error("player.time > stat.time");
148 |     return;
149 |   }
150 |   my $interval = $stat->{time} - $player->{time};
151 |   my $old_stat = $player->{stat} || { %$stat, time => 0, population2 => $stat->{units} + $stat->{peasants}, casuality => 0 };
152 |   if(!$player->{stat} && $stat->{scores} == 0 && $stat->{population} == 0) {
153 |     my $theam = $player->{theam};
154 |     my $parent;
155 |     for my $pl (@{$room->{started_players}}) {
156 |       if($pl->{theam} == $theam) {
157 |         $parent = $pl if $player->{id} != $pl->{id};
158 |         last;
159 |       }
160 |     }
161 |     if($parent) {
162 |       $player->{zombie} = 1;
163 |       $player->{color} = $parent->{color};
164 |     }
165 |   }
166 |   for my $res (qw<peasants units>) {
167 |     $player->{stat_cycle}{$res}++ if $stat->{$res} < ($old_stat->{$res} - $player->{stat_cycle}{$res} * 0x10000);
168 |     $stat->{$res} += $player->{stat_cycle}{$res} * 0x10000;
169 |   }
170 |   my $scores_change = $stat->{scores} - $old_stat->{scores};
171 |   if(abs($scores_change) > 0x7FFF) {
172 |     if($scores_change > 0) {
173 |       $player->{stat_cycle}{scores}--;
174 |     } else {
175 |       $player->{stat_cycle}{scores}++;
176 |     }
177 |   }
178 |   $stat->{real_scores} = $player->{stat_cycle}{scores} * 0x10000 + $stat->{scores};
179 |   $stat->{population2} = $stat->{units} + $stat->{peasants};
180 |   for(qw<gold iron coal>) {
181 |     $stat->{"change_$_"} = ($stat->{$_} - $old_stat->{$_}) / $interval * 25 / 2;
182 |   }
183 |   for my $res (qw<wood food stone peasants units population2>) {
184 |     my $change = $stat->{$res} - $old_stat->{$res};
185 |     push @{$player->{stat_history}{"change_$res"}}, [$change, $stat->{time}, $interval];
186 |     $player->{stat_history}{"sum_$res"} += $change;
187 |     while(@{$player->{stat_history}{"change_$res"}} && $player->{stat_history}{"change_$res"}[0][1] < $stat->{time} - $intervals->{$res}) {
188 |       my $r = shift @{$player->{stat_history}{"change_$res"}};
189 |       $player->{stat_history}{"sum_$res"} -= $r->[0];
190 |     }
191 |     $stat->{"change_$res"} = $player->{stat_history}{"sum_$res"} / ($stat->{time} - ($player->{stat_history}{"change_$res"}[0][1] - $player->{stat_history}{"change_$res"}[0][2])) * $coefs->{$res};
192 |   }
193 |   my $casuality_change = ($stat->{population2} - $old_stat->{population2}) - ($stat->{population} - $old_stat->{population});
194 |   $stat->{casuality} = $old_stat->{casuality} + $casuality_change;
195 |   $player->{time} = $stat->{time};
196 |   $player->{stat} = $stat;
197 | }
198 | 
199 | sub leave : Command {
200 |   my($self, $h) = @_;
201 |   if($h->connection->data->{id}) {
202 |     my $room = $h->server->leave_room( $h->connection->data->{id} );
203 |     delete $h->server->data->{alive_timers}{ $h->connection->data->{id} };
204 |     if($room) {
205 |       if($room->{host_id} == $h->connection->data->{id}) {
206 |         $h->log->info($h->connection->log_message . " " . $h->req->ver . " #leave his room $room->{id} $room->{title}");
207 |       } else {
208 |         $h->log->info($h->connection->log_message . " " . $h->req->ver . " #leave room $room->{id} $room->{title}");
209 |       }
210 |     } else {
211 |       $h->log->warn($h->connection->log_message . " " . $h->req->ver . " have not room for leave");
212 |     }
213 |   } else {
214 |     $h->log->warn($h->connection->log_message . " " . $h->req->ver . " no id for live room");
215 |   }
216 | }
217 | 
218 | sub start : Command {
219 |   my($self, $h, $sav, $map, $players_count, @players_list) = @_;
220 |   if(0 && $map =~ /^RN[012] [0-9A-F]+ [0-9A-Z]*3[0-9A-Z]{3} [0-9A-Z]+ [0-9A-Z]+\.m3d\0?$/) { # 1 апреля, 7млн. ресурсов :)
221 |     my($sec, $min, $hour, $day, $mon) = localtime();
222 |     if($mon == 3 && ($day == 1 || $day == 2 && $hour < 5)) {
223 |       $h->push_command(LW_bonus => '700');
224 |     }
225 |   }
226 |   my $room = $h->server->start_room( $h->connection->data->{id}, { ai => scalar($sav =~ /<AI>/) } );
227 |   if($room) {
228 |     if($room->{host_id} == $h->connection->data->{id}) {
229 |       $h->log->info($h->connection->log_message . " " . $h->req->ver . " #start his game $room->{id} $room->{title}");
230 |     } else {
231 |       $h->log->info($h->connection->log_message . " " . $h->req->ver . " #start game $room->{id} $room->{title}");
232 |     }
233 |   } else {
234 |      $h->log->info($h->connection->log_message . " " . $h->req->ver . " #start game ?unknown?");
235 |      $h->log->warn($h->connection->log_message . " have not game for start"); 
236 |   }
237 |   if($room) { # установка таймаутов
238 |     for my $player_id (keys %{$room->{players}}) {
239 |       $h->server->data->{alive_timers}{ $player_id } = AnyEvent->timer( after => 150, cb => sub {
240 |         $self->not_alive($h, $player_id);
241 |       } );
242 |     }
243 |     if($h->connection->data->{id} == $room->{host_id}) { # save player data
244 |       s/\0// for $map, $players_count, @players_list;
245 |       $room->{map} = $map;
246 |       if($players_count > 7) {
247 |         $h->log->error("bad players count $players_count");
248 |       }
249 |       for(my $i = 0; $i < $players_count; $i++) {
250 |         my($player_id, $nation, $theam, $color) = splice(@players_list, 0, 4);
251 |         $h->log->warn("no player with id $player_id") unless $room->{players}{$player_id};
252 |         my $player = $room->{players}{$player_id} || {};
253 |         $player->{nation} = $nation;
254 |         $player->{theam} = $theam;
255 |         $player->{color} = $color;
256 |         push @{$room->{started_players}}, $player; 
257 |       }
258 |     }
259 |   }
260 |   if($h->connection->data->{account}) { # отправка статы в wcl/lcn аккаунт
261 |     s/\0$// for $sav, $map, $players_count, @players_list;
262 |     $_ = int($_) for $players_count, @players_list;
263 |     my $post_room;
264 |     if($room) {
265 |       my @fields = qw<id title max_players players_count level ctime>;
266 |       @$post_room{@fields} = @$room{@fields};
267 |       $_ = int($_) for @$post_room{qw<id max_players players_count level ctime>};
268 |     } else {
269 |       $post_room = { id => $room->{id}, lost => JSON::true };
270 |     }
271 | 
272 |     $post_room->{map} = $map;
273 |     $post_room->{save_from} = int($1) if $sav && $sav =~ /^sav:\[(\d+)\]$/;
274 | 
275 |     my $i = 0;
276 |     while(@players_list && $i < $players_count) {
277 |       my($player_id, $nation, $theam, $color) = splice(@players_list, 0, 4);
278 |       $player_id = unpack 'L', pack 'l', $player_id;
279 |       my $post_player;
280 |       if(my $player = $h->server->data->{players}{$player_id}) {
281 |         my @fields = qw<id nick connected_at>;
282 |         @$post_player{@fields} = @$player{@fields};
283 |         $_ = int($_) for @$post_player{qw<id connected_at>};
284 |         if($player->{account}) {
285 |           my @fields = qw<type profile id>;
286 |           @{$post_player->{account}}{@fields} = @{$player->{account}}{@fields};
287 |         }
288 |       } else {
289 |         my $post_player = { id => $player_id, lost => JSON::true };
290 |       }
291 |       @$post_player{qw<nation theam color>} = ($nation, $theam, $color);
292 |       push @{$post_room->{players}}, $post_player;
293 |       $i++;
294 |     }
295 | 
296 |     $h->server->post_account_action($h, 'start', $post_room);
297 |   }
298 | }
299 | 
300 | sub endgame : Command {
301 |     my($self, $h, $game_id, $player_id, $result) = @_;
302 |     ($_) = /(-?\d+)/ for $game_id, $player_id, $result;
303 |     $player_id = unpack 'L', pack 'l', $player_id;
304 |     my $id = $h->connection->data->{id};
305 |     my $nick_name = ($h->server->data->{players}{$player_id} ? $h->server->data->{players}{$player_id}{nick} : '.') . ":$player_id";
306 |     my $result_str = $result == 1 ? 'loose' :
307 |         $result == 2 ? 'win' :
308 |         $result == 5 ? 'disconnect' :
309 |         "?$result?"
310 |     ;
311 |     my $room = $h->server->data->{rooms_by_id}{ $game_id };
312 |     $h->log->info(
313 |         $h->connection->log_message . " " . $h->req->ver . " #send game result: $nick_name $result_str in "
314 |         . ($room && $id && $room->{host_id} == $id ? "his " : "" )
315 |         . "game $game_id"
316 |         . ($room ? " $room->{title}" : "")
317 |     );
318 | }
319 | sub upfile  : Command {}
320 | sub unsync  : Command {}
321 | 
322 | sub _before {
323 |   my($self, $h) = @_;
324 |   my $cmd  = $h->req->cmd;
325 |   my $args = $h->req->argsref;
326 |   my $message = $h->connection->log_message;
327 |   my $win = $h->req->win;
328 |   my $key = $h->req->key;
329 |   s/\0$// for $win, $key;
330 |   $message .= ' ' . $h->req->ver . ' ' . $h->req->lang . ' ' . $h->req->num . ' "' . String::Escape::printable($win) . '" "' . String::Escape::printable($key) . '"';
331 |   if($cmd eq 'upfile') {
332 |     $message .= " -$cmd " . join " ", map { '"' . String::Escape::printable($_) . '"' } @$args[0..1];
333 |     my($offset, $size, $buffer) = unpack "LLA*", $args->[2];
334 |     $message .= " offset=$offset,size=$size,realsize=" . length($buffer);
335 |     $message .= " " . join " ", map { '"' . String::Escape::printable($_) . '"' } @$args[3..$#$args] if $#$args >= 3;
336 |   } elsif($cmd eq 'alive') {
337 |     $message .= " -$cmd ";
338 |     $message .= uc unpack 'H*', $args->[0];
339 |     $message .= " " . join " ", map { '"' . String::Escape::printable($_) . '"' } @$args[1..$#$args] if $#$args >= 1;
340 |   } elsif($cmd eq 'stats') { 
341 |     my @all = unpack "LCLC SSLLLLLLSSH*", $args->[0];
342 |     $_ //= '' for @all;
343 |     my($t, $pc, $id, $st, $sc, $pp, $w, $g, $s, $f, $i, $c, $p, $u, $tail) = @all;
344 |     $message .= " -$cmd";
345 |     $message .= " t=$t,pc=$pc,id=$id,st=$st,sc=$sc,pp=$pp,w=$w,g=$g,s=$s,f=$f,i=$i,c=$c,p=$p,u=$u";
346 |     $message .= ",tail=$tail" if defined($tail) && length($tail) > 0;
347 |     $message .= " " . join " ", map { '"' . String::Escape::printable($_) . '"' } @$args[1..$#$args] if $#$args >= 1;
348 |   } elsif($cmd eq 'GETTBL') {
349 |     my $gettbl_log_interval = $h->server->config->{gettbl_log_interval} || 1;
350 |     return if $h->connection->data->{gettbl_count}++ % $gettbl_log_interval;
351 |     $message .= " -$cmd " . join " ", map { '"' . String::Escape::printable($_) . '"' } @$args[0..1];
352 |     $message .= ' rows=' . (join ':', map {sprintf "%08X", $_} unpack 'L*', $args->[2]);
353 |     $message .= " " . join " ", map { '"' . String::Escape::printable($_) . '"' } @$args[3..$#$args] if $#$args >= 3;
354 |     if($gettbl_log_interval != 1) {
355 |       $message .= " #1/$gettbl_log_interval";
356 |     }
357 |   } else {
358 |     if($cmd eq 'go' && $args->[0] eq 'try_enter') {
359 |       $args = [@$args];
360 |       for(@$args) {
361 |         s/^PASSWORD=\K.*/.../s;
362 |       }
363 |     }
364 |     $message .= " -$cmd " . join " ", map { '"' . String::Escape::printable($_) . '"' } @$args;
365 |   }
366 |   $h->log->info($message);
367 | }
368 | 
369 | sub not_alive {
370 |   my($self, $h, $id) = @_;
371 |   my $connection = $h->server->connection_class->connection_by_pid($id);
372 |   delete $h->server->data->{alive_timers}{ $id };
373 |   my $room = $h->server->leave_room( $id );
374 |   if($room && $connection) {
375 |     $h->log->info($connection->log_message . " " . $h->req->ver . " #not alive in" . ($room->{host_id} == $id ? " his" : "") . " room $room->{id} $room->{title}"); 
376 |   }
377 | }
378 | 
379 | sub url :Command {
380 |   my($self, $h, $url) = @_;
381 |   $h->push_command(LW_time => 0, "open:$url");
382 | }
383 | 
384 | __PACKAGE__->meta->make_immutable();
385 | 


--------------------------------------------------------------------------------
/lib/SimpleCossacksServer/CommandController/Open.pm:
--------------------------------------------------------------------------------
  1 | package SimpleCossacksServer::CommandController::Open;
  2 | use Mouse;
  3 | use Coro::LWP;
  4 | use LWP;
  5 | use JSON;
  6 | use AnyEvent::IO;
  7 | use String::Escape();
  8 | use URI();
  9 | use URI::QueryParam();
 10 | use feature 'state';
 11 | 
 12 | my @PUBLIC = qw[
 13 |   enter try_enter startup resize games rooms_table_dgl new_room_dgl reg_new_room
 14 |   join_game join_pl_cmd user_details users_list direct direct_ping 
 15 |   direct_join room_info_dgl started_room_message
 16 |   tournaments lcn_registration_dgl gg_cup_thanks_dgl
 17 | ];
 18 | 
 19 | 
 20 | my %PUBLIC = map { $_ => 1 } @PUBLIC;
 21 | sub public {
 22 |   my($self, $method) = @_;
 23 |   return $PUBLIC{$method};
 24 | }
 25 | 
 26 | sub enter {
 27 |   my($self, $h, $p) = @_;
 28 |   if($h->connection->data->{account}) {
 29 |     my $type = $h->connection->data->{account}{type}; 
 30 |     my $nick = $h->connection->data->{account}{login};
 31 |     my $id = $h->connection->data->{account}{id};
 32 |     $h->show('enter.cml', { type => $type, nick => $nick, id => $id, logged_in => 1 });
 33 |   } else {
 34 |     my $type = $p->{TYPE} if $p->{TYPE} && ($p->{TYPE} eq 'LCN' || $p->{TYPE} eq 'WCL');
 35 |     $h->show('enter.cml', { type => $type });
 36 |   }
 37 | }
 38 | 
 39 | my $ua = LWP::UserAgent->new(agent => 'cossacks-server.net bot');
 40 | sub try_enter {
 41 |   my($self, $h, $p) = @_;
 42 |   my $nick = $p->{NICK};
 43 |   my $type = $p->{TYPE} // '';
 44 |   $h->connection->data->{dev} = ($nick =~ s/#dev4231$//);
 45 |   if($p->{RESET}) {
 46 |     my $account_data = $h->connection->data->{account};
 47 |     $h->log->info(
 48 |       $h->connection->log_message . " " . $h->req->ver . " #logout from " . lc($account_data->{type}) . " account "
 49 |       . String::Escape::printable("$account_data->{id} $account_data->{login}")
 50 |     );
 51 |     $h->connection->data->{account} = undef;
 52 |     $h->show('enter.cml');
 53 |   } elsif($p->{LOGGED_IN}) {
 54 |     if($h->connection->data->{account}) {
 55 |       $nick = $h->connection->data->{account}{login};
 56 |       $nick =~ s/[^\[\]\w-]+//g;
 57 |       $h->server->post_account_action($h, 'enter');
 58 |       $self->_success_enter($h, $p, $nick);
 59 |     } else {
 60 |       $h->show('enter.cml');
 61 |     }
 62 |   } elsif($type eq 'LCN' || $type eq 'WCL') {
 63 |     my $host = $h->server->config->{lc($type) . "_host"};
 64 |     my $server_name = $h->server->config->{lc($type) . "_server_name"} // $host;
 65 |     my $key = $type eq 'LCN' ? $h->server->config->{lcn_key} : $h->server->config->{wcl_key};
 66 |     my $password = $p->{PASSWORD};
 67 |     if(!defined($nick) || $nick eq '') {
 68 |       $h->show('enter.cml', { error => 'enter nick', type => $type });
 69 |     } elsif(!defined($nick) || $nick eq '') {
 70 |       $h->show('enter.cml', { error => 'enter password', type => $type });
 71 |     } else {
 72 |       my $url = "http://$host/api/server.php";
 73 |       my $response = $ua->post($url, { 
 74 |         action => 'logon',
 75 |         key => $key,
 76 |         login => $nick,
 77 |         password => $password,
 78 |       }, X_Client_IP => $h->connection->ip ); 
 79 | 
 80 |       unless($response->is_success) {
 81 |         $h->log->error("bad response from $url : " . $response->status_line);
 82 |         $h->show('enter.cml', { error => "problem with $server_name server", type => $type });
 83 |         return;
 84 |       }
 85 | 
 86 |       my $result = eval { JSON::from_json($response->decoded_content) } or do {
 87 |         $h->log->error("bad json from $url");
 88 |         $h->show('enter.cml', { error => "problem with $server_name server", type => $type });
 89 |         return;
 90 |       };
 91 | 
 92 |       unless($result->{success}) {
 93 |         $h->show('enter.cml', { error => 'incorrect login or password', type => $type });
 94 |         $h->log->info($h->connection->log_message . " " . $h->req->ver . " #authenticate unsuccessfull with " . lc($type) . " login " . String::Escape::printable($nick));
 95 |       } else {
 96 |         my $account_data = {
 97 |           login => $nick,
 98 |           id => $result->{id},
 99 |           type => $type,
100 |         };
101 |         $account_data->{profile} = $result->{profile} if defined $result->{profile} && $result->{profile} =~ m{^https?://};
102 |         if($type eq 'LCN') {
103 |           my $url = URI->new("http://" . $h->server->config->{lcn_host} . "/lang_redir.php");
104 |           $url->query_param(path => 'player.php?plid=' . $account_data->{id});
105 |           $account_data->{profile} = "$url";
106 |         }
107 |         $h->connection->data->{account} = $account_data;
108 |         $nick =~ s/[^\[\]\w-]+//g;
109 |         $nick =~ s/^(?=\d)/_/;
110 |         $h->log->info(
111 |           $h->connection->log_message . " " . $h->req->ver . " #authenticate successfull with " . lc($type)
112 |           . " account " . String::Escape::printable("$account_data->{id} $account_data->{login}")
113 |         );
114 |         $self->_success_enter($h, $p, $nick);
115 |       }
116 |     }
117 |   } else {
118 |     if(!defined($nick) || $nick eq '') {
119 |       $h->show('error_enter.cml', { error_text => 'Enter nick' });
120 |     } elsif($nick !~ /^[\[\]_\w-]+$/) {
121 |       $h->show('error_enter.cml', { error_text => 'Bad character in nick. Nick can contain only a-z,A-Z,0-9,[]_-' });
122 |     } elsif($nick =~ /^([0-9-])/) {
123 |       $h->show('error_enter.cml', { error_text => "Bad character in nick. Nick can't start with " . ($1 eq '-' ? '-' : 'numerical digit') });
124 |     } else {
125 |       $nick = substr($nick, 0, 25) if length($nick) > 25;
126 |       $self->_success_enter($h, $p, $nick);
127 |     }
128 |   }
129 | }
130 | 
131 | sub _success_enter {
132 |   my($self, $h, $p, $nick) = @_;
133 |   my $g = $h->server->data;
134 |   my $id;
135 |   unless($h->connection->data->{id}) {
136 |     $id = ++$g->{last_player_id};
137 |     $h->connection->data->{id} = $id;
138 |     $h->connection->connection_by_pid($id => $h->connection);
139 |   } else {
140 |     $id = $h->connection->data->{id};
141 |     $h->server->leave_room( $id );
142 |   }
143 |   $h->connection->data->{nick} = $nick;
144 |   my $account_data = $h->connection->data->{account};
145 |   $h->log->info(
146 |     $h->connection->log_message . " " . $h->req->ver . " #enter" 
147 |     . ( $account_data ?
148 |       " with " . lc($account_data->{type}) . " account " . String::Escape::printable("$account_data->{id} $account_data->{login}")
149 |       : ""
150 |     )
151 |   );
152 |   $g->{players}{$id}{nick} = $nick;
153 |   $g->{players}{$id}{account} = $account_data;
154 |   $g->{players}{$id}{connected_at} = $h->connection->ctime;
155 |   $g->{players}{$id}{id} = $id;
156 |   $g->{players}{$id}{account} = $h->connection->data->{account};
157 |   my $height = $p->{HEIGHT} =~ /^\d+$/ ? $p->{HEIGHT} : $h->connection->data->{height};
158 |   $h->connection->data->{height} = $height;
159 |   my $size = $height && $height > int(314 + (419 - 314)/2) ? 'large' : 'small';
160 |   $h->show('ok_enter.cml', { nick => $nick, id => $id, window_size => $size });
161 | }
162 | 
163 | sub startup {
164 |   my($self, $h, $p) = @_;
165 |   my $size = $h->connection->data->{height} && $h->connection->data->{height} > int(314 + (419 - 314)/2) ? 'large' : 'small';
166 |   my $gg_cup = $h->server->load_gg_cup();
167 |   $h->show('startup.cml', { window_size => $size, gg_cup => $gg_cup });
168 | }
169 | 
170 | sub resize {
171 |   my($self, $h, $p) = @_;
172 |   my $height = $p->{height};
173 |   $h->connection->data->{height} = $height;
174 |   my $size = $height > int(314 + (419 - 314)/2) ? 'large' : 'small';
175 |   if($size eq 'large') {
176 |     $h->push_command(LW_show => "<RESIZE>\n#large\n<RESIZE>");
177 |   } else {
178 |     $h->push_command(LW_show => "<RESIZE>\n<RESIZE>");
179 |   }
180 | }
181 | 
182 | sub games {
183 |   my $self = shift;
184 |   $self->startup(@_);
185 | }
186 | 
187 | sub new_room_dgl {
188 |   my($self, $h, $p) = @_;
189 |   if(!$p->{ASTATE}) {
190 |     $self->_error($h, "You can not create or join room!\nYou are already participate in some room\nPlease disconnect from that room first to create a new one");
191 |   } else {
192 |     $h->show('new_room_dgl.cml');
193 |   }
194 | }
195 | 
196 | sub reg_new_room {
197 |   my($self, $h, $p) = @_;
198 |   if(!$p->{ASTATE}) {
199 |     $self->_error($h, "You can not create or join room!\nYou are already participate in some room\nPlease disconnect from that room first to create a new one");
200 |   } elsif($p->{VE_TITLE} eq '' || $p->{VE_TITLE} =~ /[\x00-\x1F\x7F]/ || $p->{VE_TITLE} =~ /^\s*$/) {
201 |     $h->show('confirm_dgl.cml', {
202 |       header  => "Error",
203 |       text    => "Illegal title!\nPress Edit button to check title",
204 |       ok_text => "Edit",
205 |       command => "GW|open&new_room_dgl.dcml&ASTATE=<%ASTATE>",
206 |     });
207 |   } elsif(!$h->connection->data->{id} || !$h->connection->data->{nick}) {
208 |     $self->_error($h, "Your was disconnected from the server. Enter again.");
209 |   } else {
210 |     my $player_id = $h->connection->data->{id};
211 |     $h->server->leave_room( $player_id );
212 |     my $rooms = ( $h->server->data->{dbtbl}{ "ROOMS_V" . $h->req->ver } //= [] );
213 |     $h->server->data->{last_room} ||= 1;
214 |     my $room_id = ++$h->server->data->{last_room};
215 |     my $level = $p->{VE_LEVEL} == 3 ? 'Hard' : $p->{VE_LEVEL} == 2 ? 'Normal' : $p->{VE_LEVEL} == 1 ? 'Easy' : 'For all';
216 |     my $title = $p->{VE_TITLE};
217 |     $title = substr($title, 0, 60) if length($title) > 60;
218 |     s/^\s+//, s/\s+$// for $title;
219 |     my $row = [ $room_id, (length $p->{VE_PASSWD} ? '#' : ''), $title, $h->connection->data->{nick}, ($h->is_american_conquest ? $p->{VE_TYPE} : ()), $level, "1/".($p->{VE_MAX_PL}+2), $h->req->ver, $h->connection->int_ip, sprintf("0%X", 0xFFFFFFFF - $room_id) ];
220 |     my $ctlsum = $h->server->_room_control_sum($row);
221 |     my $room = {
222 |       row            => $row,
223 |       id             => $room_id,
224 |       title          => $title,
225 |       password       => $p->{VE_PASSWD} // '',
226 |       host_id        => $player_id,
227 |       host_addr      => $h->connection->ip,
228 |       host_addr_int  => $h->connection->int_ip,
229 |       players_count  => 1,
230 |       players        => { $player_id => { %{$h->server->data->{players}->{$player_id}} } },
231 |       players_time   => { $player_id => time },
232 |       max_players    => $p->{VE_MAX_PL} + 2,
233 |       ver            => $h->req->ver,
234 |       level          => int($p->{VE_LEVEL}),
235 |       ctime          => time,
236 |       ctlsum         => $ctlsum,
237 |     };
238 |     push @$rooms, $room;
239 |     $h->server->data->{rooms_by_ctlsum}->{ $room->{ctlsum} }  = $room;
240 |     $h->server->data->{rooms_by_player}->{ $room->{host_id} } = $room;
241 |     $h->server->data->{rooms_by_id}->{ $room->{id} }          = $room;
242 |     $h->server->data->{alive_timers}{ $player_id } = AnyEvent->timer( after => 150, cb => sub {
243 |       $h->server->command_controller($h)->not_alive($h, $player_id);
244 |     } );
245 |     $h->log->info($h->connection->log_message . " " . $h->req->ver . " #create room $room->{id} $room->{title}" );
246 |     $h->show('reg_new_room.cml', { id => ($p->{VE_TYPE} ? "HB" : "") . $room_id, name => $room->{title}, max_pl => $room->{max_players} });
247 |   }
248 | }
249 | 
250 | sub room_info_dgl {
251 |   my($self, $h, $p) = @_;
252 |   if($p->{VE_RID} !~ /^\d+$/) {
253 |     $h->push_command( LW_show => "<NGDLG>\n<NGDLG>");
254 |     return;
255 |   }
256 |   my $room = $h->server->data->{rooms_by_id}{ $p->{VE_RID} };
257 |   unless($room) {
258 |     $self->_error($h, "The room is closed");
259 |     return;
260 |   }
261 |   my $backto;
262 |   if($p->{BACKTO} && $p->{BACKTO} eq 'user_details') {
263 |     $backto = 'open&user_details.dcml&ID=' . $h->connection->data->{id}; 
264 |   }
265 |   if($room->{started} && ($h->connection->data->{dev} || $h->server->config->{show_started_room_info})) {
266 |     state $nations = [qw<
267 |       Bavaria
268 |       Denmark
269 |       Austria
270 |       England
271 |       France
272 |       Netherlands
273 |       Piemonte
274 |       Portugal
275 |       Prussia
276 |       Russia
277 |       Poland
278 |       Saxony
279 |       Spain
280 |       Sweden
281 |       Ukraine
282 |       Venice
283 |       Algeria
284 |       Turkey
285 |       Hungary
286 |       Switzerland
287 |       (Random)
288 |     >];
289 |     my $tpl = $p->{part} && $p->{part} eq 'statcols' ? 'started_room_info/statcols.cml' : 'started_room_info.cml';
290 |     $h->show($tpl, {
291 |       room => $room,
292 |       room_time => $self->_time_interval($room->{started} || $room->{ctime}),
293 |       backto => $backto,
294 |       page => ($p->{page} || 1),
295 |       res => ($p->{res} && $p->{res} =~ /^\d+$/ ? $p->{res} : 0),
296 |       nations => $nations,
297 |     });
298 |   } else {
299 |     $h->show('room_info_dgl.cml', { room => $room, room_time => $self->_time_interval($room->{started} || $room->{ctime}), backto => $backto });
300 |   }
301 | }
302 | 
303 | sub _time_interval {
304 |     my($self, $ctime) = @_;
305 |     my $time = time - $ctime;
306 |     my @tm;
307 | 
308 |     my $d = int($time / 86400);
309 |     $time %= 86400;
310 |     push @tm, "${d}d" if $d;
311 | 
312 |     my $h = int($time / 3600);
313 |     $time %= 3600;
314 |     push @tm, "${h}h" if $h;
315 |     return join " ", @tm if $d;
316 | 
317 |     my $m = int($time / 60);
318 |     $time %= 60;
319 |     push @tm, "${m}m" if $m;
320 |     return join " ", @tm if $h || $m >= 10;
321 | 
322 |     my $s = $time;
323 |     push @tm, "${s}s" if $s;
324 |     return @tm ? join(" ", @tm) : "0s";
325 | }
326 | 
327 | sub join_game {
328 |   my($self, $h, $p) = @_;
329 |   if($p->{VE_RID} !~ /^\d+$/) {
330 |     $h->push_command( LW_show => "<NGDLG>\n<NGDLG>");
331 |     return;
332 |   }
333 |   my $room = $h->server->data->{rooms_by_id}{ $p->{VE_RID} };
334 |   $self->_join_to_room($h, $room, $p->{ASTATE}, $p->{VE_PASSWD} // '');
335 | }
336 | 
337 | sub _join_to_room {
338 |   my($self, $h, $room, $astate, $password) = @_;
339 |   if(!$h->connection->data->{id} || !$h->connection->data->{nick}) {
340 |     $self->_error($h, "Your was disconnected from the server. Enter again.");
341 |     return;
342 |   }
343 |   if(!$astate) {
344 |     $self->_error($h, "You can not create or join room!\nYou are already participate in some room\nPlease disconnect from that room first to create a new one");
345 |     return;
346 |   }
347 |   if(!$room) {
348 |     $self->_error($h, "You can not join this room!\nThe room is closed");
349 |     return;
350 |   }
351 |   if($room->{started}) {
352 |     $self->_error($h, "You can not join this room!\nThe game has already started");
353 |     return;
354 |   }
355 |   if($room->{players_count} >= $room->{max_players}) {
356 |     $self->_error($h, "You can not join this room!\nThe room is full");
357 |     return;
358 |   }
359 |   if($room->{password} ne '' && $password ne $room->{password}) {
360 |     $h->show('confirm_password_dgl.cml', { id => $room->{id} });
361 |     return;
362 |   }
363 |   my $player_id = $h->connection->data->{id};
364 |   $h->server->leave_room( $player_id );
365 |   $h->server->data->{rooms_by_player}{ $player_id } = $room;
366 |   delete $h->server->data->{rooms_by_ctlsum}->{ $room->{ctlsum} };
367 |   $room->{players}{ $player_id } = { %{$h->server->data->{players}->{ $player_id }} };
368 |   $room->{players_time}{ $player_id } = time;
369 |   $room->{players_count}++;
370 |   $room->{row}[-4] = $room->{players_count} . "/" . $room->{max_players};
371 |   $room->{ctlsum} = $h->server->_room_control_sum($room->{row});
372 |   $h->server->data->{rooms_by_ctlsum}->{ $room->{ctlsum} } = $room;
373 |   my $connection = $h->connection;
374 |   $h->show('join_room.cml' => { id => $room->{id}, max_pl => $room->{max_players}, name => $room->{title}, ip => $room->{host_addr} });
375 |   $h->log->info($h->connection->log_message . " " . $h->req->ver . " #join room $room->{id} $room->{title}" );
376 | }
377 | 
378 | sub user_details {
379 |   my($self, $h, $p) = @_;
380 |   my($id) = ($p->{ID} =~ /(\d+)/);
381 |   if(my $player = $h->server->data->{players}{$id}) {
382 |     $h->show('user_details.cml', {
383 |       player => $player,
384 |       connection_time => $self->_time_interval($player->{connected_at}),
385 |       room => $h->server->data->{rooms_by_player}{ $id },
386 |     }); 
387 |   } else {
388 |     $h->log->warn("There is no info about player $id");
389 |   }
390 | }
391 | 
392 | sub join_pl_cmd {
393 |   my($self, $h, $p) = @_;
394 |   $h->push_empty, return if $h->connection->data->{id} && $h->server->data->{rooms_by_player}{ $h->connection->data->{id} };
395 |   my $room = $h->server->data->{rooms_by_player}{ $p->{VE_PLAYER} };
396 |   if(!$room) {
397 |     return;
398 |   } elsif($room->{started}) {
399 |      $self->_error($h, "Game alredy started"); 
400 |     return;
401 |   } else {
402 |     $self->room_info_dgl($h, { VE_RID => $room->{id} });
403 |     return;
404 |   }
405 | }
406 | 
407 | sub tournaments {
408 |   my($self, $h, $p) = @_;
409 |   my $option = $p->{option} // 'total';
410 |   my $rating = $h->server->load_lcn_ranking();
411 |   if(!$rating) {
412 |     $self->_error($h, 'Internal server error');
413 |     return;
414 |   } else {
415 |     $h->show('lcn_rating.cml', {
416 |       options => $rating->{options},
417 |       options_labels => $rating->{labels},
418 |       current_option => $option,
419 |       rating => $rating->{ranking}{$option},
420 |     });
421 |   }
422 | }
423 | 
424 | sub lcn_registration_dgl {
425 |   my($self, $h, $p) = @_;
426 |   $h->show('confirm_dgl.cml', {
427 |     header  => "LCN Registration",
428 |     text    => "Open www.newlcn.com?",
429 |     ok_text => "Ok",
430 |     command => "GW|url&http://" . $h->server->config->{lcn_host} . "/lang_redir.php&from=tournaments",
431 |     height  => 100,
432 |   });
433 | }
434 | 
435 | sub gg_cup_thanks_dgl {
436 |   my($self, $h, $p) = @_;
437 |   my $gg_cup = $h->server->load_gg_cup();
438 |   $h->show('gg_cup_thanks_dgl.cml', { supporters => $gg_cup->{supporters} });
439 | }
440 | 
441 | sub users_list {
442 |   my($self, $h, $p) = @_;
443 |   $self->_error($h, "Not imlemented");
444 | }
445 | 
446 | sub _default {
447 |   my($self, $h, $p) = @_;
448 |   $self->_error($h, "Page Not Found");
449 | }
450 | 
451 | sub _alert {
452 |   my($self, $h, $header, $text) = @_;
453 |   $h->show('alert_dgl.cml', { text => $text, header => $header });
454 | }
455 | 
456 | sub _error {
457 |   my($self, $h, $text) = @_;
458 |   $h->show('alert_dgl.cml', { text => $text, header => 'Error' })
459 | }
460 | 
461 | __PACKAGE__->meta->make_immutable();
462 | 


--------------------------------------------------------------------------------