annotate ally-map.pl @ 376:6ca0677a361e

refiend output format and fixed timing issue.
author "Rex Tsai <chihchun@kalug.linux.org.tw>"
date Tue, 14 Apr 2009 17:02:17 +0800
parents dd3d76f43999
children
rev   line source
373
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
1 #!/usr/bin/perl
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
2 use strict;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
3 use Ikariam;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
4 use Data::Dumper;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
5 use List::Util qw[min max];
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
6
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
7 package main;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
8
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
9 # my $users = Ikariam::User->search(ally => 'WMeMe');
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
10
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
11 Ikariam::Cities->set_sql(ally => qq {
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
12 SELECT cities.id
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
13 FROM island, cities
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
14 WHERE cities.island == island.id
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
15 AND cities.ally == ?
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
16 });
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
17
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
18 Ikariam::Island->has_many(cities => 'Ikariam::Cities');
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
19 Ikariam::Island->set_sql(ally => qq {
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
20 SELECT island.id
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
21 FROM island, cities
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
22 WHERE cities.island == island.id
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
23 AND cities.ally == ?
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
24 });
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
25
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
26 die("Usage: $0\nUsage: $0 ally\n") unless ($#ARGV == 0);
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
27
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
28 my @islands = Ikariam::Island->search_ally($ARGV[0]);
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
29 my %maps;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
30
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
31 my $x1 = 99;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
32 my $x2 = 0;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
33 my $y1 = 99;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
34 my $y2 = 0;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
35
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
36 foreach my $island (@islands)
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
37 {
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
38 $x1 = min ($x1, $island->x);
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
39 $x2 = max ($x2, $island->x);
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
40 $y1 = min ($y1, $island->y);
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
41 $y2 = max ($y2, $island->y);
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
42
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
43 $maps{$island->x}{$island->y}{'id'} = $island->id;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
44 $maps{$island->x}{$island->y}{'density'} += 1;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
45 # printf("[%s,%s]", $island->x, $island->y);
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
46 }
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
47
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
48 open(OUT, sprintf(">%s-map.html", $ARGV[0])) or die $!;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
49 printf(OUT "<html><head><style type=\"text/css\">
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
50 body {color: #FFFFFF; }
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
51 a {color: #000000; }
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
52 table {
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
53 border-width: 0px 0px 0px 0px;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
54 border-spacing: 0px;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
55 border-style: inset inset inset inset;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
56 border-color: gray gray gray gray;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
57 border-collapse: collapse;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
58 background-color: white;
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
59 }
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
60 </style></head><body><table border=1>");
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
61
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
62 foreach my $y($y1..$y2)
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
63 {
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
64 print(OUT "<tr>");
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
65 foreach my $x ($x1..$x2)
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
66 {
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
67 # printf("<div stlye='float:left; background-color: black; padding: 0; Display:inline;'>o</div>");
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
68 if(defined($maps{$x}{$y}{'density'})) {
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
69 my $c = 255 - (15 * $maps{$x}{$y}{'density'});
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
70 printf(OUT "<td style=\"background-color: rgb(255,%d,%d);\"><a href=\"http://%s/index.php?view=island&id=%d\" title=\"[%d,%d] (%d)\">[%d,%d]</a></td>",
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
71 $c, $c, $::server, $maps{$x}{$y}{'id'}, $x, $y, $maps{$x}{$y}{'density'}, $x, $y);
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
72 } else {
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
73 printf(OUT "<td style=\"background-color: rgb(255,255,255);\">[%d,%d]</td>", $x, $y);
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
74 }
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
75 }
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
76 print(OUT "</tr>");
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
77 }
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
78 printf(OUT "</table></body></html>");
dd3d76f43999 update script for collecting ally information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
79 close(OUT);